(* * Dynamic web page generation with Standard ML * Copyright (C) 2003 Adam Chlipala * * This library is free software; you can redistribute it and/or * modify it under the terms of the GNU Lesser General Public * License as published by the Free Software Foundation; either * version 2.1 of the License, or (at your option) any later version. * * This library is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU * Lesser General Public License for more details. * * You should have received a copy of the GNU Lesser General Public * License along with this library; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA *) (* Lexing info for ML template language *) type pos = int type svalue = Tokens.svalue type ('a,'b) token = ('a,'b) Tokens.token type lexresult = (svalue,pos) Tokens.token val lineNum = ErrorMsg.lineNum val linePos = ErrorMsg.linePos fun strip s = String.extract (s, 1, SOME (String.size s - 2)) local val commentLevel = ref 0 val commentPos = ref 0 val linCom = ref false in fun enterComment yypos = (commentLevel := !commentLevel + 1; commentPos := yypos) fun linComStart yypos = (linCom := true; commentPos := yypos) fun isLinCom () = !linCom fun linComEnd () = linCom := false fun exitComment () = let val _ = commentLevel := !commentLevel - 1 in !commentLevel = 0 end fun eof () = let val pos = hd (!linePos) in if (!commentLevel > 0) then (ErrorMsg.error (SOME (!commentPos,!commentPos)) "Unterminated comment") else (); Tokens.EOF (pos,pos) end end val str = ref "" val strStart = ref 0 %% %header (functor MltLexFn(structure Tokens : Mlt_TOKENS)); %full %s COMMENT STRING CHAR CODE; id = ([A-Za-z_][A-Za-z0-9_]*)|([:]+); intconst = [0-9]+; realconst = [0-9]+\.[0-9]*; ws = [\ \t\012]; bo = [^<\n]+; %% \n => (if isLinCom () then (linComEnd (); YYBEGIN INITIAL) else (); lineNum := !lineNum + 1; linePos := yypos :: ! linePos; continue ()); \n => (lineNum := !lineNum + 1; linePos := yypos :: ! linePos; Tokens.HTML (yytext, yypos, yypos + size yytext)); {ws}+ => (Tokens.HTML (" ", yypos, yypos + size yytext); lex ()); "<%" => (YYBEGIN CODE; Tokens.SEMI(yypos, yypos + size yytext)); "%>" => (YYBEGIN INITIAL; Tokens.SEMI(yypos, yypos + size yytext)); "(*" => (YYBEGIN COMMENT; enterComment yypos; continue()); "*)" => (ErrorMsg.error (SOME (yypos, yypos)) "Unbalanced comments"; continue()); "(*" => (if not (isLinCom ()) then enterComment yypos else (); continue()); "*)" => (if not (isLinCom ()) andalso exitComment () then YYBEGIN INITIAL else (); continue()); "//" => (YYBEGIN COMMENT; linComStart yypos; continue()); {ws}+ => (lex ()); "\"" => (YYBEGIN STRING; strStart := yypos; str := ""; continue()); "\\\"" => (str := !str ^ "\\\""; continue()); "\"" => (YYBEGIN CODE; Tokens.STRING (!str, !strStart, yypos + 1)); . => (str := !str ^ yytext; continue()); "#\"" => (YYBEGIN CHAR; strStart := yypos; str := ""; continue()); "\\\"" => (str := !str ^ "\\\""; continue()); "\"" => (YYBEGIN CODE; if size (!str) = 1 then Tokens.CHAR (!str, !strStart, yypos + 1) else (ErrorMsg.error (SOME (yypos, yypos)) "Invalid character constant"; continue())); . => (str := !str ^ yytext; continue()); "{" => (Tokens.LBRACE (yypos, yypos + size yytext)); "}" => (Tokens.RBRACE (yypos, yypos + size yytext)); "(" => (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.EQ (yypos, yypos + size yytext)); "<>" => (Tokens.NEQ (yypos, yypos + size yytext)); "<" => (Tokens.LT (yypos, yypos + size yytext)); "<=" => (Tokens.LTE (yypos, yypos + size yytext)); ">" => (Tokens.GT (yypos, yypos + size yytext)); ">=" => (Tokens.GTE (yypos, yypos + size yytext)); ":=" => (Tokens.ASN (yypos, yypos + size yytext)); "/" => (Tokens.DIVIDE (yypos, yypos + size yytext)); "*" => (Tokens.TIMES (yypos, yypos + size yytext)); "+" => (Tokens.PLUS (yypos, yypos + size yytext)); "-" => (Tokens.MINUS (yypos, yypos + size yytext)); "%" => (Tokens.MOD (yypos, yypos + size yytext)); "^" => (Tokens.STRCAT (yypos, yypos + size yytext)); "~" => (Tokens.NEG (yypos, yypos + size yytext)); "," => (Tokens.COMMA (yypos, yypos + size yytext)); ":" => (Tokens.COLON (yypos, yypos + size yytext)); "..." => (Tokens.DOTDOTDOT (yypos, yypos + 3)); ".." => (Tokens.DOTDOT (yypos, yypos + 2)); "." => (Tokens.DOT (yypos, yypos + 1)); "_" => (Tokens.UNDER (yypos, yypos + 1)); "#" => (Tokens.HASH (yypos, yypos + 1)); ";" => (Tokens.SEMI (yypos, yypos + 1)); "$" => (Tokens.DOLLAR (yypos, yypos + size yytext)); "@" => (Tokens.AT (yypos, yypos + size yytext)); "if" => (Tokens.IF (yypos, yypos + 2)); "iff" => (Tokens.IFF (yypos, yypos + 3)); "then" => (Tokens.THEN (yypos, yypos + 4)); "else" => (Tokens.ELSE (yypos, yypos + 4)); "elseif" => (Tokens.ELSEIF (yypos, yypos + 6)); "foreach" => (Tokens.FOREACH (yypos, yypos + 7)); "for" => (Tokens.FOR (yypos, yypos + 3)); "in" => (Tokens.IN (yypos, yypos + 2)); "case" => (Tokens.CASE (yypos, yypos + 4)); "as" => (Tokens.AS (yypos, yypos + 2)); "fn" => (Tokens.FN (yypos, yypos + 2)); "with" => (Tokens.WITH (yypos, yypos + 4)); "open" => (Tokens.OPEN (yypos, yypos + 4)); "val" => (Tokens.VAL (yypos, yypos + 3)); "ref" => (Tokens.REF (yypos, yypos + 3)); "try" => (Tokens.TRY (yypos, yypos + 3)); "catch" => (Tokens.CATCH (yypos, yypos + 5)); "or" => (Tokens.ORELSE (yypos, yypos + 2)); "and" => (Tokens.ANDALSO (yypos, yypos + 3)); "switch" => (Tokens.SWITCH (yypos, yypos + 6)); "of" => (Tokens.OF (yypos, yypos + 2)); "=>" => (Tokens.ARROW (yypos, yypos + 2)); "|" => (Tokens.BAR (yypos, yypos + 1)); "do" => (Tokens.DO (yypos, yypos + 2)); "end" => (Tokens.END (yypos, yypos + 3)); "raise" => (Tokens.RAISE (yypos, yypos + 5)); "let" => (Tokens.LET (yypos, yypos + 3)); "in" => (Tokens.IN (yypos, yypos + 2)); "::" => (Tokens.CONS (yypos, yypos + 2)); "o" => (Tokens.O (yypos, yypos + 1)); {id} => (Tokens.IDENT (yytext, yypos, yypos + size yytext)); {intconst} => (case Int.fromString yytext of SOME x => Tokens.INT (x, yypos, yypos + size yytext) | NONE => (ErrorMsg.error (SOME (yypos, yypos)) ("Expected int, received: " ^ yytext); continue ())); {realconst} => (case Real.fromString yytext of SOME x => Tokens.REAL (x, yypos, yypos + size yytext) | NONE => (ErrorMsg.error (SOME (yypos, yypos)) ("Expected real, received: " ^ yytext); continue ())); "\"" {id} "\"" => (Tokens.STRING (String.substring(yytext, 1, String.size yytext - 2), yypos, yypos + size yytext)); . => (continue()); {bo} => (Tokens.HTML (yytext, yypos, yypos + size yytext)); . => (Tokens.HTML (yytext, yypos, yypos + 1)); . => (ErrorMsg.error (SOME (yypos,yypos)) ("illegal character: \"" ^ yytext ^ "\""); continue ());