summaryrefslogtreecommitdiff
path: root/stream.sml
blob: 10b02cc9611eabd4a202be4d597643fab2b8faa4 (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
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
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