mlyacc/src/grammar.sml

   1 (* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi *)
   2
   3 structure Grammar : GRAMMAR =
   4         struct
   5
   6                 (* define types term and nonterm using those in LrTable
   7                    datatype term = T of int
   8                    datatype nonterm = NT of int *)
   9
  10                 open LrTable
  11                 datatype symbol = TERM of term | NONTERM of nonterm
  12                 datatype grammar = GRAMMAR of
  13                                 {rules: {lhs: nonterm,
  14                                          rhs: symbol list,
  15                                          precedence: int option,
  16                                          rulenum: int} list,
  17                                 noshift : term list,
  18                                 eop : term list,
  19                                 terms: int,
  20                                 nonterms: int,
  21                                 start : nonterm,
  22                                 precedence : term -> int option,
  23                                 termToString : term -> string,
  24                                 nontermToString : nonterm -> string}
  25 end;
  26
  27 structure IntGrammar : INTGRAMMAR =
  28         struct
  29                 structure Grammar = Grammar
  30                 open Grammar
  31
  32                 datatype rule = RULE of
  33                                 {lhs: nonterm,
  34                                  rhs: symbol list,
  35                                  num: int,(* internal # assigned by coreutils *)
  36                                  rulenum: int,
  37                                  precedence: int option}
  38
  39                 val eqTerm : term * term -> bool = (op =)
  40                 val gtTerm : term * term -> bool = fn (T i,T j) => i>j
  41
  42                 val eqNonterm : nonterm * nonterm -> bool = (op =)
  43                 val gtNonterm : nonterm * nonterm -> bool =
  44                     fn (NT i,NT j) => i>j
  45
  46                 val eqSymbol : symbol * symbol -> bool = (op =)
  47                 val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j
  48                                 | (NONTERM (NT i),NONTERM (NT j)) => i>j
  49                                 | (TERM _,NONTERM _) => false
  50                                 | (NONTERM _,TERM _) => true
  51
  52
  53                 structure SymbolAssoc = Table(type key = symbol
  54                                               val gt = gtSymbol)
  55
  56                 structure NontermAssoc = Table(type key =  nonterm
  57                                                val gt = gtNonterm)
  58
  59                 val DEBUG = false
  60
  61                 val prRule = fn (a as symbolToString,nontermToString,print) =>
  62                    let val printSymbol = print o symbolToString
  63                        fun printRhs (h::t) = (printSymbol h; print " ";
  64                                               printRhs t)
  65                          | printRhs nil = ()
  66                    in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) =>
  67                         ((print o nontermToString) lhs; print " : ";
  68                          printRhs rhs;
  69                          if DEBUG then (print " num = ";
  70                                         print (Int.toString num);
  71                                         print " rulenum = ";
  72                                         print (Int.toString rulenum);
  73                                         print " precedence = ";
  74                                         case precedence
  75                                             of NONE => print " none"
  76                                              | (SOME i) =>
  77                                                  print (Int.toString i);
  78                                         ())
  79                         else ())
  80                    end
  81
  82                 val prGrammar =
  83                          fn (a as (symbolToString,nontermToString,print)) =>
  84                              fn (GRAMMAR {rules,terms,nonterms,start,...}) =>
  85                  let val printRule =
  86                         let val prRule = prRule a
  87                         in  fn {lhs,rhs,precedence,rulenum} =>
  88                              (prRule (RULE {lhs=lhs,rhs=rhs,num=0,
  89                                       rulenum=rulenum, precedence=precedence});
  90                               print "\n")
  91                         end
  92                  in print "grammar = \n";
  93                     List.app printRule rules;
  94                     print "\n";
  95                     print (" terms = " ^ (Int.toString terms) ^
  96                              " nonterms = " ^ (Int.toString nonterms) ^
  97                              " start = ");
  98                     (print o nontermToString) start;
  99                     ()
 100                  end
 101         end;