lexer.ulex

(*
 * The following licensing terms and conditions apply and must be
 * accepted in order to use the Reference Implementation:
 * 
 *    1. This Reference Implementation is made available to all
 * interested persons on the same terms as Ecma makes available its
 * standards and technical reports, as set forth at
 * http://www.ecma-international.org/publications/.
 * 
 *    2. All liability and responsibility for any use of this Reference
 * Implementation rests with the user, and not with any of the parties
 * who contribute to, or who own or hold any copyright in, this Reference
 * Implementation.
 * 
 *    3. THIS REFERENCE IMPLEMENTATION IS PROVIDED BY THE COPYRIGHT
 * HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED
 * WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
 * DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE
 * LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 * CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 * SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
 * BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
 * WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
 * OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
 * IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 * 
 * End of Terms and Conditions
 * 
 * Copyright (c) 2007 Adobe Systems Inc., The Mozilla Foundation, Opera
 * Software ASA, and others.
 *)

%name Lexer;
%charset UTF8;


%defs (
open Token

(* Local tracing machinery *)

val doTrace = ref false
fun trace ss = if (!doTrace) then LogErr.log ("[lex] " :: ss) else ()

fun error ss = LogErr.lexError ss

type lex_result = TOKEN

fun eof _ = Eof

fun chopTrailing (s:string) 
    : string = 
    String.substring (s, 0, ((String.size s) - 1))

val (found_newline : bool ref) = ref false
val (curr_quote    : char ref) = ref #"\000"
val (curr_chars    : UTF8.wchar list ref) = ref []
);


%states REGEXP REGEXP_CHARSET XML SINGLE_LINE_COMMENT MULTI_LINE_COMMENT STRING;

(*
%let whitespace      = {:whitespace:}+;  Chris wonders what he's doing wrong here...
*)
%let whitespace      = [\009\013\032]+;

%let identifierStart = [$A-Za-z_];
%let identifierPart  = [$A-Za-z_0-9];
%let identifier      = ({identifierStart} {identifierPart}*);

%let hexDigit           = [0-9A-Fa-f];
%let decimalDigit       = [0-9];
%let nonZeroDigit       = [1-9];
%let exponentIndicator  = [Ee];

%let decimalDigits      = ({decimalDigit}+);
%let signedInteger      = (("+" | "-")? {decimalDigits});
%let exponentPart       = ({exponentIndicator} {signedInteger});

%let decimalIntegerLiteral = ({decimalDigits});
%let decimalLiteral_1      = ({decimalIntegerLiteral} "." {decimalDigits}? {exponentPart}?);
%let decimalLiteral_2      = ("." {decimalDigits} {exponentPart}?);
%let decimalLiteral_3      = ({decimalIntegerLiteral} {exponentPart}?);
%let decimalLiteral        = ({decimalLiteral_1} | {decimalLiteral_2} | {decimalLiteral_3});

%let hexIntegerLiteral     = ("0" [Xx] {hexDigit}+);

%let explicitIntLiteral      = ({hexIntegerLiteral} | {decimalIntegerLiteral}) "i";
%let explicitUIntHexLiteral  = ({hexIntegerLiteral}) "u";
%let explicitUIntDecLiteral  = ({decimalIntegerLiteral}) "u";
%let explicitDoubleLiteral   = {decimalLiteral} "d";
%let explicitDecimalLiteral  = {decimalLiteral} "m";

