adamc@763
|
1 (* -*- mode: sml-lex -*- *)
|
adamc@763
|
2
|
adamc@763
|
3 (* Copyright (c) 2008-2009, Adam Chlipala
|
adamc@1
|
4 * All rights reserved.
|
adamc@1
|
5 *
|
adamc@1
|
6 * Redistribution and use in source and binary forms, with or without
|
adamc@1
|
7 * modification, are permitted provided that the following conditions are met:
|
adamc@1
|
8 *
|
adamc@1
|
9 * - Redistributions of source code must retain the above copyright notice,
|
adamc@1
|
10 * this list of conditions and the following disclaimer.
|
adamc@1
|
11 * - Redistributions in binary form must reproduce the above copyright notice,
|
adamc@1
|
12 * this list of conditions and the following disclaimer in the documentation
|
adamc@1
|
13 * and/or other materials provided with the distribution.
|
adamc@1
|
14 * - The names of contributors may not be used to endorse or promote products
|
adamc@1
|
15 * derived from this software without specific prior written permission.
|
adamc@1
|
16 *
|
adamc@1
|
17 * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
|
adamc@1
|
18 * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
|
adamc@1
|
19 * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
|
adamc@1
|
20 * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
|
adamc@1
|
21 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
|
adamc@1
|
22 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
|
adamc@1
|
23 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
|
adamc@1
|
24 * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
|
adamc@1
|
25 * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
|
adamc@1
|
26 * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
|
adamc@1
|
27 * POSSIBILITY OF SUCH DAMAGE.
|
adamc@1
|
28 *)
|
adamc@1
|
29
|
adamc@244
|
30 (* Lexing info for Ur/Web programs *)
|
adamc@1
|
31
|
adamc@1
|
32 type pos = int
|
adamc@1
|
33 type svalue = Tokens.svalue
|
adamc@1
|
34 type ('a,'b) token = ('a,'b) Tokens.token
|
adamc@1
|
35 type lexresult = (svalue,pos) Tokens.token
|
adamc@1
|
36
|
adam@1283
|
37 val commentOut = ref (fn () => ())
|
adam@1283
|
38
|
adamc@1
|
39 local
|
adamc@1
|
40 val commentLevel = ref 0
|
adamc@1
|
41 val commentPos = ref 0
|
adamc@1
|
42 in
|
adam@1741
|
43 fun reset () =
|
adam@1741
|
44 (commentLevel := 0;
|
adam@1741
|
45 commentPos := 0)
|
adam@1741
|
46
|
adamc@1
|
47 fun enterComment pos =
|
adamc@1
|
48 (if !commentLevel = 0 then
|
adamc@1
|
49 commentPos := pos
|
adamc@1
|
50 else
|
adamc@1
|
51 ();
|
adamc@1
|
52 commentLevel := !commentLevel + 1)
|
adamc@1
|
53
|
adamc@1
|
54 fun exitComment () =
|
adamc@1
|
55 (ignore (commentLevel := !commentLevel - 1);
|
adam@1283
|
56 if !commentLevel = 0 then
|
adam@1283
|
57 !commentOut ()
|
adam@1283
|
58 else
|
adam@1283
|
59 ())
|
adamc@1
|
60
|
adamc@1
|
61 fun eof () =
|
adamc@1
|
62 let
|
adamc@1
|
63 val pos = ErrorMsg.lastLineStart ()
|
adamc@1
|
64 in
|
adamc@1
|
65 if !commentLevel > 0 then
|
adamc@1
|
66 ErrorMsg.errorAt' (!commentPos, !commentPos) "Unterminated comment"
|
adamc@1
|
67 else
|
adamc@1
|
68 ();
|
adamc@1
|
69 Tokens.EOF (pos, pos)
|
adamc@1
|
70 end
|
adamc@1
|
71 end
|
adamc@1
|
72
|
adamc@229
|
73 val strEnder = ref #"\""
|
adamc@14
|
74 val str = ref ([] : char list)
|
adamc@14
|
75 val strStart = ref 0
|
adamc@14
|
76
|
adamc@54
|
77 local
|
adamc@54
|
78 val initSig = ref false
|
adamc@54
|
79 val offset = ref 0
|
adamc@54
|
80 in
|
adamc@54
|
81
|
adamc@54
|
82 fun initialSig () = initSig := true
|
adamc@54
|
83
|
adamc@54
|
84 fun pos yypos = yypos - !offset
|
adamc@54
|
85
|
adamc@54
|
86 fun newline yypos =
|
adamc@54
|
87 if !initSig then
|
adamc@54
|
88 (initSig := false;
|
adamc@54
|
89 offset := yypos + 1)
|
adamc@54
|
90 else
|
adamc@54
|
91 ErrorMsg.newline (pos yypos)
|
adamc@54
|
92
|
adamc@54
|
93 end
|
adamc@54
|
94
|
adamc@91
|
95 val xmlTag = ref ([] : string list)
|
adamc@91
|
96 val xmlString = ref true
|
adamc@91
|
97 val braceLevels = ref ([] : ((unit -> unit) * int) list)
|
adamc@91
|
98
|
adamc@91
|
99 fun pushLevel s = braceLevels := (s, 1) :: (!braceLevels)
|
adamc@91
|
100
|
adamc@91
|
101 fun enterBrace () =
|
adamc@91
|
102 case !braceLevels of
|
adamc@91
|
103 (s, i) :: rest => braceLevels := (s, i+1) :: rest
|
adamc@91
|
104 | _ => ()
|
adamc@91
|
105
|
adamc@91
|
106 fun exitBrace () =
|
adamc@91
|
107 case !braceLevels of
|
adamc@91
|
108 (s, i) :: rest =>
|
adamc@91
|
109 if i = 1 then
|
adamc@91
|
110 (braceLevels := rest;
|
adamc@91
|
111 s ())
|
adamc@91
|
112 else
|
adamc@91
|
113 braceLevels := (s, i-1) :: rest
|
adamc@91
|
114 | _ => ()
|
adamc@91
|
115
|
adam@1741
|
116 fun initialize () = (reset ();
|
adam@1741
|
117 xmlTag := [];
|
adamc@91
|
118 xmlString := false)
|
adamc@91
|
119
|
adamc@54
|
120
|
adam@1592
|
121 structure StringMap = BinaryMapFn(struct
|
adam@1592
|
122 type ord_key = string
|
adam@1592
|
123 val compare = String.compare
|
adam@1592
|
124 end)
|
adam@1592
|
125
|
adam@1592
|
126 val entities = foldl (fn ((key, value), entities) => StringMap.insert (entities, key, value))
|
adam@1592
|
127 StringMap.empty Entities.all
|
adam@1592
|
128
|
adamc@763
|
129 fun unescape loc s =
|
adamc@763
|
130 let
|
adamc@763
|
131 fun process (s, acc) =
|
adamc@763
|
132 let
|
adamc@763
|
133 val (befor, after) = Substring.splitl (fn ch => ch <> #"&") s
|
adamc@763
|
134 in
|
adamc@763
|
135 if Substring.size after = 0 then
|
adamc@763
|
136 Substring.concat (rev (s :: acc))
|
adamc@763
|
137 else
|
adamc@763
|
138 let
|
adamc@763
|
139 val after = Substring.slice (after, 1, NONE)
|
adamc@763
|
140 val (befor', after') = Substring.splitl (fn ch => ch <> #";") after
|
adamc@763
|
141 in
|
adamc@763
|
142 if Substring.size after' = 0 then
|
adamc@763
|
143 (ErrorMsg.errorAt' loc "Missing ';' after '&'";
|
adamc@763
|
144 "")
|
adamc@763
|
145 else
|
adamc@763
|
146 let
|
adamc@763
|
147 val pre = befor
|
adamc@763
|
148 val code = befor'
|
adamc@763
|
149 val s = Substring.slice (after', 1, NONE)
|
adamc@763
|
150
|
adamc@763
|
151 val special =
|
adamc@763
|
152 if Substring.size code > 0 andalso Substring.sub (code, 0) = #"#"
|
adamc@763
|
153 andalso CharVectorSlice.all Char.isDigit (Substring.slice (code, 1, NONE)) then
|
adamc@763
|
154 let
|
adamc@763
|
155 val code = Substring.string (Substring.slice (code, 1, NONE))
|
adamc@763
|
156 in
|
adam@1592
|
157 Option.map Utf8.encode (Int.fromString code)
|
adamc@763
|
158 end
|
adam@1592
|
159 else
|
adam@1592
|
160 Option.map Utf8.encode (StringMap.find (entities, Substring.string code))
|
adamc@763
|
161 in
|
adamc@763
|
162 case special of
|
adamc@763
|
163 NONE => (ErrorMsg.errorAt' loc ("Unsupported XML character entity "
|
adamc@763
|
164 ^ Substring.string code);
|
adamc@763
|
165 "")
|
adam@1592
|
166 | SOME sp => process (s, Substring.full sp :: pre :: acc)
|
adamc@763
|
167 end
|
adamc@763
|
168 end
|
adamc@763
|
169 end
|
adamc@763
|
170 in
|
adamc@763
|
171 process (Substring.full s, [])
|
adamc@763
|
172 end
|
adamc@763
|
173
|
adamc@1
|
174 %%
|
adamc@244
|
175 %header (functor UrwebLexFn(structure Tokens : Urweb_TOKENS));
|
adamc@1
|
176 %full
|
adamc@821
|
177 %s COMMENT STRING CHAR XML XMLTAG;
|
adamc@1
|
178
|
adamc@48
|
179 id = [a-z_][A-Za-z0-9_']*;
|
adam@2081
|
180 xmlid = [A-Za-z][A-Za-z0-9_-]*;
|
adamc@316
|
181 cid = [A-Z][A-Za-z0-9_]*;
|
adam@1432
|
182 ws = [\ \t\012\r];
|
adamc@14
|
183 intconst = [0-9]+;
|
adamc@14
|
184 realconst = [0-9]+\.[0-9]*;
|
adam@2124
|
185 hexconst = 0x[0-9A-F]{1,8};
|
adam@1366
|
186 notags = ([^<{\n(]|(\([^\*<{\n]))+;
|
adam@1285
|
187 xcom = ([^\-]|(-[^\-]))+;
|
adamc@1098
|
188 oint = [0-9][0-9][0-9];
|
adamc@1098
|
189 xint = x[0-9a-fA-F][0-9a-fA-F];
|
adamc@1
|
190
|
adamc@1
|
191 %%
|
adamc@1
|
192
|
adam@1283
|
193 <INITIAL,COMMENT,XMLTAG>
|
adam@1283
|
194 \n => (newline yypos;
|
adamc@91
|
195 continue ());
|
adamc@91
|
196 <XML> \n => (newline yypos;
|
adamc@91
|
197 Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
|
adamc@1
|
198
|
adamc@1
|
199 <INITIAL> {ws}+ => (lex ());
|
adamc@1
|
200
|
adamc@1
|
201 <INITIAL> "(*" => (YYBEGIN COMMENT;
|
adam@1283
|
202 commentOut := (fn () => YYBEGIN INITIAL);
|
adamc@54
|
203 enterComment (pos yypos);
|
adamc@1
|
204 continue ());
|
adam@1283
|
205 <XML> "(*" => (YYBEGIN COMMENT;
|
adam@1283
|
206 commentOut := (fn () => YYBEGIN XML);
|
adam@1283
|
207 enterComment (pos yypos);
|
adam@1283
|
208 continue ());
|
adam@1283
|
209 <XMLTAG> "(*" => (YYBEGIN COMMENT;
|
adam@1283
|
210 commentOut := (fn () => YYBEGIN XMLTAG);
|
adam@1283
|
211 enterComment (pos yypos);
|
adam@1283
|
212 continue ());
|
adam@1283
|
213 <INITIAL,XML,XMLTAG>
|
adam@1283
|
214 "*)" => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
|
adamc@1
|
215 continue ());
|
adamc@1
|
216
|
adamc@54
|
217 <COMMENT> "(*" => (enterComment (pos yypos);
|
adamc@1
|
218 continue ());
|
adam@1283
|
219 <COMMENT> "*)" => (exitComment ();
|
adamc@1
|
220 continue ());
|
adamc@1
|
221
|
adam@1284
|
222 <XML> "<!--" {xcom} "-->" => (continue ());
|
adam@1284
|
223
|
adamc@838
|
224 <STRING,CHAR> "\\\"" => (str := #"\"" :: !str; continue());
|
adamc@838
|
225 <STRING,CHAR> "\\'" => (str := #"'" :: !str; continue());
|
adamc@838
|
226 <STRING,CHAR> "\\n" => (str := #"\n" :: !str; continue());
|
adamc@1128
|
227 <STRING,CHAR> "\\\\" => (str := #"\\" :: !str; continue());
|
adamc@838
|
228 <STRING,CHAR> "\\t" => (str := #"\t" :: !str; continue());
|
adamc@838
|
229 <STRING,CHAR> "\n" => (newline yypos;
|
adamc@838
|
230 str := #"\n" :: !str; continue());
|
adamc@1098
|
231 <STRING,CHAR> "\\" {oint} => (case StringCvt.scanString (Int.scan StringCvt.OCT)
|
adamc@1098
|
232 (String.extract (yytext, 1, NONE)) of
|
adamc@1098
|
233 NONE => ErrorMsg.errorAt' (pos yypos, pos yypos) "Illegal string escape"
|
adamc@1098
|
234 | SOME n => str := chr n :: !str;
|
adamc@1098
|
235 continue());
|
adamc@1098
|
236 <STRING,CHAR> "\\" {xint} => (case StringCvt.scanString (Int.scan StringCvt.HEX)
|
adamc@1098
|
237 (String.extract (yytext, 2, NONE)) of
|
adamc@1098
|
238 NONE => ErrorMsg.errorAt' (pos yypos, pos yypos) "Illegal string escape"
|
adamc@1098
|
239 | SOME n => str := chr n :: !str;
|
adamc@1098
|
240 continue());
|
adamc@838
|
241
|
adamc@821
|
242 <INITIAL> "#\"" => (YYBEGIN CHAR; strEnder := #"\""; strStart := pos yypos; str := []; continue());
|
adamc@838
|
243
|
adamc@821
|
244 <CHAR> . => (let
|
adamc@821
|
245 val ch = String.sub (yytext, 0)
|
adamc@821
|
246 in
|
adamc@821
|
247 if ch = !strEnder then
|
adamc@821
|
248 let
|
adamc@821
|
249 val s = String.implode (List.rev (!str))
|
adamc@821
|
250 in
|
adamc@821
|
251 YYBEGIN INITIAL;
|
adamc@821
|
252 if size s = 1 then
|
adamc@821
|
253 Tokens.CHAR (String.sub (s, 0), !strStart, pos yypos + 1)
|
adamc@821
|
254 else
|
adamc@821
|
255 (ErrorMsg.errorAt' (yypos, yypos)
|
adamc@821
|
256 "Character constant is zero or multiple characters";
|
adamc@821
|
257 continue ())
|
adamc@821
|
258 end
|
adamc@821
|
259 else
|
adamc@821
|
260 (str := ch :: !str;
|
adamc@821
|
261 continue ())
|
adamc@821
|
262 end);
|
adamc@821
|
263
|
adamc@229
|
264 <INITIAL> "\"" => (YYBEGIN STRING; strEnder := #"\""; strStart := pos yypos; str := []; continue());
|
adamc@229
|
265 <INITIAL> "'" => (YYBEGIN STRING; strEnder := #"'"; strStart := pos yypos; str := []; continue());
|
adamc@838
|
266
|
adamc@229
|
267 <STRING> . => (let
|
adamc@229
|
268 val ch = String.sub (yytext, 0)
|
adamc@229
|
269 in
|
adamc@229
|
270 if ch = !strEnder then
|
adamc@229
|
271 (if !xmlString then
|
adamc@229
|
272 (xmlString := false; YYBEGIN XMLTAG)
|
adamc@229
|
273 else
|
adamc@229
|
274 YYBEGIN INITIAL;
|
adamc@229
|
275 Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1))
|
adamc@229
|
276 else
|
adamc@229
|
277 (str := ch :: !str;
|
adamc@229
|
278 continue ())
|
adamc@229
|
279 end);
|
adamc@14
|
280
|
adam@2078
|
281 <INITIAL> "<" {xmlid} "/>"=>(let
|
adamc@360
|
282 val tag = String.substring (yytext, 1, size yytext - 3)
|
adamc@360
|
283 in
|
adamc@360
|
284 Tokens.XML_BEGIN_END (tag, yypos, yypos + size yytext)
|
adamc@360
|
285 end);
|
adam@2078
|
286 <INITIAL> "<" {xmlid} ">"=> (let
|
adamc@91
|
287 val tag = String.substring (yytext, 1, size yytext - 2)
|
adamc@91
|
288 in
|
adamc@91
|
289 YYBEGIN XML;
|
adamc@91
|
290 xmlTag := tag :: (!xmlTag);
|
adamc@91
|
291 Tokens.XML_BEGIN (tag, yypos, yypos + size yytext)
|
adamc@91
|
292 end);
|
adam@2078
|
293 <XML> "</" {xmlid} ">" => (let
|
adamc@91
|
294 val id = String.substring (yytext, 2, size yytext - 3)
|
adamc@91
|
295 in
|
adamc@91
|
296 case !xmlTag of
|
adamc@91
|
297 id' :: rest =>
|
adamc@91
|
298 if id = id' then
|
adamc@91
|
299 (YYBEGIN INITIAL;
|
adamc@91
|
300 xmlTag := rest;
|
adamc@91
|
301 Tokens.XML_END (yypos, yypos + size yytext))
|
adamc@91
|
302 else
|
adamc@91
|
303 Tokens.END_TAG (id, yypos, yypos + size yytext)
|
adamc@91
|
304 | _ =>
|
adamc@91
|
305 Tokens.END_TAG (id, yypos, yypos + size yytext)
|
adamc@91
|
306 end);
|
adamc@91
|
307
|
adam@2078
|
308 <XML> "<" {xmlid} => (YYBEGIN XMLTAG;
|
adamc@91
|
309 Tokens.BEGIN_TAG (String.extract (yytext, 1, NONE),
|
adamc@91
|
310 yypos, yypos + size yytext));
|
adamc@91
|
311
|
adamc@91
|
312 <XMLTAG> "/" => (Tokens.DIVIDE (yypos, yypos + size yytext));
|
adamc@91
|
313 <XMLTAG> ">" => (YYBEGIN XML;
|
adamc@91
|
314 Tokens.GT (yypos, yypos + size yytext));
|
adamc@91
|
315
|
adamc@91
|
316 <XMLTAG> {ws}+ => (lex ());
|
adamc@91
|
317
|
adam@1840
|
318 <XMLTAG> {xmlid} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
|
adamc@91
|
319 <XMLTAG> "=" => (Tokens.EQ (yypos, yypos + size yytext));
|
adamc@91
|
320
|
adamc@91
|
321 <XMLTAG> {intconst} => (case Int64.fromString yytext of
|
adamc@91
|
322 SOME x => Tokens.INT (x, yypos, yypos + size yytext)
|
adamc@91
|
323 | NONE => (ErrorMsg.errorAt' (yypos, yypos)
|
adamc@91
|
324 ("Expected int, received: " ^ yytext);
|
adamc@91
|
325 continue ()));
|
adamc@91
|
326 <XMLTAG> {realconst} => (case Real.fromString yytext of
|
adamc@91
|
327 SOME x => Tokens.FLOAT (x, yypos, yypos + size yytext)
|
adamc@91
|
328 | NONE => (ErrorMsg.errorAt' (yypos, yypos)
|
adamc@91
|
329 ("Expected float, received: " ^ yytext);
|
adamc@91
|
330 continue ()));
|
adamc@91
|
331 <XMLTAG> "\"" => (YYBEGIN STRING;
|
adamc@1069
|
332 xmlString := true; strEnder := #"\"";
|
adamc@104
|
333 strStart := yypos; str := []; continue ());
|
adamc@91
|
334
|
adamc@91
|
335 <XMLTAG> "{" => (YYBEGIN INITIAL;
|
adamc@91
|
336 pushLevel (fn () => YYBEGIN XMLTAG);
|
adamc@91
|
337 Tokens.LBRACE (yypos, yypos + 1));
|
adamc@91
|
338 <XMLTAG> "(" => (YYBEGIN INITIAL;
|
adamc@91
|
339 pushLevel (fn () => YYBEGIN XMLTAG);
|
adamc@91
|
340 Tokens.LPAREN (yypos, yypos + 1));
|
adamc@91
|
341
|
adamc@91
|
342 <XMLTAG> . => (ErrorMsg.errorAt' (yypos, yypos)
|
adamc@91
|
343 ("illegal XML tag character: \"" ^ yytext ^ "\"");
|
adamc@91
|
344 continue ());
|
adamc@91
|
345
|
adamc@91
|
346 <XML> "{" => (YYBEGIN INITIAL;
|
adamc@91
|
347 pushLevel (fn () => YYBEGIN XML);
|
adamc@91
|
348 Tokens.LBRACE (yypos, yypos + 1));
|
adamc@91
|
349
|
adamc@763
|
350 <XML> {notags} => (Tokens.NOTAGS (unescape (yypos, yypos + size yytext) yytext, yypos, yypos + size yytext));
|
adamc@91
|
351
|
adam@1366
|
352 <XML> "(" => (Tokens.NOTAGS ("(", yypos, yypos + size yytext));
|
adam@1366
|
353
|
adamc@91
|
354 <XML> . => (ErrorMsg.errorAt' (yypos, yypos)
|
adamc@91
|
355 ("illegal XML character: \"" ^ yytext ^ "\"");
|
adamc@91
|
356 continue ());
|
adamc@91
|
357
|
adamc@82
|
358 <INITIAL> "()" => (Tokens.UNIT (pos yypos, pos yypos + size yytext));
|
adamc@54
|
359 <INITIAL> "(" => (Tokens.LPAREN (pos yypos, pos yypos + size yytext));
|
adamc@54
|
360 <INITIAL> ")" => (Tokens.RPAREN (pos yypos, pos yypos + size yytext));
|
adamc@54
|
361 <INITIAL> "[" => (Tokens.LBRACK (pos yypos, pos yypos + size yytext));
|
adamc@54
|
362 <INITIAL> "]" => (Tokens.RBRACK (pos yypos, pos yypos + size yytext));
|
adamc@110
|
363 <INITIAL> "{" => (enterBrace ();
|
adamc@110
|
364 Tokens.LBRACE (pos yypos, pos yypos + size yytext));
|
adamc@110
|
365 <INITIAL> "}" => (exitBrace ();
|
adamc@110
|
366 Tokens.RBRACE (pos yypos, pos yypos + size yytext));
|
adamc@1
|
367
|
adamc@623
|
368 <INITIAL> "-->" => (Tokens.KARROW (pos yypos, pos yypos + size yytext));
|
adamc@54
|
369 <INITIAL> "->" => (Tokens.ARROW (pos yypos, pos yypos + size yytext));
|
adamc@623
|
370 <INITIAL> "==>" => (Tokens.DKARROW (pos yypos, pos yypos + size yytext));
|
adamc@54
|
371 <INITIAL> "=>" => (Tokens.DARROW (pos yypos, pos yypos + size yytext));
|
adamc@54
|
372 <INITIAL> "++" => (Tokens.PLUSPLUS (pos yypos, pos yypos + size yytext));
|
adamc@149
|
373 <INITIAL> "--" => (Tokens.MINUSMINUS (pos yypos, pos yypos + size yytext));
|
adamc@493
|
374 <INITIAL> "---" => (Tokens.MINUSMINUSMINUS (pos yypos, pos yypos + size yytext));
|
adamc@674
|
375 <INITIAL> "^" => (Tokens.CARET (pos yypos, pos yypos + size yytext));
|
adamc@1
|
376
|
adamc@842
|
377 <INITIAL> "&&" => (Tokens.ANDALSO (pos yypos, pos yypos + size yytext));
|
adamc@842
|
378 <INITIAL> "||" => (Tokens.ORELSE (pos yypos, pos yypos + size yytext));
|
adamc@842
|
379
|
adam@2122
|
380 <INITIAL> "<<<" => (Tokens.COMPOSE (pos yypos, pos yypos + size yytext));
|
adam@2122
|
381 <INITIAL> ">>>" => (Tokens.ANDTHEN (pos yypos, pos yypos + size yytext));
|
adam@2122
|
382 <INITIAL> "<|" => (Tokens.FWDAPP (pos yypos, pos yypos + size yytext));
|
adam@2122
|
383 <INITIAL> "|>" => (Tokens.REVAPP (pos yypos, pos yypos + size yytext));
|
adam@2122
|
384
|
adam@2122
|
385 <INITIAL> "`" ({cid} ".")* {id} "`" => (Tokens.BACKTICK_PATH ( (* strip backticks *)
|
adam@2122
|
386 substring (yytext,1,size yytext -2),
|
adam@2122
|
387 pos yypos, pos yypos + size yytext));
|
adam@2122
|
388
|
adamc@54
|
389 <INITIAL> "=" => (Tokens.EQ (pos yypos, pos yypos + size yytext));
|
adamc@219
|
390 <INITIAL> "<>" => (Tokens.NE (pos yypos, pos yypos + size yytext));
|
adamc@219
|
391 <INITIAL> "<" => (Tokens.LT (pos yypos, pos yypos + size yytext));
|
adamc@219
|
392 <INITIAL> ">" => (Tokens.GT (pos yypos, pos yypos + size yytext));
|
adamc@219
|
393 <INITIAL> "<=" => (Tokens.LE (pos yypos, pos yypos + size yytext));
|
adamc@219
|
394 <INITIAL> ">=" => (Tokens.GE (pos yypos, pos yypos + size yytext));
|
adamc@54
|
395 <INITIAL> "," => (Tokens.COMMA (pos yypos, pos yypos + size yytext));
|
adam@1306
|
396 <INITIAL> ":::_" => (Tokens.TCOLONWILD (pos yypos, pos yypos + size yytext));
|
adamc@54
|
397 <INITIAL> ":::" => (Tokens.TCOLON (pos yypos, pos yypos + size yytext));
|
adam@1302
|
398 <INITIAL> "::_" => (Tokens.DCOLONWILD (pos yypos, pos yypos + size yytext));
|
adamc@54
|
399 <INITIAL> "::" => (Tokens.DCOLON (pos yypos, pos yypos + size yytext));
|
adamc@54
|
400 <INITIAL> ":" => (Tokens.COLON (pos yypos, pos yypos + size yytext));
|
adamc@174
|
401 <INITIAL> "..." => (Tokens.DOTDOTDOT (pos yypos, pos yypos + size yytext));
|
adamc@54
|
402 <INITIAL> "." => (Tokens.DOT (pos yypos, pos yypos + size yytext));
|
adamc@54
|
403 <INITIAL> "$" => (Tokens.DOLLAR (pos yypos, pos yypos + size yytext));
|
adamc@54
|
404 <INITIAL> "#" => (Tokens.HASH (pos yypos, pos yypos + size yytext));
|
adamc@54
|
405 <INITIAL> "__" => (Tokens.UNDERUNDER (pos yypos, pos yypos + size yytext));
|
adamc@54
|
406 <INITIAL> "_" => (Tokens.UNDER (pos yypos, pos yypos + size yytext));
|
adamc@84
|
407 <INITIAL> "~" => (Tokens.TWIDDLE (pos yypos, pos yypos + size yytext));
|
adamc@156
|
408 <INITIAL> "|" => (Tokens.BAR (pos yypos, pos yypos + size yytext));
|
adamc@195
|
409 <INITIAL> "*" => (Tokens.STAR (pos yypos, pos yypos + size yytext));
|
adamc@243
|
410 <INITIAL> "<-" => (Tokens.LARROW (pos yypos, pos yypos + size yytext));
|
adamc@243
|
411 <INITIAL> ";" => (Tokens.SEMI (pos yypos, pos yypos + size yytext));
|
adamc@629
|
412 <INITIAL> "!" => (Tokens.BANG (pos yypos, pos yypos + size yytext));
|
adamc@1
|
413
|
adamc@389
|
414 <INITIAL> "+" => (Tokens.PLUS (pos yypos, pos yypos + size yytext));
|
adamc@389
|
415 <INITIAL> "-" => (Tokens.MINUS (pos yypos, pos yypos + size yytext));
|
adamc@389
|
416 <INITIAL> "/" => (Tokens.DIVIDE (yypos, yypos + size yytext));
|
adamc@389
|
417 <INITIAL> "%" => (Tokens.MOD (pos yypos, pos yypos + size yytext));
|
adamc@403
|
418 <INITIAL> "@" => (Tokens.AT (pos yypos, pos yypos + size yytext));
|
adamc@389
|
419
|
adamc@54
|
420 <INITIAL> "con" => (Tokens.CON (pos yypos, pos yypos + size yytext));
|
adamc@54
|
421 <INITIAL> "type" => (Tokens.LTYPE (pos yypos, pos yypos + size yytext));
|
adamc@156
|
422 <INITIAL> "datatype" => (Tokens.DATATYPE (pos yypos, pos yypos + size yytext));
|
adamc@156
|
423 <INITIAL> "of" => (Tokens.OF (pos yypos, pos yypos + size yytext));
|
adamc@54
|
424 <INITIAL> "val" => (Tokens.VAL (pos yypos, pos yypos + size yytext));
|
adamc@123
|
425 <INITIAL> "rec" => (Tokens.REC (pos yypos, pos yypos + size yytext));
|
adamc@123
|
426 <INITIAL> "and" => (Tokens.AND (pos yypos, pos yypos + size yytext));
|
adamc@242
|
427 <INITIAL> "fun" => (Tokens.FUN (pos yypos, pos yypos + size yytext));
|
adamc@54
|
428 <INITIAL> "fn" => (Tokens.FN (pos yypos, pos yypos + size yytext));
|
adamc@621
|
429 <INITIAL> "map" => (Tokens.MAP (pos yypos, pos yypos + size yytext));
|
adamc@170
|
430 <INITIAL> "case" => (Tokens.CASE (pos yypos, pos yypos + size yytext));
|
adamc@190
|
431 <INITIAL> "if" => (Tokens.IF (pos yypos, pos yypos + size yytext));
|
adamc@190
|
432 <INITIAL> "then" => (Tokens.THEN (pos yypos, pos yypos + size yytext));
|
adamc@190
|
433 <INITIAL> "else" => (Tokens.ELSE (pos yypos, pos yypos + size yytext));
|
adamc@1
|
434
|
adamc@842
|
435
|
adamc@54
|
436 <INITIAL> "structure" => (Tokens.STRUCTURE (pos yypos, pos yypos + size yytext));
|
adamc@54
|
437 <INITIAL> "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext));
|
adamc@54
|
438 <INITIAL> "struct" => (Tokens.STRUCT (pos yypos, pos yypos + size yytext));
|
adam@1590
|
439 <INITIAL> "sig" => (if yypos <= 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext));
|
adamc@446
|
440 <INITIAL> "let" => (Tokens.LET (pos yypos, pos yypos + size yytext));
|
adamc@446
|
441 <INITIAL> "in" => (Tokens.IN (pos yypos, pos yypos + size yytext));
|
adamc@54
|
442 <INITIAL> "end" => (Tokens.END (pos yypos, pos yypos + size yytext));
|
adamc@54
|
443 <INITIAL> "functor" => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext));
|
adamc@54
|
444 <INITIAL> "where" => (Tokens.WHERE (pos yypos, pos yypos + size yytext));
|
adamc@58
|
445 <INITIAL> "include" => (Tokens.INCLUDE (pos yypos, pos yypos + size yytext));
|
adamc@58
|
446 <INITIAL> "open" => (Tokens.OPEN (pos yypos, pos yypos + size yytext));
|
adamc@88
|
447 <INITIAL> "constraint"=> (Tokens.CONSTRAINT (pos yypos, pos yypos + size yytext));
|
adamc@88
|
448 <INITIAL> "constraints"=> (Tokens.CONSTRAINTS (pos yypos, pos yypos + size yytext));
|
adamc@109
|
449 <INITIAL> "export" => (Tokens.EXPORT (pos yypos, pos yypos + size yytext));
|
adamc@203
|
450 <INITIAL> "table" => (Tokens.TABLE (pos yypos, pos yypos + size yytext));
|
adamc@338
|
451 <INITIAL> "sequence" => (Tokens.SEQUENCE (pos yypos, pos yypos + size yytext));
|
adamc@754
|
452 <INITIAL> "view" => (Tokens.VIEW (pos yypos, pos yypos + size yytext));
|
adamc@211
|
453 <INITIAL> "class" => (Tokens.CLASS (pos yypos, pos yypos + size yytext));
|
adamc@459
|
454 <INITIAL> "cookie" => (Tokens.COOKIE (pos yypos, pos yypos + size yytext));
|
adamc@718
|
455 <INITIAL> "style" => (Tokens.STYLE (pos yypos, pos yypos + size yytext));
|
adamc@1075
|
456 <INITIAL> "task" => (Tokens.TASK (pos yypos, pos yypos + size yytext));
|
adamc@1199
|
457 <INITIAL> "policy" => (Tokens.POLICY (pos yypos, pos yypos + size yytext));
|
adam@2010
|
458 <INITIAL> "ffi" => (Tokens.FFI (pos yypos, pos yypos + size yytext));
|
adamc@30
|
459
|
adamc@54
|
460 <INITIAL> "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext));
|
adamc@54
|
461 <INITIAL> "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext));
|
adamc@82
|
462 <INITIAL> "Unit" => (Tokens.KUNIT (pos yypos, pos yypos + size yytext));
|
adamc@1
|
463
|
adamc@204
|
464 <INITIAL> "SELECT" => (Tokens.SELECT (pos yypos, pos yypos + size yytext));
|
adamc@993
|
465 <INITIAL> "DISTINCT" => (Tokens.DISTINCT (pos yypos, pos yypos + size yytext));
|
adamc@204
|
466 <INITIAL> "FROM" => (Tokens.FROM (pos yypos, pos yypos + size yytext));
|
adamc@204
|
467 <INITIAL> "AS" => (Tokens.AS (pos yypos, pos yypos + size yytext));
|
adamc@209
|
468 <INITIAL> "WHERE" => (Tokens.CWHERE (pos yypos, pos yypos + size yytext));
|
adamc@339
|
469 <INITIAL> "SQL" => (Tokens.SQL (pos yypos, pos yypos + size yytext));
|
adamc@226
|
470 <INITIAL> "GROUP" => (Tokens.GROUP (pos yypos, pos yypos + size yytext));
|
adamc@230
|
471 <INITIAL> "ORDER" => (Tokens.ORDER (pos yypos, pos yypos + size yytext));
|
adamc@226
|
472 <INITIAL> "BY" => (Tokens.BY (pos yypos, pos yypos + size yytext));
|
adamc@227
|
473 <INITIAL> "HAVING" => (Tokens.HAVING (pos yypos, pos yypos + size yytext));
|
adamc@231
|
474 <INITIAL> "LIMIT" => (Tokens.LIMIT (pos yypos, pos yypos + size yytext));
|
adamc@231
|
475 <INITIAL> "OFFSET" => (Tokens.OFFSET (pos yypos, pos yypos + size yytext));
|
adamc@232
|
476 <INITIAL> "ALL" => (Tokens.ALL (pos yypos, pos yypos + size yytext));
|
adamc@1071
|
477 <INITIAL> "SELECT1" => (Tokens.SELECT1 (pos yypos, pos yypos + size yytext));
|
adamc@209
|
478
|
adamc@749
|
479 <INITIAL> "JOIN" => (Tokens.JOIN (pos yypos, pos yypos + size yytext));
|
adamc@749
|
480 <INITIAL> "INNER" => (Tokens.INNER (pos yypos, pos yypos + size yytext));
|
adamc@749
|
481 <INITIAL> "CROSS" => (Tokens.CROSS (pos yypos, pos yypos + size yytext));
|
adamc@751
|
482 <INITIAL> "OUTER" => (Tokens.OUTER (pos yypos, pos yypos + size yytext));
|
adamc@750
|
483 <INITIAL> "LEFT" => (Tokens.LEFT (pos yypos, pos yypos + size yytext));
|
adamc@751
|
484 <INITIAL> "RIGHT" => (Tokens.RIGHT (pos yypos, pos yypos + size yytext));
|
adamc@751
|
485 <INITIAL> "FULL" => (Tokens.FULL (pos yypos, pos yypos + size yytext));
|
adamc@749
|
486
|
adamc@229
|
487 <INITIAL> "UNION" => (Tokens.UNION (pos yypos, pos yypos + size yytext));
|
adamc@229
|
488 <INITIAL> "INTERSECT" => (Tokens.INTERSECT (pos yypos, pos yypos + size yytext));
|
adamc@229
|
489 <INITIAL> "EXCEPT" => (Tokens.EXCEPT (pos yypos, pos yypos + size yytext));
|
adamc@229
|
490
|
adamc@209
|
491 <INITIAL> "TRUE" => (Tokens.TRUE (pos yypos, pos yypos + size yytext));
|
adamc@209
|
492 <INITIAL> "FALSE" => (Tokens.FALSE (pos yypos, pos yypos + size yytext));
|
adamc@220
|
493 <INITIAL> "AND" => (Tokens.CAND (pos yypos, pos yypos + size yytext));
|
adamc@220
|
494 <INITIAL> "OR" => (Tokens.OR (pos yypos, pos yypos + size yytext));
|
adamc@220
|
495 <INITIAL> "NOT" => (Tokens.NOT (pos yypos, pos yypos + size yytext));
|
adamc@204
|
496
|
adamc@235
|
497 <INITIAL> "COUNT" => (Tokens.COUNT (pos yypos, pos yypos + size yytext));
|
adamc@236
|
498 <INITIAL> "AVG" => (Tokens.AVG (pos yypos, pos yypos + size yytext));
|
adamc@236
|
499 <INITIAL> "SUM" => (Tokens.SUM (pos yypos, pos yypos + size yytext));
|
adamc@236
|
500 <INITIAL> "MIN" => (Tokens.MIN (pos yypos, pos yypos + size yytext));
|
adamc@236
|
501 <INITIAL> "MAX" => (Tokens.MAX (pos yypos, pos yypos + size yytext));
|
adam@1776
|
502 <INITIAL> "RANK" => (Tokens.RANK (pos yypos, pos yypos + size yytext));
|
adam@1778
|
503 <INITIAL> "PARTITION" => (Tokens.PARTITION (pos yypos, pos yypos + size yytext));
|
adam@1778
|
504 <INITIAL> "OVER" => (Tokens.OVER (pos yypos, pos yypos + size yytext));
|
adamc@235
|
505
|
kkallio@1572
|
506 <INITIAL> "IF" => (Tokens.CIF (pos yypos, pos yypos + size yytext));
|
kkallio@1572
|
507 <INITIAL> "THEN" => (Tokens.CTHEN (pos yypos, pos yypos + size yytext));
|
kkallio@1572
|
508 <INITIAL> "ELSE" => (Tokens.CELSE (pos yypos, pos yypos + size yytext));
|
kkallio@1572
|
509
|
adamc@268
|
510 <INITIAL> "ASC" => (Tokens.ASC (pos yypos, pos yypos + size yytext));
|
adamc@268
|
511 <INITIAL> "DESC" => (Tokens.DESC (pos yypos, pos yypos + size yytext));
|
adam@1682
|
512 <INITIAL> "RANDOM" => (Tokens.RANDOM (pos yypos, pos yypos + size yytext));
|
adamc@268
|
513
|
adamc@302
|
514 <INITIAL> "INSERT" => (Tokens.INSERT (pos yypos, pos yypos + size yytext));
|
adamc@302
|
515 <INITIAL> "INTO" => (Tokens.INTO (pos yypos, pos yypos + size yytext));
|
adamc@302
|
516 <INITIAL> "VALUES" => (Tokens.VALUES (pos yypos, pos yypos + size yytext));
|
adamc@302
|
517 <INITIAL> "UPDATE" => (Tokens.UPDATE (pos yypos, pos yypos + size yytext));
|
adamc@302
|
518 <INITIAL> "SET" => (Tokens.SET (pos yypos, pos yypos + size yytext));
|
adamc@302
|
519 <INITIAL> "DELETE" => (Tokens.DELETE (pos yypos, pos yypos + size yytext));
|
adamc@467
|
520 <INITIAL> "NULL" => (Tokens.NULL (pos yypos, pos yypos + size yytext));
|
adamc@470
|
521 <INITIAL> "IS" => (Tokens.IS (pos yypos, pos yypos + size yytext));
|
adam@1602
|
522 <INITIAL> "COALESCE" => (Tokens.COALESCE (pos yypos, pos yypos + size yytext));
|
kkallio@1607
|
523 <INITIAL> "LIKE" => (Tokens.LIKE (pos yypos, pos yypos + size yytext));
|
adamc@302
|
524
|
adamc@704
|
525 <INITIAL> "CONSTRAINT"=> (Tokens.CCONSTRAINT (pos yypos, pos yypos + size yytext));
|
adamc@704
|
526 <INITIAL> "UNIQUE" => (Tokens.UNIQUE (pos yypos, pos yypos + size yytext));
|
adamc@714
|
527 <INITIAL> "CHECK" => (Tokens.CHECK (pos yypos, pos yypos + size yytext));
|
adamc@707
|
528 <INITIAL> "PRIMARY" => (Tokens.PRIMARY (pos yypos, pos yypos + size yytext));
|
adamc@709
|
529 <INITIAL> "FOREIGN" => (Tokens.FOREIGN (pos yypos, pos yypos + size yytext));
|
adamc@707
|
530 <INITIAL> "KEY" => (Tokens.KEY (pos yypos, pos yypos + size yytext));
|
adamc@709
|
531 <INITIAL> "ON" => (Tokens.ON (pos yypos, pos yypos + size yytext));
|
adamc@709
|
532 <INITIAL> "NO" => (Tokens.NO (pos yypos, pos yypos + size yytext));
|
adamc@709
|
533 <INITIAL> "ACTION" => (Tokens.ACTION (pos yypos, pos yypos + size yytext));
|
adamc@709
|
534 <INITIAL> "RESTRICT" => (Tokens.RESTRICT (pos yypos, pos yypos + size yytext));
|
adamc@709
|
535 <INITIAL> "CASCADE" => (Tokens.CASCADE (pos yypos, pos yypos + size yytext));
|
adamc@709
|
536 <INITIAL> "REFERENCES"=> (Tokens.REFERENCES (pos yypos, pos yypos + size yytext));
|
adamc@709
|
537
|
adamc@709
|
538 <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
|
adamc@704
|
539
|
adamc@441
|
540 <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
|
adamc@441
|
541
|
adamc@54
|
542 <INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
|
adamc@54
|
543 <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
|
adamc@1
|
544
|
adam@2124
|
545 <INITIAL> {hexconst} => (case StringCvt.scanString (Int64.scan StringCvt.HEX) (String.extract (yytext, 2, NONE)) of
|
adam@2124
|
546 SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
|
adam@2124
|
547 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
|
adam@2124
|
548 ("Expected hexInt, received: " ^ yytext);
|
adam@2124
|
549 continue ()));
|
adam@2124
|
550
|
adamc@14
|
551 <INITIAL> {intconst} => (case Int64.fromString yytext of
|
adamc@120
|
552 SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
|
adamc@120
|
553 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
|
adamc@120
|
554 ("Expected int, received: " ^ yytext);
|
adamc@120
|
555 continue ()));
|
adamc@14
|
556 <INITIAL> {realconst} => (case Real64.fromString yytext of
|
adamc@54
|
557 SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
|
adamc@54
|
558 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
|
adamc@14
|
559 ("Expected float, received: " ^ yytext);
|
adamc@14
|
560 continue ()));
|
adamc@14
|
561
|
adamc@1
|
562 <COMMENT> . => (continue());
|
adamc@1
|
563
|
adamc@54
|
564 <INITIAL> . => (ErrorMsg.errorAt' (pos yypos, pos yypos)
|
adamc@1
|
565 ("illegal character: \"" ^ yytext ^ "\"");
|
adamc@1
|
566 continue ());
|