From ebf05a538b3de96189fefaabb68613e58a2f9f51 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 22 Jun 2008 10:53:11 -0400 Subject: Lexer/parser hacks to share code between regular and signature file parsers --- src/lacweb.lex | 127 +++++++++++++++++++++++++++++++++------------------------ 1 file changed, 73 insertions(+), 54 deletions(-) (limited to 'src/lacweb.lex') diff --git a/src/lacweb.lex b/src/lacweb.lex index 76cf26c0..18c5a9e9 100644 --- a/src/lacweb.lex +++ b/src/lacweb.lex @@ -62,6 +62,25 @@ end val str = ref ([] : char list) val strStart = ref 0 +local + val initSig = ref false + val offset = ref 0 +in + +fun initialSig () = initSig := true + +fun pos yypos = yypos - !offset + +fun newline yypos = + if !initSig then + (initSig := false; + offset := yypos + 1) + else + ErrorMsg.newline (pos yypos) + +end + + %% %header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS)); %full @@ -75,87 +94,87 @@ realconst = [0-9]+\.[0-9]*; %% - \n => (ErrorMsg.newline yypos; + \n => (newline yypos; continue ()); - \n => (ErrorMsg.newline yypos; + \n => (newline yypos; continue ()); {ws}+ => (lex ()); "(*" => (YYBEGIN COMMENT; - enterComment yypos; + enterComment (pos yypos); continue ()); - "*)" => (ErrorMsg.errorAt' (yypos, yypos) "Unbalanced comments"; + "*)" => (ErrorMsg.errorAt' (pos yypos, pos yypos) "Unbalanced comments"; continue ()); - "(*" => (enterComment yypos; + "(*" => (enterComment (pos yypos); continue ()); "*)" => (if exitComment () then YYBEGIN INITIAL else (); continue ()); - "\"" => (YYBEGIN STRING; strStart := yypos; str := []; continue()); + "\"" => (YYBEGIN STRING; strStart := pos yypos; str := []; continue()); "\\\"" => (str := #"\"" :: !str; continue()); "\"" => (YYBEGIN INITIAL; - Tokens.STRING (String.implode (List.rev (!str)), !strStart, yypos + 1)); - "\n" => (ErrorMsg.newline yypos; + Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1)); + "\n" => (newline yypos; str := #"\n" :: !str; continue()); . => (str := String.sub (yytext, 0) :: !str; continue()); - "(" => (Tokens.LPAREN (yypos, yypos + size yytext)); - ")" => (Tokens.RPAREN (yypos, yypos + size yytext)); - "[" => (Tokens.LBRACK (yypos, yypos + size yytext)); - "]" => (Tokens.RBRACK (yypos, yypos + size yytext)); - "{" => (Tokens.LBRACE (yypos, yypos + size yytext)); - "}" => (Tokens.RBRACE (yypos, yypos + size yytext)); - - "->" => (Tokens.ARROW (yypos, yypos + size yytext)); - "=>" => (Tokens.DARROW (yypos, yypos + size yytext)); - "++" => (Tokens.PLUSPLUS (yypos, yypos + size yytext)); - - "=" => (Tokens.EQ (yypos, yypos + size yytext)); - "," => (Tokens.COMMA (yypos, yypos + size yytext)); - ":::" => (Tokens.TCOLON (yypos, yypos + size yytext)); - "::" => (Tokens.DCOLON (yypos, yypos + size yytext)); - ":" => (Tokens.COLON (yypos, yypos + size yytext)); - "." => (Tokens.DOT (yypos, yypos + size yytext)); - "$" => (Tokens.DOLLAR (yypos, yypos + size yytext)); - "#" => (Tokens.HASH (yypos, yypos + size yytext)); - "__" => (Tokens.UNDERUNDER (yypos, yypos + size yytext)); - "_" => (Tokens.UNDER (yypos, yypos + size yytext)); - - "con" => (Tokens.CON (yypos, yypos + size yytext)); - "type" => (Tokens.LTYPE (yypos, yypos + size yytext)); - "val" => (Tokens.VAL (yypos, yypos + size yytext)); - "fn" => (Tokens.FN (yypos, yypos + size yytext)); - - "structure" => (Tokens.STRUCTURE (yypos, yypos + size yytext)); - "signature" => (Tokens.SIGNATURE (yypos, yypos + size yytext)); - "struct" => (Tokens.STRUCT (yypos, yypos + size yytext)); - "sig" => (Tokens.SIG (yypos, yypos + size yytext)); - "end" => (Tokens.END (yypos, yypos + size yytext)); - "functor" => (Tokens.FUNCTOR (yypos, yypos + size yytext)); - "where" => (Tokens.WHERE (yypos, yypos + size yytext)); - "extern" => (Tokens.EXTERN (yypos, yypos + size yytext)); - - "Type" => (Tokens.TYPE (yypos, yypos + size yytext)); - "Name" => (Tokens.NAME (yypos, yypos + size yytext)); - - {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext)); - {cid} => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext)); + "(" => (Tokens.LPAREN (pos yypos, pos yypos + size yytext)); + ")" => (Tokens.RPAREN (pos yypos, pos yypos + size yytext)); + "[" => (Tokens.LBRACK (pos yypos, pos yypos + size yytext)); + "]" => (Tokens.RBRACK (pos yypos, pos yypos + size yytext)); + "{" => (Tokens.LBRACE (pos yypos, pos yypos + size yytext)); + "}" => (Tokens.RBRACE (pos yypos, pos yypos + size yytext)); + + "->" => (Tokens.ARROW (pos yypos, pos yypos + size yytext)); + "=>" => (Tokens.DARROW (pos yypos, pos yypos + size yytext)); + "++" => (Tokens.PLUSPLUS (pos yypos, pos yypos + size yytext)); + + "=" => (Tokens.EQ (pos yypos, pos yypos + size yytext)); + "," => (Tokens.COMMA (pos yypos, pos yypos + size yytext)); + ":::" => (Tokens.TCOLON (pos yypos, pos yypos + size yytext)); + "::" => (Tokens.DCOLON (pos yypos, pos yypos + size yytext)); + ":" => (Tokens.COLON (pos yypos, pos yypos + size yytext)); + "." => (Tokens.DOT (pos yypos, pos yypos + size yytext)); + "$" => (Tokens.DOLLAR (pos yypos, pos yypos + size yytext)); + "#" => (Tokens.HASH (pos yypos, pos yypos + size yytext)); + "__" => (Tokens.UNDERUNDER (pos yypos, pos yypos + size yytext)); + "_" => (Tokens.UNDER (pos yypos, pos yypos + size yytext)); + + "con" => (Tokens.CON (pos yypos, pos yypos + size yytext)); + "type" => (Tokens.LTYPE (pos yypos, pos yypos + size yytext)); + "val" => (Tokens.VAL (pos yypos, pos yypos + size yytext)); + "fn" => (Tokens.FN (pos yypos, pos yypos + size yytext)); + + "structure" => (Tokens.STRUCTURE (pos yypos, pos yypos + size yytext)); + "signature" => (Tokens.SIGNATURE (pos yypos, pos yypos + size yytext)); + "struct" => (Tokens.STRUCT (pos yypos, pos yypos + size yytext)); + "sig" => (if yypos = 2 then initialSig () else (); Tokens.SIG (pos yypos, pos yypos + size yytext)); + "end" => (Tokens.END (pos yypos, pos yypos + size yytext)); + "functor" => (Tokens.FUNCTOR (pos yypos, pos yypos + size yytext)); + "where" => (Tokens.WHERE (pos yypos, pos yypos + size yytext)); + "extern" => (Tokens.EXTERN (pos yypos, pos yypos + size yytext)); + + "Type" => (Tokens.TYPE (pos yypos, pos yypos + size yytext)); + "Name" => (Tokens.NAME (pos yypos, pos yypos + size yytext)); + + {id} => (Tokens.SYMBOL (yytext, pos yypos, pos yypos + size yytext)); + {cid} => (Tokens.CSYMBOL (yytext, pos yypos, pos yypos + size yytext)); {intconst} => (case Int64.fromString yytext of - SOME x => Tokens.INT (x, yypos, yypos + size yytext) - | NONE => (ErrorMsg.errorAt' (yypos, yypos) + SOME x => Tokens.INT (x, pos yypos, pos yypos + size yytext) + | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos) ("Expected int, received: " ^ yytext); continue ())); {realconst} => (case Real64.fromString yytext of - SOME x => Tokens.FLOAT (x, yypos, yypos + size yytext) - | NONE => (ErrorMsg.errorAt' (yypos, yypos) + SOME x => Tokens.FLOAT (x, pos yypos, pos yypos + size yytext) + | NONE => (ErrorMsg.errorAt' (pos yypos, pos yypos) ("Expected float, received: " ^ yytext); continue ())); . => (continue()); - . => (ErrorMsg.errorAt' (yypos, yypos) + . => (ErrorMsg.errorAt' (pos yypos, pos yypos) ("illegal character: \"" ^ yytext ^ "\""); continue ()); -- cgit v1.2.3