Mercurial > urweb

annotate src/urweb.lex @ 2165:7dfce558aca2

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Change 'make test' to work before 'make install'
author Adam Chlipala <adam@chlipala.net>
date Thu, 06 Aug 2015 09:57:47 -0400
parents 9ea29c93246d
children 2b1af5dc6dee
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
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_-]*;
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)
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
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 ());