1(*
2 * @TAG(OTHER_PRINCETON_OSS)
3 *)
4(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
5 *
6 * $Log$
7 * Revision 1.1  2006/06/22 07:40:27  michaeln
8 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources
9 * as the base.
10 *
11 * Revision 1.1.1.1  1997/01/14 01:38:05  george
12 *   Version 109.24
13 *
14 * Revision 1.2  1996/02/26  15:02:31  george
15 *    print no longer overloaded.
16 *    use of makestring has been removed and replaced with Int.toString ..
17 *    use of IO replaced with TextIO
18 *
19 * Revision 1.1.1.1  1996/01/31  16:01:44  george
20 * Version 109
21 *
22 *)
23
24functor mkCore(structure IntGrammar : INTGRAMMAR) : CORE =
25        struct
26                open IntGrammar
27                open  Grammar
28                structure IntGrammar = IntGrammar
29                structure Grammar = Grammar
30
31                datatype item = ITEM of
32                                { rule : rule,
33                                  dot : int,
34                                  rhsAfter : symbol list
35                                }
36
37                val eqItem = fn (ITEM{rule=RULE{num=n,...},dot=d,...},
38                                 ITEM{rule=RULE{num=m,...},dot=e,...}) =>
39                                        n=m andalso d=e
40
41                val gtItem =  fn (ITEM{rule=RULE{num=n,...},dot=d,...},
42                                  ITEM{rule=RULE{num=m,...},dot=e,...}) =>
43                                        n>m orelse (n=m andalso d>e)
44
45                structure ItemList = ListOrdSet
46                        (struct
47                                type elem = item
48                                val eq = eqItem
49                                val gt = gtItem
50                        end)
51
52                open ItemList
53                datatype core = CORE of item list * int
54
55                val gtCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_gt(a,b)
56                val eqCore = fn (CORE (a,_),CORE (b,_)) => ItemList.set_eq(a,b)
57
58                (* functions for printing and debugging *)
59
60                 val prItem = fn (symbolToString,nontermToString,print) =>
61                   let val printInt = print o (Int.toString : int -> string)
62                       val prSymbol = print o symbolToString
63                       val prNonterm = print o nontermToString
64                       fun showRest nil = ()
65                         | showRest (h::t) = (prSymbol h; print " "; showRest t)
66                       fun showRhs (l,0) = (print ". "; showRest l)
67                         | showRhs (nil,_) = ()
68                         | showRhs (h::t,n) = (prSymbol h;
69                                               print " ";
70                                               showRhs(t,n-1))
71                   in fn (ITEM {rule=RULE {lhs,rhs,rulenum,num,...},
72                                dot,rhsAfter,...}) =>
73                        (prNonterm lhs; print " : "; showRhs(rhs,dot);
74                          case rhsAfter
75                         of nil => (print " (reduce by rule ";
76                                    printInt rulenum;
77                                    print ")")
78                          | _ => ();
79                          if DEBUG then
80                             (print " (num "; printInt num; print ")")
81                          else ())
82                   end
83
84                 val prCore = fn a as (_,_,print) =>
85                    let val prItem = prItem a
86                    in fn (CORE (items,state)) =>
87                          (print "state ";
88                           print (Int.toString state);
89                              print ":\n\n";
90                              app (fn i => (print "\t";
91                                         prItem i; print "\n")) items;
92                           print "\n")
93                    end
94end;
95