summaryrefslogtreecommitdiff
path: root/stream.sml
blob: ff4a6ad49187fb70bf7978633843f92d1a1ce319 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
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 pos2str (Pos (pos, line, col)) =
  let
    val % = Int.toString
  in
    pos ^ ":" ^ %line ^ ":" ^ %col
  end

  fun getcharSure (S as { contents, off, ... }: t) =
      (String.sub (contents, off), updateStream S s#off (off + 1) %)

  fun getchar stream =
    (fn (c, s) => (SOME c, s)) $ getcharSure stream handle
        Subscript => (NONE, stream)

  fun getcharEx stream = getcharSure stream handle Subscript => raise EOF

  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 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 getOffset ({ off, ... }: t) = off

  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 EOFpos (S as { contents, ... }: t) =
    getPosRaw (String.size contents) S

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