Merge pull request #5 from modular-implicits/cleanup

More code cleanup

generics.opam

@@ -17,6 +17,6 @@ build: [
 depends: [
    "dune" {build}
    "ocaml-variants"
-     { = "4.02.1+modular-implicits" | = "4.02.1+modular-implicits-ber" }
+     { = "4.02.1+modular-implicits" | = "4.02.1+modular-implicits-ber" | = "4.02.1+modular-implicits+let_syntax" }
     "imp"
-]
+]

lib/dune

@@ -1,5 +1,5 @@
 (library
  (public_name generics)
- (modules Generic GenShow GenEq Memo GenOrd)
+ (modules Generic Show Eq Memo Ord)
  (libraries imp)
- (synopsis "Experimental library using modular implicits"))
+ (synopsis "Experimental library using modular implicits"))

lib/genEq.ml → lib/eq.ml

@@ -1,30 +1,25 @@
-open Generic;;
-open Imp.Data;;
-
-
-
-implicit module EqGenBasic {X : Eq} : Eq with type t = X.t genBasic = struct 
-  type t = X.t genBasic
-  let ( = ) (GenBasic (_, a)) (GenBasic (_, b)) = X.( = ) a b
-end;;
+open Generic
+open Imp.Data
 
+implicit module EqGenBasic {X : Eq} : Eq with type t = X.t basic = struct 
+  type t = X.t basic
+  let ( = ) (Basic (_, a)) (Basic (_, b)) = X.( = ) a b
+end
 
-implicit module EqGenProd {X : Eq} {Y : Eq} : Eq with type t = (X.t, Y.t) genProd = struct 
-  type t = (X.t, Y.t) genProd
-  let ( = ) (GenProd (a1, a2)) (GenProd (b1, b2)) = X.( = ) a1 b1 && Y.( = ) a2 b2
-end;;
+implicit module EqGenProd {X : Eq} {Y : Eq} : Eq with type t = (X.t, Y.t) prod = struct 
+  type t = (X.t, Y.t) prod
+  let ( = ) (Prod (a1, a2)) (Prod (b1, b2)) = X.( = ) a1 b1 && Y.( = ) a2 b2
+end
 
-implicit module EqGenSum {X : Eq} {Y : Eq} : Eq with type t = (X.t, Y.t) genSum = struct 
-  type t = (X.t, Y.t) genSum
+implicit module EqGenSum {X : Eq} {Y : Eq} : Eq with type t = (X.t, Y.t) sum = struct 
+  type t = (X.t, Y.t) sum
   let ( = ) a b = match a, b with
     | Left a, Left b -> X.( = ) a b
     | Right a, Right b -> Y.( = ) a b
     | _ -> false
-end;;
-
+end
 
 implicit module EqGeneric {X : Generic} {XRep : Eq with type t = X.rep} : Eq with type t = X.t = struct 
   type t = X.t
   let ( = ) a b = XRep.(=) (toRep a) (toRep b)
 end
-

lib/generic.ml

@@ -1,24 +1,16 @@
-
-
 module type Generic = sig
   type t
   type rep
   val toRep : t -> rep
   val fromRep : rep -> t
-end;;
-
-let toRep {G : Generic}  = G.toRep;;
-
-let fromRep {G : Generic} = G.fromRep;;
-
-type 'a genBasic = GenBasic of (string * 'a);;
-
-type ('a, 'b) genProd = GenProd of ('a * 'b );;
-
-type ('a, 'b) genSum = Left of 'a | Right of 'b;;
-
+end
 
+let toRep {G : Generic}  = G.toRep
 
+let fromRep {G : Generic} = G.fromRep
 
+type 'a basic = Basic of (string * 'a)
 
+type ('a, 'b) prod = Prod of ('a * 'b )
 
+type ('a, 'b) sum = Left of 'a | Right of 'b

lib/memo.ml

