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/cm/parse/cm.lex
ViewVC logotype

Annotation of /sml/trunk/src/cm/parse/cm.lex

Parent Directory Parent Directory | Revision Log Revision Log


Revision 262 - (view) (download)

1 : blume 262 (* -*- sml -*- *)
2 :    
3 :     type svalue = Tokens.svalue
4 :     type pos = int
5 :     type ('a, 'b) token = ('a, 'b) Tokens.token
6 :     type lexresult = (svalue, pos) token
7 :    
8 :     fun err (p1, p2) = ErrorMsg.error p1
9 :    
10 :     local
11 :     val depth = ref 0
12 :     val curstring = ref ([]: char list)
13 :     val startpos = ref 0
14 :     val instring = ref false
15 :     in
16 :     fun resetAll () = (depth := 0; startpos := 0; instring := false)
17 :    
18 :     (* comment stuff *)
19 :     fun enterC () = depth := !depth + 1
20 :     fun leaveC () = let
21 :     val d = !depth - 1
22 :     val _ = depth := d
23 :     in
24 :     d = 0
25 :     end
26 :    
27 :     (* string stuff *)
28 :     fun newS sp = (curstring := []; startpos := sp; instring := true)
29 :     fun addS c = curstring := c :: (!curstring)
30 :     fun addSC (t, p, b) = addS (chr (ord (String.sub (t, 2)) - b))
31 :     fun addSN (t, p) = let
32 :     val ns = substring (t, 1, 3)
33 :     val n = Int.fromString ns
34 :     in
35 :     addS (chr (valOf n))
36 :     handle _ =>
37 :     ErrorMsg.error p ("illegal decimal char spec " ^ ns)
38 :     end
39 :     fun getS endpos =
40 :     (instring := false;
41 :     Tokens.STRING (implode (rev (!curstring)), !startpos, endpos + 1))
42 :    
43 :     (* handling EOF *)
44 :     fun eof() = let
45 :     val pos = ErrorMsg.lastLinePos ()
46 :     in
47 :     if !depth > 0 then
48 :     ErrorMsg.error pos "unexpected EOF in COMMENT"
49 :     else if !instring then
50 :     ErrorMsg.error pos "unexpected EOF in STRING"
51 :     else ();
52 :     resetAll ();
53 :     Tokens.EOF(pos,pos)
54 :     end
55 :     end
56 :    
57 :     local
58 :     val idlist = [("Alias", Tokens.ALIAS),
59 :     ("Group", Tokens.GROUP),
60 :     ("Library", Tokens.LIBRARY),
61 :     ("is", Tokens.IS),
62 :     ("structure", Tokens.STRUCTURE),
63 :     ("signature", Tokens.SIGNATURE),
64 :     ("functor", Tokens.FUNCTOR),
65 :     ("funsig", Tokens.FUNSIG),
66 :     ("defined", Tokens.DEFINED),
67 :     ("div", Tokens.DIV),
68 :     ("mod", Tokens.MOD),
69 :     ("andalso", Tokens.ANDALSO),
70 :     ("orelse", Tokens.ORELSE),
71 :     ("not", Tokens.NOT)]
72 :     in
73 :     fun idToken (t, p) =
74 :     case List.find (fn (id, _) => id = t) idlist of
75 :     NONE => Tokens.ID (t, p, p + size t)
76 :     | SOME (_, tok) => tok (p, p + size t)
77 :     end
78 :    
79 :     fun newLine p = ErrorMsg.newLine p
80 :    
81 :     %%
82 :     %s COMMENT STRING STRINGSKIP;
83 :    
84 :     %header(functor CMLexFun (structure Tokens: CM_TOKENS));
85 :    
86 :     idchars=[A-Za-z'_0-9];
87 :     id=[A-Za-z]{idchars}*;
88 :     ws=("\012"|[\t\ ]);
89 :     eol=("\013\010"|"\013"|"\010");
90 :     sym=[!%&$+/:<=>?@~|#*]|\-|\^|"\\";
91 :     digit=[0-9];
92 :     sharp="#";
93 :     %%
94 :    
95 :     <COMMENT>"(*" => (enterC (); continue ());
96 :     <COMMENT>"*)" => (if leaveC () then YYBEGIN INITIAL else ();
97 :     continue ());
98 :     <COMMENT>{eol} => (newLine yypos; continue ());
99 :     <COMMENT>. => (continue ());
100 :    
101 :     <STRING>"\\a" => (addS #"\a"; continue ());
102 :     <STRING>"\\b" => (addS #"\b"; continue ());
103 :     <STRING>"\\f" => (addS #"\f"; continue ());
104 :     <STRING>"\\n" => (addS #"\n"; continue ());
105 :     <STRING>"\\r" => (addS #"\r"; continue ());
106 :     <STRING>"\\t" => (addS #"\t"; continue ());
107 :     <STRING>"\\v" => (addS #"\v"; continue ());
108 :    
109 :     <STRING>"\\^"@ => (addS (chr 0); continue ());
110 :     <STRING>"\\^"[a-z] => (addSC (yytext, yypos, ord #"a"); continue ());
111 :     <STRING>"\\^"[A-Z] => (addSC (yytext, yypos, ord #"A"); continue ());
112 :     <STRING>"\\^[" => (addS (chr 27); continue ());
113 :     <STRING>"\\^\\" => (addS (chr 28); continue ());
114 :     <STRING>"\\^]" => (addS (chr 29); continue ());
115 :     <STRING>"\\^^" => (addS (chr 30); continue ());
116 :     <STRING>"\\^_" => (addS (chr 31); continue ());
117 :    
118 :     <STRING>"\\"[0-9][0-9][0-9] => (addSN (yytext, yypos); continue ());
119 :    
120 :     <STRING>"\\\"" => (addS #"\""; continue ());
121 :     <STRING>"\\\\" => (addS #"\\"; continue ());
122 :    
123 :     <STRING>"\\"{eol} => (YYBEGIN STRINGSKIP; newLine yypos; continue ());
124 :     <STRING>"\\"{ws}+ => (YYBEGIN STRINGSKIP; continue ());
125 :    
126 :     <STRING>"\\". => (ErrorMsg.error yypos
127 :     ("illegal escape character in string " ^ yytext);
128 :     continue ());
129 :    
130 :     <STRING>"\"" => (YYBEGIN INITIAL; getS yypos);
131 :     <STRING>{eol} => (ErrorMsg.error yypos "illegal linebreak in string";
132 :     continue ());
133 :     <STRING>. => (addS (String.sub (yytext, 0)); continue ());
134 :    
135 :     <STRINGSKIP>{eol} => (newLine yypos; continue ());
136 :     <STRINGSKIP>{ws}+ => (continue ());
137 :     <STRINGSKIP>"\\" => (YYBEGIN STRING; continue ());
138 :     <STRINGSKIP>. => (ErrorMsg.error yypos
139 :     ("illegal character in stringskip " ^ yytext);
140 :     continue ());
141 :    
142 :     <INITIAL>"(*" => (YYBEGIN COMMENT; enterC (); continue ());
143 :     <INITIAL>"*)" => (ErrorMsg.error yypos "unmatched comment delimiter";
144 :     continue ());
145 :     <INITIAL>"\"" => (YYBEGIN STRING; newS yypos; continue ());
146 :    
147 :     <INITIAL>"(" => (Tokens.LPAREN (yypos, yypos + 1));
148 :     <INITIAL>")" => (Tokens.RPAREN (yypos, yypos + 1));
149 :     <INITIAL>"," => (Tokens.COMMA (yypos, yypos + 1));
150 :     <INITIAL>":" => (Tokens.COLON (yypos, yypos + 1));
151 :     <INITIAL>"+" => (Tokens.PLUS (yypos, yypos + 1));
152 :     <INITIAL>"-" => (Tokens.MINUS (yypos, yypos + 1));
153 :     <INITIAL>"*" => (Tokens.TIMES (yypos, yypos + 1));
154 :     <INITIAL>"<>" => (Tokens.NE (yypos, yypos + 2));
155 :     <INITIAL>"<=" => (Tokens.LE (yypos, yypos + 2));
156 :     <INITIAL>"<" => (Tokens.LT (yypos, yypos + 1));
157 :     <INITIAL>">=" => (Tokens.GE (yypos, yypos + 2));
158 :     <INITIAL>">" => (Tokens.GT (yypos, yypos + 1));
159 :     <INITIAL>"=" => (Tokens.EQ (yypos, yypos + 1));
160 :    
161 :     <INITIAL>{digit}+ => (Tokens.NUMBER
162 :     (valOf (Int.fromString yytext)
163 :     handle _ =>
164 :     (ErrorMsg.error yypos "number too large"; 0),
165 :     yypos, yypos + size yytext));
166 :     <INITIAL>{sym}+ => (Tokens.ID (yytext, yypos, yypos + size yytext));
167 :     <INITIAL>{id} => (idToken (yytext, yypos));
168 :    
169 :     <INITIAL>{eol}{sharp}{ws}*"if" => (Tokens.IF (yypos, yypos + size yytext));
170 :     <INITIAL>{eol}{sharp}{ws}*"then" => (Tokens.THEN (yypos, yypos + size yytext));
171 :     <INITIAL>{eol}{sharp}{ws}*"elif" => (Tokens.ELIF (yypos, yypos + size yytext));
172 :     <INITIAL>{eol}{sharp}{ws}*"else" => (Tokens.ELSE (yypos, yypos + size yytext));
173 :     <INITIAL>{eol}{sharp}{ws}*"endif" => (Tokens.ENDIF (yypos,
174 :     yypos + size yytext));
175 :    
176 :     <INITIAL>{eol} => (newLine yypos; continue ());
177 :     <INITIAL>{ws}+ => (continue ());
178 :     <INITIAL>. => (ErrorMsg.error yypos
179 :     ("illegal character " ^ yytext);
180 :     continue ());

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