Commit | Line | Data |
---|---|---|
7f918cf1 CE |
1 | (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *) |
2 | ||
3 | functor mkPrintStruct(structure LrTable : LR_TABLE | |
4 | structure ShrinkLrTable : SHRINK_LR_TABLE | |
5 | sharing LrTable = ShrinkLrTable.LrTable):PRINT_STRUCT = | |
6 | struct | |
7 | val sub = Array.sub | |
8 | infix 9 sub | |
9 | structure LrTable = LrTable | |
10 | open ShrinkLrTable LrTable | |
11 | ||
12 | ||
13 | (* lineLength = approximately the largest number of characters to allow | |
14 | on a line when printing out an encode string *) | |
15 | ||
16 | val lineLength = 72 | |
17 | ||
18 | (* maxLength = length of a table entry. All table entries are encoded | |
19 | using two 16-bit integers, one for the terminal number and the other | |
20 | for the entry. Each integer is printed as two characters (low byte, | |
21 | high byte), using the ML ascii escape sequence. We need 4 | |
22 | characters for each escape sequence and 16 characters for each entry | |
23 | *) | |
24 | ||
25 | val maxLength = 16 | |
26 | ||
27 | (* number of entries we can fit on a row *) | |
28 | ||
29 | val numEntries = lineLength div maxLength | |
30 | ||
31 | (* convert integer between 0 and 255 to the three character ascii | |
32 | decimal escape sequence for it *) | |
33 | ||
34 | val chr = | |
35 | let val lookup = Array.array(256,"\000") | |
36 | val intToString = fn i => | |
37 | if i>=100 then "\\" ^ (Int.toString i) | |
38 | else if i>=10 then "\\0" ^ (Int.toString i) | |
39 | else "\\00" ^ (Int.toString i) | |
40 | fun loop n = if n=256 then () | |
41 | else (Array.update(lookup,n,intToString n); loop (n+1)) | |
42 | in loop 0; fn i => lookup sub i | |
43 | end | |
44 | ||
45 | val makeStruct = fn {table,name,print,verbose} => | |
46 | let | |
47 | val states = numStates table | |
48 | val rules = numRules table | |
49 | fun printPairList (prEntry : 'a * 'b -> unit) l = | |
50 | let fun f (EMPTY,_) = () | |
51 | | f (PAIR(a,b,r),count) = | |
52 | if count >= numEntries then | |
53 | (print "\\\n\\"; prEntry(a,b); f(r,1)) | |
54 | else (prEntry(a,b); f(r,(count+1))) | |
55 | in f(l,0) | |
56 | end | |
57 | val printList : ('a -> unit) -> 'a list -> unit = | |
58 | fn prEntry => fn l => | |
59 | let fun f (nil,_) = () | |
60 | | f (a :: r,count) = | |
61 | if count >= numEntries then | |
62 | (print "\\\n\\"; prEntry a; f(r,1)) | |
63 | else (prEntry a; f(r,count+1)) | |
64 | in f(l,0) | |
65 | end | |
66 | val prEnd = fn _ => print "\\000\\000\\\n\\" | |
67 | fun printPairRow prEntry = | |
68 | let val printEntries = printPairList prEntry | |
69 | in fn l => (printEntries l; prEnd()) | |
70 | end | |
71 | fun printPairRowWithDefault (prEntry,prDefault) = | |
72 | let val f = printPairRow prEntry | |
73 | in fn (l,default) => (prDefault default; f l) | |
74 | end | |
75 | fun printTable (printRow,count) = | |
76 | (print "\"\\\n\\"; | |
77 | let fun f i = if i=count then () | |
78 | else (printRow i; f (i+1)) | |
79 | in f 0 | |
80 | end; | |
81 | print"\"\n") | |
82 | val printChar = print o chr | |
83 | ||
84 | (* print an integer between 0 and 2^16-1 as a 2-byte character, | |
85 | with the low byte first *) | |
86 | ||
87 | val printInt = fn i => (printChar (i mod 256); | |
88 | printChar (i div 256)) | |
89 | ||
90 | (* encode actions as integers: | |
91 | ||
92 | ACCEPT => 0 | |
93 | ERROR => 1 | |
94 | SHIFT i => 2 + i | |
95 | REDUCE rulenum => numstates+2+rulenum | |
96 | *) | |
97 | ||
98 | val printAction = | |
99 | fn (REDUCE rulenum) => printInt (rulenum+states+2) | |
100 | | (SHIFT (STATE i)) => printInt (i+2) | |
101 | | ACCEPT => printInt 0 | |
102 | | ERROR => printInt 1 | |
103 | ||
104 | val printTermAction = fn (T t,action) => | |
105 | (printInt (t+1); printAction action) | |
106 | ||
107 | val printGoto = fn (NT n,STATE s) => (printInt (n+1); printInt s) | |
108 | ||
109 | val ((rowCount,rowNumbers,actionRows),entries)= | |
110 | shrinkActionList(table,verbose) | |
111 | val getActionRow = let val a = Array.fromList actionRows | |
112 | in fn i => a sub i | |
113 | end | |
114 | val printGotoRow : int -> unit = | |
115 | let val f = printPairRow printGoto | |
116 | val g = describeGoto table | |
117 | in fn i => f (g (STATE i)) | |
118 | end | |
119 | val printActionRow = | |
120 | let val f = printPairRowWithDefault(printTermAction,printAction) | |
121 | in fn i => f (getActionRow i) | |
122 | end | |
123 | in print "val "; | |
124 | print name; | |
125 | print "="; | |
126 | print "let val actionRows =\n"; | |
127 | printTable(printActionRow,rowCount); | |
128 | print "val actionRowNumbers =\n\""; | |
129 | printList (fn i => printInt i) rowNumbers; | |
130 | print "\"\n"; | |
131 | print "val gotoT =\n"; | |
132 | printTable(printGotoRow,states); | |
133 | print "val numstates = "; | |
134 | print (Int.toString states); | |
135 | print "\nval numrules = "; | |
136 | print (Int.toString rules); | |
137 | print "\n\ | |
138 | \val s = ref \"\" and index = ref 0\n\ | |
139 | \val string_to_int = fn () => \n\ | |
140 | \let val i = !index\n\ | |
141 | \in index := i+2; Char.ord(String.sub(!s,i)) + Char.ord(String.sub(!s,i+1)) * 256\n\ | |
142 | \end\n\ | |
143 | \val string_to_list = fn s' =>\n\ | |
144 | \ let val len = String.size s'\n\ | |
145 | \ fun f () =\n\ | |
146 | \ if !index < len then string_to_int() :: f()\n\ | |
147 | \ else nil\n\ | |
148 | \ in index := 0; s := s'; f ()\n\ | |
149 | \ end\n\ | |
150 | \val string_to_pairlist = fn (conv_key,conv_entry) =>\n\ | |
151 | \ let fun f () =\n\ | |
152 | \ case string_to_int()\n\ | |
153 | \ of 0 => EMPTY\n\ | |
154 | \ | n => PAIR(conv_key (n-1),conv_entry (string_to_int()),f())\n\ | |
155 | \ in f\n\ | |
156 | \ end\n\ | |
157 | \val string_to_pairlist_default = fn (conv_key,conv_entry) =>\n\ | |
158 | \ let val conv_row = string_to_pairlist(conv_key,conv_entry)\n\ | |
159 | \ in fn () =>\n\ | |
160 | \ let val default = conv_entry(string_to_int())\n\ | |
161 | \ val row = conv_row()\n\ | |
162 | \ in (row,default)\n\ | |
163 | \ end\n\ | |
164 | \ end\n\ | |
165 | \val string_to_table = fn (convert_row,s') =>\n\ | |
166 | \ let val len = String.size s'\n\ | |
167 | \ fun f ()=\n\ | |
168 | \ if !index < len then convert_row() :: f()\n\ | |
169 | \ else nil\n\ | |
170 | \ in (s := s'; index := 0; f ())\n\ | |
171 | \ end\n\ | |
172 | \local\n\ | |
173 | \ val memo = Array.array(numstates+numrules,ERROR)\n\ | |
174 | \ val _ =let fun g i=(Array.update(memo,i,REDUCE(i-numstates)); g(i+1))\n\ | |
175 | \ fun f i =\n\ | |
176 | \ if i=numstates then g i\n\ | |
177 | \ else (Array.update(memo,i,SHIFT (STATE i)); f (i+1))\n\ | |
178 | \ in f 0 handle General.Subscript => ()\n\ | |
179 | \ end\n\ | |
180 | \in\n\ | |
181 | \val entry_to_action = fn 0 => ACCEPT | 1 => ERROR | j => Array.sub(memo,(j-2))\n\ | |
182 | \end\n\ | |
183 | \val gotoT=Array.fromList(string_to_table(string_to_pairlist(NT,STATE),gotoT))\n\ | |
184 | \val actionRows=string_to_table(string_to_pairlist_default(T,entry_to_action),actionRows)\n\ | |
185 | \val actionRowNumbers = string_to_list actionRowNumbers\n\ | |
186 | \val actionT = let val actionRowLookUp=\n\ | |
187 | \let val a=Array.fromList(actionRows) in fn i=>Array.sub(a,i) end\n\ | |
188 | \in Array.fromList(List.map actionRowLookUp actionRowNumbers)\n\ | |
189 | \end\n\ | |
190 | \in LrTable.mkLrTable {actions=actionT,gotos=gotoT,numRules=numrules,\n\ | |
191 | \numStates=numstates,initialState=STATE "; | |
192 | print (Int.toString ((fn (STATE i) => i) (initialState table))); | |
193 | print "}\nend\n"; | |
194 | entries | |
195 | end | |
196 | end; |