9fc2614f |
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. |
ae3a5b8c |
17 | *) |
9fc2614f |
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 |
e680130a |
57 | %s COMMENT STRING DOC; |
9fc2614f |
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 | |
e680130a |
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 | |
9fc2614f |
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)); |
7d3ae99f |
114 | <INITIAL> "<-" => (Tokens.LARROW (yypos, yypos + size yytext)); |
9fc2614f |
115 | |
116 | <INITIAL> "=" => (Tokens.EQ (yypos, yypos + size yytext)); |
117 | <INITIAL> "," => (Tokens.COMMA (yypos, yypos + size yytext)); |
bf9b0bc3 |
118 | <INITIAL> "\\\\" => (Tokens.BSLASHBSLASH (yypos, yypos + size yytext)); |
9fc2614f |
119 | <INITIAL> "\\" => (Tokens.BSLASH (yypos, yypos + size yytext)); |
120 | <INITIAL> ":" => (Tokens.COLON (yypos, yypos + size yytext)); |
121 | <INITIAL> ";" => (Tokens.SEMI (yypos, yypos + size yytext)); |
ccc91989 |
122 | <INITIAL> "^" => (Tokens.CARET (yypos, yypos + size yytext)); |
123 | <INITIAL> "!" => (Tokens.BANG (yypos, yypos + size yytext)); |
124 | <INITIAL> "&" => (Tokens.AND (yypos, yypos + size yytext)); |
9fc2614f |
125 | |
126 | <INITIAL> "let" => (Tokens.LET (yypos, yypos + size yytext)); |
127 | <INITIAL> "in" => (Tokens.IN (yypos, yypos + size yytext)); |
a6404ae7 |
128 | <INITIAL> "begin" => (Tokens.BEGIN (yypos, yypos + size yytext)); |
9fc2614f |
129 | <INITIAL> "end" => (Tokens.END (yypos, yypos + size yytext)); |
e680130a |
130 | <INITIAL> "with" => (Tokens.WITH (yypos, yypos + size yytext)); |
2dc33fa4 |
131 | <INITIAL> "where" => (Tokens.WHERE (yypos, yypos + size yytext)); |
e680130a |
132 | |
254f7f93 |
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)); |
70ecef16 |
136 | <INITIAL> "Skip" => (Tokens.SKIP (yypos, yypos + size yytext)); |
254f7f93 |
137 | |
e680130a |
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)); |
51c32b45 |
141 | <INITIAL> "context" => (Tokens.CONTEXT (yypos, yypos + size yytext)); |
9fc2614f |
142 | |
ccc91989 |
143 | <INITIAL> "Root" => (Tokens.ROOT (yypos, yypos + size yytext)); |
144 | |
9fc2614f |
145 | <INITIAL> {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext)); |
146 | <INITIAL> {cid} => (Tokens.CSYMBOL (yytext, yypos, yypos + size yytext)); |
147 | <INITIAL> {intconst} => (case Int.fromString yytext of |
148 | SOME x => Tokens.INT (x, yypos, yypos + size yytext) |
149 | | NONE => (ErrorMsg.error (SOME (yypos, yypos)) |
150 | ("Expected int, received: " ^ yytext); |
151 | continue ())); |
152 | |
153 | <COMMENT> . => (continue()); |
154 | |
155 | <INITIAL> . => (ErrorMsg.error (SOME (yypos,yypos)) |
156 | ("illegal character: \"" ^ yytext ^ "\""); |
157 | continue ()); |