introduce omake

OCamlUtil.om

@@ -0,0 +1,25 @@
+
+public.OCamlLibrary(name, files) =
+   # XXX: JYH: these variables should be marked private in 0.9.9
+   protected.name = $(file $(name))
+
+   protected.OFILES   = $(addsuffix $(EXT_OBJ), $(files))
+   protected.CMOFILES = $(addsuffix .cmo, $(files))
+   protected.CMXFILES = $(addsuffix .cmx, $(files))
+
+   protected.CLIB      = $(file $(name)$(EXT_LIB))
+   protected.BYTELIB   = $(file $(name).cma)
+   protected.NATIVELIB = $(file $(name).cmxa)
+
+   #
+   # Link commands
+   #
+   $(BYTELIB): $(CMOFILES) $(OFILES)
+        $(OCAMLFIND) $(OCAMLLINK) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS) $(OCAMLCFLAGS) \
+                $(OCAML_LIB_FLAGS) $(OCAML_LINK_FLAGS) -a -o $@ $(OCamlLinkSort $(CMOFILES)) 
+
+   $(NATIVELIB) $(CLIB): $(CMXFILES) $(OFILES)
+        $(OCAMLFIND) $(OCAMLOPTLINK) $(LAZY_OCAMLFINDFLAGS) $(PREFIXED_OCAMLPACKS) $(OCAMLFLAGS) $(OCAMLOPTFLAGS) \
+                $(OCAML_LIB_FLAGS) $(OCAML_NATIVE_LINK_FLAGS) -a -o $(NATIVELIB) $(OCamlLinkSort $(CMXFILES))
+
+   return $(array $(if $(NATIVE_ENABLED), $(NATIVELIB)), $(if $(NATIVE_ENABLED), $(CLIB)), $(if $(BYTE_ENABLED), $(BYTELIB)))

OMakefile

@@ -0,0 +1,11 @@
+
+INSTALL_DIR = /opt/ocaml/lib/ocaml/pec
+export INSTALL_DIR
+
+OCAMLFLAGS += -thread
+
+.SUBDIRS: src
+
+.PHONY: clean
+clean:
+        rm $(filter-proper-targets $(ls R, .))

OMakeroot

@@ -0,0 +1,45 @@
+########################################################################
+# Permission is hereby granted, free of charge, to any person
+# obtaining a copy of this file, to deal in the File without
+# restriction, including without limitation the rights to use,
+# copy, modify, merge, publish, distribute, sublicense, and/or
+# sell copies of the File, and to permit persons to whom the
+# File is furnished to do so, subject to the following condition:
+#
+# THE FILE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
+# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+# IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
+# DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR
+# OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE FILE OR
+# THE USE OR OTHER DEALINGS IN THE FILE.
+
+########################################################################
+# The standard OMakeroot file.
+# You will not normally need to modify this file.
+# By default, your changes should be placed in the
+# OMakefile in this directory.
+#
+# If you decide to modify this file, note that it uses exactly
+# the same syntax as the OMakefile.
+#
+
+#
+# Include the standard installed configuration files.
+# Any of these can be deleted if you are not using them,
+# but you probably want to keep the Common file.
+#
+open build/C
+open build/OCaml
+open build/LaTeX
+
+#
+# The command-line variables are defined *after* the
+# standard configuration has been loaded.
+#
+DefineCommandVars()
+
+#
+# Include the OMakefile in this directory.
+#
+.SUBDIRS: .

src/OMakefile

@@ -0,0 +1,26 @@
+########################################################################
+# make pec
+
+include ../OCamlUtil.om 
+
+.PHONY: clean
+clean:
+  rm $(filter-proper-targets $(ls R, .))
+
+FILES[] =
+  pec
+  signal
+
+NATIVE_ENABLED = true
+BYTE_ENABLED = true
+
+LIB = pec
+PACKNAME = Pec
+OCAMLPPFLAGS = 
+OCAMLFLAGS += -thread -w -13 -for-pack $(capitalize $(LIB))
+OCAMLCFLAGS += -dtypes 
+OCAMLDEPFLAGS += $(OCAMLPPFLAGS)
+OCAML_LINK_FLAGS += 
+OCAML_NATIVE_LINK_FLAGS += 
+
+.DEFAULT: $(OCamlLibrary $(LIB), $(FILES))

signal.ml → src/signal.ml

@@ -24,10 +24,13 @@ type 'a signal = ('a, s) t
 type 'a event = ('a, e) t
 type 'a ievent = 'a E.event
 
