Commits

camlspotter committed 3c746a7

cleared pstring.ml

  • Participants
  • Parent commits 8c6d34a

Comments (0)

Files changed (1)

File pstring.ml

-open Utils
-
-module P = Plank.Make(Sbuffer)
-
-include P
-
-let test str (cmb : 'a t) : 'a option =
-  Option.map ~f:fst (cmb (Stream.Char.from_string str)) 
-
-let charp : (char -> bool) -> char t = token
-let char c = charp (fun c' -> c = c')
-
-let _ = 
-  assert (test "xyz" (char 'x') = Some 'x');
-  assert (test "zxy" (charp (fun c -> c = 'x')) = None)
-;;
-
-let string : string -> string t = fun str ->
-  let len = String.length str in
-  let rec aux n =
-    if n = len then return str
-    else char str.[n] >>= fun _ -> aux (n+1)
-  in
-  aux 0 
-
-let _ = 
-  assert (test "hello world" (string "hello") = Some "hello");
-  assert (test "bye world" (string "hello") = None);
-  assert (test "hello world" begin
-    string "hello" >>= fun _ -> 
-      char ' ' >>= fun _ ->
-	string "world" >>= fun _ -> 
-	  eos
-  end = Some ())
-;;
-
-let _ = 
-  assert (test "xxxzzz" begin 
-    star (char 'x') >>= fun xs ->
-      star (char 'y') >>= fun ys ->
-	star (char 'z') >>= fun zs ->
-	  Format.eprintf "xs=%d ys=%d zs=%d@." 
-	    (List.length xs)
-	    (List.length ys)
-	    (List.length zs);
-	  eos
-  end <> None)
-      
-let _ = 
-  assert (test "xxxzzz" begin 
-    plus (char 'x') >>= fun xs ->
-      star (char 'y') >>= fun ys ->
-	plus (char 'z') >>= fun zs ->
-	  Format.eprintf "xs=%d ys=%d zs=%d@." 
-	    (List.length xs)
-	    (List.length ys)
-	    (List.length zs);
-	  eos
-  end <> None);
-  assert (test "xxxzzz" begin 
-    plus (char 'x') >>= fun xs ->
-      plus (char 'y') >>= fun ys ->
-	plus (char 'z') >>= fun zs ->
-	  Format.eprintf "xs=%d ys=%d zs=%d@." 
-	    (List.length xs)
-	    (List.length ys)
-	    (List.length zs);
-	    eos
-  end = None)
-;;
-
-let buffer : 'a t -> Buffer.t t = fun com ->
-  com >>= fun v -> 
-
-let star_gen : Buffer.t -> char t -> Buffer.t t = fun buf com s -> 
-  let rec aux s =
-    match com s with
-    | None -> return buf s
-    | Some (v, s') -> Buffer.add_char buf v; aux s'
-  in
-  aux s
-
-let star : char t -> Buffer.t t = fun com s -> 
-  star_gen (Buffer.create 32) com s
-
-let plus : char t -> Buffer.t t = fun com s ->
-  let buf = Buffer.create 32 in
-  com >>= fun v -> 
-    Buffer.add_char buf v;
-    star_gen buf com s
-