File ‹tools/mlyacc/mlyacclib/MLY_lrtable.ML›

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

(* Modified by sweeks@acm.org on 2000-8-24.
 * Ported to MLton.
 *)
type int = Int.int

(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi
 *
 * $Log$
 * Revision 1.1  2006/06/23 03:21:27  michaeln
 * Changed the names of the files in mlyacclib because I want these files
 * to move into sigobj, and I don't want name-clashes, particularly with
 * names like stream.sml.  (If you use a parser generated by mlyacc, then
 * you need to have the files in mlyacclib available too.)
 *
 * 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:04  george
 *   Version 109.24
 *
 * Revision 1.1.1.1  1996/01/31  16:01:42  george
 * Version 109
 *
 *)

structure LrTable : LR_TABLE =
    struct
        open Array List
        infix 9 sub
        datatype ('a,'b) pairlist = EMPTY
                                  | PAIR of 'a * 'b * ('a,'b) pairlist
        datatype term = T of int
        datatype nonterm = NT of int
        datatype state = STATE of int
        datatype action = SHIFT of state
                        | REDUCE of int (* rulenum from grammar *)
                        | ACCEPT
                        | ERROR
        exception Goto of state * nonterm
        type table = {states: int, rules : int,initialState: state,
                      action: ((term,action) pairlist * action) array,
                      goto :  (nonterm,state) pairlist array}
        val numStates = fn ({states,...} : table) => states
        val numRules = fn ({rules,...} : table) => rules
        val describeActions =
           fn ({action,...} : table) =>
                   fn (STATE s) => action sub s
        val describeGoto =
           fn ({goto,...} : table) =>
                   fn (STATE s) => goto sub s
        fun findTerm (T term,row,default) =
            let fun find (PAIR (T key,data,r)) =
                       if key < term then find r
                       else if key=term then data
                       else default
                   | find EMPTY = default
            in find row
            end
        fun findNonterm (NT nt,row) =
            let fun find (PAIR (NT key,data,r)) =
                       if key < nt then find r
                       else if key=nt then SOME data
                       else NONE
                   | find EMPTY = NONE
            in find row
            end
        val action = fn ({action,...} : table) =>
                fn (STATE state,term) =>
                  let val (row,default) = action sub state
                  in findTerm(term,row,default)
                  end
        val goto = fn ({goto,...} : table) =>
                        fn (a as (STATE state,nonterm)) =>
                          case findNonterm(nonterm,goto sub state)
                          of SOME state => state
                           | NONE => raise (Goto a)
        val initialState = fn ({initialState,...} : table) => initialState
        val mkLrTable = fn {actions,gotos,initialState,numStates,numRules} =>
             ({action=actions,goto=gotos,
               states=numStates,
               rules=numRules,
               initialState=initialState} : table)
end;