Mercurial > urweb

comparison src/lacweb.lex @ 91:4327abd52997

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Basic XML stuff
author Adam Chlipala <adamc@hcoop.net>
date Thu, 03 Jul 2008 16:26:28 -0400
parents 7bab29834cd6
children f0f59e918cac
comparison
equal deleted inserted replaced
90:94ef20a31550 91:4327abd52997
78 else 78 else
79 ErrorMsg.newline (pos yypos) 79 ErrorMsg.newline (pos yypos)
80 80
81 end 81 end
82 82
83 val xmlTag = ref ([] : string list)
84 val xmlString = ref true
85 val braceLevels = ref ([] : ((unit -> unit) * int) list)
86
87 fun pushLevel s = braceLevels := (s, 1) :: (!braceLevels)
88
89 fun enterBrace () =
90 case !braceLevels of
91 (s, i) :: rest => braceLevels := (s, i+1) :: rest
92 | _ => ()
93
94 fun exitBrace () =
95 case !braceLevels of
96 (s, i) :: rest =>
97 if i = 1 then
98 (braceLevels := rest;
99 s ())
100 else
101 braceLevels := (s, i-1) :: rest
102 | _ => ()
103
104 fun initialize () = (xmlTag := [];
105 xmlString := false)
106
83 107
84 %% 108 %%
85 %header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS)); 109 %header (functor LacwebLexFn(structure Tokens : Lacweb_TOKENS));
86 %full 110 %full
87 %s COMMENT STRING; 111 %s COMMENT STRING XML XMLTAG;
88 112
89 id = [a-z_][A-Za-z0-9_']*; 113 id = [a-z_][A-Za-z0-9_']*;
90 cid = [A-Z][A-Za-z0-9_']*; 114 cid = [A-Z][A-Za-z0-9_']*;
91 ws = [\ \t\012]; 115 ws = [\ \t\012];
92 intconst = [0-9]+; 116 intconst = [0-9]+;
93 realconst = [0-9]+\.[0-9]*; 117 realconst = [0-9]+\.[0-9]*;
118 notags = [^<{\n]+;
94 119
95 %% 120 %%
96 121
97 <INITIAL> \n => (newline yypos; 122 <INITIAL> \n => (newline yypos;
98 continue ()); 123 continue ());
99 <COMMENT> \n => (newline yypos; 124 <COMMENT> \n => (newline yypos;
100 continue ()); 125 continue ());
126 <XMLTAG> \n => (newline yypos;
127 continue ());
128 <XML> \n => (newline yypos;
129 Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
101 130
102 <INITIAL> {ws}+ => (lex ()); 131 <INITIAL> {ws}+ => (lex ());
103 132
104 <INITIAL> "(*" => (YYBEGIN COMMENT; 133 <INITIAL> "(*" => (YYBEGIN COMMENT;
105 enterComment (pos yypos); 134 enterComment (pos yypos);
117 <STRING> "\"" => (YYBEGIN INITIAL; 146 <STRING> "\"" => (YYBEGIN INITIAL;
118 Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1)); 147 Tokens.STRING (String.implode (List.rev (!str)), !strStart, pos yypos + 1));
119 <STRING> "\n" => (newline yypos; 148 <STRING> "\n" => (newline yypos;
120 str := #"\n" :: !str; continue()); 149 str := #"\n" :: !str; continue());
121 <STRING> . => (str := String.sub (yytext, 0) :: !str; continue()); 150 <STRING> . => (str := String.sub (yytext, 0) :: !str; continue());
151
152 <INITIAL> "<" {id} ">"=> (let
153 val tag = String.substring (yytext, 1, size yytext - 2)
154 in
155 YYBEGIN XML;
156 xmlTag := tag :: (!xmlTag);
157 Tokens.XML_BEGIN (tag, yypos, yypos + size yytext)
158 end);
159 <XML> "</" {id} ">" => (let
160 val id = String.substring (yytext, 2, size yytext - 3)
161 in
162 case !xmlTag of
163 id' :: rest =>
164 if id = id' then
165 (YYBEGIN INITIAL;
166 xmlTag := rest;
167 Tokens.XML_END (yypos, yypos + size yytext))
168 else
169 Tokens.END_TAG (id, yypos, yypos + size yytext)
170 | _ =>
171 Tokens.END_TAG (id, yypos, yypos + size yytext)
172 end);
173
174 <XML> "<" {id} => (YYBEGIN XMLTAG;
175 Tokens.BEGIN_TAG (String.extract (yytext, 1, NONE),
176 yypos, yypos + size yytext));
177
178 <XMLTAG> "/" => (Tokens.DIVIDE (yypos, yypos + size yytext));
179 <XMLTAG> ">" => (YYBEGIN XML;
180 Tokens.GT (yypos, yypos + size yytext));
181
182 <XMLTAG> {ws}+ => (lex ());
183
184 <XMLTAG> {id} => (Tokens.SYMBOL (yytext, yypos, yypos + size yytext));
185 <XMLTAG> "=" => (Tokens.EQ (yypos, yypos + size yytext));
186
187 <XMLTAG> {intconst} => (case Int64.fromString yytext of
188 SOME x => Tokens.INT (x, yypos, yypos + size yytext)
189 | NONE => (ErrorMsg.errorAt' (yypos, yypos)
190 ("Expected int, received: " ^ yytext);
191 continue ()));
192 <XMLTAG> {realconst} => (case Real.fromString yytext of
193 SOME x => Tokens.FLOAT (x, yypos, yypos + size yytext)
194 | NONE => (ErrorMsg.errorAt' (yypos, yypos)
195 ("Expected float, received: " ^ yytext);
196 continue ()));
197 <XMLTAG> "\"" => (YYBEGIN STRING;
198 xmlString := true;
199 strStart := yypos; str := []; continue());
200
201 <XMLTAG> "{" => (YYBEGIN INITIAL;
202 pushLevel (fn () => YYBEGIN XMLTAG);
203 Tokens.LBRACE (yypos, yypos + 1));
204 <XMLTAG> "(" => (YYBEGIN INITIAL;
205 pushLevel (fn () => YYBEGIN XMLTAG);
206 Tokens.LPAREN (yypos, yypos + 1));
207
208 <XMLTAG> . => (ErrorMsg.errorAt' (yypos, yypos)
209 ("illegal XML tag character: \"" ^ yytext ^ "\"");
210 continue ());
211
212 <XML> "{" => (YYBEGIN INITIAL;
213 pushLevel (fn () => YYBEGIN XML);
214 Tokens.LBRACE (yypos, yypos + 1));
215
216 <XML> {notags} => (Tokens.NOTAGS (yytext, yypos, yypos + size yytext));
217
218 <XML> . => (ErrorMsg.errorAt' (yypos, yypos)
219 ("illegal XML character: \"" ^ yytext ^ "\"");
220 continue ());
122 221
123 <INITIAL> "()" => (Tokens.UNIT (pos yypos, pos yypos + size yytext)); 222 <INITIAL> "()" => (Tokens.UNIT (pos yypos, pos yypos + size yytext));
124 <INITIAL> "(" => (Tokens.LPAREN (pos yypos, pos yypos + size yytext)); 223 <INITIAL> "(" => (Tokens.LPAREN (pos yypos, pos yypos + size yytext));
125 <INITIAL> ")" => (Tokens.RPAREN (pos yypos, pos yypos + size yytext)); 224 <INITIAL> ")" => (Tokens.RPAREN (pos yypos, pos yypos + size yytext));
126 <INITIAL> "[" => (Tokens.LBRACK (pos yypos, pos yypos + size yytext)); 225 <INITIAL> "[" => (Tokens.LBRACK (pos yypos, pos yypos + size yytext));