mlyacc/src/mkprstruct.sml

   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;