Home My Page Projects Code Snippets Project Openings SML/NJ
Summary Activity Forums Tracker Lists Tasks Docs Surveys News SCM Files

SCM Repository

[smlnj] Annotation of /sml/trunk/src/compiler/Parse/lex/ml.lex
ViewVC logotype

Annotation of /sml/trunk/src/compiler/Parse/lex/ml.lex

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1140 - (view) (download)

1 : monnier 245 (* ml.lex
2 :     *
3 :     * Copyright 1989 by AT&T Bell Laboratories
4 :     *)
5 :    
6 :     open ErrorMsg;
7 :    
8 :     structure TokTable = TokenTable(Tokens);
9 :     type svalue = Tokens.svalue
10 :     type pos = int
11 :     type lexresult = (svalue,pos) Tokens.token
12 :     type lexarg = {
13 :     comLevel : int ref,
14 :     sourceMap : SourceMap.sourcemap,
15 :     charlist : string list ref,
16 :     stringtype : bool ref,
17 :     stringstart : int ref, (* start of current string or comment*)
18 :     brack_stack : int ref list ref, (* for frags *)
19 :     err : pos*pos -> ErrorMsg.complainer
20 :     }
21 :     type arg = lexarg
22 :     type ('a,'b) token = ('a,'b) Tokens.token
23 :     fun eof ({comLevel,err,charlist,stringstart,sourceMap, ...} : lexarg) = let
24 :     val pos = Int.max(!stringstart+2, SourceMap.lastChange sourceMap)
25 :     in
26 :     if !comLevel>0
27 :     then err (!stringstart,pos) COMPLAIN "unclosed comment" nullErrorBody
28 :     else if !charlist <> []
29 :     then err (!stringstart,pos) COMPLAIN
30 :     "unclosed string, character, or quotation" nullErrorBody
31 :    
32 :     else ();
33 :     Tokens.EOF(pos,pos)
34 :     end
35 :     fun addString (charlist,s:string) = charlist := s :: (!charlist)
36 :     fun addChar (charlist, c:char) = addString(charlist, String.str c)
37 :     fun makeString charlist = (concat(rev(!charlist)) before charlist := nil)
38 :    
39 :     local
40 :     fun cvt radix (s, i) =
41 :     #1(valOf(IntInf.scan radix Substring.getc (Substring.triml i (Substring.all s))))
42 :     in
43 :     val atoi = cvt StringCvt.DEC
44 :     val xtoi = cvt StringCvt.HEX
45 :     end (* local *)
46 :    
47 :     fun mysynch (src, pos, parts) =
48 :     let fun digit d = Char.ord d - Char.ord #"0"
49 :     fun cvt digits = foldl (fn(d, n) => 10*n + digit d) 0 (explode digits)
50 :     val r = SourceMap.resynch src
51 :     in case parts
52 :     of [col, line] =>
53 :     r (pos, {fileName=NONE, line=cvt line, column=SOME(cvt col)})
54 :     | [file, col, line] =>
55 :     r (pos, {fileName=SOME file, line=cvt line, column=SOME(cvt col)})
56 :     | _ => impossible "text in (*#line...*)"
57 :     end
58 :    
59 :     fun has_quote s = let
60 :     fun loop i = ((String.sub(s,i) = #"`") orelse loop (i+1))
61 :     handle _ => false
62 :     in
63 :     loop 0
64 :     end
65 :    
66 :     fun inc (ri as ref i) = (ri := i+1)
67 :     fun dec (ri as ref i) = (ri := i-1)
68 :     %%
69 :     %reject
70 :     %s A S F Q AQ L LL LLC LLCQ;
71 :     %header (functor MLLexFun(structure Tokens : ML_TOKENS));
72 :     %arg ({
73 :     comLevel,
74 :     sourceMap,
75 :     err,
76 :     charlist,
77 :     stringstart,
78 :     stringtype,
79 :     brack_stack});
80 :     idchars=[A-Za-z'_0-9];
81 :     id=[A-Za-z]{idchars}*;
82 :     ws=("\012"|[\t\ ])*;
83 :     nrws=("\012"|[\t\ ])+;
84 :     eol=("\013\010"|"\010"|"\013");
85 :     some_sym=[!%&$+/:<=>?@~|#*]|\-|\^;
86 :     sym={some_sym}|"\\";
87 :     quote="`";
88 :     full_sym={sym}|{quote};
89 :     num=[0-9]+;
90 :     frac="."{num};
91 :     exp=[eE](~?){num};
92 :     real=(~?)(({num}{frac}?{exp})|({num}{frac}{exp}?));
93 :     hexnum=[0-9a-fA-F]+;
94 :     %%
95 :     <INITIAL>{ws} => (continue());
96 :     <INITIAL>{eol} => (SourceMap.newline sourceMap yypos; continue());
97 : blume 1140 <INITIAL>"_overload" => (if !ParserControl.overloadKW then
98 :     Tokens.OVERLOAD(yypos,yypos+1)
99 :     else REJECT());
100 : monnier 245 <INITIAL>"_" => (Tokens.WILD(yypos,yypos+1));
101 :     <INITIAL>"," => (Tokens.COMMA(yypos,yypos+1));
102 :     <INITIAL>"{" => (Tokens.LBRACE(yypos,yypos+1));
103 :     <INITIAL>"}" => (Tokens.RBRACE(yypos,yypos+1));
104 :     <INITIAL>"[" => (Tokens.LBRACKET(yypos,yypos+1));
105 :     <INITIAL>"#[" => (Tokens.VECTORSTART(yypos,yypos+1));
106 :     <INITIAL>"]" => (Tokens.RBRACKET(yypos,yypos+1));
107 :     <INITIAL>";" => (Tokens.SEMICOLON(yypos,yypos+1));
108 :     <INITIAL>"(" => (if (null(!brack_stack))
109 :     then ()
110 :     else inc (hd (!brack_stack));
111 :     Tokens.LPAREN(yypos,yypos+1));
112 :     <INITIAL>")" => (if (null(!brack_stack))
113 :     then ()
114 :     else if (!(hd (!brack_stack)) = 1)
115 :     then ( brack_stack := tl (!brack_stack);
116 :     charlist := [];
117 :     YYBEGIN Q)
118 :     else dec (hd (!brack_stack));
119 :     Tokens.RPAREN(yypos,yypos+1));
120 :     <INITIAL>"." => (Tokens.DOT(yypos,yypos+1));
121 :     <INITIAL>"..." => (Tokens.DOTDOTDOT(yypos,yypos+3));
122 :     <INITIAL>"'"("'"?)("_"|{num})?{id}
123 :     => (TokTable.checkTyvar(yytext,yypos));
124 :     <INITIAL>{id} => (TokTable.checkId(yytext, yypos));
125 : blume 902 <INITIAL>{full_sym}+ => (if !ParserControl.quotation
126 : monnier 245 then if (has_quote yytext)
127 :     then REJECT()
128 :     else TokTable.checkSymId(yytext,yypos)
129 :     else TokTable.checkSymId(yytext,yypos));
130 :     <INITIAL>{sym}+ => (TokTable.checkSymId(yytext,yypos));
131 : blume 902 <INITIAL>{quote} => (if !ParserControl.quotation
132 : monnier 245 then (YYBEGIN Q;
133 :     charlist := [];
134 :     Tokens.BEGINQ(yypos,yypos+1))
135 :     else (err(yypos, yypos+1)
136 :     COMPLAIN "quotation implementation error"
137 :     nullErrorBody;
138 :     Tokens.BEGINQ(yypos,yypos+1)));
139 :     <INITIAL>{real} => (Tokens.REAL(yytext,yypos,yypos+size yytext));
140 :     <INITIAL>[1-9][0-9]* => (Tokens.INT(atoi(yytext, 0),yypos,yypos+size yytext));
141 :     <INITIAL>{num} => (Tokens.INT0(atoi(yytext, 0),yypos,yypos+size yytext));
142 :     <INITIAL>~{num} => (Tokens.INT0(atoi(yytext, 0),yypos,yypos+size yytext));
143 :     <INITIAL>"0x"{hexnum} => (Tokens.INT0(xtoi(yytext, 2),yypos,yypos+size yytext));
144 :     <INITIAL>"~0x"{hexnum} => (Tokens.INT0(IntInf.~(xtoi(yytext, 3)),yypos,yypos+size yytext));
145 :     <INITIAL>"0w"{num} => (Tokens.WORD(atoi(yytext, 2),yypos,yypos+size yytext));
146 :     <INITIAL>"0wx"{hexnum} => (Tokens.WORD(xtoi(yytext, 3),yypos,yypos+size yytext));
147 :     <INITIAL>\" => (charlist := [""]; stringstart := yypos;
148 :     stringtype := true; YYBEGIN S; continue());
149 :     <INITIAL>\#\" => (charlist := [""]; stringstart := yypos;
150 :     stringtype := false; YYBEGIN S; continue());
151 :     <INITIAL>"(*#line"{nrws} =>
152 :     (YYBEGIN L; stringstart := yypos; comLevel := 1; continue());
153 :     <INITIAL>"(*" => (YYBEGIN A; stringstart := yypos; comLevel := 1; continue());
154 :     <INITIAL>"*)" => (err (yypos,yypos+1) COMPLAIN "unmatched close comment"
155 :     nullErrorBody;
156 :     continue());
157 :     <INITIAL>\h => (err (yypos,yypos) COMPLAIN "non-Ascii character"
158 :     nullErrorBody;
159 :     continue());
160 :     <INITIAL>. => (err (yypos,yypos) COMPLAIN "illegal token" nullErrorBody;
161 :     continue());
162 :     <L>[0-9]+ => (YYBEGIN LL; charlist := [yytext]; continue());
163 :     <LL>\. => ((* cheat: take n > 0 dots *) continue());
164 :     <LL>[0-9]+ => (YYBEGIN LLC; addString(charlist, yytext); continue());
165 :     <LL>0* => (YYBEGIN LLC; addString(charlist, "1"); continue()
166 :     (* note hack, since ml-lex chokes on the empty string for 0* *));
167 :     <LLC>"*)" => (YYBEGIN INITIAL; mysynch(sourceMap, yypos+2, !charlist);
168 :     comLevel := 0; charlist := []; continue());
169 :     <LLC>{ws}\" => (YYBEGIN LLCQ; continue());
170 :     <LLCQ>[^\"]* => (addString(charlist, yytext); continue());
171 :     <LLCQ>\""*)" => (YYBEGIN INITIAL; mysynch(sourceMap, yypos+3, !charlist);
172 :     comLevel := 0; charlist := []; continue());
173 :     <L,LLC,LLCQ>"*)" => (err (!stringstart, yypos+1) WARN
174 :     "ill-formed (*#line...*) taken as comment" nullErrorBody;
175 :     YYBEGIN INITIAL; comLevel := 0; charlist := []; continue());
176 :     <L,LLC,LLCQ>. => (err (!stringstart, yypos+1) WARN
177 :     "ill-formed (*#line...*) taken as comment" nullErrorBody;
178 :     YYBEGIN A; continue());
179 :     <A>"(*" => (inc comLevel; continue());
180 :     <A>{eol} => (SourceMap.newline sourceMap yypos; continue());
181 :     <A>"*)" => (dec comLevel; if !comLevel=0 then YYBEGIN INITIAL else (); continue());
182 :     <A>. => (continue());
183 :     <S>\" => (let val s = makeString charlist
184 :     val s = if size s <> 1 andalso not(!stringtype)
185 :     then (err(!stringstart,yypos) COMPLAIN
186 :     "character constant not length 1"
187 :     nullErrorBody;
188 :     substring(s^"x",0,1))
189 :     else s
190 :     val t = (s,!stringstart,yypos+1)
191 :     in YYBEGIN INITIAL;
192 :     if !stringtype then Tokens.STRING t else Tokens.CHAR t
193 :     end);
194 :     <S>{eol} => (err (!stringstart,yypos) COMPLAIN "unclosed string"
195 :     nullErrorBody;
196 :     SourceMap.newline sourceMap yypos;
197 :     YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos));
198 :     <S>\\{eol} => (SourceMap.newline sourceMap (yypos+1);
199 :     YYBEGIN F; continue());
200 :     <S>\\{ws} => (YYBEGIN F; continue());
201 :     <S>\\a => (addString(charlist, "\007"); continue());
202 :     <S>\\b => (addString(charlist, "\008"); continue());
203 :     <S>\\f => (addString(charlist, "\012"); continue());
204 :     <S>\\n => (addString(charlist, "\010"); continue());
205 :     <S>\\r => (addString(charlist, "\013"); continue());
206 :     <S>\\t => (addString(charlist, "\009"); continue());
207 :     <S>\\v => (addString(charlist, "\011"); continue());
208 :     <S>\\\\ => (addString(charlist, "\\"); continue());
209 :     <S>\\\" => (addString(charlist, "\""); continue());
210 :     <S>\\\^[@-_] => (addChar(charlist,
211 :     Char.chr(Char.ord(String.sub(yytext,2))-Char.ord #"@"));
212 :     continue());
213 :     <S>\\\^. =>
214 :     (err(yypos,yypos+2) COMPLAIN "illegal control escape; must be one of \
215 :     \@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_" nullErrorBody;
216 :     continue());
217 :     <S>\\[0-9]{3} =>
218 :     (let val x = Char.ord(String.sub(yytext,1))*100
219 :     +Char.ord(String.sub(yytext,2))*10
220 :     +Char.ord(String.sub(yytext,3))
221 :     -((Char.ord #"0")*111)
222 :     in (if x>255
223 :     then err (yypos,yypos+4) COMPLAIN "illegal ascii escape" nullErrorBody
224 :     else addChar(charlist, Char.chr x);
225 :     continue())
226 :     end);
227 :     <S>\\ => (err (yypos,yypos+1) COMPLAIN "illegal string escape"
228 :     nullErrorBody;
229 :     continue());
230 :    
231 :    
232 :     <S>[\000-\031] => (err (yypos,yypos+1) COMPLAIN "illegal non-printing character in string" nullErrorBody;
233 :     continue());
234 :     <S>({idchars}|{some_sym}|\[|\]|\(|\)|{quote}|[,.;^{}])+|. => (addString(charlist,yytext); continue());
235 :     <F>{eol} => (SourceMap.newline sourceMap yypos; continue());
236 :     <F>{ws} => (continue());
237 :     <F>\\ => (YYBEGIN S; stringstart := yypos; continue());
238 :     <F>. => (err (!stringstart,yypos) COMPLAIN "unclosed string"
239 :     nullErrorBody;
240 :     YYBEGIN INITIAL; Tokens.STRING(makeString charlist,!stringstart,yypos+1));
241 :     <Q>"^`" => (addString(charlist, "`"); continue());
242 :     <Q>"^^" => (addString(charlist, "^"); continue());
243 :     <Q>"^" => (YYBEGIN AQ;
244 :     let val x = makeString charlist
245 :     in
246 :     Tokens.OBJL(x,yypos,yypos+(size x))
247 :     end);
248 :     <Q>"`" => ((* a closing quote *)
249 :     YYBEGIN INITIAL;
250 :     let val x = makeString charlist
251 :     in
252 :     Tokens.ENDQ(x,yypos,yypos+(size x))
253 :     end);
254 :     <Q>{eol} => (SourceMap.newline sourceMap yypos; addString(charlist,"\n"); continue());
255 :     <Q>. => (addString(charlist,yytext); continue());
256 :    
257 :     <AQ>{eol} => (SourceMap.newline sourceMap yypos; continue());
258 :     <AQ>{ws} => (continue());
259 :     <AQ>{id} => (YYBEGIN Q;
260 : monnier 411 let val hash = HashString.hashString yytext
261 : monnier 245 in
262 :     Tokens.AQID(FastSymbol.rawSymbol(hash,yytext),
263 :     yypos,yypos+(size yytext))
264 :     end);
265 :     <AQ>{sym}+ => (YYBEGIN Q;
266 : monnier 411 let val hash = HashString.hashString yytext
267 : monnier 245 in
268 :     Tokens.AQID(FastSymbol.rawSymbol(hash,yytext),
269 :     yypos,yypos+(size yytext))
270 :     end);
271 :     <AQ>"(" => (YYBEGIN INITIAL;
272 :     brack_stack := ((ref 1)::(!brack_stack));
273 :     Tokens.LPAREN(yypos,yypos+1));
274 :     <AQ>. => (err (yypos,yypos+1) COMPLAIN
275 :     ("ml lexer: bad character after antiquote "^yytext)
276 :     nullErrorBody;
277 : monnier 411 Tokens.AQID(FastSymbol.rawSymbol(0w0,""),yypos,yypos));

root@smlnj-gforge.cs.uchicago.edu
ViewVC Help
Powered by ViewVC 1.0.0