1(* Modified by sweeks@acm.org on 2000-8-24.
2 * Ported to MLton.
3 *)
4type int = Int.int
5
6(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
7 *
8 * $Log$
9 * Revision 1.1  2006/06/23 03:21:27  michaeln
10 * Changed the names of the files in mlyacclib because I want these files
11 * to move into sigobj, and I don't want name-clashes, particularly with
12 * names like stream.sml.  (If you use a parser generated by mlyacc, then
13 * you need to have the files in mlyacclib available too.)
14 *
15 * Revision 1.1  2006/06/22 07:40:27  michaeln
16 * Add a MoscowML compilable implementation of MLyacc, using the MLton sources
17 * as the base.
18 *
19 * Revision 1.1.1.1  1997/01/14 01:38:04  george
20 *   Version 109.24
21 *
22 * Revision 1.1.1.1  1996/01/31  16:01:42  george
23 * Version 109
24 *
25 *)
26
27structure LrTable : LR_TABLE =
28    struct
29	open Array List
30	infix 9 sub
31	datatype ('a,'b) pairlist = EMPTY
32				  | PAIR of 'a * 'b * ('a,'b) pairlist
33	datatype term = T of int
34	datatype nonterm = NT of int
35	datatype state = STATE of int
36	datatype action = SHIFT of state
37			| REDUCE of int (* rulenum from grammar *)
38			| ACCEPT
39			| ERROR
40	exception Goto of state * nonterm
41	type table = {states: int, rules : int,initialState: state,
42		      action: ((term,action) pairlist * action) array,
43		      goto :  (nonterm,state) pairlist array}
44	val numStates = fn ({states,...} : table) => states
45	val numRules = fn ({rules,...} : table) => rules
46	val describeActions =
47	   fn ({action,...} : table) =>
48	           fn (STATE s) => action sub s
49	val describeGoto =
50	   fn ({goto,...} : table) =>
51	           fn (STATE s) => goto sub s
52	fun findTerm (T term,row,default) =
53	    let fun find (PAIR (T key,data,r)) =
54		       if key < term then find r
55		       else if key=term then data
56		       else default
57		   | find EMPTY = default
58	    in find row
59	    end
60	fun findNonterm (NT nt,row) =
61	    let fun find (PAIR (NT key,data,r)) =
62		       if key < nt then find r
63		       else if key=nt then SOME data
64		       else NONE
65		   | find EMPTY = NONE
66	    in find row
67	    end
68	val action = fn ({action,...} : table) =>
69		fn (STATE state,term) =>
70		  let val (row,default) = action sub state
71		  in findTerm(term,row,default)
72		  end
73	val goto = fn ({goto,...} : table) =>
74			fn (a as (STATE state,nonterm)) =>
75			  case findNonterm(nonterm,goto sub state)
76			  of SOME state => state
77			   | NONE => raise (Goto a)
78	val initialState = fn ({initialState,...} : table) => initialState
79	val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
80	     ({action=actions,goto=gotos,
81	       states=numStates,
82	       rules=numRules,
83               initialState=initialState} : table)
84end;
85