More flexible sexp reading.

sexp.ml

@@ -44,6 +44,20 @@ let rec output_sexp ch x =
       List.iter (output_sexp ch) xs;
       output_char ch ')'
 
+let rec stream_of_sexp x =
+  Stringstream.make (fun () ->
+    match x with
+    | Str s ->
+	Some (string_of_int (String.length s) ^ ":", false, Stringstream.const s)
+    | Hint {hint = h; body = b} ->
+	Some ("[", false,
+	      Stringstream.seq (stream_of_sexp h)
+		(Stringstream.seq (Stringstream.const "]")
+		   (stream_of_sexp b)))
+    | Arr xs ->
+	Some ("(", false,
+	      Stringstream.seq (Stringstream.map stream_of_sexp xs) (Stringstream.const ")")))
+
 let output_char_escaped ch c =
   if c = '\"'
   then output_string ch "\\\""
@@ -79,44 +93,48 @@ let char_whitespace c = c <= ' '
 
 let digit_val c = (int_of_char c) - (int_of_char '0')
 
-let input_bytes count ch =
+let input_bytes ch count =
   let buf = String.create count in (* mutable strings?!?! *)
   really_input ch buf 0 count;
-  Str buf
+  buf
 
 let syntax_error explanation = raise (Syntax_error explanation)
 
-let rec input_simple_string len ch =
+let input_sexp_outer input_char input_bytes =
-  match input_char ch with
+  let rec input_simple_string len =
-  | ':' -> input_bytes len ch
+    match input_char () with
-  | b when char_numeric b -> input_simple_string (len * 10 + digit_val b) ch
+    | ':' -> Str (input_bytes len)
-  | _ -> syntax_error "Bad simple-string length character"
+    | b when char_numeric b -> input_simple_string (len * 10 + digit_val b)
-
+    | _ -> syntax_error "Bad simple-string length character"
-let rec input_sexp_list ch =
+  in
-  let rec collect acc =
+  let rec input_sexp_list () =
-    match input_sexp_inner ch with
+    let rec collect acc =
-    | None -> Arr (List.rev acc)
+      match input_sexp_inner () with
-    | Some v -> collect (v :: acc)
+      | None -> Arr (List.rev acc)
-  in collect []
+      | Some v -> collect (v :: acc)
-
+    in collect []
-and input_sexp_inner ch =
+  and input_sexp_inner () =
-  match input_char ch with
+    match input_char () with
-  | '(' -> Some (input_sexp_list ch)
+    | '(' -> Some (input_sexp_list ())
-  | ')' -> None
+    | ')' -> None
-  | '[' ->
+    | '[' ->
-      let hint = input_simple_string 0 ch in
+	let hint = input_simple_string 0 in
-      (match input_char ch with
+	(match input_char () with
-      | ']' -> Some (Hint {hint = hint; body = input_simple_string 0 ch})
+	| ']' -> Some (Hint {hint = hint; body = input_simple_string 0})
-      | _ -> syntax_error "Missing close-bracket in display hint")
+	| _ -> syntax_error "Missing close-bracket in display hint")
-  | b when char_numeric b ->
+    | b when char_numeric b ->
-      Some (input_simple_string (digit_val b) ch)
+	Some (input_simple_string (digit_val b))
-  | b when char_whitespace b ->
+    | b when char_whitespace b ->
-      (* Convenience for testing *)
+	(* Convenience for testing *)
-      input_sexp_inner ch
+	input_sexp_inner ()
-  | _ ->
+    | _ ->
-      syntax_error "Bad SEXP input character"
+	syntax_error "Bad SEXP input character"
-
+  in
-let input_sexp ch =
+  match input_sexp_inner () with
-  match input_sexp_inner ch with
   | None -> syntax_error "Unexpected end of list"
   | Some v -> v
+
+let input_sexp ch = input_sexp_outer (fun () -> input_char ch) (input_bytes ch)
+let parse b = input_sexp_outer (fun () -> Ibuffer.next_char b) (Ibuffer.next_chars b)
+let sexp_of_string s = parse (Ibuffer.of_string s)
+let string_of_sexp x = Stringstream.to_string (stream_of_sexp x)