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
|
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 getFname (stream: t) = #2 stream
val lastUsedId = ref ~1
fun createFromInstream fname instream =
let
open TextIO
val contents = inputAll instream
val () = closeIn instream
in
lastUsedId := !lastUsedId + 1;
(!lastUsedId, fname, 0, contents)
end
fun create fname = createFromInstream fname (TextIO.openIn fname)
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 pposCacheGetId (cache: pposCache) = #id cache
fun pposCacheGetLine (cache: pposCache) = #line cache
fun pposCacheGetFname (cache: pposCache) = #fname cache
end
|
