Object-like macros

1 files changed, 63 insertions, 96 deletions

diff --git a/stream.sml b/stream.sml
index 4134293..c41eae7 100644
--- a/stream.sml
+++ b/stream.sml
@@ -1,82 +1,57 @@
 structure Stream :> STREAM = struct 
   type fileId = int
   type fileOffset = int
-  type fileInfo = fileId * string * string
 
-  type t = fileId * string * fileOffset * string
+  datatype pos = Pos of string * int * int
 
-  type pos = fileId * fileOffset
-  type ppos = string * int * int option
+  type t = {
+    id: fileOffset,
+    fname: string,
+    off: fileOffset,
+    contents: string,
 
-  type pposCache =
-    { id: fileId, fname: string, contents: string,
-      offset: fileOffset, line: int, col: int }
+    (* offset * line * col *)
+    cache: fileOffset * int * int
+  }
 
+  exception EOF
   exception UngetcError
-  exception InvalidFileInfo
 
-  fun ppos2str (pos, line, col) =
+  val updateStream = fn z =>
+    let
+      fun from id fname off contents cache =
+        { id, fname, off, contents, cache }
+      fun to f { id, fname, off, contents, cache } =
+        f id fname off contents cache
+    in
+      FRU.makeUpdate5 (from, from, to)
+    end
+    z
+
+  fun pos2str (Pos (pos, line, col)) =
   let
     val % = Int.toString
   in
-    case col of
-      SOME col => pos ^ ":" ^ %line ^ ":" ^ %col
-    | NONE => pos ^ ":" ^ %line
+    pos ^ ":" ^ %line ^ ":" ^ %col
   end
 
-  fun convert (fid, fname, _, contents) = (fid, fname, contents)
-
-  fun calcFilePos (startOff, startPos) contents destOff =
-  let
-    fun calc offset (line, col) =
-      if offset = destOff then
-        (line, col)
-      else
-        calc (offset + 1) (if String.sub (contents, offset) = #"\n"
-            then (line + 1, 1) else (line, col + 1))
-  in
-    calc startOff startPos
-  end
+  fun getcharSure (S as { contents, off, ... }: t) =
+      (String.sub (contents, off), updateStream S s#off (off + 1) %)
 
-  val calcFilePosFromStart = calcFilePos (0, (1, 1))
+  fun getchar stream =
+    (fn (c, s) => (SOME c, s)) $ getcharSure stream handle
+        Subscript => (NONE, stream)
 
-  fun getchar (S as (fid, fname, off, contents)) =
-    if off < String.size contents then
-      (SOME $ String.sub (contents, off), (fid, fname, off + 1, contents))
-    else
-      (NONE, S)
+  fun getcharEx stream = getcharSure stream handle Subscript => raise EOF
 
-  fun ungetc (fid, fname, off, contents) =
-    if off = 0 then
+  fun ungetc ({ off = 0, ... }: t) =
       raise UngetcError
-    else
-      (fid, fname, off - 1, contents)
-
-  fun getPosAfterCharRead (fid, _, off, _) = (fid, off - 1)
-
-  fun pos2pposWithFI (id, pos) (id', fname, contents) =
-    if id <> id' then
-      raise InvalidFileInfo
-    else
-    let
-      val (line, col) = calcFilePosFromStart contents pos
-    in
-      (fname, line, SOME col)
-    end
-
-  fun pos2ppos pos stream = pos2pposWithFI pos (convert stream)
+    | ungetc stream = updateStream stream u#off (fn off => off - 1) %
 
-  fun pposWithoutCol (fname, line, SOME _) = (fname, line, NONE)
-    | pposWithoutCol (_, _, NONE) = raise Unreachable
-
-  fun getPos (id, _, off, _) = (id, off)
-
-  fun getSubstr startOff endOff (_, _, _, contents) =
+  fun getSubstr startOff endOff ({ contents, ... }: t) =
       String.substring (contents, startOff, endOff - startOff)
 
-  fun getFname (stream: t) = #2 stream
-
-  val lastUsedId = ref ~1
+  fun getFname ({ fname, ... }: t) = fname
 
   fun createFromInstream fname instream =
   let
@@ -84,47 +59,39 @@ structure Stream :> STREAM = struct
     val contents = inputAll instream
     val () = closeIn instream
   in
-    lastUsedId := !lastUsedId + 1;
-    (!lastUsedId, fname, 0, contents)
+    { id = 0, fname, off = 0, contents, cache = (0, 1, 1) }
   end
 
   fun create fname = createFromInstream fname (TextIO.openIn fname)
 
-  fun isFirstOnLine (_, offset) ((_, _, _, contents) : t) =
-    let
-      fun returnToNL ~1 = true
-        | returnToNL offset =
-        let
-          val chr = String.sub (contents, offset)
-        in
-          if chr = #"\n" then
-            true
-          else if Char.isSpace chr then
-            returnToNL (offset - 1)
-          else
-            false
-        end
-    in
-      returnToNL (offset - 1)
-    end
+  fun getOffset ({ off, ... }: t) = off
+
+  fun getPosRaw off (S as { cache = (prevOff, line, col), fname,
+    contents, ... }: t) =
+  let
+    (*
+    val () = printLn $ "raw: " ^ Int.toString off ^ ", " ^ Int.toString prevOff
+    *)
+
+    fun calcPos curOff (line, col) =
+      if curOff = off then
+        (line, col)
+      else
+        calcPos (curOff + 1)
+            (if String.sub (contents,curOff) = #"\n" then (line + 1, 1)
+               else (line, col + 1))
+    val (line, col) = calcPos prevOff (line, col)
+  in
+    assert $ off >= prevOff;
+    (Pos (fname, line, col), updateStream S s#cache (off, line, col) %)
+  end
+
+  fun getPos (S as { off, ... }: t) =
+    getPosRaw off S
+
+  fun EOFpos (S as { contents, ... }: t) =
+    getPosRaw (String.size contents) S
 
-  fun pposCacheInit (id, fname, contents) =
-    { id, fname, contents, offset = 0, line = 1, col = 1 }
-
-  fun pposCacheAdvance (id, pos) (cache: pposCache) =
-    if id <> #id cache then
-      raise Unreachable
-    else
-      let
-        fun ` f = f cache
-        val p as (line, col) = calcFilePos (` #offset, (` #line, ` #col))
-            (` #contents) pos
-      in
-        (p, { id = ` #id, fname = ` #fname, contents = ` #contents,
-            offset = pos, line, col })
-      end
-
-  fun pposCacheGetId (cache: pposCache) = #id cache
-  fun pposCacheGetLine (cache: pposCache) = #line cache
-  fun pposCacheGetFname (cache: pposCache) = #fname cache
+  fun getPosAfterChar stream =
+    getPosRaw (getOffset stream -1) stream
 end