mailman: open /usr/share/images/mailman, revert to mod_access_compat
[hcoop/domtool2.git] / 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> "begin" => (Tokens.BEGIN (yypos, yypos + size yytext));
129 <INITIAL> "end" => (Tokens.END (yypos, yypos + size yytext));
130 <INITIAL> "with" => (Tokens.WITH (yypos, yypos + size yytext));
131 <INITIAL> "where" => (Tokens.WHERE (yypos, yypos + size yytext));
132
133 <INITIAL> "if" => (Tokens.IF (yypos, yypos + size yytext));
134 <INITIAL> "then" => (Tokens.THEN (yypos, yypos + size yytext));
135 <INITIAL> "else" => (Tokens.ELSE (yypos, yypos + size yytext));
136 <INITIAL> "Skip" => (Tokens.SKIP (yypos, yypos + size yytext));
137
138 <INITIAL> "extern" => (Tokens.EXTERN (yypos, yypos + size yytext));
139 <INITIAL> "type" => (Tokens.TYPE (yypos, yypos + size yytext));
140 <INITIAL> "val" => (Tokens.VAL (yypos, yypos + size yytext));
141 <INITIAL> "var" => (Tokens.ENV (yypos, yypos + size yytext));
142 <INITIAL> "context" => (Tokens.CONTEXT (yypos, yypos + size yytext));
143
144 <INITIAL> "Root" => (Tokens.ROOT (yypos, yypos + size yytext));
145
146 <INITIAL> {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
147 <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext));
148 <INITIAL> {intconst} => (case Int.fromString yytext of
149 SOME x => Tokens.INT (x, yypos, yypos + size yytext)
150 | NONE => (ErrorMsg.error (SOME (yypos, yypos))
151 ("Expected int, received: " ^ yytext);
152 continue ()));
153
154 <COMMENT> . => (continue());
155
156 <INITIAL> . => (ErrorMsg.error (SOME (yypos,yypos))
157 ("illegal character: \"" ^ yytext ^ "\"");
158 continue ());