let (=>) left right = print_char (if left = right then '.' else 'F') | |
open Printf | |
let id x = x | |
let const x = fun _ -> x | |
let sum = List.fold_left (+) 0 | |
let (>>) f g x = g (f x) | |
let () = | |
List.fold_right (^) ["a"; "b"; "c"] "z" => ("a" ^ ("b" ^ ("c" ^ "z"))) | |
let () = | |
List.fold_left (^) "z" ["a"; "b"; "c"] => ((("z" ^ "a") ^ "b") ^ "c") | |
let () = | |
let open StdLabels in | |
List.fold_right ~f:(+) ~init:0 [1; 2; 3; 4] => (1 + (2 + (3 + (4 + 0)))) | |
let () = | |
let open StdLabels in | |
List.fold_left ~f:(+) ~init:0 [1; 2; 3; 4] => ((((0 + 1) + 2) + 3) + 4) | |
let rec fold_right ~f ~init = function | |
| [] -> init | |
| head :: tail -> f head (fold_right ~f ~init tail) | |
let nil = [] | |
let cons head tail = head :: tail | |
let rec fold ~nil ~cons = function | |
| [] -> nil | |
| head :: tail -> cons head (fold ~nil ~cons tail) | |
module Tree = struct | |
type 'a t = Leaf of 'a | Node of 'a t * 'a t | |
let rec fold ~leaf ~node = function | |
| Leaf a -> leaf a | |
| Node (left, right) -> | |
node (fold ~leaf ~node left) (fold ~leaf ~node right) | |
let leaf a = Leaf a | |
let node left right = Node (left, right) | |
let size = fold ~leaf:(const 1) ~node:(+) | |
let height = fold ~leaf:(const 1) ~node:(fun l r -> 1 + max l r) | |
let to_string leaf = fold ~leaf ~node:(sprintf "(%s %s)") | |
let reverse = fold ~leaf ~node:(fun l r -> node r l) | |
let map f = fold ~leaf:(f >> leaf) ~node | |
let bind f = fold ~leaf:f ~node | |
let iter f = fold ~leaf:f ~node:(fun _ _ -> ()) | |
let for_all predicate = fold ~leaf:predicate ~node:(&&) | |
let exists predicate = fold ~leaf:predicate ~node:(||) | |
let rec fold_right ~f ~init = function | |
| Leaf a -> f a init | |
| Node (left, right) -> | |
fold_right ~f ~init:(fold_right ~f ~init right) left | |
let to_list = fold_right ~f:List.cons ~init:[] | |
let map_to_list f = fold_right ~f:(f >> List.cons) ~init:[] | |
end | |
open Tree | |
let ab = Node (Leaf "a", Leaf "b") | |
let cd = Node (Leaf "c", Leaf "d") | |
let aa = Node (Leaf "a", Leaf "a") | |
let ab_cd = Node (ab, cd) | |
let to_string = Tree.to_string id | |
module TestBinTree = struct | |
Tree.size ab_cd => 4; | |
Tree.height ab_cd => 3; | |
Tree.height ab => 2; | |
Tree.height (leaf "a") => 1; | |
to_string ab_cd => "((a b) (c d))"; | |
to_string (Tree.reverse ab_cd) => "((d c) (b a))"; | |
Tree.iter (printf "%s") ab_cd; | |
to_string (Tree.map String.uppercase_ascii ab_cd) => "((A B) (C D))"; | |
Tree.for_all ((=) "a") ab_cd => false; | |
Tree.for_all ((=) "a") aa => true; | |
Tree.to_list ab_cd => ["a"; "b"; "c"; "d"]; | |
Tree.map_to_list String.uppercase_ascii ab_cd | |
=> ["A"; "B"; "C"; "D"]; | |
end | |
module Syntax = struct | |
type t = | |
| Unit | |
| Boolean of bool | |
| Number of int | |
| Id of string | |
| Divide of t * t | |
| Sequence of t * t | |
| Let of {id: string; value: t; body: t} | |
| If of if_ | |
and if_ = {conditional: t; consequence: t; alternative: t} | |
let unit = Unit | |
let boolean b = Boolean b | |
let number n = Number n | |
let id i = Id i | |
let divide dividend divisor = Divide (dividend, divisor) | |
let sequence first second = Sequence (first, second) | |
let let_ id value body = Let {id; value; body} | |
let if_ x = If x | |
let rec fold ~unit ~boolean ~number ~id ~divide ~sequence ~let_ ~if_ = function | |
| Unit -> unit | |
| Boolean b -> boolean b | |
| Number n -> number n | |
| Id i -> id i | |
| Divide (dividend, divisor) -> divide dividend divisor | |
| Sequence (first, second) -> | |
let fold' = fold ~unit ~boolean ~number ~id ~divide ~sequence ~let_ ~if_ in | |
sequence (fold' first) (fold' second) | |
| Let {id=id'; value; body} -> | |
let fold' = fold ~unit ~boolean ~number ~id ~divide ~sequence ~let_ ~if_ in | |
let_ id' (fold' value) (fold' body) | |
| If {conditional; consequence; alternative} -> | |
let fold' = fold ~unit ~boolean ~number ~id ~divide ~sequence ~let_ ~if_ in | |
let conditional = fold' conditional in | |
let consequence = fold' consequence in | |
let alternative = fold' alternative in | |
if_ {conditional; consequence; alternative} | |
let map f = | |
fold ~unit ~boolean ~number ~id | |
~divide:(fun l r -> divide (f l) (f r)) | |
~sequence:(fun l r -> sequence (f l) (f r)) | |
~let_:(fun id value body -> let_ id (f value) (f body)) | |
~if_:(fun {conditional; consequence; alternative} -> | |
if_ {conditional=f conditional; | |
consequence=f consequence; | |
alternative=f alternative}) | |
end | |
module Dead_code_elimination = struct | |
open Syntax | |
let rec pass = function | |
| If {conditional=Boolean true; consequence; _} -> | |
pass consequence | |
| If {conditional=Boolean false; alternative; _} -> | |
pass alternative | |
| other -> map pass other | |
end | |
module Dead_code_elimination_2 = struct | |
open Syntax | |
let pass = | |
fold ~unit ~boolean ~number ~id ~divide ~sequence ~let_ ~if_:(function | |
| {conditional=Boolean true; consequence; _} -> consequence | |
| {conditional=Boolean false; alternative; _} -> alternative | |
| other -> If other) | |
end | |
module Dead_code_elimination_3 = struct | |
open Syntax | |
let fold' = | |
fold ~unit ~boolean ~number ~id ~divide ~sequence ~let_ | |
let pass = | |
fold' ~if_:(function | |
| {conditional=Boolean true; consequence; _} -> | |
consequence | |
| {conditional=Boolean false; alternative; _} -> | |
alternative | |
| other -> If other) | |
end |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment