Commits

camlspotter  committed 995958f

under heavy construction

  • Participants
  • Parent commits baad659

Comments (0)

Files changed (10)

File lib/lazylist.ml

 open Lazy
 
-type ('a, 'attr) zlist = ('a, 'attr) desc lazy_t
+type 'a zlist = 'a desc lazy_t
 
-and ('a, 'attr) desc =
-  | Cons of 'a * 'attr * ('a, 'attr) zlist
-  | Null of 'attr
+and 'a desc =
+  | Cons of 'a * 'a zlist
+  | Null
 
-let null attr = lazy_from_val (Null attr)
-let null_desc attr = Null attr
-let cons_desc v attr t = Cons (v, attr, t)
+let null = lazy_from_val Null
+let null_desc = Null
+let cons_desc v t = Cons (v, t)
 
 let desc = force
-let peek t = 
-  match desc t with
-  | Null _ -> None
-  | Cons (v, attr, t') -> Some (v, attr, t')
+let peek = function
+  | lazy Null -> None
+  | lazy Cons (v, t') -> Some (v, t')
 
-let is_null t = match desc t with
-  | Null _ -> true
+let is_null = function
+  | lazy Null -> true
   | _ -> false
 
-let attr t = match desc t with
-  | Null a -> a
-  | Cons (_, a, _) -> a
-
 let to_list t = 
-  let rec to_list st t = match desc t with
-    | Null _ -> List.rev st
-    | Cons (elem, _, t) -> to_list (elem :: st) t
+  let rec to_list st = function
+    | lazy Null -> List.rev st
+    | lazy Cons (elem, t) -> to_list (elem :: st) t
   in
   to_list [] t
   
-let to_list_with_attrs t = 
-  let rec to_list_with_attrs st t = 
-    let desc = desc t in
-    match desc with
-    | Null _ -> List.rev st
-    | Cons (elem, attr, t) -> 
-        to_list_with_attrs ((elem, attr) :: st) t
-  in
-  to_list_with_attrs [] t
-  
-let rec iter f t = 
-  let desc = desc t in
-  match desc with
-  | Null attr -> f None attr
-  | Cons (elem, attr, t) -> f (Some elem) attr; iter f t
+let rec iter f = function
+  | lazy Null -> ()
+  | lazy Cons (elem, t) -> f elem; iter f t
 
