Commits

camlspotter committed 9b35f38

fixed examples

Comments (0)

Files changed (7)

dcamlexamples/ex001_plus.ml

 
 open Plus
 
-let _ = 
+let () = 
   assert (1 + 2 = 3);
   assert (1.0 + 2.0 = 3.0)
 ;;
- 
-      
-      

dcamlexamples/ex002_plus_sep.ml

 
 open Overloaded
 
-let _ = 
+let () = 
   assert (1 + 2 = 3);
   assert (1.0 + 2.0 = 3.0)
 ;;

dcamlexamples/ex010_num.ml

 module Int = struct
 
   let t : int Num.t = {
-    plus = (+);
+    Num.plus = (+);
     minus = (-);
   }
 
 module Float = struct
 
   let t : float Num.t = {
-    plus = (+.);
+    Num.plus = (+.);
     minus = (-.);
   }
 
 
 open Overloaded
 
-let _ = 
+let () = 
   assert (1 + 2 - 0 = 3);
   assert (1.0 + 2.0 - 0.0 = 3.0)
 ;;
- 
-      
-      

dcamlexamples/ex020_sum.ml

 
 end
 
-let _ =
+let () =
   assert (Overloaded.sum [[]; [1]; [2;3]; [4;5;6]] = 21)
 ;;

dcamlexamples/ex021_sum_fail.ml

 
 end
 
-let _ =
+let () =
   assert ([[]; [1]; [2;3]; [4;5;6]] = 21)
 ;;

dcamlexamples/ex030_monad.ml

   }
   let return $:t = t.return
   let bind $:t = t.bind
+  ;;
+
+  module Make(M : sig 
+    type 'a t
+    val return : 'a -> 'a t
+    val bind : 'a t -> ('a -> 'b t) -> 'b t
+  end) = struct
+    let t = { return = M.return; bind = M.bind }
+  end
 end
 
 module Option = struct
-  let t = 
-    { Monad.return = (fun x -> Some x);
-      bind = (fun v f ->
-        match v with
-        | None -> None
-        | Some v -> f v)
-    }
+
+  type 'a t = 'a option
+
+  let return x = Some x;;
+
+  let bind v f = match v with
+    | None -> None
+    | Some v -> f v
+
 end
 
 module List = struct
-  let t = 
-    { Monad.return = (fun x -> [x]);
-      bind = (fun v f -> List.flatten (List.map f v)) }
+
+  type 'a t = 'a list
+
+  let return x = [x]
+
+  let bind v f = List.flatten (List.map f v)
+
+end
+
+module IO : sig
+
+  type 'a t
+
+  val return : 'a -> 'a t
+    
+  val bind : 'a t -> ('a -> 'b t) -> 'b t
+
+  val run : unit t -> unit
+
+  val putStr : string -> unit t
+
+end = struct
+
+  type 'a t = unit -> 'a
+
+  let return x = fun () -> x
+
+  let bind t f = f (t ())
+
+  let run t = t ()
+
+  let putStr s = fun () -> prerr_endline s
 end
 
 module Overloaded : sig
   val bind : $:('a, 'am, 'bm) t -> 'am -> ('a -> 'bm) -> 'bm
   val option : ('a, 'a option, 'b option) t
   val list : ('a, 'a list, 'b list) t
+  val io : ('a, 'a IO.t, 'b IO.t) t
 end = struct
   include Monad
+  module Option = Monad.Make(Option)
   let option = Option.t
+  module List = Monad.Make(List)
   let list = List.t
+  module IO = Monad.Make(IO)
+  let io = IO.t
 end
 
 open Overloaded
 
-let _ = 
+(* It does not work... need more types.
+
+let () = 
   assert (bind (return 1) (fun x -> Some (float x)) = Some 1.0);
   assert (bind (return 1) (fun x -> [float x; float (x+1)]) = [1.0; 2.0]);
+  assert (IO.run (bind (return ()) (fun x -> IO.putStr "hello")) = ())
+*)
 ;;
 
+(* It runs if we explicitly deliver dictionaries, for now. 
+
+   We can remove some of them by making the resolution cleverer.
+*)
+
+let () = 
+  assert (bind $:option (return $:option 1) (fun x -> Some (float x)) = Some 1.0);
+  assert (bind $:list (return $:list 1) (fun x -> [float x; float (x+1)]) = [1.0; 2.0]);
+  assert (IO.run (bind $:io (return $:io ()) (fun x -> IO.putStr "hello")) = ())
+;;
+

dcamlexamples/ex040_show.ml

 
 open Show
 
-let _ =
+let () =
   assert (
     show [("hello", "world");
           ("bye", "universe")]