@@ -1,49 +1,46 @@
-open Generic;;
-
+open Generic
 
 module type Memo = sig 
   type t 
   val memo : (t -> 'a) -> t -> 'a
-end;;
+end
 
-let memo {M : Memo} = M.memo;;
+let memo {M : Memo} = M.memo
 
-implicit module MemoBasic {X : Memo} : Memo with type t = X.t genBasic = struct 
-  type t = X.t genBasic
+implicit module MemoBasic {X : Memo} : Memo with type t = X.t basic = struct 
+  type t = X.t basic
   let memo f = 
-        let memoX = X.memo (fun x -> f (GenBasic ("", x))) in
-            (fun (GenBasic (_, x)) -> memoX x)
-end;;
+        let memoX = X.memo (fun x -> f (Basic ("", x))) in
+            (fun (Basic (_, x)) -> memoX x)
+end
 
-implicit module MemoisableProd {X : Memo} {Y : Memo} : Memo with type t = (X.t, Y.t) genProd = struct
-  type t = (X.t, Y.t) genProd
+implicit module MemoisableProd {X : Memo} {Y : Memo} : Memo with type t = (X.t, Y.t) prod = struct
+  type t = (X.t, Y.t) prod
   let memo f = 
-      let memoX = X.memo (fun x -> Y.memo (fun y -> f (GenProd (x, y)))) in 
-      fun (GenProd (x, y)) -> memoX x y
-end;; 
-
+      let memoX = X.memo (fun x -> Y.memo (fun y -> f (Prod (x, y)))) in 
+      fun (Prod (x, y)) -> memoX x y
+end 
 
-implicit module MemoisableSum {X : Memo} {Y : Memo} : Memo with type t = (X.t, Y.t) genSum = struct
-  type t = (X.t, Y.t) genSum
+implicit module MemoisableSum {X : Memo} {Y : Memo} : Memo with type t = (X.t, Y.t) sum = struct
+  type t = (X.t, Y.t) sum
   let memo f = 
     let memoX = X.memo (fun x -> f (Left x)) in
     let memoY = Y.memo (fun y -> f (Right y)) in
         fun s -> match s  with
             | (Left x) -> memoX x
             | (Right y) -> memoY y
-end;;
-
+end
 
 implicit module MemoisableGeneric {X : Generic} {XRep : Memo with type t = X.rep} : Memo with type t = X.t = struct 
   type t = X.t
   let memo (f : X.t -> 'a) : X.t -> 'a = let memoXRep = XRep.memo (fun x -> f (X.fromRep x)) in 
                   fun x -> memoXRep (X.toRep x)
-end;;
+end
 
 module IntMap = Map.Make(struct 
         type t = int
         let compare = compare
-end);;
+end)
 
 implicit module MemoInt : Memo with type t = int = struct 
     type t = int
@@ -56,14 +53,12 @@ implicit module MemoInt : Memo with type t = int = struct
                 let y = f x in 
                 memoMap := IntMap.add x y !memoMap;
                 y
-end;;
-
-
+end
 
 module StrMap = Map.Make(struct 
         type t = string
         let compare = compare
-end);;
+end)
 
 implicit module MemoStr : Memo with type t = string = struct 
     type t = string
@@ -76,4 +71,4 @@ implicit module MemoStr : Memo with type t = string = struct
                 let y = f x in 
                 memoMap := StrMap.add x y !memoMap;
                 y
-end;;
+end

lib/genOrd.ml → lib/ord.ml

@@ -1,20 +1,20 @@
 open Generic
 open Imp.Data
 
-implicit module OrdGenBasic {X : Ord} : Ord with type t = X.t genBasic = struct 
-  type t = X.t genBasic
-  let compare (GenBasic (_, a)) (GenBasic (_, b)) = X.compare a b
+implicit module OrdGenBasic {X : Ord} : Ord with type t = X.t basic = struct 
+  type t = X.t basic
+  let compare (Basic (_, a)) (Basic (_, b)) = X.compare a b
 end
 
-implicit module OrdGenProd {X : Ord} {Y : Ord} : Ord with type t = (X.t, Y.t) genProd = struct 
-  type t = (X.t, Y.t) genProd
-  let compare (GenProd (a1, a2)) (GenProd (b1, b2)) =
-                  let comp = X.compare a1 b1 in
-                    if comp = EQ then Y.compare a2 b2 else comp
+implicit module OrdGenProd {X : Ord} {Y : Ord} : Ord with type t = (X.t, Y.t) prod = struct 
+  type t = (X.t, Y.t) prod
+  let compare (Prod (a1, a2)) (Prod (b1, b2)) =
+    let comp = X.compare a1 b1 in
+    if comp = EQ then Y.compare a2 b2 else comp
 end
 
