|
|
1.1 root 1: (* Copyright 1989 by AT&T Bell Laboratories *)
2: type lexresult = Token.token
3: type lexarg = {comLevel : int ref, lineNum : int ref, complain : string->unit}
4: val eof = fn {comLevel,lineNum,complain} =>
5: (if !comLevel>0 then complain "unclosed comment" else ();
6: Token.EOF)
7: val charlist = ref (nil : string list)
8: fun addString (s:string) = charlist := s :: (!charlist)
9: fun makeInt s = revfold (fn (c,a) => a*10 + (ord c - Ascii.zero)) (explode s) 0
10: %%
11: %s A S F;
12: %arg (arg as {comLevel,lineNum,complain});
13: idchars=[A-Za-z'_0-9];
14: id=[A-Za-z'_]{idchars}*;
15: qualid={id}".";
16: ws=[\t\ ]*;
17: sym=[!%&$+/:<=>?@~|#*`]|\\|\-|\^;
18: num=[0-9]+;
19: frac="."{num};
20: exp="E"(~?){num};
21: real=(~?)(({num}{frac}?{exp})|({num}{frac}{exp}?));
22: %%
23: <INITIAL>{ws} => (continue());
24: <INITIAL>\n => (inc lineNum; continue());
25: <INITIAL>"*" => (Token.ASTERISK);
26: <INITIAL>"|" => (Token.BAR);
27: <INITIAL>":" => (Token.COLON);
28: <INITIAL>"=" => (Token.EQUAL);
29: <INITIAL>"_" => (Token.WILD);
30: <INITIAL>"#" => (Token.HASH);
31: <INITIAL>"," => (Token.COMMA);
32: <INITIAL>"{" => (Token.LBRACE);
33: <INITIAL>"}" => (Token.RBRACE);
34: <INITIAL>"[" => (Token.LBRACKET);
35: <INITIAL>"]" => (Token.RBRACKET);
36: <INITIAL>";" => (Token.SEMICOLON);
37: <INITIAL>"(" => (Token.LPAREN);
38: <INITIAL>")" => (Token.RPAREN);
39: <INITIAL>"and" => (Token.AND);
40: <INITIAL>"abstraction" => (Token.ABSTRACTION);
41: <INITIAL>"abstype" => (Token.ABSTYPE);
42: <INITIAL>"->" => (Token.ARROW);
43: <INITIAL>"as" => (Token.AS);
44: <INITIAL>"case" => (Token.CASE);
45: <INITIAL>"datatype" => (Token.DATATYPE);
46: <INITIAL>"..." => (Token.DOTDOTDOT);
47: <INITIAL>"else" => (Token.ELSE);
48: <INITIAL>"end" => (Token.END);
49: <INITIAL>"eqtype" => (Token.EQTYPE);
50: <INITIAL>"exception" => (Token.EXCEPTION);
51: <INITIAL>"do" => (Token.DO);
52: <INITIAL>"=>" => (Token.DARROW);
53: <INITIAL>"fn" => (Token.FN);
54: <INITIAL>"fun" => (Token.FUN);
55: <INITIAL>"functor" => (Token.FUNCTOR);
56: <INITIAL>"handle" => (Token.HANDLE);
57: <INITIAL>"if" => (Token.IF);
58: <INITIAL>"in" => (Token.IN);
59: <INITIAL>"include" => (Token.INCLUDE);
60: <INITIAL>"infix" => (Token.INFIX);
61: <INITIAL>"infixr" => (Token.INFIXR);
62: <INITIAL>"let" => (Token.LET);
63: <INITIAL>"local" => (Token.LOCAL);
64: <INITIAL>"nonfix" => (Token.NONFIX);
65: <INITIAL>"of" => (Token.OF);
66: <INITIAL>"op" => (Token.OP);
67: <INITIAL>"open" => (Token.OPEN);
68: <INITIAL>"overload" => (Token.OVERLOAD);
69: <INITIAL>"raise" => (Token.RAISE);
70: <INITIAL>"rec" => (Token.REC);
71: <INITIAL>"sharing" => (Token.SHARING);
72: <INITIAL>"sig" => (Token.SIG);
73: <INITIAL>"signature" => (Token.SIGNATURE);
74: <INITIAL>"struct" => (Token.STRUCT);
75: <INITIAL>"structure" => (Token.STRUCTURE);
76: <INITIAL>"then" => (Token.THEN);
77: <INITIAL>"type" => (Token.TYPE);
78: <INITIAL>"val" => (Token.VAL);
79: <INITIAL>"while" => (Token.WHILE);
80: <INITIAL>"with" => (Token.WITH);
81: <INITIAL>"withtype" => (Token.WITHTYPE);
82: <INITIAL>"orelse" => (Token.ORELSE);
83: <INITIAL>"andalso" => (Token.ANDALSO);
84: <INITIAL>"import" => (Token.IMPORT);
85: <INITIAL>{qualid} =>
86: (Token.IDDOT (Symbol.symbol(substring(yytext,0,size(yytext)-1))));
87: <INITIAL>"..." => (Token.DOTDOTDOT);
88: <INITIAL>"'"{idchars}+ => (Token.TYVAR(Symbol.symbol yytext));
89: <INITIAL>({sym}+|{id}) => (Token.ID(Symbol.symbol yytext));
90: <INITIAL>{real} => (Token.REAL yytext);
91: <INITIAL>{num} => (Token.INT(makeInt yytext
92: handle Overflow => (complain "integer too large"; 0)));
93: <INITIAL>~{num} => (Token.INT(~(makeInt(substring(yytext,1,size(yytext)-1)))
94: handle Overflow => (complain "integer too large"; 0)));
95: <INITIAL>\" => (charlist := nil; YYBEGIN S; continue());
96: <INITIAL>"(*" => (YYBEGIN A; comLevel := 1; continue());
97: <INITIAL>. => (complain "illegal token"; continue());
98: <A>"(*" => (inc comLevel; continue());
99: <A>\n => (inc lineNum; continue());
100: <A>"*)" => (dec comLevel; if !comLevel=0 then YYBEGIN INITIAL else (); continue());
101: <A>. => (continue());
102: <S>\" => (YYBEGIN INITIAL; Token.STRING(implode(rev(!charlist))));
103: <S>\n => (complain "unclosed string"; YYBEGIN INITIAL; Token.STRING "");
104: <S>[^"\\\n]* => (addString yytext; continue());
105: <S>\\\n => (inc lineNum; YYBEGIN F; continue());
106: <S>\\[\ \t] => (YYBEGIN F; continue());
107: <F>\n => (inc lineNum; continue());
108: <F>{ws} => (continue());
109: <F>\\ => (YYBEGIN S; continue());
110: <F>. => (complain "unclosed string"; YYBEGIN INITIAL; Token.STRING "");
111: <S>\\t => (addString "\t"; continue());
112: <S>\\n => (addString "\n"; continue());
113: <S>\\\\ => (addString "\\"; continue());
114: <S>\\\" => (addString(chr(Ascii.dquote)); continue());
115: <S>\\\^[@-_] => (addString(chr(ordof(yytext,2)-ord("@"))); continue());
116: <S>\\[0-9]{3} =>
117: (let val x = ordof(yytext,1)*100
118: +ordof(yytext,2)*10
119: +ordof(yytext,3)
120: -(Ascii.zero*111)
121: in (if x>255
122: then complain ("illegal ascii escape '"^yytext^"'")
123: else addString (chr x);
124: continue())
125: end);
126: <S>\\ => (complain "illegal string escape"; continue());
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.