adamc@763: (* -*- mode: sml-lex -*- *)
adamc@763: 
adamc@763: (* Copyright (c) 2008-2009, Adam Chlipala
adamc@1:  * All rights reserved.
adamc@1:  *
adamc@1:  * Redistribution and use in source and binary forms, with or without
adamc@1:  * modification, are permitted provided that the following conditions are met:
adamc@1:  *
adamc@1:  * - Redistributions of source code must retain the above copyright notice,
adamc@1:  *   this list of conditions and the following disclaimer.
adamc@1:  * - Redistributions in binary form must reproduce the above copyright notice,
adamc@1:  *   this list of conditions and the following disclaimer in the documentation
adamc@1:  *   and/or other materials provided with the distribution.
adamc@1:  * - The names of contributors may not be used to endorse or promote products
adamc@1:  *   derived from this software without specific prior written permission.
adamc@1:  *
adamc@1:  * THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
adamc@1:  * AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
adamc@1:  * IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
adamc@1:  * ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
ziv@2221:  * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
adamc@1:  * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
adamc@1:  * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
adamc@1:  * INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
adamc@1:  * CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
adamc@1:  * ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
adamc@1:  * POSSIBILITY OF SUCH DAMAGE.
adamc@1:  *)
adamc@1: 
adamc@244: (* Lexing info for Ur/Web programs *)
adamc@1: 
adamc@1: type pos = int
adamc@1: type svalue = Tokens.svalue
adamc@1: type ('a,'b) token = ('a,'b) Tokens.token
adamc@1: type lexresult = (svalue,pos) Tokens.token
adamc@1: 
adam@1283: val commentOut = ref (fn () => ())
adam@1283: 
adamc@1: local
adamc@1:   val commentLevel = ref 0
adamc@1:   val commentPos = ref 0
adamc@1: in
adam@1741:   fun reset () =
adam@1741:       (commentLevel := 0;
adam@1741:        commentPos := 0)
adam@1741: 
adamc@1:   fun enterComment pos =
adamc@1:       (if !commentLevel = 0 then
adamc@1:            commentPos := pos
adamc@1:        else
adamc@1:            ();
adamc@1:        commentLevel := !commentLevel + 1)
ziv@2221: 
adamc@1:   fun exitComment () =
adamc@1:       (ignore (commentLevel := !commentLevel - 1);
adam@1283:        if !commentLevel = 0 then
adam@1283:            !commentOut ()
adam@1283:        else
adam@1283:            ())
adamc@1: 
ziv@2221:   fun eof () =
ziv@2221:     let
adamc@1:       val pos = ErrorMsg.lastLineStart ()
adamc@1:     in
adamc@1:       if !commentLevel > 0 then
adamc@1:           ErrorMsg.errorAt' (!commentPos, !commentPos) "Unterminated comment"
adamc@1:       else
adamc@1:           ();
ziv@2221:       Tokens.EOF (pos, pos)
adamc@1:     end
adamc@1: end
adamc@1: 
adamc@229: val strEnder = ref #"\""
adamc@14: val str = ref ([] : char list)
adamc@14: val strStart = ref 0
adamc@14: 
adamc@54: local
adamc@54:     val initSig = ref false
adamc@54:     val offset = ref 0
adamc@54: in
adamc@54: 
adamc@54: fun initialSig () = initSig := true
adamc@54: 
adamc@54: fun pos yypos = yypos - !offset
adamc@54: 
adamc@54: fun newline yypos =
adamc@54:     if !initSig then
adamc@54:         (initSig := false;
adamc@54:          offset := yypos + 1)
adamc@54:     else
adamc@54:         ErrorMsg.newline (pos yypos)
adamc@54: 
adamc@54: end
adamc@54: 
adamc@91: val xmlTag = ref ([] : string list)
adamc@91: val xmlString = ref true
adamc@91: val braceLevels = ref ([] : ((unit -> unit) * int) list)
adamc@91: 
adamc@91: fun pushLevel s = braceLevels := (s, 1) :: (!braceLevels)
adamc@91: 
adamc@91: fun enterBrace () =
adamc@91:     case !braceLevels of
adamc@91: 	(s, i) :: rest => braceLevels := (s, i+1) :: rest
adamc@91:       | _ => ()
adamc@91: 
adamc@91: fun exitBrace () =
adamc@91:     case !braceLevels of
adamc@91: 	(s, i) :: rest =>
adamc@91: 	if i = 1 then
adamc@91: 	    (braceLevels := rest;
adamc@91: 	     s ())
adamc@91: 	else
adamc@91: 	    braceLevels := (s, i-1) :: rest
adamc@91:       | _ => ()
adamc@91: 
adam@1741: fun initialize () = (reset ();
adam@1741:                      xmlTag := [];
adamc@91: 		     xmlString := false)
adamc@91: 
adamc@54: 
adam@1592: structure StringMap = BinaryMapFn(struct
adam@1592:                                   type ord_key = string
adam@1592:                                   val compare = String.compare
adam@1592:                                   end)
adam@1592: 
adam@1592: val entities = foldl (fn ((key, value), entities) => StringMap.insert (entities, key, value))
adam@1592:                      StringMap.empty Entities.all
adam@1592: 
adamc@763: fun unescape loc s =
adamc@763:     let
adamc@763:         fun process (s, acc) =
adamc@763:             let
adamc@763:                 val (befor, after) = Substring.splitl (fn ch => ch <> #"&") s
adamc@763:             in
adamc@763:                 if Substring.size after = 0 then
adamc@763:                     Substring.concat (rev (s :: acc))
adamc@763:                 else
adamc@763:                     let
adamc@763:                         val after = Substring.slice (after, 1, NONE)
adamc@763:                         val (befor', after') = Substring.splitl (fn ch => ch <> #";") after
adamc@763:                     in
adamc@763:                         if Substring.size after' = 0 then
adamc@763:                             (ErrorMsg.errorAt' loc "Missing ';' after '&'";
adamc@763:                              "")
adamc@763:                         else
adamc@763:                             let
adamc@763:                                 val pre = befor
adamc@763:                                 val code = befor'
adamc@763:                                 val s = Substring.slice (after', 1, NONE)
adamc@763: 
adamc@763:                                 val special =
adamc@763:                                     if Substring.size code > 0 andalso Substring.sub (code, 0) = #"#"
adamc@763:                                        andalso CharVectorSlice.all Char.isDigit (Substring.slice (code, 1, NONE)) then
adamc@763:                                         let
adamc@763:                                             val code = Substring.string (Substring.slice (code, 1, NONE))
adamc@763:                                         in
adam@1592:                                             Option.map Utf8.encode (Int.fromString code)
adamc@763:                                         end
adam@1592:                                     else
adam@1592:                                         Option.map Utf8.encode (StringMap.find (entities, Substring.string code))
adamc@763:                             in
adamc@763:                                 case special of
adamc@763:                                     NONE => (ErrorMsg.errorAt' loc ("Unsupported XML character entity "
adamc@763:                                                                         ^ Substring.string code);
adamc@763:                                              "")
adam@1592:                                   | SOME sp => process (s, Substring.full sp :: pre :: acc)
adamc@763:                             end
adamc@763:                     end
adamc@763:             end
adamc@763:     in
adamc@763:         process (Substring.full s, [])
adamc@763:     end
adamc@763: 
adamc@1: %%
adamc@244: %header (functor UrwebLexFn(structure Tokens : Urweb_TOKENS));
adamc@1: %full
adamc@821: %s COMMENT STRING CHAR XML XMLTAG;
adamc@1: 
adamc@48: id = [a-z_][A-Za-z0-9_']*;
adam@2081: xmlid = [A-Za-z][A-Za-z0-9_-]*;
adam@2154: cid = [A-Z][A-Za-z0-9_']*;
adam@1432: ws = [\ \t\012\r];
adamc@14: intconst = [0-9]+;
adamc@14: realconst = [0-9]+\.[0-9]*;
adam@2148: hexconst = 0x[0-9A-F]+;
adam@1366: notags = ([^<{\n(]|(\([^\*<{\n]))+;
adam@1285: xcom = ([^\-]|(-[^\-]))+;
adamc@1098: oint = [0-9][0-9][0-9];
adamc@1098: xint = x[0-9a-fA-F][0-9a-fA-F];
adamc@1: 
adamc@1: %%
adamc@1: 
adam@1283: <INITIAL,COMMENT,XMLTAG>
adam@1283:       \n              => (newline yypos;
adamc@91:                           continue ());
adamc@91: <XML> \n              => (newline yypos;
adamc@91:                           Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
adamc@1: 
adamc@1: <INITIAL> {ws}+       => (lex ());
adamc@1: 
adamc@1: <INITIAL> "(*"        => (YYBEGIN COMMENT;
adam@1283:                           commentOut := (fn () => YYBEGIN INITIAL);
adamc@54:                           enterComment (pos yypos);
adamc@1:                           continue ());
adam@1283: <XML> "(*"            => (YYBEGIN COMMENT;
adam@1283:                           commentOut := (fn () => YYBEGIN XML);
adam@1283:                           enterComment (pos yypos);
adam@1283:                           continue ());
adam@1283: <XMLTAG> "(*"         => (YYBEGIN COMMENT;
adam@1283:                           commentOut := (fn () => YYBEGIN XMLTAG);
adam@1283:                           enterComment (pos yypos);
adam@1283:                           continue ());
adam@1283: <INITIAL,XML,XMLTAG>
adam@1283:              "*)"     => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments";
adamc@1: 			  continue ());
adamc@1: 
adamc@54: <COMMENT> "(*"        => (enterComment (pos yypos);
adamc@1:                           continue ());
adam@1283: <COMMENT> "*)"        => (exitComment ();
adamc@1: 			  continue ());
adamc@1: 
adam@1284: <XML> "<!--" {xcom} "-->" => (continue ());
adam@1284: 
adamc@838: <STRING,CHAR> "\\\""  => (str := #"\"" :: !str; continue());
adamc@838: <STRING,CHAR> "\\'"   => (str := #"'" :: !str; continue());
adamc@838: <STRING,CHAR> "\\n"   => (str := #"\n" :: !str; continue());
adamc@1128: <STRING,CHAR> "\\\\"  => (str := #"\\" :: !str; continue());
adamc@838: <STRING,CHAR> "\\t"   => (str := #"\t" :: !str; continue());
adamc@838: <STRING,CHAR> "\n"    => (newline yypos;
adamc@838: 			  str := #"\n" :: !str; continue());
adamc@1098: <STRING,CHAR> "\\" {oint} => (case StringCvt.scanString (Int.scan StringCvt.OCT)
adamc@1098:                                                         (String.extract (yytext, 1, NONE)) of
adamc@1098:                                   NONE => ErrorMsg.errorAt' (pos yypos, pos yypos) "Illegal string escape"
adamc@1098:                                 | SOME n => str := chr n :: !str;
adamc@1098:                               continue());
adamc@1098: <STRING,CHAR> "\\" {xint} => (case StringCvt.scanString (Int.scan StringCvt.HEX)
adamc@1098:                                                         (String.extract (yytext, 2, NONE)) of
adamc@1098:                                   NONE => ErrorMsg.errorAt' (pos yypos, pos yypos) "Illegal string escape"
adamc@1098:                                 | SOME n => str := chr n :: !str;
adamc@1098:                               continue());
adamc@838: 
adamc@821: <INITIAL> "#\""       => (YYBEGIN CHAR; strEnder := #"\""; strStart := pos yypos; str := []; continue());
adamc@838: 
adamc@821: <CHAR> .              => (let
adamc@821:                               val ch = String.sub (yytext, 0)
adamc@821:                           in
adamc@821:                               if ch = !strEnder then
adamc@821:                                   let
adamc@821:                                       val s = String.implode (List.rev (!str))
adamc@821:                                   in
adamc@821: 			              YYBEGIN INITIAL;
adamc@821:                                       if size s = 1 then
adamc@821: 			                  Tokens.CHAR (String.sub (s, 0), !strStart, pos yypos + 1)
adamc@821:                                       else
adamc@821:                                           (ErrorMsg.errorAt' (yypos, yypos)
adamc@821:                                                              "Character constant is zero or multiple characters";
adamc@821:                                            continue ())
adamc@821:                                   end
adamc@821:                               else
adamc@821:                                   (str := ch :: !str;
adamc@821:                                    continue ())
adamc@821:                           end);
adamc@821: 
adamc@229: <INITIAL> "\""        => (YYBEGIN STRING; strEnder := #"\""; strStart := pos yypos; str := []; continue());
adamc@229: <INITIAL> "'"         => (YYBEGIN STRING; strEnder := #"'"; strStart := pos yypos; str := []; continue());
adamc@838: 
adamc@229: <STRING> .            => (let
adamc@229:                               val ch = String.sub (yytext, 0)
adamc@229:                           in
adamc@229:                               if ch = !strEnder then
adamc@229:                                   (if !xmlString then
adamc@229: 			               (xmlString := false; YYBEGIN XMLTAG)
adamc@229: 			           else
adamc@229: 			               YYBEGIN INITIAL;
adamc@229: 			           Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1))
adamc@229:                               else
adamc@229:                                   (str := ch :: !str;
adamc@229:                                    continue ())
adamc@229:                           end);
adamc@14: 
adam@2078: <INITIAL> "<" {xmlid} "/>"=>(let
adamc@360: 			      val tag = String.substring (yytext, 1, size yytext - 3)
adamc@360: 			  in
adamc@360: 			      Tokens.XML_BEGIN_END (tag, yypos, yypos + size yytext)
adamc@360: 			  end);
adam@2078: <INITIAL> "<" {xmlid} ">"=> (let
adamc@91: 			      val tag = String.substring (yytext, 1, size yytext - 2)
adamc@91: 			  in
adamc@91: 			      YYBEGIN XML;
adamc@91: 			      xmlTag := tag :: (!xmlTag);
adamc@91: 			      Tokens.XML_BEGIN (tag, yypos, yypos + size yytext)
adamc@91: 			  end);
adam@2078: <XML> "</" {xmlid} ">" => (let
adamc@91: 			      val id = String.substring (yytext, 2, size yytext - 3)
adamc@91: 			  in
adamc@91: 			      case !xmlTag of
adamc@91: 			          id' :: rest =>
adamc@91: 			          if id = id' then
adamc@91: 				      (YYBEGIN INITIAL;
adamc@91: 				       xmlTag := rest;
adamc@91: 				       Tokens.XML_END (yypos, yypos + size yytext))
adamc@91: 			          else
adamc@91: 				      Tokens.END_TAG (id, yypos, yypos + size yytext)
ziv@2221: 			        | _ =>
adamc@91: 			          Tokens.END_TAG (id, yypos, yypos + size yytext)
adamc@91: 			  end);
adamc@91: 
adam@2078: <XML> "<" {xmlid}     => (YYBEGIN XMLTAG;
adamc@91: 			  Tokens.BEGIN_TAG (String.extract (yytext, 1, NONE),
adamc@91: 					    yypos, yypos + size yytext));
adamc@91: 
adamc@91: <XMLTAG> "/"          => (Tokens.DIVIDE (yypos, yypos + size yytext));
adamc@91: <XMLTAG> ">"          => (YYBEGIN XML;
adamc@91: 			  Tokens.GT (yypos, yypos + size yytext));
adamc@91: 
adamc@91: <XMLTAG> {ws}+        => (lex ());
adamc@91: 
adam@1840: <XMLTAG> {xmlid}      => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
adamc@91: <XMLTAG> "="          => (Tokens.EQ (yypos, yypos + size yytext));
adamc@91: 
adamc@91: <XMLTAG> {intconst}   => (case Int64.fromString yytext of
adamc@91:                             SOME x => Tokens.INT (x, yypos, yypos + size yytext)
adamc@91:                           | NONE   => (ErrorMsg.errorAt' (yypos, yypos)
adamc@91:                                        ("Expected int, received: " ^ yytext);
adamc@91:                                        continue ()));
adamc@91: <XMLTAG> {realconst}  => (case Real.fromString yytext of
adamc@91:                             SOME x => Tokens.FLOAT (x, yypos, yypos + size yytext)
adamc@91:                           | NONE   => (ErrorMsg.errorAt' (yypos, yypos)
adamc@91:                                        ("Expected float, received: " ^ yytext);
adamc@91:                                        continue ()));
adamc@91: <XMLTAG> "\""         => (YYBEGIN STRING;
adamc@1069: 			  xmlString := true; strEnder := #"\"";
adamc@104: 			  strStart := yypos; str := []; continue ());
adamc@91: 
adamc@91: <XMLTAG> "{"          => (YYBEGIN INITIAL;
adamc@91: 			  pushLevel (fn () => YYBEGIN XMLTAG);
adamc@91: 			  Tokens.LBRACE (yypos, yypos + 1));
adamc@91: <XMLTAG> "("          => (YYBEGIN INITIAL;
adamc@91: 			  pushLevel (fn () => YYBEGIN XMLTAG);
adamc@91: 			  Tokens.LPAREN (yypos, yypos + 1));
adamc@91: 
adamc@91: <XMLTAG> .            => (ErrorMsg.errorAt' (yypos, yypos)
adamc@91:                           ("illegal XML tag character: \"" ^ yytext ^ "\"");
adamc@91:                           continue ());
adamc@91: 
adamc@91: <XML> "{"             => (YYBEGIN INITIAL;
adamc@91: 			  pushLevel (fn () => YYBEGIN XML);
adamc@91: 			  Tokens.LBRACE (yypos, yypos + 1));
adamc@91: 
adamc@763: <XML> {notags}        => (Tokens.NOTAGS (unescape (yypos, yypos + size yytext) yytext, yypos, yypos + size yytext));
adamc@91: 
adam@1366: <XML> "("             => (Tokens.NOTAGS ("(", yypos, yypos + size yytext));
adam@1366: 
adamc@91: <XML> .               => (ErrorMsg.errorAt' (yypos, yypos)
adamc@91:                           ("illegal XML character: \"" ^ yytext ^ "\"");
adamc@91:                           continue ());
adamc@91: 
adamc@82: <INITIAL> "()"        => (Tokens.UNIT (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "("         => (Tokens.LPAREN (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> ")"         => (Tokens.RPAREN (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "["         => (Tokens.LBRACK (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "]"         => (Tokens.RBRACK (pos yypos, pos yypos + size yytext));
adamc@110: <INITIAL> "{"         => (enterBrace ();
adamc@110:                           Tokens.LBRACE (pos yypos, pos yypos + size yytext));
adamc@110: <INITIAL> "}"         => (exitBrace ();
adamc@110:                           Tokens.RBRACE (pos yypos, pos yypos + size yytext));
adamc@1: 
adamc@623: <INITIAL> "-->"       => (Tokens.KARROW (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "->"        => (Tokens.ARROW (pos yypos, pos yypos + size yytext));
adamc@623: <INITIAL> "==>"       => (Tokens.DKARROW (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "=>"        => (Tokens.DARROW (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "++"        => (Tokens.PLUSPLUS (pos yypos, pos yypos + size yytext));
adamc@149: <INITIAL> "--"        => (Tokens.MINUSMINUS (pos yypos, pos yypos + size yytext));
adamc@493: <INITIAL> "---"       => (Tokens.MINUSMINUSMINUS (pos yypos, pos yypos + size yytext));
adamc@674: <INITIAL> "^"         => (Tokens.CARET (pos yypos, pos yypos + size yytext));
adamc@1: 
adamc@842: <INITIAL> "&&"        => (Tokens.ANDALSO (pos yypos, pos yypos + size yytext));
adamc@842: <INITIAL> "||"        => (Tokens.ORELSE (pos yypos, pos yypos + size yytext));
adamc@842: 
adam@2122: <INITIAL> "<<<"       => (Tokens.COMPOSE (pos yypos, pos yypos + size yytext));
adam@2122: <INITIAL> ">>>"       => (Tokens.ANDTHEN (pos yypos, pos yypos + size yytext));
adam@2122: <INITIAL> "<|"        => (Tokens.FWDAPP (pos yypos, pos yypos + size yytext));
adam@2122: <INITIAL> "|>"        => (Tokens.REVAPP (pos yypos, pos yypos + size yytext));
adam@2122: 
adam@2122: <INITIAL> "`" ({cid} ".")* {id} "`"  => (Tokens.BACKTICK_PATH ( (* strip backticks *)
adam@2122:                                                               substring (yytext,1,size yytext -2),
adam@2122:                                                               pos yypos, pos yypos + size yytext));
adam@2122: 
adamc@54: <INITIAL> "="         => (Tokens.EQ (pos yypos, pos yypos + size yytext));
adamc@219: <INITIAL> "<>"        => (Tokens.NE (pos yypos, pos yypos + size yytext));
adamc@219: <INITIAL> "<"         => (Tokens.LT (pos yypos, pos yypos + size yytext));
adamc@219: <INITIAL> ">"         => (Tokens.GT (pos yypos, pos yypos + size yytext));
adamc@219: <INITIAL> "<="        => (Tokens.LE (pos yypos, pos yypos + size yytext));
adamc@219: <INITIAL> ">="        => (Tokens.GE (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> ","         => (Tokens.COMMA (pos yypos, pos yypos + size yytext));
adam@1306: <INITIAL> ":::_"      => (Tokens.TCOLONWILD (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> ":::"       => (Tokens.TCOLON (pos yypos, pos yypos + size yytext));
adam@1302: <INITIAL> "::_"       => (Tokens.DCOLONWILD (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "::"        => (Tokens.DCOLON (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> ":"         => (Tokens.COLON (pos yypos, pos yypos + size yytext));
adamc@174: <INITIAL> "..."       => (Tokens.DOTDOTDOT (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "."         => (Tokens.DOT (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "$"         => (Tokens.DOLLAR (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "#"         => (Tokens.HASH (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "__"        => (Tokens.UNDERUNDER (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "_"         => (Tokens.UNDER (pos yypos, pos yypos + size yytext));
adamc@84: <INITIAL> "~"         => (Tokens.TWIDDLE (pos yypos, pos yypos + size yytext));
adamc@156: <INITIAL> "|"         => (Tokens.BAR (pos yypos, pos yypos + size yytext));
adamc@195: <INITIAL> "*"         => (Tokens.STAR (pos yypos, pos yypos + size yytext));
adamc@243: <INITIAL> "<-"        => (Tokens.LARROW (pos yypos, pos yypos + size yytext));
adamc@243: <INITIAL> ";"         => (Tokens.SEMI (pos yypos, pos yypos + size yytext));
adamc@629: <INITIAL> "!"         => (Tokens.BANG (pos yypos, pos yypos + size yytext));
adamc@1: 
adamc@389: <INITIAL> "+"         => (Tokens.PLUS (pos yypos, pos yypos + size yytext));
adamc@389: <INITIAL> "-"         => (Tokens.MINUS (pos yypos, pos yypos + size yytext));
adamc@389: <INITIAL> "/"         => (Tokens.DIVIDE (yypos, yypos + size yytext));
adamc@389: <INITIAL> "%"         => (Tokens.MOD (pos yypos, pos yypos + size yytext));
adamc@403: <INITIAL> "@"         => (Tokens.AT (pos yypos, pos yypos + size yytext));
adamc@389: 
adamc@54: <INITIAL> "con"       => (Tokens.CON (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "type"      => (Tokens.LTYPE (pos yypos, pos yypos + size yytext));
adamc@156: <INITIAL> "datatype"  => (Tokens.DATATYPE (pos yypos, pos yypos + size yytext));
adamc@156: <INITIAL> "of"        => (Tokens.OF (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "val"       => (Tokens.VAL (pos yypos, pos yypos + size yytext));
adamc@123: <INITIAL> "rec"       => (Tokens.REC (pos yypos, pos yypos + size yytext));
adamc@123: <INITIAL> "and"       => (Tokens.AND (pos yypos, pos yypos + size yytext));
adamc@242: <INITIAL> "fun"       => (Tokens.FUN (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "fn"        => (Tokens.FN (pos yypos, pos yypos + size yytext));
adamc@621: <INITIAL> "map"       => (Tokens.MAP (pos yypos, pos yypos + size yytext));
adamc@170: <INITIAL> "case"      => (Tokens.CASE (pos yypos, pos yypos + size yytext));
adamc@190: <INITIAL> "if"        => (Tokens.IF (pos yypos, pos yypos + size yytext));
adamc@190: <INITIAL> "then"      => (Tokens.THEN (pos yypos, pos yypos + size yytext));
adamc@190: <INITIAL> "else"      => (Tokens.ELSE (pos yypos, pos yypos + size yytext));
adamc@1: 
adamc@842: 
adamc@54: <INITIAL> "structure" => (Tokens.STRUCTURE (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "struct"    => (Tokens.STRUCT (pos yypos, pos yypos + size yytext));
adam@1590: <INITIAL> "sig"       => (if yypos <= 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext));
adamc@446: <INITIAL> "let"       => (Tokens.LET (pos yypos, pos yypos + size yytext));
adamc@446: <INITIAL> "in"        => (Tokens.IN (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "end"       => (Tokens.END (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "functor"   => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "where"     => (Tokens.WHERE (pos yypos, pos yypos + size yytext));
adamc@58: <INITIAL> "include"   => (Tokens.INCLUDE (pos yypos, pos yypos + size yytext));
adamc@58: <INITIAL> "open"      => (Tokens.OPEN (pos yypos, pos yypos + size yytext));
adamc@88: <INITIAL> "constraint"=> (Tokens.CONSTRAINT (pos yypos, pos yypos + size yytext));
adamc@88: <INITIAL> "constraints"=> (Tokens.CONSTRAINTS (pos yypos, pos yypos + size yytext));
adamc@109: <INITIAL> "export"    => (Tokens.EXPORT (pos yypos, pos yypos + size yytext));
adamc@203: <INITIAL> "table"     => (Tokens.TABLE (pos yypos, pos yypos + size yytext));
adamc@338: <INITIAL> "sequence"  => (Tokens.SEQUENCE (pos yypos, pos yypos + size yytext));
adamc@754: <INITIAL> "view"      => (Tokens.VIEW (pos yypos, pos yypos + size yytext));
adamc@211: <INITIAL> "class"     => (Tokens.CLASS (pos yypos, pos yypos + size yytext));
adamc@459: <INITIAL> "cookie"    => (Tokens.COOKIE (pos yypos, pos yypos + size yytext));
adamc@718: <INITIAL> "style"     => (Tokens.STYLE (pos yypos, pos yypos + size yytext));
adamc@1075: <INITIAL> "task"      => (Tokens.TASK (pos yypos, pos yypos + size yytext));
adamc@1199: <INITIAL> "policy"    => (Tokens.POLICY (pos yypos, pos yypos + size yytext));
adam@2010: <INITIAL> "ffi"       => (Tokens.FFI (pos yypos, pos yypos + size yytext));
adamc@30: 
adamc@54: <INITIAL> "Type"      => (Tokens.TYPE (pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> "Name"      => (Tokens.NAME (pos yypos, pos yypos + size yytext));
adamc@82: <INITIAL> "Unit"      => (Tokens.KUNIT (pos yypos, pos yypos + size yytext));
adamc@1: 
adamc@204: <INITIAL> "SELECT"    => (Tokens.SELECT (pos yypos, pos yypos + size yytext));
adamc@993: <INITIAL> "DISTINCT"  => (Tokens.DISTINCT (pos yypos, pos yypos + size yytext));
adamc@204: <INITIAL> "FROM"      => (Tokens.FROM (pos yypos, pos yypos + size yytext));
adamc@204: <INITIAL> "AS"        => (Tokens.AS (pos yypos, pos yypos + size yytext));
adamc@209: <INITIAL> "WHERE"     => (Tokens.CWHERE (pos yypos, pos yypos + size yytext));
adamc@339: <INITIAL> "SQL"       => (Tokens.SQL (pos yypos, pos yypos + size yytext));
adamc@226: <INITIAL> "GROUP"     => (Tokens.GROUP (pos yypos, pos yypos + size yytext));
adamc@230: <INITIAL> "ORDER"     => (Tokens.ORDER (pos yypos, pos yypos + size yytext));
adamc@226: <INITIAL> "BY"        => (Tokens.BY (pos yypos, pos yypos + size yytext));
adamc@227: <INITIAL> "HAVING"    => (Tokens.HAVING (pos yypos, pos yypos + size yytext));
adamc@231: <INITIAL> "LIMIT"     => (Tokens.LIMIT (pos yypos, pos yypos + size yytext));
adamc@231: <INITIAL> "OFFSET"    => (Tokens.OFFSET (pos yypos, pos yypos + size yytext));
adamc@232: <INITIAL> "ALL"       => (Tokens.ALL (pos yypos, pos yypos + size yytext));
adamc@1071: <INITIAL> "SELECT1"   => (Tokens.SELECT1 (pos yypos, pos yypos + size yytext));
adamc@209: 
adamc@749: <INITIAL> "JOIN"      => (Tokens.JOIN (pos yypos, pos yypos + size yytext));
adamc@749: <INITIAL> "INNER"     => (Tokens.INNER (pos yypos, pos yypos + size yytext));
adamc@749: <INITIAL> "CROSS"     => (Tokens.CROSS (pos yypos, pos yypos + size yytext));
adamc@751: <INITIAL> "OUTER"     => (Tokens.OUTER (pos yypos, pos yypos + size yytext));
adamc@750: <INITIAL> "LEFT"      => (Tokens.LEFT (pos yypos, pos yypos + size yytext));
adamc@751: <INITIAL> "RIGHT"     => (Tokens.RIGHT (pos yypos, pos yypos + size yytext));
adamc@751: <INITIAL> "FULL"      => (Tokens.FULL (pos yypos, pos yypos + size yytext));
adamc@749: 
adamc@229: <INITIAL> "UNION"     => (Tokens.UNION (pos yypos, pos yypos + size yytext));
adamc@229: <INITIAL> "INTERSECT" => (Tokens.INTERSECT (pos yypos, pos yypos + size yytext));
adamc@229: <INITIAL> "EXCEPT"    => (Tokens.EXCEPT (pos yypos, pos yypos + size yytext));
adamc@229: 
adamc@209: <INITIAL> "TRUE"      => (Tokens.TRUE (pos yypos, pos yypos + size yytext));
adamc@209: <INITIAL> "FALSE"     => (Tokens.FALSE (pos yypos, pos yypos + size yytext));
adamc@220: <INITIAL> "AND"       => (Tokens.CAND (pos yypos, pos yypos + size yytext));
adamc@220: <INITIAL> "OR"        => (Tokens.OR (pos yypos, pos yypos + size yytext));
adamc@220: <INITIAL> "NOT"       => (Tokens.NOT (pos yypos, pos yypos + size yytext));
adamc@204: 
adamc@235: <INITIAL> "COUNT"     => (Tokens.COUNT (pos yypos, pos yypos + size yytext));
adamc@236: <INITIAL> "AVG"       => (Tokens.AVG (pos yypos, pos yypos + size yytext));
adamc@236: <INITIAL> "SUM"       => (Tokens.SUM (pos yypos, pos yypos + size yytext));
adamc@236: <INITIAL> "MIN"       => (Tokens.MIN (pos yypos, pos yypos + size yytext));
adamc@236: <INITIAL> "MAX"       => (Tokens.MAX (pos yypos, pos yypos + size yytext));
adam@1776: <INITIAL> "RANK"      => (Tokens.RANK (pos yypos, pos yypos + size yytext));
adam@1778: <INITIAL> "PARTITION" => (Tokens.PARTITION (pos yypos, pos yypos + size yytext));
adam@1778: <INITIAL> "OVER"      => (Tokens.OVER (pos yypos, pos yypos + size yytext));
adamc@235: 
kkallio@1572: <INITIAL> "IF"        => (Tokens.CIF (pos yypos, pos yypos + size yytext));
kkallio@1572: <INITIAL> "THEN"      => (Tokens.CTHEN (pos yypos, pos yypos + size yytext));
kkallio@1572: <INITIAL> "ELSE"      => (Tokens.CELSE (pos yypos, pos yypos + size yytext));
kkallio@1572: 
adamc@268: <INITIAL> "ASC"       => (Tokens.ASC (pos yypos, pos yypos + size yytext));
adamc@268: <INITIAL> "DESC"      => (Tokens.DESC (pos yypos, pos yypos + size yytext));
adam@1682: <INITIAL> "RANDOM"    => (Tokens.RANDOM (pos yypos, pos yypos + size yytext));
adamc@268: 
adamc@302: <INITIAL> "INSERT"    => (Tokens.INSERT (pos yypos, pos yypos + size yytext));
adamc@302: <INITIAL> "INTO"      => (Tokens.INTO (pos yypos, pos yypos + size yytext));
adamc@302: <INITIAL> "VALUES"    => (Tokens.VALUES (pos yypos, pos yypos + size yytext));
adamc@302: <INITIAL> "UPDATE"    => (Tokens.UPDATE (pos yypos, pos yypos + size yytext));
adamc@302: <INITIAL> "SET"       => (Tokens.SET (pos yypos, pos yypos + size yytext));
adamc@302: <INITIAL> "DELETE"    => (Tokens.DELETE (pos yypos, pos yypos + size yytext));
adamc@467: <INITIAL> "NULL"      => (Tokens.NULL (pos yypos, pos yypos + size yytext));
adamc@470: <INITIAL> "IS"        => (Tokens.IS (pos yypos, pos yypos + size yytext));
adam@1602: <INITIAL> "COALESCE"  => (Tokens.COALESCE (pos yypos, pos yypos + size yytext));
kkallio@1607: <INITIAL> "LIKE"      => (Tokens.LIKE (pos yypos, pos yypos + size yytext));
adamc@302: 
adamc@704: <INITIAL> "CONSTRAINT"=> (Tokens.CCONSTRAINT (pos yypos, pos yypos + size yytext));
adamc@704: <INITIAL> "UNIQUE"    => (Tokens.UNIQUE (pos yypos, pos yypos + size yytext));
adamc@714: <INITIAL> "CHECK"     => (Tokens.CHECK (pos yypos, pos yypos + size yytext));
adamc@707: <INITIAL> "PRIMARY"   => (Tokens.PRIMARY (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "FOREIGN"   => (Tokens.FOREIGN (pos yypos, pos yypos + size yytext));
adamc@707: <INITIAL> "KEY"       => (Tokens.KEY (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "ON"        => (Tokens.ON (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "NO"        => (Tokens.NO (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "ACTION"    => (Tokens.ACTION (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "RESTRICT"  => (Tokens.RESTRICT (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "CASCADE"   => (Tokens.CASCADE (pos yypos, pos yypos + size yytext));
adamc@709: <INITIAL> "REFERENCES"=> (Tokens.REFERENCES (pos yypos, pos yypos + size yytext));
adamc@709: 
adamc@709: <INITIAL> "CURRENT_TIMESTAMP" => (Tokens.CURRENT_TIMESTAMP (pos yypos, pos yypos + size yytext));
adamc@704: 
griba2001@2150: <INITIAL> "_LOC_" => (let val strLoc = ErrorMsg.spanToString (ErrorMsg.spanOf
griba2001@2150:                                             (pos yypos, pos yypos + size yytext))
griba2001@2150:                       in
griba2001@2150:                           Tokens.STRING (strLoc, pos yypos, pos yypos + size yytext)
griba2001@2150:                       end);
griba2001@2150: 
adamc@54: <INITIAL> {id}        => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext));
adamc@54: <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext));
adamc@1: 
adam@2148: <INITIAL> {hexconst}  => (let val digits = String.extract (yytext, 2, NONE)
adam@2148:                               val v = (StringCvt.scanString (Int64.scan StringCvt.HEX) digits)
adam@2148:                                       handle Overflow => NONE
adam@2148:                           in
adam@2148:                           case v of
adam@2124:                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
adam@2124:                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adam@2124:                                                            ("Expected hexInt, received: " ^ yytext);
adam@2148:                                          continue ())
adam@2148:                          end);
adam@2124: 
adam@2148: <INITIAL> {intconst}  => (let val v = (Int64.fromString yytext) handle Overflow => NONE
adam@2148:                           in 
adam@2148:                           case v of
adamc@120:                               SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext)
adamc@120:                             | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adamc@120:                                                            ("Expected int, received: " ^ yytext);
adam@2148:                                          continue ())
adam@2148:                          end);
adamc@14: <INITIAL> {realconst} => (case Real64.fromString yytext of
adamc@54:                             SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext)
adamc@54:                           | NONE   => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adamc@14:                                        ("Expected float, received: " ^ yytext);
adamc@14:                                        continue ()));
adamc@14: 
adamc@1: <COMMENT> .           => (continue());
adamc@1: 
adamc@54: <INITIAL> .           => (ErrorMsg.errorAt' (pos yypos, pos yypos)
adamc@1:                                             ("illegal character: \"" ^ yytext ^ "\"");
adamc@1:                           continue ());