Commits

james woodyatt committed e6d56c1

Refactoring Cf_flow into Cf_dyn.

Comments (0)

Files changed (10)

         stdtime
         journal
         seq
+        llscan
+        fmt_llscan
+        deque
         dyn
-        deque
-        flow
         heap
         pqueue
         map
         set
         sbheap
         rbtree
-        llscan
         dfa
         regx
         clex
-        fmt_llscan
         message
+        flow
         gadget
         state_gadget
         machine
     | Q of ('i -> ('i, 'o) s)
 
 let fin = lazy Z
-(* let nil = let rec put x = P (x, get) and get = lazy (Q put) in get *)
+
+let nop =
+    let rec get = lazy (Q put) and put x = P (x, get)
+    in get
+
+let select =
+    let rec get = lazy (Q put)
+    and put = function Some x -> P (x, get) | None -> Lazy.force get
+    in get
+
+let flat =
+    let rec get = lazy (Q put)
+    and put z =
+        match Lazy.force z with
+        | Cf_seq.Z -> Lazy.force get
+        | Cf_seq.P (hd, tl) -> P (hd, lazy (put tl))
+    in get
 
 let filter f =
-    let rec init = lazy (Q get)
-    and get i = if f i then P (i, init) else Z in
-    init
+    let rec get = lazy (Q put)
+    and put x = if f x then P (x, get) else Lazy.force get
+    in get
 
-let commute =
-    let rec start w s = lazy (loop w s)
-    and loop w s =
+let map f =
+    let rec get = lazy (Q put) and put x = P (f x, get)
+    in get
+
+let fold =
+    let rec loop p q m w =
         match Lazy.force w with
-        | Z -> Cf_seq.Z
-        | P (hd, tl) -> Cf_seq.P (hd, start tl s)
+        | Z -> m
+        | P (hd, tl) -> loop p q (p m hd) tl
+        | Q f -> let x, m = q m in loop p q m (lazy (f x))
+    in
+    loop
+
+let connect =
+    let rec loop w1 w2 =
+        match Lazy.force w2 with
+        | Z -> Z
+        | P (hd, tl) -> P (hd, lazy (loop w1 tl))
         | Q f ->
-            match Lazy.force s with
-            | Cf_seq.P (hd, tl) -> loop (lazy (f hd)) tl
-            | Cf_seq.Z -> Cf_seq.Z
+            match Lazy.force w1 with
+            | Z -> Z
+            | P (hd, tl) -> loop tl (lazy (f hd))
+            | Q f -> Q (fun x -> loop (lazy (f x)) w2)
     in
-    start
+    let enter w1 w2 = lazy (loop w1 w2) in
+    enter
+
+let cyclical =
+    let rec loop w0 w =
+        match Lazy.force w with
+        | Z -> loop w0 w0
+        | P (hd, tl) -> P (hd, lazy (loop w0 tl))
+        | Q f -> Q (fun x -> loop w0 (lazy (f x)))
+    in
+    let enter w = lazy (loop w w) in
+    enter
+
+let sequential =
+    let rec loop z =
+        match Lazy.force z with
+        | Cf_seq.Z -> Z
+        | Cf_seq.P (hd, tl) -> each hd tl
+    and each w z =
+        match Lazy.force w with
+        | Z -> loop z
+        | P (x, w) -> P (x, lazy (each w z))
+        | Q f -> Q (get f z)
+    and get f z x = each (lazy (f x)) z in
+    let enter z = lazy (loop z) in
+    enter
+
+let concurrent =
+    let get f q x = Cf_deque.A.push (lazy (f x)) q in
+    let rec loop q =
+        match Cf_deque.B.pop q with
+        | None ->
+            Z
+        | Some (w, q) ->
+            match Lazy.force w with
+            | Z -> loop q
+            | P (x, w) -> P (x, lazy (loop (Cf_deque.A.push w q)))
+            | Q f -> Q (fun x -> loop (get f q x))
+    in
+    let rec start q z =
+        match Lazy.force z with
+        | Cf_seq.Z ->
+            loop q
+        | Cf_seq.P (hd, tl) ->
+            match Lazy.force hd with
+            | Z -> start q tl
+            | P (x, w) -> P (x, lazy (start (Cf_deque.A.push w q) tl))
+            | Q f -> Q (fun x -> start (get f q x) tl)
+    in
+    let enter z = lazy (start Cf_deque.nil z) in
+    enter
 
 let copy =
     let rec start w = lazy (loop w)
     in
     start
 
+module A = struct
+    open Cf_either
+    
+    let tag =
+        let rec get = lazy (Q put) and put x = P (A x, get)
+        in get
+    
+    let strip =
+        let rec get = lazy (Q put)
+        and put = function
+            | A x -> P (x, get)
+            | B _ -> Lazy.force get
+        in get
+end
+
+module B = struct
+    open Cf_either
+    
+    let tag =
+        let rec get = lazy (Q put) and put x = P (B x, get)
+        in get
+    
+    let strip =
+        let rec get = lazy (Q put)
+        and put = function
+            | A _ -> Lazy.force get
+            | B x -> P (x, get)
+        in get
+end
+
+let commute =
+    let rec start w s = lazy (loop w s)
+    and loop w s =
+        match Lazy.force w with
+        | Z -> Cf_seq.Z
+        | P (hd, tl) -> Cf_seq.P (hd, start tl s)
+        | Q f ->
+            match Lazy.force s with
+            | Cf_seq.P (hd, tl) -> loop (lazy (f hd)) tl
+            | Cf_seq.Z -> Cf_seq.Z
+    in
+    start
+
+let drain =
+    let rec loop w =
+        match Lazy.force w with
+        | P (hd, tl) -> Cf_seq.P (hd, lazy (loop tl))
+        | (Z | Q _) -> Cf_seq.Z
+    in
+    let enter w = lazy (loop w) in
+    enter
+
+let flush =
+    let rec loop w =
+        match Lazy.force w with
+        | P (_, tl) -> loop tl
+        | (Z | Q _ as w0) -> w0
+    in
+    let enter w = lazy (loop w) in
+    enter
+
+let stringcommute w s = Cf_seq.to_string (commute w (Cf_seq.of_string s))
+
+let upcase, dncase =
+    let delta = (int_of_char 'a') - (int_of_char 'A') in
+    let upcode = function
+        | 'a'..'z' as c -> char_of_int ((int_of_char c) - delta)
+        | c -> c
+    and dncode = function
+        | 'A'..'Z' as c -> char_of_int ((int_of_char c) + delta)
+        | c -> c
+    in
+    map upcode, map dncode
+
+let liftseq =
+    let rec loop z =
+        match Lazy.force z with
+        | Cf_seq.P (hd, tl) -> P (hd, lazy (loop tl))
+        | Cf_seq.Z -> Z
+    in
+    let enter z = lazy (loop z) in
+    enter
+
+let downseq =
+    let rec loop w =
+        match Lazy.force w with
+        | Z -> Cf_seq.Z
+        | P (hd, tl) -> Cf_seq.P (hd, lazy (loop tl))
+        | Q f -> loop (lazy (f ()))
+    in
+    let enter w = lazy (loop w) in
+    enter
+
+module CM = struct
+    let eval =
+        let finish_ () = fin in
+        let enter m = m finish_ in
+        enter
+    
+    let read =
+        let get f a = Lazy.force (f a) in
+        let enter f = lazy (Q (get f)) in
+        enter
+    
+    let write x f = lazy (P (x, f ()))
+end
+
+module SCM = struct
+    let eval =
+        let finish_ () _ = fin in
+        let enter m s = m finish_ s in
+        enter
+    
+    let read =
+        let get f s a = Lazy.force (f a s) in
+        let enter f s = lazy (Q (get f s)) in
+        enter
+    
+    let write x f s = lazy (P (x, f () s))
+end
+
+module Op = struct
+    let ( -=- ) = connect
+    let ( ~* ) s = concurrent (Cf_seq.of_list s)
+    let ( ~& ) s = sequential (Cf_seq.of_list s)
+end
+
 (*--- $File$ ---*)
     | P of 'o * ('i, 'o) t
     | Q of ('i -> ('i, 'o) s)
 
-val commute: ('i, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
-
 val fin: ('i, 'o) t
 
-val filter: ('i -> bool) -> ('i, 'i) t
+val nop: ('a, 'a) t
+val select: ('a option, 'a) t
+val flat: ('a Cf_seq.t, 'a) t
+
+val filter: ('a -> bool) -> ('a, 'a) t
+val map: ('i -> 'o) -> ('i, 'o) t
+val fold: ('r -> 'o -> 'r) -> ('r -> 'i * 'r) -> 'r -> ('i, 'o) t -> 'r
+
+val connect: ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
+val cyclical: ('i, 'o) t -> ('i, 'o) t
+
+val sequential: ('a, 'b) t Cf_seq.t -> ('a, 'b) t
+val concurrent: ('a, 'b) t Cf_seq.t -> ('a, 'b) t
 
 val copy: ('i, 'o) t -> ('i, 'o * 'o) t
 val fuse: ('i, 'a) t -> ('i, 'b) t -> ('i, 'a * 'b) t
 
+module A: sig
+    val tag: ('a, ('a, 'b) Cf_either.t) t
+    val strip: (('a, 'b) Cf_either.t, 'a) t
+end
+
+module B: sig
+    val tag: ('b, ('a, 'b) Cf_either.t) t
+    val strip: (('a, 'b) Cf_either.t, 'b) t
+end
+
+val commute: ('i, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
+val drain: ('i, 'o) t -> 'o Cf_seq.t
+val flush: ('i, 'o) t -> ('i, 'o) t
+
+val stringcommute: (char, char) t -> string -> string
+val upcase: (char, char) t
+val dncase: (char, char) t
+
+val liftseq: 'o Cf_seq.t -> ('i, 'o) t
+val downseq: (unit, 'o) t -> 'o Cf_seq.t
+
+module CM: sig
+    val eval: (('i, 'o) t, unit) Cf_cmonad.t -> ('i, 'o) t
+    val read: (('i, 'o) t, 'i) Cf_cmonad.t
+    val write: 'o -> (('i, 'o) t, unit) Cf_cmonad.t
+end
+
+module SCM: sig
+    val eval: ('s, ('i, 'o) t, unit) Cf_scmonad.t -> 's -> ('i, 'o) t
+    val read: ('s, ('i, 'o) t, 'i) Cf_scmonad.t
+    val write: 'o -> ('s, ('i, 'o) t, unit) Cf_scmonad.t
+end
+
+module Op: sig
+    val ( -=- ): ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
+    val ( ~& ): ('i, 'o) t list -> ('i, 'o) t
+    val ( ~* ): ('i, 'o) t list -> ('i, 'o) t
+end
+
 (*--- $File$ ---*)
         method virtual private guard: ('i, 'o, unit) guard
         
         (** Use [obj#next] to transition the state of the gadget by applying
-            {!Cf_state_gadget.guard} [self#guard].
+            [guard self#guard].
         *)
         method next: 'a. ('i, 'o, 'a) t
     end
         [ '`'; '.'; '?'; '*'; '+'; '('; ')'; '|'; '['; ']'; '^'; '$' ]
     in
     let rec loop c =
-        let w = Lazy.lazy_from_val (Cf_flow.Q loop) in
+        let w = Lazy.lazy_from_val (Cf_dyn.Q loop) in
         match c with
         | _ when List.exists (fun c' -> c == c') esc_ ->
-            let w = Lazy.lazy_from_val (Cf_flow.P (c, w)) in
-            Cf_flow.P ('`', w)
+            let w = Lazy.lazy_from_val (Cf_dyn.P (c, w)) in
+            Cf_dyn.P ('`', w)
         | _ ->
-            Cf_flow.P (c, w)
+            Cf_dyn.P (c, w)
     in
-    Lazy.lazy_from_val (Cf_flow.Q loop)
+    Lazy.lazy_from_val (Cf_dyn.Q loop)
 
 let unquote =
     let rec loop c =
-        let w = Lazy.lazy_from_val (Cf_flow.Q loop) in
+        let w = Lazy.lazy_from_val (Cf_dyn.Q loop) in
         match c with
         | '`' ->
-            Cf_flow.Q begin fun c ->
-                Cf_flow.P (c, Lazy.lazy_from_val (Cf_flow.Q loop))
+            Cf_dyn.Q begin fun c ->
+                Cf_dyn.P (c, Lazy.lazy_from_val (Cf_dyn.Q loop))
             end
         | _ ->
-            Cf_flow.P (c, w)
+            Cf_dyn.P (c, w)
     in
-    Lazy.lazy_from_val (Cf_flow.Q loop)
+    Lazy.lazy_from_val (Cf_dyn.Q loop)
 
 type t = int DFA.t
 
     that the output may be used in a regular expression to match the input
     exactly.
 *)
-val quote: (char, char) Cf_flow.t
+val quote: (char, char) Cf_dyn.t
 
 (** A character flow that unquotes all the quoted special characters in the
     input so that the output may by used in a regular expression to match the
     specified pattern.
 *)
-val unquote: (char, char) Cf_flow.t
+val unquote: (char, char) Cf_dyn.t
 
 (** Use [of_expression x] to produce a regular expression from the DFA
     expression [x].
         | Z -> Lazy.force s2
     end
 
+let rec replicate a = lazy (P (a, replicate a))
+
 let rec flatten z =
     lazy begin
         match Lazy.force z with
 *)
 val concat: 'a t -> 'a t -> 'a t
 
+(** [replicate a] returns an infinite sequence of elements replicated from [a].
+*)
+val replicate: 'a -> 'a t
+
 (** [flatten a] returns the sequence of all the elements in the sequence of
     sequences by concatenating them.
 *)
         ]
         
         let loop (a, b) =
-            let s = Cf_flow.commute_string Cf_regx.unquote b in
+            let s = Cf_dyn.stringcommute Cf_regx.unquote b in
             if s <> a then
                 failwith (Printf.sprintf "unquoting \"%s\" <> \"%s\"" s a);
-            let s = Cf_flow.commute_string Cf_regx.quote a in
+            let s = Cf_dyn.stringcommute Cf_regx.quote a in
             if s <> b then
                 failwith (Printf.sprintf "quoting \"%s\" <> \"%s\"" s b);
             ()
 + Fixed an error in the Nx_socket module where the message flags on send and
   recv calls would be passed incorrectly, with MSG_DONTWAIT applied.
 
++ Added Cf_seq.replicate.
+
 + Added Cf_seq.weave, Cf_seq.optweave and their paired cognates.  See PROBLEMS
   for related issues.
 
++ Refactored Cf_flow as Cf_dyn module.
+
 + Refactored the functional parser modules.  The Cf_llscan module now has the
   core LL(x) parsing monad.  The old X submodules in Cf_parser, Cf_dfa and
   cognates has been removed to be closer to where they make sense: in the
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.