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
|
functor Cpp(T: TOKENIZER): CPP = struct
structure T = T
type tkPos = T.S.pos
type t =
{ streams: T.S.t list, fileInfo: T.S.fileInfo list,
lastPos: tkPos option, firstId: T.S.fileId };
datatype tkExp =
Tk of T.token |
Id |
NumConst |
StrLiteral |
UnOp |
BinOp |
Op
type tkExpectedValue = string * tkExp list
exception StreamTooOld
exception TkExpected of tkExpectedValue
fun create fname =
let
val stream = T.S.create fname
val info = T.S.convert stream
in
{ streams = [stream] , fileInfo = [info], lastPos = NONE, firstId = #1 info }
end
fun getToken
({ streams = stream :: tail, fileInfo, lastPos, firstId }: t) =
let
val (tk, stream) = T.getToken stream
in
case tk of
NONE => getToken { streams = tail, fileInfo, lastPos, firstId }
| SOME (pos, tk) =>
( tk, { streams = stream :: tail, fileInfo,
lastPos = SOME pos, firstId })
end
| getToken
{ streams = [], fileInfo, lastPos = SOME lastPos, firstId } =
let
val pos = SOME (#1 lastPos, ~1) (* EOF *)
in
(T.EOS, {streams = [], fileInfo, lastPos = pos, firstId })
end
| getToken { streams = [], fileInfo, lastPos = NONE, firstId } =
(T.EOS, { streams = [], fileInfo,
lastPos = SOME (firstId, ~1), firstId })
fun getLastPos ({ lastPos = NONE, ... }: t) = raise Unreachable
| getLastPos { lastPos = SOME p, ... } = p
val tkExp2str = fn
(Tk tk) => T.token2str tk
| Id: tkExp => "identifier"
| NumConst => "numeric constant"
| StrLiteral => "string literal"
| UnOp => "unary operator"
| BinOp => "binary operator"
| Op => "operator"
fun prepAndRaise (stream: t) (id, pos) expList =
let
val fileInfo =
case List.find (fn (id', _, _) => id' = id) $ #fileInfo stream of
NONE => raise StreamTooOld
| SOME fileInfo => fileInfo
val pos = T.S.ppos2str $ T.S.pos2pposWithFI (id, pos) fileInfo
in
raise TkExpected (pos, expList)
end
fun tkExpectedPrint (pos, expList) =
let
fun tkExps2str [e] [] = tkExp2str e
| tkExps2str [e] acc =
(String.concatWith ", " acc ^ " or ") ^ tkExp2str e
| tkExps2str (e :: ec) acc =
tkExps2str ec (tkExp2str e :: acc)
| tkExps2str [] _ = raise Unreachable
in
print pos;
print ":expected ";
printLn $ tkExps2str expList []
end
fun debugPrint fname =
let
val stream = create fname
val cache = T.S.pposCacheInit $ hd $ #fileInfo stream
fun print' cache stream first =
let
val (tk, stream) = getToken stream
val ` = Int.toString
in
case tk of
T.NewLine => print' cache stream first
| T.EOS => ()
| tk =>
let
val ((line, col), cache') = T.S.pposCacheAdvance
(getLastPos stream) cache
fun printTk () =
print $ `col ^ ":" ^ T.token2str tk ^ " "
in
if T.S.pposCacheGetLine cache = line andalso not first then
printTk ()
else
(if not first then print "\n" else ();
printLn $ T.S.pposCacheGetFname cache' ^ ":" ^ `line;
print "\t";
printTk ());
print' cache' stream false
end
end
in
print' cache stream true;
print "\n"
end
end
|
