File ‹tools/mlyacc/src/grammar.ML›

(* SPDX-License-Identifier: SMLNJ *)
(* SPDX-FileCopyrightText: 1989 Andrew W. Appel, David R. Tarditi *)

(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
 *
 * $Log$
 * Revision 1.1  2006/06/22 07:40:27  michaeln
 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources
 * as the base.
 *
 * Revision 1.1.1.1  1997/01/14 01:38:05  george
 *   Version 109.24
 *
 * Revision 1.2  1996/02/26  15:02:33  george
 *    print no longer overloaded.
 *    use of makestring has been removed and replaced with Int.toString ..
 *    use of IO replaced with TextIO
 *
 * Revision 1.1.1.1  1996/01/31  16:01:45  george
 * Version 109
 *
 *)

structure Grammar : GRAMMAR =
        struct

                (* define types term and nonterm using those in LrTable
                   datatype term = T of int
                   datatype nonterm = NT of int *)

                open LrTable
                datatype symbol = TERM of term | NONTERM of nonterm
                datatype grammar = GRAMMAR of
                                {rules: {lhs: nonterm,
                                          rhs: symbol list,
                                          precedence: int option,
                                          rulenum: int} list,
                                noshift : term list,
                                eop : term list,
                                terms: int,
                                nonterms: int,
                                start : nonterm,
                                precedence : term -> int option,
                                termToString : term -> string,
                                nontermToString : nonterm -> string}
end;

structure IntGrammar : INTGRAMMAR =
        struct
                structure Grammar = Grammar
                open Grammar

                datatype rule = RULE of
                                 {lhs: nonterm,
                                 rhs: symbol list,
                                 num: int,(* internal # assigned by coreutils *)
                                 rulenum: int,
                                 precedence: int option}

                val eqTerm = (op =)
                val gtTerm = fn (T i,T j) => i>j

                val eqNonterm = (op =)
                val gtNonterm = fn (NT i,NT j) => i>j

                val eqSymbol = (op =)
                val gtSymbol = fn (TERM (T i),TERM (T j)) => i>j
                                | (NONTERM (NT i),NONTERM (NT j)) => i>j
                                | (TERM _,NONTERM _) => false
                                | (NONTERM _,TERM _) => true


                structure SymbolAssoc = Table(type key = symbol
                                              val gt = gtSymbol)

                structure NontermAssoc = Table(type key =  nonterm
                                               val gt = gtNonterm)

                val DEBUG = false

                val prRule = fn (a as symbolToString,nontermToString,print) =>
                   let val printSymbol = print o symbolToString
                       fun printRhs (h::t) = (printSymbol h; print " ";
                                              printRhs t)
                         | printRhs nil = ()
                   in fn (RULE {lhs,rhs,num,rulenum,precedence,...}) =>
                        ((print o nontermToString) lhs; print " : ";
                         printRhs rhs;
                         if DEBUG then (print " num = ";
                                        print (Int.toString num);
                                        print " rulenum = ";
                                        print (Int.toString rulenum);
                                        print " precedence = ";
                                        case precedence
                                            of NONE => print " none"
                                             | (SOME i) =>
                                                 print (Int.toString i);
                                        ())
                        else ())
                   end

                val prGrammar =
                         fn (a as (symbolToString,nontermToString,print)) =>
                             fn (GRAMMAR {rules,terms,nonterms,start,...}) =>
                 let val printRule =
                        let val prRule = prRule a
                        in  fn {lhs,rhs,precedence,rulenum} =>
                                (prRule (RULE {lhs=lhs,rhs=rhs,num=0,
                                      rulenum=rulenum, precedence=precedence});
                              print "\n")
                        end
                 in print "grammar = \n";
                    List.app printRule rules;
                    print "\n";
                    print (" terms = " ^ (Int.toString terms) ^
                             " nonterms = " ^ (Int.toString nonterms) ^
                             " start = ");
                    (print o nontermToString) start;
                    ()
                 end
        end;