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