Commits

camlspotter committed 4341431

pscheme

Comments (0)

Files changed (16)

 BYTE_ENABLED = $(not $(OCAMLOPT_EXISTS))
 
 
-OCAMLFLAGS    += -annot
+OCAMLFLAGS    += -annot -w Ae
 OCAMLCFLAGS   +=
 OCAMLOPTFLAGS +=
 OCAML_LINK_FLAGS +=
 OCAML_BYTE_LINK_FLAGS +=
 OCAML_NATIVE_LINK_FLAGS +=
 
-# OCAMLPACKS= 
+OCAMLPACKS[]= 
+    sexplib.syntax
+
+OCAMLDEPFLAGS= -syntax camlp4o -package sexplib.syntax
+OCAMLPPFLAGS= -syntax camlp4o -package sexplib.syntax
 
 # OCamlGeneratedFiles(parser.ml lexer.ml)
 
    utils
    position
    result
-   stream
+   pstream
    sbuffer
    planck
    plang
+   pscheme
    test
 
 LIB = planck
 open Utils
 
-type ('a, 'pos) generator = ('a, 'pos) Stream.generator
+type ('a, 'pos) generator = ('a, 'pos) Pstream.generator
 
 module type S = sig
   type pos
   module Result : Result.S with type error = pos * string
-  module Str : Stream.S
+  module Str : Pstream.S
   type 'a t = Str.t -> ('a * Str.t) Result.t
   include Utils.Monad.T with type 'a t := 'a t
-  val pos : 'a t -> pos t
+  val take : Str.elem t
+  val pos : 'a t -> ('a * pos) t
   val error : string -> 'a t
   val eos : unit t
   val filter_map : string -> (Str.elem -> 'a option) -> 'a t
   val ( <|> ) : 'a t -> 'a t -> 'a t
   val ignore : 'a t -> unit t
     
-  val stream_gen : 'a option t -> Str.t -> ('a, pos) generator
+  val stream_gen : 'a option t -> Str.t -> ('a, pos * pos) generator
 end
 
 (* basic *)
-module Make(S : Stream.S) = struct
+module Make(S : Pstream.S) = struct
   type pos = S.pos
+  exception Error of pos * string
   module Result = Result.Make(struct type error = pos * string end)
-  open Result
+  module R = Result
 
   let take s = match S.take s with
-    | None -> Error (S.pos s, "unexpected end of stream")
-    | Some v -> Ok v
+    | None -> R.Error (S.pos s, "unexpected end of stream")
+    | Some v -> R.Ok v
 
   include Monad.Make(struct
     type 'a t = S.t -> ('a * S.t) Result.t
 
   open Infix
 
-  let pos : 'a t -> pos t = fun t st ->
+  let pos : 'a t -> ('a * pos) t = fun t st ->
     match t st with
-    | Result.Ok (a, st') -> Result.Ok (S.pos st', st')
+    | Result.Ok (a, st') -> Result.Ok ((a, S.pos st), st')
     | Result.Error s -> Result.Error s
 
-  let error s : 'a t = fun st -> Error (S.pos st, s)
+  let error s : 'a t = fun st -> R.Error (S.pos st, s)
+    (* CR jfuruse: it takes EOF as an error too. Probably not useful *)
 
   let eos : unit t = fun s ->
     match S.take s with
-    | Some _ -> Error (S.pos s, "end of stream expected")
-    | None -> Ok ((), s)
+    | Some _ -> R.Error (S.pos s, "end of stream expected")
+    | None -> R.Ok ((), s)
   
   let filter_map : 'a . string -> (S.elem -> 'a option) -> 'a t = 
     fun error_mes p s ->
