Commits

jhwoodyatt  committed d765427

Use Cf_seq.nil in place of Lazy.lazy_from_val Cf_seq.Z.

  • Participants
  • Parent commits e3a5cc7

Comments (0)

Files changed (3)

File cf/cf_parser.ml

   OF THE POSSIBILITY OF SUCH DAMAGE. 
  *---------------------------------------------------------------------------*)
 
+(**)
+let jout = Cf_journal.stdout
+(**)
+
 type ('s, 'a) t = 's Cf_seq.t -> ('a * 's Cf_seq.t) option
 
 exception Error
 
 let nil _ = None
 
-let err f s = raise (f s)
+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
         | None -> altz tl s
         | v -> v
 
-let req_aux_ _ = Error
-
-let req ?(f = req_aux_) 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)
         constraint 'z = 'i * 'c
         constraint 'c = 'x #cursor
 
-    val weave: c:('i #cursor as 'c) -> 'i Cf_seq.t -> ('i * 'c) Cf_seq.t
+    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
 
         constraint 'z = 'i * 'c
         constraint 'c = 'x #cursor
     
-    let rec weave ~c s =
-        lazy begin
+    exception Error of int
+    
+    let err_aux_ s =
+        Error 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
+            | 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)
         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 seq with
         | Cf_seq.Z ->
             begin
-                let z = Lazy.lazy_from_val Cf_seq.Z in
-                match q (X.unfold p z) with
+                match q (X.unfold p Cf_seq.nil) with
                 | None -> None
-                | Some (x, _) -> Some (x, z)
+                | Some (x, _) -> Some (x, Cf_seq.nil)
             end
         | Cf_seq.P ((_, c0), _) ->
-            let n0 = c0#position in
             match q (X.unfold p seq) with
             | None -> None
             | Some (x, seq') ->
                 let seq'' =
                     match Lazy.force seq' with
                     | Cf_seq.Z ->
-                        Lazy.lazy_from_val Cf_seq.Z
+                        Cf_seq.nil
                     | Cf_seq.P ((_, c1), _) ->
                         Cf_seq.shift (c1#position - c0#position) seq
                 in
         | None -> optmap f p s
         | Some y -> Some (y, s)
 
-let rec to_extended_aux_ n z s =
-    if z == s then
+let rec to_extended_aux_ n fin s =
+    let z = Lazy.force s in
+    if fin == z then
         n
     else
-        match Lazy.force s with
-        | Cf_seq.P (_, tl) -> to_extended_aux_ (succ n) z tl
+        match z with
+        | Cf_seq.P (c, 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) -> Some (x, Cf_seq.shift (to_extended_aux_ 0 s1 s0) s)
+    | 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 =

File cf/cf_parser.mli

 (** 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].
+(** 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: ('i Cf_seq.t -> exn) -> ('i, 'x) t
+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 altz: ('i, 'o) t Cf_seq.t -> ('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 Cf_seq.t -> exn) -> ('i, 'o) 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].
 *)
         constraint 'z = 'i * 'c
         constraint 'c = 'x #cursor
 
-    (** Use [weave ~c i] with an initial cursor [c] and an input sequence [i]
-        to create an input sequence with accompanying 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 weave: c:('i #cursor as 'c) -> 'i Cf_seq.t -> ('i * 'c) Cf_seq.t
+    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 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

File cf/cf_rbtree.ml

 module Core(N: Node_T) = struct
     module N = N
 
-    (**)
+    (*
     type 'a ic_t = IC_o | IC_l of 'a N.t | IC_r of 'a N.t
     
     let invariant_key_compare_ x = function
             (* try ignore (loop u); true with Failure _ as x -> false *)
     
     let invariant_aux_ = invariant_noprint_aux_
-    (**)
+    *)
     
     let nil = Z
     
 
     let replace x u =
         let u = force_black_ (replace_aux_ x u) in
-        (**) assert (invariant_aux_ u); (**)
+        (* assert (invariant_aux_ u); *)
         u
     
     let l_repair_ = function
     let delete k u =
         try
             let u, _, _ = extract_aux_ k u in
-            (**) assert (invariant_aux_ u); (**)
+            (* assert (invariant_aux_ u); *)
             u
         with
         | Not_found ->
                 loop (lazy (Cf_seq.P (x, loop z b))) a
         in
         fun u ->
-            loop (Lazy.lazy_from_val Cf_seq.Z) u
+            loop Cf_seq.nil u
     
     let to_seq_decr =
         let rec loop z u =
                 loop (lazy (Cf_seq.P (x, loop z a))) b
         in
         fun u ->
-            loop (Lazy.lazy_from_val Cf_seq.Z) u
+            loop Cf_seq.nil u
     
     let to_list_aux_ f =
         let rec loop acc = function