Commit | Line | Data |
---|---|---|
42198578 AC |
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. | |
dac62e84 | 17 | *) |
42198578 AC |
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 | |
234b917a | 57 | %s COMMENT STRING DOC; |
42198578 AC |
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 | ||
234b917a AC |
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 | ||
42198578 AC |
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)); | |
63920aa5 | 114 | <INITIAL> "<-" => (Tokens.LARROW (yypos, yypos + size yytext)); |
42198578 AC |
115 | |
116 | <INITIAL> "=" => (Tokens.EQ (yypos, yypos + size yytext)); | |
117 | <INITIAL> "," => (Tokens.COMMA (yypos, yypos + size yytext)); | |
6bb366c5 | 118 | <INITIAL> "\\\\" => (Tokens.BSLASHBSLASH (yypos, yypos + size yytext)); |
42198578 AC |
119 | <INITIAL> "\\" => (Tokens.BSLASH (yypos, yypos + size yytext)); |
120 | <INITIAL> ":" => (Tokens.COLON (yypos, yypos + size yytext)); | |
121 | <INITIAL> ";" => (Tokens.SEMI (yypos, yypos + size yytext)); | |
a22c187b AC |
122 | <INITIAL> "^" => (Tokens.CARET (yypos, yypos + size yytext)); |
123 | <INITIAL> "!" => (Tokens.BANG (yypos, yypos + size yytext)); | |
124 | <INITIAL> "&" => (Tokens.AND (yypos, yypos + size yytext)); | |
42198578 AC |
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)); | |
234b917a | 129 | <INITIAL> "with" => (Tokens.WITH (yypos, yypos + size yytext)); |
1a4e5a6c | 130 | <INITIAL> "where" => (Tokens.WHERE (yypos, yypos + size yytext)); |
234b917a AC |
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)); | |
095de39e | 135 | <INITIAL> "context" => (Tokens.CONTEXT (yypos, yypos + size yytext)); |
42198578 | 136 | |
a22c187b AC |
137 | <INITIAL> "Root" => (Tokens.ROOT (yypos, yypos + size yytext)); |
138 | ||
42198578 AC |
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 ()); |