Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | structure Tokens = Tokens |
2 | type pos = int | |
3 | type svalue = Tokens.svalue | |
4 | type ('a,'b) token = ('a,'b) Tokens.token | |
5 | type lexresult = (svalue,pos) token | |
6 | ||
7 | open Tokens | |
8 | ||
9 | val lineNum = ref 0 | |
10 | val eof = fn () => EOF(!lineNum,!lineNum) | |
11 | ||
12 | ||
13 | structure KeyWord : sig | |
14 | val find : string -> | |
15 | (int * int -> (svalue,int) token) option | |
16 | end = | |
17 | struct | |
18 | ||
19 | val TableSize = 211 | |
20 | val HashFactor = 5 | |
21 | ||
22 | val hash = fn s => | |
23 | foldl (fn (c,v)=>(v*HashFactor+(ord c)) mod TableSize) 0 (explode s) | |
24 | ||
25 | ||
26 | val HashTable = Array.array(TableSize,nil) : | |
27 | (string * (int * int -> (svalue,int) token)) list Array.array | |
28 | ||
29 | ||
30 | val add = fn (s,v) => | |
31 | let val i = hash s | |
32 | in Array.update(HashTable,i,(s,v) :: (Array.sub(HashTable, i))) | |
33 | end | |
34 | ||
35 | val find = fn s => | |
36 | let val i = hash s | |
37 | fun f ((key,v)::r) = if s=key then SOME v else f r | |
38 | | f nil = NONE | |
39 | in f (Array.sub(HashTable, i)) | |
40 | end | |
41 | ||
42 | val _ = | |
43 | (List.app add | |
44 | [("and",YAND), | |
45 | ("array",YARRAY), | |
46 | ("begin",YBEGIN), | |
47 | ("case",YCASE), | |
48 | ("const",YCONST), | |
49 | ("div",YDIV), | |
50 | ("do",YDO), | |
51 | ("downto",YDOWNTO), | |
52 | ("else",YELSE), | |
53 | ("end",YEND), | |
54 | ("extern",YEXTERN), | |
55 | ("file",YFILE), | |
56 | ("for",YFOR), | |
57 | ("forward",YFORWARD), | |
58 | ("function",YFUNCTION), | |
59 | ("goto",YGOTO), | |
60 | ("hex",YHEX), | |
61 | ("if",YIF), | |
62 | ("in",YIN), | |
63 | ("label",YLABEL), | |
64 | ("mod",YMOD), | |
65 | ("nil",YNIL), | |
66 | ("not",YNOT), | |
67 | ("oct",YOCT), | |
68 | ("of",YOF), | |
69 | ("or",YOR), | |
70 | ("packed",YPACKED), | |
71 | ("procedure",YPROCEDURE), | |
72 | ("program",YPROG), | |
73 | ("record",YRECORD), | |
74 | ("repeat",YREPEAT), | |
75 | ("set",YSET), | |
76 | ("then",YTHEN), | |
77 | ("to",YTO), | |
78 | ("type",YTYPE), | |
79 | ("until",YUNTIL), | |
80 | ("var",YVAR), | |
81 | ("while",YWHILE), | |
82 | ("with",YWITH) | |
83 | ]) | |
84 | end | |
85 | open KeyWord | |
86 | ||
87 | %% | |
88 | ||
89 | %header (functor PascalLexFun(structure Tokens : Pascal_TOKENS)); | |
90 | %s C B; | |
91 | alpha=[A-Za-z]; | |
92 | digit=[0-9]; | |
93 | optsign=("+"|"-")?; | |
94 | integer={digit}+; | |
95 | frac="."{digit}+; | |
96 | exp=(e|E){optsign}{digit}+; | |
97 | octdigit=[0-7]; | |
98 | ws = [\ \t]; | |
99 | %% | |
100 | <INITIAL>{ws}+ => (lex()); | |
101 | <INITIAL>\n+ => (lineNum := (!lineNum) + (String.size yytext); lex()); | |
102 | <INITIAL>{alpha}+ => (case find yytext of SOME v => v(!lineNum,!lineNum) | |
103 | | _ => YID(!lineNum,!lineNum)); | |
104 | <INITIAL>{alpha}({alpha}|{digit})* => (YID(!lineNum,!lineNum)); | |
105 | <INITIAL>{optsign}{integer}({frac}{exp}?|{frac}?{exp}) => (YNUMB(!lineNum,!lineNum)); | |
106 | <INITIAL>{optsign}{integer} => (YINT(!lineNum,!lineNum)); | |
107 | <INITIAL>{octdigit}+(b|B) => (YBINT(!lineNum,!lineNum)); | |
108 | <INITIAL>"'"([^']|"''")*"'" => (YSTRING(!lineNum,!lineNum)); | |
109 | <INITIAL>"(*" => (YYBEGIN C; lex()); | |
110 | <INITIAL>".." => (YDOTDOT(!lineNum,!lineNum)); | |
111 | <INITIAL>"." => (YDOT(!lineNum,!lineNum)); | |
112 | <INITIAL>"(" => (YLPAR(!lineNum,!lineNum)); | |
113 | <INITIAL>")" => (YRPAR(!lineNum,!lineNum)); | |
114 | <INITIAL>";" => (YSEMI(!lineNum,!lineNum)); | |
115 | <INITIAL>"," => (YCOMMA(!lineNum,!lineNum)); | |
116 | <INITIAL>":" => (YCOLON(!lineNum,!lineNum)); | |
117 | <INITIAL>"^" => (YCARET(!lineNum,!lineNum)); | |
118 | <INITIAL>"[" => (YLBRA(!lineNum,!lineNum)); | |
119 | <INITIAL>"]" => (YRBRA(!lineNum,!lineNum)); | |
120 | <INITIAL>"~" => (YTILDE(!lineNum,!lineNum)); | |
121 | <INITIAL>"<" => (YLESS(!lineNum,!lineNum)); | |
122 | <INITIAL>"=" => (YEQUAL(!lineNum,!lineNum)); | |
123 | <INITIAL>">" => (YGREATER(!lineNum,!lineNum)); | |
124 | <INITIAL>"+" => (YPLUS(!lineNum,!lineNum)); | |
125 | <INITIAL>"-" => (YMINUS(!lineNum,!lineNum)); | |
126 | <INITIAL>"|" => (YBAR(!lineNum,!lineNum)); | |
127 | <INITIAL>"*" => (YSTAR(!lineNum,!lineNum)); | |
128 | <INITIAL>"/" => (YSLASH(!lineNum,!lineNum)); | |
129 | <INITIAL>"{" => (YYBEGIN B; lex()); | |
130 | <INITIAL>. => (YILLCH(!lineNum,!lineNum)); | |
131 | <C>\n+ => (lineNum := (!lineNum) + (String.size yytext); lex()); | |
132 | <C>[^()*\n]+ => (lex()); | |
133 | <C>"(*" => (lex()); | |
134 | <C>"*)" => (YYBEGIN INITIAL; lex()); | |
135 | <C>[*()] => (lex()); | |
136 | <B>\n+ => (lineNum := (!lineNum) + (String.size yytext); lex()); | |
137 | <B>[^{}\n]+ => (lex()); | |
138 | <B>"{" => (lex()); | |
139 | <B>"}" => (YYBEGIN INITIAL; lex()); |