Commits

camlspotter  committed e139872

string literal

  • Participants
  • Parent commits 4309ac6

Comments (0)

Files changed (4)

 open Utils
 
+module type S = sig
+  module Result : Result.S with type error = 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 error : 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 seq : Stream.elem list -> unit t
+  val star : 'a t -> 'a list t
+  val plus : 'a t -> 'a list t
+  val surrounded : 'a t -> 'b t -> 'c t -> 'c t
+  val ( <|> ) : 'a t -> 'a t -> 'a t
+end
+
 (* basic *)
 module Make(S : Stream.S) = struct
 
       match c1 st with
       | (Ok _ as res) -> res
       | Error _ -> c2 st
+
+  module Stream = S
 end
+
+module String(S : Stream.S with type elem = char) = struct
+
+  include Make(S)
+
+  open Infix
+
+  (* CR jfuruse: this should be in Planck *)
+  let rec string : string -> string t = 
+    fun str -> 
+      let len = String.length str in
+      let rec aux pos = 
+	if pos = len then return ()
+	else tokenp (Printf.sprintf "%S expected" str) (fun c -> c = str.[pos]) >>= fun _ -> aux (pos+1)
+      in
+      aux 0 >>= fun () -> return str
+
+  let chars_to_string : char list t -> string t = fun chars ->
+    chars >>= fun chars ->
+      let len = List.length chars in
+      let s = String.create len in
+      let rec fill pos = function
+	| [] -> s
+	| x::xs ->
+	    s.[pos] <- x;
+	    fill (pos+1) xs
+      in
+      return (fill 0 chars)
+end
-module Make (S : Stream.S) : sig
+module type S = sig
   module Result : Result.S with type error = string
-  type 'a t = S.t -> ('a * S.t) Result.t
+  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 error : unit t
-  val filter_map : Result.error -> (S.elem -> 'a option) -> 'a t
-  val token : Result.error -> S.elem -> S.elem t
-  val tokenp : Result.error -> (S.elem -> bool) -> S.elem t
-  val seq : S.elem list -> 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 seq : Stream.elem list -> unit t
   val star : 'a t -> 'a list t
   val plus : 'a t -> 'a list t
   val surrounded : 'a t -> 'b t -> 'c t -> 'c t
   val ( <|> ) : 'a t -> 'a t -> 'a t
 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
+  val string : string -> string t
+  val chars_to_string : char list t -> string t
+end
+
-include Planck.Make(Sbuffer)
-
-let rec string : string -> string t = 
-  fun str -> 
-    let len = String.length str in
-    let rec aux pos = 
-      if pos = len then return ()
-      else tokenp (Printf.sprintf "%S expected" str) (fun c -> c = str.[pos]) >>= fun _ -> aux (pos+1)
-    in
-    aux 0 >>= fun () -> return str
+include Planck.String(Sbuffer)
 
 let digit_char =
   tokenp "digit expected" (function
 	      return (char_of_int (c1 * 100 + c2 * 10 + c3))
   in
   let dquote = token "" '\"' in
-  surrounded dquote dquote (star (normal <|> backslashed <|> hex <|> oct <|> digit))
+  surrounded dquote dquote (chars_to_string (star (normal <|> backslashed <|> hex <|> oct <|> digit)))
   assert (test char "'\\x41'" = Some 'A');
   assert (test char "'\\o101'" = Some 'A');
   assert (test char "'\\065'" = Some 'A');
+  assert (test string "\"hello world\"" = Some "hello world");
   prerr_endline "test done"