-let rec fold_right f lst st =
-  match desc lst with
-  | Null attr -> f None attr st
-  | Cons (v, attr, lst') -> fold_right f lst' (f (Some v) attr st)
+let rec fold_right f lst st = match lst with
+  | lazy Null -> st
+  | lazy Cons (v, lst') -> f v (fold_right f lst' st)
 
-let rec map fcons fnull lst =
-  lazy (match desc lst with
-  | Null attr -> Null (fnull attr)
-  | Cons (v, attr, lst') ->
-      let v, attr = fcons v attr in
-      Cons (v, attr, map fcons fnull lst'))
+let rec map f lst = lazy (match lst with
+  | lazy Null -> Null
+  | lazy Cons (v, lst') -> Cons (f v, map f lst'))
 
 (* [t2] must be a postfix of [t1] otherwise, it loops forever *)
 let rev_between t1 t2 =
   let rec loop st t =
     if t == t2 then st (* CR jfuruse: we cannot always use pointer eq *)
     else 
-      let desc = desc t in
-      match desc with
-      | Cons (elem, attr, t') -> loop ((elem, attr)::st) t'
-      | Null _ -> st
+      match t with
+      | lazy Cons (elem, t') -> loop (elem::st) t'
+      | lazy Null -> st
   in
   loop [] t1
 

File lib/lazylist.mli

 (** This is a lazy list basically, but its elements and nil can have extra information. *)
 
-type ('elem, 'attr) zlist = ('elem, 'attr) desc lazy_t
+type 'a zlist = 'a desc lazy_t
 
-and ('elem, 'attr) desc = 
-  | Cons of 'elem * 'attr * ('elem, 'attr) zlist  (** cons of element with attribute *)
-  | Null of 'attr (** null with attribute. Even at the EOF, we can get some info of it, such as the position. *)
+and 'a desc = 
+  | Cons of 'a * 'a zlist
+  | Null 
 
 (** Constructor functions *)
-val null : 'attr -> ('elem, 'attr) zlist
-val null_desc : 'attr -> ('elem, 'attr) desc
-val cons_desc : 'elem -> 'attr -> ('elem, 'attr) zlist -> ('elem, 'attr) desc
+val null : 'a zlist
+val null_desc : 'a desc
+val cons_desc : 'a -> 'a zlist -> 'a desc
 
 (** Destructors *)
-val desc : ('elem, 'attr) zlist -> ('elem, 'attr) desc
-val peek : ('elem, 'attr) zlist -> ('elem * 'attr * ('elem, 'attr) zlist) option
-val is_null : ('elem, 'attr) zlist -> bool
-val attr : ('elem, 'attr) zlist -> 'attr
-(** Attribute of the head element/null *)
+val desc : 'a zlist -> 'a desc
+val peek : 'a zlist -> ('a * 'a zlist) option
+val is_null : 'a zlist -> bool
 
-val to_list : ('elem, 'attr) zlist -> 'elem list
-val to_list_with_attrs : ('elem, 'attr) zlist -> ('elem * 'attr) list
-(** Conversions to eager list. The attribute at Null is thrown away. *)
+val to_list : 'a zlist -> 'a list
 
-val iter : ('elem option -> 'attr -> 'c) -> ('elem, 'attr) zlist -> 'c
-val fold_right : ('elem option -> 'attr -> 'c -> 'c) -> ('elem, 'attr) zlist -> 'c -> 'c
-val map : ('elem -> 'attr -> 'c * 'd) -> ('attr -> 'd) -> ('elem, 'attr) zlist -> ('c, 'd) zlist
+val iter : ('a -> unit) -> 'a zlist -> unit
+val fold_right : ('a -> 'b -> 'b) -> 'a zlist -> 'b -> 'b
+val map : ('a -> 'b) -> 'a zlist -> 'b zlist
 
-val rev_between : ('elem, 'attr) zlist -> ('elem, 'attr) zlist -> ('elem * 'attr) list
-val between : ('elem, 'attr) zlist -> ('elem, 'attr) zlist -> ('elem * 'attr) list
+val rev_between : 'a zlist -> 'a zlist -> 'a list
+val between : 'a zlist -> 'a zlist -> 'a list

File lib/pstate.ml

   let take : Str.Elem.t t = fun s stat -> 
     match Str.peek s with
     | None -> Error (Str.position s, "unexpected end of stream")
-    | Some (elem, _pos, s') -> Ok (elem, s', stat)
+    | Some (elem, s') -> Ok (elem, s', stat)
 
   let take_ : unit t = fun s stat -> 
     match Str.peek s with

File lib/sbuffer.ml

 
 module Extend(Base : sig
   include S
-  with type Elem.t = char
+  with type Elem.t = char * Position.File.t
   and  type Pos.t  = Position.File.t
-  val create_attr : buf -> Attr.t
   val buf : t -> buf
 end) = struct
 
 
   let rec create : buf -> t = fun i ->
     match Sstring.peek i.base with
-    | None -> null (create_attr i)
-    | Some (elem, _, buf') ->
+    | None -> null
+    | Some (elem, buf') ->
         if i.rel_pos >= String.length elem then begin
           (* If the position is out of the head *)
           create { i with base = buf'; 

File lib/sbuffer.mli

 
 module Extend(Base : sig
   include S
-  with type Elem.t = char
+  with type Elem.t = (char * Position.File.t)
   and  type Pos.t  = Position.File.t
   (** Sbuffer is based on a stream whose element is [char].
       [attr] is implementation dependent.
   *)
-  val create_attr : buf -> Attr.t
   val buf : t -> buf
 end) : sig
 

File lib/sstring.ml

 (* open Stream_intf *)
 
 include Stream.Make(struct
+  module Pos = Position.None
   module Elem = struct
     type t = string
     let show = Printf.sprintf "%S"
     let format ppf = Format.fprintf ppf "%S"
     let equal (x : string) y = x = y
     let compare (x : string) y = compare x y
-  end
-  module Pos = Position.None
-  module Attr = struct
-    type t = unit
-    let default = ()
-    let position () = Position.None.none
+    let position _ = Position.None.none
   end
 end)
 
-let from_string str = Lazy.lazy_from_val (cons_desc str () (null ()))
+let from_string str = Lazy.lazy_from_val (cons_desc str null)
 
 let from_chan ic =
   let len = 1024 in
   let rec read () = lazy begin
     let buf = String.create len in
     let read_bytes = input ic buf 0 len in
-    if read_bytes = 0 then null_desc ()
+    if read_bytes = 0 then null_desc
     else
       let str = String.sub buf 0 read_bytes in
-      cons_desc str () (read ())
+      cons_desc str (read ())
   end
   in
   read ()

File lib/sstring.mli

 
 include Stream_intf.S
   with type Elem.t = string
-  and  type Attr.t = unit
   and  type Pos.t  = unit
 
 val from_string : string -> t

File lib/stream.ml

   open Lazylist
   include P
 
-  type t = (Elem.t, Attr.t) zlist
+  type desc = (Elem.t option * Pos.t)
+  type t = desc zlist (* None means EOS *)
 
-  let null = null
-  let default_null = null P.Attr.default
-  let null_desc = null_desc 
-  let cons_desc = cons_desc
+  let null_desc pos = cons_desc (None, pos) Lazylist.null
+  let null pos = Lazy.lazy_from_val (null_desc pos)
+  let cons_desc e pos = cons_desc (Some e,pos)
 
   let desc = desc
-  let peek t = 
-    let desc = desc t in
-    match desc with
-    | Null _ -> None
-    | Cons (elem, attr, t') -> Some (elem, attr, t')
+  let peek = function
+    | lazy Cons ((Some elem, _), t') -> Some (elem, t')
+    | _ -> None
 
   let is_null = is_null
-  let attr = attr
     
   let to_list = to_list
-  let to_list_with_attrs = to_list_with_attrs
 
   let iter = iter
   let fold_right = fold_right
   let rev_between = rev_between
   let between = between
 
-  let position t = 
-    let desc = desc t in
-    match desc with
-    | Null attr -> P.Attr.position attr
-    | Cons (_elem, attr, _) -> P.Attr.position attr
+  let position = function
+    | lazy Cons ((_, pos), _) -> pos
+    | _ -> assert false
 
 end

File lib/stream.mli

 module Make (Base : Base) : S 
   with type Pos.t  = Base.Pos.t
   and  type Elem.t = Base.Elem.t
-  and  type Attr.t = Base.Attr.t
 (** The functor [Make] creates a stream module based on [Base] *)
 

File lib/stream_intf.ml

 
 (** Minimum specification to create a stream *)
 module type Base = sig
+
+  module Pos : Position.S
+  (** Module for stream positions *)
+
   module Elem : sig
     type t
     (** Type of the stream element *)
     include Mtypes.Comparable with type t := t
   end
 
-  module Pos : Position.S
-  (** Module for stream positions *)
-
-  module Attr : sig
-    type t
-    (** Type of the stream attribute *)
-
-    val default : t
-    (** Default attr value *)
-    
-    val position : t -> Pos.t
-    (** [Pos.t] must be obtainable from [t]. *)
-  end
 end
 
 (* Standard interface *)
 module type S = sig
   include Base
 
-  type t = (Elem.t, Attr.t) zlist
-  (** Stream is implemented as a lazylist with attributes. *)
+  type desc
+  type t = desc zlist
 
-  val default_null : t
-  (** Null with the default attr *)
-
-  val null : Attr.t -> t
+  val null : Pos.t -> t
   (** Create a null stream *)
 
-  val null_desc : Attr.t -> (Elem.t, Attr.t) desc
-  val cons_desc : Elem.t -> Attr.t -> t -> (Elem.t, Attr.t) desc
+  val null_desc : Pos.t -> desc
+  val cons_desc : Elem.t -> Pos.t -> t -> desc
   (** Create a null/cons cell desc. *)
 
-
   (** Destructors *)
-  val desc : t -> (Elem.t, Attr.t) desc
-  val peek : t -> (Elem.t * Attr.t * t) option
+  val desc : t -> desc
+  val peek : t -> (Elem.t * t) option
 
   val is_null : t -> bool
   (** Null check *)
 
-  val attr : t -> Attr.t
-  (** Attribute of the head element/null *)
-
   val position : t -> Pos.t
   (** Position of the head element/null *)
 
   val to_list : t -> Elem.t list
-  val to_list_with_attrs : t -> (Elem.t * Attr.t) list
-  (** Conversions to eager list. The attribute at Null is thrown away. *)
 
-  val iter : (Elem.t option -> Attr.t -> unit) -> t -> unit
-  val fold_right : (Elem.t option -> Attr.t -> 'a -> 'a) -> t -> 'a -> 'a
-  val map : (Elem.t -> Attr.t -> 'a2 * 'attr2) -> (Attr.t -> 'attr2) -> t -> ('a2, 'attr2) zlist
+  val iter : (Elem.t -> unit) -> t -> unit
+  val fold_right : (Elem.t -> 'a -> 'a) -> t -> 'a -> 'a
+  val map : (Elem.t -> 'a) -> t -> 'a zlist
   (** Iteration, folding and map *)
 
-  val rev_between : t -> t -> (Elem.t * Attr.t) list
+  val rev_between : t -> t -> Elem.t list
   (** [rev_between t1 t2] returns the elemens between the two steam positions [t1] and [t2].
       [t2] must be a postfix of [t1].
       The elements are returned in the reverse order in the stream.
       This can be quite costy operation. Use with care.
   *)
 
-  val between : t -> t -> (Elem.t * Attr.t) list
+  val between : t -> t -> Elem.t list
   (** Same as [rev_between] but the elements are in the same ordered in the streams.
 
       [between t1 t2] is actually defined as [List.rev (rev_between t1 t2)].