%let charEscape            = "\\" (["'\\bfnrtv] | "x" {hexDigit}{2} | [0-7] | [0-7][0-7] | [0-7][0-7][0-7]);

%let regexpFlags           = [a-zA-Z]*;



<INITIAL>"\n"              => (Eol);

<INITIAL>"-"               => (Minus);
<INITIAL>"--"              => (MinusMinus);
<INITIAL>"-="              => (MinusAssign);
<INITIAL>"!"               => (Not);
<INITIAL>"!="              => (NotEquals);
<INITIAL>"!=="             => (StrictNotEquals);
<INITIAL>"%"               => (Modulus);
<INITIAL>"%="              => (ModulusAssign);
<INITIAL>"&"               => (BitwiseAnd);
<INITIAL>"&&"              => (LogicalAnd);
<INITIAL>"&&="             => (LogicalAndAssign);
<INITIAL>"&="              => (BitwiseAndAssign);
<INITIAL>"("               => (LeftParen);
<INITIAL>")"               => (RightParen);
<INITIAL>"*"               => (Mult);
<INITIAL>"*="              => (MultAssign);
<INITIAL>","               => (Comma);
<INITIAL>"."               => (Dot);
<INITIAL>".."              => (DoubleDot);
<INITIAL>"..."             => (TripleDot);
<INITIAL>".<"              => (LeftDotAngle);

<INITIAL>"/"               => (LexBreakDiv       { lex_initial = fn _ => [], lex_regexp = fn _ => [] });
<INITIAL>"/="              => (LexBreakDivAssign { lex_initial = fn _ => [], lex_regexp = fn _ => [] });

<INITIAL>":"               => (Colon);
<INITIAL>"::"              => (DoubleColon);
<INITIAL>";"               => (SemiColon);
<INITIAL>"?"               => (QuestionMark);
<INITIAL>"@"               => (At);
<INITIAL>"["               => (LeftBracket);
<INITIAL>"]"               => (RightBracket);
<INITIAL>"^"               => (BitwiseXor);
<INITIAL>"^="              => (BitwiseXorAssign);
<INITIAL>"{"               => (LeftBrace);
<INITIAL>"|"               => (BitwiseOr);
<INITIAL>"||"              => (LogicalOr);
<INITIAL>"||="             => (LogicalOrAssign);
<INITIAL>"|="              => (BitwiseOrAssign);
<INITIAL>"}"               => (RightBrace);
<INITIAL>"~"               => (BitwiseNot);
<INITIAL>"+"               => (Plus);
<INITIAL>"++"              => (PlusPlus);
<INITIAL>"+="              => (PlusAssign);

<INITIAL>"<"               => (LexBreakLessThan { lex_initial = fn _ => [], lex_xml = fn _ => [] });

<INITIAL>"<<"              => (LeftShift);
<INITIAL>"<<="             => (LeftShiftAssign);
<INITIAL>"<="              => (LessThanOrEquals);
<INITIAL>"="               => (Assign);
<INITIAL>"=="              => (Equals);
<INITIAL>"==="             => (StrictEquals);
<INITIAL>">"               => (GreaterThan);
<INITIAL>">="              => (GreaterThanOrEquals);
<INITIAL>">>"              => (RightShift);
<INITIAL>">>="             => (RightShiftAssign);
<INITIAL>">>>"             => (UnsignedRightShift);
<INITIAL>">>>="            => (UnsignedRightShiftAssign);

<INITIAL>"as"              => (As);
<INITIAL>"break"           => (Break);
<INITIAL>"case"            => (Case); 
<INITIAL>"cast"            => (Cast); 
<INITIAL>"catch"           => (Catch); 
<INITIAL>"class"           => (Class); 
<INITIAL>"const"           => (Const); 
<INITIAL>"continue"        => (Continue); 
<INITIAL>"default"         => (Default); 
<INITIAL>"delete"          => (Delete); 
<INITIAL>"do"              => (Do); 
<INITIAL>"else"            => (Else); 
<INITIAL>"enum"            => (Enum); 
<INITIAL>"extends"         => (Extends); 
<INITIAL>"false"           => (False); 
<INITIAL>"finally"         => (Finally); 
<INITIAL>"for"             => (For); 
<INITIAL>"function"        => (Function); 
<INITIAL>"if"              => (If);
<INITIAL>"implements"      => (Implements);
<INITIAL>"import"          => (Import);
<INITIAL>"in"              => (In);
<INITIAL>"instanceof"      => (InstanceOf);
<INITIAL>"interface"       => (Interface);
<INITIAL>"internal"        => (Internal);
<INITIAL>"intrinsic"       => (Intrinsic);
<INITIAL>"is"              => (Is);
<INITIAL>"let"             => (Let);
<INITIAL>"new"             => (New);
<INITIAL>"null"            => (Null);
<INITIAL>"package"         => (Package);
<INITIAL>"private"         => (Private);
<INITIAL>"protected"       => (Protected);
<INITIAL>"public"          => (Public);
<INITIAL>"return"          => (Return);
<INITIAL>"super"           => (Super);
<INITIAL>"switch"          => (Switch);
<INITIAL>"this"            => (This);
<INITIAL>"throw"           => (Throw);
<INITIAL>"to"              => (To);
<INITIAL>"true"            => (True);
<INITIAL>"try"             => (Try);
<INITIAL>"typeof"          => (TypeOf);
<INITIAL>"use"             => (Use);
<INITIAL>"var"             => (Var);
<INITIAL>"void"            => (Void);
<INITIAL>"while"           => (While);
<INITIAL>"with"            => (With);

<INITIAL>"call"            => (Call);
<INITIAL>"debugger"        => (Debugger);
<INITIAL>"decimal"         => (Decimal);
<INITIAL>"double"          => (Double);
<INITIAL>"dynamic"         => (Dynamic);
<INITIAL>"each"            => (Each);
<INITIAL>"final"           => (Final);
<INITIAL>"get"             => (Get);
<INITIAL>"goto"            => (Goto);
<INITIAL>"has"             => (Has);
<INITIAL>"include"         => (Include);
<INITIAL>"int"             => (Int);
<INITIAL>"invoke"          => (Invoke);
<INITIAL>"namespace"       => (Namespace);
<INITIAL>"native"          => (Native);
<INITIAL>"number"          => (Number);
<INITIAL>"override"        => (Override);
<INITIAL>"precision"       => (Precision);
<INITIAL>"prototype"       => (Prototype);
<INITIAL>"rounding"        => (Rounding);
<INITIAL>"standard"        => (Standard);
<INITIAL>"strict"          => (Strict);
<INITIAL>"uint"            => (UInt);
<INITIAL>"set"             => (Set);
<INITIAL>"static"          => (Static);
<INITIAL>"type"            => (Type);
<INITIAL>"undefined"       => (Undefined);
<INITIAL>"xml"             => (Token.Xml);
<INITIAL>"yield"           => (Yield);

<INITIAL>{whitespace}      => (continue());
<INITIAL>{identifier}      => (Identifier (Vector.fromList yyunicode));

<INITIAL>{explicitIntLiteral} => (case Int32.fromString (chopTrailing yytext) of
					  SOME i => ExplicitIntLiteral i
					| NONE => error ["unexpected input in {explicitIntLiteral}: '", yytext, "'"]);
<INITIAL>{explicitUIntDecLiteral} => (case LargeInt.fromString (chopTrailing yytext) of
					  SOME i => ExplicitUIntLiteral (Word32.fromLargeInt i)
					| NONE => error ["unexpected input in {explicitUIntDecLiteral}: '", yytext, "'"]);
<INITIAL>{explicitUIntHexLiteral} => (case Word32.fromString (chopTrailing yytext) of
					  SOME i => ExplicitUIntLiteral i
					| NONE => error ["unexpected input in {explicitUIntHexLiteral}: '", yytext, "'"]);
<INITIAL>{explicitDoubleLiteral} => (case Real64.fromString (chopTrailing yytext) of
					  SOME i => ExplicitDoubleLiteral i
					| NONE => error ["unexpected input in {explicitDoubleLiteral}: '", yytext, "'"]);
<INITIAL>{explicitDecimalLiteral} => (case Decimal.fromStringDefault (chopTrailing yytext) of
					  SOME i => ExplicitDecimalLiteral i
					| NONE => error ["unexpected input in {explicitDecimalLiteral}: '", yytext, "'"]);

<INITIAL>{decimalIntegerLiteral} => (DecimalIntegerLiteral yytext);
<INITIAL>{hexIntegerLiteral}     => (HexIntegerLiteral yytext);
<INITIAL>{decimalLiteral}        => (DecimalLiteral yytext);


<INITIAL>"//"                => (YYBEGIN SINGLE_LINE_COMMENT; continue());
<SINGLE_LINE_COMMENT>"\n"    => (YYBEGIN INITIAL; Eol);
<SINGLE_LINE_COMMENT>.       => (continue());

<INITIAL>"/*"                => (YYBEGIN MULTI_LINE_COMMENT; continue());
<MULTI_LINE_COMMENT>"*/"     => (YYBEGIN INITIAL; continue());
<MULTI_LINE_COMMENT>"\n"     => (continue());
<MULTI_LINE_COMMENT>.        => (continue());


<REGEXP>"/"{regexpFlags}    => (let
				    val x_flag = String.isSubstring "x" yytext;
				    val re = rev (!curr_chars) @ yyunicode
				in
				    if !found_newline andalso (not x_flag)
				    then error ["Illegal newline in regexp"]
				    else
				       (curr_chars := [];
					found_newline := false;
					YYBEGIN INITIAL;
					RegexpLiteral (Vector.fromList re))
				end);
<REGEXP>"["                 => (curr_chars := (UTF8.fromAscii #"[") :: !curr_chars;
				YYBEGIN REGEXP_CHARSET;
				continue());
<REGEXP>"\n"|"\r"           => (found_newline := true; continue());
<REGEXP>"\\\n"|"\\\r"       => (continue());
<REGEXP>"\\".               => (curr_chars := List.nth(yyunicode,1) :: (UTF8.fromAscii #"\\") :: !curr_chars;
				continue());
<REGEXP>.                   => (curr_chars := List.nth(yyunicode,0) :: !curr_chars;
				continue());

<REGEXP_CHARSET>"]"         => (curr_chars := (UTF8.fromAscii #"]") :: !curr_chars;
				YYBEGIN REGEXP;
				continue());
<REGEXP_CHARSET>"\n"|"\r"   => (found_newline := true; continue());
<REGEXP_CHARSET>"\\\n"|"\\\r" => (continue());
<REGEXP_CHARSET>"\\".       => (curr_chars := List.nth(yyunicode,1) :: (UTF8.fromAscii #"\\") :: !curr_chars;
				continue());
<REGEXP_CHARSET>.           => (curr_chars := List.nth(yyunicode,0) :: !curr_chars;
				continue());

<INITIAL>"'"|"\""           => (curr_quote := String.sub (yytext,0); 
				curr_chars := [];
				YYBEGIN STRING;
				continue());

<STRING>"'"|"\""            => (if 
				    (!curr_quote) = String.sub (yytext,0)
				then 
				    let 
					val str = rev (!curr_chars)
					(* val str_span = *)
				    in
					curr_quote := #"\000";
					curr_chars := [];
					YYBEGIN INITIAL;
					(* (StringLiteral str, str_span) *)
					StringLiteral (Vector.fromList str)
				    end
				else
				    (curr_chars := (hd yyunicode) :: (!curr_chars);
				    continue()));

<STRING>{charEscape}        =>((case Char.fromCString yytext of
				    NONE => error ["unexpected input in <STRING>{charEscape}: '", yytext, "'"]
				  | SOME c => curr_chars := (UTF8.fromAscii c) :: (!curr_chars));
				continue());

<STRING>"\\".               => (curr_chars := (List.nth(yyunicode,1)) :: (!curr_chars);
				continue());

<STRING>.                   => (curr_chars := (List.nth(yyunicode,0)) :: (!curr_chars);
				continue());

<INITIAL>.                  => (error [
					"unexpected input: '",
					yytext,
					"' -- char code: ",
					Int.toString (Char.ord (String.sub (yytext,0)))
				      ]);