avsm
diff --git a/‎fringe.ml‎
Lines changed: 3 additions & 2 deletions b/‎fringe.ml‎
Lines changed: 3 additions & 2 deletions
diff --git a/‎ref.ml‎
Lines changed: 8 additions & 10 deletions b/‎ref.ml‎
Lines changed: 8 additions & 10 deletions
diff --git a/‎state.ml‎
Lines changed: 4 additions & 6 deletions b/‎state.ml‎
Lines changed: 4 additions & 6 deletions
@@ -25,7 +25,8 @@ module SameFringe(E : EQUATABLE) = struct
   type nonrec tree = E.t tree
 
   (* Yielding control *)
-  effect Yield : E.t -> unit
+  type _ eff += Yield : E.t -> unit eff
+
   let yield e = perform (Yield e)
 
   (* The walk routine *)
@@ -43,7 +44,7 @@ module SameFringe(E : EQUATABLE) = struct
   let step f =
     match f () with
     | _ -> Done
-    | effect (Yield e) k -> Yielded (e, k)
+    | effect Yield e, k -> Yielded (e, k)
 
   (* The comparator "step walks" two given trees simultaneously *)
   let comparator ltree rtree =
 
@@ -52,14 +52,13 @@ module FCMBasedHeap : HEAP = functor (Cell : CELL) -> struct
   (* [EFF] declares a pair of effect names [Get] and [Set]. *)
   module type EFF = sig
     type t
-    effect Get : t
-    effect Set : t -> unit
+    type _ eff += Get : t eff | Set : t -> unit eff
   end
   (* ['a t] is the type of first-class [EFF] modules.
      The effect-name declarations in [EFF] become first-class. *)
   type 'a t = (module EFF with type t = 'a)
 
-  effect Ref : 'a -> 'a t
+  type _ eff += Ref : 'a -> 'a t unit
 
   let ref init = perform (Ref init)
   let (!) : type a. a t -> a =
@@ -72,21 +71,20 @@ module FCMBasedHeap : HEAP = functor (Cell : CELL) -> struct
   let fresh (type a) () : a t =
     (module struct
       type t = a
-      effect Get : t
-      effect Set : t -> unit
+      type _ eff += Get : t eff | Set : t -> unit eff
     end)
 
   let run main =
    try main () with
-     effect (Ref init) k ->
+     effect (Ref init), k ->
        (* trick to name the existential type introduced by the matching: *)
        (init, k) |> fun (type a) (init, k : a * (a t, _) continuation) ->
        let module E = (val (fresh (): a t)) in
        let module C = Cell(struct type t = a end) in
        let main () =
          try continue k (module E) with
-         | effect E.Get k -> continue k (C.get() : a)
-         | effect (E.Set y) k -> continue k (C.set y)
+         | effect E.Get, k -> continue k (C.get() : a)
+         | effect (E.Set y), k -> continue k (C.set y)
        in
        snd (C.run ~init main)
 end
@@ -108,15 +106,15 @@ module RecordBasedHeap : HEAP = functor (Cell : CELL) -> struct
     get : unit -> 'a;
     set : 'a -> unit;
   }
-  effect Ref : 'a -> 'a t
+  type _ eff += Ref : 'a -> 'a t eff
 
   let ref init = perform (Ref init)
   let (!) {get; _} = get()
   let (:=) {set; _} y = set y
 
   let run main =
     try main () with
-    | effect (Ref init) k ->
+    | effect (Ref init), k ->
         (init, k) |> fun (type a) ((init, k) : a * (a t, _) continuation) ->
         let open Cell(struct type t = a end) in
         snd (run ~init (fun _ -> continue k {get; set}))
 
@@ -138,8 +138,7 @@ end
 *)
 module LocalMutVar : CELL = functor (T : TYPE) -> struct
   type t = T.t
-  effect Get : t
-  effect Set : t -> unit
+  type _ eff += Get : t eff | Set : t -> unit eff
 
   let get () = perform Get
   let set y = perform (Set y)
@@ -148,8 +147,8 @@ module LocalMutVar : CELL = functor (T : TYPE) -> struct
     let var = ref init in
     match main () with
     | res -> !var, res
-    | effect Get k -> continue k (!var : t)
-    | effect (Set y) k -> var := y; continue k ()
+    | effect Get, k -> continue k (!var : t)
+    | effect (Set y), k -> var := y; continue k ()
 end
 
 
@@ -180,8 +179,7 @@ end
 *)
 module StPassing : CELL = functor (T : TYPE) -> struct
   type t = T.t
-  effect Get : t
-  effect Set : t -> unit
+  type _ eff += Get : t eff | Set : t -> unit eff
 
   let get () = perform Get
   let set y = perform (Set y)