(* HCoop Domtool (http://hcoop.sourceforge.net/) * Copyright (c) 2006, Adam Chlipala * * This program is free software; you can redistribute it and/or * modify it under the terms of the GNU General Public License * as published by the Free Software Foundation; either version 2 * of the License, or (at your option) any later version. * * This program 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 General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) (* Lexer for Domtool configuration files *) 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 local val commentLevel = ref 0 val commentPos = ref 0 in fun enterComment yypos = (commentLevel := !commentLevel + 1; commentPos := yypos) 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 ([] : char list) val strStart = ref 0 %% %header (functor DomtoolLexFn(structure Tokens : Domtool_TOKENS)); %full %s COMMENT STRING DOC; id = [a-z_][A-Za-z0-9_]*; cid = [A-Z][A-Za-z0-9_]*; intconst = [0-9]+; ws = [\ \t\012]; lineComment = #[^\n]*\n; %% \n => (lineNum := !lineNum + 1; linePos := yypos :: ! linePos; continue ()); \n => (lineNum := !lineNum + 1; linePos := yypos :: ! linePos; continue ()); {ws}+ => (lex ()); lineComment => (lex ()); "(*" => (YYBEGIN COMMENT; enterComment yypos; continue()); "*)" => (ErrorMsg.error (SOME (yypos, yypos)) "Unbalanced comments"; continue()); "(*" => (enterComment yypos; continue()); "*)" => (if exitComment () then YYBEGIN INITIAL else (); continue()); "\"" => (YYBEGIN STRING; strStart := yypos; str := []; continue()); "\\\"" => (str := #"\"" :: !str; continue()); "\"" => (YYBEGIN INITIAL; Tokens.STRING (String.implode (List.rev (!str)), !strStart, yypos + 1)); "\n" => (lineNum := !lineNum + 1; linePos := yypos :: ! linePos; str := #"\n" :: !str; continue()); . => (str := String.sub (yytext, 0) :: !str; continue()); "{{" => (YYBEGIN DOC; strStart := yypos; str := []; continue()); "}}" => (YYBEGIN INITIAL; Tokens.DOC (String.implode (List.rev (!str)), !strStart, yypos + 1)); "\n" => (lineNum := !lineNum + 1; linePos := yypos :: ! linePos; 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.LARROW (yypos, yypos + size yytext)); "=" => (Tokens.EQ (yypos, yypos + size yytext)); "," => (Tokens.COMMA (yypos, yypos + size yytext)); "\\" => (Tokens.BSLASH (yypos, yypos + size yytext)); ":" => (Tokens.COLON (yypos, yypos + size yytext)); ";" => (Tokens.SEMI (yypos, yypos + size yytext)); "^" => (Tokens.CARET (yypos, yypos + size yytext)); "!" => (Tokens.BANG (yypos, yypos + size yytext)); "&" => (Tokens.AND (yypos, yypos + size yytext)); "let" => (Tokens.LET (yypos, yypos + size yytext)); "in" => (Tokens.IN (yypos, yypos + size yytext)); "end" => (Tokens.END (yypos, yypos + size yytext)); "with" => (Tokens.WITH (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)); "val" => (Tokens.VAL (yypos, yypos + size yytext)); "context" => (Tokens.CONTEXT (yypos, yypos + size yytext)); "Root" => (Tokens.ROOT (yypos, yypos + size yytext)); {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext)); {cid} => (Tokens.CSYMBOL (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 ())); . => (continue()); . => (ErrorMsg.error (SOME (yypos,yypos)) ("illegal character: \"" ^ yytext ^ "\""); continue ());