structure Stream :> STREAM = struct 
  type fileId = int
  type fileOffset = int

  datatype pos = Pos of string * int * int

  type t = {
    id: fileOffset,
    fname: string,
    off: fileOffset,
    contents: string,

    (* offset * line * col *)
    cache: fileOffset * int * int
  }

  exception EOF
  exception UngetcError

  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 ppos (Pos (fname, line, col)) out =
      Printf out `fname `":" I line `":" I col %
  val Ppos = fn z => bind A1 ppos z

  fun getchar (S as { contents, off, ... }: t) =
    (String.sub (contents, off), updateStream S s#off (off + 1) %)
      handle Subscript => (chr 0, S)

  fun ungetc ({ off = 0, ... }: t) =
      raise UngetcError
    | ungetc stream = updateStream stream u#off (fn off => off - 1) %

  fun getSubstr startOff endOff ({ contents, ... }: t) =
      String.substring (contents, startOff, endOff - startOff)

  fun getLine (S as { contents, off, ... }: t) =
  let
    fun find off =
      if off = size contents then
        NONE
      else
        if String.sub (contents, off) = #"\n" then
          SOME off
        else
          find (off + 1)
  in
    case find off of
      SOME off' =>
        (SOME $ getSubstr off off' S, updateStream S s#off off' %)
    | NONE => (NONE, S)
  end

  fun getFname ({ fname, ... }: t) = fname

  fun createFromInstream fname instream =
  let
    open TextIO
    val contents = inputAll instream
    val () = closeIn instream
  in
    { id = 0, fname, off = 0, contents, cache = (0, 1, 1) }
  end

  fun create fname = createFromInstream fname (TextIO.openIn fname)

  fun createFromString s = createFromInstream s (TextIO.openString s)

  fun getOffset ({ off, ... }: t) = off

  fun isFirstOnLine ({ contents, ... }: t) off =
  let
    fun check (~1) = true
      | check off =
        case String.sub (contents, off) of
          #"\n" => true
        | #" " => check (off - 1)
        | #"\t" => check (off - 1)
        | _ => false
  in
    check (off - 1)
  end

  fun getPosRaw off (S as { cache = (prevOff, line, col), fname,
    contents, ... }: t) =
  let
    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 getPosDisc s = #1 $ getPos s

  fun EOFpos (S as { contents, ... }: t) =
    getPosRaw (String.size contents) S

  fun getPosAfterChar stream =
    getPosRaw (getOffset stream -1) stream
end