1. james woodyatt
  2. oni

Commits

james woodyatt  committed d88baca

Finish moving aside the old Cf_dfa module to Cf_dfa0 and replacing it
with the what is currently Cf_xdfa.

  • Participants
  • Parent commits b1e66ab
  • Branches sideline

Comments (0)

Files changed (7)

File cf/OMakefile

View file
         sbheap
         rbtree
         llscan
-        xdfa
+        dfa
         regx
         clex
         fmt_llscan

File cf/cf_dfa.ml

View file
+(*---------------------------------------------------------------------------*
+  $Change$
+  Copyright (C) 2011, james 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 N_set = Cf_rbtree.Set(Cf_ordered.Int_order)
+module N_map = Cf_rbtree.Map(Cf_ordered.Int_order)
+
+external identity: 'a -> 'a = "%identity"
+
+module type Symbol = sig
+    type t and 'a map
+    val map: (t -> 'a) -> 'a map
+    val get: 'a map -> t -> 'a
+end
+
+module type T = sig
+    module S: Symbol
+    
+    type x
+    
+    val nil: x
+    
+    type 'a r
+    type 'a t = (S.t, 'a) Cf_llscan.t
+    
+    module Op: sig
+        val ( $| ): x -> x -> x
+        val ( $& ): x -> x -> x
+        
+        val ( !* ): x -> x
+        val ( !+ ): x -> x
+        val ( !? ): x -> x
+        val ( !: ): S.t -> x
+        val ( !^ ): (S.t -> bool) -> x
+        val ( !~ ): S.t Cf_seq.t -> x
+        
+        val ( $= ): x -> 'a -> 'a r
+        val ( $> ): x -> (S.t Cf_seq.t -> 'a) -> 'a r
+        val ( $@ ): x -> (int -> 'a t) -> 'a r
+        val ( !@ ): 'a r list -> 'a r
+    end
+    
+    val create: 'a r -> 'a t
+end
+
+module Create(S: Symbol) : (T with module S = S) = struct
+    module S = S
+    
+    class virtual ['r] satisfy state =
+        object(_:'self)
+            val state_ = state
+            
+            method state = state_
+            method follow u = {< state_ = N_set.union state_ u >}
+            method virtual edge: S.t -> N_set.t -> N_set.t
+            method accept: (int -> (S.t, 'r) Cf_llscan.t) option = None
+        end
+    
+    let literal c =
+        object
+            inherit ['r] satisfy N_set.nil
+            method edge n u = if n = c then N_set.union state_ u else u
+        end
+        
+    let mapped f =
+        object
+            inherit ['r] satisfy N_set.nil
+            method edge n u = if f n then N_set.union state_ u else u
+        end
+    
+    type 's y = {
+        y_counter: int;
+        y_first: N_set.t;
+        y_last: N_set.t;
+        y_follow: 's N_map.t -> 's N_map.t;
+    } constraint 's = 'r #satisfy
+    
+    type 's w = {
+        w_null: bool;
+        w_cons: int -> 's y;
+    }
+    
+    type x = Obj.t satisfy w
+    
+    let nil = {
+        w_null = true;
+        w_cons = fun i -> {
+            y_counter = i;
+            y_first = N_set.nil;
+            y_last = N_set.nil;
+            y_follow = identity;
+        }
+    }
+    
+    let expr n = {
+        w_null = false;
+        w_cons = fun i ->
+            let s = N_set.singleton i in {
+                y_counter = succ i;
+                y_first = s;
+                y_last = s;
+                y_follow = fun m -> N_map.replace (i, n) m;
+            }
+    }
+    
+    let acceptor f =
+        object(self:'self)
+            inherit ['r] satisfy N_set.nil
+            
+            method edge _ u = u
+            method follow _ = (self :> 'self)
+            method accept = Some f
+        end
+    
+    type 'a r = 'a satisfy w
+    type 'a t = (S.t, 'a) Cf_llscan.t
+    
+    module Op = struct
+        let ( $| ) wa wb = {
+            w_null = wa.w_null || wb.w_null;
+            w_cons = fun i ->
+                let ya = wa.w_cons i in
+                let yb = wb.w_cons ya.y_counter in {
+                    y_counter = yb.y_counter;
+                    y_first = N_set.union ya.y_first yb.y_first;
+                    y_last = N_set.union ya.y_last yb.y_last;
+                    y_follow = fun m -> yb.y_follow (ya.y_follow m);
+                }
+        }
+        
+        let follow_fold_aux a m i =
+            N_map.replace (i, let sat = N_map.search i m in sat#follow a) m
+        
+        let ( $& ) wa wb = {
+            w_null = wa.w_null && wb.w_null;
+            w_cons = fun i -> 
+                let ya = wa.w_cons i in
+                let yb = wb.w_cons ya.y_counter in
+                let first =
+                    if wa.w_null then
+                        N_set.union ya.y_first yb.y_first
+                    else
+                        ya.y_first
+                and last =
+                    if wb.w_null then
+                        N_set.union ya.y_last yb.y_last
+                    else
+                        yb.y_last
+                in {
+                    y_counter = yb.y_counter;
+                    y_first = first;
+                    y_last = last;
+                    y_follow = fun m ->
+                        let m = yb.y_follow (ya.y_follow m) in
+                        N_set.fold (follow_fold_aux yb.y_first) m ya.y_last
+                }
+        }
+        
+        let ( !* ) w =
+            let cons i =
+                let y = w.w_cons i in
+                let f = follow_fold_aux y.y_first in
+                let follow m = N_set.fold f (y.y_follow m) y.y_last in
+                { y with y_follow = follow }
+            in
+            {
+                w_null = true;
+                w_cons = cons;
+            }
+        
+        let ( !? ) x = x $| nil
+        let ( !+ ) x = x $& (!* x)
+        
+        let ( !: ) i = expr (literal i)
+        let ( !^ ) f = expr (mapped f)
+        
+        let rec ( !~ ) s =
+            match Lazy.force s with
+            | Cf_seq.Z -> nil
+            | Cf_seq.P (hd, tl) -> !:hd $& !~tl
+        
+        let ( $= ) x k =
+            let f n z = Some (k, Cf_seq.shift n z) in
+            (Obj.magic x) $& (expr (acceptor f))
+        
+        let ( $> ) x f =
+            let g n z =
+                let hd = Cf_seq.limit n z and tl = Cf_seq.shift n z in
+                Some (f hd, tl)
+            in
+            (Obj.magic x) $& (expr (acceptor g))
+        
+        let ( $@ ) x f =
+            (Obj.magic x) $& (expr (acceptor f))
+        
+        let ( !@ ) =
+            let rec f e = function hd :: tl -> f (hd $| e) tl | [] -> e in
+            fun s -> f nil s
+    end
+    
+    module S_order = struct
+        type t = int array
+        
+        let compare = compare
+            
+        (*
+        let to_string a =
+            let b = Buffer.create 40 in
+            Buffer.add_string b "[|";
+            begin
+                match Array.length a with
+                | 0 -> ()
+                | 1 ->
+                    Buffer.add_string b (Printf.sprintf " %u" a.(0))
+                | n ->
+                    for i = 0 to n - 2 do
+                        Buffer.add_string b (Printf.sprintf " %u;" a.(i))
+                    done;
+                    Buffer.add_string b (Printf.sprintf " %u" a.(n - 1))
+            end;
+            Buffer.add_string b " |]";
+            Buffer.contents b
+        *)
+    end
+    
+    module S_map = Cf_rbtree.Map(S_order)
+    
+    type ('i, 'o) s = {
+        s_id: S_order.t;
+        s_accept: (int -> ('i, 'o) Cf_llscan.t) option;
+        s_next: ('i, 'o) s option Lazy.t S.map;
+    }
+    
+    let create_aux =
+        let suspend w =
+            let y = w.w_cons 0 in
+            let m = y.y_follow N_map.nil in
+            let edge n u p = let sat = N_map.search p m in sat#edge n u in
+            let rec accept u ul i =
+                if i < ul then begin
+                    let sat = N_map.search (Array.unsafe_get u i) m in
+                    match sat#accept with
+                    | None -> accept u ul (succ i)
+                    | v -> v
+                end
+                else
+                    None
+            in
+            let sh = ref S_map.nil in
+            let rec state u =
+                let s = {
+                    s_id = u;
+                    s_accept = accept u (Array.length u) 0;
+                    s_next = S.map (follow u);
+                } in
+                sh := S_map.replace (u, s) !sh;
+                s
+            and follow u n =
+                lazy begin
+                    let v = Array.fold_left (edge n) N_set.nil u in
+                    if N_set.empty v then
+                        None
+                    else
+                        let u = Array.of_list (N_set.to_list_incr v) in
+                        Some (try S_map.search u !sh with Not_found -> state u)
+                end
+            in
+            state (Array.of_list (N_set.to_list_incr y.y_first))
+        in
+        let nil _ _ = None in
+        let rec loop code s f n z0 z =
+            let f = match s.s_accept with None -> f | Some f -> f in
+            match Lazy.force z with
+            | Cf_seq.Z ->
+                f n z0
+            | Cf_seq.P (hd, tl) ->
+                match Lazy.force (S.get s.s_next (code hd)) with
+                | None -> f n z0
+                | Some s -> loop code s f (succ n) z0 tl
+        in
+        fun code r ->
+            let s = suspend r in
+            fun z ->
+                loop code s nil 0 z z
+    
+    let create r = create_aux identity r
+end
+
+(*--- $File$ ---*)

File cf/cf_dfa.mli

View file
+(*---------------------------------------------------------------------------*
+  $Change$
+  Copyright (C) 2011, james 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 Symbol = sig
+    type t and 'a map
+    val map: (t -> 'a) -> 'a map
+    val get: 'a map -> t -> 'a
+end
+
+module type T = sig
+    module S: Symbol
+    
+    type x
+    
+    val nil: x
+    
+    type 'a r
+    type 'a t = (S.t, 'a) Cf_llscan.t
+    
+    module Op: sig
+        val ( $| ): x -> x -> x
+        val ( $& ): x -> x -> x
+        
+        val ( !* ): x -> x
+        val ( !+ ): x -> x
+        val ( !? ): x -> x
+        val ( !: ): S.t -> x
+        val ( !^ ): (S.t -> bool) -> x
+        val ( !~ ): S.t Cf_seq.t -> x
+        
+        val ( $= ): x -> 'a -> 'a r
+        val ( $> ): x -> (S.t Cf_seq.t -> 'a) -> 'a r
+        val ( $@ ): x -> (int -> 'a t) -> 'a r
+        val ( !@ ): 'a r list -> 'a r
+    end
+    
+    val create: 'a r -> 'a t
+end
+
+module Create(S: Symbol): T with module S = S
+
+(*--- $File$ ---*)

File cf/cf_regex.mli

View file
 (** {6 Modules} *)
 
 (** The deterministic finite automata on octet character symbols. *)
-module DFA: Cf_dfa.T with type S.t = char
+module DFA: Cf_dfa0.T with type S.t = char
 
 (** {6 Exceptions} *)
 

File cf/cf_regx.ml

View file
     let get m c = Array.unsafe_get m (int_of_char c)
 end
 
-module DFA = Cf_xdfa.Create(Symbol)
+module DFA = Cf_dfa.Create(Symbol)
 
 exception Error of string
         

File cf/cf_xdfa.ml

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (C) 2011, james 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 N_set = Cf_rbtree.Set(Cf_ordered.Int_order)
-module N_map = Cf_rbtree.Map(Cf_ordered.Int_order)
-
-external identity: 'a -> 'a = "%identity"
-
-module type Symbol = sig
-    type t and 'a map
-    val map: (t -> 'a) -> 'a map
-    val get: 'a map -> t -> 'a
-end
-
-module type T = sig
-    module S: Symbol
-    
-    type x
-    
-    val nil: x
-    
-    type 'a r
-    type 'a t = (S.t, 'a) Cf_llscan.t
-    
-    module Op: sig
-        val ( $| ): x -> x -> x
-        val ( $& ): x -> x -> x
-        
-        val ( !* ): x -> x
-        val ( !+ ): x -> x
-        val ( !? ): x -> x
-        val ( !: ): S.t -> x
-        val ( !^ ): (S.t -> bool) -> x
-        val ( !~ ): S.t Cf_seq.t -> x
-        
-        val ( $= ): x -> 'a -> 'a r
-        val ( $> ): x -> (S.t Cf_seq.t -> 'a) -> 'a r
-        val ( $@ ): x -> (int -> 'a t) -> 'a r
-        val ( !@ ): 'a r list -> 'a r
-    end
-    
-    val create: 'a r -> 'a t
-end
-
-module Create(S: Symbol) : (T with module S = S) = struct
-    module S = S
-    
-    class virtual ['r] satisfy state =
-        object(_:'self)
-            val state_ = state
-            
-            method state = state_
-            method follow u = {< state_ = N_set.union state_ u >}
-            method virtual edge: S.t -> N_set.t -> N_set.t
-            method accept: (int -> (S.t, 'r) Cf_llscan.t) option = None
-        end
-    
-    let literal c =
-        object
-            inherit ['r] satisfy N_set.nil
-            method edge n u = if n = c then N_set.union state_ u else u
-        end
-        
-    let mapped f =
-        object
-            inherit ['r] satisfy N_set.nil
-            method edge n u = if f n then N_set.union state_ u else u
-        end
-    
-    type 's y = {
-        y_counter: int;
-        y_first: N_set.t;
-        y_last: N_set.t;
-        y_follow: 's N_map.t -> 's N_map.t;
-    } constraint 's = 'r #satisfy
-    
-    type 's w = {
-        w_null: bool;
-        w_cons: int -> 's y;
-    }
-    
-    type x = Obj.t satisfy w
-    
-    let nil = {
-        w_null = true;
-        w_cons = fun i -> {
-            y_counter = i;
-            y_first = N_set.nil;
-            y_last = N_set.nil;
-            y_follow = identity;
-        }
-    }
-    
-    let expr n = {
-        w_null = false;
-        w_cons = fun i ->
-            let s = N_set.singleton i in {
-                y_counter = succ i;
-                y_first = s;
-                y_last = s;
-                y_follow = fun m -> N_map.replace (i, n) m;
-            }
-    }
-    
-    let acceptor f =
-        object(self:'self)
-            inherit ['r] satisfy N_set.nil
-            
-            method edge _ u = u
-            method follow _ = (self :> 'self)
-            method accept = Some f
-        end
-    
-    type 'a r = 'a satisfy w
-    type 'a t = (S.t, 'a) Cf_llscan.t
-    
-    module Op = struct
-        let ( $| ) wa wb = {
-            w_null = wa.w_null || wb.w_null;
-            w_cons = fun i ->
-                let ya = wa.w_cons i in
-                let yb = wb.w_cons ya.y_counter in {
-                    y_counter = yb.y_counter;
-                    y_first = N_set.union ya.y_first yb.y_first;
-                    y_last = N_set.union ya.y_last yb.y_last;
-                    y_follow = fun m -> yb.y_follow (ya.y_follow m);
-                }
-        }
-        
-        let follow_fold_aux a m i =
-            N_map.replace (i, let sat = N_map.search i m in sat#follow a) m
-        
-        let ( $& ) wa wb = {
-            w_null = wa.w_null && wb.w_null;
-            w_cons = fun i -> 
-                let ya = wa.w_cons i in
-                let yb = wb.w_cons ya.y_counter in
-                let first =
-                    if wa.w_null then
-                        N_set.union ya.y_first yb.y_first
-                    else
-                        ya.y_first
-                and last =
-                    if wb.w_null then
-                        N_set.union ya.y_last yb.y_last
-                    else
-                        yb.y_last
-                in {
-                    y_counter = yb.y_counter;
-                    y_first = first;
-                    y_last = last;
-                    y_follow = fun m ->
-                        let m = yb.y_follow (ya.y_follow m) in
-                        N_set.fold (follow_fold_aux yb.y_first) m ya.y_last
-                }
-        }
-        
-        let ( !* ) w =
-            let cons i =
-                let y = w.w_cons i in
-                let f = follow_fold_aux y.y_first in
-                let follow m = N_set.fold f (y.y_follow m) y.y_last in
-                { y with y_follow = follow }
-            in
-            {
-                w_null = true;
-                w_cons = cons;
-            }
-        
-        let ( !? ) x = x $| nil
-        let ( !+ ) x = x $& (!* x)
-        
-        let ( !: ) i = expr (literal i)
-        let ( !^ ) f = expr (mapped f)
-        
-        let rec ( !~ ) s =
-            match Lazy.force s with
-            | Cf_seq.Z -> nil
-            | Cf_seq.P (hd, tl) -> !:hd $& !~tl
-        
-        let ( $= ) x k =
-            let f n z = Some (k, Cf_seq.shift n z) in
-            (Obj.magic x) $& (expr (acceptor f))
-        
-        let ( $> ) x f =
-            let g n z =
-                let hd = Cf_seq.limit n z and tl = Cf_seq.shift n z in
-                Some (f hd, tl)
-            in
-            (Obj.magic x) $& (expr (acceptor g))
-        
-        let ( $@ ) x f =
-            (Obj.magic x) $& (expr (acceptor f))
-        
-        let ( !@ ) =
-            let rec f e = function hd :: tl -> f (hd $| e) tl | [] -> e in
-            fun s -> f nil s
-    end
-    
-    module S_order = struct
-        type t = int array
-        
-        let compare = compare
-            
-        (*
-        let to_string a =
-            let b = Buffer.create 40 in
-            Buffer.add_string b "[|";
-            begin
-                match Array.length a with
-                | 0 -> ()
-                | 1 ->
-                    Buffer.add_string b (Printf.sprintf " %u" a.(0))
-                | n ->
-                    for i = 0 to n - 2 do
-                        Buffer.add_string b (Printf.sprintf " %u;" a.(i))
-                    done;
-                    Buffer.add_string b (Printf.sprintf " %u" a.(n - 1))
-            end;
-            Buffer.add_string b " |]";
-            Buffer.contents b
-        *)
-    end
-    
-    module S_map = Cf_rbtree.Map(S_order)
-    
-    type ('i, 'o) s = {
-        s_id: S_order.t;
-        s_accept: (int -> ('i, 'o) Cf_llscan.t) option;
-        s_next: ('i, 'o) s option Lazy.t S.map;
-    }
-    
-    let create_aux =
-        let suspend w =
-            let y = w.w_cons 0 in
-            let m = y.y_follow N_map.nil in
-            let edge n u p = let sat = N_map.search p m in sat#edge n u in
-            let rec accept u ul i =
-                if i < ul then begin
-                    let sat = N_map.search (Array.unsafe_get u i) m in
-                    match sat#accept with
-                    | None -> accept u ul (succ i)
-                    | v -> v
-                end
-                else
-                    None
-            in
-            let sh = ref S_map.nil in
-            let rec state u =
-                let s = {
-                    s_id = u;
-                    s_accept = accept u (Array.length u) 0;
-                    s_next = S.map (follow u);
-                } in
-                sh := S_map.replace (u, s) !sh;
-                s
-            and follow u n =
-                lazy begin
-                    let v = Array.fold_left (edge n) N_set.nil u in
-                    if N_set.empty v then
-                        None
-                    else
-                        let u = Array.of_list (N_set.to_list_incr v) in
-                        Some (try S_map.search u !sh with Not_found -> state u)
-                end
-            in
-            state (Array.of_list (N_set.to_list_incr y.y_first))
-        in
-        let nil _ _ = None in
-        let rec loop code s f n z0 z =
-            let f = match s.s_accept with None -> f | Some f -> f in
-            match Lazy.force z with
-            | Cf_seq.Z ->
-                f n z0
-            | Cf_seq.P (hd, tl) ->
-                match Lazy.force (S.get s.s_next (code hd)) with
-                | None -> f n z0
-                | Some s -> loop code s f (succ n) z0 tl
-        in
-        fun code r ->
-            let s = suspend r in
-            fun z ->
-                loop code s nil 0 z z
-    
-    let create r = create_aux identity r
-end
-
-(*--- $File$ ---*)

File cf/cf_xdfa.mli

-(*---------------------------------------------------------------------------*
-  $Change$
-  Copyright (C) 2011, james 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 Symbol = sig
-    type t and 'a map
-    val map: (t -> 'a) -> 'a map
-    val get: 'a map -> t -> 'a
-end
-
-module type T = sig
-    module S: Symbol
-    
-    type x
-    
-    val nil: x
-    
-    type 'a r
-    type 'a t = (S.t, 'a) Cf_llscan.t
-    
-    module Op: sig
-        val ( $| ): x -> x -> x
-        val ( $& ): x -> x -> x
-        
-        val ( !* ): x -> x
-        val ( !+ ): x -> x
-        val ( !? ): x -> x
-        val ( !: ): S.t -> x
-        val ( !^ ): (S.t -> bool) -> x
-        val ( !~ ): S.t Cf_seq.t -> x
-        
-        val ( $= ): x -> 'a -> 'a r
-        val ( $> ): x -> (S.t Cf_seq.t -> 'a) -> 'a r
-        val ( $@ ): x -> (int -> 'a t) -> 'a r
-        val ( !@ ): 'a r list -> 'a r
-    end
-    
-    val create: 'a r -> 'a t
-end
-
-module Create(S: Symbol): T with module S = S
-
-(*--- $File$ ---*)