-implicit module OrdGenSum {X : Ord} {Y : Ord} : Ord with type t = (X.t, Y.t) genSum = struct 
-  type t = (X.t, Y.t) genSum
+implicit module OrdGenSum {X : Ord} {Y : Ord} : Ord with type t = (X.t, Y.t) sum = struct 
+  type t = (X.t, Y.t) sum
   let compare a b = match a, b with
     | Left _, Right _ -> LT
     | Right _, Left _ -> GT

lib/show.ml

@@ -0,0 +1,24 @@
+open Imp.Show
+open Generic
+
+implicit module ShowGenBasic {X : Show} : Show with type t = X.t basic = struct 
+    type t = X.t basic
+    let show (Basic (s, x)) = s ^ " " ^ X.show x
+end
+
+implicit module ShowGenProd {X : Show} {Y : Show} : Show with type t = (X.t, Y.t) prod = struct
+  type t = (X.t, Y.t) prod
+  let show (Prod (x, y)) = X.show x ^ ", " ^ Y.show y
+end
+
+implicit module ShowGenSum {X : Show} {Y : Show} : Show with type t = (X.t, Y.t) sum = struct
+  type t = (X.t, Y.t) sum
+  let show = function
+  | (Left a) -> X.show a
+  | (Right b) -> Y.show b
+end
+
+implicit module ShowGeneric {X : Generic} {XRep : Show with type t = X.rep} : Show with type t = X.t = struct
+  type t = X.t
+  let show x = XRep.show (X.toRep x)
+end

tests/test.ml

@@ -6,20 +6,18 @@ type basicSum = L of int | R of string
 
 implicit module GenBasicSum = struct 
   type t = basicSum 
-  type rep = (int genBasic, string genBasic) genSum
+  type rep = (int basic, string basic) sum
   let toRep = function 
-                  | L x -> Left (GenBasic ("L", x))
-                  | R x -> Right (GenBasic ("R", x))
+                  | L x -> Left (Basic ("L", x))
+                  | R x -> Right (Basic ("R", x))
   let fromRep = function
-                | Left (GenBasic (_, x)) -> L x
-                | Right (GenBasic (_, x)) -> R x
+                | Left (Basic (_, x)) -> L x
+                | Right (Basic (_, x)) -> R x
 end
 
-type basicProd = P of int * string
-
 let () = 
 begin
-  let open [@warning "-33"] Generics.GenShow in
+  let open [@warning "-33"] Generics.Show in
   assert (show (L 1) = "L 1");
 end
 
@@ -29,13 +27,13 @@ type ints = L1 of int | R1 of int
 
 implicit module IntsGeneric = struct
   type t = ints
-  type rep = (int genBasic, int genBasic) genSum
-  let (toRep : ints -> (int genBasic, int genBasic) genSum) = function
-    | L1 a -> Left (GenBasic ("L1", a))
-    | R1 b -> Right (GenBasic ("R1", b))
-  let (fromRep : (int genBasic, int genBasic) genSum -> ints) = function
-    | Left (GenBasic (_, a)) -> L1 a
-    | Right (GenBasic (_,b)) -> R1 b
+  type rep = (int basic, int basic) sum
+  let (toRep : ints -> (int basic, int basic) sum) = function
+    | L1 a -> Left (Basic ("L1", a))
+    | R1 b -> Right (Basic ("R1", b))
+  let (fromRep : (int basic, int basic) sum -> ints) = function
+    | Left (Basic (_, a)) -> L1 a
+    | Right (Basic (_,b)) -> R1 b
 end
 
 let rec fib : int -> int = function 
@@ -50,6 +48,10 @@ let weirdFib : ints -> int = function
 let () =
 begin
   let m = memo weirdFib in
+  (* Dune doesn't show live output when running tests, it just prints it all at the end.
+     So, to test how fast they run, compare the times with different numbers of copies of this line.
+     (If memoisation is working, then 2 should be barely slower than 1)
+   *)
   print (m (R1 46));
   print (m (R1 46));
   print (m (R1 46));