From 8e2dc7712de206b87e1c46df9383c3fa1e18a43a Mon Sep 17 00:00:00 2001
From: Vladimir Azarov <avm@intermediate-node.net>
Date: Sun, 6 Apr 2025 23:22:30 +0200
Subject: Debug print preprocessor function

---
 stream.sml | 54 +++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 35 insertions(+), 19 deletions(-)

(limited to 'stream.sml')

diff --git a/stream.sml b/stream.sml
index bc9048b..a6afa31 100644
--- a/stream.sml
+++ b/stream.sml
@@ -1,9 +1,16 @@
 structure Stream :> STREAM = struct 
   type fileId = int
   type fileOffset = int
+  type fileInfo = fileId * string * string
+
+  type t = fileId * string * fileOffset * string
+
   type pos = fileId * fileOffset
   type ppos = string * int * int option
-  type fileInfo = fileId * string * string
+
+  type pposCache =
+    { id: fileId, fname: string, contents: string,
+      offset: fileOffset, line: int, col: int }
 
   exception UngetcError
   exception InvalidFileInfo
@@ -17,31 +24,21 @@ structure Stream :> STREAM = struct
     | NONE => pos ^ ":" ^ %line
   end
 
-  type t = fileId * string * fileOffset * string
-
   fun convert (fid, fname, _, contents) = (fid, fname, contents)
 
-  fun calcFilePos s offset =
+  fun calcFilePos (startOff, startPos) contents destOff =
   let
-    fun calc s cur offset (line, col) =
-      if cur = offset then
+    fun calc offset (line, col) =
+      if offset = destOff then
         (line, col)
       else
-        calc s (cur + 1) offset
-          (if String.sub (s, cur) = #"\n" then (line + 1, 1)
-              else (line, col + 1))
+        calc (offset + 1) (if String.sub (contents, offset) = #"\n"
+            then (line + 1, 1) else (line, col + 1))
   in
-    calc s 0 offset (1, 1)
+    calc startOff startPos
   end
 
-  fun printPos (_, fname, contents) (_, pos) =
-  let
-    val (line, col) = calcFilePos contents pos
-    val line = Int.toString line
-    val col = Int.toString col
-  in
-    print $ fname ^ ":" ^ line ^ ":" ^ col ^ ": "
-  end
+  val calcFilePosFromStart = calcFilePos (0, (1, 1))
 
   fun getchar (S as (fid, fname, off, contents)) =
     if off < String.size contents then
@@ -62,7 +59,7 @@ structure Stream :> STREAM = struct
       raise InvalidFileInfo
     else
     let
-      val (line, col) = calcFilePos contents pos
+      val (line, col) = calcFilePosFromStart contents pos
     in
       (fname, line, SOME col)
     end
@@ -105,4 +102,23 @@ structure Stream :> STREAM = struct
     in
       returnToNL (offset - 1)
     end
+
+  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 pposCacheGetLine (cache: pposCache) = #line cache
+  fun pposCacheGetFname (cache: pposCache) = #fname cache
 end
-- 
cgit v1.2.3