+let ievent t =
+  t.event
+
 let switch t (e : 'a ievent) =
   t.switcher e
 
-let listen t f =
+let listen f t =
   E.subscribe f t.event
 
 let read (t : 'a signal) =
@@ -64,7 +67,7 @@ let return queue x =
 let run queue = 
   E.run queue
 
-module Op = struct
+module OP = struct
   let (!!) t = read t
   let (<<=) t e = switch t e
   let (<==) queue t x = put queue t x

signal.mli → src/signal.mli

@@ -8,13 +8,14 @@ type 'a ievent
 
 val make : (unit -> unit) Queue.t -> 'a event
 val return : (unit -> unit) Queue.t -> 'a -> 'a signal
+val ievent : ('a, 'b) t -> 'a ievent
 val switch : ('a, 'b) t -> 'a ievent -> unit
-val listen : ('a, 'b) t -> ('a -> unit) -> unit
+val listen : ('a -> unit) -> ('a, 'b) t -> unit
 val read : 'a signal ->  'a
 val put : (unit -> unit) Queue.t -> ('a, 'b) t -> 'a -> unit
 val run : (unit -> unit) Queue.t -> int
 
-module Op : sig
+module OP : sig
   val (!!) : 'a signal -> 'a
   val (<<=) : ('a, 'b) t -> 'a ievent -> unit
   val (<==) : (unit -> unit) Queue.t -> ('a, 'b) t -> 'a -> unit

test/eventTest.ml

@@ -1,5 +1,10 @@
 
-module E = Pec
+module E = struct
+  include Pec
+  let queue = Queue.create ()
+  let make () = make queue
+  let run () = run queue
+end
 
 let run_all () =
   while E.run () > 0 do () done

test/signalTest.ml

@@ -0,0 +1,229 @@
+
+module E = struct
+  let queue = Queue.create ()
+
+  (* module OP = struct *)
+  (*   include Signal.OP *)
+  (*   let (<==) t x = Signal.put queue t x *)
+  (* end *)
+
+  (* include (Signal : (module type of Signal with module OP := OP)) *)
+  include Signal
+
+  let make () = make queue
+  let return x = return queue x
+  let put t x = put queue t x
+  let run () = run queue
+end
+
+let run_all () =
+  while E.run () > 0 do () done
+
+let put_test () =
+  let seq = ref [] in
+  let cell = E.make () in
+  let _ = E.listen (fun v -> seq := v :: !seq) cell in
+  E.put cell 1;
+  E.put cell 2;
+  E.put cell 3;
+  E.put cell 4;
+  E.put cell 5;
+  run_all ();
+  assert ( List.rev !seq = [1;2;3;4;5])
+
+let map_test () =
+  let seq = ref [] in
+  let cell = E.make () in
+  let cell' = E.make () in
+  let _ = E.switch cell' (E.map (fun x -> x + 1) (E.ievent cell)) in
+  let _ = E.listen (fun v -> seq := v :: !seq) cell' in
+  E.put cell 1;
+  E.put cell 2;
+  run_all ();
+  assert ( List.rev !seq = [2;3])
+
+let choose_test () =
+  let seq = ref [] in
+  let cell1 = E.make () in
+  let cell2 = E.make () in
+  let cell3 = E.make () in
+  let _ = E.switch cell3 (E.choose [E.ievent cell1; E.ievent cell2]) in
+  let _ = E.listen (fun v -> seq := v :: !seq) cell3 in
+  E.put cell1 3;
+  E.put cell2 4;
+  run_all ();
+  assert ( List.rev !seq = [3;4])
+
+(* let never_test () = *)
+(*   E.subscribe (fun x -> assert false) E.never; *)
+(*   run_all () *)
+
+(* let join_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let cell2, sender2 = E.make () in *)
+(*   let cell3, sender3 = E.make () in *)
+(*   let e = E.join cell2 in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) e; *)
+(*   sender2 cell1; *)
+(*   sender1 9; *)
+(*   sender1 3; *)
+(*   sender2 cell3; *)
+(*   sender3 10; *)
+(*   sender3 11; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq = [9;3;10;11]) *)
+
+(* let scan_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let e = E.scan (fun s x -> s + x) 0 cell1 in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) e; *)
+(*   sender1 1; *)
+(*   sender1 2; *)
+(*   sender1 3; *)
+(*   sender1 4; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq = [1;3;6;10]) *)
+
+(* let filter_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let e = E.filter (fun x -> x > 0 && x < 5) cell1 in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) e; *)
+(*   sender1 ~-1; *)
+(*   sender1 1; *)
+(*   sender1 2; *)
+(*   sender1 6; *)
+(*   sender1 9; *)
+(*   sender1 3; *)
+(*   sender1 10; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq = [1;2;3]) *)
+
+(* let map2_test () = *)
+(*   let seq1 = ref [] in *)
+(*   let seq2 = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let e1 = E.map (fun x -> x + 1) cell1 in *)
+(*   let e2 = E.map (fun x -> x + 2) cell1 in *)
+(*   E.subscribe (fun v -> seq1 := v :: !seq1) e1; *)
+(*   E.subscribe (fun v -> seq2 := v :: !seq2) e2; *)
+(*   sender1 1; *)
+(*   sender1 2; *)
+(*   sender1 3; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq1 = [2;3;4]); *)
+(*   assert ( List.rev !seq2 = [3;4;5])   *)
+
+(* let jmap2_test () = *)
+(*   let seq1 = ref [] in *)
+(*   let seq2 = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let cell2, sender2 = E.make () in *)
+(*   let j = E.join cell1 in *)
+(*   let e1 = E.map (fun x -> x + 1) j in *)
+(*   let e2 = E.map (fun x -> x + 2) j in *)
+(*   E.subscribe (fun v -> seq1 := v :: !seq1) e1; *)
+(*   E.subscribe (fun v -> seq2 := v :: !seq2) e2; *)
+(*   sender1 cell2; *)
+(*   sender2 1; *)
+(*   sender2 2; *)
+(*   sender2 3; *)
+(*   let cell3, sender3 = E.make () in *)
+(*   sender1 cell3; *)
+(*   sender2 4; *)
+(*   sender3 5; *)
+(*   sender3 6; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq1 = [2;3;4;6;7]); *)
+(*   assert ( List.rev !seq2 = [3;4;5;7;8]) *)
+
+(* let bind_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let cell2, sender2 = E.make () in *)
+(*   let cell3, sender3 = E.make () in *)
+(*   let e1 = E.map (fun x -> x + 1) cell1 in *)
+(*   let e2 = E.map (fun x -> x + 2) cell2 in *)
+(*   let e3 = E.bind cell3 (fun b -> if b then e1 else e2) in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) e3; *)
+(*   sender1 1; *)
+(*   sender2 2; *)
+(*   sender3 true; *)
+(*   sender1 3; *)
+(*   sender2 4; *)
+(*   sender1 5; *)
+(*   sender2 6; *)
+(*   sender3 false; *)
+(*   sender1 7; *)
+(*   sender2 8; *)
+(*   sender1 9; *)
+(*   sender2 10; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq = [4;6;10;12]) *)
+
+(* let diamond_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let e1 = E.map (fun x -> x + 1) cell1 in *)
+(*   let e2 = E.map (fun x -> x + 2) cell1 in *)
+(*   let e3 = E.choose [e1; e2] in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) e3;   *)
+(*   sender1 1; *)
+(*   sender1 2; *)
+(*   run_all (); *)
+(*   let r = List.rev !seq in *)
+(*   assert ( r = [2;3] || r = [2; 4] || r = [3; 3] || r = [3; 4]) *)
+
+(* let zip_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   let cell2, sender2 = E.make () in *)
+(*   let e1 = E.zip cell1 cell2 in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) e1; *)
+(*   run_all (); *)
+(*   sender1 1; *)
+(*   sender2 2; *)
+(*   sender2 3; *)
+(*   sender1 4; *)
+(*   run_all (); *)
+(*   assert ( List.rev !seq = [1,2; 1,3; 4,3] ) *)
+
+(* let once_test () = *)
+(*   let seq = ref [] in *)
+(*   let cell1, sender1 = E.make () in *)
+(*   E.subscribe (fun v -> seq := v :: !seq) (E.once cell1); *)
+(*   sender1 1; *)
+(*   sender1 2; *)
+(*   sender1 3; *)
+(*   sender1 4; *)
+(*   run_all (); *)
+(*   assert ( !seq = [1] ) *)
+
+let tests =
+  [
+    "put test", put_test;
+    "map test", map_test;
+    "choose test", choose_test;
+    (* "never test", never_test; *)
+    (* "join test", join_test; *)
+    (* "scan test", scan_test; *)
+    (* "filter test", filter_test; *)
+    (* "map2 test", map2_test; *)
+    (* "jmap2 test", jmap2_test; *)
+    (* "bind test", bind_test; *)
+    (* "diamond test", diamond_test; *)
+    (* "zip test", zip_test; *)
+    (* "once test", once_test; *)
+  ]
+
+let (!%) = Printf.sprintf
+
+let _ =
+  Random.self_init ();
+  List.iter (fun (name, f) ->
+    print_string  (!%"running %s.." name);
+    f ();
+    print_string "done\n") tests
+