Commits

Anonymous committed 78445d6

Submit of cf-0.3 release.

Comments (0)

Files changed (6)

 - Findlib (tested with v0.8.1 and v1.0.4)
 
 Principle development was on Mac OS X 10.3.  The final version of this
-library also compiled successfully without warnings and self-tests on
-Suse Linux 9.0 on x86-32.  Other platforms with POSIX-like environments
+library also compiled successfully and passed all self-tests without warnings
+on Suse Linux 9.0 for x86-32.  Other platforms with POSIX-like environments
 should require only a minimal porting effort.
 
 One major open issue: the extended socket interface is broken under WIN32.
 
 --j h woodyatt <jhw@wetware.com>
   San Francisco, CA
-  2004-01-01
+  2004-07-29
     | Y a -> f a
     | X (a,b) -> f a; f b
     | U (a,b,c) ->
-        iterate f a; iterate f c;
-        (Obj.magic iterate) (fun (x,y) -> f x; f y) b
+        iterate f a;
+        (Obj.magic iterate) (fun (x,y) -> f x; f y) b;
+        iterate f c
     | V (a,b,c) ->
-        iterate f a; iterate f c;
-        (Obj.magic iterate) (iterate f) (Lazy.force b)
+        iterate f a;
+        (Obj.magic iterate) (iterate f) (Lazy.force b);
+        iterate f c
 
 let rec predicate f = function
     | Z -> true
     | Y a -> f a
     | X (a,b) -> f a && f b
     | U (a,b,c) ->
-        predicate f a && predicate f c &&
-        (Obj.magic predicate) (fun (x,y) -> f x && f y) b
+        predicate f a &&
+        (Obj.magic predicate) (fun (x,y) -> f x && f y) b &&
+        predicate f c
     | V (a,b,c) ->
-        predicate f a && predicate f c &&
-        (Obj.magic predicate) (predicate f) (Lazy.force b)
+        predicate f a &&
+        (Obj.magic predicate) (predicate f) (Lazy.force b) &&
+        predicate f c
 
 let rec fold f v = function
     | Z -> v
     | Y a -> f v a
     | X (a,b) -> f (f v a) b
     | U (a,b,c) ->
-        let v = fold f v a in let v = fold f v c in
-        (Obj.magic fold) (fun (x,y) -> f (f v x) y) b
+        let v = fold f v a in
+        let v = (Obj.magic fold) (fun (x,y) -> f (f v x) y) b in
+        fold f v c
     | V (a,b,c) ->
-        let v = fold f v a in let v = fold f v c in
-        (Obj.magic fold) (fold f v) (Lazy.force b)
+        let v = fold f v a in
+        let v = (Obj.magic fold) (fold f v) (Lazy.force b) in
+        fold f v c
 
 let filter f =
     let g d' x = if f x then B.push x d' else d' in
     | X (a,b) ->
         X (f a, f b)
     | U (a,b,c) ->
-        let a = map f a and c = map f c in
+        let a = map f a in
         let b = (Obj.magic map) (fun (x,y) -> f x, f y) b in
+        let c = map f c in
         U (a, b, c)
     | V (a,b,c) ->
-        let a = map f a and c = map f c in
+        let a = map f a in
         let b = Lazy.lazy_from_val ((Obj.magic map) (map f) (Lazy.force b)) in
+        let c = map f c in
         V (a, b, c)
 
 let optmap f =
 module A: Direction_T  (** Operations on the left end of a deque. *)
 module B: Direction_T  (** Operations on the right end of a deque. *)
 
