Commits

james woodyatt committed 6ecc491

Use `Cf_dyn` instead of `Cf_flow` where possible.

Comments (0)

Files changed (10)

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2004-2010, James H. Woodyatt
+  Copyright (c) 2004-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
 type wref = Wire of int * wref Weak.t * string option
 
 type ('i, 'o, 'a) t = (('i, 'o) work, 'a) Cf_cmonad.t
-and ('i, 'o) work = (('i, 'o) state, ('i, 'o) Cf_flow.t, unit) Cf_scmonad.t
+and ('i, 'o) work = (('i, 'o) state, ('i, 'o) Cf_dyn.t, unit) Cf_scmonad.t
 and ('i, 'o) gate = (wref * (Obj.t -> ('i, 'o, unit) t)) Cf_seq.t
 and ('i, 'o) state = {
     wireN: int;
         | None ->
             Cf_scmonad.nil
         | Some (input, inputQ) ->
-            Cf_flow.readSC >>= fun i ->
+            Cf_dyn.SCM.read >>= fun i ->
             let work = input i in
             let rQ = Cf_deque.map (fun f -> f i) inputQ in
             run work rQ Cf_deque.nil
         Cf_cmonad.Op.( >>= )
             (Cf_scmonad.down (Cf_cmonad.eval m (scheduler_ Void)) state0_)
             (fun _ -> Cf_cmonad.nil)
-    end Cf_flow.nil
+    end Cf_dyn.fin
 
 let start m c =
     let work = Cf_cmonad.eval m (scheduler_ Void) in
     end >>= fun () ->
     scheduler_ Void
 
-let write x c = Cf_flow.writeSC x >>= c
+let write x c = Cf_dyn.SCM.write x >>= c
 
 let rxGet_ (Wire (_, txPtr, _) as wref) f c =
     if Weak.check txPtr 0 then begin
     let y = (y :> ('y, 'i, 'o) tx) in
     let rec loop w cc =
         match Lazy.force w with
-        | Cf_flow.Z -> cc ()
-        | Cf_flow.P (hd, tl) -> y#put hd (fun () -> loop tl cc)
-        | Cf_flow.Q f -> guard (x#get (fun i -> loop (lazy (f i)))) cc
+        | Cf_dyn.Z -> cc ()
+        | Cf_dyn.P (hd, tl) -> y#put hd (fun () -> loop tl cc)
+        | Cf_dyn.Q f -> guard (x#get (fun i -> loop (lazy (f i)))) cc
     in
     fun w ->
         start (loop w)
 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2004-2010, James H. Woodyatt
+  Copyright (c) 2004-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     joint {{:http://www.cs.chalmers.se/~hallgren/Thesis/}Ph.D. thesis}.
     
     In the context of this module, a "gadget" is a monad that evaluates into
-    a {!Cf_flow} object, capable of alternately reading from a source of input
+    a {!Cf_dyn} object, capable of alternately reading from a source of input
     values and writing to a sink of output values.  The continuation monad is
     specialized over an abstract "work" monad type, and a scheduler handles
     the calls and jumps between multiple simultaneous work units, communicating
     a "wire".
     
     The abstract work monad is a kind of state-continuation monad for
-    operations over the internal {!Cf_flow} value.  The operations it supports
+    operations over the internal {!Cf_dyn} value.  The operations it supports
     are lifted into the gadget monad, and they are summarized as follows:
     
     {ul
 (** {6 Types} *)
 
 (** An functionally compositional work unit in a gadget, encapsulating the
-    state-continuation monad for the underlying {!Cf_flow} object.
+    state-continuation monad for the underlying {!Cf_dyn} object.
 *)
 type ('i, 'o) work
 
 (** {6 Functions} *)
 
 (** Use [eval y] to obtain a new flow by evaluating the gadget monad [y]. *)
-val eval: ('i, 'o, unit) t -> ('i, 'o) Cf_flow.t
+val eval: ('i, 'o, unit) t -> ('i, 'o) Cf_dyn.t
 
 (** Use [start y] to start a new gadget evaluating the gadget [y]. *)
 val start: ('i, 'o, unit) t -> ('i, 'o, unit) t
     to the flow (copying it from the [rx] object).
 *)
 val wrap:
-    ('x, 'i, 'o) #rx -> ('y, 'i, 'o) #tx -> ('x, 'y) Cf_flow.t ->
+    ('x, 'i, 'o) #rx -> ('y, 'i, 'o) #tx -> ('x, 'y) Cf_dyn.t ->
     ('i, 'o, unit) t
 
 (** Use [inherit \['i, 'o\] next] to derive a class that implements an

cf/cf_state_gadget.ml

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2004-2010, James H. Woodyatt
+  Copyright (c) 2004-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     if Queue.is_empty k.k_writeQ_ then
         if Queue.is_empty k.k_workQ_ then
             if Queue.is_empty k.k_readQ_ then
-                Cf_flow.Z
+                Cf_dyn.Z
             else
                 let q = Queue.take k.k_readQ_ in
-                Cf_flow.Q (fun i -> q i; scheduler_ k)
+                Cf_dyn.Q (fun i -> q i; scheduler_ k)
         else
             let () = Queue.take k.k_workQ_ k in
             scheduler_ k
     else
-        Cf_flow.P (Queue.take k.k_writeQ_, lazy (scheduler_ k))
+        Cf_dyn.P (Queue.take k.k_writeQ_, lazy (scheduler_ k))
 
 type ('s, 'i, 'o) work = ('i, 'o) kernel -> ('s -> unit) -> 's -> unit
 type ('s, 'i, 'o) gate = ('s -> (Obj.t, 'i, 'o) gate0) Cf_seq.t
     let y = (y :> ('y, 'i, 'o) tx) in
     let rec loop w =
         match Lazy.force w with
-        | Cf_flow.Z ->
+        | Cf_dyn.Z ->
             Cf_cmonad.nil
-        | Cf_flow.P (hd, tl) ->
+        | Cf_dyn.P (hd, tl) ->
             y#put hd >>= fun () ->
             loop tl
-        | Cf_flow.Q f ->
+        | Cf_dyn.Q f ->
             guard (x#get (fun obj -> loop (lazy (f obj))))
     in
     fun w ->

cf/cf_state_gadget.mli

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2004-2010, James H. Woodyatt
+  Copyright (c) 2004-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     joint {{:http://www.cs.chalmers.se/~hallgren/Thesis/}Ph.D. thesis}.
     
     In the context of this module, a "gadget" is a monad that evaluates into
-    a {!Cf_flow} object, capable of alternately reading from a source of input
+    a {!Cf_dyn} object, capable of alternately reading from a source of input
     values and writing to a sink of output values.  The continuation monad is
     specialized over an abstract "process" monad type, and a scheduler handles
     the calls and jumps between multiple simultaneous processes communicating
     a "wire".
     
     The abstract process monad is a kind of state-continuation monad for
-    operations over the internal {!Cf_flow} value.  The operations it supports
+    operations over the internal {!Cf_dyn} value.  The operations it supports
     are lifted into the gadget monad, as are briefly sumamrized as follows:
     
     {ul
 (** Use [eval y s] to obtain a new flow by evaluating the gadget monad [y] with
     a state initializer of [a].
 *)
-val eval: ('s, 'i, 'o, unit) t -> 's -> ('i, 'o) Cf_flow.t
+val eval: ('s, 'i, 'o, unit) t -> 's -> ('i, 'o) Cf_dyn.t
 
 (** Bind the result of [start y s] to start a new process evaluating the gadget
     [y] with a state initializer [s].
     to the flow (copying it from the [rx] object).
 *)
 val wrap:
-    ('x, 'i, 'o) #rx -> ('y, 'i, 'o) #tx -> ('x, 'y) Cf_flow.t ->
+    ('x, 'i, 'o) #rx -> ('y, 'i, 'o) #tx -> ('x, 'y) Cf_dyn.t ->
     ('s, 'i, 'o, unit) t
 
 (*--- $File$ ---*)
 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2003-2010, James H. Woodyatt
+  Copyright (c) 2003-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     (*
     let rec logflow w =
         match Lazy.force w with
-        | Cf_flow.Z ->
+        | Cf_dyn.Z ->
             print_string "| Z\n";
             flush stdout;
-            Cf_flow.Z
-        | Cf_flow.P (hd, tl) ->
+            Cf_dyn.Z
+        | Cf_dyn.P (hd, tl) ->
             (* if (int_of_float hd) mod 1000 = 0 then begin *)
                 Printf.printf "| P %f\n" hd;
                 flush stdout;
             (* end; *)
-            Cf_flow.P (hd, lazy (logflow tl))
-        | Cf_flow.Q f ->
-            Cf_flow.Q begin fun i ->
+            Cf_dyn.P (hd, lazy (logflow tl))
+        | Cf_dyn.Q f ->
+            Cf_dyn.Q begin fun i ->
                 Printf.printf "| Q %d\n" i;
                 flush stdout;
                 logflow (lazy (f i))
             end
     
     let rec circuit0 =
-        Cf_flow.Q begin fun n ->
+        Cf_dyn.Q begin fun n ->
             let hd = (float_of_int n) /. 2.0 in
             let tl = Lazy.lazy_from_val circuit0 in
-            Cf_flow.P (hd, tl)
+            Cf_dyn.P (hd, tl)
         end
     *)
     
         in
         fun () -> lazy (loop 1)
     
-    open Cf_flow.Op
+    open Cf_dyn.Op
     
     let test () =
         let n = 100 in
         let o = Cf_seq.limit n (output ()) in
         let divflow = eval (gadget 0) () in
         (* let divflow = lazy (logflow divflow) in *)
-        let x = Cf_flow.to_seq (Cf_flow.of_seq i -=- divflow) in
+        let x = Cf_dyn.downseq (Cf_dyn.liftseq i -=- divflow) in
         if not (Cf_seq.equal x o) then failwith "Transform failed!"
 end
 
     (*
     let rec logflow w =
         match Lazy.force w with
-        | Cf_flow.Z ->
+        | Cf_dyn.Z ->
             print_string "| Z\n";
             flush stdout;
-            Cf_flow.Z
-        | Cf_flow.P (hd, tl) ->
+            Cf_dyn.Z
+        | Cf_dyn.P (hd, tl) ->
             (* if (int_of_float hd) mod 1000 = 0 then begin *)
                 Printf.printf "| P %f\n" hd;
                 flush stdout;
             (* end; *)
-            Cf_flow.P (hd, lazy (logflow tl))
-        | Cf_flow.Q f ->
-            Cf_flow.Q begin fun i ->
+            Cf_dyn.P (hd, lazy (logflow tl))
+        | Cf_dyn.Q f ->
+            Cf_dyn.Q begin fun i ->
                 Printf.printf "| Q %d\n" i;
                 flush stdout;
                 logflow (lazy (f i))
             end
     
     let rec circuit0 =
-        Cf_flow.Q begin fun n ->
+        Cf_dyn.Q begin fun n ->
             let hd = (float_of_int n) /. 2.0 in
             let tl = Lazy.lazy_from_val circuit0 in
-            Cf_flow.P (hd, tl)
+            Cf_dyn.P (hd, tl)
         end
     *)
     
         in
         fun () -> lazy (loop 1)
     
-    open Cf_flow.Op
+    open Cf_dyn.Op
     
     let test () =
         let n = 100 in
         let o = Cf_seq.limit n (output ()) in
         let divflow = eval (gadget ()) in
         (* let divflow = lazy (logflow divflow) in *)
-        let x = Cf_flow.to_seq (Cf_flow.of_seq i -=- divflow) in
+        let x = Cf_dyn.downseq (Cf_dyn.liftseq i -=- divflow) in
         if not (Cf_seq.equal x o) then failwith "Transform failed!"
 end
 
     
     module String_set = Cf_rbtree.Set(String)
     
-    (* val memoize: (string, string) Cf_flow.t *)
+    (* val memoize: (string, string) Cf_dyn.t *)
     let memoize =
         let rec loop () =
-            Cf_flow.readSC >>= fun s ->
+            Cf_dyn.SCM.read >>= fun s ->
             Cf_scmonad.load >>= fun u ->
             if String_set.member s u then
                 loop ()
             else
                 let u = String_set.put s u in
                 Cf_scmonad.store u >>= fun () ->
-                Cf_flow.writeSC s >>= fun () ->
+                Cf_dyn.SCM.write s >>= fun () ->
                 loop ()
         in
-        Cf_flow.evalSC (loop ()) String_set.nil
+        Cf_dyn.SCM.eval (loop ()) String_set.nil
     
     (* val uniq: string list -> string list *)
     let uniq s =
         let z = Cf_seq.of_list s in
-        let z = Cf_flow.commute memoize z in
+        let z = Cf_dyn.commute memoize z in
         Cf_seq.to_list z
     
     let test () =
         let outRx = (outRx :> (unit, unit, unit) rx) in
         let inTx = (inTx :> (unit, unit, unit) tx) in
         inTx#put () >>= fun () ->
-        wrap inRx outTx Cf_flow.nop >>= fun () ->
+        wrap inRx outTx Cf_dyn.nop >>= fun () ->
         let rec loop () =
             guard begin
                 outRx#get begin fun () ->
         Gc.set { gc with Gc.stack_limit = 4 * 0x400 };
         let w = eval (gadget limit) () in
         match Lazy.force w with
-        | Cf_flow.Q f -> let _ = f () in Gc.set gc
-        | _ -> failwith "Cf_state_gadget not evaluated to Cf_flow.Q state."
+        | Cf_dyn.Q f -> let _ = f () in Gc.set gc
+        | _ -> failwith "Cf_state_gadget not evaluated to Cf_dyn.Q state."
 end
 
 module T13 = struct
         let outRx = (outRx :> (unit, unit, unit) rx) in
         let inTx = (inTx :> (unit, unit, unit) tx) in
         inTx#put () >>= fun () ->
-        wrap inRx outTx Cf_flow.nop >>= fun () ->
+        wrap inRx outTx Cf_dyn.nop >>= fun () ->
         let rec loop () =
             guard begin
                 outRx#get begin fun () ->
         Gc.set { gc with Gc.stack_limit = 4 * 0x400 };
         let w = eval (gadget limit) () in
         match Lazy.force w with
-        | Cf_flow.Q f -> let _ = f () in Gc.set gc
-        | _ -> failwith "Cf_state_gadget not evaluated to Cf_flow.Q state."
+        | Cf_dyn.Q f -> let _ = f () in Gc.set gc
+        | _ -> failwith "Cf_state_gadget not evaluated to Cf_dyn.Q state."
 end
 *)
 
 Open issues in development:
 
-+ OBSOLESCENT: Cf_flow
++ OBSOLESCENT: Cf_flow (still used by Cf_unicode and Mime_base64, which depend
+  on the obsolescent transcoding section).
 
 + (Cf_dyn): Exploring this as a refactoring of the Cf_flow module, with all new
     functions and maybe some different operators.  The serial loop composers
     are not included because their utility is unclear.  The transcoder section
     is not included because the LL(x) scanner should be used instead.
 
-+ (Cf_gadget): Still uses `Cf_flow`.
-
-+ (Cf_unicode): Still uses `Cf_flow` and relies on its transcoder section.
-
 + (Cf_seq): The tentative weave functions are probably a bad idea.  It probably
     makes more sense to unfold/weave the new Cf_llscan.t instead.
 

iom/iom_gadget.ml

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
+  Copyright (c) 2002-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     in
     let rec runloop_ p w =
         match Lazy.force w with
-        | Cf_flow.Z -> ()
-        | Cf_flow.P ((), tl) -> assert (not true); runloop_ p tl
-        | Cf_flow.Q f -> runloop_ p (lazy (f (Nx_poll.cycle p)))
+        | Cf_dyn.Z -> ()
+        | Cf_dyn.P ((), tl) -> assert (not true); runloop_ p tl
+        | Cf_dyn.Q f -> runloop_ p (lazy (f (Nx_poll.cycle p)))
     in
     fun f ->
         let p = Nx_poll.create () and q = Queue.create () in

iom/iom_gadget.mli

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
+  Copyright (c) 2002-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     [read] and [write] functions.
     
     Evaluating an I/O gadget monad results in the execution of an event loop
-    (using the [Nx_poll] module).  The underlying [Cf_flow] object conceptually
+    (using the [Nx_poll] module).  The underlying [Cf_dyn] object conceptually
     reads I/O events from the system and writes commands to wait for more.
     
     An I/O gadget monad is a continuation monad initialized with an abstract
     receive connector [a], sends event to the transmit connector [b], and
     processes the stream of input and output events with the flow [w].
 *)
-val wrap: 'i #rx -> 'o #tx -> ('i, 'o) Cf_flow.t -> unit t
+val wrap: 'i #rx -> 'o #tx -> ('i, 'o) Cf_dyn.t -> unit t
 
 (** Use [inherit next] to derive a class that implements an intermediate state
     in a machine.

mime/mime_stream.ml

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2005-2010, James H. Woodyatt
+  Copyright (c) 2005-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
         Iom_gadget.guard begin
             eventRx#get begin fun (headers, fragmentRx) ->
                 let m = headers#to_message in
-                let fragment =
-                    new Iom_octet_stream.fragment Iom_stream.More m
-                in
-                fragmentTx#put fragment >>= fun () ->
-                Iom_gadget.wrap fragmentRx fragmentTx Cf_flow.nop
+                let frag = new Iom_octet_stream.fragment Iom_stream.More m in
+                fragmentTx#put frag >>= fun () ->
+                Iom_gadget.wrap fragmentRx fragmentTx Cf_dyn.nop
             end
         end
     end >>= fun () ->
 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2003-2010, James H. Woodyatt
+  Copyright (c) 2003-2013, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
   OF THE POSSIBILITY OF SUCH DAMAGE. 
  *---------------------------------------------------------------------------*)
 
-open Cf_flow.Op
+open Cf_dyn.Op
 open Cf_llscan.Op
 open Cf_clex.Op
 
     let rec loop f c =
         let self = w_escape_ f in
         if (ch_is_unreserved_ c) or (f c) then
-            Cf_flow.P (c, self)
+            Cf_dyn.P (c, self)
         else begin
             let n = int_of_char c in
             let c1 = hex_char_of_int_ (n land 0xF) in
-            let z1 = Lazy.lazy_from_val (Cf_flow.P (c1, self)) in
+            let z1 = Lazy.lazy_from_val (Cf_dyn.P (c1, self)) in
             let c0 = hex_char_of_int_ ((n land 0xF0) lsr 4) in
-            let z0 = Lazy.lazy_from_val (Cf_flow.P (c0, z1)) in
-            Cf_flow.P ('%', z0)
+            let z0 = Lazy.lazy_from_val (Cf_dyn.P (c0, z1)) in
+            Cf_dyn.P ('%', z0)
         end
     in
     fun f ->
-        Lazy.lazy_from_val (Cf_flow.Q (loop f))
+        Lazy.lazy_from_val (Cf_dyn.Q (loop f))
 
 let rec w_unescape_ =
     let rec loop c =
         let self = w_unescape_ () in
         match c with
         | '%' ->
-            Cf_flow.Q begin fun c ->
+            Cf_dyn.Q begin fun c ->
                 let n0 = int_of_hex_char_ c in
-                Cf_flow.Q begin fun c ->
+                Cf_dyn.Q begin fun c ->
                     let n1 = int_of_hex_char_ c in
-                    Cf_flow.P (char_of_int (n0 * 16 + n1), self)
+                    Cf_dyn.P (char_of_int (n0 * 16 + n1), self)
                 end
             end
         | x ->
-            Cf_flow.P (x, self)
+            Cf_dyn.P (x, self)
     in
     fun () ->
-        Lazy.lazy_from_val (Cf_flow.Q loop)
+        Lazy.lazy_from_val (Cf_dyn.Q loop)
 
 let escape ?(allow = (fun _ -> false)) =
     let w = w_escape_ allow in
-    fun s -> Cf_seq.to_string (Cf_flow.commute w (Cf_seq.of_string s))
+    fun s -> Cf_seq.to_string (Cf_dyn.commute w (Cf_seq.of_string s))
 
 let unescape s =
-    Cf_seq.to_string (Cf_flow.commute (w_unescape_ ()) (Cf_seq.of_string s))
+    Cf_seq.to_string (Cf_dyn.commute (w_unescape_ ()) (Cf_seq.of_string s))
 
 let p_colon_ s = ?.':' s
 let p_semicolon_ s = ?.';' s