Instantly share code, notes, and snippets.

@keleshev /fold.ml
Last active Jul 16, 2018

Embed
What would you like to do?
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