-(** [iterate f d] applies [f] to every element in [d] in some indeterminate
+(** [iterate f d] applies [f] to every element in [d] in left-to-right
     order.  Not tail recursive.
 *)
 val iterate: ('a -> unit) -> 'a t -> unit
 
 (** [predicate f d] returns [true] if the result of applying [f] to every
     element in the deque [d] is [true], or if [d] is the empty deque.  The
-    order in which elements are applied is indeterminate.  If [f] returns
+    order in which elements are applied is left to right.  If [f] returns
     [false], then no more elements from [d] will be applied and the result
     will be returned immediately.  Not tail recursive.
 *)
 val predicate: ('a -> bool) -> 'a t -> bool
 
 (** [fold f a0 d] is [f (... (f (f a0 e0) e1) ...) en] when [e0..en] are the
-    elements of the deque [d] in some indeterminate order.  Not tail recursive.
+    elements of the deque [d] in left-to-right order.  Not tail recursive.
 *)
 val fold: ('b -> 'a -> 'b) -> 'b -> 'a t -> 'b
 
 (** [filter f d] returns a new deque composed by applying [f] to every element
     in [d], including only those elements for which the result is [true].  The
-    function is applied to the elements in the deque in an indeterminate order.
+    function is applied to the elements in the deque in left-to-right order.
     Not tail recursive.
 *)
 val filter: ('a -> bool) -> 'a t -> 'a t
 
 (** [map f d] returns a new deque composed by applying [f] to every element in
-    [d] in some indeterminate order.  Not tail recursive.
+    [d] in left-to-right order.  Not tail recursive.
 *)
 val map: ('a -> 'b) -> 'a t -> 'b t
 
 (** [optmap f d] returns a new deque composed by applying [f] to every element
-    in [d] in some indeterminate order, including only those elements of [d]
+    in [d] in left-to-right order, including only those elements of [d]
     for which [f] returns [Some] value.  Not tail recursive.
 *)
 val optmap: ('a -> 'b option) -> 'a t -> 'b t
 
 (** [listmap f d] returns a new deque composed by applying [f] to every element
-    in [d] in some indeterminate order, taking all the resulting lists of
+    in [d] in left-to-right order, taking all the resulting lists of
     elements in order.  Not tail recursive.
 *)
 val listmap: ('a -> 'b list) -> 'a t -> 'b t
 
 (** [seqmap f d] returns a new deque composed by applying [f] to every element
-    in [d] in some indeterminate order, taking all the resulting sequences of
+    in [d] in left-to-right order, taking all the resulting sequences of
     elements in order.  Not tail recursive.
 *)
 val seqmap: ('a -> 'b Cf_seq.t) -> 'a t -> 'b t
 
 (** [partition f s] returns two deques.  The first is the deque of
     elements in [d] for which applying [f] results in [true], and the second
-    is the deque of elements for which applying [f] results in [false].
+    is the deque of elements for which applying [f] results in [false].  The
+    elements are applied in left-to-right order.
 *)
 val partition: ('a -> bool) -> 'a t -> 'a t * 'a t
 
   OF THE POSSIBILITY OF SUCH DAMAGE.
  *---------------------------------------------------------------------------*)
 
+class ['i] cursor pos =
+    object(_:'self)
+        inherit ['i] Cf_parser.cursor pos
+        
+        method error (_: int) (_: ('i * 'self) Cf_seq.t) = ()
+    end
+
 module NFA_state = struct
     type t = int
 
 class ['action] acceptor f =
     object(self:'self)
         constraint 'action =
-            (int -> ('i #Cf_parser.cursor, 'i, 'o) Cf_parser.X.t) option
+            (int -> ('i #cursor, 'i, 'o) Cf_parser.X.t) option
         
         inherit ['action] satisfier
         
     }
 
 type ('i, 'o) suspension_t = {
-    s_accept_: (int -> ('i Cf_parser.cursor, 'i, 'o) Cf_parser.X.t) option;
+    s_accept_: (int -> ('i cursor, 'i, 'o) Cf_parser.X.t) option;
     s_next_: ('i, 'o) suspension_t Lazy.t array;
 }
 
 module type T = sig
     module S: Symbol_T
 
-    type ('c, 'x) t = ('c, S.t, 'x) Cf_parser.X.t
-        constraint 'c = S.t #Cf_parser.cursor
-    
-    type 'c raise_exn_t = int -> (S.t * 'c) Cf_seq.t -> exn
-        constraint 'c = S.t #Cf_parser.cursor
+    type ('c, 'x) t = ('c, S.t, 'x) Cf_parser.X.t constraint 'c = S.t #cursor
 
-    type expr_t and ('c, 'x) rule_t constraint 'c = S.t #Cf_parser.cursor
+    type expr_t
+    type ('c, 'x) rule_t constraint 'c = S.t #cursor
 
     val nil: expr_t
 
         val ( !@ ): ('c, 'x) rule_t list -> ('c, 'x) rule_t
     end
     
-    val create: ?xf:'c raise_exn_t -> ('c, 'x) rule_t -> ('c, 'x) t
+    val create: ('c, 'x) rule_t -> ('c, 'x) t
 end
 
 module Create(S: Symbol_T) : (T with module S = S) = struct
 
     module S = S
 
-    type ('c, 'o) t = ('c, S.t, 'o) Cf_parser.X.t
-        constraint 'c = S.t #Cf_parser.cursor
-
-    type 'c raise_exn_t = int -> (S.t * 'c) Cf_seq.t -> exn
-        constraint 'c = S.t #Cf_parser.cursor
+    type ('c, 'o) t = ('c, S.t, 'o) Cf_parser.X.t constraint 'c = S.t #cursor
 
     type expr_t = x
-    type ('c, 'x) rule_t = x constraint 'c = S.t #Cf_parser.cursor
+    type ('c, 'x) rule_t = x constraint 'c = S.t #cursor
     
     let nil = nil_
     
             expr $& (node_ (new acceptor f))
 
         let ( !@ ) =
-            let rec loop e = function
+            let rec loop e rs =
+                match rs with
                 | hd :: tl -> loop (hd $| e) tl
                 | [] -> e
             in
         | None -> acc
         | Some action -> lazy ((Obj.magic action) lim z0)
     
-    let create ?xf =
+    let create =
         let rec loop ~z0 ~lim acc susp seq =
             match Lazy.force seq with
             | Cf_seq.Z ->
                 | None ->
                     match Lazy.force acc with
                     | Some _ as v -> v
-                    | None ->
-                        match xf with
-                        | None -> None
-                        | Some f -> raise (f lim z0)
+                    | None -> c#error lim z0; None
         in
         fun dfa ->
             let susp = suspend_ dfa in
     certain classes of unusual grammars and unusual input.
 *)
 
+(** {6 Classes} *)
+
+(** The class of cursors used by lazy DFA parser.  It inherits from the
+    basic parser and defines a new method for handling errors.
+*)
+
+class ['i] cursor:
+    int ->  (** The initial position, i.e. usually zero *)
+    object('self)
+        inherit ['i] Cf_parser.cursor
+        
+        (** This method is invoked as [c#error n z] in a DFA when no rule
+            matches the input stream [z] after [n] symbols.  The purpose is to
+            give a derived class an opportunity to raise an exception rather
+            that allow the parser to return without a match.
+        *)
+        method error: int -> ('i * 'self) Cf_seq.t -> unit
+    end
+
 (** {6 Module Types} *)
 
 (** The type of the input module for [Create(S: Symbol_T)] functor defined
         cursor class, and produces output according to the types of the rules
         used in the composition of the automaton.
     *)
-    type ('c, 'x) t = ('c, S.t, 'x) Cf_parser.X.t
-        constraint 'c = S.t #Cf_parser.cursor
+    type ('c, 'x) t = ('c, S.t, 'x) Cf_parser.X.t constraint 'c = S.t #cursor
     
-    (** A function that an automaton may use to signal when a symbol in the
-        input stream does not comply with its grammar by raising an exception.
-    *)
-    type 'c raise_exn_t = int -> (S.t * 'c) Cf_seq.t -> exn
-        constraint 'c = S.t #Cf_parser.cursor
-
     (** The type of an expression in the regular grammar of an automaton. *)
     type expr_t
     
     (** The type of a rule for recognizing a sequence of symbols according to
         the regular grammar of an automaton and producing an output token.
     *)
-    type ('c, 'x) rule_t constraint 'c = S.t #Cf_parser.cursor
+    type ('c, 'x) rule_t constraint 'c = S.t #cursor
 
     (** The expression that matches the empty symbol sequence. *)
     val nil: expr_t
         val ( !@ ): ('c, 'x) rule_t list -> ('c, 'x) rule_t
     end
     
-    (** Use [create ?xf r] to compose a new DFA from the rule [r] and the
-        optional exception handler [xf].
-    *)
-    val create: ?xf:'c raise_exn_t -> ('c, 'x) rule_t -> ('c, 'x) t
+    (** Use [create r] to compose a new DFA from the rule [r]. *)
+    val create: ('c, 'x) rule_t -> ('c, 'x) t
 end
 
 (** The functor that creates a DFA module. *)
 *)
 val dncase: (char, char) t
 
-(** Use [commute w z] to produce an output sequence from a flow[w] that
+(** 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