Commits

james woodyatt  committed 11cf8b9

Checkpoint. Major refactoring of CF library in preparation for 2.0
release is drafted.

  • Participants
  • Parent commits 6ecc491
  • Branches sideline

Comments (0)

Files changed (25)

 ### The findlib package
 PKG.=
     NAME=oni
-    VERSION=1.01
+    VERSION=2.00
     DESCRIPTION= $"Oni - assorted components for low-level networking"
 PKG=$(OCaml_findlib_package.new $(PKG))
 export PKG

File cf/OMakefile

         dfa
         regx
         clex
-        flow
         gadget
         state_gadget
         machine
-        unicode
-        parser
-    
-    # OBSOLESCENT:
-        # dfa0
-        # regex
-        # lex
-        # scan_parser
     
     primitives[]=
         common

File cf/cf_clex.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

File cf/cf_clex.mli

 (*---------------------------------------------------------------------------*
   $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

File cf/cf_dfa.ml

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (C) 2011, james woodyatt
+  Copyright (C) 2011-2013, james woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without

File cf/cf_dfa.mli

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (C) 2011, james woodyatt
+  Copyright (C) 2011-2013, james woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     type 'a r
     
     (** A parser that works on the symbols used in the automaton. *)
-    type 'a t = (S.t, 'a) Cf_parser.t
+    type 'a t = (S.t, 'a) Cf_llscan.t
     
     (** Open this module to bring the composition operators into the current
         scope.

File cf/cf_dyn.ml

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (C) 2011, james woodyatt
+  Copyright (C) 2011-2013, james woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
     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 =
     let rec get = lazy (Q put) and put x = P (f x, get)
     in get
 
+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 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 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 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
+
 let fold =
     let rec loop p q m w =
         match Lazy.force w with
     let enter a b = lazy (loop a b) 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)))
+let seqpair =
+    let rec get b f i = loop (lazy (f i)) b
+    and loop a b =
+        match Lazy.force a with
+        | Z -> Lazy.force b
+        | P (hd, tl) -> P (hd, lazy (loop tl b))
+        | Q f -> Q (get b f)
     in
-    let enter w = lazy (loop w w) in
+    let enter a b = lazy (loop a b) in
     enter
 
 let sequential =
     let enter z = lazy (start Cf_deque.nil z) in
     enter
 
-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 parallel =
     let ( -=- ) = connect in
     let enter a b =
     in
     enter
 
-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 canget w = match Lazy.force w with Q _ -> true | (P _ | Z) -> false
+
+let rec fill s w =
+    match Lazy.force w with
+    | (Z | P _) -> w
+    | Q f ->
+        match Lazy.force s with
+        | Cf_seq.Z -> w
+        | Cf_seq.P (hd, tl) -> fill tl (lazy (f hd))
+
+let rec skip w s =
+    match Lazy.force w with
+    | (Z | P _) -> s
+    | Q f ->
+        match Lazy.force s with
+        | Cf_seq.Z -> s
+        | Cf_seq.P (hd, tl) -> skip (lazy (f hd)) tl
+
+let canput w = match Lazy.force w with P _ -> true | (Q _ | Z) -> false
 
 let drain =
-    let rec loop w =
-        match Lazy.force w with
-        | P (hd, tl) -> Cf_seq.P (hd, lazy (loop tl))
+    let rec loop w = lazy (aux (Lazy.force w))
+    and aux = function
+        | P (hd, tl) -> Cf_seq.P (hd, loop tl)
         | (Z | Q _) -> Cf_seq.Z
     in
-    let enter w = lazy (loop w) in
-    enter
+    loop
 
 let flush =
     let rec loop w =
     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
 module Op = struct
     let ( -=- ) = connect
     let ( -^- ) = zip
+    let ( -&- ) = seqpair
     let ( -%- ) = parallel
+    
     let ( ~* ) s = concurrent (Cf_seq.of_list s)
     let ( ~& ) s = sequential (Cf_seq.of_list s)
 end

File cf/cf_dyn.mli

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (C) 2011, james woodyatt
+  Copyright (C) 2011-2013, james woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
   OF THE POSSIBILITY OF SUCH DAMAGE. 
  *---------------------------------------------------------------------------*)
 
