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

SCM Repository

[smlnj] Diff of /sml/branches/SMLNJ/src/cm/parse/cm.lex
ViewVC logotype

Diff of /sml/branches/SMLNJ/src/cm/parse/cm.lex

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 629, Wed Apr 26 04:06:41 2000 UTC revision 630, Wed Apr 26 18:40:56 2000 UTC
# Line 1  Line 1 
1  (* -*- sml -*- *)  (* -*- sml -*-
2     *
3     * lexical analysis (ML-Lex specification) for CM description files
4     *
5     * (C) 1999 Lucent Technologies, Bell Laboratories
6     *
7     * Author: Matthias Blume (blume@kurims.kyoto-u.ac.jp)
8     *)
9    
10  type svalue = Tokens.svalue  type svalue = Tokens.svalue
11  type pos = int  type pos = int
12    
13  type ('a, 'b) token = ('a, 'b) Tokens.token  type ('a, 'b) token = ('a, 'b) Tokens.token
14  type lexresult = (svalue, pos) token  type lexresult = (svalue, pos) token
15    
16  fun err (p1, p2) = ErrorMsg.error p1  type lexarg = {
17                   enterC: unit -> unit,
18                   leaveC: unit -> bool,
19                   newS: pos -> unit,
20                   addS: char -> unit,
21                   addSC: string * int -> unit,
22                   addSN: string * pos -> unit,
23                   getS: pos * (string * pos * pos -> lexresult) -> lexresult,
24                   handleEof: unit -> pos,
25                   newline: pos -> unit,
26                   obsolete: pos * pos -> unit,
27                   error: pos * pos -> string -> unit,
28                   sync: pos * string -> unit
29                  }
30    
31  local  type arg = lexarg
     val depth = ref 0  
     val curstring = ref ([]: char list)  
     val startpos = ref 0  
     val instring = ref false  
 in  
     fun resetAll () = (depth := 0; startpos := 0; instring := false)  
32    
33      (* comment stuff *)  fun eof (arg: lexarg) = let
34      fun enterC () = depth := !depth + 1      val pos = #handleEof arg ()
     fun leaveC () = let  
         val d = !depth - 1  
         val _ = depth := d  
35      in      in
36          d = 0      Tokens.EOF (pos, pos)
37      end      end
38    
39      (* string stuff *)  fun errorTok (t, p) = let
40      fun newS sp = (curstring := []; startpos := sp; instring := true)      fun findGraph i =
41      fun addS c = curstring := c :: (!curstring)          if Char.isGraph (String.sub (t, i)) then i
42      fun addSC (t, p, b) = addS (chr (ord (String.sub (t, 2)) - b))          else findGraph (i + 1)
43      fun addSN (t, p) = let      fun findError i =
44          val ns = substring (t, 1, 3)          if String.sub (t, i) = #"e" then i
45          val n = Int.fromString ns          else findError (i + 1)
46      in      val start = findGraph (5 + findError 0)
47          addS (chr (valOf n))      val msg = String.extract (t, start, NONE)
         handle _ =>  
             ErrorMsg.error p ("illegal decimal char spec " ^ ns)  
     end  
     fun getS endpos =  
         (instring := false;  
          Tokens.STRING (implode (rev (!curstring)), !startpos, endpos + 1))  
   
     (* handling EOF *)  
     fun eof() = let  
         val pos = ErrorMsg.lastLinePos ()  
48      in      in
49          if !depth > 0 then      Tokens.ERROR (msg, p + 1, p + size t)
             ErrorMsg.error pos "unexpected EOF in COMMENT"  
         else if !instring then  
             ErrorMsg.error pos "unexpected EOF in STRING"  
         else ();  
         resetAll ();  
         Tokens.EOF(pos,pos)  
     end  
