mv lab 07 to 06

lectures/09/arithmetic.ml

@@ -0,0 +1,39 @@
+(* monad, mx means monad x *)
+let (>>=) mx f =
+  match mx with
+  | None -> None
+  | Some x -> f x
+
+let return x = Some x
+
+let (/) a b =
+  if b = 0 then None
+  else Some (a / b)
+
+let square x = x * x
+let square' mx = mx >>= fun x -> return (square x)
+
+let (<$>) f mx =
+  match mx with
+  | None -> None
+  | Some x -> Some (f x)
+
+(* functor *)
+let lift f mx = f <$> mx
+
+let (<*>) mf mx =
+  match mf with
+  | None -> None
+  | Some f -> f <$> mx
+
+let add a b = a + b;;
+
+add <$> 4 / 2 <*> Some 1
+
+let lift' f mx my = f <$> mx <*> my
+
+let ( + ) = lift' Stdlib.( + );;
+let ( - ) = lift' Stdlib.( - );;
+let ( * ) = lift' Stdlib.( * );;
+
+Some 1 + (4 / 2) = Some 3;;

lectures/09/list_monad.ml

@@ -0,0 +1,18 @@
+let return x = [x]
+
+let ( >>= ) l f = List.concat_map f l
+
+let gaurd cond l =
+  if cond then l else []
+
+let multiply_to n =
+  List.init n ((+) 1) >>= fun x ->
+    List.init n ((+) 1) >>= fun y ->
+      gaurd (x * y = n) [(x, y)]
+
+let ( let* ) = ( >>= )
+
+let multiply_to' n =
+  let* x = List.init n ((+) 1) in
+  let* y = List.init n ((+) 1) in
+  if x * y = n then [(x, y)] else []

lectures/09/maybe_monad.ml

@@ -0,0 +1,44 @@
+type bstree = L | N of int * bstree * bstree
+
+let rec insert x t =
+  match t with
+  | L -> N (x, L, L)
+  | N (x', l, r) ->
+    if x < x' then N (x', insert x l, r)
+    else if x > x' then N (x', l, insert x r)
+    else t
+
+let of_list l = List.fold_left (Fun.flip insert) L l
+
+(* val right : bstree -> bstree option *)
+let right t =
+  match t with
+  | L -> None
+  | N (_, _, r) -> Some r
+
+(* val left : bstree -> bstree option *)
+let left t =
+  match t with
+  | L -> None
+  | N (_, l, _) -> Some l
+
+let right_left t =
+  match right t with
+  | None -> None
+  | Some r -> left r
+
+(* maybe monad *)
+let bind mt f =
+  match mt with
+  | None -> None
+  | Some t -> f t
+
+let ( >>= ) = bind
+
+let t = of_list [3;2;7;6;8];;
+t |> right >>= left;;
+t |> right >>= left >>= right >>= left;;
+
+let return t = Some t;;
+
+return t >>= right >>= left;;

lectures/09/writer_monad.ml

@@ -0,0 +1,35 @@
+let return x = (x, "")
+
+let ( >>= ) (x, s) f =
+  let (x', s') = f x in
+  (x', s  ^ s')
+
+let ( >> ) mx my =
+  mx >>= fun _ -> my
+
+let square x =
+  let y = x * x in
+  (y, Printf.sprintf "square %d = %d" x y)
+
+let inc x =
+  let y = x + 1 in
+  (y, Printf.sprintf "inc %d = %d" x y)
+
+let dec x =
+  let y = x - 1 in
+  (y, Printf.sprintf "dec %d = %d" x y);;
+
+return 2 >>= square >>= square >>= dec >>= square >>= inc;;
+
+let tell s = ((), s);;
+
+let rec gcd a b =
+  if b = 0 then a else gcd b (a mod b);;
+
+gcd 32 24;;
+
+let rec gcd_logged a b =
+  if b = 0 then tell (Printf.sprintf "gcd = %d" a) >> return a
+  else tell (Printf.sprintf "gcd %d %d: " a b) >> gcd_logged b (a mod b);;
+
+gcd_logged 24 32;;