+(** Lazy stream procesors and their operators. *)
+
+(** {6 Overview}
+    A [Cf_flow] value is like a [Cf_seq] value that can take intermediate input
+    to continue generating output.  Many of the other modules in the [cf]
+    library use this module.
+    
+    The semantics of this module are derived from the stream processors in the
+    Fudgets system, as described by Magnus Carlsson and Thomas Hallgren in
+    their joint {{:http://www.cs.chalmers.se/~hallgren/Thesis/}Ph.D. thesis},
+    chapter 16.
+*)
+
+(** {6 Types} *)
+
+(** A stream processor *)
 type ('i, 'o) t = ('i, 'o) s Lazy.t and ('i, 'o) s =
-    | Z
-    | P of 'o * ('i, 'o) t
-    | Q of ('i -> ('i, 'o) s)
+    | Z                         (** End of processing *)
+    | P of 'o * ('i, 'o) t      (** Output a value *)
+    | Q of ('i -> ('i, 'o) s)   (** Input a value *)
 
+(** {6 Constructors} *)
+
+(** A stream processor that reads no input and writes no output. *)
 val fin: ('i, 'o) t
 
+(** A stream processor that outputs every input value without change. *)
 val nop: ('a, 'a) t
-val select: ('a option, 'a) t
+
+(** A stream processor that flattens value sequences into values. *)
 val flat: ('a Cf_seq.t, 'a) t
 
+(** Use [filter f] to construct a stream processor that applies [f] to every
+    input value and outputs only those for which the function result is [true].
+*)
 val filter: ('a -> bool) -> ('a, 'a) t
+
+(** Use [map f] to construct a stream processor that applies [f] to every input
+    value and outputs the result.
+*)
 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 zip: ('i, 'a) t -> ('i, 'b) t -> ('i, 'a * 'b) 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
-
+(** A-tagging stream processors. *)
 module A: sig
+    
+    (** A stream processor that maps its input to its A-tagged output. *)
     val tag: ('a, ('a, 'b) Cf_either.t) t
+    
+    (** A stream processor that maps its A-tagged input to its output. *)
     val strip: (('a, 'b) Cf_either.t, 'a) t
 end
 
+(** B-tagging stream processors. *)
 module B: sig
+    
+    (** A stream processor that maps its input to its B-tagged output. *)
     val tag: ('b, ('a, 'b) Cf_either.t) t
+    
+    (** A stream processor that maps its B-tagged input to its output. *)
     val strip: (('a, 'b) Cf_either.t, 'b) t
 end
 
+(** A stream processor that converts lowercase US-ASCII characters into
+    uppercase characters.  All other characters are unchanged.
+*)
+val upcase: (char, char) t
+
+(** A stream processor that converts uppercase US-ASCII characters into
+    lowercase characters.  All other characters are unchanged.
+*)
+val dncase: (char, char) t
+
+(** Use [liftseq z] to convert a sequence into the equivalent stream processor
+    (which never ingests any input).
+*)
+val liftseq: 'o Cf_seq.t -> ('i, 'o) t
+
+(** {6 Evaluators} *)
+
+(** Use [commute w z] to produce an output sequence from a flow [w] that
+    ingests its input from the sequence [z].
+*)
+val commute: ('i, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
+
+(** Use [downseq w] to convert a stream processor [w] into the equivalent
+    sequence.  This can only work when the stream processor ingests input of
+    the [unit] type.
+*)
+val downseq: (unit, 'o) t -> 'o Cf_seq.t
+
+(** Use [fold f g v0 w] with an initial value [v0] to fold [f] and [g] over the
+    stream processor [w], by invoking [f v x] for each output state containing
+    a value [x] and with the cursor value [v], and invoking [g v] with the
+    cursor value [v] for each input state to obtain the next input and cursor
+    value.  When the stream process reaches the end of processing, the final
+    cursor value is return.
+*)
+val fold: ('r -> 'o -> 'r) -> ('r -> 'i * 'r) -> 'r -> ('i, 'o) t -> 'r
+
+(** {6 Operations} *)
+
+(** Use [connect a b] to compose the stream processors [a] and [b] in serial,
+    where the output of [a] is provided as input for [b].  See the [(-=-)]
+    binary operator.
+*)
+val connect: ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
+
+(** Use [zip a b] to compose the stream processor [a] and [b] as a zipper,
+    where the input of the resulting stream processor is provided as input in
+    parallel to both [a] and [b], and the outputs of each are combined in pairs
+    as the output of the resulting stream processor.
+*)
+val zip: ('i, 'a) t -> ('i, 'b) t -> ('i, 'a * 'b) t
+
+(** Use [seqpair a b] to compose a stream processor that first performs the work
+    of [a] then performs the work of [b].
+*)
+val seqpair: ('i, 'o) t -> ('i, 'o) t -> ('i, 'o) t
+
+(** Use [sequential s] to compose a stream processor that performs the work of
+    each stream processor in the sequence [s], each successive processor
+    started when its predecessor completes.
+*)
+val sequential: ('a, 'b) t Cf_seq.t -> ('a, 'b) t
+
+(** Use [concurrent s] to compose a stream processor that performs the work of
+    all stream processors in the sequence [s], interleaving operations on each
+    in a circular fashion.
+*)
+val concurrent: ('a, 'b) t Cf_seq.t -> ('a, 'b) t
+
+(** Use [parallel a b] to compose a stream processor that concurrently performs
+    the work of [a] and [b] provided that input and output are tagged.
+*)
 val parallel:
     ('ia, 'oa) t -> ('ib, 'ob) t ->
     (('ia, 'ib) Cf_either.t, ('oa, 'ob) Cf_either.t) t
 
-val commute: ('i, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
+(** Use [canget w] to test whether [w] is ready for input. *)
+val canget: ('i, 'o) t -> bool
+
+(** Use [fill z w] to provide the stream [z] as input to [w]. If [w] is not
+    ready for input then [z] returned without consuming any elements.
+*)
+val fill: 'i Cf_seq.t -> ('i, 'o) t -> ('i, 'o) t
+
+(** Use [skip w z] to consume all the elements in [z] that [w] is currently
+    ready to process as input.  If [w] is not ready for input, then no elements
+    will be consumed.
+*)
+val skip: ('i, 'o) t -> 'i Cf_seq.t -> 'i Cf_seq.t
+
+(** Use [canput w] to test whether [w] is ready for output. *)
+val canput: ('i, 'o) t -> bool
+
+(** Use [drain w] to produce the sequence that [w] is ready to output. If [w]
+    is not ready to output, then the empty sequence is returned.
+*)
 val drain: ('i, 'o) t -> 'o Cf_seq.t
+
+(** Use [flush w] to discard the sequence that [w] is ready to output. *)
 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
+(** {6 Monadic Composers} *)
 
-val liftseq: 'o Cf_seq.t -> ('i, 'o) t
-val downseq: (unit, 'o) t -> 'o Cf_seq.t
-
+(** Continuation monad composers *)
 module CM: sig
+    
+    (** Use [eval m] to compose a stream processor by evaluating [m]. *)
     val eval: (('i, 'o) t, unit) Cf_cmonad.t -> ('i, 'o) t
+    
+    (** Use [read] to consume input for the stream processor. *)
     val read: (('i, 'o) t, 'i) Cf_cmonad.t
+    
+    (** Use [write v] to produce output for the stream processor. *)
     val write: 'o -> (('i, 'o) t, unit) Cf_cmonad.t
 end
 
+(** State-contination monad composers *)
 module SCM: sig
+    
+    (** Use [eval m s] to compose a stream processor by evaluating [m] with
+        the initial state [s].
+    *)
     val eval: ('s, ('i, 'o) t, unit) Cf_scmonad.t -> 's -> ('i, 'o) t
+    
+    (** Use [read] to consume input for the stream processor. *)
     val read: ('s, ('i, 'o) t, 'i) Cf_scmonad.t
+    
+    (** Use [write v] to produce output for the stream processor. *)
     val write: 'o -> ('s, ('i, 'o) t, unit) Cf_scmonad.t
 end
 
+(** {6 Operators} *)
+
+(** Open this module to bring the operator functions into the current scope. *)
 module Op: sig
+    
+    (** Serial composition. *)
     val ( -=- ): ('a, 'b) t -> ('b, 'c) t -> ('a, 'c) t
+    
+    (** Zipping composition. *)
     val ( -^- ): ('i, 'a) t -> ('i, 'b) t -> ('i, 'a * 'b) t
+    
+    (** Sequential composition. *)
+    val ( -&- ): ('i, 'o) t -> ('i, 'o) t -> ('i, 'o) t
+    
+    (** Tagged parallel composition. *)
     val ( -%- ):
         ('ia, 'oa) t -> ('ib, 'ob) t ->
         (('ia, 'ib) Cf_either.t, ('oa, 'ob) Cf_either.t) t
     
+    (** Unary sequential composition. *)
     val ( ~& ): ('i, 'o) t list -> ('i, 'o) t
+    
+    (** Concurrent composition. *)
     val ( ~* ): ('i, 'o) t list -> ('i, 'o) t
 end
 

File cf/cf_either.mli

 (*---------------------------------------------------------------------------*
   $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
  *---------------------------------------------------------------------------*)
 
 (** A utility type to represent the sum of two parameter types. *)
-
 type ('a, 'b) t = A of 'a | B of 'b
 
 (*--- $File$ ---*)

File cf/cf_flow.ml

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
-  All rights reserved.
-  
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions
-  are met:
-  
-    Redistributions of source code must retain the above copyright
-    notice, this list of conditions and the following disclaimer.
-    
-    Redistributions in binary form must reproduce the above copyright
-    notice, this list of conditions and the following disclaimer in
-    the documentation and/or other materials provided with the
-    distribution
-  
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
-  OF THE POSSIBILITY OF SUCH DAMAGE. 
- *---------------------------------------------------------------------------*)
-
-type ('i, 'o) t = ('i, 'o) cell Lazy.t
-and ('i, 'o) cell = P of 'o * ('i,'o) t | Q of ('i -> ('i, 'o) cell) | Z
-
-let nil = lazy Z
-
-let rec nop = lazy (Q (fun x -> P (x, nop)))
-
-let rec filter f =
-    let rec loop x = if f x then P (x, filter f) else Q loop in
-    Lazy.lazy_from_val (Q loop)
-
-let rec map f = Lazy.lazy_from_val (Q (fun x -> P (f x, map f)))
-
-let rec optmap f =
-    let rec loop x =
-        match f x with
-        | Some y -> P (y, optmap f)
-        | None -> Q loop
-    in
-    Lazy.lazy_from_val (Q loop)
-
-let rec listmap f =
-    let rec outer x = inner (listmap f) (f x)
-    and inner w = function
-        | hd :: tl -> P (hd, lazy (inner w tl))
-        | [] -> Lazy.force w
-    in
-    Lazy.lazy_from_val (Q outer)
-
-let rec put_seq_ w s =
-    match Lazy.force s with
-    | Cf_seq.P (hd, tl) -> P (hd, lazy (put_seq_ w tl))
-    | Cf_seq.Z -> Lazy.force w
-
-let rec seqmap f =
-    let rec loop x = put_seq_ (seqmap f) (f x) in
-    Lazy.lazy_from_val (Q loop)
-
-let broadcast =
-    let rec loop fs = function
-        | hd :: tl ->
-            begin
-                match Lazy.force hd with
-                | Z -> loop fs tl
-                | P (y, next) -> P (y, lazy (loop fs (next :: tl)))
-                | Q f -> loop (f :: fs) tl
-            end
-        | [] ->
-            match fs with
-            | [] ->
-                Z
-            | fs ->
-                Q (fun x -> loop [] (List.rev_map (fun f -> lazy (f x)) fs))
-    in
-    fun ws -> lazy (loop [] ws)
-
-let rec mapstate f s =
-    lazy (Q (fun x -> let s, y = f s x in P (y, mapstate f s)))
-
-let rec machine f =
-    let loop s x =
-        match f s x with
-        | Some (s, out) -> put_seq_ (machine f s) out
-        | None -> Z
-    in
-    fun s -> lazy (Q (loop s))
-
-module Op = struct
-    let ( -*- ) =
-        let rec loop w1 w2 =
-            match Lazy.force w1 with
-            | Z -> Lazy.force w2
-            | P (hd, tl) -> P (hd, lazy (loop tl w2))
-            | Q f1 as w1cell ->
-                match Lazy.force w2 with
-                | Z -> w1cell
-                | P (hd, tl) -> P (hd, lazy (loop w1 tl))
-                | Q f2 -> Q begin fun x ->
-                    let w1 = Lazy.lazy_from_val (f1 x) in
-                    let w2 = lazy (f2 x) in
-                    loop w1 w2
-                end
-        in
-        fun w1 w2 ->
-            lazy (loop w1 w2)
-    
-    let ( -=- ) =
-        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 w1 with
-                | Z -> Z
-                | P (hd, tl) -> loop tl (lazy (f hd))
-                | Q f -> Q (fun x -> loop (Lazy.lazy_from_val (f x)) w2)
-        in
-        fun w1 w2 ->
-            lazy (loop w1 w2)
-
-    let ( -&- ) =
-        let rec loop w1 w2 =
-            match Lazy.force w1 with
-            | Z -> Lazy.force w2
-            | P (hd, tl) -> P (hd, lazy (loop tl w2))
-            | Q f -> Q (fun x -> loop (Lazy.lazy_from_val (f x)) w2)
-        in
-        fun w1 w2 ->
-            lazy (loop w1 w2)
-    
-    let rec ( ~@ ) =
-        let rec loop q w =
-            match Lazy.force w with
-            | Z -> Z
-            | P (hd, tl) -> P (hd, lazy (loop (Cf_deque.A.push hd q) tl))
-            | Q f ->
-                match Cf_deque.B.pop q with
-                | Some (hd, tl) -> loop tl (Lazy.lazy_from_val (f hd))
-                | None -> Q (fun x -> loop q (lazy (f x)))
-        in
-        fun w ->
-            lazy (loop Cf_deque.nil w)
-
-    let consA_ a = Cf_either.A a
-    let consB_ b = Cf_either.B b
-    let stripA_ = function Cf_either.A a -> Some a | _ -> None
-    let stripB_ = function Cf_either.B b -> Some b | _ -> None
-
-    let ( -+- ) s0 s1 =
-        let s0 = optmap stripA_ -=- s0 -=- map consA_ 
-        and s1 = optmap stripB_ -=- s1 -=- map consB_
-        in s0 -*- s1
-
-    let stripBorAA_ = function
-        | Cf_either.B _ as v
-        | Cf_either.A (Cf_either.A _ as v) -> Some v
-        | _ -> None
-    
-    let stripAB_ = function
-        | Cf_either.A (Cf_either.B x) -> Some x
-        | _ -> None
- 
-    let ( ~@< ) s =
-        let s' = optmap stripBorAA_ -=- s -=- map consA_ in
-        map consB_ -=- ~@ s' -=- optmap stripAB_
-
-    let pre_ = function
-        | Cf_either.B x -> Cf_either.B (Cf_either.B x)
-        | Cf_either.A (Cf_either.A x) -> Cf_either.A x
-        | Cf_either.A (Cf_either.B x) -> Cf_either.B (Cf_either.A x)
-    
-    let post_ = function
-        | Cf_either.B (Cf_either.B x) -> Cf_either.B x
-        | Cf_either.B (Cf_either.A x) -> Cf_either.A (Cf_either.A x)
-        | Cf_either.A x -> Cf_either.A (Cf_either.B x)
-
-    let ( -@- ) s1 s0 = ~@< (map pre_ -=- (s0 -+- s1) -=- map post_)
-end
-
-open Op
-
-let to_seq =
-    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
-    fun w -> lazy (loop w)
-
-let of_seq =
-    let rec loop s =
-        match Lazy.force s with
-        | Cf_seq.P (hd, tl) -> P (hd, lazy (loop tl))
-        | Cf_seq.Z -> Z
-    in
-    fun s -> lazy (loop s)
-
-let delta_ = (int_of_char 'a') - (int_of_char 'A')
-
-let upcase =
-    map begin function
-        | 'a'..'z' as c -> char_of_int ((int_of_char c) - delta_)
-        | c -> c
-    end
-
-let dncase =
-    map begin function
-        | 'A'..'Z' as c -> char_of_int ((int_of_char c) + delta_)
-        | c -> c
-    end
-
-let rec commute =
-    let rec loop w s =
-        match Lazy.force w with
-        | Z -> Cf_seq.Z
-        | P (hd, tl) -> Cf_seq.P (hd, commute tl s)
-        | Q f ->
-            match Lazy.force s with
-            | Cf_seq.P (hd, tl) -> loop (Lazy.lazy_from_val (f hd)) tl
-            | Cf_seq.Z -> Cf_seq.Z
-    in
-    fun w s ->
-        lazy (loop w s)
-
-let commute_string w s = Cf_seq.to_string (commute w (Cf_seq.of_string s))
-
-let drain =
-    let rec loop w =
-        match Lazy.force w with
-        | P (hd, tl) -> Cf_seq.P (hd, lazy (loop tl))
-        | _ -> Cf_seq.Z
-    in
-    fun w -> lazy (loop w)
-
-let flush =
-    let rec loop w =
-        match Lazy.force w with
-        | P (_, tl) -> loop tl
-        | w -> w
-    in
-    fun w -> lazy (loop w)
-
-let rec ingestor =
-    let rec loop = function
-        | None -> Z
-        | Some s ->
-            match Lazy.force s with
-            | Cf_seq.Z -> Q loop
-            | Cf_seq.P (hd, tl) -> P (hd, lazy (loop (Some tl)))
-    in
-    lazy (Q loop)
-
-let rec transcode_drain_ w =
-    match Lazy.force w with
-    | Z -> Cf_seq.Z
-    | P (hd, tl) -> Cf_seq.P (hd, lazy (transcode_drain_ tl))
-    | Q f -> transcode_drain_ (lazy (f None))
-
-let transcode =
-    let rec loop (w : ('i Cf_seq.t option, 'o) t) (s : 'i Cf_seq.t) =
-        match Lazy.force w with
-        | Z -> Cf_seq.Z
-        | P (hd, tl) -> Cf_seq.P (hd, lazy (loop tl s))
-        | Q f -> transcode_drain_ (lazy (f (Some s)))
-    in
-    fun w s ->
-        lazy (loop w s)
-
-module Transcode = struct
-    let more w s =
-        match Lazy.force w with
-        | Z -> Cf_seq.nil, w
-        | P (_, _) -> drain w, flush w
-        | Q f -> let w = lazy (f (Some s)) in drain w, flush w
-    
-    let last w =
-        match Lazy.force w with
-        | Z -> Cf_seq.nil
-        | P (_, _) -> drain w
-        | Q f -> drain (lazy (f None))
-end
-
-let finishC_ _ = Lazy.lazy_from_val Z
-let finishSC_ _ _ = Lazy.lazy_from_val Z
-
-let readC f = lazy (Q (fun a -> Lazy.force (f a)))
-let writeC o f = lazy (P (o, f ()))
-let evalC m = m finishC_
-
-let readSC f s = lazy (Q (fun a -> Lazy.force (f a s)))
-let writeSC o f s = lazy (P (o, f () s))
-let evalSC m s = m finishSC_ s
-
-(*--- $File$ ---*)

File cf/cf_flow.mli

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
-  All rights reserved.
-  
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions
-  are met:
-  
-    Redistributions of source code must retain the above copyright
-    notice, this list of conditions and the following disclaimer.
-    
-    Redistributions in binary form must reproduce the above copyright
-    notice, this list of conditions and the following disclaimer in
-    the documentation and/or other materials provided with the
-    distribution
-  
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
-  OF THE POSSIBILITY OF SUCH DAMAGE. 
- *---------------------------------------------------------------------------*)
-
-(** Lazy stream procesors and their operators. *)
-
-(** {6 Overview}
-    A [Cf_flow] value is like a [Cf_seq] value that can take intermediate input
-    to continue generating output.  Many of the other modules in the [cf]
-    library use this module.
-    
-    The semantics of this module are derived from the stream processors in the
-    Fudgets system, as described by Magnus Carlsson and Thomas Hallgren in
-    their joint {{:http://www.cs.chalmers.se/~hallgren/Thesis/}Ph.D. thesis},
-    chapter 16.
-*)
-
-(** {6 Types} *)
-
-(** A stream processor *)
-type ('i, 'o) t = ('i, 'o) cell Lazy.t
-and ('i, 'o) cell =
-    | P of 'o * ('i,'o) t           (** Output a value *)
-    | Q of ('i -> ('i, 'o) cell)    (** Input a value *)
-    | Z                             (** Finish processing stream *)
-
-(** {6 Constructors} *)
-
-(** A stream processor that reads no input and writes no output. *)
-val nil: ('y, 'x) t
-
-(** A stream processor that outputs every input value without change. *)
-val nop: ('x, 'x) t
-
-(** Use [filter f] to construct a stream processor that applies [f] to every
-    input value and outputs only those for which the function result is [true].
-*)
-val filter: ('x -> bool) -> ('x, 'x) t
-
-(** Use [map f] to construct a stream processor that applies [f] to every input
-    value and outputs the result.
-*)
-val map: ('i -> 'o) -> ('i, 'o) t
-
-(** Use [optmap f] to construct a stream processor that applies [f] to every
-    input value and outputs the result if there is one.
-*)
-val optmap: ('i -> 'o option) -> ('i, 'o) t
-
-(** Use [listmap f] to construct a stream processor that applies [f] to every
-    input value and outputs every element of the resulting list.
-*)
-val listmap: ('i -> 'o list) -> ('i, 'o) t
-
-(** Use [listmap f] to construct a stream processor that applies [f] to every
-    input value and outputs every element of the resulting sequence.
-*)
-val seqmap: ('i -> 'o Cf_seq.t) -> ('i, 'o) t
-
-(** Use [broadcast ws] to construct a stream processor that combines the input
-    and output of every stream processor in the list [ws] by first rendering
-    all the output from each stream in turn, then ingesting all the input to
-    each stream in turn, until all streams are completed.
-*)
-val broadcast: ('i, 'o) t list -> ('i, 'o) t
-
-(** Use [mapstate f s] with an initial state value [s] and a weaving function
-    [f] to construct a stream processor that weaves the state into every input
-    value to produce an output value and a new state.
-*)
-val mapstate: ('s -> 'i -> 's * 'o) -> 's -> ('i, 'o) t
-
-(** Use [machine f s] with an initial state value [s] and a weaving function
-    [f] to construct a stream processor that weaves the state into every input
-    value to produce either a sequence of values to output and a new state or
-    the end of stream processing.
-*)
-val machine: ('s -> 'i -> ('s * 'o Cf_seq.t) option) -> 's -> ('i, 'o) t
-
-(** {6 Operators} *)
-
-(** Open this module to bring the operator functions into the current scope. *)
-module Op: sig
-    (** Broadcasting parallel composition. *)
-    val ( -*- ): ('i, 'o) t -> ('i, 'o) t -> ('i, 'o) t
-    
-    (** Serial composition. *)
-    val ( -=- ): ('i, 'x) t -> ('x, 'o) t -> ('i, 'o) t
-    
-    (** Sequential composition. *)
-    val ( -&- ): ('i, 'o) t -> ('i, 'o) t -> ('i, 'o) t
-    
-    (** Tagged parallel composition. *)
-    val ( -+- ):
-      ('ia, 'oa) t -> ('ib, 'ob) t ->
-      (('ia, 'ib) Cf_either.t, ('oa, 'ob) Cf_either.t) t
-    
-    (** Serial loop composition. *)
-    val ( ~@ ): ('x, 'x) t -> ('x, 'x) t
-    
-    (** Serial loop left. *)
-    val ( ~@< ): (('x, 'i) Cf_either.t, ('x, 'o) Cf_either.t) t -> ('i, 'o) t
-    
-    (** Serial loop through right. *)
-    val ( -@- ):
-        (('o0, 'i1) Cf_either.t, ('i0, 'o1) Cf_either.t) t -> ('i0, 'o0) t ->
-        ('i1, 'o1) t
-end
-
-(** {6 Miscellaneous} *)
-
-(** Use [to_seq w] to convert a stream processor [w] into the equivalent
-    sequence.  This can only work when the stream processor ingests input of
-    the [unit] type.
-*)
-val to_seq: (unit, 'o) t -> 'o Cf_seq.t
-
-(** Use [of_seq z] to convert a sequence into the equivalent stream processor
-    (which never ingests any input).
-*)
-val of_seq: 'o Cf_seq.t -> ('i, 'o) t
-
-(** A stream processor that converts uppercase US-ASCII characters into
-    lowercase characters.  All other characters are unchanged.
-*)
-val upcase: (char, char) t
-
-(** A stream processor that converts lowercase US-ASCII characters into
-    uppercase characters.  All other characters are unchanged.
-*)
-val dncase: (char, char) t
-
-(** Use [commute w z] to produce an output sequence from a flow [w] that
-    ingests its input from the sequence [z].
-*)
-val commute: ('i, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
-
-(** Use [commute_string w s] to commute the sequence of characters in the string
-    [s] with the flow [w] and compose a new string from the resulting sequence.
-*)
-val commute_string: (char, char) t -> string -> string
-
-(** Use [drain w] to produce an output sequence comprised of all the values
-    output from the stream processor [w] until the first input is required.
-*)
-val drain: ('i, 'o) t -> 'o Cf_seq.t
-
-(** Use [flush w] to discard all the output from the flow [w] until the first
-    input is required.
-*)
-val flush: ('i, 'o) t -> ('i, 'o) t
-
-(** A stream processor that copies to its output every element of its input
-    sequences.  The stream processor finishes when it ingests [None].
-    
-    This stream processor is helpful for placing at the end of a serial
-    composition to produce a transcoder.
-*)
-val ingestor: ('a Cf_seq.t option, 'a) t
-
-(** Use [transcode w z] to produce the sequence of output values obtained by
-    executing the transcoder stream processor [w] to ingest every element of
-    the sequence [z].
-*)
-val transcode: ('i Cf_seq.t option, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
-
-(** A namespace for the [more] and [last] transcoder functions. *)
-module Transcode: sig
-    (** Use [more w z] to produce an intermediate sequence of output values
-        obtained by executing the transcoder stream processor [w] to ingest all
-        the elements of the sequence [z].  Returns the intermediate output
-        sequence and a new transcoder stream processor representing the
-        intermediate state of the transcoder, as it is now ready for ingesting
-        more input or its "end of input" indication.
-    *)
-    val more:
-        ('i Cf_seq.t option, 'o) t -> 'i Cf_seq.t ->
-        'o Cf_seq.t * ('i Cf_seq.t option, 'o) t
-    
-    (** Use [last w z] to produce the final sequence of output values obtained
-        by executing the transcoder stream processor [w] after ingesting the
-        "end of input" indication.
-    *)
-    val last: ('i Cf_seq.t option, 'o) t -> 'o Cf_seq.t
-end
-
-(** {6 Monad Functions} *)
-
-(** The continuation monad that returns a value obtained from the flow produced
-    by its evaluation.
-*)
-val readC: (('i, 'o) t, 'i) Cf_cmonad.t
-
-(** Use [writeC x] to compose a continuation monad that puts [x] into the
-    flow produced by evaluation and returns the unit value.
-*)
-val writeC: 'o -> (('i, 'o) t, unit) Cf_cmonad.t
-
-(** Use [evalC m] to evaluate the continuation monad [m], computing the
-    encapsulated flow.
-*)
-val evalC: (('i, 'o) t, unit) Cf_cmonad.t -> ('i, 'o) t
-
-(** The state-continuation monad that returns a value obtained from the flow
-    produced by its evaluation.
-*)
-val readSC: ('s, ('i, 'o) t, 'i) Cf_scmonad.t
-
-(** Use [writeSC x] to compose a state-continuation monad that puts [x] into
-    the flow produced by evaluation and returns the unit value.
-*)
-val writeSC: 'o -> ('s, ('i, 'o) t, unit) Cf_scmonad.t
-
-(** Use [evalSC m s] to evaluate the state-continuation monad [m] with the
-    initial state [s], computing the encapsulated flow.
-*)
-val evalSC: ('s, ('i, 'o) t, unit) Cf_scmonad.t -> 's -> ('i, 'o) t
-
-(*--- $File$ ---*)

File cf/cf_parser.ml

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
-  All rights reserved.
-  
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions
-  are met:
-  
-    Redistributions of source code must retain the above copyright
-    notice, this list of conditions and the following disclaimer.
-    
-    Redistributions in binary form must reproduce the above copyright
-    notice, this list of conditions and the following disclaimer in
-    the documentation and/or other materials provided with the
-    distribution
-  
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
-  OF THE POSSIBILITY OF SUCH DAMAGE. 
- *---------------------------------------------------------------------------*)
-
-type ('s, 'a) t = 's Cf_seq.t -> ('a * 's Cf_seq.t) option
-
-exception Error
-
-let nil _ = None
-
-let err_aux_ _ = Error
-
-let err ?(f = err_aux_) () s = raise (f s)
-
-let req ?f p s = match p s with None -> err ?f () s | x -> x
-
-let fin s =
-    match Lazy.force s with
-    | Cf_seq.Z -> Some ((), s)
-    | _ -> None
-
-let rec alt a s =
-    match a with
-    | [] -> None
-    | hd :: tl ->
-        match hd s with
-        | None -> alt tl s
-        | v -> v
-
-let rec altz pz s =
-    match Lazy.force pz with
-    | Cf_seq.Z -> None
-    | Cf_seq.P (hd, tl) ->
-        match hd s with
-        | None -> altz tl s
-        | v -> v
-
-let sat f s =
-    match Lazy.force s with
-    | Cf_seq.P (i, tl) when f i -> Some (i, tl)
-    | _ -> None
-
-let tok f s =
-    match Lazy.force s with
-    | Cf_seq.Z -> None
-    | Cf_seq.P (hd, tl) ->
-        match f hd with
-        | None -> None
-        | Some x -> Some (x, tl)
-
-let lit k x =
-    let klen = String.length k in
-    let rec loop i s =
-        if i < klen then
-            match Lazy.force s with
-            | Cf_seq.P (hd, tl) when String.unsafe_get k i = hd ->
-                loop (succ i) tl
-            | _ ->
-                None
-        else
-            Some (x, s)
-    in
-    fun s ->
-        loop 0 s
-
-let rec unfold p s =
-    lazy begin
-        match p s with
-        | None -> Cf_seq.Z
-        | Some (x, s) -> Cf_seq.P (x, unfold p s)
-    end
-
-class ['a] cursor init =
-    object
-        val position_: int = init
-        
-        method advance (_: 'a) = {< position_ = succ position_ >}
-        method position = position_
-    end
-
-module type X = sig
-    type ('c, 'i, 'o) t = 'z Cf_seq.t -> ('o * 'z Cf_seq.t) option
-        constraint 'z = 'i * 'c
-        constraint 'c = 'x #cursor
-
-    exception Error of int
-
-    val err: ?f:(('i * 'c) Cf_seq.t -> exn) -> unit -> ('c, 'i, 'o) t
-    val req: ?f:(('i * 'c) Cf_seq.t -> exn) -> ('c, 'i, 'o) t -> ('c, 'i, 'o) t
-    val sat: ('i -> bool) -> ('c, 'i, 'i) t
-    val tok: ('i -> 'o option) -> ('c, 'i, 'o) t
-    val lit: string -> 'o -> ('c, char, 'o) t
-    
-    val weave: c:('i #cursor as 'c) -> 'i Cf_seq.t -> ('i * 'c) Cf_seq.t
-    val unfold: ('c, 'i, 'o) t -> ('i * 'c) Cf_seq.t -> ('o * 'c) Cf_seq.t
-end
-
-module X: X = struct
-    type ('c, 'i, 'o) t = 'z Cf_seq.t -> ('o * 'z Cf_seq.t) option
-        constraint 'z = 'i * 'c
-        constraint 'c = 'x #cursor
-    
-    exception Error of int
-    
-    let err_aux_ s =
-        Error begin
-            match Lazy.force s with
-            | Cf_seq.Z -> (-1)
-            | Cf_seq.P ((_, c), _) -> c#position
-        end
-    
-    let err ?(f = err_aux_) () s = raise (f s)
-    
-    let req ?f p s = match p s with None -> err ?f () s | x -> x
-    
-    let sat f s =
-        match Lazy.force s with
-        | Cf_seq.P ((i, _), tl) when f i -> Some (i, tl)
-        | _ -> None
-    
-    let tok f s =
-        match Lazy.force s with
-        | Cf_seq.Z -> None
-        | Cf_seq.P ((hd, _), tl) ->
-            match f hd with
-            | None -> None
-            | Some x -> Some (x, tl)
-    
-    let lit k x =
-        let klen = String.length k in
-        let rec loop i s =
-            if i < klen then
-                match Lazy.force s with
-                | Cf_seq.P ((hd, _), tl) when String.unsafe_get k i = hd ->
-                    loop (succ i) tl
-                | _ ->
-                    None
-            else
-                Some (x, s)
-        in
-        fun s ->
-            loop 0 s
-    
-    let rec weave ~c s =
-        lazy begin
-            match Lazy.force s with
-            | Cf_seq.P (hd, tl) ->
-                Cf_seq.P ((hd, c), weave ~c:(c#advance hd) tl)
-            | Cf_seq.Z ->
-                Cf_seq.Z
-        end
-    
-    let rec unfold p s =
-        lazy begin
-            match Lazy.force s with
-            | Cf_seq.Z -> Cf_seq.Z
-            | Cf_seq.P ((_, c), _) ->
-                match p s with
-                | None -> Cf_seq.Z
-                | Some (x, s) -> Cf_seq.P ((x, c), unfold p s)
-        end
-end
-
-module Op = struct
-    let ( >>= ) m f s = match m s with None -> None | Some (a, s) -> f a s
-    
-    let ( ~: ) a s = Some (a, s)
-    
-    let ( ?. ) i0 s =
-        match Lazy.force s with
-        | Cf_seq.P (i, tl) when i = i0 -> Some (i0, tl)
-        | _ -> None
-    
-    let ( ?: ) i0 s =
-        match Lazy.force s with
-        | Cf_seq.P ((i, _), tl) when i = i0 -> Some (i0, tl)
-        | _ -> None
-    
-    let ( ?/ ) p c =
-        Some (match p c with None -> None, c | Some (y, c) -> Some y, c)
-    
-    let ( ?* ) p =
-        let rec loop stack c =
-            match p c with
-            | None -> Some (List.rev stack, c)
-            | Some (x, c) -> loop (x :: stack) c
-        in
-        fun c ->
-            loop [] c
-    
-    let ( ?+ ) p = p >>= fun hd -> ?*p >>= fun tl -> ~: (hd, tl)
-    
-    let ( %= ) p q seq =
-        match Lazy.force seq with
-        | Cf_seq.Z ->
-            begin
-                match q (X.unfold p Cf_seq.nil) with
-                | None -> None
-                | Some (x, _) -> Some (x, Cf_seq.nil)
-            end
-        | Cf_seq.P ((_, c0), _) ->
-            match q (X.unfold p seq) with
-            | None -> None
-            | Some (x, seq') ->
-                let seq'' =
-                    match Lazy.force seq' with
-                    | Cf_seq.Z ->
-                        Cf_seq.nil
-                    | Cf_seq.P ((_, c1), _) ->
-                        Cf_seq.shift (c1#position - c0#position) seq
-                in
-                Some (x, seq'')
-end
-
-let rec filter f p s =
-    match p s with
-    | None -> None
-    | Some (x, s) as v -> if f x then v else filter f p s
-
-let map f p s =
-    match p s with
-    | None -> None
-    | Some (x, s) -> Some (f x, s)
-
-let rec optmap f p s =
-    match p s with
-    | None -> None
-    | Some (x, s) ->
-        match f x with
-        | None -> optmap f p s
-        | Some y -> Some (y, s)
-
-let rec to_extended_aux_ n fin s =
-    let z = Lazy.force s in
-    if fin == z then
-        n
-    else
-        match z with
-        | Cf_seq.P (_, tl) -> to_extended_aux_ (succ n) fin tl
-        | Cf_seq.Z -> assert (not true); n
-
-let to_extended p s =
-    let s0 = Cf_seq.first s in
-    match p s0 with
-    | Some (x, s1) ->
-        let fin = Lazy.force s1 in
-        Some (x, Cf_seq.shift (to_extended_aux_ 0 fin s0) s)
-    | None -> None
-
-let of_extended c p s =
-    match p (X.weave ~c s) with
-    | Some (x, s) -> Some (x, Cf_seq.first s)
-    | None -> None
-
-(*--- $File$ ---*)

File cf/cf_parser.mli

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
-  All rights reserved.
-  
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions
-  are met:
-  
-    Redistributions of source code must retain the above copyright
-    notice, this list of conditions and the following disclaimer.
-    
-    Redistributions in binary form must reproduce the above copyright
-    notice, this list of conditions and the following disclaimer in
-    the documentation and/or other materials provided with the
-    distribution
-  
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
-  OF THE POSSIBILITY OF SUCH DAMAGE. 
- *---------------------------------------------------------------------------*)
-
-(** Functional LL(x) parsing with monadic combinators. *)
-
-(** This module implements function left-shift/left-reduce parser combinators
-    using a state-exception monad over the input stream.  To evaluate a parser
-    monad is to parse an input stream.  The state monad is lifted into the
-    exception monad to facilitate backtracking.  Parsers should signal errors
-    in the input stream with ordinary Objective Caml exceptions.
-*)
-
-(** The parser monad.  A function that parses a sequence of input tokens.
-    Returns [None] if the parser does not recognize any symbols.  Otherwise
-    returns the reduced output and the remainder of the input tokens.
-*)
-type ('i, 'o) t = 'i Cf_seq.t -> ('o * 'i Cf_seq.t) option
-
-(** Generic parser error with no parameters. *)
-exception Error
-
-(** A parser that never recognizes any input, i.e. it always returns [None]. *)
-val nil: ('i, 'o) t
-
-(** Use [err ?f ()] to compose parser that applies the input token stream to
-    the optional function [f] to obtain an Objective Caml exception, then
-    raises the exception.  The default function simply raises [Error].
-*)
-val err: ?f:('i Cf_seq.t -> exn) -> unit -> ('i, 'x) t
-
-(** Use [req f p] to create a parser that requires the input stream to match
-    the parser [p] or it will be passed to the parser [err f] instead.
-*)
-val req: ?f:('i Cf_seq.t -> exn) -> ('i, 'o) t -> ('i, 'o) t
-
-(** A parser that produces the unit value when it recognizes the end of the
-    input token sequence.
-*)
-val fin: ('i, unit) t
-
-(** Use [alt plist] to create a parser that produces the output from the first
-    parser in the list [plist] that recognizes a pattern in the input.  If no
-    parser in the list recognizes a pattern, then the parser constructed by
-    this function returns [None].
-*)
-val alt: ('i, 'o) t list -> ('i, 'o) t
-
-(** Use [altz pseq] to create a parser that produces the output from the first
-    parser in the lazy sequence [pseq] that recognizes a pattern in the input.
-    If no parser in the sequence recognizes a pattern, then the parser
-    constructed by this function returns [None].
-*)
-val altz: ('i, 'o) t Cf_seq.t -> ('i, 'o) t
-
-(** Use [sat f] to create a parser that recognizes, shifts and reduces input
-    tokens for which the satisfier function [f] returns [true].
-*)
-val sat: ('i -> bool) -> ('i, 'i) t
-
-(** Use [tok f] to recognize and shift input tokens for which the tokenizer
-    function [f] reduces an output value.
-*)
-val tok: ('i -> 'o option) -> ('i, 'o) t
-
-(** Use [lit s obj] to obtain a parser on character input sequences that
-    produces the output [obj] when it recognizes the literal [s] in the input.
-*)
-val lit: string -> 'o -> (char, 'o) t
-
-(** Use [unfold p i] to create a sequence of output values recognized by
-    applying the input token sequence [i] to the parser [p] until no more
-    input is recognized.
-*)
-val unfold: ('i, 'o) t -> 'i Cf_seq.t -> 'o Cf_seq.t
-
-(** A class useful for tracking the position in the input token stream that
-    corresponds to the head of the sequence passed to a parser.  The [#cursor]
-    class type is used in the [X] module defined below.
-*)
-class ['i] cursor:
-    int ->  (** The initial position, i.e. usually zero *)
-    object('self)
-        val position_: int      (** The current position *)
-        
-        (** Use [c#advance i] to construct a new object corresponding to the
-            new input position after reading an input symbol [i].
-        *)
-        method advance: 'i -> 'self
-        
-        (** Returns the current position. *)
-        method position: int
-    end
-
-(** A module of parser extensions for working with input sequences that require
-    position information in the parse function.
-*)
-module X: sig
-    (** A parser where every token in the input sequence is accompanied by a
-        {!Cf_parser.cursor} class object.
-    *)
-    type ('c, 'i, 'o) t = 'z Cf_seq.t -> ('o * 'z Cf_seq.t) option
-        constraint 'z = 'i * 'c
-        constraint 'c = 'x #cursor
-    
-    (** Generic parser error with one positional parameter. *)
-    exception Error of int
-    
-    (** Use [err ?f ()] to compose parser that applies the input token stream
-        to the optional function [f] to obtain an Objective Caml exception,
-        then raises the exception.  The default function simply raises [Error].
-    *)
-    val err: ?f:(('i * 'c) Cf_seq.t -> exn) -> unit -> ('c, 'i, 'o) t
-    
-    (** Use [req ?f p] to create a parser that requires the input stream to
-        match the parser [p] or it will be passed to the parser [err ?f ()]
-        instead.
-    *)
-    val req: ?f:(('i * 'c) Cf_seq.t -> exn) -> ('c, 'i, 'o) t -> ('c, 'i, 'o) t
-    
-    (** Use [sat f] to create a parser that recognizes, shifts and reduces
-        input tokens for which the satisfier function [f] returns [true].
-    *)
-    val sat: ('i -> bool) -> ('c, 'i, 'i) t
-    
-    (** Use [tok f] to recognize and shift input tokens for which the tokenizer
-        function [f] reduces an output value.
-    *)
-    val tok: ('i -> 'o option) -> ('c, 'i, 'o) t
-    
-    (** Use [lit s obj] to obtain a parser on character input sequences that
-        produces the output [obj] when it recognizes the literal [s] in the
-        input.
-    *)
-    val lit: string -> 'o -> ('c, char, 'o) t
-    
-    (** Use [weave ~c i] with an initial cursor [c] and an input sequence [i]
-        to create an input sequence with accompanying cursor.
-    *)
-    val weave: c:('i #cursor as 'c) -> 'i Cf_seq.t -> ('i * 'c) Cf_seq.t
-    
-    (** Use [unfold p i] to create a sequence of output values recognized by
-        applying the input token sequence [i] to the parser [p] until no more
-        input is recognized.  The cursor objects in the output sequence
-        elements correspond to the positions of the input sequence at the start
-        of where the output was recognized.
-    *)
-    val unfold: ('c, 'i, 'o) t -> ('i * 'c) Cf_seq.t -> ('o * 'c) Cf_seq.t
-end
-
-(** Open this module to take the parser operators into the current scope. *)
-module Op: sig
-    
-    (** The binding operator.  Use [p >>= f] to compose a parser that passes
-        output of parser [p] to the bound function [f] which returns the parser
-        for the next symbol in a parsing rule.
-    *)
-    val ( >>= ): ('i, 'a) t -> ('a -> ('i, 'b) t) -> ('i, 'b) t
-    
-    (** The return operator.  Use [~:obj] to create a parser that produces the
-        value [obj] as its result without processing any more input.
-    *)
-    val ( ~: ): 'o -> ('i, 'o) t
-    
-    (** The unit operator.  Use [?.token] to create a parser that recognizes
-        [token] at the head of the input stream and produces it as its output.
-    *)
-    val ( ?. ): 'i -> ('i, 'i) t
-    
-    (** The unit operator with a cursor.  Use [?:token] to create a parser that
-        recognizes [token] at the head of a position attributed input stream
-        and produces it as its output.
-    *)
-    val ( ?: ): 'i -> ('c, 'i, 'i) X.t
-    
-    (** The option operator.  Use [?/p] to create a parser that recognizes an
-        optional symbol in the input stream with the parser [p].  If the symbol
-        is recognized, its tokens are shifted and reduced as [Some obj],
-        otherwise no tokens are shifted and the reduced value is [None].
-        Parser functions created with this operator {i always} return [Some r],
-        where [r] is the reduced value, i.e. either [Some obj] or [None].
-    *)
-    val ( ?/ ): ('i, 'o) t -> ('i, 'o option) t
-    
-    (** The zero-or-more operator.  Use [?*p] to create a parser that
-        recognizes zero or more symbols in the input stream with the parser
-        [p].  The tokens of all the symbols recognized are shifted and reduced
-        as a list of objects in the order of their appearance in the input
-        stream.  Parser functions created with this operator {i always} return
-        [Some r], where [r] is the reduced list of symbols, which may be the
-        empty list if there are no symbols recognized.
-    *)
-    val ( ?* ): ('i, 'o) t -> ('i, 'o list) t
-    
-    (** The one-or-more operator.  Use [?+p] to create a parser that recognizes
-        one or more symbols in the input stream with the parser [p].  If the
-        symbols are recognized in the input stream, then their tokens are
-        shifted and reduced into a list of objects in the order of their
-        appearance in the input stream.  Otherwise, no tokens are shifted and
-        no output is reduced.
-    *)
-    val ( ?+ ): ('i, 'o) t -> ('i, 'o * 'o list) t
-    
-    (** The serial composition operator.  Use [p1 %= p2] to unfold the output
-        token stream of parser [p1] and use it as the input token stream for
-        parser [p2].  This is useful in the case that [p1] is a lexical
-        analyzer created with the {!Cf_lex} module, and [p2] is a grammar that
-        operates at the level of lexical tokens output by [p1].
-    *)
-    val ( %= ): ('c, 'i, 'x) X.t -> ('c, 'x, 'o) X.t -> ('c, 'i, 'o) X.t
-end
-
-(** Use [filter f p] to produce a parser that applies [f] to each output symbol
-    of [p] and ignores all those for which the result is [false].
-*)
-val filter: ('o -> bool) -> ('i, 'o) t -> ('i, 'o) t
-
-(** Use [map f p] to produce a parser that transforms each output symbol of [p]
-    by applying [f] to its value.
-*)
-val map: ('x -> 'y) -> ('i, 'x) t -> ('i, 'y) t
-
-(** Use [optmap f p] to produce a parser that transforms each output symbol of
-    [p] by applying [f] to its value and ignoring all those for which the
-    result is [None].
-*)
-val optmap: ('x -> 'y option) -> ('i, 'x) t -> ('i, 'y) t
-
-(** Use [to_extended p] to convert the parser [p] into an extended parser that
-    ignores the position information woven into the input stream.
-*)
-val to_extended: ('i, 'o) t -> ('c, 'i, 'o) X.t
-
-(** Use [of_extended c p] to convert the parser [p] that requires position
-    information in the input stream into a parser that assumes the input begins
-    at the position of the cursor [c].
-*)
-val of_extended: ('i #cursor as 'c) -> ('c, 'i, 'o) X.t -> ('i, 'o) t
-
-(*--- $File$ ---*)

File cf/cf_regx.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

File cf/cf_regx.mli

 (*---------------------------------------------------------------------------*
   $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

File cf/cf_seq.ml

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
+  Copyright (c) 2002-2011, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
         | _, _ -> Z
     end
 
-let rec weave f c s =
-    lazy begin
-        match Lazy.force s with
-        | P (hd, tl) -> let c, hd = f c hd in P (hd, weave f c tl)
-        | Z -> Z
-    end
-
-let rec optweave =
-    let rec loop f c s =
-        match Lazy.force s with
-        | Z -> Z
-        | P (hd, tl) ->
-            let c, hd = f c hd in
-            match hd with
-            | Some hd -> P (hd, lazy (loop f c tl))
-            | None -> loop f c tl
-    in
-    let start f c s = lazy (loop f c s) in
-    start
-
 let rec iterate2 f s0 s1 =
     match Lazy.force s0, Lazy.force s1 with
     | P (hd1, tl1), P (hd2, tl2) -> f hd1 hd2; iterate2 f tl1 tl2
     fun f s1 s2 ->
         lazy (outer f s1 s2)
 
-let rec weave2 =
-    let rec loop f c s1 s2 =
-        match Lazy.force s1, Lazy.force s2 with
-        | P (hd1, tl1), P (hd2, tl2) ->
-            let c, hd3 = f c hd1 hd2 in P (hd3, lazy (loop f c tl1 tl2))
-        | _, _ ->
-            Z
-    in
-    let start f c sa sb = lazy (loop f c sa sb) in
-    start
-
-let rec optweave2 =
-    let rec loop f c s1 s2 =
-        match Lazy.force s1, Lazy.force s2 with
-        | P (hd1, tl1), P (hd2, tl2) ->
-            let c, v = f c hd1 hd2 in begin
-                match v with
-                | Some hd -> P (hd, lazy (loop f c tl1 tl2))
-                | None -> loop f c tl1 tl2
-            end
-        | _, _ ->
-            Z
-    in
-    let start f c s1 s2 = lazy (loop f c s1 s2) in
-    start
-
 let rec of_channel c =
     lazy (try P (input_char c, of_channel c) with End_of_file -> Z)
 

File cf/cf_seq.mli

 (*---------------------------------------------------------------------------*
   $Change$
-  Copyright (c) 2002-2010, James H. Woodyatt
+  Copyright (c) 2002-2011, James H. Woodyatt
   All rights reserved.
   
   Redistribution and use in source and binary forms, with or without
 *)
 val combine: 'a t -> 'b t -> ('a * 'b) t
 
-(** [weave f c s] returns the sequence composed by applying each element of [s]
-    to [f] along with the initial value [c] for the first element and the
-    first part of the result of the previous application for each succeeding
-    element in [s].  The second part of the result of applying [f] is produced
-    in the output sequence.
-*)
-val weave: ('c -> 'a -> 'c * 'b) -> 'c -> 'a t -> 'b t
-
-(** [optweave f c s] returns the sequence composed by applying each element of
-    [s] to [f] along with the initial value [c] for the first element and the
-    first part of the result of the previous application for each succeeding
-    element in [s].  The second part of the result of applying [f], when not
-    [None], is produced in the output sequence.
-*)
-val optweave: ('c -> 'a -> 'c * 'b option) -> 'c -> 'a t -> 'b t
-
 (** [iterate2 f a b] is like [iterate f s], except it operates on a pair of
     sequences simultaneously, until one or both sequences reaches its end.
 *)
 *)
 val seqmap2: ('a -> 'b -> 'c t) -> 'a t -> 'b t -> 'c t
 
-(** [weave2 f c a b] is like [weave f c s], except it operates on a pair of
-    sequences simulataneously, until one or both sequences reaches its end.
-*)
-val weave2: ('x -> 'a -> 'b -> 'x * 'c) -> 'x -> 'a t -> 'b t -> 'c t
-
-(** [optweave2 f c a b] is like [optweave f c s], except it operates on a pair
-    of sequences simulataneously, until one or both sequences reaches its end.
-*)
-val optweave2: ('x -> 'a -> 'b -> 'x * 'c option) -> 'x -> 'a t -> 'b t -> 'c t
-
 (** [of_channel c] returns the sequence of characters produced by reading them
     on demand from the channel [c].  (Note: this means that dueling [char t]
     sequences reading from the same [in_channel] object may interfere with one

File cf/cf_unicode.ml

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (c) 2003-2010, James H. Woodyatt
-  All rights reserved.
-  
-  Redistribution and use in source and binary forms, with or without
-  modification, are permitted provided that the following conditions
-  are met:
-  
-    Redistributions of source code must retain the above copyright
-    notice, this list of conditions and the following disclaimer.
-    
-    Redistributions in binary form must reproduce the above copyright
-    notice, this list of conditions and the following disclaimer in
-    the documentation and/or other materials provided with the
-    distribution
-  
-  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-  ``AS IS'' AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-  LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS
-  FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE
-  COPYRIGHT HOLDERS OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
-  INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
-  (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
-  SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-  HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-  STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
-  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
-  OF THE POSSIBILITY OF SUCH DAMAGE. 
- *---------------------------------------------------------------------------*)
-
-module type Endian_T = sig
-    val to_ucs2: char -> char -> int
-    val of_ucs2: int -> char * char
-end
-
-module Endian_be: Endian_T = struct
-    let to_ucs2 c0 c1 =
-        let c0 = int_of_char c0 and c1 = int_of_char c1 in
-        (c0 lsr 8) lor c1
-    
-    let of_ucs2 n =
-        let c1 = char_of_int (n land 0xFF) in
-        let n = n lsr 8 in
-        let c0 = char_of_int (n land 0xFF) in
-        c0, c1
-end
-
-module Endian_le: Endian_T = struct
-    let to_ucs2 c0 c1 =
-        let c0 = int_of_char c0 and c1 = int_of_char c1 in
-        (c1 lsr 8) lor c0
-    
-    let of_ucs2 n =
-        let c0 = char_of_int (n land 0xFF) in
-        let n = n lsr 8 in
-        let c1 = char_of_int (n land 0xFF) in
-        c0, c1
-end
-
-module type Encoding_T = sig
-    val to_ucs4: (char Cf_seq.t option, int) Cf_flow.t
-    val of_ucs4: (int, char) Cf_flow.t
-end
-
-module E_utf8: Encoding_T = struct
-    let to_ucs4 =
-        let rec state0 sopt =
-            match sopt with
-            | None ->
-                Cf_flow.Z
-            | Some seq ->
-                match Lazy.force seq with
-                | Cf_seq.Z ->
-                    Cf_flow.Q state0
-                | Cf_seq.P (hd, tl) ->
-                    let c = int_of_char hd in
-                    let tl = Some tl in
-                    if c < 0b11000000 || c >= 0b11111110 then
-                        let hd = if c < 0b10000000 then c else 0xFFFD in
-                        Cf_flow.P (hd, lazy (state0 tl))
-                    else
-                        let k, x =
-                            if c < 0b11100000 then 0, (c land 0b11111)
-                            else if c < 0b11110000 then 1, (c land 0b1111)
-                            else if c < 0b11111000 then 2, (c land 0b111)
-                            else if c < 0b11111100 then 3, (c land 0b11)
-                            else 4, (c land 0b1)
-                        in
-                        state1 ~k ~x tl
-        and state1 ~k ~x sopt =
-            match sopt with
-            | None ->
-                Cf_flow.P (0xFFFD, Lazy.lazy_from_val Cf_flow.Z)
-            | Some seq as p ->
-                match Lazy.force seq with
-                | Cf_seq.Z ->
-                    Cf_flow.Q (state1 ~k ~x)
-                | Cf_seq.P (hd, tl) ->
-                    let c = int_of_char hd in
-                    if c < 0b10000000 then
-                        Cf_flow.P (0xFFFD, lazy (state0 p))
-                    else
-                        let z = Some tl in
-                        let zz = lazy (state0 z) in
-                        if c > 0b10111111 then
-                            Cf_flow.P (0xFFFD, zz)
-                        else
-                            let x = (x lsl 6) lor (c land 0b111111) in
-                            if k > 0 then
-                                let k = pred k in
-                                state1 ~k ~x z
-                            else
-                                Cf_flow.P (x, zz)
-        in
-        Lazy.lazy_from_val (Cf_flow.Q state0)
-    
-    let rec of_ucs4 =
-        lazy begin
-            let rec state0 x =
-                match x with
-                | x when x = x land 0x7f -> state1 0 0 x of_ucs4
-                | x when x = x land 0x7ff -> state1 0b11000000 1 x of_ucs4
-                | x when x = x land 0xffff -> state1 0b11100000 2 x of_ucs4
-                | x when x = x land 0xfffff -> state1 0b11110000 3 x of_ucs4
-                | x when x = x land 0x3ffffff -> state1 0b11111000 4 x of_ucs4
-                | x -> state1 0b11111100 5 x of_ucs4 (* UCS4 are 31-bit *)
-            and state1 pre n x w =
-                if n > 0 then begin
-                    let c = char_of_int ((x land 0x3f) lor 0x80) in
-                    let w = Lazy.lazy_from_val (Cf_flow.P (c, w)) in
-                    state1 pre (pred n) (x lsr 6) w
-                end
-                else begin
-                    let c = char_of_int (x lor pre) in
-                    Cf_flow.P (c, w)
-                end
-            in
-            Cf_flow.Q state0
-        end
-end
-
-module E_utf16x_create(N: Endian_T): Encoding_T = struct
-    open Cf_flow.Op
-    
-    let utf16_to_ucs2_ =
-        let rec state0 = function
-            | None -> Cf_flow.Z
-            | Some seq ->
-                match Lazy.force seq with
-                | Cf_seq.Z -> Cf_flow.Q state0
-                | Cf_seq.P (hd, tl) -> state1 ~c0:hd (Some tl)
-        and state1 ~c0 = function
-            | None ->
-                Cf_flow.P (0xFFFD, Lazy.lazy_from_val Cf_flow.Z)
-            | Some seq ->
-                match Lazy.force seq with
-                | Cf_seq.Z ->
-                    Cf_flow.Q (state1 ~c0)
-                | Cf_seq.P (hd, tl) ->
-                    Cf_flow.P (N.to_ucs2 c0 hd, lazy (state0 (Some tl)))
-        in
-        Lazy.lazy_from_val (Cf_flow.Q state0)
-    
-    let rec ucs2_to_ucs4_ =
-        lazy begin
-            let rec state0 u0 =
-                if u0 >= 0xd800 && u0 < 0xdc00 then
-                    Cf_flow.Q (state1 ~u0)
-                else
-                    let u0 = if u0 < 0xe000 then 0xfffd else u0 in
-                    Cf_flow.P (u0, ucs2_to_ucs4_)
-            and state1 ~u0 u1 =
-                let u =
-                    if u1 < 0xdc00 || u1 >= 0xe000
-                        then 0xfffd 
-                        else ((u0 land 0x3ff) lsl 10) lor (u1 land 0x3ff)
-                in
-                Cf_flow.P (u, ucs2_to_ucs4_)
-            in
-            Cf_flow.Q state0
-        end
-    
-    let to_ucs4 =
-        utf16_to_ucs2_ -=- ucs2_to_ucs4_
-    
-    let rec of_ucs4 =
-        lazy begin
-            let put x w =
-                let c0, c1 = N.of_ucs2 x in
-                Cf_flow.P (c0, Lazy.lazy_from_val (Cf_flow.P (c1, w)))
-            in
-            let rec loop x =
-                match x with
-                | x when x = (x land 0xffff) ->
-                    put x of_ucs4
-                | x when x > 0 && x < 0x110000 ->
-                    let x = x - 0x10000 in
-                    let d800 = 0xd800 lor ((x lsr 10) land 0x3ff)
-                    and dc00 = 0xdc00 lor (x land 0x3ff) in
-                    put dc00 (Lazy.lazy_from_val (put d800 of_ucs4))
-                | _ ->
-                    put 0xFFFD of_ucs4
-            in
-            Cf_flow.Q loop
-        end
-end
-
-module E_utf16be: Encoding_T = E_utf16x_create(Endian_be)
-module E_utf16le: Encoding_T = E_utf16x_create(Endian_le)
-
-let any_utf_to_ucs4 =
-    let to_ucs4_f_ x =
-        match Lazy.force E_utf8.to_ucs4 with
-        | Cf_flow.Q f -> f x
-        | _ -> assert false
-    in
-    let rec state1 = function
-        | None ->
-            Cf_flow.Z
-        | Some seq as p->
-            match Lazy.force seq with
-            | Cf_seq.Z ->
-                Cf_flow.Q state1
-            | Cf_seq.P (hd, tl) ->
-                let c = int_of_char hd in
-                if c < 0b11111110 then
-                    to_ucs4_f_ p
-                else
-                    state2 ~c0:hd (Some tl)
-    and state2 ~c0 = function
-        | None ->
-            Cf_flow.P (0xFFFD, Lazy.lazy_from_val Cf_flow.Z)
-        | Some seq ->
-            match Lazy.force seq with
-            | Cf_seq.Z ->
-                Cf_flow.Q (state2 ~c0)
-            | Cf_seq.P (hd, tl) ->
-                let c = int_of_char hd in
-                let w = Cf_flow.P (0xFFFD, lazy (to_ucs4_f_ (Some tl))) in
-                if c < 0b11111110 then
-                    w
-                else
-                    let u0 = int_of_char c0 and u1 = int_of_char hd in
-                    match u0, u1 with
-                    | 0xFE, 0xFF -> Lazy.force E_utf16be.to_ucs4
-                    | 0xFF, 0xFE -> Lazy.force E_utf16le.to_ucs4
-                    | _, _ -> w
-    in
-    Lazy.lazy_from_val (Cf_flow.Q state1)
-
-module B_utf16_create(N: Endian_T) = struct    
-    let prepend_bom w =
-        let c0, c1 = N.of_ucs2 0xFFEF in
-        lazy (Cf_flow.P (c0, lazy (Cf_flow.P (c1, w))))
-end
-
-module B_utf16be = B_utf16_create(Endian_be)
-module B_utf16le = B_utf16_create(Endian_le)
-
-let ucs4_to_utf16 = function
-    | `BE -> B_utf16be.prepend_bom E_utf16be.of_ucs4
-    | `LE -> B_utf16le.prepend_bom E_utf16le.of_ucs4
-
-module type Transcoding_T = sig
-    module E: Encoding_T
-    
-    val transcoder: (char Cf_seq.t option, char) Cf_flow.t
-    val transcode: char Cf_seq.t -> char Cf_seq.t
-    val atomic: string -> string
-end
-
-module C_create(E: Encoding_T): Transcoding_T = struct
-    open Cf_flow.Op
-    
-    module E = E
-    
-    let transcoder = E.to_ucs4 -=- E.of_ucs4
-    
-    let transcode s = Cf_flow.transcode transcoder s
-    
-    let atomic s = Cf_seq.to_string (transcode (Cf_seq.of_string s))
-end
-
-module E_utf8_to_utf16be: Encoding_T = struct
-    let to_ucs4 = E_utf8.to_ucs4
-    let of_ucs4 = ucs4_to_utf16 `BE
-end
-
-module E_utf8_to_utf16le: Encoding_T = struct
-    let to_ucs4 = E_utf8.to_ucs4
-    let of_ucs4 = ucs4_to_utf16 `LE
-end
-
-module E_utf8_to_utf16be_raw: Encoding_T = struct
-    let to_ucs4 = E_utf8.to_ucs4
-    let of_ucs4 = E_utf16be.of_ucs4
-end
-
-module E_utf8_to_utf16le_raw: Encoding_T = struct
-    let to_ucs4 = E_utf8.to_ucs4