Commits

Sébastien Ferré committed 8a39944

Initial revision

Comments (0)

Files changed (1)

+
+open Ipp
+
+class virtual cursor =
+  object
+    method virtual print_string : string -> cursor
+    method print_flush : unit = ()
+    method virtual at_init : bool
+    method virtual init : cursor
+  end
+
+let print_string (v : string) = new operation (fun cursor -> cursor#print_string v)
+let eof () = new operation (fun cursor -> cursor#init)
+
+
+class cursor_buffer (buf : Buffer.t) (offset : int) (suf : string) (p : int) =
+  object (self)
+    inherit cursor
+
+    method print_string s =
+      new cursor_buffer buf offset (suf ^ s) (p + String.length s)
+
+    method at_init = (p = offset)
+
+    method init =
+      Buffer.add_string buf suf;
+      new cursor_buffer buf p "" p
+  end
+let cursor_of_buffer buf = new cursor_buffer buf 0 "" 0
+
+class cursor_string_ref (text : string ref) (offset : int) (suf : string) (p : int) =
+  object (self)
+    inherit cursor
+
+    method print_string s =
+      new cursor_string_ref text offset (suf ^ s) (p + String.length s)
+
+    method at_init = (p = offset)
+
+    method init =
+      text := !text ^ suf;
+      new cursor_string_ref text p "" p
+  end
+let cursor_of_string_ref r = new cursor_string_ref r 0 "" 0
+
+class cursor_formatter (fmt : Format.formatter) (offset : int) (suf : string) (p : int) =
+  (* invariant : result string = buf ^ suf; offset + String.length suf = p *)
+  object (self)
+    inherit cursor
+    method print_string (s : string) =
+      new cursor_formatter fmt offset (suf ^ s) (p + String.length s)
+
+    method print_flush = Format.pp_print_flush fmt ()
+
+    method at_init : bool = (p = offset)
+
+    method init =
+      Format.pp_print_string fmt suf;
+      new cursor_formatter fmt p "" p
+  end
+let cursor_of_formatter fmt = new cursor_formatter fmt 0 "" 0
+