50  end  end
51    
52  local  val cm_ids = [("Group", Tokens.GROUP),
53      val idlist = [("Alias", Tokens.ALIAS),                ("GROUP", Tokens.GROUP),
54                    ("Group", Tokens.GROUP),                ("group", Tokens.GROUP),
55                    ("Library", Tokens.LIBRARY),                    ("Library", Tokens.LIBRARY),
56                    ("is", Tokens.IS),                ("LIBRARY", Tokens.LIBRARY),
57                    ("structure", Tokens.STRUCTURE),                ("library", Tokens.LIBRARY),
58                  ("IS", Tokens.IS),
59                  ("is", Tokens.IS)]
60    
61    val ml_ids = [("structure", Tokens.STRUCTURE),
62                    ("signature", Tokens.SIGNATURE),                    ("signature", Tokens.SIGNATURE),
63                    ("functor", Tokens.FUNCTOR),                    ("functor", Tokens.FUNCTOR),
64                    ("funsig", Tokens.FUNSIG),                ("funsig", Tokens.FUNSIG)]
65                    ("defined", Tokens.DEFINED),  
66    val pp_ids = [("defined", Tokens.DEFINED),
67                    ("div", Tokens.DIV),                    ("div", Tokens.DIV),
68                    ("mod", Tokens.MOD),                    ("mod", Tokens.MOD),
69                    ("andalso", Tokens.ANDALSO),                    ("andalso", Tokens.ANDALSO),
70                    ("orelse", Tokens.ORELSE),                    ("orelse", Tokens.ORELSE),
71                    ("not", Tokens.NOT)]                    ("not", Tokens.NOT)]
 in  
     fun idToken (t, p) =  
         case List.find (fn (id, _) => id = t) idlist of  
             NONE => Tokens.ID (t, p, p + size t)  
           | SOME (_, tok) => tok (p, p + size t)  
 end  
