Mercurial > urweb

annotate src/urweb.lex @ 2258:b1ba35ce2613

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Fix bug where pure caching didn't treat FFI applications as effectful.
author Ziv Scully <ziv@mit.edu>
date Sun, 27 Sep 2015 17:02:14 -0400
parents 2b1af5dc6dee
children
rev   line source
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
ziv@2221 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)
ziv@2221 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
ziv@2221 61 fun eof () =
ziv@2221 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 ();
ziv@2221 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_-]*;
adam@2154 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@2148 185 hexconst = 0x[0-9A-F]+;
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)
ziv@2221 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
griba2001@2150 540 <INITIAL> "_LOC_" => (let val strLoc = ErrorMsg.spanToString (ErrorMsg.spanOf
griba2001@2150 541 (pos yypos, pos yypos + size yytext))
griba2001@2150 542 in
griba2001@2150 543 Tokens.STRING (strLoc, pos yypos, pos yypos + size yytext)
griba2001@2150 544 end);
griba2001@2150 545
adamc@54 546 <INITIAL> {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
adamc@54 547 <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
adamc@1 548
adam@2148 549 <INITIAL> {hexconst} => (let val digits = String.extract (yytext, 2, NONE)
adam@2148 550 val v = (StringCvt.scanString (Int64.scan StringCvt.HEX) digits)
adam@2148 551 handle Overflow => NONE
adam@2148 552 in
adam@2148 553 case v of
adam@2124 554 SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
adam@2124 555 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adam@2124 556 ("Expected hexInt, received: " ^ yytext);
adam@2148 557 continue ())
adam@2148 558 end);
adam@2124 559
adam@2148 560 <INITIAL> {intconst} => (let val v = (Int64.fromString yytext) handle Overflow => NONE
adam@2148 561 in
adam@2148 562 case v of
adamc@120 563 SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
adamc@120 564 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adamc@120 565 ("Expected int, received: " ^ yytext);
adam@2148 566 continue ())
adam@2148 567 end);
adamc@14 568 <INITIAL> {realconst} => (case Real64.fromString yytext of
adamc@54 569 SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
adamc@54 570 | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adamc@14 571 ("Expected float, received: " ^ yytext);
adamc@14 572 continue ()));
adamc@14 573
adamc@1 574 <COMMENT> . => (continue());
adamc@1 575
adamc@54 576 <INITIAL> . => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adamc@1 577 ("illegal character: \"" ^ yytext ^ "\"");
adamc@1 578 continue ());