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 pposCache =
    { id: fileId, fname: string, contents: string,
      offset: fileOffset, line: int, col: int }

  exception UngetcError
  exception InvalidFileInfo

  fun ppos2str (pos, line, col) =
  let
    val % = Int.toString
  in
    case col of
      SOME col => pos ^ ":" ^ %line ^ ":" ^ %col
    | NONE => pos ^ ":" ^ %line
  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

  val calcFilePosFromStart = calcFilePos (0, (1, 1))

  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 ungetc (fid, fname, off, contents) =
    if off = 0 then
      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)

  fun pposWithoutCol (fname, line, SOME _) = (fname, line, NONE)
    | pposWithoutCol (_, _, NONE) = raise Unreachable

  fun getPos (id, _, off, _) = (id, off)

  fun getSubstr startOff endOff (_, _, _, contents) =
      String.substring (contents, startOff, endOff - startOff)

  fun create fname =
  let
    open TextIO

    val h = openIn fname
    val contents = inputAll h
    val () = closeIn h
  in
    (0, fname, 0, contents)
  end

  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 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