add tests, fix heartbeat to compute sums correctly, unclear if its th…

…e correct heartbeat

bin/dune

@@ -1,4 +1,5 @@
 (executable
  (public_name heartbeat)
  (name main)
+ (link_flags -linkall)
  (libraries heartbeat))

lib/dune

@@ -1,3 +1,5 @@
 (library
- (libraries domainslib saturn)
+ (libraries ppx_mica domainslib saturn ppx_inline_test base_quickcheck ppx_quick_test core_bench)
+ (inline_tests)
+ (preprocess (pps ppx_mica ppx_deriving.show ppx_jane ppx_inline_test ppx_quick_test))
  (name heartbeat))

lib/tree.ml

@@ -1,4 +1,5 @@
-type 'a t = Empty | Node of int * 'a * 'a t * 'a t
+type t = Empty | Node of int * int * t * t
+[@@deriving show]
 
 let size = function
     | Empty -> 0
@@ -10,3 +11,15 @@ let view t =
     match t with
     | Empty -> None
     | Node (_,x,l,r) -> Some (x,l,r)
+
+let quickcheck_generator_t =
+    let open Base_quickcheck.Generator in
+    let open Let_syntax in
+    recursive_union [return empty] ~f:(
+        fun g ->  [
+            let%bind l = g in
+            let%bind r = g in
+            let%bind x = Base_quickcheck.Generator.small_positive_or_zero_int in
+            return (node x l r)
+        ]
+    )

lib/tree.mli

@@ -1,7 +1,10 @@
-type 'a t
+type t
+[@@deriving show]
 
-val empty : 'a t
-val node : 'a -> 'a t -> 'a t -> 'a t
-val size : 'a t -> int
+val empty : t
+val node : int -> t -> t -> t
+val size : t -> int
 
-val view : 'a t -> ('a * 'a t * 'a t) option
+val view : t -> (int * t * t) option
+
+val quickcheck_generator_t : t Core.Quickcheck.Generator.t

lib/tree_sum.ml

@@ -1,7 +1,64 @@
-
 module type SUM = sig
-    val sum : int Tree.t -> int
+    val sum : Tree.t -> int
 end
+include
+  struct
+    [@@@ocaml.warning "-60"]
+    module Mica =
+      struct
+        include
+          struct
+            type expr =
+              | Sum of Tree.t [@@deriving show { with_path = false }]
+            type ty =
+              | Int [@@deriving show { with_path = false }]
+            let gen_expr ty =
+              let open Core in
+                let open Quickcheck.Generator in
+                  let open Let_syntax in
+                    size >>=
+                      (fun k ->
+                         match (ty, k) with
+                         | (Int, _) ->
+                             let gen_sum =
+                               let g__001_ = Tree.quickcheck_generator_t in
+                               g__001_ >>| (fun e__002_ -> Sum e__002_) in
+                             union [gen_sum])
+            let _ = gen_expr
+          end
+        module Interpret(M:SUM) =
+          struct
+            type value =
+              | ValInt of int
+            let interp e =
+              match e with | Sum treet__003_ -> ValInt (M.sum treet__003_)
+            let _ = interp
+          end
+        include
+          struct
+            module TestHarness(M1:SUM)(M2:SUM) =
+              struct
+                module I1 = (Interpret)(M1)
+                module I2 = (Interpret)(M2)
+                open Core
+                include
+                  struct
+                    let trials = 100
+                    let test_int () =
+                      Quickcheck.test (gen_expr Int)
+                        ~trials:trials
+                        ~f:(fun e ->
+                              match ((I1.interp e), (I2.interp e)) with
+                              | (ValInt int__005_, ValInt int__004_) ->
+                                  ([%test_eq : int]) int__005_ int__004_)
+                    let _ = test_int
+                    let run_tests () = test_int ()
+                    let _ = run_tests
+                  end
+              end
+          end
+      end
+  end[@@ocaml.doc "@inline"]
 
 (*
 1. Normal Recursive tree sum.
@@ -28,7 +85,7 @@ end
 (* 3 Defunctionalized CPS'd tree sum . *)
 module CPSDefunc : SUM = struct
     type kont = Id
-        | Recur of int Tree.t * kont (* Accum (t,k) ~~ fun a -> k (a + sum x) *)
+        | Recur of Tree.t * kont (* Accum (t,k) ~~ fun a -> k (a + sum x) *)
         | Accum of int * kont (* Accum (x,k) ~~ fun a -> k (a + x)*)
     let rec apply k a =
         match k with
@@ -49,7 +106,7 @@ Sum' turns into a function int tree -> icont -> unit, which writes its result to
 *)
 
 module ICPSDefunc : SUM = struct
-    type kont = Store of int ref | Recur of int Tree.t * kont | Accum of int * kont
+    type kont = Store of int ref | Recur of Tree.t * kont | Accum of int * kont
 
     let rec apply k a =
         match k with
@@ -69,7 +126,7 @@ end
 *)
 
 module TR_ICPS_Defunc : SUM = struct