-      Result.bind (take s) (fun (char, s') ->
-	match p char with
-	| None -> Error (S.pos s, error_mes)
-	| Some v -> Ok (v, s'))
-  
-  let tokenp : string -> ('a -> bool) -> 'a t = fun error p ->
+      Result.bind (take s) (fun (elem, s') ->
+	match p elem with
+	| None -> R.Error (S.pos s, error_mes)
+	| Some v -> R.Ok (v, s'))
+
+  let tokenp : string -> (S.elem -> bool) -> S.elem t = fun error p ->
     filter_map error (fun x -> if p x then Some x else None)
   
-  let token : string -> 'a -> 'a t = fun error tkn ->
+  let token : string -> S.elem -> S.elem t = fun error tkn ->
     filter_map error (fun x -> if tkn = x then Some x else None)
   
   let rec seq : S.elem list -> unit t = fun str ->
   let star : 'a . 'a t -> 'a list t = fun com ->
     let rec aux st = fun s ->
       match com s with
-      | Error _ -> return (List.rev st) s
-      | Ok (v, s') -> aux (v :: st) s'
+      | R.Error _ -> return (List.rev st) s
+      | R.Ok (v, s') -> aux (v :: st) s'
     in
     aux []
   
   let star_ : 'a . 'a t -> unit t = fun com ->
     let rec aux = fun s ->
       match com s with
-      | Error _ -> return () s
-      | Ok (v, s') -> aux  s'
+      | R.Error _ -> return () s
+      | R.Ok (_v, s') -> aux  s'
     in
     aux
   
   let (<|>) : 'a t -> 'a t -> 'a t = fun c1 c2 -> 
     fun st ->
       match c1 st with
-      | (Ok _ as res) -> res
-      | Error _ -> c2 st
+      | (R.Ok _ as res) -> res
+      | R.Error _ -> c2 st
 
   let ignore : 'a t -> unit t = fun c st ->
     match c st with
-    | Ok (_,st) -> Ok ((), st)
-    | Error e -> Error e
+    | R.Ok (_,st) -> R.Ok ((), st)
+    | R.Error e -> R.Error e
 
   module Str = S
 
     let rec f st () = 
       match c st with
       | Result.Ok (None, st') -> f st' ()
-      | Result.Ok (Some token, st') -> S.pos st', `Some (token, f st')
-      | Result.Error (_, "unexpected end of stream") -> S.pos st, `None
-      | Result.Error (_pos, s) -> failwith s (* CR pos *)
+      | Result.Ok (Some token, st') -> (S.pos st, S.pos st'), `Some (token, f st')
+      | Result.Error (_, "unexpected end of stream") -> (S.pos st, S.pos st), `None
+      | Result.Error (pos, s) -> raise (Error (pos, s))
     in
     f st
   ;;
 end
 
-module String(S : Stream.S with type elem = char) = struct
+module String(S : Pstream.S with type elem = char) = struct
 
   include Make(S)
 
-type ('a, 'pos) generator = ('a, 'pos) Stream.generator
+type ('a, 'pos) generator = ('a, 'pos) Pstream.generator
 (* CR bad escape *)
 
 module type S = sig
   type pos
   module Result : Result.S with type error = pos * string
-  module Str : Stream.S
+  module Str : Pstream.S
   type 'a t = Str.t -> ('a * Str.t) Result.t
   include Utils.Monad.T with type 'a t := 'a t
 
-  val pos : 'a t -> pos t
+  val take : Str.elem t
+  val pos : 'a t -> ('a * pos) t
   val error : string -> 'a t
   val eos : unit t
   val filter_map : string -> (Str.elem -> 'a option) -> 'a t
   val ( <|> ) : 'a t -> 'a t -> 'a t
   val ignore : 'a t -> unit t
 
-  val stream_gen : 'a option t -> Str.t -> ('a, pos) generator
+  val stream_gen : 'a option t -> Str.t -> ('a, pos * pos) generator
 end
 
-module Make (S : Stream.S) : S with module Str = S
+module Make (S : Pstream.S) : S 
+  with module Str = S
+  and  type pos = S.pos
 
-module String (S : Stream.S with type elem = char) : sig
+module String (S : Pstream.S with type elem = char) : sig
   include S with module Str = S
-	    and type pos = S.pos
+	    and type pos = S.pos	
   val string : string -> string t
   val chars_to_string : char list t -> string t
 end
-
   module Char = Char
 end
 
-module type PString = module type of Planck.String(Sbuffer)
+module type P = sig
+  include Planck.S with type Str.elem = Sbuffer.elem
+                   and  type Str.t = Sbuffer.t
+		   and  type pos = Sbuffer.pos
+  val string : string -> string t
+  val chars_to_string : char list t -> string t
 
-module type P = sig
-  include PString (* OCaml cannot permit writing module type of Planck.String(Sbuffer) *)
   type mark
   val mark : mark t
   val string_from_mark : mark -> string t
   type mark = Sbuffer.t * int (* abs_pos *)
 
   let mark : mark t = fun st -> 
-    let abs_pos = (Sbuffer.pos st).Sbuffer.Pos.byte in
+    let abs_pos = (Sbuffer.pos st).Position.File.byte in
     Result.Ok ((st, abs_pos), st)
 
   let string_from_mark : mark -> string t = fun (sbuf, start_pos) st ->
-    let end_pos = (Sbuffer.pos st).Sbuffer.Pos.byte in
+    let end_pos = (Sbuffer.pos st).Position.File.byte in
     let str = Sbuffer.substr sbuf start_pos (end_pos - start_pos) in
     Result.Ok (str, st)
 
     | String of string
     | LIdent of string
     | UIdent of string
+    | LParen
+    | RParen
+  with sexp
 
   type token = t
-  module Str = Stream.Simple(struct type t = token end)(Sbuffer.Pos)
 
-  let lex : token option P.t =
-    let open P in
+  open P
+  let lex : token option P.t = 
+    let ret v = return (Some v) in
     (plus_ whitespace >>= fun _ -> return None)
-	<|> ((
-	  (Literal.char >>= fun c -> return (Char c))
-	  <|> (Literal.string >>= fun s -> return (String s))
-	    <|> (Literal.nat_int >>= fun i -> return (Int i))
-	      <|> (Identifier.lowercase >>= fun s -> return (LIdent s))
-		<|> (Identifier.uppercase >>= fun s -> return (UIdent s))
-		  <|> error "Unexpected token"
-	) >>= fun v -> return (Some v))
+    <|> (
+      (token "( expected" '(' >>= fun _ -> ret LParen)
+      <|> (token ") expected" ')' >>= fun _ -> ret RParen)
+      <|> (Literal.char >>= fun c -> ret (Char c))
+      <|> (Literal.string >>= fun s -> ret (String s))
+      <|> (Literal.nat_int >>= fun i -> ret (Int i))
+      <|> (Identifier.lowercase >>= fun s -> ret (LIdent s))
+      <|> (Identifier.uppercase >>= fun s -> ret (UIdent s))
+      <|> (take >>= fun c -> error (Printf.sprintf "Unexpected char %C" c))
+    )  
     
-  let stream st = Str.create (P.stream_gen lex st)
+  module Str = Pstream.Simple(struct type t = token end)(Position.Region)
+
+  let rec regionize gen =
+    fun () -> 
+      let (pos1, pos2), res = gen () in
+      let pos = { Position.Region.start = pos1; end_ = pos2 } in
+      let res = match res with
+	| `None -> `None
+	| `Some (v, gen) -> `Some (v, regionize gen)
+      in
+      pos, res
+
+  let stream st = Str.create (regionize (P.stream_gen lex st))
 end
 
 include P
+
+module Test = struct
+  let f t str =
+    let stream = Sbuffer.from_string str in
+    match t stream with
+    | Result.Error _ -> None
+    | Result.Ok (v,_) -> Some v
+
+  let literal_ident () =
+    prerr_endline "Plang.Test.literal_ident ...";
+    assert (f Literal.char "'x'" = Some 'x');
+    assert (f Literal.char "'xx'" = None);
+    assert (f Literal.char "'\n'" = Some '\n');
+    assert (f Literal.char "'\\''" = Some '\'');
+    assert (f Literal.char "'\\x41'" = Some 'A');
+    assert (f Literal.char "'\\o101'" = Some 'A');
+    assert (f Literal.char "'\\065'" = Some 'A');
+    assert (f Literal.string "\"hello world\"" = Some "hello world");
+    assert (f Literal.string "\"hello\\nworld\"" = Some "hello\nworld");
+    assert (f Literal.nat_int "0123" = Some 123);
+    assert (f Literal.nat_int "0o10" = Some 8);
+    assert (f Literal.nat_int "0x10" = Some 16);
+    assert (f Identifier.lowercase "hello42World_\'*" = Some "hello42World_\'");
+    assert (f Identifier.uppercase "Hello42World_\'*" = Some "Hello42World_\'");
+    assert (f (Literal.Num.digit </> Literal.Num.hex) "0x10" = Some { Literal.Num.base = 16; rev_nums = [0; 1] });
+    prerr_endline "Plang.Test.literal_ident done"
+  ;;
+
+  open Token
+  let lex () = 
+    prerr_endline "Plang.Test.lex ...";
+    assert (Token.Str.to_list (Token.stream (Sbuffer.from_string "(hello 24 world)"))
+	      = [ LParen; LIdent "hello"; Int 24; LIdent "world"; RParen ]);
+    prerr_endline "Plang.Test.lex done"
+end
-module type PString = module type of Planck.String(Sbuffer)
+module type P = sig
+  include Planck.S with type Str.elem = Sbuffer.elem
+                   and  type Str.t = Sbuffer.t
+		   and  type pos = Sbuffer.pos
+  val string : string -> string t
+  val chars_to_string : char list t -> string t
 
-module type P = sig
-  include PString (* OCaml cannot permit writing module type of Planck.String(Sbuffer) *)
   type mark
   val mark : mark t
   val string_from_mark : mark -> string t
     | String of string
     | LIdent of string
     | UIdent of string
+    | LParen
+    | RParen
+  with sexp
 
   val lex : t option P.t
 
-  module Str : Stream.S 
-    with type pos = Sbuffer.pos
+  module Str : Pstream.S 
+    with type pos = Position.Region.t
     and type elem = t
   val stream : Sbuffer.t -> Str.t
 end
 
 include P
+
+module Test : sig
+  val literal_ident : unit -> unit
+  val lex : unit -> unit
+end
   let none = ()
 end
 
-module File = struct
+module type File = sig
+  type t = {
+    byte : int; (* in bytes from 0 *)
+    line : int; (* from 1 *)
+    column : int; (* in bytes from 0 *)
+  }
+
+  val top : t
+  val add_newlines : t -> int -> t
+  val add_columns : t -> int -> t
+  val none : t
+  val format : Format.formatter -> t -> unit
+end
+
+module File : File = struct
   type t = {
     byte : int; (* in bytes from 0 *)
     line : int; (* from 1 *)
     else Format.fprintf ppf "line %d, character %d" t.line t.column
 end
 
+module Region = struct
+  type t = {
+    start : File.t;
+    end_ : File.t;
+  }
+
+  let top = { start = File.top; end_ = File.top }
+  let none = { start = File.none; end_ = File.none }
+  let format ppf t = 
+    if t.start.File.byte < 0 then Format.fprintf ppf "<no location>"
+    else 
+      let diff = t.end_.File.byte - t.start.File.byte in
+      Format.fprintf ppf "line %d, character %d-%d" t.start.File.line t.start.File.column (t.start.File.column + diff)
+end
+
+open Utils
+
+module T = Plang.Token
+module P = Planck.Make(T.Str)
+
+open P
+
+module Lang = struct
+  type desc = 
+    | Int of int
+    | Char of char
+    | String of string
+    | LIdent of string
+    | UIdent of string
+    | Unit
+    | App of t list
+
+  and t = { desc : desc; pos : Position.Region.t }
+
+  let rec format ppf exp = match exp.desc with
+    | Int n -> Format.fprintf ppf "%d" n
+    | Char c -> Format.fprintf ppf "%C" c
+    | String s -> Format.fprintf ppf "%S" s
+    | LIdent s -> Format.fprintf ppf "%s" s
+    | UIdent s -> Format.fprintf ppf "%s" s
+    | Unit -> Format.fprintf ppf "()"
+    | App ts -> 
+      Format.fprintf ppf "(@[%a@])"
+	(Format.list (fun ppf -> Format.fprintf ppf "@ ") format)
+	ts
+end
+
+open Lang
+
+let lparen = token "( expected" T.LParen
+let rparen = token ") expected" T.RParen
+
+let with_pos t = pos t >>= fun (desc, pos) -> 
+  return { desc = desc; pos = pos }
+
+let literal = filter_map "" (function 
+  | T.Int n -> Some (Int n)
+  | T.Char c -> Some (Char c)
+  | T.String s -> Some (String s)
+  | _ -> None)
+
+let ident = filter_map "" (function
+  | T.LIdent s -> Some (LIdent s)
+  | T.UIdent s -> Some (UIdent s)
+  | _ -> None)
+
+let rec parened = fun x -> begin
+  surrounded lparen rparen (star expr)
+  >>= function
+    | [] -> return Unit
+    | l -> return (App l)
+end x
+    
+and expr = fun x -> begin
+  with_pos (literal <|> ident <|> parened)
+end x
+
+module Test = struct
+  open Lang
+  type tokens = T.t list with sexp
+  let _ = 
+    let str = T.stream (Sbuffer.from_string "(hello 24 world)") in
+    Format.eprintf "%a@." Sexplib.Sexp.pp_hum (sexp_of_tokens (T.Str.to_list str));
+    match expr str with
+    | Result.Error (pos, err) -> 
+        Format.eprintf "ERROR: %a : %s@." Position.Region.format pos  err
+    | Result.Ok (e, _) -> 
+        Format.eprintf "%a@." Lang.format e
+  ;;
+end
+module P : sig
+  include Planck.S with type Str.elem = Plang.Token.t
+	           and  type Str.t = Plang.Token.Str.t
+		   and  type pos = Position.Region.t
+end
+
+module Lang : sig
+  type desc = 
+    | Int of int
+    | Char of char
+    | String of string
+    | LIdent of string
+    | UIdent of string
+    | Unit
+    | App of t list
+
+  and t = { desc : desc; pos : Position.Region.t }
+end
+
+val expr : Lang.t P.t
+open Utils
+
+module type S0 = sig
+  type t (** type of the stream *)
+  type elem (** element of the stream *)
+  type pos (** position of the stream *)
+
+  val empty : t
+  val take : t -> (elem * t) option
+  val pos : t -> pos
+
+  type gen
+  val create : gen -> t
+end
+
+module type S = sig
+  include S0
+  val peek : t -> elem option
+  val is_empty : t -> bool
+  val to_list : t -> elem list
+end
+
+module Make(S0 : S0) = struct
+  include S0
+  let peek t = Option.map (take t) ~f:fst
+  let is_empty t = peek t = None
+  let to_list t = 
+    let rec to_list st t = match take t with
+      | None -> List.rev st
+      | Some (elem, t) -> to_list (elem :: st) t
+    in
+    to_list [] t
+end
+
+type ('a, 'pos) generator = unit -> 'pos * [ `None | `Some of 'a * ('a, 'pos) generator ]
+
+module Simple(E : sig type t end)(Pos : Position.S) = Make(struct
+  type pos = Pos.t
+  type elem = E.t
+  type gen = (elem, pos) generator
+  (* One of bad things in OCaml: the following is impossible. *)
+  (* type gen = unit -> (elem * gen) option *)
+
+  type t = desc ref
+  and desc = 
+    | Lazy of gen
+    | Cons of elem * pos * t
+    | Null of pos
+
+  let create gen = ref (Lazy gen)
+
+  let empty = ref (Null Pos.top)
+
+  let force t = match !t with
+    | Cons _ | Null _ -> !t
+    | Lazy gen -> match gen () with
+      | pos, `None -> t := Null pos; !t
+      | pos, `Some (v, gen) -> t := Cons (v, pos, create gen); !t
+
+  let rec pos t = match force t with
+    | Cons (_, pos, _) | Null pos -> pos
+    | Lazy _ -> assert false
+
+  let rec take t = match force t with
+    | Null _pos -> None
+    | Cons (e, _pos, t) -> Some (e, t)
+    | Lazy _ -> assert false
+end)
+(* Stream (lazy list) monad *)
+
+module type S0 = sig
+  type t
+
+  type pos
+  type elem
+  type gen
+
+  val empty : t
+  val take : t -> (elem * t) option
+  val pos : t -> pos
+    (** get the current position of the stream *)
+
+  val create : gen -> t
+end
+
+module type S = sig
+  include S0
+  val peek : t -> elem option
+  val is_empty : t -> bool
+  val to_list : t -> elem list
+end
+
+module Make(S0 : S0) : S 
+  with type t = S0.t
+  and  type pos = S0.pos
+  and  type elem = S0.elem
+  and  type gen = S0.gen
+
+type ('a, 'pos) generator = unit -> 'pos * [ `None 
+					   | `Some of 'a * ('a, 'pos) generator ]
+ 
+module Simple(E : sig type t end)(Pos : Position.S) : S 
+  with type elem = E.t 
+  and  type gen = (E.t, Pos.t) generator
+  and  type pos = Pos.t
 open Utils
-open Stream
+open Pstream
 
 (* string stream. Not of char. *)
 module Simple_string : sig
-  include Stream.S with type elem = string 
-		   and  type gen = (string, Position.None.t) Stream.generator
+  include Pstream.S with type elem = string 
+		   and  type gen = (string, Position.None.t) Pstream.generator
 		   and  type pos = Position.None.t
   val from_string : string -> t
 end = struct
 end
 
 module type S = sig
-  module Pos : module type of Position.File  
-  include Stream.S with type elem = char
-                   and  type gen  = (string, Position.None.t) Stream.generator
-		   and  type pos  = Pos.t
+  include Pstream.S with type elem = char
+                   and  type gen  = (string, Position.None.t) Pstream.generator
+		   and  type pos  = Position.File.t
   val bytes : t -> int
   val substr : t -> int -> int -> string
   val from_string : string -> t
   let pos t = t.abs_pos
 end
 
-include Stream.Make(M)
+include Pstream.Make(M)
 
 open M
 
 (* Stream specialized for String *)
 
 module type S = sig
-  module Pos : module type of Position.File
-  include Stream.S with type elem = char
-                   and  type gen  = (string, Position.None.t) Stream.generator
-		   and  type pos  = Pos.t
+  include Pstream.S with type elem = char
+                   and  type gen  = (string, Position.None.t) Pstream.generator
+		   and  type pos  = Position.File.t
   val bytes : t -> int
     (** get the abs byte position *)
 

stream.ml

-open Utils
-
-module type S0 = sig
-  type elem
-  type t
-  type pos 
-
-  val empty : t
-  val take : t -> (elem * t) option
-  val pos : t -> pos
-
-  type gen
-  val create : gen -> t
-end
-
-module type S = sig
-  include S0
-  val peek : t -> elem option
-  val is_empty : t -> bool
-end
-
-module Make(S0 : S0) = struct
-  include S0
-  let peek t = Option.map (take t) ~f:fst
-  let is_empty t = peek t = None
-end
-
-type ('a, 'pos) generator = unit -> 'pos * [ `None | `Some of 'a * ('a, 'pos) generator ]
-
-module Simple(E : sig type t end)(Pos : Position.S) = Make(struct
-  type pos = Pos.t
-  type elem = E.t
-  type gen = (elem, pos) generator
-  (* One of bad things in OCaml: the following is impossible. *)
-  (* type gen = unit -> (elem * gen) option *)
-
-  type t = desc ref
-  and desc = 
-    | Lazy of gen
-    | Cons of elem * pos * t
-    | Null of pos
-
-  let create gen = ref (Lazy gen)
-
-  let empty = ref (Null Pos.top)
-
-  let force t = match !t with
-    | Cons _ | Null _ -> !t
-    | Lazy gen -> match gen () with
-      | pos, `None -> t := Null pos; !t
-      | pos, `Some (v, gen) -> t := Cons (v, pos, create gen); !t
-
-  let rec pos t = match force t with
-    | Cons (_, pos, _) | Null pos -> pos
-    | Lazy _ -> assert false
-
-  let rec take t = match force t with
-    | Null _pos -> None
-    | Cons (e, _pos, t) -> Some (e, t)
-    | Lazy _ -> assert false
-end)

stream.mli

-(* Stream (lazy list) monad *)
-
-module type S0 = sig
-  type pos
-  type elem
-  type t
-  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
-end
-
-module type S = sig
-  include S0
-  val peek : t -> elem option
-  val is_empty : t -> bool
-end
-
-module Make(S0 : S0) : S 
-  with type pos = S0.pos
-  and  type elem = S0.elem
-  and  type gen = S0.gen
-  and  type t = S0.t
-
-type ('a, 'pos) generator = unit -> 'pos * [ `None | `Some of 'a * ('a, 'pos) generator ]
- 
-module Simple(E : sig type t end)(Pos : Position.S) : S 
-  with type elem = E.t 
-  and  type gen = (E.t, Pos.t) generator
-  and  type pos = Pos.t
-open Plang
+let test () = 
+  Plang.Test.literal_ident ();
+  Plang.Test.lex ()
 
-let test t str =
-  let stream = Sbuffer.from_string str in
-  match t stream with
-  | Result.Error _ -> None
-  | Result.Ok (v,_) -> Some v
+let _ = test ()
 
-let _ = 
-  assert (test Literal.char "'x'" = Some 'x');
-  assert (test Literal.char "'xx'" = None);
-  assert (test Literal.char "'\n'" = Some '\n');
-  assert (test Literal.char "'\\''" = Some '\'');
-  assert (test Literal.char "'\\x41'" = Some 'A');
-  assert (test Literal.char "'\\o101'" = Some 'A');
-  assert (test Literal.char "'\\065'" = Some 'A');
-  assert (test Literal.string "\"hello world\"" = Some "hello world");
-  assert (test Literal.string "\"hello\\nworld\"" = Some "hello\nworld");
-  assert (test Literal.nat_int "0123" = Some 123);
-  assert (test Literal.nat_int "0o10" = Some 8);
-  assert (test Literal.nat_int "0x10" = Some 16);
-  assert (test Identifier.lowercase "hello42World_\'*" = Some "hello42World_\'");
-  assert (test Identifier.uppercase "Hello42World_\'*" = Some "Hello42World_\'");
-  assert (test (Literal.Num.digit </> Literal.Num.hex) "0x10" = Some { Literal.Num.base = 16; rev_nums = [0; 1] });
-  prerr_endline "test done"
-
-
+  
   let add t k = if not (mem t k) then Hashtbl.add t k ()
   let remove = Hashtbl.remove
 end
+
+module Format = struct
+  include Format
+
+  let rec list sep f ppf = function
+    | [] -> ()
+    | [x] -> f ppf x
+    | x::xs ->
+      fprintf ppf "%a%t%a"
+        f x
+        sep
+        (list sep f) xs
+end
+
+