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