-    type kont = Store of int ref | Recur of int Tree.t * kont | Accum of int * kont
+    type kont = Store of int ref | Recur of Tree.t * kont | Accum of int * kont
     let rec apply k a =
         let k_ref = ref k in
         let a_ref = ref a in
@@ -93,7 +150,7 @@ end
 6. Inline apply into the definiton of sum'
 *)
 module Inlined_TR_ICPS_Defunc : SUM = struct
-    type kont = Store of int ref | Recur of int Tree.t * kont | Accum of int * kont
+    type kont = Store of int ref | Recur of Tree.t * kont | Accum of int * kont
     let rec sum' t k =
         match Tree.view t with
         | None ->
@@ -113,8 +170,8 @@ end
 
 (*7. compltely inlined and constant stack space. *)
 module Complete : SUM = struct
-    type kont = Store of int ref | Recur of int Tree.t * kont | Accum of int * kont
-    let rec sum' t k =
+    type kont = Store of int ref | Recur of Tree.t * kont | Accum of int * kont
+    let sum' t k =
         let t = ref t in
         let k = ref k in
         let sum_quit = ref false in
@@ -140,8 +197,8 @@ module Complete : SUM = struct
 end
 
 module CompleteLiftAcc : SUM = struct
-    type kont = Store of int ref | Recur of int Tree.t * kont | Accum of int * kont
-    let rec sum' t k =
+    type kont = Store of int ref | Recur of Tree.t * kont | Accum of int * kont
+    let sum' t k =
         let t = ref t in
         let k = ref k in
         let acc = ref 0 in
@@ -183,15 +240,18 @@ end
             else (incr beats; false)
 
 
-    type kont = Store of int ref | Recur of int Tree.t * kont | Accum of int * kont | Join of (unit T.promise)
+    type kont = Store of int ref | Recur of Tree.t * kont | Accum of int * kont | Join of (int ref) * (unit T.promise) * kont
 
     (* with uniquness this could be in-place. *)
     let [@tail_mod_cons] rec try_promote k =
         match k with
         | Store dst -> Store dst
         | Accum (n,k) -> Accum (n, try_promote k)
-        | Recur (t,k) -> Join (T.async pool (fun () -> sum' t k))
-        | Join p -> Join p
+        | Recur (t,k) -> 
+            let r = ref 0 in
+            let p = T.async pool (fun () -> sum' t (Store r)) in
+            Join (r,p,k)
+        | Join (r,p,k) -> Join (r,p,try_promote k)
 
     and sum' t k =
         let t = ref t in
@@ -212,7 +272,11 @@ end
                         k := Accum (!a_ref,k');
                         apply_quit := true
                     | Accum (x,k') -> a_ref := !a_ref + x; k := k'
-                    | Join p -> T.await pool p; apply_quit := true; sum_quit := true
+                    | Join (r,p,k') ->
+                        T.await pool p;
+                        a_ref := !a_ref + !r;
+                        k := k'
+                        (* apply_quit := true; sum_quit := true *)
                 done
             | Some (x,l,r) ->
                 t := l;
@@ -242,4 +306,44 @@ end) : SUM = struct
             x + nl + nr
 
     let sum t = T.run pool (fj_sum t)
-end
+end
+
+
+let%test_unit "Recursive/CPS" =
+    let open Mica.TestHarness(Recursive)(CPS) in
+    run_tests ()
+
+let%test_unit "Recursive/Complete" =
+    let open Mica.TestHarness(Recursive)(Complete) in
+    run_tests ()
+
+let%test_unit "Complete/CompleteLiftAcc" =
+    let open Mica.TestHarness(Complete)(CompleteLiftAcc) in
+    run_tests ()
+
+let%test_unit "Complete/Heartbeat" =
+    let module Params = struct
+        let num_domains = 4
+        let heartbeat_rate = 3
+    end in
+    let module HB = HeartbeatSum(Params) in
+    let open Mica.TestHarness(Complete)(HB) in
+    run_tests ()
+
+let%test_unit "Recursive/Heartbeat" =
+    let module Params = struct
+        let num_domains = 4
+        let heartbeat_rate = 3
+    end in
+    let module HB = HeartbeatSum(Params) in
+    let open Mica.TestHarness(Recursive)(HB) in
+    run_tests ()
+
+let%test_unit "Recursive/ForkJoin" =
+    let module Params = struct
+        let num_domains = 4
+        let fork_cutoff = 10
+    end in
+    let module HB = ForkJoinSum(Params) in
+    let open Mica.TestHarness(Recursive)(HB) in
+    run_tests ()