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