src/domtool.lex

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* Lexer for Domtool configuration files *)
  20
  21 type pos = int
  22 type svalue = Tokens.svalue
  23 type ('a,'b) token = ('a,'b) Tokens.token
  24 type lexresult = (svalue,pos) Tokens.token
  25
  26 val lineNum = ErrorMsg.lineNum
  27 val linePos = ErrorMsg.linePos
  28
  29 local
  30   val commentLevel = ref 0
  31   val commentPos = ref 0
  32 in
  33   fun enterComment yypos = (commentLevel := !commentLevel + 1; commentPos := yypos)
  34
  35   fun exitComment () =
  36    let val _ = commentLevel := !commentLevel - 1 in
  37      !commentLevel = 0
  38    end
  39
  40   fun eof () =
  41     let
  42       val pos = hd (!linePos)
  43     in
  44       if (!commentLevel > 0) then
  45           (ErrorMsg.error (SOME (!commentPos,!commentPos)) "Unterminated comment")
  46       else ();
  47       Tokens.EOF (pos,pos)
  48     end
  49 end
  50
  51 val str = ref ([] : char list)
  52 val strStart = ref 0
  53
  54 %%
  55 %header (functor DomtoolLexFn(structure Tokens : Domtool_TOKENS));
  56 %full
  57 %s COMMENT STRING DOC;
  58
  59 id = [a-z_][A-Za-z0-9_]*;
  60 cid = [A-Z][A-Za-z0-9_]*;
  61 intconst = [0-9]+;
  62 ws = [\ \t\012];
  63 lineComment = #[^\n]*\n;
  64
  65 %%
  66
  67 <INITIAL> \n          => (lineNum := !lineNum + 1;
  68                           linePos := yypos :: ! linePos;
  69                           continue ());
  70 <COMMENT> \n          => (lineNum := !lineNum + 1;
  71                           linePos := yypos :: ! linePos;
  72                           continue ());
  73
  74 <INITIAL> {ws}+       => (lex ());
  75
  76 <INITIAL> lineComment => (lex ());
  77
  78 <INITIAL> "(*"        => (YYBEGIN COMMENT; enterComment yypos; continue());
  79 <INITIAL> "*)"        => (ErrorMsg.error (SOME (yypos, yypos)) "Unbalanced comments";
  80                           continue());
  81
  82 <COMMENT> "(*"        => (enterComment yypos; continue());
  83 <COMMENT> "*)"        => (if exitComment () then YYBEGIN INITIAL else ();
  84                           continue());
  85
  86 <INITIAL> "\""        => (YYBEGIN STRING; strStart := yypos; str := []; continue());
  87 <STRING> "\\\""       => (str := #"\"" :: !str; continue());
  88 <STRING> "\""         => (YYBEGIN INITIAL;
  89                           Tokens.STRING (String.implode (List.rev (!str)), !strStart, yypos + 1));
  90 <STRING> "\n"         => (lineNum := !lineNum + 1;
  91                           linePos := yypos :: ! linePos;
  92                           str := #"\n" :: !str; continue());
  93 <STRING> .            => (str := String.sub (yytext, 0) :: !str; continue());
  94
  95 <INITIAL> "{{"        => (YYBEGIN DOC; strStart := yypos; str := []; continue());
  96 <DOC> "}}"            => (YYBEGIN INITIAL;
  97                           Tokens.DOC (String.implode (List.rev (!str)), !strStart, yypos + 1));
  98 <DOC> "\n"            => (lineNum := !lineNum + 1;
  99                           linePos := yypos :: ! linePos;
 100                           str := #"\n" :: !str; continue());
 101 <DOC> .               => (str := String.sub (yytext, 0) :: !str; continue());
 102
 103 <INITIAL> "("         => (Tokens.LPAREN (yypos, yypos + size yytext));
 104 <INITIAL> ")"         => (Tokens.RPAREN (yypos, yypos + size yytext));
 105
 106 <INITIAL> "["         => (Tokens.LBRACK (yypos, yypos + size yytext));
 107 <INITIAL> "]"         => (Tokens.RBRACK (yypos, yypos + size yytext));
 108
 109 <INITIAL> "{"         => (Tokens.LBRACE (yypos, yypos + size yytext));
 110 <INITIAL> "}"         => (Tokens.RBRACE (yypos, yypos + size yytext));
 111
 112 <INITIAL> "->"        => (Tokens.ARROW (yypos, yypos + size yytext));
 113 <INITIAL> "=>"        => (Tokens.DARROW (yypos, yypos + size yytext));
 114 <INITIAL> "<-"        => (Tokens.LARROW (yypos, yypos + size yytext));
 115
 116 <INITIAL> "="         => (Tokens.EQ (yypos, yypos + size yytext));
 117 <INITIAL> ","         => (Tokens.COMMA (yypos, yypos + size yytext));
 118 <INITIAL> "\\\\"      => (Tokens.BSLASHBSLASH (yypos, yypos + size yytext));
 119 <INITIAL> "\\"        => (Tokens.BSLASH (yypos, yypos + size yytext));
 120 <INITIAL> ":"         => (Tokens.COLON (yypos, yypos + size yytext));
 121 <INITIAL> ";"         => (Tokens.SEMI (yypos, yypos + size yytext));
 122 <INITIAL> "^"         => (Tokens.CARET (yypos, yypos + size yytext));
 123 <INITIAL> "!"         => (Tokens.BANG (yypos, yypos + size yytext));
 124 <INITIAL> "&"         => (Tokens.AND (yypos, yypos + size yytext));
 125
 126 <INITIAL> "let"       => (Tokens.LET (yypos, yypos + size yytext));
 127 <INITIAL> "in"        => (Tokens.IN (yypos, yypos + size yytext));
 128 <INITIAL> "end"       => (Tokens.END (yypos, yypos + size yytext));
 129 <INITIAL> "with"      => (Tokens.WITH (yypos, yypos + size yytext));
 130 <INITIAL> "where"     => (Tokens.WHERE (yypos, yypos + size yytext));
 131
 132 <INITIAL> "extern"    => (Tokens.EXTERN (yypos, yypos + size yytext));
 133 <INITIAL> "type"      => (Tokens.TYPE (yypos, yypos + size yytext));
 134 <INITIAL> "val"       => (Tokens.VAL (yypos, yypos + size yytext));
 135 <INITIAL> "context"   => (Tokens.CONTEXT (yypos, yypos + size yytext));
 136
 137 <INITIAL> "Root"      => (Tokens.ROOT (yypos, yypos + size yytext));
 138
 139 <INITIAL> {id}        => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
 140 <INITIAL> {cid}       => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
 141 <INITIAL> {intconst}  => (case Int.fromString yytext of
 142                             SOME x => Tokens.INT (x, yypos, yypos + size yytext)
 143                           | NONE   => (ErrorMsg.error (SOME (yypos, yypos))
 144                                        ("Expected int, received: " ^ yytext);
 145                                        continue ()));
 146
 147 <COMMENT> .           => (continue());
 148
 149 <INITIAL> .           => (ErrorMsg.error (SOME (yypos,yypos))
 150                           ("illegal character: \"" ^ yytext ^ "\"");
 151                           continue ());