72    
73  fun newLine p = ErrorMsg.newLine p  fun idToken (t, p, idlist, default, chstate) =
74        case List.find (fn (id, _) => id = t) ml_ids of
75            SOME (_, tok) => (chstate (); tok (p, p + size t))
76          | NONE =>
77                (case List.find (fn (id, _) => id = t) idlist of
78                     SOME (_, tok) => tok (p, p + size t)
79                   | NONE => default (t, p, p + size t))
80    
81    (* states:
82    
83         INITIAL -> C
84           |
85           +------> P -> PC
86           |        |
87           |        +--> PM -> PMC
88           |
89           +------> M -> MC
90           |
91           +------> S -> SS
92    
93       "C"  -- COMMENT
94       "P"  -- PREPROC
95       "M"  -- MLSYMBOL
96       "S"  -- STRING
97       "SS" -- STRINGSKIP
98    *)
99    
100  %%  %%
101  %s COMMENT STRING STRINGSKIP;  
102    %s C P PC PM PMC M MC S SS;
103    
104  %header(functor CMLexFun (structure Tokens: CM_TOKENS));  %header(functor CMLexFun (structure Tokens: CM_TOKENS));
105    
106    %arg ({ enterC, leaveC,
107            newS, addS, addSC, addSN, getS,
108            handleEof,
109            newline,
110            obsolete,
111            error,
112            sync });
113    
114  idchars=[A-Za-z'_0-9];  idchars=[A-Za-z'_0-9];
115  id=[A-Za-z]{idchars}*;  id=[A-Za-z]{idchars}*;
116    cmextrachars=[.;,!%&$+/<=>?@~|#*]|\-|\^;
117    cmidchars={idchars}|{cmextrachars};
118    cmid={cmidchars}+;
119  ws=("\012"|[\t\ ]);  ws=("\012"|[\t\ ]);
120  eol=("\013\010"|"\013"|"\010");  eol=("\013\010"|"\013"|"\010");
121    neol=[^\013\010];
122  sym=[!%&$+/:<=>?@~|#*]|\-|\^|"\\";  sym=[!%&$+/:<=>?@~|#*]|\-|\^|"\\";
123  digit=[0-9];  digit=[0-9];
124  sharp="#";  sharp="#";
125  %%  %%
126    
127  <COMMENT>"(*"           => (enterC (); continue ());  <INITIAL>"(*"           => (enterC (); YYBEGIN C; continue ());
128  <COMMENT>"*)"           => (if leaveC () then YYBEGIN INITIAL else ();  <P>"(*"                 => (enterC (); YYBEGIN PC; continue ());
129    <PM>"(*"                => (enterC (); YYBEGIN PMC; continue ());
130    <M>"(*"                 => (enterC (); YYBEGIN MC; continue ());
131    
132    <C,PC,PMC,MC>"(*"       => (enterC (); continue ());
133    
134    <C>"*)"                 => (if leaveC () then YYBEGIN INITIAL else ();
135                                continue ());
136    <PC>"*)"                => (if leaveC () then YYBEGIN P else ();
137                                continue ());
138    <PMC>"*)"                => (if leaveC () then YYBEGIN PM else ();
139                                continue ());
140    <MC>"*)"                => (if leaveC () then YYBEGIN M else ();
141                              continue ());                              continue ());
142  <COMMENT>{eol}          => (newLine yypos; continue ());  <C,PC,PMC,MC>{eol}      => (newline yypos; continue ());
143  <COMMENT>.              => (continue ());  <C,PC,PMC,MC>.          => (continue ());
144    
145  <STRING>"\\a"           => (addS #"\a"; continue ());  <INITIAL,P,PM,M>"*)"    => (error (yypos, yypos+2)
146  <STRING>"\\b"           => (addS #"\b"; continue ());                                "unmatched comment delimiter";
147  <STRING>"\\f"           => (addS #"\f"; continue ());                              continue ());
148  <STRING>"\\n"           => (addS #"\n"; continue ());  
149  <STRING>"\\r"           => (addS #"\r"; continue ());  <INITIAL>"\""           => (YYBEGIN S; newS yypos; continue ());
 <STRING>"\\t"           => (addS #"\t"; continue ());  
 <STRING>"\\v"           => (addS #"\v"; continue ());  
   
 <STRING>"\\^"@          => (addS (chr 0); continue ());  
 <STRING>"\\^"[a-z]      => (addSC (yytext, yypos, ord #"a"); continue ());  
 <STRING>"\\^"[A-Z]      => (addSC (yytext, yypos, ord #"A"); continue ());  
 <STRING>"\\^["          => (addS (chr 27); continue ());  
 <STRING>"\\^\\"         => (addS (chr 28); continue ());  
 <STRING>"\\^]"          => (addS (chr 29); continue ());  
 <STRING>"\\^^"          => (addS (chr 30); continue ());  
 <STRING>"\\^_"          => (addS (chr 31); continue ());  
   
 <STRING>"\\"[0-9][0-9][0-9]     => (addSN (yytext, yypos); continue ());  
150    
151  <STRING>"\\\""          => (addS #"\""; continue ());  <S>"\\a"                => (addS #"\a"; continue ());
152  <STRING>"\\\\"          => (addS #"\\"; continue ());  <S>"\\b"                => (addS #"\b"; continue ());
153    <S>"\\f"                => (addS #"\f"; continue ());
154    <S>"\\n"                => (addS #"\n"; continue ());
155    <S>"\\r"                => (addS #"\r"; continue ());
156    <S>"\\t"                => (addS #"\t"; continue ());
157    <S>"\\v"                => (addS #"\v"; continue ());
158    
159    <S>"\\^"@               => (addS (chr 0); continue ());
160    <S>"\\^"[a-z]           => (addSC (yytext, ord #"a"); continue ());
161    <S>"\\^"[A-Z]           => (addSC (yytext, ord #"A"); continue ());
162    <S>"\\^["               => (addS (chr 27); continue ());
163    <S>"\\^\\"              => (addS (chr 28); continue ());
164    <S>"\\^]"               => (addS (chr 29); continue ());
165    <S>"\\^^"               => (addS (chr 30); continue ());
166    <S>"\\^_"               => (addS (chr 31); continue ());
167    
168    <S>"\\"[0-9][0-9][0-9]  => (addSN (yytext, yypos); continue ());
169    
170  <STRING>"\\"{eol}       => (YYBEGIN STRINGSKIP; newLine yypos; continue ());  <S>"\\\""               => (addS #"\""; continue ());
171  <STRING>"\\"{ws}+       => (YYBEGIN STRINGSKIP; continue ());  <S>"\\\\"               => (addS #"\\"; continue ());
172    
173  <STRING>"\\".           => (ErrorMsg.error yypos  <S>"\\"{eol}            => (YYBEGIN SS; newline (yypos + 1); continue ());
174    <S>"\\"{ws}+            => (YYBEGIN SS; continue ());
175    
176    <S>"\\".                => (error (yypos, yypos+2)
177                               ("illegal escape character in string " ^ yytext);                               ("illegal escape character in string " ^ yytext);
178                              continue ());                              continue ());
179    
180  <STRING>"\""            => (YYBEGIN INITIAL; getS yypos);  <S>"\""                 => (YYBEGIN INITIAL; getS (yypos, Tokens.FILE_NATIVE));
181  <STRING>{eol}           => (ErrorMsg.error yypos "illegal linebreak in string";  <S>{eol}                => (newline yypos;
182                                error (yypos, yypos + size yytext)
183                                  "illegal linebreak in string";
184                              continue ());                              continue ());
 <STRING>.               => (addS (String.sub (yytext, 0)); continue ());  
185    
186  <STRINGSKIP>{eol}       => (newLine yypos; continue ());  <S>.                    => (addS (String.sub (yytext, 0)); continue ());
 <STRINGSKIP>{ws}+       => (continue ());  
 <STRINGSKIP>"\\"        => (YYBEGIN STRING; continue ());  
 <STRINGSKIP>.           => (ErrorMsg.error yypos  
                              ("illegal character in stringskip " ^ yytext);  
                             continue ());  
187    
188  <INITIAL>"(*"           => (YYBEGIN COMMENT; enterC (); continue ());  <SS>{eol}               => (newline yypos; continue ());
189  <INITIAL>"*)"           => (ErrorMsg.error yypos "unmatched comment delimiter";  <SS>{ws}+               => (continue ());
190    <SS>"\\"                => (YYBEGIN S; continue ());
191    <SS>.                   => (error (yypos, yypos+1)
192                                 ("illegal character in stringskip " ^ yytext);
193                              continue ());                              continue ());
 <INITIAL>"\""           => (YYBEGIN STRING; newS yypos; continue ());  
194    
195  <INITIAL>"("            => (Tokens.LPAREN (yypos, yypos + 1));  <INITIAL,P>"("          => (Tokens.LPAREN (yypos, yypos + 1));
196  <INITIAL>")"            => (Tokens.RPAREN (yypos, yypos + 1));  <INITIAL,P>")"          => (Tokens.RPAREN (yypos, yypos + 1));
 <INITIAL>","            => (Tokens.COMMA (yypos, yypos + 1));  
197  <INITIAL>":"            => (Tokens.COLON (yypos, yypos + 1));  <INITIAL>":"            => (Tokens.COLON (yypos, yypos + 1));
198  <INITIAL>"+"            => (Tokens.PLUS (yypos, yypos + 1));  <P>"+"                  => (Tokens.PLUS (yypos, yypos + 1));
199  <INITIAL>"-"            => (Tokens.MINUS (yypos, yypos + 1));  <P>"-"                  => (Tokens.MINUS (yypos, yypos + 1));
200  <INITIAL>"*"            => (Tokens.TIMES (yypos, yypos + 1));  <P>"*"                  => (Tokens.TIMES (yypos, yypos + 1));
201  <INITIAL>"<>"           => (Tokens.NE (yypos, yypos + 2));  <P>"<>"                 => (Tokens.NE (yypos, yypos + 2));
202  <INITIAL>"<="           => (Tokens.LE (yypos, yypos + 2));  <P>"!="                 => (obsolete (yypos, yypos + 2);
203  <INITIAL>"<"            => (Tokens.LT (yypos, yypos + 1));                              Tokens.NE (yypos, yypos+2));
204  <INITIAL>">="           => (Tokens.GE (yypos, yypos + 2));  <P>"<="                 => (Tokens.LE (yypos, yypos + 2));
205  <INITIAL>">"            => (Tokens.GT (yypos, yypos + 1));  <P>"<"                  => (Tokens.LT (yypos, yypos + 1));
206  <INITIAL>"="            => (Tokens.EQ (yypos, yypos + 1));  <P>">="                 => (Tokens.GE (yypos, yypos + 2));
207    <P>">"                  => (Tokens.GT (yypos, yypos + 1));
208    <P>"=="                 => (obsolete (yypos, yypos + 2);
209                                Tokens.EQ (yypos, yypos + 2));
210    <P>"="                  => (Tokens.EQ (yypos, yypos + 1));
211    <P>"~"                  => (Tokens.TILDE (yypos, yypos + 1));
212    
213  <INITIAL>{digit}+       => (Tokens.NUMBER  <P>{digit}+             => (Tokens.NUMBER
214                               (valOf (Int.fromString yytext)                               (valOf (Int.fromString yytext)
215                                handle _ =>                                handle _ =>
216                                    (ErrorMsg.error yypos "number too large"; 0),                                    (error (yypos, yypos + size yytext)
217                                         "number too large";
218                                       0),
219                                yypos, yypos + size yytext));                                yypos, yypos + size yytext));
 <INITIAL>{sym}+         => (Tokens.ID (yytext, yypos, yypos + size yytext));  
 <INITIAL>{id}           => (idToken (yytext, yypos));  
220    
221  <INITIAL>{eol}{sharp}{ws}*"if"   => (Tokens.IF (yypos, yypos + size yytext));  <P>{id}                 => (idToken (yytext, yypos, pp_ids, Tokens.CM_ID,
222  <INITIAL>{eol}{sharp}{ws}*"then" => (Tokens.THEN (yypos, yypos + size yytext));                                       fn () => YYBEGIN PM));
223  <INITIAL>{eol}{sharp}{ws}*"elif" => (Tokens.ELIF (yypos, yypos + size yytext));  <P>"/"                  => (obsolete (yypos, yypos + 1);
224  <INITIAL>{eol}{sharp}{ws}*"else" => (Tokens.ELSE (yypos, yypos + size yytext));                              Tokens.DIV (yypos, yypos + 1));
225  <INITIAL>{eol}{sharp}{ws}*"endif" => (Tokens.ENDIF (yypos,  <P>"%"                  => (obsolete (yypos, yypos + 1);
226                                Tokens.MOD (yypos, yypos + 1));
227    <P>"&&"                 => (obsolete (yypos, yypos + 2);
228                                Tokens.ANDALSO (yypos, yypos + 2));
229    <P>"||"                 => (obsolete (yypos, yypos + 2);
230                                Tokens.ORELSE (yypos, yypos + 2));
231    <P>"!"                  => (obsolete (yypos, yypos + 1);
232                                Tokens.NOT (yypos, yypos + 1));
233    
234    <M>({id}|{sym}+)        => (YYBEGIN INITIAL;
235                                Tokens.ML_ID (yytext, yypos, yypos + size yytext));
236    <PM>({id}|{sym}+)       => (YYBEGIN P;
237                                Tokens.ML_ID (yytext, yypos, yypos + size yytext));
238    
239    <INITIAL,P>{eol}{sharp}{ws}*"if" => (YYBEGIN P;
240                                         newline yypos;
241                                         Tokens.IF (yypos, yypos + size yytext));
242    <INITIAL,P>{eol}{sharp}{ws}*"elif" => (YYBEGIN P;
243                                         newline yypos;
244                                         Tokens.ELIF (yypos, yypos + size yytext));
245    <INITIAL,P>{eol}{sharp}{ws}*"else" => (YYBEGIN P;
246                                         newline yypos;
247                                         Tokens.ELSE (yypos, yypos + size yytext));
248    <INITIAL,P>{eol}{sharp}{ws}*"endif" => (YYBEGIN P;
249                                          newline yypos;
250                                          Tokens.ENDIF (yypos,
251                                                      yypos + size yytext));                                                      yypos + size yytext));
252    <INITIAL,P>{eol}{sharp}{ws}*"error"{ws}+{neol}* => (newline yypos;
253                                                        errorTok (yytext, yypos));
254    <INITIAL,M,PM>{eol}     => (newline yypos; continue ());
255    <P>{eol}                => (YYBEGIN INITIAL; newline yypos; continue ());
256    
257    <INITIAL,M,PM,P>{ws}+   => (continue ());
258    
259    <M,PM>.                 => (error (yypos, yypos+1)
260                                ("illegal character at start of ML symbol: " ^
261                                 yytext);
262                                continue ());
263    
264    <INITIAL>{cmid}         => (idToken (yytext, yypos, cm_ids,
265                                         Tokens.FILE_STANDARD,
266                                         fn () => YYBEGIN M));
267    
268    
269    <INITIAL>.              => (error (yypos, yypos+1)
270                                ("illegal character: " ^ yytext);
271                                continue ());
272    
273  <INITIAL>{eol}          => (newLine yypos; continue ());  {eol}{sharp}{ws}*"line"{ws}+{neol}* => (newline yypos;
274  <INITIAL>{ws}+          => (continue ());                                          sync (yypos, yytext);
 <INITIAL>.              => (ErrorMsg.error yypos  
                              ("illegal character " ^ yytext);  
275                              continue ());                              continue ());

Legend:
Removed from v.629  
changed lines
  Added in v.630

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