Partition into structures

1 files changed, 185 insertions, 0 deletions

diff --git a/stream.sml b/stream.sml
new file mode 100644
index 0000000..10b02cc
--- /dev/null
+++ b/stream.sml
@@ -0,0 +1,185 @@
+structure Stream :> STREAM = struct 
+  type fileId = int
+  type fileOffset = int
+  type pos = fileId * fileOffset
+  type convPos = string * int * int option
+
+  type filesInfo = (fileId * string * string) list
+
+  exception EndOfStream
+  exception EndOfFile
+
+  (* unreachable *)
+  exception InvalidStream
+  exception InvalidStreamAdvance
+
+  exception LineWithoutNl
+
+  fun pos2str (pos, line, col) =
+  let
+    val % = Int.toString
+  in
+    case col of
+      SOME col => pos ^ ":" ^ %line ^ ":" ^ %col
+    | NONE => pos ^ ":" ^ %line
+  end
+
+  type t = {
+       (* stack of file ids, file offsets and file contents *)
+       stack: (fileId * fileOffset * string) list,
+       (* list of file ids, file names and file contents *)
+       allFiles: filesInfo
+  }
+
+  fun extractFilesInfo (s: t) = #allFiles s
+
+  fun calcFilePos s offset =
+  let
+    fun calc s cur offset (line, col) =
+      if cur = offset then
+        (line, col)
+      else
+        calc s (cur + 1) offset
+          (if String.sub (s, cur) = #"\n" then (line + 1, 1)
+              else (line, col + 1))
+  in
+    calc s 0 offset (1, 1)
+  end
+
+  fun printPos fileList (id, pos) =
+  let
+    val triple = List.find (fn (fid, _, _) => fid = id) fileList
+  in
+    case triple of
+    NONE => raise InvalidStream
+    | SOME (_, fname, contents) => 
+      let
+        val (line, col) = calcFilePos contents pos
+        val line = Int.toString line
+        val col = Int.toString col
+      in
+        print $ fname ^ ":" ^ line ^ ":" ^ col ^ ": "
+      end
+  end
+
+  fun readFile fname =
+  let
+    open TextIO
+    val h = openIn fname
+    val s = inputAll h
+    val () = closeIn h
+  in
+    s
+  end
+
+  fun getchar
+    ({ stack = (id, off, contents) :: rest, allFiles }: t)
+    : (char * t) =
+    if off < String.size contents then
+      (String.sub (contents, off),
+          { stack = (id, off + 1, contents) :: rest, allFiles })
+    else
+      raise EndOfFile
+    | getchar _ = raise EndOfStream
+
+  fun ungetc
+    ({ stack = (id, off, contents) :: rest, allFiles }) =
+    if off = 0 then
+      raise InvalidStream
+    else
+      { stack = (id, off - 1, contents) :: rest, allFiles }
+    | ungetc _ = raise InvalidStream
+
+  fun readline { stack = (fid, off, contents) :: rest, allFiles } =
+    let
+      val prevIsSlash =
+        off > 0 andalso String.sub (contents, off - 1) = #"\\"
+
+      open String
+      fun read prevIsSlash offset acc =
+      let
+        val c = sub (contents, offset)
+      in
+        if offset = size contents then
+          raise LineWithoutNl
+        else if c = #"\n" then
+          if prevIsSlash then
+            read (c = #"\\") (offset + 1) (#" " :: tl acc)
+          else
+            (implode $ rev acc, offset + 1)
+        else
+          read (c = #"\\") (offset + 1) (c :: acc)
+      end
+
+      val (arg, newOffset) = read prevIsSlash off []
+    in
+      (arg, { stack = (fid, newOffset, contents) :: rest, allFiles })
+    end
+    | readline _ = raise InvalidStream
+
+  fun getOffset ({ stack = (_, off, _) :: _, ... }: t) = off
+    | getOffset _ = raise InvalidStream
+
+  fun getPosAfterCharRead
+    ({ stack = (id, off, _) :: _, ... }: t) = (id, off - 1)
+    | getPosAfterCharRead _ = raise InvalidStream
+
+  fun getPposFromPos (id, pos)
+    { stack = (_, _, _) :: _, allFiles} =
+  let
+    val (fname, contents) =
+      case List.find (fn (fid, _, _) => fid = id) allFiles of
+        NONE => raise InvalidStream
+      | SOME (_, fname, contents) => (fname, contents)
+
+    val (line, col) = calcFilePos contents pos
+  in
+    (fname, line, SOME col)
+  end
+    | getPposFromPos _ _ = raise InvalidStream
+
+  fun getPos ({ stack = (id, off, _) :: _, ... }: t) = (id, off)
+    | getPos _ = raise InvalidStream
+
+  fun getSubstr startOff endOff
+    ({ stack = (_, _, contents) :: _, ... }: t) =
+      String.substring (contents, startOff, endOff - startOff)
+    | getSubstr _ _ _ = raise InvalidStream
+
+  fun advanceToNewFile
+    ({ stack = (_, off, contents) :: rest, allFiles }: t) =
+    if off = String.size contents then
+      { stack = rest, allFiles }
+    else
+      raise InvalidStreamAdvance
+    | advanceToNewFile _ = raise InvalidStreamAdvance
+
+  fun streamInit fname =
+  let
+    val contents = readFile fname
+  in
+    { allFiles = [(0, fname, contents)], stack = [(0, 0, contents)] }
+  end
+
+  fun isFirstOnLine (id, offset) (stream: t) =
+    case List.find (fn (fid, _, _) => id = fid) (#allFiles stream) of
+    NONE => raise InvalidStream
+    | SOME (_, _, contents) =>
+        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
+
+end