HCoop / hcoop / debian / mlton.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Import Upstream version 20180207
[hcoop/debian/mlton.git] / mlton / front-end / ml.lex
CommitLineData
7f918cf1
CE		 1(* Heavily modified from SML/NJ sources. *)
2
3(* ml.lex
4 *
5 * Copyright 1989 by AT&T Bell Laboratories
6 *
7 * SML/NJ is released under a BSD-style license.
8 * See the file NJ-LICENSE for details.
9 *)
10
11(* Copyright (C) 2009,2016-2017 Matthew Fluet.
12 * Copyright (C) 1999-2006 Henry Cejtin, Matthew Fluet, Suresh
13 * Jagannathan, and Stephen Weeks.
14 * Copyright (C) 1997-2000 NEC Research Institute.
15 *
16 * MLton is released under a BSD-style license.
17 * See the file MLton-LICENSE for details.
18 *)
19
20type svalue = Tokens.svalue
21type pos = SourcePos.t
22type lexresult = (svalue, pos) Tokens.token
23type lexarg = {source: Source.t}
24type arg = lexarg
25type ('a,'b) token = ('a,'b) Tokens.token
26
27local
28 open Control.Elaborate
29in
30 val allowLineComments = fn () => current allowLineComments
31 val allowExtendedNumConsts = fn () => current allowExtendedNumConsts
32 val allowExtendedTextConsts = fn () => current allowExtendedTextConsts
33end
34
35fun lastPos (yypos, yytext) = yypos + size yytext - 1
36
37fun tok (t, x, s, l) =
38 let
39 val left = Source.getPos (s, l)
40 val right = Source.getPos (s, lastPos (l, x))
41 in
42 t (left, right)
43 end
44
45fun tok' (t, x, s, l) = tok (fn (l, r) => t (x, l, r), x, s, l)
46
47fun error' (left, right, msg) =
48 Control.errorStr (Region.make {left = left, right = right}, msg)
49fun error (source, left, right, msg) =
50 error' (Source.getPos (source, left), Source.getPos (source, right), msg)
51
52
53(* Comments *)
54local
55 val commentErrors: string list ref = ref []
56 val commentLeft = ref SourcePos.bogus
57 val commentStack: (int -> unit) list ref = ref []
58in
59 fun addCommentError msg =
60 List.push (commentErrors, msg)
61 val inComment = fn () => not (List.isEmpty (!commentStack))
62 fun startComment (source, yypos, th) =
63 if inComment ()
64 then List.push (commentStack, fn _ => th ())
65 else (commentErrors := []
66 ; commentLeft := Source.getPos (source, yypos)
67 ; List.push (commentStack, fn yypos =>
68 (List.foreach (!commentErrors, fn msg =>
69 error' (!commentLeft,
70 Source.getPos (source, yypos),
71 msg))
72 ; th ())))
73 fun finishComment yypos =
74 (List.pop commentStack) yypos
75end
76
77
78(* Line Directives *)
79local
80 val lineDirCol: int ref = ref ~1
81 val lineDirFile: File.t option ref = ref NONE
82 val lineDirLine: int ref = ref ~1
83in
84 fun startLineDir (source, yypos, th) =
85 let
86 val _ = lineDirCol := ~1
87 val _ = lineDirFile := NONE
88 val _ = lineDirLine := ~1
89 in
90 startComment (source, yypos, th)
91 end
92 fun addLineDirLineCol (line, col) =
93 let
94 val _ = lineDirLine := line
95 val _ = lineDirCol := col
96 in
97 ()
98 end
99 fun addLineDirFile file =
100 let
101 val _ = lineDirFile := SOME file
102 in
103 ()
104 end
105 fun finishLineDir (source, yypos) =
106 let
107 val col = !lineDirCol
108 val file = !lineDirFile
109 val line = !lineDirLine
110 val _ = lineDirCol := ~1
111 val _ = lineDirFile := NONE
112 val _ = lineDirLine := ~1
113 in
114 finishComment yypos
115 ; Source.lineDirective (source, file,
116 {lineNum = line,
117 lineStart = yypos + 1 - col})
118 end
119end
120
121
122(* Numeric Constants *)
123local
124fun doit (source, yypos, yytext, drop, {extended: string option}, mkTok) =
125 let
126 val left = yypos
127 val right = lastPos (yypos, yytext)
128 val extended =
129 if String.contains (yytext, #"_")
130 then SOME (Option.fold
131 (extended, "'_' separators", fn (msg1, msg2) =>
132 msg1 ^ " and " ^ msg2))
133 else extended
134 val _ =
135 case extended of
136 NONE => ()
137 | SOME msg =>
138 if allowExtendedNumConsts ()
139 then ()
140 else error (source, left, right,
141 concat ["Extended numeric constants (using ", msg,
142 ") disallowed, compile with -default-ann 'allowExtendedNumConsts true'"])
143 in
144 mkTok (String.keepAll (String.dropPrefix (yytext, drop), fn c => not (c = #"_")),
145 {extended = Option.isSome extended},
146 Source.getPos (source, left), Source.getPos (source, right))
147 end
148in
149fun real (source, yypos, yytext) =
150 doit (source, yypos, yytext, 0, {extended = NONE}, fn (digits, {extended: bool}, l, r) =>
151 Tokens.REAL (digits, l, r))
152fun int (source, yypos, yytext, drop, {extended: string option}, {negate: bool}, radix) =
153 doit (source, yypos, yytext, drop, {extended = extended}, fn (digits, {extended: bool}, l, r) =>
154 Tokens.INT ({digits = digits,
155 extended = extended,
156 negate = negate,
157 radix = radix},
158 l, r))
159fun word (source, yypos, yytext, drop, {extended: string option}, radix) =
160 doit (source, yypos, yytext, drop, {extended = extended}, fn (digits, {extended: bool}, l, r) =>
161 Tokens.WORD ({digits = digits,
162 radix = radix},
163 l, r))
164end
165
166
167(* Text Constants *)
168local
169 val chars: IntInf.t list ref = ref []
170 val inText = ref false
171 val textLeft = ref SourcePos.bogus
172 val textFinishFn: (IntInf.t vector * SourcePos.t * SourcePos.t -> lexresult) ref = ref (fn _ => raise Fail "textFinish")
173in
174 fun startText (tl, tf) =
175 let
176 val _ = chars := []
177 val _ = inText := true
178 val _ = textLeft := tl
179 val _ = textFinishFn := tf
180 in
181 ()
182 end
183 fun finishText textRight =
184 let
185 val cs = Vector.fromListRev (!chars)
186 val tl = !textLeft
187 val tr = textRight
188 val tf = !textFinishFn
189 val _ = chars := []
190 val _ = inText := false
191 val _ = textLeft := SourcePos.bogus
192 val _ = textFinishFn := (fn _ => raise Fail "textFinish")
193 in
194 tf (cs, tl, tr)
195 end
196 val inText = fn () => !inText
197 fun addTextString (s: string) =
198 chars := String.fold (s, !chars, fn (c, ac) => Int.toIntInf (Char.ord c) :: ac)
199 fun addTextCharCode (i: IntInf.int) = List.push (chars, i)
200end
201fun addTextChar (c: char) = addTextString (String.fromChar c)
202fun addTextNumEsc (source, yypos, yytext, drop, {extended: string option}, radix): unit =
203 let
204 val left = yypos
205 val right = lastPos (yypos, yytext)
206 val _ =
207 case extended of
208 NONE => ()
209 | SOME msg =>
210 if allowExtendedTextConsts ()
211 then ()
212 else error (source, left, right,
213 concat ["Extended text constants (using ", msg,
214 ") disallowed, compile with -default-ann 'allowExtendedTextConsts true'"])
215 in
216 case StringCvt.scanString (fn r => IntInf.scan (radix, r)) (String.dropPrefix (yytext, drop)) of
217 NONE => error (source, left, right, "Illegal numeric escape in text constant")
218 | SOME i => addTextCharCode i
219 end
220fun addTextUTF8 (source, yypos, yytext): unit =
221 let
222 val left = yypos
223 val right = lastPos (yypos, yytext)
224 in
225 if not (allowExtendedTextConsts ())
226 then error (source, left, right,
227 "Extended text constants (using UTF-8 byte sequences) disallowed, compile with -default-ann 'allowExtendedTextConsts true'")
228 else addTextString yytext
229 end
230
231
232(* EOF *)
233val eof: lexarg -> lexresult =
234 fn {source, ...} =>
235 let
236 val _ = Source.newline (source, ~1)
237 val pos = Source.getPos (source, ~1)
238 val _ =
239 if inComment ()
240 then error' (pos, SourcePos.bogus, "Unclosed comment at end of file")
241 else ()
242 val _ =
243 if inText ()
244 then error' (pos, SourcePos.bogus, "Unclosed text constant at end of file")
245 else ()
246 in
247 Tokens.EOF (pos, SourcePos.bogus)
248 end
249
250
251%%
252%full
253
254%s TEXT TEXT_FMT BLOCK_COMMENT LINE_COMMENT LINE_DIR1 LINE_DIR2 LINE_DIR3 LINE_DIR4;
255
256%header (functor MLLexFun (structure Tokens : ML_TOKENS));
257%arg ({source});
258
259ws=\t|"\011"|"\012"|" ";
260cr="\013";
261nl="\010";
262eol=({cr}{nl}|{nl}|{cr});
263
264alphanum=[A-Za-z0-9'_];
265alphanumId=[A-Za-z]{alphanum}*;
266sym="!"|"%"|"&"|"$"|"#"|"+"|"-"|"/"|":"|"<"|"="|">"|"?"|"@"|"\\"|"~"|"`"|"^"|"|"|"*";
267symId={sym}+;
268
269tyvarId="'"{alphanum}*;
270longSymId=({alphanumId}".")+{symId};
271longAlphanumId=({alphanumId}".")+{alphanumId};
272
273decDigit=[0-9];
274decnum={decDigit}("_"*{decDigit})*;
275hexDigit=[0-9a-fA-F];
276hexnum={hexDigit}("_"*{hexDigit})*;
277binDigit=[0-1];
278binnum={binDigit}("_"*{binDigit})*;
279frac="."{decnum};
280exp=[eE](~?){decnum};
281real=(~?)(({decnum}{frac}?{exp})|({decnum}{frac}{exp}?));
282
283%%
284<INITIAL>{ws}+ => (continue ());
285<INITIAL>{eol} => (Source.newline (source, lastPos (yypos, yytext)); continue ());
286
287
288<INITIAL>"_address" => (tok (Tokens.ADDRESS, yytext, source, yypos));
289<INITIAL>"_build_const" => (tok (Tokens.BUILD_CONST, yytext, source, yypos));
290<INITIAL>"_command_line_const" => (tok (Tokens.COMMAND_LINE_CONST, yytext, source, yypos));
291<INITIAL>"_const" => (tok (Tokens.CONST, yytext, source, yypos));
292<INITIAL>"_export" => (tok (Tokens.EXPORT, yytext, source, yypos));
293<INITIAL>"_import" => (tok (Tokens.IMPORT, yytext, source, yypos));
294<INITIAL>"_overload" => (tok (Tokens.OVERLOAD, yytext, source, yypos));
295<INITIAL>"_prim" => (tok (Tokens.PRIM, yytext, source, yypos));
296<INITIAL>"_symbol" => (tok (Tokens.SYMBOL, yytext, source, yypos));
297
298<INITIAL>"#" => (tok (Tokens.HASH, yytext, source, yypos));
299<INITIAL>"#[" => (tok (Tokens.HASHLBRACKET, yytext, source, yypos));
300<INITIAL>"(" => (tok (Tokens.LPAREN, yytext, source, yypos));
301<INITIAL>")" => (tok (Tokens.RPAREN, yytext, source, yypos));
302<INITIAL>"," => (tok (Tokens.COMMA, yytext, source, yypos));
303<INITIAL>"->" => (tok (Tokens.ARROW, yytext, source, yypos));
304<INITIAL>"..." => (tok (Tokens.DOTDOTDOT, yytext, source, yypos));
305<INITIAL>":" => (tok (Tokens.COLON, yytext, source, yypos));
306<INITIAL>":>" => (tok (Tokens.COLONGT, yytext, source, yypos));
307<INITIAL>";" => (tok (Tokens.SEMICOLON, yytext, source, yypos));
308<INITIAL>"=" => (tok (Tokens.EQUALOP, yytext, source, yypos));
309<INITIAL>"=>" => (tok (Tokens.DARROW, yytext, source, yypos));
310<INITIAL>"[" => (tok (Tokens.LBRACKET, yytext, source, yypos));
311<INITIAL>"]" => (tok (Tokens.RBRACKET, yytext, source, yypos));
312<INITIAL>"_" => (tok (Tokens.WILD, yytext, source, yypos));
313<INITIAL>"{" => (tok (Tokens.LBRACE, yytext, source, yypos));
314<INITIAL>"|" => (tok (Tokens.BAR, yytext, source, yypos));
315<INITIAL>"}" => (tok (Tokens.RBRACE, yytext, source, yypos));
316
317<INITIAL>"abstype" => (tok (Tokens.ABSTYPE, yytext, source, yypos));
318<INITIAL>"and" => (tok (Tokens.AND, yytext, source, yypos));
319<INITIAL>"andalso" => (tok (Tokens.ANDALSO, yytext, source, yypos));
320<INITIAL>"as" => (tok (Tokens.AS, yytext, source, yypos));
321<INITIAL>"case" => (tok (Tokens.CASE, yytext, source, yypos));
322<INITIAL>"datatype" => (tok (Tokens.DATATYPE, yytext, source, yypos));
323<INITIAL>"do" => (tok (Tokens.DO, yytext, source, yypos));
324<INITIAL>"else" => (tok (Tokens.ELSE, yytext, source, yypos));
325<INITIAL>"end" => (tok (Tokens.END, yytext, source, yypos));
326<INITIAL>"eqtype" => (tok (Tokens.EQTYPE, yytext, source, yypos));
327<INITIAL>"exception" => (tok (Tokens.EXCEPTION, yytext, source, yypos));
328<INITIAL>"fn" => (tok (Tokens.FN, yytext, source, yypos));
329<INITIAL>"fun" => (tok (Tokens.FUN, yytext, source, yypos));
330<INITIAL>"functor" => (tok (Tokens.FUNCTOR, yytext, source, yypos));
331<INITIAL>"handle" => (tok (Tokens.HANDLE, yytext, source, yypos));
332<INITIAL>"if" => (tok (Tokens.IF, yytext, source, yypos));
333<INITIAL>"in" => (tok (Tokens.IN, yytext, source, yypos));
334<INITIAL>"include" => (tok (Tokens.INCLUDE, yytext, source, yypos));
335<INITIAL>"infix" => (tok (Tokens.INFIX, yytext, source, yypos));
336<INITIAL>"infixr" => (tok (Tokens.INFIXR, yytext, source, yypos));
337<INITIAL>"let" => (tok (Tokens.LET, yytext, source, yypos));
338<INITIAL>"local" => (tok (Tokens.LOCAL, yytext, source, yypos));
339<INITIAL>"nonfix" => (tok (Tokens.NONFIX, yytext, source, yypos));
340<INITIAL>"of" => (tok (Tokens.OF, yytext, source, yypos));
341<INITIAL>"op" => (tok (Tokens.OP, yytext, source, yypos));
342<INITIAL>"open" => (tok (Tokens.OPEN, yytext, source, yypos));
343<INITIAL>"orelse" => (tok (Tokens.ORELSE, yytext, source, yypos));
344<INITIAL>"raise" => (tok (Tokens.RAISE, yytext, source, yypos));
345<INITIAL>"rec" => (tok (Tokens.REC, yytext, source, yypos));
346<INITIAL>"sharing" => (tok (Tokens.SHARING, yytext, source, yypos));
347<INITIAL>"sig" => (tok (Tokens.SIG, yytext, source, yypos));
348<INITIAL>"signature" => (tok (Tokens.SIGNATURE, yytext, source, yypos));
349<INITIAL>"struct" => (tok (Tokens.STRUCT, yytext, source, yypos));
350<INITIAL>"structure" => (tok (Tokens.STRUCTURE, yytext, source, yypos));
351<INITIAL>"then" => (tok (Tokens.THEN, yytext, source, yypos));
352<INITIAL>"type" => (tok (Tokens.TYPE, yytext, source, yypos));
353<INITIAL>"val" => (tok (Tokens.VAL, yytext, source, yypos));
354<INITIAL>"where" => (tok (Tokens.WHERE, yytext, source, yypos));
355<INITIAL>"while" => (tok (Tokens.WHILE, yytext, source, yypos));
356<INITIAL>"with" => (tok (Tokens.WITH, yytext, source, yypos));
357<INITIAL>"withtype" => (tok (Tokens.WITHTYPE, yytext, source, yypos));
358
359
360<INITIAL>{alphanumId} => (tok' (Tokens.SHORTALPHANUMID, yytext, source, yypos));
361<INITIAL>{symId} =>
362 (case yytext of
363 "*" => tok (Tokens.ASTERISK, yytext, source, yypos)
364 | _ => tok' (Tokens.SHORTSYMID, yytext, source, yypos));
365<INITIAL>{tyvarId} => (tok' (Tokens.TYVAR, yytext, source, yypos));
366<INITIAL>{longAlphanumId} => (tok' (Tokens.LONGALPHANUMID, yytext, source, yypos));
367<INITIAL>{longSymId} => (tok' (Tokens.LONGSYMID, yytext, source, yypos));
368
369
370<INITIAL>{real} =>
371 (real (source, yypos, yytext));
372<INITIAL>{decnum} =>
373 (int (source, yypos, yytext, 0, {extended = NONE}, {negate = false}, StringCvt.DEC));
374<INITIAL>"~"{decnum} =>
375 (int (source, yypos, yytext, 1, {extended = NONE}, {negate = true}, StringCvt.DEC));
376<INITIAL>"0x"{hexnum} =>
377 (int (source, yypos, yytext, 2, {extended = NONE}, {negate = false}, StringCvt.HEX));
378<INITIAL>"~0x"{hexnum} =>
379 (int (source, yypos, yytext, 3, {extended = NONE}, {negate = true}, StringCvt.HEX));
380<INITIAL>"0b"{binnum} =>
381 (int (source, yypos, yytext, 2, {extended = SOME "binary notation"}, {negate = false}, StringCvt.BIN));
382<INITIAL>"~0b"{binnum} =>
383 (int (source, yypos, yytext, 3, {extended = SOME "binary notation"}, {negate = true}, StringCvt.BIN));
384<INITIAL>"0w"{decnum} =>
385 (word (source, yypos, yytext, 2, {extended = NONE}, StringCvt.DEC));
386<INITIAL>"0wx"{hexnum} =>
387 (word (source, yypos, yytext, 3, {extended = NONE}, StringCvt.HEX));
388<INITIAL>"0wb"{binnum} =>
389 (word (source, yypos, yytext, 3, {extended = SOME "binary notation"}, StringCvt.BIN));
390
391<INITIAL>"\"" =>
392 (startText (Source.getPos (source, yypos), fn (cs, l, r) =>
393 (YYBEGIN INITIAL;
394 Tokens.STRING (cs, l, r)))
395 ; YYBEGIN TEXT
396 ; continue ());
397<INITIAL>"#\"" =>
398 (startText (Source.getPos (source, yypos), fn (cs, l, r) =>
399 let
400 fun err () =
401 error' (l, r, "character constant not of size 1")
402 val c =
403 case Int.compare (Vector.length cs, 1) of
404 LESS => (err (); 0)
405 | EQUAL => Vector.sub (cs, 0)
406 | GREATER => (err (); Vector.sub (cs, 0))
407 in
408 YYBEGIN INITIAL;
409 Tokens.CHAR (c, l, r)
410 end)
411 ; YYBEGIN TEXT
412 ; continue ());
413
414<TEXT>"\"" => (finishText (Source.getPos (source, lastPos (yypos, yytext))));
415<TEXT>" "|!|[\035-\091]|[\093-\126] =>
416 (addTextString yytext; continue ());
417<TEXT>[\192-\223][\128-\191] =>
418 (addTextUTF8 (source, yypos, yytext); continue());
419<TEXT>[\224-\239][\128-\191][\128-\191] =>
420 (addTextUTF8 (source, yypos, yytext); continue());
421<TEXT>[\240-\247][\128-\191][\128-\191][\128-\191] =>
422 (addTextUTF8 (source, yypos, yytext); continue());
423<TEXT>\\a => (addTextChar #"\a"; continue ());
424<TEXT>\\b => (addTextChar #"\b"; continue ());
425<TEXT>\\t => (addTextChar #"\t"; continue ());
426<TEXT>\\n => (addTextChar #"\n"; continue ());
427<TEXT>\\v => (addTextChar #"\v"; continue ());
428<TEXT>\\f => (addTextChar #"\f"; continue ());
429<TEXT>\\r => (addTextChar #"\r"; continue ());
430<TEXT>\\\^[@-_] => (addTextChar (Char.chr(Char.ord(String.sub(yytext, 2)) - Char.ord #"@"));
431 continue ());
432<TEXT>\\\^. => (error (source, yypos, yypos + 2, "Illegal control escape in text constant; must be one of @ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_");
433 continue ());
434<TEXT>\\[0-9]{3} => (addTextNumEsc (source, yypos, yytext, 1,
435 {extended = NONE}, StringCvt.DEC)
436 ; continue ());
437<TEXT>\\u{hexDigit}{4} =>
438 (addTextNumEsc (source, yypos, yytext, 2,
439 {extended = NONE}, StringCvt.HEX)
440 ; continue ());
441<TEXT>\\U{hexDigit}{8} =>
442 (addTextNumEsc (source, yypos, yytext, 2,
443 {extended = SOME "\\Uxxxxxxxx numeric escapes"},
444 StringCvt.HEX)
445 ; continue ());
446<TEXT>"\\\"" => (addTextString "\""; continue ());
447<TEXT>\\\\ => (addTextString "\\"; continue ());
448<TEXT>\\{ws}+ => (YYBEGIN TEXT_FMT; continue ());
449<TEXT>\\{eol} => (Source.newline (source, lastPos (yypos, yytext)); YYBEGIN TEXT_FMT; continue ());
450<TEXT>\\ => (error (source, yypos, yypos + 1, "Illegal escape in text constant")
451 ; continue ());
452<TEXT>{eol} => (error (source, yypos, lastPos (yypos, yytext), "Unclosed text constant at end of line")
453 ; Source.newline (source, lastPos (yypos, yytext))
454 ; continue ());
455<TEXT>. => (error (source, yypos, yypos, "Illegal character in text constant")
456 ; continue ());
457
458<TEXT_FMT>{ws}+ => (continue ());
459<TEXT_FMT>{eol} => (Source.newline (source, lastPos (yypos, yytext)); continue ());
460<TEXT_FMT>\\ => (YYBEGIN TEXT; continue ());
461<TEXT_FMT>. => (error (source, yypos, yypos, "Illegal formatting character in text continuation")
462 ; continue ());
463
464
465<INITIAL>"(*)" =>
466 (if allowLineComments ()
467 then ()
468 else error (source, yypos, lastPos (yypos, yytext),
469 "Line comments disallowed, compile with -default-ann 'allowLineComments true'")
470 ; startComment (source, yypos, fn () =>
471 YYBEGIN INITIAL)
472 ; YYBEGIN LINE_COMMENT
473 ; continue ());
474<INITIAL>"(*" =>
475 (startComment (source, yypos, fn () =>
476 YYBEGIN INITIAL)
477 ; YYBEGIN BLOCK_COMMENT
478 ; continue ());
479
480<LINE_COMMENT>{eol} =>
481 (finishComment (lastPos (yypos, yytext))
482 ; Source.newline (source, lastPos (yypos, yytext))
483 ; continue ());
484<LINE_COMMENT>. =>
485 (continue ());
486
487<BLOCK_COMMENT>"(*)" =>
488 (if allowLineComments ()
489 then ()
490 else error (source, yypos, lastPos (yypos, yytext),
491 "Line comments disallowed, compile with -default-ann 'allowLineComments true'")
492 ; startComment (source, yypos, fn () =>
493 YYBEGIN BLOCK_COMMENT)
494 ; YYBEGIN LINE_COMMENT
495 ; continue ());
496<BLOCK_COMMENT>"(*" =>
497 (startComment (source, yypos, fn () =>
498 YYBEGIN BLOCK_COMMENT)
499 ; YYBEGIN BLOCK_COMMENT
500 ; continue ());
501<BLOCK_COMMENT>"*)" =>
502 (finishComment (lastPos (yypos,yytext))
503 ; continue ());
504<BLOCK_COMMENT>{eol} =>
505 (Source.newline (source, lastPos (yypos, yytext))
506 ; continue ());
507<BLOCK_COMMENT>. =>
508 (continue ());
509
510
511<INITIAL>"(*#line"{ws}+ =>
512 (startLineDir (source, yypos, fn () =>
513 YYBEGIN INITIAL)
514 ; YYBEGIN LINE_DIR1
515 ; continue ());
516
517<LINE_DIR1>{decDigit}+"."{decDigit}+ =>
518 (let
519 fun err () =
520 (addCommentError "Illegal line directive"
521 ; YYBEGIN BLOCK_COMMENT)
522 in
523 case String.split (yytext, #".") of
524 [line, col] =>
525 (YYBEGIN LINE_DIR2
526 ; addLineDirLineCol (valOf (Int.fromString line), valOf (Int.fromString col))
527 handle Overflow => err () | Option => err ()
528 ; continue ())
529 | _ => (err (); continue ())
530 end);
531<LINE_DIR2>{ws}+"\"" =>
532 (YYBEGIN LINE_DIR3
533 ; continue ());
534<LINE_DIR3>[^"]*"\"" =>
535 (addLineDirFile (String.dropLast yytext)
536 ; YYBEGIN LINE_DIR4
537 ; continue ());
538<LINE_DIR2,LINE_DIR4>{ws}*"*)" =>
539 (finishLineDir (source, lastPos (yypos, yytext))
540 ; continue ());
541<LINE_DIR1,LINE_DIR2,LINE_DIR3,LINE_DIR4>. =>
542 (addCommentError "Illegal line directive"
543 ; YYBEGIN BLOCK_COMMENT
544 ; continue ());
545
546
547<INITIAL>"(*#showBasis"{ws}+"\""[^"]*"\""{ws}*"*)" =>
548 (let
549 val file = List.nth (String.split (yytext, #"\""), 1)
550 val file =
551 if OS.Path.isAbsolute file
552 then file
553 else OS.Path.mkCanonical (OS.Path.concat (OS.Path.dir (Source.name source), file))
554 in
555 tok' (fn (_, l, r) => Tokens.SHOW_BASIS (file, l, r), yytext, source, yypos)
556 end);
557
558
559<INITIAL>. =>
560 (error (source, yypos, yypos, "Illegal token")
561 ; continue ());
mlton packaging