Commits

camlspotter committed 2f8f848

positions

Comments (0)

Files changed (9)

    sbuffer
    planck
    plang
-   px
    test
 
 LIB = planck
 open Utils
 
+type 'a simple_gen = 'a Stream.simple_gen
+
 module type S = sig
   type pos
-  module Result : Result.S with type error = string
+  module Result : Result.S with type error = pos * string
   module Stream : Stream.S
   type 'a t = Stream.t -> ('a * Stream.t) Result.t
   include Utils.Monad.T with type 'a t := 'a t
+  val pos : 'a t -> pos t
   val error : string -> 'a t
   val eos : unit t
-  val filter_map : Result.error -> (Stream.elem -> 'a option) -> 'a t
-  val token : Result.error -> Stream.elem -> Stream.elem t
-  val tokenp : Result.error -> (Stream.elem -> bool) -> Stream.elem t
+  val filter_map : string -> (Stream.elem -> 'a option) -> 'a t
+  val token : string -> Stream.elem -> Stream.elem t
+  val tokenp : string -> (Stream.elem -> bool) -> Stream.elem t
   val seq : Stream.elem list -> unit t
   val star : 'a t -> 'a list t
   val star_ : 'a t -> unit t
   val surrounded : 'a t -> 'b t -> 'c t -> 'c t
   val ( <|> ) : 'a t -> 'a t -> 'a t
   val ignore : 'a t -> unit t
+    
+  val stream_gen : 'a option t -> Stream.t -> 'a simple_gen
 end
 
 (* basic *)
 module Make(S : Stream.S) = struct
   type pos = S.pos
-  module Result = Result.Make(struct type error = string end)
+  module Result = Result.Make(struct type error = pos * string end)
   open Result
 
   let take s = match S.take s with
-    | None -> Error "unexpected end of stream"
+    | None -> Error (S.pos s, "unexpected end of stream")
     | Some v -> Ok v
 
   include Monad.Make(struct
       match t st with
       | Result.Ok (r, st') -> f r st' 
       | Result.Error s -> Result.Error s
-  
   end)
 
   open Infix
 
-  let error s : 'a t = fun _st -> Error s
+  let pos : 'a t -> pos t = fun t st ->
+    match t st with
+    | Result.Ok (a, st') -> Result.Ok (S.pos st', st')
+    | Result.Error s -> Result.Error s
+
+  let error s : 'a t = fun st -> Error (S.pos st, s)
 
   let eos : unit t = fun s ->
     match S.take s with
-    | Some _ -> Error "end of stream expected"
+    | Some _ -> Error (S.pos s, "end of stream expected")
     | None -> Ok ((), s)
   
   let filter_map : 'a . string -> (S.elem -> 'a option) -> 'a t = 
-    fun error p s ->
+    fun error_mes p s ->
       Result.bind (take s) (fun (char, s') ->
 	match p char with
-	| None -> Error error
+	| None -> Error (S.pos s, error_mes)
 	| Some v -> Ok (v, s'))
   
   let tokenp : string -> ('a -> bool) -> 'a t = fun error p ->
     | Error e -> Error e
 
   module Stream = S
+
+  let stream_gen (c : 'a option t) (st : Stream.t) =
+    let rec f st () = 
+      match c st with
+      | Result.Ok (None, st') -> f st' ()
+      | Result.Ok (Some token, st') -> `Some (token, f st')
+      | Result.Error (_, "unexpected end of stream") -> `None
+      | Result.Error (_pos, s) -> failwith s (* CR pos *)
+    in
+    f st
+  ;;
 end
 
 module String(S : Stream.S with type elem = char) = struct
+type 'a simple_gen = 'a Stream.simple_gen
+(* CR bad escape *)
+
 module type S = sig
-  module Result : Result.S with type error = string
+  type pos
+  module Result : Result.S with type error = pos * string
   module Stream : Stream.S
-  type pos
   type 'a t = Stream.t -> ('a * Stream.t) Result.t
   include Utils.Monad.T with type 'a t := 'a t
+
+  val pos : 'a t -> pos t
   val error : string -> 'a t
   val eos : unit t
-  val filter_map : Result.error -> (Stream.elem -> 'a option) -> 'a t
-  val token : Result.error -> Stream.elem -> Stream.elem t
-  val tokenp : Result.error -> (Stream.elem -> bool) -> Stream.elem t
+  val filter_map : string -> (Stream.elem -> 'a option) -> 'a t
+  val token : string -> Stream.elem -> Stream.elem t
+  val tokenp : string -> (Stream.elem -> bool) -> Stream.elem t
   val seq : Stream.elem list -> unit t
   val star : 'a t -> 'a list t
   val star_ : 'a t -> unit t
   val surrounded : 'a t -> 'b t -> 'c t -> 'c t
   val ( <|> ) : 'a t -> 'a t -> 'a t
   val ignore : 'a t -> unit t
+
+  val stream_gen : 'a option t -> Stream.t -> 'a simple_gen
 end
 
 module Make (S : Stream.S) : S with module Stream = S
 
 module String (S : Stream.S with type elem = char) : sig
   include S with module Stream = S
+	    and type pos = S.pos
   val string : string -> string t
   val chars_to_string : char list t -> string t
 end
       match t1 st, t2 st with
       | (Result.Ok _ as r), Result.Error _ -> r
       | Result.Error _, (Result.Ok _ as r) -> r
-      | Result.Error e1, Result.Error e2 -> Result.Error (e1 ^ " or " ^ e2)
+      | Result.Error (_pos1, e1), Result.Error (_pos2, e2) -> 
+	  Result.Error (Sbuffer.pos st, e1 ^ " or " ^ e2)
       | (Result.Ok (_, st1) as r1), (Result.Ok (_, st2) as r2) ->
 	  if Sbuffer.bytes st1 >= Sbuffer.bytes st2 then r1 else r2
 end
   | ' ' | '\t' | '\n' | '\r' | '\000' -> true
   | _ -> false)
 
-let stream c st =
-  let rec f st () = 
-    match c st with
-    | P.Result.Ok (None, st') -> f st' ()
-    | P.Result.Ok (Some token, st') -> `Some (token, f st')
-    | P.Result.Error s -> failwith s
-  in
-  f st
-;;
-
 module Token = struct
   type token =
     | Int of int
   type t
   val format : Format.formatter -> t -> unit
   val top : t
+  val none : t
 end
 
 module None = struct
   type t = unit
   let format ppf () = Format.pp_print_string ppf "<no position>"
   let top = ()
+  let none = ()
 end
 
 module File = struct
   let top = { byte = 0; line = 1; column = 0; } 
   let add_newlines t n = { byte = t.byte + n; line = t.line + n; column = 0; }
   let add_columns t n = { t with byte = t.byte + n; column = t.column + n; }
-  let format ppf t = Format.fprintf ppf "line %d, character %d" t.line t.column
+  let none = { byte = -1; line = -1; column = -1; }
+  let format ppf t = 
+    if t.byte < 0 then Format.fprintf ppf "<no location>"
+    else Format.fprintf ppf "line %d, character %d" t.line t.column
 end
 
   include Stream.S with type elem = char
                    and  type gen  = string Stream.simple_gen
 		   and  type pos  = Position.t
-  val pos : t -> Position.t
   val bytes : t -> int
   val substr : t -> int -> int -> string
   val from_string : string -> t
 include Make(M)
 
 let substr = M.substr
-let pos = M.pos
 let bytes = M.bytes
 let from_string = M.from_string
   include Stream.S with type elem = char
                    and  type gen  = string Stream.simple_gen
 		   and  type pos  = Position.t
-  val pos : t -> Position.t
-    (** get the current position of the stream *)
-
   val bytes : t -> int
     (** get the abs byte position *)
 
 	    t := Cons (e, t'); 
 	    Some (e, t')
 	      
-  let pos _t = Position.None.top
+  let pos _t = Position.None.none
 end)
   val empty : t
   val take : t -> (elem * t) option
   val pos : t -> pos
+    (** get the current position of the stream *)
 
   type gen
   val create : gen -> t