Segmentation fault when trying to use mllex and mlyacc, sml sourc e

Roland Olsson rolsson@cs.chalmers.se
Tue, 14 Dec 1999 04:49:03 -0800


This message is in MIME format. Since your mail reader does not understand
this format, some or all of this message may not be legible.

------_=_NextPart_000_01BF4636.F6376BCE
Content-Type: text/plain;
	charset="windows-1252"





------_=_NextPart_000_01BF4636.F6376BCE
Content-Type: TEXT/PLAIN;
	name="main.sml"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="main.sml"
Content-Description: SML source code
Content-ID: <Pine.SOL.4.10.9912141349030.24367@muppet1.cs.chalmers.se>


structure Word31 =3D Word structure Int31 =3D Int
(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi=20
 *
 * $Log: base.sig, v $
 * 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
 *=20
 *)

(* base.sig: Base signature file for SML-Yacc.  This file contains =
signatures
   that must be loaded before any of the files produced by ML-Yacc are =
loaded
*)

(* STREAM: signature for a lazy stream.*)

signature STREAM =3D
 sig type 'xa stream
     val streamify: (unit -> 'a) -> 'a stream
     val cons: 'a * 'a stream -> 'a stream
     val get: 'a stream -> 'a * 'a stream
 end

(* LR_TABLE: signature for an LR Table.

   The list of actions and gotos passed to mkLrTable must be ordered by =
state
   number. The values for state 0 are the first in the list, the values =
for
    state 1 are next, etc.
*)

signature LR_TABLE =3D
    sig
        datatype ('a, 'b) pairlist =3D EMPTY | PAIR of 'a * 'b * ('a, =
'b) pairlist
	datatype state =3D STATE of int
	datatype term =3D T of int
	datatype nonterm =3D NT of int
	datatype action =3D SHIFT of state
			| REDUCE of int
			| ACCEPT
			| ERROR
	type table
=09
	val numStates: table -> int
	val numRules: table -> int
	val describeActions: table -> state ->
				(term, action) pairlist * action
	val describeGoto: table -> state -> (nonterm, state) pairlist
	val action: table -> state * term -> action
	val goto: table -> state * nonterm -> state
	val initialState: table -> state
	exception Goto of state * nonterm

	val mkLrTable: {actions: ((term, action) pairlist * action) array,
			 gotos: (nonterm, state) pairlist array,
			 numStates: int, numRules: int,
			 initialState: state} -> table
    end

(* TOKEN: signature revealing the internal structure of a token. This =
signature
   TOKEN distinct from the signature {parser name}_TOKENS produced by =
ML-Yacc.
   The {parser name}_TOKENS structures contain some types and functions =
to
    construct tokens from values and positions.

   The representation of token was very carefully chosen here to allow =
the
   polymorphic parser to work without knowing the types of semantic =
values
   or line numbers.

   This has had an impact on the TOKENS structure produced by SML-Yacc, =
which
   is a structure parameter to lexer functors.  We would like to have =
some
   type 'a token which functions to construct tokens would create.  A
   constructor function for a integer token might be

	  INT: int * 'a * 'a -> 'a token.
=20
   This is not possible because we need to have tokens with the =
representation
   given below for the polymorphic parser.

   Thus our constructur functions for tokens have the form:

	  INT: int * 'a * 'a -> (svalue, 'a) token

   This in turn has had an impact on the signature that lexers for =
SML-Yacc
   must match and the types that a user must declare in the user =
declarations
   section of lexers.
*)

signature TOKEN =3D
    sig
	structure LrTable: LR_TABLE
        datatype ('a, 'b) token =3D TOKEN of LrTable.term * ('a * 'b * =
'b)
	val sameToken: ('a, 'b) token * ('a, 'b) token -> bool
    end

(* LR_PARSER: signature for a polymorphic LR parser *)

signature LR_PARSER =3D
    sig
	structure Stream: STREAM
	structure LrTable: LR_TABLE
	structure Token: TOKEN

	sharing LrTable =3D Token.LrTable

	exception ParseError

	val parse: {table: LrTable.table,
		     lexer: ('b, 'c) Token.token Stream.stream,
		     arg: 'arg,
		     saction: int *
			       'c *
				(LrTable.state * ('b * 'c * 'c)) list *=20
				'arg ->
				     LrTable.nonterm *
				     ('b * 'c * 'c) *
				     ((LrTable.state *('b * 'c * 'c)) list),
		     void: 'b,
		     ec: { is_keyword: LrTable.term -> bool,
			    noShift: LrTable.term -> bool,
			    preferred_change: (LrTable.term list * LrTable.term list) list,
			    errtermvalue: LrTable.term -> 'b,
			    showTerminal: LrTable.term -> string,
			    terms: LrTable.term list,
			    error: string * 'c * 'c -> unit
			   },
		     lookahead: int  (* max amount of lookahead used in *)
				      (* error correction *)
			} -> 'b *
			     (('b, 'c) Token.token Stream.stream)
    end

(* LEXER: a signature that most lexers produced for use with SML-Yacc's
   output will match.  The user is responsible for declaring type =
token,
   type pos, and type svalue in the UserDeclarations section of a =
lexer.

   Note that type token is abstract in the lexer.  This allows SML-Yacc =
to
   create a TOKENS signature for use with lexers produced by ML-Lex =
that
   treats the type token abstractly.  Lexers that are functors =
parametrized by
   a Tokens structure matching a TOKENS signature cannot examine the =
structure
   of tokens.
*)

signature LEXER =3D
   sig
       structure UserDeclarations :
	   sig
	        type ('a, 'b) token
		type pos
		type svalue
	   end
	val makeLexer: (int -> string) -> unit ->=20
         (UserDeclarations.svalue, UserDeclarations.pos) =
UserDeclarations.token
   end

(* ARG_LEXER: the %arg option of ML-Lex allows users to produce lexers =
which
   also take an argument before yielding a function from unit to a =
token
*)

signature ARG_LEXER =3D
   sig
       structure UserDeclarations :
	   sig
	        type ('a, 'b) token
		type pos
		type svalue
		type arg
	   end
	val makeLexer: (int -> string) -> UserDeclarations.arg -> unit ->=20
         (UserDeclarations.svalue, UserDeclarations.pos) =
UserDeclarations.token
   end

(* PARSER_DATA: the signature of ParserData structures in {parser =
name}LrValsFun
   produced by  SML-Yacc.  All such structures match this signature. =20

   The {parser name}LrValsFun produces a structure which contains all =
the values
   except for the lexer needed to call the polymorphic parser mentioned
   before.

*)

signature PARSER_DATA =3D
   sig
        (* the type of line numbers *)

	type pos

	(* the type of semantic values *)

	type svalue

         (* the type of the user-supplied argument to the parser *)
 	type arg
=20
	(* the intended type of the result of the parser.  This value is
	   produced by applying extract from the structure Actions to the
	   final semantic value resultiing from a parse.
	 *)

	type result

	structure LrTable: LR_TABLE
	structure Token: TOKEN
	sharing Token.LrTable =3D LrTable

	(* structure Actions contains the functions which mantain the
	   semantic values stack in the parser.  Void is used to provide
	   a default value for the semantic stack.
	 *)

	structure Actions:=20
	  sig
	      val actions: int * pos *
		   (LrTable.state * (svalue * pos * pos)) list * arg->
		         LrTable.nonterm * (svalue * pos * pos) *
			 ((LrTable.state *(svalue * pos * pos)) list)
	      val void: svalue
	      val extract: svalue -> result
	  end

	(* structure EC contains information used to improve error
	   recovery in an error-correcting parser *)

	structure EC :
	   sig
	     val is_keyword: LrTable.term -> bool
	     val noShift: LrTable.term -> bool
 	     val preferred_change: (LrTable.term list * LrTable.term list) =
list
	     val errtermvalue: LrTable.term -> svalue
	     val showTerminal: LrTable.term -> string
	     val terms: LrTable.term list
	   end

	(* table is the LR table for the parser *)

	val table: LrTable.table
    end

(* signature PARSER is the signature that most user parsers created by=20
   SML-Yacc will match.
*)

signature PARSER =3D
    sig
        structure Token: TOKEN
	structure Stream: STREAM
	exception ParseError

	(* type pos is the type of line numbers *)

	type pos

	(* type result is the type of the result from the parser *)

	type result

         (* the type of the user-supplied argument to the parser *)
 	type arg
=09
	(* type svalue is the type of semantic values for the semantic value
	   stack
	 *)

	type svalue

	(* val makeLexer is used to create a stream of tokens for the parser =
*)

	val makeLexer: (int -> string) ->
			 (svalue, pos) Token.token Stream.stream

	(* val parse takes a stream of tokens and a function to print
	   errors and returns a value of type result and a stream containing
	   the unused tokens
	 *)

	val parse: int * ((svalue, pos) Token.token Stream.stream) *
		    (string * pos * pos -> unit) * arg ->
				result * (svalue, pos) Token.token Stream.stream

	val sameToken: (svalue, pos) Token.token * (svalue, pos) Token.token =
->
				bool
     end

(* signature ARG_PARSER is the signature that will be matched by =
parsers whose
    lexer takes an additional argument.
*)

signature ARG_PARSER =3D=20
    sig
        structure Token: TOKEN
	structure Stream: STREAM
	exception ParseError

	type arg
	type lexarg
	type pos
	type result
	type svalue

	val makeLexer: (int -> string) -> lexarg ->
			 (svalue, pos) Token.token Stream.stream
	val parse: int * ((svalue, pos) Token.token Stream.stream) *
		    (string * pos * pos -> unit) * arg ->
				result * (svalue, pos) Token.token Stream.stream

	val sameToken: (svalue, pos) Token.token * (svalue, pos) Token.token =
->
				bool
     end


(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi=20
 *
 * $Log: lrtable.sml, v $
 * 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
 *=20
 *)

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

(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi=20
 *
 * $Log: stream.sml, v $
 * Revision 1.2  1997/08/26 19:18:55  jhr
 *   Replaced used of "abstraction" with ":>".
 *
# 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:43  george
 * Version 109
 *=20
 *)

(* Stream: a structure implementing a lazy stream.  The signature =
STREAM
   is found in base.sig *)

structure Stream :> STREAM =3D
struct
   datatype 'a str =3D EVAL of 'a * 'a str ref | UNEVAL of (unit->'a)

   type 'a stream =3D 'a str ref

   fun get(ref(EVAL t)) =3D t
     | get(s as ref(UNEVAL f)) =3D=20
	    let val t =3D (f(), ref(UNEVAL f)) in s :=3D EVAL t; t end

   fun streamify f =3D ref(UNEVAL f)
   fun cons(a, s) =3D ref(EVAL(a, s))

end;

(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi=20
 *
 * $Log: parser2.sml, v $
 * Revision 1.2  1997/08/26 19:18:54  jhr
 *   Replaced used of "abstraction" with ":>".
 *
# Revision 1.1.1.1  1997/01/14  01:38:04  george
#   Version 109.24
#
 * Revision 1.3  1996/10/03  03:36:58  jhr
 * Qualified identifiers that are no-longer top-level (quot, rem, min, =
max).
 *
 * Revision 1.2  1996/02/26  15:02:29  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:42  george
 * Version 109
 *=20
 *)

(* parser.sml:  This is a parser driver for LR tables with an =
error-recovery
   routine added to it.  The routine used is described in detail in =
this
   article:

	'A Practical Method for LR and LL Syntactic Error Diagnosis and
	 Recovery', by M. Burke and G. Fisher, ACM Transactions on
	 Programming Langauges and Systems, Vol. 9, No. 2, April 1987,
	 pp. 164-197.

    This program is an implementation is the partial, deferred method =
discussed
    in the article.  The algorithm and data structures used in the =
program
    are described below. =20

    This program assumes that all semantic actions are delayed.  A =
semantic
    action should produce a function from unit -> value instead of =
producing the
    normal value.  The parser returns the semantic value on the top of =
the
    stack when accept is encountered.  The user can deconstruct this =
value
    and apply the unit -> value function in it to get the answer.

    It also assumes that the lexer is a lazy stream.

    Data Structures:
    ----------------
=09
	* The parser:

	   The state stack has the type

		 (state * (semantic value * line # * line #)) list

	   The parser keeps a queue of (state stack * lexer pair).  A lexer =
pair
	 consists of a terminal * value pair and a lexer.  This allows the=20
	 parser to reconstruct the states for terminals to the left of a
	 syntax error, and attempt to make error corrections there.

	   The queue consists of a pair of lists (x, y).  New additions to
	 the queue are cons'ed onto y.  The first element of x is the top
	 of the queue.  If x is nil, then y is reversed and used
	 in place of x.

    Algorithm:
    ----------

	* The steady-state parser: =20

	    This parser keeps the length of the queue of state stacks at
	a steady state by always removing an element from the front when
	another element is placed on the end.

	    It has these arguments:

	   stack: current stack
	   queue: value of the queue
	   lexPair ((terminal, value), lex stream)

	When SHIFT is encountered, the state to shift to and the value are
	are pushed onto the state stack.  The state stack and lexPair are
	placed on the queue.  The front element of the queue is removed.

	When REDUCTION is encountered, the rule is applied to the current
	stack to yield a triple (nonterm, value,new stack).  A new
	stack is formed by adding (goto(top state of stack,nonterm), value)
	to the stack.

	When ACCEPT is encountered, the top value from the stack and the
	lexer are returned.

	When an ERROR is encountered, fixError is called.  FixError
	takes the arguments to the parser, fixes the error if possible and
        returns a new set of arguments.

	* The distance-parser:

	This parser includes an additional argument distance.  It pushes
	elements on the queue until it has parsed distance tokens, or an
	ACCEPT or ERROR occurs.  It returns a stack, lexer, the number of
	tokens left unparsed, a queue, and an action option.
*)

signature FIFO =3D=20
  sig type 'a queue
      val empty: 'a queue
      exception Empty
      val get: 'a queue -> 'a * 'a queue
      val put: 'a * 'a queue -> 'a queue
  end

(* drt (12/15/89) -- the functor should be used in development work, =
but
   it wastes space in the release version.

functor ParserGen(structure LrTable: LR_TABLE
		  structure Stream: STREAM): LR_PARSER =3D
*)

structure LrParser :> LR_PARSER =3D
   struct
      structure LrTable =3D LrTable
      structure Stream =3D Stream

      structure Token: TOKEN =3D
	struct
	    structure LrTable =3D LrTable
	    datatype ('a, 'b) token =3D TOKEN of LrTable.term * ('a * 'b * 'b)
	    val sameToken =3D fn (TOKEN(t, _), TOKEN(t', _)) =3D> t=3Dt'
        end

      open LrTable
      open Token

      val DEBUG1 =3D false
      val DEBUG2 =3D false
      exception ParseError
      exception ParseImpossible of int

      structure Fifo :> FIFO =3D
        struct
	  type 'a queue =3D ('a list * 'a list)
	  val empty =3D (nil,nil)
	  exception Empty
	  fun get(a :: x, y) =3D (a, (x, y))
	    | get(nil, nil) =3D raise Empty
	    | get(nil, y) =3D get(rev y, nil)
 	  fun put(a, (x, y)) =3D (x, a :: y)
        end

      type ('a, 'b) elem =3D (state * ('a * 'b * 'b))
      type ('a, 'b) stack =3D ('a, 'b) elem list
      type ('a, 'b) lexv =3D ('a, 'b) token
      type ('a, 'b) lexpair =3D ('a, 'b) lexv * (('a, 'b) lexv =
Stream.stream)
      type ('a, 'b) distanceParse =3D
		 ('a, 'b) lexpair *
		 ('a, 'b) stack *=20
		 (('a, 'b) stack * ('a, 'b) lexpair) Fifo.queue *
		 int ->
		   ('a, 'b) lexpair *
		   ('a, 'b) stack *=20
		   (('a, 'b) stack * ('a, 'b) lexpair) Fifo.queue *
		   int *
		   action option

      type ('a, 'b) ecRecord =3D
	 {is_keyword: term -> bool,
          preferred_change: (term list * term list) list,
	  error: string * 'b * 'b -> unit,
	  errtermvalue: term -> 'a,
	  terms: term list,
	  showTerminal: term -> string,
	  noShift: term -> bool}

      local=20
	 val print =3D fn s =3D> TextIO.output(TextIO.stdOut, s)
	 val println =3D fn s =3D> (print s; print "\n")
	 val showState =3D fn (STATE s) =3D> "STATE " ^ (Int.toString s)
      in
        fun printStack(stack: ('a, 'b) stack, n: int) =3D
         case stack
           of (state, _) :: rest =3D>
                 (print("\t" ^ Int.toString n ^ ": ");
                  println(showState state);
                  printStack(rest, n+1))
            | nil =3D> ()
               =20
        fun prAction showTerminal
		 (stack as (state, _) :: _, next as (TOKEN (term, _), _), action) =3D
             (println "Parse: state stack:";
              printStack(stack, 0);
              print("       state=3D"
                         ^ showState state=09
                         ^ " next=3D"
                         ^ showTerminal term
                         ^ " action=3D"
                        );
              case action
                of SHIFT state =3D> println ("SHIFT " ^ (showState =
state))
                 | REDUCE i =3D> println ("REDUCE " ^ (Int.toString i))
                 | ERROR =3D> println "ERROR"
		 | ACCEPT =3D> println "ACCEPT")
        | prAction _ (_, _, action) =3D ()
     end

    (* ssParse: parser which maintains the queue of (state * lexvalues) =
in a
	steady-state.  It takes a table, showTerminal function, saction
	function, and fixError function.  It parses until an ACCEPT is
	encountered, or an exception is raised.  When an error is encountered,
	fixError is called with the arguments of parseStep (lexv, stack, and
	queue).  It returns the lexv, and a new stack and queue adjusted so
	that the lexv can be parsed *)
=09
    val ssParse =3D
      fn (table, showTerminal, saction, fixError, arg) =3D>
	let val prAction =3D prAction showTerminal
	    val action =3D LrTable.action table
	    val goto =3D LrTable.goto table
	    fun parseStep(args as
			 (lexPair as (TOKEN (terminal, value as (_, leftPos, _)),
				      lexer
				      ),
			  stack as (state, _) :: _,
			  queue)) =3D
	      let val nextAction =3D action (state, terminal)
	          val _ =3D if DEBUG1 then prAction(stack, lexPair,nextAction)
			  else ()
	      in case nextAction
		 of SHIFT s =3D>
		  let val newStack =3D (s, value) :: stack
		      val newLexPair =3D Stream.get lexer
		      val (_,newQueue) =3DFifo.get(Fifo.put((newStack,newLexPair),
							    queue))
		  in parseStep(newLexPair, (s, value) :: stack,newQueue)
		  end
		 | REDUCE i =3D>
		     (case saction(i, leftPos, stack, arg)
		      of (nonterm, value, stack as (state, _) :: _) =3D>
		          parseStep(lexPair, (goto(state,nonterm), value) :: stack,
				    queue)
		       | _ =3D> raise (ParseImpossible 197))
		 | ERROR =3D> parseStep(fixError args)
		 | ACCEPT =3D>=20
			(case stack
			 of (_, (topvalue, _, _)) :: _ =3D>
				let val (token, restLexer) =3D lexPair
				in (topvalue, Stream.cons(token, restLexer))
				end
			  | _ =3D> raise (ParseImpossible 202))
	      end
	    | parseStep _ =3D raise (ParseImpossible 204)
	in parseStep
	end

    (*  distanceParse: parse until n tokens are shifted, or accept or
	error are encountered.  Takes a table, showTerminal function, and
	semantic action function.  Returns a parser which takes a lexPair
	(lex result * lexer), a state stack, a queue, and a distance
	(must be > 0) to parse.  The parser returns a new lex-value, a stack
	with the nth token shifted on top, a queue, a distance, and action
	option. *)

    val distanceParse =3D
      fn (table, showTerminal, saction, arg) =3D>
	let val prAction =3D prAction showTerminal
	    val action =3D LrTable.action table
	    val goto =3D LrTable.goto table
	    fun parseStep(lexPair, stack, queue, 0) =3D (lexPair, stack, =
queue, 0, NONE)
	      | parseStep(lexPair as (TOKEN (terminal, value as (_, leftPos, =
_)),
				      lexer
				     ),
			  stack as (state, _) :: _,
			  queue, distance) =3D
	      let val nextAction =3D action(state, terminal)
	          val _ =3D if DEBUG1 then prAction(stack, lexPair,nextAction)
			  else ()
	      in case nextAction
		 of SHIFT s =3D>
		  let val newStack =3D (s, value) :: stack
		      val newLexPair =3D Stream.get lexer
		  in parseStep(newLexPair, (s, value) :: stack,
			       Fifo.put((newStack,newLexPair), queue), distance-1)
		  end
		 | REDUCE i =3D>
		    (case saction(i, leftPos, stack, arg)
		      of (nonterm, value, stack as (state, _) :: _) =3D>
		         parseStep(lexPair, (goto(state,nonterm), value) :: stack,
				 queue, distance)
		      | _ =3D> raise (ParseImpossible 240))
		 | ERROR =3D> (lexPair, stack, queue, distance, SOME nextAction)
		 | ACCEPT =3D> (lexPair, stack, queue, distance, SOME nextAction)
	      end
	   | parseStep _ =3D raise (ParseImpossible 242)
	in parseStep: ('a, 'b) distanceParse=20
	end

(* mkFixError: function to create fixError function which adjusts =
parser state
   so that parse may continue in the presence of an error *)

fun mkFixError({is_keyword, terms, errtermvalue,
	      preferred_change,noShift,
	      showTerminal, error, ...}: ('a, 'b) ecRecord,
	     distanceParse: ('a, 'b) distanceParse,
	     minAdvance, maxAdvance)=20

            (lexv as (TOKEN (term, value as (_, leftPos, _)), _), =
stack, queue) =3D
    let val _ =3D if DEBUG2 then
			error("syntax error found at " ^ (showTerminal term),
			      leftPos, leftPos)
		else ()

        fun tokAt(t, p) =3D TOKEN(t, (errtermvalue t, p, p))

	val minDelta =3D 3

	(* pull all the state * lexv elements from the queue *)

	val stateList =3D=20
	   let fun f q =3D let val (elem,newQueue) =3D Fifo.get q
			 in elem :: (f newQueue)
			 end handle Fifo.Empty =3D> nil
	   in f queue
	   end

	(* now number elements of stateList, giving distance from
	   error token *)

	val (_, numStateList) =3D
	      List.foldr (fn (a, (num, r)) =3D> (num+1, (a,num) :: r)) (0, []) =
stateList

	(* Represent the set of potential changes as a linked list.

	   Values of datatype Change hold information about a potential =
change.

	   oper =3D oper to be applied
	   pos =3D the # of the element in stateList that would be altered.
	   distance =3D the number of tokens beyond the error token which the
	     change allows us to parse.
	   new =3D new terminal * value pair at that point
	   orig =3D original terminal * value pair at the point being changed.
	 *)

	datatype ('a, 'b) change =3D CHANGE of
	   {pos: int, distance: int, leftPos: 'b, rightPos: 'b,
	    new: ('a, 'b) lexv list, orig: ('a, 'b) lexv list}


         val showTerms =3D concat o map (fn TOKEN(t, _) =3D> " " ^ =
showTerminal t)

	 val printChange =3D fn c =3D>
	  let val CHANGE {distance,new, orig, pos, ...} =3D c
	  in (print ("{distance=3D " ^ (Int.toString distance));
	      print (", orig =3D"); print(showTerms orig);
	      print (",new =3D"); print(showTerms new);
	      print (", pos=3D " ^ (Int.toString pos));
	      print "}\n")
	  end

	val printChangeList =3D app printChange

(* parse: given a lexPair, a stack, and the distance from the error
   token, return the distance past the error token that we are able to =
parse.*)

	fun parse (lexPair, stack, queuePos: int) =3D
	    case distanceParse(lexPair, stack, Fifo.empty, =
queuePos+maxAdvance+1)
             of (_, _, _, distance, SOME ACCEPT) =3D>=20
		        if maxAdvance-distance-1 >=3D 0=20
			    then maxAdvance=20
			    else maxAdvance-distance-1
	      | (_, _, _, distance, _) =3D> maxAdvance - distance - 1

(* catList: concatenate results of scanning list *)

	fun catList l f =3D List.foldr (fn(a, r)=3D> f a @ r) [] l

        fun keywordsDelta new =3D if List.exists (fn(TOKEN(t, =
_))=3D>is_keyword t) new
	               then minDelta else 0

        fun tryChange{lex, stack, pos, leftPos, rightPos, orig,new} =3D
	     let val lex' =3D List.foldr (fn (t', p)=3D>(t', Stream.cons p)) =
lex new
		 val distance =3D parse(lex', stack, pos+length new-length orig)
	      in if distance >=3D minAdvance + keywordsDelta new=20
		   then [CHANGE{pos=3Dpos, leftPos=3DleftPos, rightPos=3DrightPos,
				distance=3Ddistance, orig=3Dorig,new=3Dnew}]=20
		   else []
	     end


(* tryDelete: Try to delete n terminals.
              Return single-element [success] or nil.
	      Do not delete unshiftable terminals. *)


    fun tryDelete n ((stack, lexPair as (TOKEN(term, (_, l, r)), _)), =
qPos) =3D
	let fun del(0, accum, left, right, lexPair) =3D
	          tryChange{lex=3DlexPair, stack=3Dstack,
			    pos=3DqPos, leftPos=3Dleft, rightPos=3Dright,
			    orig=3Drev accum, new=3D[]}
	      | del(n, accum, left, right, (tok as TOKEN(term, (_, _, r)), =
lexer)) =3D
		   if noShift term then []
		   else del(n-1, tok :: accum, left, r, Stream.get lexer)
         in del(n, [], l, r, lexPair)
        end

(* tryInsert: try to insert tokens before the current terminal;
       return a list of the successes  *)

        fun tryInsert((stack, lexPair as (TOKEN(_, (_, l, _)), _)), =
queuePos) =3D
	       catList terms (fn t =3D>
		 tryChange{lex=3DlexPair, stack=3Dstack,
			   pos=3DqueuePos, orig=3D[],new=3D[tokAt(t, l)],
			   leftPos=3Dl, rightPos=3Dl})
			     =20
(* trySubst: try to substitute tokens for the current terminal;
       return a list of the successes  *)

        fun trySubst ((stack, lexPair as (orig as TOKEN (term, (_, l, =
r)), lexer)),
		      queuePos) =3D
	      if noShift term then []
	      else
		  catList terms (fn t =3D>
		      tryChange{lex=3DStream.get lexer, stack=3Dstack,
				pos=3DqueuePos,
				leftPos=3Dl, rightPos=3Dr, orig=3D[orig],
				new=3D[tokAt(t, r)]})

     (* do_delete(toks, lexPair) tries to delete tokens "toks" from =
"lexPair".
         If it succeeds, returns SOME(toks', l, r, lp), where
	     toks' is the actual tokens (with positions and values) deleted,
	     (l, r) are the (leftmost, rightmost) position of toks',=20
	     lp is what remains of the stream after deletion=20
     *)
        fun do_delete(nil, lp as (TOKEN(_, (_, l, _)), _)) =3D =
SOME(nil, l, l, lp)
          | do_delete([t], (tok as TOKEN(t', (_, l, r)), lp')) =3D
	       if t=3Dt'
		   then SOME([tok], l, r, Stream.get lp')
                   else NONE
          | do_delete(t :: rest, (tok as TOKEN(t', (_, l, r)), lp')) =
=3D
	       if t=3Dt'
		   then case do_delete(rest, Stream.get lp')
                         of SOME(deleted, l', r', lp'') =3D>
			       SOME(tok :: deleted, l, r', lp'')
			  | NONE =3D> NONE
		   else NONE
			    =20
        fun tryPreferred((stack, lexPair), queuePos) =3D
	    catList preferred_change (fn (delete, insert) =3D>
	       if List.exists noShift delete then [] (* should give warning at
						 parser-generation time *)
               else case do_delete(delete, lexPair)
                     of SOME(deleted, l, r, lp) =3D>=20
			    tryChange{lex=3Dlp, stack=3Dstack, pos=3DqueuePos,
				      leftPos=3Dl, rightPos=3Dr, orig=3Ddeleted,
				      new=3Dmap (fn t=3D>(tokAt(t, r))) insert}
		      | NONE =3D> [])

	val changes =3D catList numStateList tryPreferred @
	                catList numStateList tryInsert @
			  catList numStateList trySubst @
			    catList numStateList (tryDelete 1) @
			      catList numStateList (tryDelete 2) @
			        catList numStateList (tryDelete 3)

	val findMaxDist =3D fn l =3D>=20
	  foldr (fn (CHANGE {distance, ...}, high) =3D> Int.max(distance, =
high)) 0 l

(* maxDist: max distance past error taken that we could parse *)

	val maxDist =3D findMaxDist changes

(* remove changes which did not parse maxDist tokens past the error =
token *)

        val changes =3D catList changes=20
	      (fn(c as CHANGE{distance, ...}) =3D>=20
		  if distance=3DmaxDist then [c] else [])

      in case changes=20
	  of (l as change :: _) =3D>
	      let fun print_msg (CHANGE {new, orig, leftPos, rightPos, ...}) =
=3D
		  let val s =3D=20
		      case (orig,new)
			  of (_ :: _, []) =3D> "deleting " ^ (showTerms orig)
	                   | ([], _ :: _) =3D> "inserting " ^ (showTerms new)
			   | _ =3D> "replacing " ^ (showTerms orig) ^
				 " with " ^ (showTerms new)
		  in error ("syntax error: " ^ s, leftPos, rightPos)
		  end
		  =20
		  val _ =3D=20
		      (if length l > 1 andalso DEBUG2 then
			   (print "multiple fixes possible; could fix it by:\n";
			    app print_msg l;
			    print "chosen correction:\n")
		       else ();
		       print_msg change)

		  (* findNth: find nth queue entry from the error
		   entry.  Returns the Nth queue entry and the  portion of
		   the queue from the beginning to the nth-1 entry.  The
		   error entry is at the end of the queue.

		   Examples:

		   queue =3D a b c d e
		   findNth 0 =3D (e, a b c d)
		   findNth 1 =3D  (d, a b c)
		   *)

		  val findNth =3D fn n =3D>
		      let fun f (h :: t, 0) =3D (h, rev t)
			    | f (h :: t,n) =3D f(t,n-1)
			    | f (nil, _) =3D let exception FindNth
					  in raise FindNth
					  end
		      in f (rev stateList,n)
		      end
	=09
		  val CHANGE {pos, orig,new, ...} =3D change
		  val (last, queueFront) =3D findNth pos
		  val (stack, lexPair) =3D last

		  val lp1 =3D foldl(fn (_, (_, r)) =3D> Stream.get r) lexPair orig
		  val lp2 =3D foldr(fn(t, r)=3D>(t, Stream.cons r)) lp1 new

		  val restQueue =3D=20
		      Fifo.put((stack, lp2),
			       foldl Fifo.put Fifo.empty queueFront)

		  val (lexPair, stack, queue, _, _) =3D
		      distanceParse(lp2, stack, restQueue, pos)

	      in (lexPair, stack, queue)
	      end
	| nil =3D> (error("syntax error found at " ^ (showTerminal term),
			leftPos, leftPos); raise ParseError)
    end

   val parse =3D fn {arg, table, lexer, saction, void, lookahead,
		   ec=3Dec as {showTerminal, ...}: ('a, 'b) ecRecord} =3D>
	let val distance =3D 15   (* defer distance tokens *)
	    val minAdvance =3D 1  (* must parse at least 1 token past error *)
	    val maxAdvance =3D Int.max(lookahead, 0)(* max distance for parse =
check *)
	    val lexPair =3D Stream.get lexer
	    val (TOKEN (_, (_, leftPos, _)), _) =3D lexPair
	    val startStack =3D [(initialState table, (void, leftPos, =
leftPos))]
	    val startQueue =3D Fifo.put((startStack, lexPair), Fifo.empty)
	    val distanceParse =3D distanceParse(table, showTerminal, saction, =
arg)
	    val fixError =3D mkFixError(ec, distanceParse, minAdvance, =
maxAdvance)
	    val ssParse =3D ssParse(table, showTerminal, saction, fixError, =
arg)
	    fun loop (lexPair, stack, queue, _, SOME ACCEPT) =3D
		   ssParse(lexPair, stack, queue)
	      | loop (lexPair, stack, queue, 0, _) =3D ssParse(lexPair, stack, =
queue)
	      | loop (lexPair, stack, queue, distance, SOME ERROR) =3D
		 let val (lexPair, stack, queue) =3D fixError(lexPair, stack, queue)
		 in loop (distanceParse(lexPair, stack, queue, distance))
		 end
	      | loop _ =3D let exception ParseInternal
			 in raise ParseInternal
			 end
	in loop (distanceParse(lexPair, startStack, startQueue, distance))
	end
 end;

(* drt (12/15/89) -- needed only when the code above is functorized

structure LrParser =3D ParserGen(structure LrTable=3DLrTable
			     structure Stream=3DStream);
*)

(* ML-Yacc Parser Generator (c) 1989 Andrew W. Appel, David R. Tarditi=20
 *
 * $Log: join.sml, v $
 * 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
 *=20
 *)

(* functor Join creates a user parser by putting together a Lexer =
structure,
   an LrValues structure, and a polymorphic parser structure.  Note =
that
   the Lexer and LrValues structure must share the type pos (i.e. the =
type
   of line numbers), the type svalues for semantic values, and the type
   of tokens.
*)

functor Join(structure Lex: LEXER
	     structure ParserData: PARSER_DATA
	     structure LrParser: LR_PARSER
	     sharing ParserData.LrTable =3D LrParser.LrTable
	     sharing ParserData.Token =3D LrParser.Token
	     sharing type Lex.UserDeclarations.svalue =3D ParserData.svalue
	     sharing type Lex.UserDeclarations.pos =3D ParserData.pos
	     sharing type Lex.UserDeclarations.token =3D =
ParserData.Token.token)
		: PARSER =3D
struct
    structure Token =3D ParserData.Token
    structure Stream =3D LrParser.Stream
=20
    exception ParseError =3D LrParser.ParseError

    type arg =3D ParserData.arg
    type pos =3D ParserData.pos
    type result =3D ParserData.result
    type svalue =3D ParserData.svalue
    val makeLexer =3D LrParser.Stream.streamify o Lex.makeLexer
    val parse =3D fn (lookahead, lexer, error, arg) =3D>
	(fn (a, b) =3D> (ParserData.Actions.extract a, b))
     (LrParser.parse {table =3D ParserData.table,
	        lexer=3Dlexer,
		lookahead=3Dlookahead,
		saction =3D ParserData.Actions.actions,
		arg=3Darg,
		void=3D ParserData.Actions.void,
	        ec =3D {is_keyword =3D ParserData.EC.is_keyword,
		      noShift =3D ParserData.EC.noShift,
		      preferred_change =3D ParserData.EC.preferred_change,
		      errtermvalue =3D ParserData.EC.errtermvalue,
		      error=3Derror,
		      showTerminal =3D ParserData.EC.showTerminal,
		      terms =3D ParserData.EC.terms}}
      )
     val sameToken =3D Token.sameToken
end

(* functor JoinWithArg creates a variant of the parser structure =
produced=20
   above.  In this case, the makeLexer take an additional argument =
before
   yielding a value of type unit -> (svalue, pos) token
 *)

functor JoinWithArg(structure Lex: ARG_LEXER
	     structure ParserData: PARSER_DATA
	     structure LrParser: LR_PARSER
	     sharing ParserData.LrTable =3D LrParser.LrTable
	     sharing ParserData.Token =3D LrParser.Token
	     sharing type Lex.UserDeclarations.svalue =3D ParserData.svalue
	     sharing type Lex.UserDeclarations.pos =3D ParserData.pos
	     sharing type Lex.UserDeclarations.token =3D =
ParserData.Token.token)
		: ARG_PARSER  =3D
struct
    structure Token =3D ParserData.Token
    structure Stream =3D LrParser.Stream

    exception ParseError =3D LrParser.ParseError

    type arg =3D ParserData.arg
    type lexarg =3D Lex.UserDeclarations.arg
    type pos =3D ParserData.pos
    type result =3D ParserData.result
    type svalue =3D ParserData.svalue

    val makeLexer =3D fn s =3D> fn arg =3D>
		 LrParser.Stream.streamify (Lex.makeLexer s arg)
    val parse =3D fn (lookahead, lexer, error, arg) =3D>
	(fn (a, b) =3D> (ParserData.Actions.extract a, b))
     (LrParser.parse {table =3D ParserData.table,
	        lexer=3Dlexer,
		lookahead=3Dlookahead,
		saction =3D ParserData.Actions.actions,
		arg=3Darg,
		void=3D ParserData.Actions.void,
	        ec =3D {is_keyword =3D ParserData.EC.is_keyword,
		      noShift =3D ParserData.EC.noShift,
		      preferred_change =3D ParserData.EC.preferred_change,
		      errtermvalue =3D ParserData.EC.errtermvalue,
		      error=3Derror,
		      showTerminal =3D ParserData.EC.showTerminal,
		      terms =3D ParserData.EC.terms}}
      )
    val sameToken =3D Token.sameToken
end;

(* hash-string.sml
 *
 * COPYRIGHT (c) 1992 by AT&T Bell Laboratories
 *)

structure HashString : sig

    val hashString : string -> word

  end =3D struct

    fun charToWord c =3D Word.fromInt(Char.ord c)

  (* A function to hash a character.  The computation is:
   *
   *   h =3D 33 * h + 720 + c
   *)
    fun hashChar (c, h) =3D Word.<<(h, 0w5) + h + 0w720 + (charToWord =
c)

    fun hashString s =3D CharVector.foldl hashChar 0w0 s
	 =20
  end (* HashString *)

(* lib-base-sig.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *)

signature LIB_BASE =3D
  sig

    exception Unimplemented of string
	(* raised to report unimplemented features *)
    exception Impossible of string
	(* raised to report internal errors *)

    exception NotFound
	(* raised by searching operations *)

    val failure : {module : string, func : string, msg : string} -> 'a
	(* raise the exception Fail with a standard format message. *)

    val version : {date : string, system : string, version_id : int =
list}
    val banner : string

  end (* LIB_BASE *)


(* lib-base.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *)

structure LibBase : LIB_BASE =3D
  struct

  (* raised to report unimplemented features *)
    exception Unimplemented of string

  (* raised to report internal errors *)
    exception Impossible of string

  (* raised by searching operations *)
    exception NotFound

  (* raise the exception Fail with a standard format message. *)
    fun failure {module, func, msg} =3D
	  raise (Fail(concat[module, ".", func, ": ", msg]))

    val version =3D {
	    date =3D "June 1, 1996",=20
	    system =3D "SML/NJ Library",
	    version_id =3D [1, 0]
	  }

    fun f ([], l) =3D l
      | f ([x : int], l) =3D (Int.toString x)::l
      | f (x::r, l) =3D (Int.toString x) :: "." :: f(r, l)

    val banner =3D concat (
	    #system version :: ", Version " ::
	    f (#version_id version, [", ", #date version]))

  end (* LibBase *)


(* random-sig.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *)

signature RANDOM =3D
  sig

    type rand
	(* the internal state of a random number generator *)

    val rand : (int * int) -> rand
	(* create rand from initial seed *)

    val toString : rand -> string
    val fromString : string -> rand
        (* convert state to and from string
         * fromString raises Fail if its argument
         * does not have the proper form.
         *)

    val randInt : rand -> int
	(* generate ints uniformly in [minInt,maxInt] *)

    val randNat : rand -> int
	(* generate ints uniformly in [0,maxInt] *)

    val randReal : rand -> real
	(* generate reals uniformly in [0.0,1.0) *)

    val randRange : (int * int) -> rand -> int
	(* randRange (lo,hi) generates integers uniformly [lo,hi].
	 * Raises Fail if hi < lo.
	 *)

  end; (* RANDOM *)


(* random.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *
 * This package implements a random number generator using a =
subtract-with-borrow
 * (SWB) generator as described in Marsaglia and Zaman, "A New Class of =
Random Number
 * Generators," Ann. Applied Prob. 1(3), 1991, pp. 462-480.
 *=20
 * The SWB generator is a 31-bit generator with lags 48 and 8. It has =
period=20
 * (2^1487 - 2^247)/105 or about 10^445. In general, these generators =
are
 * excellent. However, they act locally like a lagged Fibonacci =
generator
 * and thus have troubles with the birthday test. Thus, we combine this =
SWB
 * generator with the linear congruential generator =
(48271*a)mod(2^31-1).
 *
 * Although the interface is fairly abstract, the implementation uses=20
 * 31-bit ML words. At some point, it might be good to use 32-bit =
words.
 *)

structure Random : RANDOM =3D
  struct
    structure A   =3D Array
    structure LW  =3D LargeWord
    structure W8A =3D Word8Array
    structure W8V =3D Word8Vector
    structure P   =3D Pack32Big

    val << =3D Word31.<<
    val >> =3D Word31.>>
    val & =3D Word31.andb
    val ++ =3D Word31.orb
    val xorb =3D Word31.xorb
    infix << >> & ++

    val nbits =3D 31                                      (* bits per =
word *)
    val maxWord : Word31.word =3D 0wx7FFFFFFF             (* largest =
word *)
    val bit30 : Word31.word   =3D 0wx40000000
    val lo30 : Word31.word    =3D 0wx3FFFFFFF

    val N =3D 48
    val lag =3D 8
    val offset =3D N-lag

    fun error (f,msg) =3D LibBase.failure {module=3D"Random",func=3Df, =
msg=3Dmsg}

    val two2neg30 =3D 1.0/((real 0x8000)*(real 0x8000))   (* 2^~30 *)

    fun minus(x,y,false) =3D (x - y, y > x)
      | minus(x,y,true) =3D (x - y - 0w1, y >=3D x)

    datatype rand =3D RND of {
        vals   : Word31.word A.array,(* seed array *)
        borrow : bool ref,           (* last borrow *)
        congx  : Word31.word ref,    (* congruential seed *)
        index  : int ref             (* index of next available value =
in vals *)
      }

      (* We represent state as a string, starting with an initial
       * word acting as an magic cookie (with bit 0 determining the
       * value of borrow), followed by a word containing index and a =
word
       * containing congx, followed by the seed array.
       *)
    val numWords =3D 3 + N
    val magic : LW.word =3D 0wx72646e64
    fun toString (RND{vals, borrow, congx, index}) =3D let
          val arr =3D W8A.array (4*numWords, 0w0)
          val word0 =3D if !borrow then LW.orb (magic, 0w1) else magic
          fun fill (src,dst) =3D
                if src =3D N then ()
                else (
                  P.update (arr, dst, Word31.toLargeWord (A.sub (vals, =
src)));
                  fill (src+1,dst+1)
                )
          in
            P.update (arr, 0, word0);
            P.update (arr, 1, LW.fromInt (!index));
            P.update (arr, 2, Word31.toLargeWord (!congx));
            fill (0,3);
            Byte.bytesToString (W8A.extract (arr, 0, NONE))
          end

    fun fromString s =3D let
          val bytes =3D Byte.stringToBytes s
          val _ =3D if W8V.length bytes =3D 4 * numWords then ()
                  else error ("fromString","invalid state string")
          val word0 =3D P.subVec (bytes, 0)
          val _ =3D if LW.andb(word0, 0wxFFFFFFFE) =3D magic then ()
                  else error ("fromString","invalid state string")
          fun subVec i =3D P.subVec (bytes, i)
          val borrow =3D ref (LW.andb(word0,0w1) =3D 0w1)
          val index =3D ref (LW.toInt (subVec 1))
          val congx =3D ref (Word31.fromLargeWord (subVec 2))
          val arr =3D A.array (N, 0w0 : Word31.word)
          fun fill (src,dst) =3D
                if dst =3D N then ()
                else (
                  A.update (arr, dst, Word31.fromLargeWord (subVec =
src));
                  fill (src+1,dst+1)
                )
          in
            fill (3, 0);
            RND{vals =3D arr,
                index =3D index,=20
                congx =3D congx,=20
                borrow =3D borrow}
          end

      (* linear congruential generator:
       * multiplication by 48271 mod (2^31 - 1)=20
       *)
    val a : Word31.word =3D 0w48271
    val m : Word31.word =3D 0w2147483647
    val q =3D m div a
    val r =3D m mod a
    fun lcg seed =3D let
          val left =3D a * (seed mod q)
          val right =3D r * (seed div q)
          in
            if left > right then left - right
            else (m - right) + left
          end

      (* Fill seed array using subtract-with-borrow generator:
       *  x[n] =3D x[n-lag] - x[n-N] - borrow
       * Sets index to 1 and returns 0th value.
       *)
    fun fill (RND{vals,index,congx,borrow}) =3D let
          fun update (ix,iy,b) =3D let
                val (z,b') =3D minus(A.sub(vals,ix), A.sub(vals,iy),b)
                in
                  A.update(vals,iy,z); b'
                end
          fun fillup (i,b) =3D
                if i =3D lag then b
                else fillup(i+1, update(i+offset,i,b))
          fun fillup' (i,b) =3D
                if i =3D N then b
                else fillup'(i+1, update(i-lag,i,b))
          in
            borrow :=3D fillup' (lag, fillup (0,!borrow));
            index :=3D 1;
            A.sub(vals,0)
          end

      (* Create initial seed array and state of generator.
       * Fills the seed array one bit at a time by taking the leading=20
       * bit of the xor of a shift register and a congruential =
sequence.=20
       * The congruential generator is (c*48271) mod (2^31 - 1).
       * The shift register generator is c(I + L18)(I + R13).
       * The same congruential generator continues to be used as a=20
       * mixing generator with the SWB generator.
       *)
    fun rand (congy, shrgx) =3D let
          fun mki (i,c,s) =3D let
                val c' =3D lcg c
                val s' =3D xorb(s, s << 0w18)
                val s'' =3D xorb(s', s' >> 0w13)
                val i' =3D (lo30 & (i >> 0w1)) ++ (bit30 & =
xorb(c',s''))
                in (i',c',s'') end
	  fun iterate (0, v) =3D v
	    | iterate (n, v) =3D iterate(n-1, mki v)
          fun mkseed (congx,shrgx) =3D iterate (nbits, =
(0w0,congx,shrgx))
          fun genseed (0,seeds,congx,_) =3D (seeds,congx)
            | genseed (n,seeds,congx,shrgx) =3D let
                val (seed,congx',shrgx') =3D mkseed (congx,shrgx)
                in genseed(n-1,seed::seeds,congx',shrgx') end
          val congx =3D ((Word31.fromInt congy & maxWord) << 0w1)+0w1
          val (seeds,congx) =3D genseed(N,[],congx, Word31.fromInt =
shrgx)
          in
            RND{vals =3D A.fromList seeds,=20
                index =3D ref 0,=20
                congx =3D ref congx,=20
                borrow =3D ref false}
          end

      (* Get next random number. The tweak function combines
       * the number from the SWB generator with a number from
       * the linear congruential generator.
       *)
    fun randWord (r as RND{vals, index,congx,...}) =3D let
         val idx =3D !index
         fun tweak i =3D let
               val c =3D lcg (!congx)
               in
                 congx :=3D c;
                 xorb(i, c)
               end
         in
           if idx =3D N then tweak(fill r)
           else tweak(A.sub(vals,idx)) before index :=3D idx+1
         end

    fun randInt state =3D Word31.toIntX(randWord state)
    fun randNat state =3D Word31.toIntX(randWord state & lo30)
    fun randReal state =3D
      (real(randNat state) + real(randNat state) * two2neg30) * =
two2neg30

    fun randRange (i,j) =3D=20
          if j < i=20
            then error ("randRange", "hi < lo")
            else let
              val R =3D two2neg30*real(j - i + 1)
              in
                fn s =3D> i + trunc(R*real(randNat s))
              end handle _ =3D> let
                val ri =3D real i
                val R =3D (real j)-ri+1.0
                in
                  fn s =3D> trunc(ri + R*(randReal s))
                end

  end; (* Random *)


(* hash-key-sig.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *
 * Abstract hash table keys.  This is the argument signature for the =
hash table
 * functor (see hash-table-sig.sml and hash-table.sml).
 *
 * AUTHOR:  John Reppy
 *	    AT&T Bell Laboratories
 *	    Murray Hill, NJ 07974
 *	    jhr@research.att.com
 *)

signature HASH_KEY =3D
  sig
    type hash_key

    val hashVal : hash_key -> word
	(* Compute an unsigned integer key from a hash key. *)

    val sameKey : (hash_key * hash_key) -> bool
	(* Return true if two keys are the same.
	 * NOTE: if sameKey(h1, h2), then it must be the
	 * case that (hashVal h1 =3D hashVal h2).
	 *)

  end (* HASH_KEY *)

(* mono-hash-table-sig.sml
 *
 * COPYRIGHT (c) 1992 by AT&T Bell Laboratories.
 *
 * The result signature of the hash table functor (see hash-table.sml).
 *
 * AUTHOR:  John Reppy
 *	    AT&T Bell Laboratories
 *	    Murray Hill, NJ 07974
 *	    jhr@research.att.com
 *)

signature MONO_HASH_TABLE =3D
  sig

    structure Key : HASH_KEY

    type 'a hash_table

    val mkTable : (int * exn) -> 'a hash_table
	(* Create a new table; the int is a size hint and the exception
	 * is to be raised by find.
	 *)

    val clear : 'a hash_table -> unit
	(* remove all elements from the table *)

    val insert : 'a hash_table -> (Key.hash_key * 'a) -> unit
	(* Insert an item.  If the key already has an item associated with it,
	 * then the old item is discarded.
	 *)

    val lookup : 'a hash_table -> Key.hash_key -> 'a
	(* Find an item, the table's exception is raised if the item doesn't =
exist *)

    val find : 'a hash_table -> Key.hash_key -> 'a option
	(* Look for an item, return NONE if the item doesn't exist *)

    val remove : 'a hash_table -> Key.hash_key -> 'a
	(* Remove an item, returning the item.  The table's exception is =
raised if
	 * the item doesn't exist.
	 *)

    val numItems : 'a hash_table ->  int
	(* Return the number of items in the table *)

    val listItems  : 'a hash_table -> 'a list
    val listItemsi : 'a hash_table -> (Key.hash_key * 'a) list
	(* Return a list of the items (and their keys) in the table *)

    val app  : ('a -> unit) -> 'a hash_table -> unit
    val appi : ((Key.hash_key * 'a) -> unit) -> 'a hash_table -> unit
	(* Apply a function to the entries of the table *)

    val map  : ('a -> 'b) -> 'a hash_table -> 'b hash_table
    val mapi : ((Key.hash_key * 'a) -> 'b) -> 'a hash_table -> 'b =
hash_table
	(* Map a table to a new table that has the same keys *)

    val fold  : (('a * 'b) -> 'b) -> 'b -> 'a hash_table -> 'b
    val foldi : ((Key.hash_key * 'a * 'b) -> 'b) -> 'b -> 'a hash_table =
-> 'b

(** Also mapPartial?? *)
    val filter  : ('a -> bool) -> 'a hash_table -> unit
    val filteri : ((Key.hash_key * 'a) -> bool) -> 'a hash_table -> =
unit
	(* remove any hash table items that do not satisfy the given
	 * predicate.
	 *)

    val copy : 'a hash_table -> 'a hash_table
	(* Create a copy of a hash table *)

    val bucketSizes : 'a hash_table -> int list
	(* returns a list of the sizes of the various buckets.  This is to
	 * allow users to gauge the quality of their hashing function.
	 *)

  end (* MONO_HASH_TABLE *)

(* hash-table-rep.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.
 * COPYRIGHT (c) 1996 AT&T Research.
 *
 * This is the internal representation of hash tables, along with some
 * utility functions.  It is used in both the polymorphic and functor
 * hash table implementations.
 *
 * AUTHOR:  John Reppy
 *	    AT&T Bell Laboratories
 *	    Murray Hill, NJ 07974
 *	    jhr@research.att.com
 *)

structure HashTableRep : sig

    datatype ('a, 'b) bucket
      =3D NIL
      | B of (word * 'a * 'b * ('a, 'b) bucket)

    type ('a, 'b) table =3D ('a, 'b) bucket array

    val alloc : int -> ('a, 'b) table
	(* allocate a table of at least the given size *)

    val growTable : (('a, 'b) table * int) -> ('a, 'b) table
	(* grow a table to the specified size *)

    val growTableIfNeeded : (('a, 'b) table ref * int) -> bool
	(* conditionally grow a table; the second argument is the number
	 * of items currently in the table.
	 *)

    val clear : ('a, 'b) table -> unit
	(* remove all items *)

    val listItems  : (('a, 'b) table * int ref) -> 'b list
    val listItemsi : (('a, 'b) table * int ref) -> ('a * 'b) list


    val appi : ('a * 'b -> 'c) -> ('a, 'b) table -> unit
    val app : ('a -> 'b) -> ('c, 'a) table -> unit

    val mapi : ('a * 'b -> 'c) -> ('a, 'b) table -> ('a, 'c) table
    val map : ('a -> 'b) -> ('c, 'a) table -> ('c, 'b) table

    val foldi : ('a * 'b * 'c -> 'c) -> 'c -> ('a, 'b) table -> 'c
    val fold : ('a * 'b -> 'b) -> 'b -> ('c, 'a) table -> 'b

    val filteri : ('a * 'b -> bool) -> ('a, 'b) table -> unit
    val filter : ('a -> bool) -> ('b,'a) table -> unit

    val copy : ('a, 'b) table -> ('a, 'b) table

    val bucketSizes : ('a, 'b) table -> int list

  end =3D struct

    datatype ('a, 'b) bucket
      =3D NIL
      | B of (word * 'a * 'b * ('a, 'b) bucket)

    type ('a, 'b) table =3D ('a, 'b) bucket array

    fun index (i, sz) =3D Word.toIntX(Word.andb(i, Word.fromInt sz - =
0w1))

  (* find smallest power of 2 (>=3D 32) that is >=3D n *)
    fun roundUp n =3D let
	  fun f i =3D if (i >=3D n) then i else f(i * 2)
	  in
	    f 32
	  end

  (* Create a new table; the int is a size hint and the exception
   * is to be raised by find.
   *)
    fun alloc sizeHint =3D Array.array(roundUp sizeHint, NIL)

  (* grow a table to the specified size *)
    fun growTable (table, newSz) =3D let
	  val newArr =3D Array.array (newSz, NIL)
	  fun copy NIL =3D ()
	    | copy (B(h, key, v, rest)) =3D let
		val indx =3D index (h, newSz)
		in
		  Array.update (newArr, indx,
		    B(h, key, v, Array.sub(newArr, indx)));
		  copy rest
		end
	  in
	    Array.app copy table;
	    newArr
	  end

  (* conditionally grow a table; return true if it grew. *)
    fun growTableIfNeeded (table, nItems) =3D let
	    val arr =3D !table
	    val sz =3D Array.length arr
	    in
	      if (nItems >=3D sz)
		then (table :=3D growTable (arr, sz+sz); true)
		else false
	    end

  (* remove all items *)
    fun clear table =3D Array.modify (fn _ =3D> NIL) table

  (* return a list of the items in the table *)
    fun listItems (table, nItems) =3D let
	  fun f (_, l, 0) =3D l
	    | f (~1, l, _) =3D l
	    | f (i, l, n) =3D let
		fun g (NIL, l, n) =3D f (i-1, l, n)
		  | g (B(_, k, v, r), l, n) =3D g(r, v::l, n-1)
		in
		  g (Array.sub(table, i), l, n)
		end
	  in
	    f ((Array.length table) - 1, [], !nItems)
	  end (* listItems *)
    fun listItemsi (table, nItems) =3D let
	  fun f (_, l, 0) =3D l
	    | f (~1, l, _) =3D l
	    | f (i, l, n) =3D let
		fun g (NIL, l, n) =3D f (i-1, l, n)
		  | g (B(_, k, v, r), l, n) =3D g(r, (k, v)::l, n-1)
		in
		  g (Array.sub(table, i), l, n)
		end
	  in
	    f ((Array.length table) - 1, [], !nItems)
	  end (* listItems *)

  (* Apply a function to the entries of the table *)
    fun appi f table =3D let
	  fun appF NIL =3D ()
	    | appF (B(_, key, item, rest)) =3D (f (key, item); appF rest)
	  in
	    Array.app appF table
	  end (* appi *)
    fun app f table =3D let
	  fun appF NIL =3D ()
	    | appF (B(_, key, item, rest)) =3D (f item; appF rest)
	  in
	    Array.app appF table
	  end (* app *)

  (* Map a table to a new table that has the same keys *)
    fun mapi f table =3D let
	  fun mapF NIL =3D NIL
	    | mapF (B(hash, key, item, rest)) =3D
		B(hash, key, f (key, item), mapF rest)
	  val newTbl =3D Array.tabulate (
		Array.length table,
		fn i =3D> mapF (Array.sub(table, i)))
	  in
	    newTbl
	  end (* transform *)

  (* Map a table to a new table that has the same keys *)
    fun map f table =3D let
	  fun mapF NIL =3D NIL
	    | mapF (B(hash, key, item, rest)) =3D B(hash, key, f item, mapF =
rest)
	  val newTbl =3D Array.tabulate (
		Array.length table,
		fn i =3D> mapF (Array.sub(table, i)))
	  in
	    newTbl
	  end (* map *)

    fun foldi f init table =3D let
	  fun foldF (NIL, accum) =3D accum
	    | foldF (B(hash, key, item, rest), accum) =3D
		foldF(rest, f(key, item, accum))
	  in
	    Array.foldl foldF init table
	  end
    fun fold f init table =3D let
	  fun foldF (NIL, accum) =3D accum
	    | foldF (B(hash, key, item, rest), accum) =3D
		foldF(rest, f(item, accum))
	  in
	    Array.foldl foldF init table
	  end

  (* remove any hash table items that do not satisfy the given
   * predicate.
   *)
    fun filteri pred table =3D let
	  fun filterP NIL =3D NIL
	    | filterP (B(hash, key, item, rest)) =3D if (pred(key, item))
		then B(hash, key, item, filterP rest)
		else filterP rest
	  in
	    Array.modify filterP table
	  end (* filteri *)
    fun filter pred table =3D let
	  fun filterP NIL =3D NIL
	    | filterP (B(hash, key, item, rest)) =3D if (pred item)
		then B(hash, key, item, filterP rest)
		else filterP rest
	  in
	    Array.modify filterP table
	  end (* filter *)

  (* Create a copy of a hash table *)
    fun copy table =3D
	  Array.tabulate (Array.length table, fn i =3D> Array.sub(table, i));

  (* returns a list of the sizes of the various buckets.  This is to
   * allow users to gauge the quality of their hashing function.
   *)
    fun bucketSizes table =3D let
	  fun len (NIL, n) =3D n
	    | len (B(_, _, _, r), n) =3D len(r, n+1)
	  in
	    Array.foldr (fn (b, l) =3D> len(b, 0) :: l) [] table
	  end

  end (* HashTableRep *)

(* hash-table-fn.sml
 *
 * COPYRIGHT (c) 1992 by AT&T Bell Laboratories.
 *
 * A hash table functor.  It takes a key type with two operations: =
sameKey and
 * hashVal as arguments (see hash-key-sig.sml).
 *
 * AUTHOR:  John Reppy
 *	    AT&T Bell Laboratories
 *	    Murray Hill, NJ 07974
 *	    jhr@research.att.com
 *)

functor HashTableFn (Key : HASH_KEY) : MONO_HASH_TABLE =3D
  struct

    structure Key =3D Key
    open Key

    structure HTRep =3D HashTableRep

    datatype 'a hash_table =3D HT of {
	not_found : exn,
	table : (hash_key, 'a) HTRep.table ref,
	n_items : int ref
      }

    fun index (i, sz) =3D Word.toIntX(Word.andb(i, Word.fromInt sz - =
0w1))

  (* Create a new table; the int is a size hint and the exception
   * is to be raised by find.
   *)
    fun mkTable (sizeHint, notFound) =3D HT{
	    not_found =3D notFound,
	    table =3D ref (HTRep.alloc sizeHint),
	    n_items =3D ref 0
	  }

  (* remove all elements from the table *)
    fun clear (HT{table, n_items, ...}) =3D (HTRep.clear(!table); =
n_items :=3D 0)

  (* Insert an item.  If the key already has an item associated with =
it,
   * then the old item is discarded.
   *)
    fun insert (tbl as HT{table, n_items, ...}) (key, item) =3D let
	  val arr =3D !table
	  val sz =3D Array.length arr
	  val hash =3D hashVal key
	  val indx =3D index (hash, sz)
	  fun look HTRep.NIL =3D (
		Array.update(arr, indx, HTRep.B(hash, key, item, Array.sub(arr, =
indx)));
		n_items :=3D !n_items + 1;
		HTRep.growTableIfNeeded (table, !n_items);
		HTRep.NIL)
	    | look (HTRep.B(h, k, v, r)) =3D if ((hash =3D h) andalso =
sameKey(key, k))
		then HTRep.B(hash, key, item, r)
		else (case (look r)
		   of HTRep.NIL =3D> HTRep.NIL
		    | rest =3D> HTRep.B(h, k, v, rest)
		  (* end case *))
	  in
	    case (look (Array.sub (arr, indx)))
	     of HTRep.NIL =3D> ()
	      | b =3D> Array.update(arr, indx, b)
	    (* end case *)
	  end

  (* find an item, the table's exception is raised if the item doesn't =
exist *)
    fun lookup (HT{table, not_found, ...}) key =3D let
	  val arr =3D !table
	  val hash =3D hashVal key
	  val indx =3D index (hash, Array.length arr)
	  fun look HTRep.NIL =3D raise not_found
	    | look (HTRep.B(h, k, v, r)) =3D if ((hash =3D h) andalso =
sameKey(key, k))
		then v
		else look r
	  in
	    look (Array.sub (arr, indx))
	  end

  (* look for an item, return NONE if the item doesn't exist *)
    fun find (HT{table, ...}) key =3D let
	  val arr =3D !table
	  val sz =3D Array.length arr
	  val hash =3D hashVal key
	  val indx =3D index (hash, sz)
	  fun look HTRep.NIL =3D NONE
	    | look (HTRep.B(h, k, v, r)) =3D if ((hash =3D h) andalso =
sameKey(key, k))
		then SOME v
		else look r
	  in
	    look (Array.sub (arr, indx))
	  end

  (* Remove an item.  The table's exception is raised if
   * the item doesn't exist.
   *)
    fun remove (HT{not_found, table, n_items}) key =3D let
	  val arr =3D !table
	  val sz =3D Array.length arr
	  val hash =3D hashVal key
	  val indx =3D index (hash, sz)
	  fun look HTRep.NIL =3D raise not_found
	    | look (HTRep.B(h, k, v, r)) =3D if ((hash =3D h) andalso =
sameKey(key, k))
		then (v, r)
		else let val (item, r') =3D look r in (item, HTRep.B(h, k, v, r')) =
end
	  val (item, bucket) =3D look (Array.sub (arr, indx))
	  in
	    Array.update (arr, indx, bucket);
	    n_items :=3D !n_items - 1;
	    item
	  end (* remove *)

  (* Return the number of items in the table *)
   fun numItems (HT{n_items, ...}) =3D !n_items

  (* return a list of the items in the table *)
    fun listItems (HT{table =3D ref arr, n_items, ...}) =3D
	  HTRep.listItems (arr, n_items)
    fun listItemsi (HT{table =3D ref arr, n_items, ...}) =3D
	  HTRep.listItemsi (arr, n_items)

  (* Apply a function to the entries of the table *)
    fun appi f (HT{table, ...}) =3D HTRep.appi f (! table)
    fun app f (HT{table, ...}) =3D HTRep.app f (! table)

  (* Map a table to a new table that has the same keys and exception *)
    fun mapi f (HT{table, n_items, not_found}) =3D HT{
	    table =3D ref(HTRep.mapi f (! table)),
	    n_items =3D ref(!n_items),
	    not_found =3D not_found
	  }
    fun map f (HT{table, n_items, not_found}) =3D HT{
	    table =3D ref(HTRep.map f (! table)),
	    n_items =3D ref(!n_items),
	    not_found =3D not_found
	  }

  (* Fold a function over the entries of the table *)
    fun foldi f init (HT{table, ...}) =3D HTRep.foldi f init (! table)
    fun fold f init (HT{table, ...}) =3D HTRep.fold f init (! table)

  (* remove any hash table items that do not satisfy the given
   * predicate.
   *)
    fun filteri pred (HT{table, ...}) =3D HTRep.filteri pred (! table)
    fun filter pred (HT{table, ...}) =3D HTRep.filter pred (! table)

  (* Create a copy of a hash table *)
    fun copy (HT{table, n_items, not_found}) =3D HT{
	    table =3D ref(HTRep.copy(! table)),
	    n_items =3D ref(!n_items),
	    not_found =3D not_found
	  }

  (* returns a list of the sizes of the various buckets.  This is to
   * allow users to gauge the quality of their hashing function.
   *)
    fun bucketSizes (HT{table, ...}) =3D HTRep.bucketSizes (! table)

  end (* HashTableFn *)

(* mono-dynamic-array-sig.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *
 * Signature for unbounded arrays.
 *
 *)

signature MONO_DYNAMIC_ARRAY =3D
  sig
    type elem
    type array

    val array : (int * elem) -> array
      (* array (sz, e) creates an unbounded array all of whose elements
       * are initialized to e.  sz (>=3D 0) is used as a
       * hint of the potential range of indices.  Raises Size if a
       * negative hint is given.
       *)

    val subArray : array * int * int -> array
      (* subArray (a,lo,hi) creates a new array with the same default
       * as a, and whose values in the range [0,hi-lo] are equal to
       * the values in b in the range [lo, hi].
       * Raises Size if lo > hi
       *)

    val fromList : elem list * elem -> array
      (* arrayoflist (l, v) creates an array using the list of values l
       * plus the default value v.
       *)

    val tabulate: int * (int -> elem) * elem -> array
      (* tabulate (sz,fill,dflt) acts like Array.tabulate, plus=20
       * stores default value dflt.  Raises Size if sz < 0.
       *)

    val default : array -> elem
      (* default returns array's default value *)

    val sub : array * int -> elem
      (* sub (a,idx) returns value of the array at index idx.
       * If that value has not been set by update, it returns the =
default value.
       * Raises Subscript if idx < 0
       *)

    val update : array * int * elem -> unit
      (* update (a,idx,v) sets the value at index idx of the array to =
v.=20
       * Raises Subscript if idx < 0
       *)

    val bound : array -> int
      (* bound returns an upper bound on the index of values that have =
been
       * changed.
       *)

    val truncate : array * int -> unit
      (* truncate (a,sz) makes every entry with index > sz the default =
value *)

(** what about iterators??? **)

  end (* MONO_DYNAMIC_ARRAY *)


(* dynamic-array-fn.sml
 *
 * COPYRIGHT (c) 1993 by AT&T Bell Laboratories.  See COPYRIGHT file =
for details.
 *
 * Arrays of unbounded length
 *
 *)

functor DynamicArrayFn (A : MONO_ARRAY) : MONO_DYNAMIC_ARRAY =3D
  struct

    type elem =3D A.elem
    datatype array =3D BLOCK of A.array ref * elem * int ref
=20
    exception Subscript =3D General.Subscript
    exception Size =3D General.Size

    fun array (sz, dflt) =3D BLOCK(ref (A.array (sz, dflt)), dflt, ref =
(~1))

  (* fromList (l, v) creates an array using the list of values l
   * plus the default value v.
   * NOTE: Once MONO_ARRAY includes arrayoflist, this will become =
trivial.
   *)
    fun fromList (initList, dflt) =3D let
          val len =3D length initList
	  val arr =3D A.array(len, dflt)
	  fun upd ([], _) =3D ()
	    | upd (x::r, i) =3D (A.update(arr, i, x); upd(r, i+1))
	  in
	    upd (initList, 0);
	    BLOCK(ref arr, dflt, ref (len-1))
	  end

  (* tabulate (sz,fill,dflt) acts like Array.tabulate, plus=20
   * stores default value dflt.  Raises Size if sz < 0.
   *)
    fun tabulate (sz, fillFn, dflt) =3D
	  BLOCK(ref(A.tabulate(sz, fillFn)), dflt, ref (sz-1))

    fun subArray (BLOCK(arr,dflt,bnd),lo,hi) =3D let
          val arrval =3D !arr
          val bnd =3D !bnd
          fun copy i =3D A.sub(arrval,i+lo)
          in
            if hi <=3D bnd
              then BLOCK(ref(A.tabulate(hi-lo,copy)), dflt, ref =
(hi-lo))
            else if lo <=3D bnd=20
              then BLOCK(ref(A.tabulate(bnd-lo,copy)),dflt,ref(bnd-lo))
            else
              array(0,dflt)
          end

    fun default (BLOCK(_,dflt,_)) =3D dflt

    fun sub (BLOCK(arr,dflt,_),idx) =3D (A.sub(!arr,idx))=20
          handle Subscript =3D> if idx < 0 then raise Subscript else =
dflt

    fun bound (BLOCK(_,_,bnd)) =3D (!bnd)

    fun expand(arr,oldlen,newlen,dflt) =3D let
          fun fillfn i =3D if i < oldlen then A.sub(arr,i) else dflt
          in
            A.tabulate(newlen, fillfn)
          end

    fun update (BLOCK(arr,dflt,bnd),idx,v) =3D let=20
          val len =3D A.length (!arr)
          in
            if idx >=3D len=20
              then arr :=3D expand(!arr,len, =
Int.max(len+len,idx+1),dflt)=20
              else ();
            A.update(!arr,idx,v);
            if idx > !bnd then bnd :=3D idx else ()
          end

    fun truncate (a as BLOCK(arr,dflt,bndref),sz) =3D let
          val bnd =3D !bndref
          val newbnd =3D sz - 1
          val arr_val =3D !arr
          val array_sz =3D A.length arr_val
          fun fillDflt (i,stop) =3D
                if i =3D stop then ()
                else (A.update(arr_val,i,dflt);fillDflt(i-1,stop))
          in
            if newbnd < 0 then (bndref :=3D ~1;arr :=3D =
A.array(0,dflt))
            else if newbnd >=3D bnd then ()
            else if 3 * sz < array_sz then let
              val BLOCK(arr',_,bnd') =3D subArray(a,0,newbnd)
              in
                (bndref :=3D !bnd'; arr :=3D !arr')
              end
            else fillDflt(bnd,newbnd)
          end

  end (* DynamicArrayFn *)


(* File: lib40.sml
   Created 1993-06-01
   Modified 1998-09-14.
*)

structure Lib =3D
struct
open Math

exception My_mod_exn
fun op mod( N, K ) =3D=20
  if N < 0 orelse K < 0 then raise My_mod_exn else N - K * ( N div K )
(* To avoid segmentation fault under gdb in SML/NJ 110.0.3 *)

val Max_int =3D case Int.maxInt of SOME X =3D> X - 3
val Max_word =3D Word.fromInt Max_int
val Max_real =3D 1.0E99

fun for( L, U, f ) =3D
  if L>U then
    ()
  else (
    f L;
    for( L+1, U, f )
    )

fun real_for( L, U, f ) =3D
  if L>U then
    ()
  else (
    f L;
    real_for( L+1.0, U, f )
    )



fun word32_to_bin_string( X : Word32.word ) : string =3D
  let
    fun g( N : int, X : Word32.word ) =3D
      if N =3D 0 then
        ""
      else
        g( N-1, Word32.>>( X, 0w1 ) ) ^
        Word32.toString( Word32.andb( X, 0w1 ) )=20
  in
    g(32,X)
  end

fun bin_string_to_word32( Xs : string ) : Word32.word =3D
  let
    fun h( #"0" ) =3D 0w0
      | h( #"1" ) =3D 0w1
    fun g( Xs : char list ) : Word32.word =3D
      case Xs of
        [X1] =3D> h X1
      | X1::Xs1 =3D> Word32.orb( h X1, Word32.<<( g Xs1, 0w1 ) )
  in
    g( rev( explode Xs ) )
  end

fun is_NONE NONE =3D true
  | is_NONE _ =3D false

fun is_SOME( SOME _ ) =3D true
  | is_SOME _ =3D false

type outstream =3D TextIO.outstream
val std_err =3D ref TextIO.stdErr
val std_out =3D ref TextIO.stdOut
fun output( stream : outstream, S : string ) =3D=20
  TextIO.output(stream, S)
fun flush_out( stream : outstream ) =3D TextIO.flushOut stream
fun flush_output( stream : outstream, S : string ) =3D (
  flush_out stream;
  output(stream, S)
  )

fun p S =3D ( output( !std_out, S ); flush_out( !std_out ) )

fun print_int N =3D p(Int.toString N)
fun print_word32 N =3D p(Word32.toString N)
fun print_real N =3D p(Real.toString N)
fun print_bool N =3D p(Bool.toString N)

fun print_option(print : 'a -> unit, X : 'a option ) =3D
  case X of NONE =3D> p"NONE" | SOME X =3D> ( p"SOME( "; print X; p" )" =
)

fun print_int_option X =3D print_option( print_int, X )
fun print_real_option X =3D print_option( print_real, X )
fun print_bool_option X =3D print_option( print_bool, X )

fun pack( Xs : string list ) : string =3D
  let
    fun g [] =3D []
      | g( X :: Xs ) =3D Int.toString( String.size X ) ^ "\n" :: X :: g =
Xs
  in
    String.concat( g Xs )
  end
fun unpack( S : string ) : string list =3D
  let
    val Len =3D String.size S
    fun nl_pos Start =3D
      if Start >=3D Len then
        NONE
      else
        case String.sub( S, Start ) of=20
          #"\n" =3D> SOME Start
        | _ =3D> nl_pos( Start + 1 )    =20

    fun read_len( Start : int ) : ( int * int ) option =3D
      case nl_pos Start of
        NONE =3D> NONE
      | SOME Pos =3D>
      case Int.fromString( String.substring( S, Start, Pos-Start ) ) of
        SOME Len =3D> SOME( Len, Pos+1 )

    fun g Start=3D
      case read_len Start of
        NONE =3D> []
      | SOME( Len, Start ) =3D> String.substring( S, Start, Len ) :: =
g(Start+Len)
  in
    g 0
  end
       =20
exception Internal_error

fun re_raise(Ex:exn,S:string) =3D (
  flush_out( !std_out );
  output(!std_out,"\nre_raise: "^S^"\n");
  flush_out( !std_out );
  raise Ex
  )

fun inc X =3D if !X < Max_int then X :=3D !X + 1 else ()

fun real_inc( X : real ref ) : unit =3D X :=3D !X + 1.0

fun word_inc( X : Word.word ref) =3D
 ( X :=3D Word.+( !X, Word.fromInt 1) )


local val Eps =3D 1.0E~6 in
fun real_eq(X:real,Y:real):bool =3D
  if abs Y < Eps then
    abs X < Eps
  else
    case X/Y of Ratio =3D>
      1.0-Eps<Ratio andalso Ratio<1.0+Eps
end

fun real_rep_eq( X : real, Y : real ) =3D=20
  case Real.compare( X, Y ) of EQUAL =3D> true | _ =3D> false

local

fun normalize X =3D=20
  if X > 1.0 orelse X < ~1.0 then=20
    normalize( X / 2.55343525364845 )
  else
    X

in

fun normrealhash( X : real ) =3D=20
  normalize( case Real.toManExp X of { man, exp } =3D>=20
    man * (real exp + 0.38197515646351) )

end

fun max2(less,X,Y) =3D if less(X,Y) then Y else X
fun min2(less,X,Y) =3D if less(X,Y) then X else Y

fun cmp_invert cmp =3D fn( X, Y ) =3D> cmp( Y, X )


fun real_pow(X,Y) =3D exp(Y*ln X)

fun real_factorial N =3D if N<=3D0.0 then 1.0 else =
N*real_factorial(N-1.0)

fun is_prime(N:int) : bool =3D
  let val Max=3Dceil(sqrt(real N))
      fun try I =3D
        I>Max orelse not(N mod I=3D0) andalso try(I+1)
  in
    try 2
  end

val Big_prime =3D
  let fun try N =3D if is_prime N then N else try(N-1) in
    try Max_int
  end

exception Real_mod
fun real_mod(X:real,Y:real) =3D
  X - real(trunc(X/Y))*Y
  handle Div =3D> raise Real_mod
       | Overflow =3D> raise Real_mod

local
  val Max =3D real Max_int - 7.0
in

fun hash_real_to_int( X : real ) : int =3D Real.trunc( normrealhash X * =
Max  )
handle Ex =3D> (
  p"\nhash_real_to_int: X =3D "; p( Real.toString X );
  re_raise( Ex, "hash_real_to_int" ) )

fun hash_real_to_word( X : real ) : word =3D=20
  Word.fromInt( Real.trunc( normrealhash X * Max ) )
handle Ex =3D> (
  p"\nhash_real_to_word: X =3D "; p( Real.toString X );
  re_raise( Ex, "hash_real_to_word" ) )

end (* local *)

fun real_compare( X : real, Y ) =3D
  if X < Y then
    LESS
  else if Y < X then
    GREATER
  else=20
    EQUAL

structure Int_hash_key =3D
struct
  type hash_key=3Dint
  fun hashVal(X:int)=3D Word.fromInt X
  fun sameKey(X,Y:int)=3D X=3DY
end

structure Int_HashTable =3D HashTableFn(Int_hash_key)



structure Int_dyn =3D DynamicArrayFn(
  struct
    open Array
    type elem =3D int
    type vector =3D elem Vector.vector
    type array =3D int array
    structure Vector =3D
struct
  open Vector
  type elem =3D int
  type vector =3D elem Vector.vector
end
  end=20
  )



structure Real_hash_key =3D
struct
  fun hashVal(X:real) =3D Word.fromInt( hash_real_to_int X )
  fun sameKey(X:real,Y:real) =3D real_rep_eq( X, Y )
  type hash_key=3Dreal
end

structure Real_HashTable =3D HashTableFn(Real_hash_key)


structure Word32_dyn =3D DynamicArrayFn(=20
  struct
    open Array
    type elem =3D Word32.word
    type vector =3D elem Vector.vector
    type array =3D Word32.word array
    structure Vector =3D
struct
  open Vector
  type elem =3D Word32.word
  type vector =3D elem Vector.vector
end
  end=20
  )

structure Word8_dyn =3D  DynamicArrayFn(
  struct
    open Array
    type elem =3D Word8.word
    type vector =3D elem Vector.vector
    type array =3D Word8.word array
    structure Vector =3D
struct
  open Vector
  type elem =3D Word8.word
  type vector =3D elem Vector.vector
end
  end=20
  )

structure Word_hash_key =3D
struct
  type hash_key=3Dword
  fun hashVal(X:word)=3D  X
  fun sameKey(X,Y:word)=3D X=3DY
end

structure Word_HashTable =3D HashTableFn(Word_hash_key)


structure String_hash_key =3D
struct
  type hash_key=3Dstring
  val hashVal =3D HashString.hashString
  fun sameKey(X,Y:string)=3D X=3DY
end

structure String_HashTable =3D HashTableFn(String_hash_key)


fun timeit( f : unit -> 'a ) =3D
  let
    val start =3D Timer.startCPUTimer ();
    val result =3D f();
    val non_gc_time =3D #usr(Timer.checkCPUTimer start);
  in
   print( Real.toString( Time.toReal non_gc_time ) );
   print "\n";=20
   result
  end;


fun time_to_real X=3D Time.toReal X
  handle Ex =3D> re_raise( Ex, "time_to_real" )

fun real_to_time X =3D Time.fromReal X
  handle Ex =3D> (
    output(!std_err, "\n\nreal_to_time: X =3D " ^ Real.toString X);
    re_raise( Ex, "real_to_time" )
    )

type timer =3D ( string * bool * real * Timer.cpu_timer ) ref

fun mk_timer( Id ) : timer =3D  ref( Id, false, 0.0, =
Timer.startCPUTimer() )
    handle Ex =3D> re_raise( Ex, "mk_timer" )

exception Start_timer
fun start_timer( T : timer ) =3D
  T :=3D=20
    let=20
      val ( Id, Running, So_far, Timer ) =3D !T
    in
      if Running then (
        p( "\n\nstart_timer: " ^ Id );
        raise Start_timer )
      else
        ( Id, true, So_far, Timer.startCPUTimer() )
    end
    handle Ex =3D> re_raise( Ex, "start_timer" )

fun timer_running( T : timer ) =3D #2(!T)

exception Stop_timer
fun stop_timer(T) =3D
  (
  T :=3D=20
    let=20
      val ( Id, Running, So_far, Timer ) =3D !T
    in
      if not(Running) then (
        p( "\n\nstop_timer: " ^ Id );
        raise Stop_timer )
      else
        ( Id, false,=20
          So_far+time_to_real(#usr(Timer.checkCPUTimer Timer)), Timer)
    end)
(*
    handle Time.Time =3D> (
      output(!std_err,"\nstop_timer: Exn Time handled :" ^
        Real.toString(#2(!T)) ^ "\n");
      stop_timer T
      )
   | Ex =3D> re_raise( Ex, "stop_timer" )
*)

fun check_timer(T) : real =3D
    let=20
      val ( Id, Running, So_far, Timer ) =3D !T
    in
      if Running then
        So_far+time_to_real(#usr(Timer.checkCPUTimer Timer))
(*
        handle Time.Time =3D> (
          output(!std_err,"\ncheck_timer: Exn Time handled :" ^
            Real.toString So_far ^ "\n");
          check_timer T
          )
*)
      else
        So_far
    end
    handle Ex =3D> re_raise( Ex, "check_timer" )

fun set_timer(T,To:real) : unit =3D
  (case !T of ( Id, Running, _, _ ) =3D>
  T :=3D ( Id, Running, To, Timer.startCPUTimer() ) )
  handle Ex =3D> re_raise( Ex, "set_timer" )


fun sort (op < : 'a * 'a -> bool) ls =3D let=20
          fun merge([],ys) =3D ys
            | merge(xs,[]) =3D xs
            | merge(x::xs,y::ys) =3D
                if y < x then y::merge(x::xs,ys) else =
x::merge(xs,y::ys)
          fun mergepairs(ls as [l], k) =3D ls
            | mergepairs(l1::l2::ls,k) =3D
                if k mod 2 =3D 1 then l1::l2::ls
                else mergepairs(merge(l1,l2)::ls, k div 2)
            | mergepairs _ =3D raise Internal_error
          fun nextrun(run,[])    =3D (rev run,[])
            | nextrun(run,x::xs) =3D if hd run < x then =
nextrun(x::run,xs)
                                   else (rev run,x::xs)
          fun samsorting([], ls, k)    =3D hd(mergepairs(ls,0))
            | samsorting(x::xs, ls, k) =3D let=20
                val (run,tail) =3D nextrun([x],xs)
                in samsorting(tail, mergepairs(run::ls,k+1), k+1)
                end
          in=20
            case ls of [] =3D> [] | _ =3D> samsorting(ls, [], 0)
          end

fun stable_merge(less,[],Ys) =3D Ys
  | stable_merge(less,Xs,[]) =3D Xs
  | stable_merge(less,X::Xs,Y::Ys) =3D
  if less(Y,X) then=20
    Y::stable_merge(less,X::Xs,Ys)=20
  else=20
    X::stable_merge(less,Xs,Y::Ys)


fun cmpsort( cmp : 'a * 'a -> order, Xs : 'a list ) =3D
  sort ( fn( X1, X2 ) =3D> case cmp( X1, X2 ) of LESS =3D> true | _ =
=3D> false ) Xs=20

fun nl() =3D output(!std_out,"\n");


local

val Rand =3D Random.rand( 6951246, ~215434691 )

in

val randInt =3D fn() =3D> Random.randInt Rand
val randNat =3D fn() =3D> Random.randNat Rand
val randReal =3D fn() =3D> Random.randReal Rand
val randRange =3D fn(Low,High) =3D> Random.randRange (Low,High) Rand

end


end (* structure Lib *)


structure List1 =3D
struct
open Lib;

fun list_less(less,_,[]) =3D false
  | list_less(less,[],_) =3D true
  | list_less(less,X::Xs,Y::Ys) =3D
      less(X,Y) orelse ( not(less(Y,X)) andalso list_less(less,Xs,Ys) )

fun list_compare( cmp, [], [] ) =3D EQUAL
  | list_compare( cmp, [], _ ) =3D LESS
  | list_compare( cmp, _, [] ) =3D GREATER
  | list_compare( cmp, X :: Xs, Y :: Ys ) =3D=20
  case cmp( X, Y ) of
    EQUAL =3D> list_compare( cmp, Xs, Ys )
  | Z =3D> Z

fun snoc(Xs,X) =3D Xs@(X::nil)

fun dh(X::nil) =3D X
  | dh(X::Xs) =3D dh(Xs)

fun lt(X::nil) =3D nil
  | lt(X::Xs) =3D X::(lt Xs)

exception Nth;
fun nth( X::_, 0 ) =3D X
  | nth( _::Xs, N ) =3D if N>0 then nth(Xs,N-1) else raise Nth
  | nth(_,_) =3D raise Nth;

fun index(X,Y::Ys) =3D
  if X=3DY then 0 else 1+index(X,Ys)

fun index_opt(X,[]) =3D NONE
  | index_opt(X,Y::Ys) =3D if X=3DY then SOME 0 else
      case index_opt(X,Ys) of NONE =3D> NONE | SOME N =3D> SOME(1+N)

fun index_opt'( _, [] ) =3D NONE
  | index_opt'( found, Y::Ys) =3D if found Y then SOME 0 else
      case index_opt'( found, Ys ) of NONE =3D> NONE | SOME N =3D> =
SOME(1+N)

fun take(N,[]) =3D []
  | take(N,X::Xs) =3D if N>0 then X::take(N-1,Xs) else []

fun drop(_,[]) =3D []
  | drop(N,X::Xs) =3D if N>0 then drop(N-1,Xs) else X::Xs

fun takewhile(p,[]) =3D []
  | takewhile(p,X::Xs) =3D
  if p X then X::takewhile(p,Xs) else nil

fun dropwhile(p,[]) =3D []
  | dropwhile(p,X::Xs) =3D=20
      if p X then dropwhile(p,Xs) else X::Xs

exception List_replace;
fun list_replace( X::Xs, 0, Y ) =3D Y::Xs
  | list_replace( X::Xs, N, Y ) =3D
      if N>0 then X::list_replace(Xs,N-1,Y) else raise List_replace
  | list_replace(_,_,_) =3D raise List_replace;

exception Delete_nth
fun delete_nth(nil,_) =3D raise Delete_nth
  | delete_nth(X::Xs,N) =3D if N=3D0 then Xs else X::delete_nth(Xs,N-1)

fun fromto(Lower,Upper) =3D
  if Lower>Upper then nil else Lower::fromto(Lower+1,Upper)


fun real_sum( Xs : real list ) =3D
  case Xs of nil =3D> 0.0
  | X1::Xs1 =3D> X1+real_sum Xs1

fun real_prod( Xs : real list ) =3D
  case Xs of nil =3D> 1.0
  | X1::Xs1 =3D> X1*real_prod Xs1

fun int_sum( Xs : int list ) =3D
  case Xs of nil =3D> 0
  | X1::Xs1 =3D> X1+int_sum Xs1


fun combine( [], [] ) =3D []
  | combine( X::Xs, Y::Ys ) =3D (X,Y)::combine(Xs,Ys)

fun split [] =3D ([],[])
  | split( (X1,X2)::Xs ) =3D case split Xs of (Ys,Zs) =3D> =
(X1::Ys,X2::Zs)

val zip =3D combine
val unzip =3D split

fun indexize( Xs : 'a list, Start : int ) =3D
  combine( Xs, fromto( Start, Start + length Xs - 1 ) )

fun assoc_opt( X : ''a, Xs : (''a * 'b ) list ) : 'b option =3D
  case Xs of
    nil =3D> NONE
  | (X1,Y1)::Xs1 =3D> if X1=3DX then SOME Y1 else assoc_opt(X,Xs1)

fun assoc_opt'(eq : 'a*'a->bool, X : 'a, Xs : ('a * 'b ) list ) : 'b =
option =3D
  case Xs of
    nil =3D> NONE
  | (X1,Y1)::Xs1 =3D> if eq(X1,X) then SOME Y1 else =
assoc_opt'(eq,X,Xs1)

fun assoc(X,Xs) =3D case assoc_opt(X,Xs) of SOME Y =3D> Y

fun foldright( A, f, Xs ) =3D
  case Xs of nil =3D> A
  | X1::Xs1 =3D> f( X1, foldright(A,f,Xs1) )

fun flat_map( f, Xs ) =3D
  case Xs of nil =3D> nil | X1::Xs1 =3D> f(X1)@flat_map(f,Xs1)

fun flatten nil =3D nil
  | flatten (Xs::Xss) =3D Xs@flatten Xss

fun map( f, Xs ) =3D
  case Xs of nil =3D> nil | X1::Xs1 =3D> f(X1)::map(f,Xs1)

fun loop( f, Xs ) =3D
  case Xs of nil =3D> () | X1::Xs1 =3D> ( f X1; loop(f,Xs1) )

fun filter(p,Xs) =3D
  case Xs of
    nil =3D> nil
  | X1::Xs1 =3D>=20
      if p X1 then
        X1 :: filter( p, Xs1 )
      else
        filter( p, Xs1 )

fun pfilter( p, Xs ) =3D
  case Xs of
    nil =3D> ( nil, nil )
  | X1::Xs1 =3D>=20
  case pfilter( p, Xs1 ) of ( Ys, Zs ) =3D>
  if p X1 then
    ( X1::Ys, Zs )
  else
    ( Ys, X1::Zs )

fun forall(p,Xs) =3D null( filter( fn X =3D> not(p(X)), Xs ) )
fun exists(p,Xs) =3D=20
  case Xs of nil =3D> false
  | X1::Xs1 =3D> p X1 orelse exists(p,Xs1)

fun cart_prod(Xs,Ys) =3D flat_map( fn X =3D> map(fn Y=3D>(X,Y),Ys), Xs =
)

fun powset([],Base) =3D [Base]
  | powset(X::Xs,Base) =3D powset(Xs,Base) @ powset(Xs,X::Base)


exception Choose
fun choose( Xs : 'a list, K : int ) : 'a list list =3D
  if K > length Xs orelse K<0 then
    raise Choose
  else if K=3D0 then
    [[]]
  else if K=3Dlength Xs then
    [Xs]
  else case Xs of X1::Xs1 =3D>
    map( fn Ys =3D> X1::Ys, choose(Xs1,K-1) ) @ choose(Xs1,K)

fun mk_eq_classes( eq : 'a * 'a -> bool, Xs : 'a list ) : 'a list list =
=3D
let
  fun g [] =3D []
    | g( X :: Xs ) =3D
        case pfilter( fn Y :: _ =3D> eq( X, Y ), g Xs ) of
          ( [], Xss ) =3D> [X] :: Xss
        | ( [Ys], Xss ) =3D> ( X :: Ys ) :: Xss
in
  g Xs
end






fun count(X,Xs) =3D
  case Xs of nil =3D> 0 | X1::Xs1 =3D>=20
    if X=3DX1 then 1+count(X,Xs1) else count(X,Xs1)

fun member(X,Xs) =3D=20
  case Xs of nil =3D> false | X1::Xs1 =3D> X=3DX1 orelse member(X,Xs1)

fun is_subset(Xs,Ys) =3D forall( fn X =3D> member(X,Ys), Xs )

fun member'(eq,X,Xs) =3D=20
  case Xs of nil =3D> false | X1::Xs1 =3D> eq(X,X1) orelse =
member'(eq,X,Xs1)

fun is_set(Xs) =3D
  case Xs of nil =3D> true | X1::Xs1 =3D> not(member(X1,Xs1)) andalso =
is_set(Xs1)

fun is_set'(eq,Xs) =3D
  case Xs of=20
    nil =3D> true=20
  | X1::Xs1 =3D> not(member'(eq,X1,Xs1)) andalso is_set'(eq,Xs1)

fun make_set(Xs) =3D
  case Xs of nil =3D> nil=20
  | X1::Xs1 =3D> if member(X1,Xs1) then make_set(Xs1) else =
X1::make_set(Xs1)

fun make_set'(eq,Xs) =3D
  case Xs of nil =3D> nil=20
  | X1::Xs1 =3D>=20
      if member'(eq,X1,Xs1) then make_set'(eq,Xs1) else =
X1::make_set'(eq,Xs1)

fun fast_make_set( less, Xs ) =3D
  let fun ms(Xs) =3D
    case Xs of=20
      nil =3D> Xs
    | X::nil =3D> Xs
    | X1::(Xs1 as X2::Xs2) =3D> if less(X1,X2) then X1::ms(Xs1) else ms =
Xs1
  in
    ms(Lib.sort less Xs )
  end


fun duplicates(Xs) =3D
case Xs of
  nil =3D> nil
| X1::Xs1 =3D> if member(X1,Xs1) then X1::duplicates(Xs1) else =
duplicates(Xs1)

fun list_eq( eq : 'a * 'a -> bool, Xs : 'a list, Ys : 'a list ) =3D
  let=20
    fun g( [], [] ) =3D true
      | g( [], _ ) =3D false
      | g( _, [] ) =3D false
      | g( X :: Xs, Y :: Ys ) =3D eq( X, Y ) andalso g( Xs, Ys )
  in
    g( Xs, Ys )
  end

fun option_eq( eq : 'a * 'a -> bool, X : 'a option, Y : 'a option ) : =
bool =3D
  case X of
    NONE =3D> ( case Y of NONE =3D> true | SOME _ =3D> false )
  | SOME X =3D>
  case Y of
    NONE =3D> false
  | SOME Y =3D> eq( X, Y )

fun stable_sort (less : 'a * 'a -> bool) Xs =3D
  map(#1, sort (fn((X1,N1),(X2,N2)) =3D>=20
    less(X1,X2) orelse not(less(X2,X1)) andalso N1<N2)
                (combine(Xs,fromto(1,length Xs))))

fun delete_one(X,Xs) =3D
  case Xs of
    nil =3D> nil
  | X1::Xs1 =3D> if X=3DX1 then Xs1 else X1::delete_one(X,Xs1)

fun min( less, Xs ) =3D=20
  case Xs of
    X1::nil =3D> X1
  | X1::Xs1 =3D> let val M =3D min(less,Xs1) in
      if less(M,X1) then M else X1
      end

fun max( less, Xs ) =3D
  case Xs of
    X1::nil =3D> X1
  | X1::X2::Xs2 =3D> if less(X1,X2) then max(less,X2::Xs2) else =
max(less,X1::Xs2)

fun is_subsequence( [], _ ) =3D true
  | is_subsequence( X1 :: Xs1,  [] ) =3D false
  | is_subsequence(  Xs as X1 :: Xs1, Y1 :: Ys1 ) =3D=20
      if X1 =3D Y1 then
        is_subsequence( Xs1, Ys1 )
      else
        is_subsequence( Xs, Ys1 )



local

fun lcp( eq, So_far, Xss ) =3D
  if exists( null, Xss ) then
    rev So_far
  else=20
  case Xss of ( X :: _ ) :: Xss1 =3D>
  if forall( fn Y::_ =3D> eq( X, Y ), Xss1 ) then
    lcp( eq, X :: So_far, map( tl, Xss ) )
  else
    rev So_far

in=20

fun longest_common_prefix'( eq : 'a * 'a -> bool,=20
      Xss : 'a list list ) : 'a list =3D
  case Xss of
    [] =3D> []
  | [ Xs ] =3D> Xs
  | _::_::_ =3D> lcp( eq, [], Xss )

end (* local *)
 =20
fun longest_common_prefix( Xss : ''a list list ) : ''a list =3D
  longest_common_prefix'( op=3D,  Xss )




(*

See lcs.sml instead

local
  open Array2
in

fun lcs(eq, Xs, Ys ) : int =3D
  let
    val Memomatrix : int option array =3D=20
      array( length Xs, length Ys, NONE )
    fun lcs'( _, _, [], _ ) =3D 0
      | lcs'( _, _, _, [] ) =3D 0
      | lcs'( I, J,  Xs as X1::Xs1, Ys as Y1::Ys1 ) =3D
      case sub( Memomatrix, I, J ) of
        SOME N =3D> N
      | NONE =3D>
      let val N =3D
            if eq(X1,Y1) then
              1 + lcs'(I+1,J+1,Xs1,Ys1)
            else
              max2( op<, lcs'(I+1,J,Xs1,Ys),  lcs'(I,J+1,Xs,Ys1) )
      in
        update(Memomatrix,I,J,SOME N);
        N
      end
  in
    lcs'(0,0,Xs,Ys)
  end

end (* local *)

*)

(*
fun test1() =3D lcs(op=3D, [1,2,3,2,4,1,2], [2,4,3,1,2,1] )

fun test2() =3D timeit( fn () =3D> lcs( op=3D,
  [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25],
  [1,7,3,4,5,6,7,8,5,10,11,12,13,14,15,16,11,18,19,20,21,22,23,21,25]) =
)
*)

fun difference(Xs,Ys) =3D
  case Xs of nil =3D> nil
  | X1::Xs1 =3D>
      if member(X1,Ys) then difference(Xs1,Ys) else =
X1::difference(Xs1,Ys)

fun difference'(eq,Xs,Ys) =3D
  case Xs of nil =3D> nil
  | X1::Xs1 =3D>
      if member'(eq,X1,Ys) then difference'(eq,Xs1,Ys) else=20
        X1::difference'(eq,Xs1,Ys)

fun is_sorted( less, Xs ) =3D
  case Xs of
    [] =3D> true
  | [X] =3D> true
  | X1::( Xs1 as X2::Xs2) =3D>=20
      not(less(X2,X1)) andalso is_sorted(less,Xs1)

fun cmp_is_sorted( cmp, Xs ) =3D
  is_sorted( fn( X, Y ) =3D> case cmp( X, Y ) of LESS =3D> true | _ =
=3D> false, Xs )

exception Sorted_difference
fun sorted_difference( less, Xs, Ys ) =3D
  if not(is_sorted(less,Xs)) orelse not(is_sorted(less,Ys)) then
    raise Sorted_difference
  else
  case Xs of nil =3D> nil
  | X1::Xs1 =3D> case Ys of nil =3D> Xs
  | Y1::Ys1 =3D>
      if less(X1,Y1) then
        X1::sorted_difference(less,Xs1,Ys)
      else if less(Y1,X1) then
        sorted_difference(less,Xs,Ys1)
      else
        sorted_difference(less,Xs1,Ys)

fun fast_difference( less, Xs, Ys ) =3D
  sorted_difference( less, Lib.sort less Xs, Lib.sort less Ys )



fun intersection(Xs,Ys) =3D
  case Xs of nil =3D> nil
  | X1::Xs1 =3D>=20
      if member(X1,Ys) then X1::intersection(Xs1,Ys) else =
intersection(Xs1,Ys)

exception Sorted_intersection
fun sorted_intersection( less, Xs, Ys ) =3D
  if not(is_sorted(less,Xs)) orelse not(is_sorted(less,Ys)) then
    raise Sorted_intersection
  else
  case Xs of nil =3D> nil
  | X1::Xs1 =3D> case Ys of nil =3D> nil
  | Y1::Ys1 =3D>
      if less(X1,Y1) then
        sorted_intersection(less,Xs1,Ys)
      else if less(Y1,X1) then
        sorted_intersection(less,Xs,Ys1)
      else
        X1::sorted_intersection(less,Xs1,Ys1)



fun fast_intersection( less, Xs, Ys ) =3D
  sorted_intersection( less, Lib.sort less Xs, Lib.sort less Ys )


fun sorted_intersections( less : 'a*'a->bool, Xss : 'a list list ) =3D
  case Xss of
    [] =3D> []
  | _ =3D>
  let fun g Xss =3D
    case Xss of
      [Xs] =3D> Xs
    | Xs::Xss =3D> sorted_intersection( less, Xs, g Xss )
  in
    g Xss
  end



fun list_insert(less,X,Xs) =3D
  case Xs of
    nil =3D> X::nil
  | X1::Xs1 =3D> if less(X,X1) then X::X1::Xs1 else =
X1::list_insert(less,X,Xs1)


fun list_out(out : outstream, print : outstream * 'a -> unit, Xs : 'a =
list ) =3D
  let fun p S =3D output(out,S)
  in
  p "[ "; (
  case Xs of
    nil =3D> ()
  | _::_ =3D> (
    loop( fn X =3D> ( print(out,X); p", " ), lt Xs );
    print( out, dh Xs ) )
  );
  p " ]"
  end

fun real_list_out(out : outstream, Xs : real list ) =3D
  list_out( out, fn(Stream,X) =3D> output(Stream,Real.toString X), Xs)

fun int_list_out(out : outstream, Xs : int list ) =3D
  list_out( out, fn(Stream,X) =3D> output(Stream,Int.toString X), Xs)

fun bool_list_out(out : outstream, Xs : bool list ) =3D
  list_out( out, fn(Stream,X) =3D> output(Stream,Bool.toString X), Xs)

fun print_list(print : 'a -> unit, Xs : 'a list ) =3D
  list_out(!std_out, fn(Stream,X) =3D> print X, Xs)

fun print_int_list( Xs : int list ) =3D
  print_list( fn X =3D> output(!std_out,Int.toString X), Xs )

fun print_word32_list( Xs : Word32.word list ) =3D
  print_list( fn X =3D> output(!std_out,Word32.toString X), Xs )

fun print_real_list( Xs : real list ) =3D
  print_list( fn X =3D> output(!std_out,Real.toString X), Xs )

fun print_bool_list( Xs : bool list ) =3D
  print_list( fn X =3D> output(!std_out,Bool.toString X), Xs )

fun print_bool_list_list( Xss : bool list list ) =3D
  print_list(fn Xs =3D> (print_bool_list Xs; output(!std_out,"\n")), =
Xss)



fun print_int_opt NONE =3D p "NONE "
  | print_int_opt( SOME X ) =3D p( "SOME " ^ Int.toString X ^ " " )

fun print_real_opt NONE =3D p "NONE "
  | print_real_opt( SOME X ) =3D p( "SOME " ^ Real.toString X ^ " " )

fun scramble( Xs : 'a list ) : 'a list =3D
  map(#1,
    sort (fn ((_,X),(_,Y)) =3D> X<Y)
      (combine(Xs,map(fn _ =3D> randReal(),fromto(1,length Xs)))))

exception rand_choice_exn
fun rand_choice( Xs : 'a list ) : 'a =3D
  case Xs of [] =3D> raise rand_choice_exn | _ =3D>
  nth( Xs, randRange( 0, length Xs -1 ) ) =20





(* List hashing function: *)

local

val N_rands =3D 10000

val Rand =3D Random.rand( 8362696, ~279264173 )

val next =3D fn() =3D> Random.randReal Rand

val Rand_vector : real vector =3D
  Vector.tabulate( N_rands, fn I =3D> next() - 0.5 )

fun next_random Rand_vector_index =3D (
  Rand_vector_index :=3D !Rand_vector_index + 1;
  Vector.sub( Rand_vector, !Rand_vector_index )
  )
  handle Subscript =3D> (
    Rand_vector_index :=3D ~1;
    next_random Rand_vector_index
    )

fun hash( Hash_val : real ref, Rand_vector_index : int ref, X : real ) =
: unit =3D
  Hash_val :=3D 0.45243233 + X * next_random Rand_vector_index + =
!Hash_val
   =20
in (* local *)

fun list_hash( f : 'a -> real, Xs : 'a list ) : real =3D=20
  let
    val Hash_val =3D ref 0.0  =20
    val Rand_vector_index =3D ref ~1
  in
    loop( fn X =3D>  hash( Hash_val, Rand_vector_index, f X ),  Xs );
    !Hash_val + 0.325454325
  end

end (* local *)



end (* List1 *)


functor Hash_make_set_functor( H : MONO_HASH_TABLE ) :=20
sig
   val hash_make_set : H.Key.hash_key list -> H.Key.hash_key list
end =3D
struct

exception Hash_make_set_exn

fun hash_make_set Xs =3D
  let
    val Table : unit H.hash_table =3D=20
      H.mkTable( length Xs, Hash_make_set_exn )
  in
    List1.filter( fn X =3D>=20
      case H.find Table X of
        NONE =3D> ( H.insert Table (X,()); true )
      | SOME _ =3D> false,
      Xs )
  end

end=20

 =20
signature HASH_SET =3D
sig
  structure Key : HASH_KEY
  type item =3D Key.hash_key
  structure H : MONO_HASH_TABLE
  type set =3D unit H.hash_table
  val empty : unit -> set
  val insert : item * set -> unit
  val delete : item * set -> unit
  val list_to_set : item list -> set
  val set_to_list : set -> item list=20
  val member : item * set -> bool
  val loop : (item -> 'a) * set -> unit
  val singleton : item -> set=20
  val union : set * set -> set
  val intersection : set * set -> set
  val difference : set * set -> set
  val union_map : ('a -> set) * 'a list -> set
end=20

functor HashSet( Key : HASH_KEY ) : HASH_SET =3D
struct
structure Key =3D Key

type item =3D Key.hash_key

structure H =3D HashTableFn( Key )

type set =3D unit H.hash_table

exception HashSet_exn

fun empty() : set =3D H.mkTable( 10, HashSet_exn )

fun insert( X : item, Xs : set ) :  unit =3D H.insert Xs ( X, () )

fun delete( X : item, Xs : set ) :  unit =3D H.remove Xs X

fun list_to_set( Xs : item list ) : set =3D
  let
    val Ys =3D H.mkTable( length Xs, HashSet_exn )
  in
    List1.loop( fn X =3D> insert( X, Ys ), Xs );
    Ys
  end  =20

fun set_to_list( Xs : set ) : item list =3D List1.map( #1, H.listItemsi =
Xs )

fun member( X : item, Xs : set ) : bool =3D
  case H.find Xs X of NONE =3D> false | SOME _ =3D> true

fun loop( f, Xs ) =3D H.appi ( fn( X, () ) =3D> (f X; ()) ) Xs
  =20


fun singleton( X : item ) :  set =3D
  case empty() of Xs =3D> ( insert( X, Xs );  Xs )

fun union( Xs : set, Ys : set ) : set =3D
  let
    val Zs =3D H.copy Xs
  in
    loop( fn Y =3D> insert( Y, Zs ), Ys );
    Zs
  end
   =20
 =20
fun intersection( Xs : set, Ys : set ) : set =3D
  let
    val Zs =3D empty()
  in
    loop( fn X =3D> if member( X, Ys ) then insert( X, Zs ) else (), Xs =
);
    Zs
  end
     =20
 =20
fun difference( Xs : set, Ys : set ) : set =3D
  let
    val Zs =3D empty()
  in
    loop( fn X =3D> if member( X, Ys ) then () else insert( X, Zs ), Xs =
);
    Zs
  end
     =20

fun union_map( f : 'a -> set, Xs : 'a list ) =3D
  case Xs of
    [] =3D> empty()
  | X :: Xs =3D> union( f X, union_map( f, Xs ) )


end (* functor HashSet *)



structure Int_set =3D HashSet( Lib.Int_hash_key )
structure Real_set =3D HashSet( Lib.Real_hash_key )


structure Tree =3D
struct
open List1

datatype 'a tree =3D tree_cons of 'a * 'a tree list

datatype 'a bin_tree =3D bt_nil | bt_cons of 'a * 'a bin_tree * 'a =
bin_tree

fun bt_map( f : 'a -> 'b, Xs : 'a bin_tree ) : 'b bin_tree =3D
  case Xs of
    bt_nil =3D> bt_nil
  | bt_cons(RoXs,LeXs,RiXs) =3D>=20
      bt_cons( f RoXs, bt_map(f,LeXs), bt_map(f,RiXs) )

fun is_leaf( tree_cons(_,Subs) ) =3D null(Subs);

fun root( tree_cons(Root,_) ) =3D Root;
fun subs( tree_cons(_,Subs) ) =3D Subs;

fun preorder( tree_cons(X,Xs) : 'a tree ) : 'a list =3D
  X::flat_map(preorder,Xs)


fun leaves( tree_cons(X,Xs) : 'a tree ) : 'a list =3D
  case Xs of
    nil =3D> X::nil
  | _ =3D> flat_map(leaves,Xs)

fun positions( tree_cons(Root,Subs) : 'a tree ) : int list list =3D
  []::flat_map( fn (Order_no,Sub_pos_list) =3D>
                  map( fn Sub_pos =3D> Order_no::Sub_pos, Sub_pos_list =
),
                combine( fromto(0,length(Subs)-1), map(positions,Subs) =
)
                )

fun pos_to_sub( T as tree_cons(Root,Subs) : 'a tree, Pos : int list )
  : 'a tree =3D
  case Pos of
    nil =3D> T
  | P::Ps =3D> pos_to_sub(nth(Subs,P),Ps)

fun pos_replace( Old as tree_cons(Root,Subs), Pos : int list, New )
  : 'a tree =3D
  case Pos of
    nil =3D> New
  | P::Ps =3D>
    tree_cons(
      Root,
      list_replace( Subs, P, pos_replace(nth(Subs,P),Ps,New) )
      )

fun add_sub_right( T : 'a tree, Pos : int list, Sub : 'a tree)
  : 'a tree =3D
  let val tree_cons(X,Xs) =3D pos_to_sub(T,Pos)
  in
    pos_replace( T, Pos, tree_cons(X,snoc(Xs,Sub)) )
  end

end (* structure Tree *)

(*
require "basis.__vector";
require "basis.__array";
require "basis.__list";
require "basis.__string";
require "basis.__int";
require "basis.__word";
require "hash-table-sig.sml";
require "hash-table.sml";
require "dynamic-array-sig.sml";
require "dynamic-array.sml";
require "lib.sml";
*)

(* File: ast.sml
   Created: 1993-05-21
   Modified: 1996-08-06
*)

signature AST =3D
sig


datatype symbol_category =3D=20
    func_sym | var_sym | emb_sym | not_activated_sym | dont_know_sym=20
  | ty_var_sym | ty_con_sym | int_sym

val symbol_category_to_string : symbol_category -> string
val string_to_symbol_category : string -> symbol_category=20
type symbol =3D symbol_category*Word.word*Word.word
val symbol_hash : symbol -> Word.word
val real_symbol_hash : symbol -> real
val string_to_symbol : symbol_category * string -> symbol
val string_to_symbol' : string -> symbol
val string_to_qsymbol : string -> symbol
val symbol_to_string : symbol -> string
val get_predefined_syms : unit -> symbol list
val symbol_less : symbol * symbol -> bool
val int_to_symbol : int -> symbol
val int_sym_to_int : symbol -> int
structure Symbol_hash_key : HASH_KEY
structure Symbol_HashTable : MONO_HASH_TABLE
structure Symbol_dyn : MONO_DYNAMIC_ARRAY

type ty_var =3D symbol

datatype ty_exp =3D
  ty_var_exp of ty_var
| ty_con_exp of symbol * ty_exp list

type ty_schema =3D { schematic_vars : ty_var list, ty_exp :  ty_exp }
(* See Peyton-Jones book for documentation of this type *)

type ty_env =3D (symbol * ty_schema) list

datatype ('a,'b)e =3D
  app_exp of { func : symbol, args : ('a,'b)e list, exp_info : 'a }
| case_exp of {=20
    exp : ('a,'b)e,=20
    rules : {
      pat:('a,'b)e,
      exp:('a,'b)e,
      act_index : int ref,
      act_count : int ref,
      activated : bool ref
      } list,
    exp_info : 'a=20
    }
| let_exp of {=20
    dec_list : {=20
      func : symbol,=20
      pat : ('a,'b)e,=20
      exp:('a,'b)e,
      dec_info : 'b
      } list,
    exp : ('a,'b)e,
    exp_info : 'a=20
    }
| as_exp of { var : symbol, pat : ('a,'b)e, exp_info : 'a }

type ('a,'b)rule_type =3D {
      pat:('a,'b)e,
      exp:('a,'b)e,
      act_index : int ref,
      act_count : int ref,
      activated : bool ref
      }=20



type ('a,'b)d =3D {=20
  func : symbol,=20
  pat : ('a,'b)e,=20
  exp : ('a,'b)e,=20
  dec_info : 'b=20
  }

val set_exp : ('a,'b)d * ('a,'b)e -> ('a,'b)d

type exp_info_type =3D ty_exp
type dec_info_type =3D ty_schema

val no_exp_info : unit -> exp_info_type
val no_dec_info : unit -> ty_schema

val is_no_exp_info : exp_info_type -> bool
val is_no_dec_info : dec_info_type -> bool

val mk_exp_info : ty_exp -> exp_info_type
val get_ty_exp : exp_info_type -> ty_exp
val set_ty_exp : exp_info_type * ty_exp -> exp_info_type


val mk_rule : ('a,'b)rule_type * ('c,'d)e * ('c,'d)e -> =
('c,'d)rule_type
val mk_new_rule : ('a,'b)e * ('a,'b)e -> ('a,'b)rule_type

type exp =3D ( exp_info_type, dec_info_type )e
type pat=3Dexp
type dec =3D ( exp_info_type, dec_info_type )d

type datatype_dec =3D {
  ty_con : symbol,
  ty_pars : ty_var list,
  alts : { constr : symbol, domain : ty_exp option } list
  }

type type_dec =3D {
  ty_con : symbol,
  ty_pars : ty_var list,
  ty_exp : ty_exp=20
  }

datatype parse_result =3D
  parsed_fun of dec list
| parsed_type of type_dec
| parsed_datatype of datatype_dec list


val TUPLE : symbol
val TUPLE_TY_CON : symbol
val INT : symbol
val BOOL : symbol
val INPUT_TYPE : symbol
val OUTPUT_TYPE : symbol
val THIN_ARROW : symbol
val PREDEFINED_NOT_ACTIVATED_SYMBOL : symbol
val EQ : symbol
val SEMICOLON : symbol
val LESS' : symbol
val PLUS : symbol
val MUL : symbol
val DIV : symbol
val MINUS : symbol
val UMINUS : symbol
val CONS : symbol
val APPEND : symbol
val FALSE : symbol
val TRUE : symbol
val F : symbol
val ANON : symbol
val DUMMY_FUNC : symbol
val DUMMY_TY_CON : symbol
val DUMMY_SYMBOL : symbol
val dummy_exp : 'a -> ('a,'b)e
val Dummy_exp : exp
val Dummy_dec : dec
val Dummy_ty_exp : ty_exp
val Dummy_ty_schema : ty_schema

val type_of_exp : exp -> ty_exp

val is_predefined_sym : symbol -> bool
val is_generated_sym : symbol -> bool
val is_int : symbol -> bool
val is_int_exp : ('a,'b)e -> bool
val is_variable : symbol -> bool
val is_ty_var : symbol -> bool
val is_variable_exp : ('a,'b)e -> bool
val is_function : symbol -> bool
val is_q : symbol -> bool
val is_q_exp : ('a,'b)e -> bool
val is_not_activated_sym : symbol -> bool
val is_not_activated_exp : ('a,'b)e -> bool
val is_not_activated_rule : ('a,'b)rule_type -> bool
val is_emb_exp : ('a,'b)e -> bool
val is_dont_know_exp : ('a,'b)e -> bool
val is_app_exp : ('a,'b)e -> bool
val is_case_exp : ('a,'b)e -> bool
val is_let_exp : ('a,'b)e -> bool
val is_leaf : ('a,'b)e -> bool
val is_tuple_exp : ('a,'b)e -> bool
val is_anon_sym : symbol -> bool
val is_anon_exp : ('a,'b)e -> bool
val is_fun_type : ty_exp -> bool
val is_tuple_type : ty_exp -> bool


val sym_no : unit -> word * word
val set_sym_no : word * word -> unit
val gen_func_sym : unit -> symbol
val gen_ty_var_sym : unit -> symbol
val gen_var_sym : unit -> symbol
val gen_var_exp : 'a -> ('a,'b) e
val gen_emb_sym : unit -> symbol
val gen_emb_exp : 'a -> ('a,'b) e
val gen_not_activated_sym  : unit -> symbol
val gen_not_activated_exp : 'a -> ('a,'b) e
val gen_dont_know_sym : unit -> symbol
val gen_dont_know_exp : 'a -> ('a,'b) e

val mk_anon_exp : 'a -> ('a,'b)e

val vars_in_ty_exp : ty_exp -> ty_var list
val ty_cons_in_ty_exp : ty_exp -> symbol list
val vars_in_pure_tuple_pat : ('a,'b)e -> symbol list
val vars_in_pat : ('a,'b)e -> symbol list
val var_exps_in_pat : ('a,'b)e -> ('a,'b)e list=20

val get_exp_info : ('a,'b)e -> 'a
val set_exp_info : ('a,'b)e * 'a -> ('a,'b)e

val exp_size : ('a,'b)e -> int
val rename :  ('a,'b)e * bool -> ('a,'b)e=20
val rename_decs :  ('a,'b)d list * bool -> ('a,'b)d list

val Debug : bool ref

val print_syms : symbol list -> unit

end (* sig AST *)


structure Ast : AST =3D
struct

open Lib
open List1

datatype symbol_category =3D=20
    func_sym | var_sym | emb_sym | not_activated_sym | dont_know_sym=20
  | ty_var_sym | ty_con_sym | int_sym



fun symbol_category_to_string( X :  symbol_category ) =3D
  case X of
    func_sym =3D> "func_sym"
  | var_sym =3D> "var_sym"
  | emb_sym =3D> "emb_sym"
  | not_activated_sym =3D> "not_activated_sym"
  | dont_know_sym =3D> "dont_know_sym"
  | ty_var_sym =3D> "ty_var_sym"
  | ty_con_sym =3D> "ty_con_sym"=20
  | int_sym =3D> "int_sym"

fun string_to_symbol_category( X : string ) =3D
  case X of
    "func_sym" =3D> func_sym
  | "var_sym" =3D> var_sym
  | "emb_sym" =3D> emb_sym
  | "not_activated_sym" =3D> not_activated_sym
  | "dont_know_sym" =3D> dont_know_sym
  | "ty_var_sym" =3D> ty_var_sym
  | "ty_con_sym" =3D> ty_con_sym
  | "int_sym" =3D> int_sym

type symbol =3D symbol_category*word*word
(*=20
  A symbol (Cat,0,N) represents a predefined identifier.
  A symbol of the form (Cat,1,N) is used for canonization.
  A symbol (Cat,M,N) with M>=3D2 represents a generated identifier.
*)

fun is_predefined_sym(Cat,M,N) =3D M =3D Word.fromInt 0
fun is_generated_sym(Cat,M,N) =3D M >=3D Word.fromInt 2


exception Symbol_HashTable_exn
structure H =3D Lib.String_HashTable
val Symbol_table : symbol H.hash_table =3D=20
(*=20
  Maps a string (predefined identifier) to the corresponding=20
   symbol.=20
*)
  H.mkTable(1000,Symbol_HashTable_exn)


fun get_predefined_syms() : symbol list =3D
  map( #2, H.listItemsi Symbol_table )

structure String_dyn =3D DynamicArrayFn(
  struct
    open Array
    type elem =3D string
  type vector =3D elem Vector.vector
    type array =3D string array
    structure Vector =3D=20
struct
  open Vector
  type elem =3D string
  type vector =3D elem Vector.vector
end
  end=20
  )


val String_table: String_dyn.array =3D=20
  String_dyn.array(2,"UNDEFINED SYMBOL")
val Top : int ref =3D ref 0

fun string_to_symbol( Cat : symbol_category, S : string ) : symbol =3D
(*
  Inserts S in the next free entry in array of predefined symbols
  if S is an unseen symbol.
*)
  case H.find Symbol_table S of
    SOME Sym =3D> Sym
  | NONE =3D> (
      String_dyn.update( String_table, !Top, S );
      let val Sym =3D ( Cat, Word.fromInt 0, Word.fromInt(!Top) ) in
        H.insert Symbol_table (S,Sym);
        inc Top;
        Sym
      end
      )


fun string_to_symbol'( S : string ) : symbol =3D
  case String.explode S of
    #"?" :: #"_" :: #"E" :: #"M" :: #"B" :: _ =3D>
      string_to_symbol( emb_sym, S )
  | #"?" :: #"_" :: #"D" :: _ =3D>
      string_to_symbol( dont_know_sym, S )
  | #"?" :: #"_" :: #"N" :: #"A" :: _ =3D>
      string_to_symbol( not_activated_sym, S )
  | _ =3D> string_to_symbol( func_sym, S )

exception String_to_qsymbol_exn
fun string_to_qsymbol( S : string ) : symbol =3D
  case String.explode S of
    #"E" :: #"M" :: #"B" :: _ =3D>
      string_to_symbol( emb_sym, S )
  | #"D" :: _ =3D>
      string_to_symbol( dont_know_sym, S )
  | #"N" :: #"A" :: _ =3D>
      string_to_symbol( not_activated_sym, S )
  | #"?" :: #"_" :: #"E" :: #"M" :: #"B" :: _ =3D>
      string_to_symbol( emb_sym, S )
  | #"?" :: #"_" :: #"D" :: _ =3D>
      string_to_symbol( dont_know_sym, S )
  | #"?" :: #"_" :: #"N" :: #"A" :: _ =3D>
      string_to_symbol( not_activated_sym, S )
  | _ =3D> (
      output( !std_err, "\nIllegal exception name:" ^ S ^
        "\nExceptions must start with EMB, D or NA.\n\n");
      raise String_to_qsymbol_exn
      )


fun is_q(Cat,_,_) =3D
  case Cat of=20
    emb_sym =3D> true
  | not_activated_sym =3D> true
  | dont_know_sym  =3D> true
  | _ =3D> false=20
 =20
fun symbol_to_string( Sym as (Cat,M,N) : symbol ) : string =3D
  if is_predefined_sym Sym then
    (if is_q Sym then "(raise " else "") ^
    String_dyn.sub( String_table, Word.toInt N) ^
    (if is_q Sym then ")" else "")
  else
  let val Suffix =3D Word.toString M ^ "_" ^ Word.toString N in
    case Cat of
      func_sym =3D> "g" ^ Suffix
    | var_sym =3D> "V" ^ Suffix
    | not_activated_sym =3D> "(raise NA_" ^ Suffix ^ ")"
    | emb_sym =3D> "(raise EMB_" ^ Suffix ^ ")"
    | dont_know_sym =3D> "(raise D_" ^ Suffix ^ ")"
    | ty_var_sym =3D> "'" ^ Suffix
    | ty_con_sym =3D> "c" ^ Suffix
    | int_sym =3D> Int.toString( Word.toIntX N )
  end

fun symbol_less( (_,M1,N1) : symbol, (_,M2,N2) : symbol ) : bool =3D
  Word.<(M1,M2) orelse M1=3DM2 andalso Word.<(N1,N2)

fun int_to_symbol( N : int ) :  symbol =3D
  ( int_sym, Word.fromInt(~1), Word.fromInt N )

fun int_sym_to_int( (int_sym,_,N) : symbol ) : int =3D
  Word.toIntX N
=20
type ty_var =3D symbol

datatype ty_exp =3D
  ty_var_exp of ty_var
| ty_con_exp of symbol * ty_exp list

type ty_schema =3D { schematic_vars : ty_var list, ty_exp :  ty_exp }
(* See Peyton-Jones book for documentation of this type *)

type ty_env =3D (symbol * ty_schema) list


datatype ('a,'b)e =3D
  app_exp of { func : symbol, args : ('a,'b)e list, exp_info : 'a }
| case_exp of {=20
    exp : ('a,'b)e,=20
    rules : {
      pat:('a,'b)e,
      exp:('a,'b)e,
      act_index : int ref,
      act_count : int ref,
      activated : bool ref
      } list,
    exp_info : 'a=20
    }
| let_exp of {=20
    dec_list : {=20
      func : symbol,=20
      pat : ('a,'b)e,=20
      exp:('a,'b)e,
      dec_info : 'b
      } list,
    exp : ('a,'b)e,
    exp_info : 'a=20
    }
| as_exp of { var : symbol, pat : ('a,'b)e, exp_info : 'a }


type ('a,'b)rule_type =3D {
      pat:('a,'b)e,
      exp:('a,'b)e,
      act_index : int ref,
      act_count : int ref,
      activated : bool ref
      }=20


type ('a,'b)d =3D {=20
  func : symbol,=20
  pat : ('a,'b)e,=20
  exp : ('a,'b)e,=20
  dec_info : 'b=20
  }

fun set_exp( { func, pat, exp, dec_info } : ('a,'b)d, E : ('a,'b)e )
    : ('a,'b)d =3D
  { func =3D func, pat =3D pat, exp =3D E, dec_info =3D dec_info }

type exp_info_type =3D ty_exp
type dec_info_type =3D ty_schema

fun get_ty_exp TE =3D TE

fun set_ty_exp( _, TE ) =3D TE=20


fun mk_rule( { act_index, act_count, activated, ... } : =
('a,'b)rule_type,
      Pat : ('c,'d)e, E : ('c,'d)e ) =3D {
  pat =3D Pat,
  exp =3D E,
  act_index =3D ref( !act_index ),
  act_count =3D ref( !act_count ),
  activated =3D ref( !activated )
  }


fun mk_new_rule( Pat : ('a,'b)e, E : ('a,'b)e ) =3D {
  pat =3D Pat,
  exp =3D E,
  act_index =3D ref 0,
  act_count =3D ref 0,
  activated =3D ref false
  }


type exp =3D ( exp_info_type, dec_info_type )e
type pat=3Dexp
type dec =3D ( exp_info_type, dec_info_type )d


type datatype_dec =3D {
  ty_con : symbol,
  ty_pars : ty_var list,
  alts : { constr : symbol, domain : ty_exp option } list
  }

type type_dec =3D {
  ty_con : symbol,
  ty_pars : ty_var list,
  ty_exp : ty_exp=20
  }

datatype parse_result =3D
  parsed_fun of dec list
| parsed_type of type_dec
| parsed_datatype of datatype_dec list

val TUPLE =3D string_to_symbol( func_sym, "___tuple" )
val TUPLE_TY_CON =3D string_to_symbol( ty_con_sym, "___tuple" )
val INT =3D string_to_symbol( ty_con_sym, "int" )
val BOOL =3D string_to_symbol( ty_con_sym, "bool" )
val INPUT_TYPE =3D string_to_symbol( ty_con_sym, "input_type" )
val OUTPUT_TYPE =3D string_to_symbol( ty_con_sym, "output_type" )
val THIN_ARROW =3D string_to_symbol( ty_con_sym, "->" )
val PREDEFINED_NOT_ACTIVATED_SYMBOL =3D string_to_symbol( =
not_activated_sym, "?_NA_PREDEFINED" )
val EQ =3D string_to_symbol( func_sym, "=3D" )
val SEMICOLON =3D string_to_symbol( func_sym, ";" )
val LESS' =3D string_to_symbol( func_sym, "<" )
val PLUS =3D string_to_symbol( func_sym, "+" )
val MUL =3D string_to_symbol( func_sym, "*" )
val DIV =3D string_to_symbol( func_sym, "/" )
val MINUS =3D string_to_symbol( func_sym, "-" )
val UMINUS =3D string_to_symbol( func_sym, "~" )
val CONS =3D string_to_symbol( func_sym, "::" )
val APPEND =3D string_to_symbol( func_sym, "@" )
val FALSE =3D string_to_symbol( func_sym, "false" )
val TRUE =3D string_to_symbol( func_sym, "true" )
val ANON =3D string_to_symbol( func_sym, "_" )
val F =3D string_to_symbol( func_sym, "f" )


val DUMMY_FUNC =3D string_to_symbol( func_sym, "___dummy" )
val DUMMY_SYMBOL =3D DUMMY_FUNC
val DUMMY_TY_CON =3D string_to_symbol( ty_con_sym, "___dummy_ty_con" )

val Dummy_ty_exp =3D ty_con_exp( DUMMY_TY_CON, [] )

fun dummy_exp(Exp_info : 'a) : ('a,'b)e =3D=20
  app_exp{
    func=3DDUMMY_FUNC,
    args=3Dnil,
    exp_info=3DExp_info
    }

val Dummy_exp : exp =3D dummy_exp Dummy_ty_exp

val Dummy_ty_schema =3D { schematic_vars =3D [], ty_exp =3D =
Dummy_ty_exp }


val Dummy_dec : dec =3D {
  func=3DDUMMY_FUNC,
  pat=3DDummy_exp,
  exp=3DDummy_exp,
  dec_info=3DDummy_ty_schema
  }

fun no_exp_info() =3D Dummy_ty_exp
fun no_dec_info() =3D Dummy_ty_schema

fun is_no_exp_info TE =3D TE =3D no_exp_info()
fun is_no_dec_info Sch =3D Sch =3D no_dec_info()

fun mk_exp_info TE =3D TE

fun is_int(int_sym,_,_) =3D true
  | is_int _ =3D false

fun is_int_exp( app_exp{ func, ... } : ('a,'b)e ) =3D is_int func
  | is_int_exp _ =3D false

fun is_variable(var_sym,_,_) =3D true
  | is_variable _ =3D false

fun is_ty_var(ty_var_sym,_,_) =3D true
  | is_ty_var(_,_,_) =3D false

fun is_variable_exp( app_exp{ func, ... } ) =3D is_variable func
  | is_variable_exp _ =3D false

fun is_function(func_sym,_,_) =3D true
  | is_function _ =3D false

fun is_q_exp( app_exp{ func, ... } : ('a,'b)e ) =3D is_q func
  | is_q_exp _ =3D false

fun is_emb_exp(=20
      app_exp{ func=3D(emb_sym,_,_), ... } : ('a,'b)e ) =3D=20
        true
  | is_emb_exp _ =3D false

fun is_not_activated_sym( (not_activated_sym,_,_) ) =3D true
  | is_not_activated_sym _ =3D false

fun is_not_activated_exp(=20
      app_exp{ func=3D(not_activated_sym,_,_), ... } : ('a,'b)e ) =3D=20
        true
  | is_not_activated_exp _ =3D false

fun is_not_activated_rule( { exp, ... } : ('a,'b) rule_type ) =3D
  is_not_activated_exp exp

fun is_dont_know_exp(=20
      app_exp{ func=3D(dont_know_sym,_,_), ... } : ('a,'b)e ) =3D true
  | is_dont_know_exp _ =3D false

fun is_app_exp( app_exp{...} ) =3D true
  | is_app_exp _ =3D false

fun is_case_exp(case_exp{...}) =3D true
  | is_case_exp _ =3D false

fun is_let_exp(let_exp{...}) =3D true
  | is_let_exp _ =3D false

fun is_leaf( app_exp{args=3Dnil,...}:('a,'b)e ) =3D true
  | is_leaf E =3D is_q_exp E

fun is_tuple_exp( app_exp{ func, ... } : ('a,'b)e ) =3D func=3DTUPLE
  | is_tuple_exp _ =3D false

fun is_anon_sym S =3D S =3D ANON

exception Is_anon_exp_exn
fun is_anon_exp( app_exp{ func, args, ... } :('a,'b)e ) =3D=20
      if null args then
        is_anon_sym func
      else
        raise Is_anon_exp_exn
  | is_anon_exp _ =3D false


fun is_fun_type( ty_con_exp( Ty_con, _ ) ) =3D Ty_con =3D THIN_ARROW
  | is_fun_type _ =3D false

fun is_tuple_type( ty_con_exp( Ty_con, _ ) ) =3D Ty_con =3D =
TUPLE_TY_CON
  | is_tuple_type _ =3D false







local

val Current_sym_no =3D ref( Word.fromInt 0 )=20
val Current_sym_no' =3D ref( Word.fromInt 2 )

in

exception Sym_no
fun sym_no() =3D   (=20
  word_inc Current_sym_no;
  if Word.>=3D( !Current_sym_no, Lib.Max_word ) then (
    Current_sym_no :=3D Word.fromInt 1;
    word_inc Current_sym_no';
    if Word.>=3D( !Current_sym_no', Lib.Max_word ) then=20
      raise Sym_no=20
    else=20
      ()
    )
  else
    ();
  ( !Current_sym_no', !Current_sym_no )
  )

fun set_sym_no( No', No ) =3D (
  Current_sym_no :=3D No;
  Current_sym_no' :=3D No'
  )

end (* local *)

fun gen_var_sym() =3D=20
  case sym_no() of (M,N) =3D> (var_sym,M,N)

fun gen_ty_var_sym() =3D=20
  case sym_no() of (M,N) =3D> (ty_var_sym,M,N)

fun gen_func_sym() =3D=20
  case sym_no() of (M,N) =3D> (func_sym,M,N)

fun gen_emb_sym() =3D=20
  case sym_no() of (M,N) =3D> (emb_sym,M,N)

fun gen_not_activated_sym() =3D=20
  case sym_no() of (M,N) =3D> (not_activated_sym,M,N)

fun gen_dont_know_sym() =3D=20
  case sym_no() of (M,N) =3D> (dont_know_sym,M,N)

fun gen_var_exp(Exp_info) =3D
  app_exp{func=3Dgen_var_sym(),args=3Dnil,exp_info=3DExp_info }

fun mk_anon_exp(Exp_info) =3D
  app_exp{func=3DANON,args=3Dnil,exp_info=3DExp_info }

fun gen_not_activated_exp(Exp_info) =3D
  app_exp{func=3Dgen_not_activated_sym(),args=3Dnil,exp_info=3DExp_info =
}

fun gen_dont_know_exp(Exp_info) =3D
  app_exp{func=3Dgen_dont_know_sym(),args=3Dnil,exp_info=3DExp_info }


fun gen_emb_exp(Exp_info) =3D
  app_exp{func=3Dgen_emb_sym(),args=3Dnil,exp_info=3DExp_info }



fun vars_in_ty_exp TE =3D
let fun vars_in_ty_exp1 TE =3D
  case TE of ty_var_exp N =3D> N::nil
  | ty_con_exp(F,TEs) =3D> flat_map( vars_in_ty_exp1, TEs )
in
  make_set(vars_in_ty_exp1 TE)
end


fun ty_cons_in_ty_exp TE =3D
let fun ty_cons_in_ty_exp1 TE =3D
  case TE of =20
    ty_var_exp _ =3D> nil
  | ty_con_exp(F,TEs) =3D> F :: flat_map( ty_cons_in_ty_exp1, TEs )
in
  make_set(ty_cons_in_ty_exp1 TE)
end

exception Vars_in_pure_tuple_pat_exn
fun vars_in_pure_tuple_pat P =3D (
  case P of
    app_exp{func,args=3Dnil,...} =3D>
    if is_variable func then
      func::nil
    else
      raise Vars_in_pure_tuple_pat_exn
  | app_exp{func,args,...} =3D>=20
      if func =3D TUPLE then (
        loop( fn app_exp{ func =3D V, args=3D[], ... } =3D>
          if is_variable V then () else raise =
Vars_in_pure_tuple_pat_exn
               | _ =3D> raise Vars_in_pure_tuple_pat_exn,
          args );
        map( fn app_exp{ func, ... } =3D> func, args )
        )
      else
        raise Vars_in_pure_tuple_pat_exn )
 =20


fun vars_in_pat P =3D
  case P of
    app_exp{func,args=3Dnil,...} =3D>
    if is_variable func then
      func::nil
    else
      nil
  | app_exp{func,args,...} =3D> flat_map(vars_in_pat,args)
  | as_exp{var,pat,...} =3D> var::vars_in_pat(pat)



fun var_exps_in_pat P =3D
  case P of
    app_exp{func,args=3Dnil,...} =3D>
    if is_variable func then
      P::nil
    else
      nil
  | app_exp{func,args,...} =3D> flat_map(var_exps_in_pat,args)
  | as_exp{var,pat,exp_info} =3D>=20
      app_exp{func=3Dvar,args=3Dnil,exp_info=3Dexp_info}::
      var_exps_in_pat pat=20



fun symbol_hash( (Cat,M,N) : symbol ) =3D=20
  Word.xorb(
    case Cat of func_sym =3D> 0w1 | var_sym =3D> 0w2 | _ =3D> 0w4,
    Word.xorb(M,N) )


fun real_symbol_hash( (Cat,M,N) : symbol ) : real =3D=20
    ( case Cat of=20
        func_sym =3D> 0.456343233453663769848=20
      | var_sym =3D> 0.8349187367352156128437628=20
      | _ =3D> 0.92764352345272984378327
      )=20
    *=20
    ( normrealhash( real( Word.toIntX M ) ) +=20
      normrealhash( real( Word.toIntX N ) ) )

structure Symbol_hash_key =3D
struct
  type hash_key=3Dsymbol
  val hashVal =3D symbol_hash
  fun sameKey(X,Y:symbol)=3D X=3DY
end

structure Symbol_HashTable =3D HashTableFn(Symbol_hash_key)



structure Symbol_dyn =3D DynamicArrayFn(
  struct
    open Array
    type elem =3D symbol
  type vector =3D symbol Vector.vector
    type array =3D symbol array
    structure Vector =3D
struct
  open Vector
  type elem =3D symbol
  type vector =3D symbol Vector.vector
end

  end=20
  )




fun get_exp_info E =3D
  case E of
    app_exp {exp_info,...} =3D> exp_info
  | case_exp {exp_info,...} =3D> exp_info
  | let_exp {exp_info,...} =3D> exp_info
  | as_exp {exp_info,...} =3D> exp_info


fun set_exp_info( E, Info ) =3D
  case E of
    app_exp { func, args, ... } =3D>=20
      app_exp{ func =3D func, args =3D args, exp_info =3D Info }
  | case_exp { exp, rules, ... } =3D>
      case_exp{ exp =3D exp, rules =3D rules, exp_info =3D Info }
  | let_exp { dec_list, exp, ... } =3D>
      let_exp{ dec_list =3D dec_list, exp =3D exp, exp_info =3D Info }
  | as_exp { var, pat, ... } =3D>=20
      as_exp{ var =3D var, pat =3D pat, exp_info =3D Info }

fun type_of_exp E =3D get_ty_exp(get_exp_info E)

fun exp_size( E : ('a,'b)e ) =3D=20
  case E of
    app_exp{ args, ... } =3D> 1 + int_sum(map(exp_size,args))
  | case_exp{ exp, rules, ... } =3D>
      1 + exp_size exp + int_sum(map(exp_size,map(#exp,rules)))
  | let_exp { dec_list, exp, ... } =3D>
      1 + exp_size exp + int_sum(map(exp_size,map(#exp,dec_list)))
  | as_exp{ pat, ... } =3D> 1 + exp_size pat

local

exception Rename
exception Rename_hash
structure H =3D Symbol_HashTable

in

fun rename( E : ('a,'b)e, Canonize : bool ) : ('a,'b)e =3D
let
  val Curr_no =3D ref(Word.fromInt 0)
  fun sym_no() =3D (word_inc Curr_no; (Word.fromInt 1,!Curr_no) )

  val gen_var_sym =3D=20
    if Canonize then=20
      fn() =3D> case sym_no() of (M,N) =3D> (var_sym,M,N)
    else=20
      gen_var_sym

  val gen_func_sym =3D=20
    if Canonize then=20
      fn() =3D> case sym_no() of (M,N) =3D> (func_sym,M,N)
    else=20
      gen_func_sym

  val gen_not_activated_sym =3D=20
    if Canonize then=20
      fn() =3D> case sym_no() of (M,N) =3D> (not_activated_sym,M,N)
    else=20
      gen_not_activated_sym

  val gen_dont_know_sym =3D=20
    if Canonize then=20
      fn() =3D> case sym_no() of (M,N) =3D> (dont_know_sym,M,N)
    else=20
      gen_dont_know_sym

  val gen_var_exp =3D
    if Canonize then=20
      fn Exp_info =3D>=20
        app_exp{func=3Dgen_var_sym(),args=3Dnil,exp_info=3DExp_info }
    else
      gen_var_exp

  val gen_not_activated_exp =3D=20
    if Canonize then=20
      fn Exp_info =3D>=20
        app_exp{func=3Dgen_not_activated_sym(),
          args=3Dnil,exp_info=3DExp_info }
    else
      gen_not_activated_exp

  val gen_dont_know_exp =3D
    if Canonize then=20
      fn Exp_info =3D>=20
        app_exp{func=3Dgen_dont_know_sym(),
          args=3Dnil,exp_info=3DExp_info }
    else
      gen_dont_know_exp
 =20
  val Table : symbol list H.hash_table =3D=20
    H.mkTable( 3 * exp_size E, Rename_hash )

  fun insert S =3D=20
    let=20
      val Sym =3D
        if is_variable S then gen_var_sym() else gen_func_sym()=20
    in
      case H.find Table S of
        NONE =3D> H.insert Table ( S, [Sym] )
      | SOME Xs =3D> H.insert Table ( S, Sym::Xs )
    end

  fun delete( S : symbol ) : unit =3D
    let=20
      val Sym::Xs =3D H.lookup Table S
    in
      case Xs of
        [] =3D> ( H.remove Table S; () )
      | _ =3D> H.insert Table ( S, Xs )
    end

  fun replace( S : symbol) : symbol =3D=20
    case H.find Table S of NONE =3D> S | SOME( S :: _ ) =3D> S
 =20
  fun insert_pat Pat =3D ( map(insert,vars_in_pat Pat); () )

  fun delete_pat Pat =3D ( map(delete,vars_in_pat Pat); () )

  fun rename E =3D
  case E of
    app_exp{func,args,exp_info} =3D>
      if is_q_exp E then
        if is_dont_know_exp E then
          gen_dont_know_exp exp_info
        else if is_not_activated_exp E then
          gen_not_activated_exp exp_info
        else
          raise Rename
      else
        app_exp{ func=3Dreplace func, args=3Dmap(rename,args), =
exp_info=3Dexp_info }
  | case_exp{exp,rules,exp_info} =3D> case_exp{ exp=3Drename exp, =
rules=3D
      map( fn Rule as {pat,exp,...} =3D>
        let=20
          val _ =3D insert_pat pat;
          val X =3D mk_rule(Rule,rename pat,rename exp)
        in
          delete_pat pat;
          X
        end,
        rules ),
      exp_info=3Dexp_info }
  | let_exp{ dec_list, exp, exp_info } =3D>=20
    let
      val _ =3D map( fn { func, ... } =3D> insert func, dec_list )
      val Ds =3D map( fn { func, pat, exp, dec_info } =3D>=20
        let
          val _ =3D insert_pat pat
          val D =3D {
            func =3D replace func,
            pat =3D rename pat,
            exp =3D rename exp,
            dec_info =3D dec_info
            }
        in
          delete_pat pat;
          D
        end,
        dec_list )

      val LE =3D let_exp{ dec_list =3D Ds, exp =3D rename exp,
        exp_info =3D exp_info }
    in
      map( fn { func, ... } =3D> delete func, dec_list );
      LE
    end

  | as_exp{var,pat,exp_info} =3D>=20
      as_exp{ var=3Dreplace var, pat=3Drename pat, exp_info=3Dexp_info =
}
in
  rename E
end

end (* local *)


fun rename_decs( Ds : ('a,'b)d list, Canonize : bool )=20
    : ('a,'b)d list =3D
  case Ds of
    [] =3D> []
  | D::_ =3D>
  let
    val Dummy_e =3D #exp D
  in
  case rename(=20
    let_exp{
      dec_list =3D Ds,
      exp =3D Dummy_e,
      exp_info =3D get_exp_info Dummy_e=20
      },
    Canonize ) of
    let_exp{ dec_list, ... } =3D> dec_list
  end



val Debug =3D ref false


fun print_syms Syms =3D list_out(
      !std_out,
      fn (Str,Sym) =3D> output( Str, symbol_to_string Sym ),
      Syms )

end (* structure Ast *)


signature ML_TOKENS =3D
sig
type ('a,'b) token
type svalue
val EOF:  'a * 'a -> (svalue,'a) token
val ID: (string) *  'a * 'a -> (svalue,'a) token
val INT: (int) *  'a * 'a -> (svalue,'a) token
val EXCEPTION:  'a * 'a -> (svalue,'a) token
val RAISE:  'a * 'a -> (svalue,'a) token
val APPEND:  'a * 'a -> (svalue,'a) token
val CONS:  'a * 'a -> (svalue,'a) token
val COLON:  'a * 'a -> (svalue,'a) token
val PRIME:  'a * 'a -> (svalue,'a) token
val MINUS:  'a * 'a -> (svalue,'a) token
val DIV:  'a * 'a -> (svalue,'a) token
val MUL:  'a * 'a -> (svalue,'a) token
val PLUS:  'a * 'a -> (svalue,'a) token
val LESS':  'a * 'a -> (svalue,'a) token
val EQ:  'a * 'a -> (svalue,'a) token
val SEMICOLON:  'a * 'a -> (svalue,'a) token
val COMMA:  'a * 'a -> (svalue,'a) token
val THIN_ARROW:  'a * 'a -> (svalue,'a) token
val ARROW:  'a * 'a -> (svalue,'a) token
val VBAR:  'a * 'a -> (svalue,'a) token
val RPAR:  'a * 'a -> (svalue,'a) token
val LPAR:  'a * 'a -> (svalue,'a) token
val AS:  'a * 'a -> (svalue,'a) token
val OF:  'a * 'a -> (svalue,'a) token
val CASE:  'a * 'a -> (svalue,'a) token
val END:  'a * 'a -> (svalue,'a) token
val IN:  'a * 'a -> (svalue,'a) token
val LET:  'a * 'a -> (svalue,'a) token
val AND:  'a * 'a -> (svalue,'a) token
val TYPE:  'a * 'a -> (svalue,'a) token
val DATATYPE:  'a * 'a -> (svalue,'a) token
val VAL:  'a * 'a -> (svalue,'a) token
val FUN:  'a * 'a -> (svalue,'a) token
end
signature ML_LRVALS=3D
sig
structure Tokens : ML_TOKENS
structure ParserData:PARSER_DATA
sharing type ParserData.Token.token =3D Tokens.token
sharing type ParserData.svalue =3D Tokens.svalue
end

functor MLLrValsFun (structure Token : TOKEN) : ML_LRVALS =3D=20
struct
structure ParserData=3D
struct
structure Header =3D=20
struct
(* File: ML.grm=20
   Created: 1993-05-26
   Modified: 1996-06-02
*)



end
structure LrTable =3D Token.LrTable
structure Token =3D Token
local open LrTable in=20
val table=3Dlet val actionRows =3D
"\
\\001\000\001\000\202\000\003\000\202\000\004\000\202\000\005\000\202\00=
0\
\\007\000\202\000\008\000\202\000\010\000\202\000\013\000\202\000\
\\014\000\202\000\017\000\202\000\018\000\202\000\021\000\084\000\
\\022\000\083\000\023\000\082\000\024\000\081\000\027\000\080\000\
\\028\000\079\000\030\000\202\000\033\000\202\000\000\000\
\\001\000\001\000\203\000\003\000\203\000\004\000\203\000\005\000\203\00=
0\
\\007\000\203\000\008\000\203\000\010\000\203\000\013\000\203\000\
\\014\000\203\000\017\000\203\000\018\000\203\000\021\000\084\000\
\\022\000\083\000\023\000\082\000\024\000\081\000\027\000\080\000\
\\028\000\079\000\030\000\203\000\033\000\203\000\000\000\
\\001\000\001\000\011\000\000\000\
\\001\000\001\000\011\000\003\000\010\000\004\000\009\000\030\000\008\00=
0\000\000\
\\001\000\006\000\064\000\009\000\063\000\012\000\062\000\029\000\061\00=
0\
\\031\000\060\000\032\000\059\000\000\000\
\\001\000\007\000\121\000\000\000\
\\001\000\008\000\138\000\018\000\087\000\019\000\086\000\020\000\085\00=
0\
\\021\000\084\000\022\000\083\000\023\000\082\000\024\000\081\000\
\\027\000\080\000\028\000\079\000\000\000\
\\001\000\010\000\120\000\018\000\087\000\019\000\086\000\020\000\085\00=
0\
\\021\000\084\000\022\000\083\000\023\000\082\000\024\000\081\000\
\\027\000\080\000\028\000\079\000\000\000\
\\001\000\012\000\034\000\032\000\033\000\000\000\
\\001\000\012\000\047\000\032\000\033\000\000\000\
\\001\000\012\000\053\000\025\000\016\000\032\000\052\000\000\000\
\\001\000\013\000\037\000\000\000\
\\001\000\013\000\070\000\017\000\069\000\026\000\068\000\027\000\041\00=
0\000\000\
\\001\000\013\000\070\000\017\000\069\000\027\000\041\000\000\000\
\\001\000\013\000\095\000\000\000\
\\001\000\013\000\102\000\000\000\
\\001\000\013\000\104\000\016\000\074\000\017\000\103\000\000\000\
\\001\000\013\000\119\000\017\000\118\000\018\000\087\000\019\000\086\00=
0\
\\020\000\085\000\021\000\084\000\022\000\083\000\023\000\082\000\
\\024\000\081\000\027\000\080\000\028\000\079\000\000\000\
\\001\000\013\000\123\000\016\000\074\000\000\000\
\\001\000\013\000\124\000\000\000\
\\001\000\013\000\128\000\000\000\
\\001\000\013\000\136\000\000\000\
\\001\000\015\000\137\000\027\000\041\000\000\000\
\\001\000\016\000\074\000\019\000\141\000\000\000\
\\001\000\019\000\035\000\000\000\
\\001\000\019\000\038\000\000\000\
\\001\000\019\000\042\000\027\000\041\000\000\000\
\\001\000\026\000\134\000\000\000\
\\001\000\032\000\013\000\000\000\
\\001\000\032\000\023\000\000\000\
\\001\000\032\000\025\000\000\000\
\\001\000\032\000\027\000\000\000\
\\001\000\032\000\029\000\000\000\
\\001\000\032\000\056\000\000\000\
\\001\000\032\000\091\000\000\000\
\\001\000\032\000\125\000\000\000\
\\001\000\033\000\000\000\000\000\
\\146\000\000\000\
\\147\000\000\000\
\\148\000\000\000\
\\149\000\000\000\
\\150\000\001\000\011\000\003\000\010\000\004\000\009\000\030\000\008\00=
0\000\000\
\\151\000\000\000\
\\152\000\000\000\
\\153\000\000\000\
\\154\000\005\000\030\000\000\000\
\\155\000\000\000\
\\156\000\000\000\
\\157\000\000\000\
\\158\000\000\000\
\\159\000\000\000\
\\160\000\017\000\026\000\000\000\
\\161\000\012\000\017\000\025\000\016\000\000\000\
\\162\000\000\000\
\\163\000\014\000\077\000\000\000\
\\164\000\016\000\074\000\000\000\
\\165\000\010\000\078\000\000\000\
\\166\000\016\000\074\000\000\000\
\\167\000\000\000\
\\168\000\000\000\
\\169\000\000\000\
\\170\000\000\000\
\\171\000\000\000\
\\172\000\016\000\074\000\017\000\103\000\000\000\
\\173\000\000\000\
\\174\000\022\000\073\000\032\000\072\000\000\000\
\\175\000\000\000\
\\176\000\022\000\073\000\032\000\072\000\000\000\
\\177\000\000\000\
\\178\000\016\000\074\000\000\000\
\\179\000\000\000\
\\180\000\018\000\087\000\019\000\086\000\020\000\085\000\021\000\084\00=
0\
\\022\000\083\000\023\000\082\000\024\000\081\000\027\000\080\000\
\\028\000\079\000\000\000\
\\181\000\018\000\087\000\019\000\086\000\020\000\085\000\021\000\084\00=
0\
\\022\000\083\000\023\000\082\000\024\000\081\000\027\000\080\000\
\\028\000\079\000\000\000\
\\182\000\005\000\031\000\000\000\
\\183\000\000\000\
\\184\000\000\000\
\\185\000\000\000\
\\186\000\027\000\041\000\000\000\
\\187\000\000\000\
\\188\000\027\000\041\000\000\000\
\\189\000\000\000\
\\190\000\011\000\045\000\012\000\044\000\032\000\043\000\000\000\
\\191\000\017\000\096\000\027\000\041\000\000\000\
\\192\000\000\000\
\\193\000\000\000\
\\194\000\000\000\
\\195\000\000\000\
\\196\000\000\000\
\\197\000\000\000\
\\198\000\000\000\
\\199\000\012\000\090\000\031\000\089\000\032\000\088\000\000\000\
\\200\000\000\000\
\\201\000\019\000\086\000\020\000\085\000\021\000\084\000\022\000\083\00=
0\
\\023\000\082\000\024\000\081\000\027\000\080\000\028\000\079\000\000\00=
0\
\\204\000\000\000\
\\205\000\000\000\
\\206\000\022\000\083\000\023\000\082\000\000\000\
\\207\000\022\000\083\000\023\000\082\000\000\000\
\\208\000\021\000\084\000\022\000\083\000\023\000\082\000\024\000\081\00=
0\
\\027\000\080\000\028\000\079\000\000\000\
\\209\000\021\000\084\000\022\000\083\000\023\000\082\000\024\000\081\00=
0\
\\027\000\080\000\028\000\079\000\000\000\
\\210\000\000\000\
\\211\000\000\000\
\\212\000\017\000\129\000\018\000\087\000\019\000\086\000\020\000\085\00=
0\
\\021\000\084\000\022\000\083\000\023\000\082\000\024\000\081\000\
\\027\000\080\000\028\000\079\000\000\000\
\\213\000\000\000\
\\214\000\014\000\142\000\019\000\086\000\020\000\085\000\021\000\084\00=
0\
\\022\000\083\000\023\000\082\000\024\000\081\000\027\000\080\000\
\\028\000\079\000\000\000\
\\215\000\000\000\
\"
val actionRowNumbers =3D
"\003\000\038\000\039\000\040\000\
\\041\000\037\000\028\000\052\000\
\\052\000\029\000\043\000\003\000\
\\030\000\051\000\031\000\052\000\
\\032\000\045\000\044\000\073\000\
\\070\000\008\000\042\000\024\000\
\\052\000\048\000\011\000\025\000\
\\052\000\029\000\026\000\081\000\
\\009\000\010\000\050\000\049\000\
\\033\000\046\000\074\000\009\000\
\\004\000\080\000\009\000\009\000\
\\012\000\009\000\068\000\067\000\
\\057\000\058\000\059\000\010\000\
\\054\000\047\000\056\000\077\000\
\\071\000\090\000\091\000\034\000\
\\004\000\004\000\002\000\014\000\
\\082\000\079\000\010\000\009\000\
\\075\000\013\000\062\000\010\000\
\\010\000\015\000\016\000\033\000\
\\010\000\004\000\004\000\004\000\
\\004\000\004\000\004\000\004\000\
\\004\000\004\000\088\000\089\000\
\\004\000\084\000\017\000\007\000\
\\005\000\078\000\009\000\018\000\
\\019\000\066\000\065\000\069\000\
\\035\000\010\000\060\000\053\000\
\\055\000\098\000\097\000\096\000\
\\094\000\093\000\095\000\001\000\
\\000\000\092\000\020\000\101\000\
\\004\000\085\000\009\000\004\000\
\\083\000\027\000\076\000\061\000\
\\064\000\063\000\087\000\004\000\
\\021\000\099\000\022\000\006\000\
\\010\000\102\000\086\000\004\000\
\\100\000\023\000\103\000\004\000\
\\009\000\072\000\104\000\036\000"
val gotoT =3D
"\
\\001\000\143\000\002\000\005\000\003\000\004\000\004\000\003\000\
\\011\000\002\000\016\000\001\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\002\000\010\000\003\000\004\000\004\000\003\000\011\000\002\000\
\\016\000\001\000\000\000\
\\000\000\
\\000\000\
\\007\000\013\000\008\000\012\000\000\000\
\\005\000\018\000\006\000\017\000\007\000\013\000\008\000\016\000\000\00=
0\
\\017\000\020\000\018\000\019\000\000\000\
\\000\000\
\\002\000\022\000\003\000\004\000\004\000\003\000\011\000\002\000\
\\016\000\001\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\007\000\013\000\008\000\026\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\014\000\030\000\000\000\
\\000\000\
\\000\000\
\\007\000\013\000\008\000\034\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\005\000\037\000\006\000\017\000\007\000\013\000\008\000\016\000\000\00=
0\
\\017\000\038\000\018\000\019\000\000\000\
\\000\000\
\\000\000\
\\014\000\044\000\000\000\
\\007\000\049\000\021\000\048\000\022\000\047\000\023\000\046\000\000\00=
0\
\\000\000\
\\000\000\
\\009\000\053\000\010\000\052\000\000\000\
\\000\000\
\\000\000\
\\014\000\055\000\000\000\
\\012\000\056\000\000\000\
\\000\000\
\\014\000\064\000\015\000\063\000\000\000\
\\014\000\065\000\000\000\
\\000\000\
\\014\000\069\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\007\000\049\000\021\000\074\000\022\000\047\000\023\000\046\000\
\\024\000\073\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\012\000\090\000\000\000\
\\012\000\091\000\000\000\
\\016\000\092\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\007\000\049\000\021\000\095\000\022\000\047\000\023\000\046\000\000\00=
0\
\\014\000\064\000\015\000\096\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\007\000\049\000\022\000\098\000\023\000\097\000\000\000\
\\007\000\049\000\021\000\099\000\022\000\047\000\023\000\046\000\000\00=
0\
\\000\000\
\\000\000\
\\009\000\103\000\010\000\052\000\000\000\
\\007\000\049\000\021\000\104\000\022\000\047\000\023\000\046\000\000\00=
0\
\\012\000\105\000\000\000\
\\012\000\106\000\000\000\
\\012\000\107\000\000\000\
\\012\000\108\000\000\000\
\\012\000\109\000\000\000\
\\012\000\110\000\000\000\
\\012\000\111\000\000\000\
\\012\000\112\000\000\000\
\\012\000\113\000\000\000\
\\000\000\
\\000\000\
\\012\000\115\000\013\000\114\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\014\000\064\000\015\000\120\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\007\000\049\000\021\000\125\000\022\000\047\000\023\000\046\000\
\\024\000\124\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\012\000\115\000\013\000\128\000\000\000\
\\000\000\
\\014\000\130\000\020\000\129\000\000\000\
\\012\000\131\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\012\000\115\000\013\000\133\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\000\000\
\\007\000\049\000\021\000\137\000\022\000\047\000\023\000\046\000\000\00=
0\
\\000\000\
\\000\000\
\\012\000\138\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\\012\000\141\000\000\000\
\\014\000\130\000\020\000\142\000\000\000\
\\000\000\
\\000\000\
\\000\000\
\"
val numstates =3D 144
val numrules =3D 70
val s =3D ref "" and index =3D ref 0
val string_to_int =3D fn () =3D>=20
let val i =3D !index
in index :=3D i+2; Char.ord(String.sub(!s,i)) + =
Char.ord(String.sub(!s,i+1)) * 256
end
val string_to_list =3D fn s' =3D>
    let val len =3D String.size s'
        fun f () =3D
           if !index < len then string_to_int() :: f()
           else nil
   in index :=3D 0; s :=3D s'; f ()
   end
val string_to_pairlist =3D fn (conv_key,conv_entry) =3D>
     let fun f () =3D
         case string_to_int()
         of 0 =3D> EMPTY
          | n =3D> PAIR(conv_key (n-1),conv_entry =
(string_to_int()),f())
     in f
     end
val string_to_pairlist_default =3D fn (conv_key,conv_entry) =3D>
    let val conv_row =3D string_to_pairlist(conv_key,conv_entry)
    in fn () =3D>
       let val default =3D conv_entry(string_to_int())
           val row =3D conv_row()
       in (row,default)
       end
   end
val string_to_table =3D fn (convert_row,s') =3D>
    let val len =3D String.size s'
        fun f ()=3D
           if !index < len then convert_row() :: f()
           else nil
     in (s :=3D s'; index :=3D 0; f ())
     end
local
  val memo =3D Array.array(numstates+numrules,ERROR)
  val _ =3Dlet fun g i=3D(Array.update(memo,i,REDUCE(i-numstates)); =
g(i+1))
       fun f i =3D
            if i=3Dnumstates then g i
            else (Array.update(memo,i,SHIFT (STATE i)); f (i+1))
          in f 0 handle Subscript =3D> ()
          end
in
val entry_to_action =3D fn 0 =3D> ACCEPT | 1 =3D> ERROR | j =3D> =
Array.sub(memo,(j-2))
end
val =
gotoT=3DArray.fromList(string_to_table(string_to_pairlist(NT,STATE),goto=
T))
val =
actionRows=3Dstring_to_table(string_to_pairlist_default(T,entry_to_actio=
n),actionRows)
val actionRowNumbers =3D string_to_list actionRowNumbers
val actionT =3D let val actionRowLookUp=3D
let val a=3DArray.fromList(actionRows) in fn i=3D>Array.sub(a,i) end
in Array.fromList(map actionRowLookUp actionRowNumbers)
end
in LrTable.mkLrTable =
{actions=3DactionT,gotos=3DgotoT,numRules=3Dnumrules,
numStates=3Dnumstates,initialState=3DSTATE 0}
end
end
local open Header in
type pos =3D int
type arg =3D unit
structure MlyValue =3D=20
struct
datatype svalue =3D VOID | ntVOID of unit | ID of  (string)
 | INT of  (int) | TY_EXP_LIST of  (Ast.ty_exp list)
 | CART_PROD of  (Ast.ty_exp list) | BASIC_TY_EXP of  (Ast.ty_exp)
 | TY_EXP of  (Ast.ty_exp)
 | RULE_LIST of  ( ( Ast.exp_info_type, Ast.dec_info_type )  =
Ast.rule_type list)
 | RULE of  ({ pat:Ast.pat,exp:Ast.exp } ) | FUN_DEC of  (Ast.dec)
 | FUN_DECS of  (Ast.dec list) | FUN_DEC_LIST of  (Ast.dec list)
 | PAT_LIST of  (Ast.pat list) | PAT of  (Ast.pat)
 | EXP_LIST of  (Ast.exp list) | EXP of  (Ast.exp)
 | TYPE_DEC of  ({ ty_con:Ast.symbol,ty_pars:Ast.ty_var =
list,ty_exp:Ast.ty_exp } )
 | ALT of  ({ constr:Ast.symbol,domain:Ast.ty_exp option } )
 | ALT_LIST of  ({ constr:Ast.symbol,domain:Ast.ty_exp option }  list)
 | TY_PAR_LIST of  (Ast.symbol list) | TY_VAR of  (Ast.symbol)
 | DATATYPE_DEC of  (Ast.datatype_dec)
 | DATATYPE_DECS of  (Ast.datatype_dec list)
 | DATATYPE_DEC_LIST of  (Ast.datatype_dec list)
 | DEC of  (Ast.parse_result) | DEC_LIST of  (Ast.parse_result list)
 | START of  (Ast.parse_result list)
end
type svalue =3D MlyValue.svalue
type result =3D Ast.parse_result list
end
structure EC=3D
struct
open LrTable
val is_keyword =3D
fn _ =3D> false
val preferred_change =3D=20
nil
val noShift =3D=20
fn (T 32) =3D> true | _ =3D> false
val showTerminal =3D
fn (T 0) =3D> "FUN"
  | (T 1) =3D> "VAL"
  | (T 2) =3D> "DATATYPE"
  | (T 3) =3D> "TYPE"
  | (T 4) =3D> "AND"
  | (T 5) =3D> "LET"
  | (T 6) =3D> "IN"
  | (T 7) =3D> "END"
  | (T 8) =3D> "CASE"
  | (T 9) =3D> "OF"
  | (T 10) =3D> "AS"
  | (T 11) =3D> "LPAR"
  | (T 12) =3D> "RPAR"
  | (T 13) =3D> "VBAR"
  | (T 14) =3D> "ARROW"
  | (T 15) =3D> "THIN_ARROW"
  | (T 16) =3D> "COMMA"
  | (T 17) =3D> "SEMICOLON"
  | (T 18) =3D> "EQ"
  | (T 19) =3D> "LESS'"
  | (T 20) =3D> "PLUS"
  | (T 21) =3D> "MUL"
  | (T 22) =3D> "DIV"
  | (T 23) =3D> "MINUS"
  | (T 24) =3D> "PRIME"
  | (T 25) =3D> "COLON"
  | (T 26) =3D> "CONS"
  | (T 27) =3D> "APPEND"
  | (T 28) =3D> "RAISE"
  | (T 29) =3D> "EXCEPTION"
  | (T 30) =3D> "INT"
  | (T 31) =3D> "ID"
  | (T 32) =3D> "EOF"
  | _ =3D> "bogus-term"
local open Header in
val errtermvalue=3D
fn _ =3D> MlyValue.VOID
end
val terms =3D (T 0) :: (T 1) :: (T 2) :: (T 3) :: (T 4) :: (T 5) :: (T =
6
) :: (T 7) :: (T 8) :: (T 9) :: (T 10) :: (T 11) :: (T 12) :: (T 13)
 :: (T 14) :: (T 15) :: (T 16) :: (T 17) :: (T 18) :: (T 19) :: (T 20)
 :: (T 21) :: (T 22) :: (T 23) :: (T 24) :: (T 25) :: (T 26) :: (T 27)
 :: (T 28) :: (T 29) :: (T 32) :: nil
end
structure Actions =3D
struct=20
exception mlyAction of int
local open Header in
val actions =3D=20
fn (i392,defaultPos,stack,
    (()):arg) =3D>
case (i392,stack)
of (0,(_,(MlyValue.DEC_LIST DEC_LIST,DEC_LIST1left,DEC_LIST1right))::
rest671) =3D> let val result=3DMlyValue.START(( DEC_LIST ))
 in (LrTable.NT 0,(result,DEC_LIST1left,DEC_LIST1right),rest671) end
| (1,(_,(MlyValue.FUN_DEC_LIST FUN_DEC_LIST,FUN_DEC_LIST1left,
FUN_DEC_LIST1right))::rest671) =3D> let val result=3DMlyValue.DEC((
 Ast.parsed_fun FUN_DEC_LIST ))
 in (LrTable.NT 2,(result,FUN_DEC_LIST1left,FUN_DEC_LIST1right),
rest671) end
| (2,(_,(MlyValue.TYPE_DEC TYPE_DEC,TYPE_DEC1left,TYPE_DEC1right))::
rest671) =3D> let val result=3DMlyValue.DEC(( Ast.parsed_type TYPE_DEC =
))
 in (LrTable.NT 2,(result,TYPE_DEC1left,TYPE_DEC1right),rest671) end
| (3,(_,(MlyValue.DATATYPE_DEC_LIST DATATYPE_DEC_LIST,
DATATYPE_DEC_LIST1left,DATATYPE_DEC_LIST1right))::rest671) =3D> let val =

result=3DMlyValue.DEC(( Ast.parsed_datatype DATATYPE_DEC_LIST ))
 in (LrTable.NT 2,(result,DATATYPE_DEC_LIST1left,
DATATYPE_DEC_LIST1right),rest671) end
| (4,(_,(MlyValue.DEC DEC,DEC1left,DEC1right))::rest671) =3D> let val=20
result=3DMlyValue.DEC_LIST(( DEC::nil ))
 in (LrTable.NT 1,(result,DEC1left,DEC1right),rest671) end
| (5,(_,(MlyValue.DEC_LIST DEC_LIST,_,DEC_LIST1right))::_::(_,(_,
EXCEPTION1left,_))::rest671) =3D> let val result=3DMlyValue.DEC_LIST((
 DEC_LIST ))
 in (LrTable.NT 1,(result,EXCEPTION1left,DEC_LIST1right),rest671) end
| (6,(_,(MlyValue.DEC_LIST DEC_LIST,_,DEC_LIST1right))::(_,(
MlyValue.DEC DEC,DEC1left,_))::rest671) =3D> let val result=3D
MlyValue.DEC_LIST(( DEC::DEC_LIST ))
 in (LrTable.NT 1,(result,DEC1left,DEC_LIST1right),rest671) end
| (7,(_,(MlyValue.DATATYPE_DECS DATATYPE_DECS,_,DATATYPE_DECS1right))
::(_,(_,DATATYPE1left,_))::rest671) =3D> let val result=3D
MlyValue.DATATYPE_DEC_LIST(( DATATYPE_DECS ))
 in (LrTable.NT 3,(result,DATATYPE1left,DATATYPE_DECS1right),rest671)
 end
| (8,(_,(MlyValue.DATATYPE_DEC DATATYPE_DEC,DATATYPE_DEC1left,
DATATYPE_DEC1right))::rest671) =3D> let val result=3D
MlyValue.DATATYPE_DECS(( DATATYPE_DEC :: nil ))
 in (LrTable.NT 4,(result,DATATYPE_DEC1left,DATATYPE_DEC1right),
rest671) end
| (9,(_,(MlyValue.DATATYPE_DECS DATATYPE_DECS,_,DATATYPE_DECS1right))
::_::(_,(MlyValue.DATATYPE_DEC DATATYPE_DEC,DATATYPE_DEC1left,_))::
rest671) =3D> let val result=3DMlyValue.DATATYPE_DECS((
 DATATYPE_DEC :: DATATYPE_DECS ))
 in (LrTable.NT 4,(result,DATATYPE_DEC1left,DATATYPE_DECS1right),
rest671) end
| (10,(_,(MlyValue.ALT_LIST ALT_LIST,_,ALT_LIST1right))::_::(_,(
MlyValue.ID ID,_,_))::(_,(MlyValue.TY_PAR_LIST TY_PAR_LIST,
TY_PAR_LIST1left,_))::rest671) =3D> let val =
result=3DMlyValue.DATATYPE_DEC
((
 {
      ty_con =3D Ast.string_to_symbol(Ast.ty_con_sym,ID),
      ty_pars =3D TY_PAR_LIST,
      alts =3D ALT_LIST
      }=20
))
 in (LrTable.NT 5,(result,TY_PAR_LIST1left,ALT_LIST1right),rest671)
 end
| (11,(_,(MlyValue.ID ID,_,ID1right))::(_,(_,PRIME1left,_))::rest671)
 =3D> let val result=3DMlyValue.TY_VAR((
 Ast.string_to_symbol( Ast.ty_var_sym, "'" ^ ID ) ))
 in (LrTable.NT 6,(result,PRIME1left,ID1right),rest671) end
| (12,(_,(_,_,RPAR1right))::(_,(MlyValue.TY_PAR_LIST TY_PAR_LIST,_,_))
::(_,(_,LPAR1left,_))::rest671) =3D> let val =
result=3DMlyValue.TY_PAR_LIST
(( TY_PAR_LIST ))
 in (LrTable.NT 7,(result,LPAR1left,RPAR1right),rest671) end
| (13,(_,(MlyValue.TY_PAR_LIST TY_PAR_LIST,_,TY_PAR_LIST1right))::_::(
_,(MlyValue.TY_VAR TY_VAR,TY_VAR1left,_))::rest671) =3D> let val =
result=3D
MlyValue.TY_PAR_LIST(( TY_VAR :: TY_PAR_LIST ))
 in (LrTable.NT 7,(result,TY_VAR1left,TY_PAR_LIST1right),rest671) end
| (14,(_,(MlyValue.TY_VAR TY_VAR,TY_VAR1left,TY_VAR1right))::rest671)
 =3D> let val result=3DMlyValue.TY_PAR_LIST(( TY_VAR :: nil ))
 in (LrTable.NT 7,(result,TY_VAR1left,TY_VAR1right),rest671) end
| (15,rest671) =3D> let val result=3DMlyValue.TY_PAR_LIST(( nil ))
 in (LrTable.NT 7,(result,defaultPos,defaultPos),rest671) end
| (16,(_,(MlyValue.ALT_LIST ALT_LIST,_,ALT_LIST1right))::_::(_,(
MlyValue.ALT ALT,ALT1left,_))::rest671) =3D> let val result=3D
MlyValue.ALT_LIST(( ALT :: ALT_LIST ))
 in (LrTable.NT 8,(result,ALT1left,ALT_LIST1right),rest671) end
| (17,(_,(MlyValue.ALT ALT,ALT1left,ALT1right))::rest671) =3D> let val=20
result=3DMlyValue.ALT_LIST(( ALT :: nil ))
 in (LrTable.NT 8,(result,ALT1left,ALT1right),rest671) end
| (18,(_,(MlyValue.TY_EXP TY_EXP,_,TY_EXP1right))::_::(_,(MlyValue.ID=20
ID,ID1left,_))::rest671) =3D> let val result=3DMlyValue.ALT((
 {=20
      constr =3D Ast.string_to_symbol( Ast.func_sym, ID ),
      domain =3D SOME TY_EXP
      }=20
))
 in (LrTable.NT 9,(result,ID1left,TY_EXP1right),rest671) end
| (19,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) =3D> let val=20
result=3DMlyValue.ALT((
 {=20
      constr =3D Ast.string_to_symbol( Ast.func_sym, ID ),=20
      domain =3D NONE=20
      }=20
))
 in (LrTable.NT 9,(result,ID1left,ID1right),rest671) end
| (20,(_,(MlyValue.TY_EXP TY_EXP,_,TY_EXP1right))::_::(_,(MlyValue.ID=20
ID,_,_))::(_,(MlyValue.TY_PAR_LIST TY_PAR_LIST,_,_))::(_,(_,TYPE1left,
_))::rest671) =3D> let val result=3DMlyValue.TYPE_DEC((
 {
      ty_con =3D Ast.string_to_symbol( Ast.ty_con_sym, ID ),
      ty_pars =3D TY_PAR_LIST,
      ty_exp =3D TY_EXP
      }=20
))
 in (LrTable.NT 10,(result,TYPE1left,TY_EXP1right),rest671) end
| (21,(_,(MlyValue.TY_VAR TY_VAR,TY_VAR1left,TY_VAR1right))::rest671)
 =3D> let val result=3DMlyValue.BASIC_TY_EXP(( Ast.ty_var_exp TY_VAR ))
 in (LrTable.NT 21,(result,TY_VAR1left,TY_VAR1right),rest671) end
| (22,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) =3D> let val=20
result=3DMlyValue.BASIC_TY_EXP((
=20
      Ast.ty_con_exp(
        Ast.string_to_symbol( Ast.ty_con_sym, ID ),
        nil)=20
     =20
))
 in (LrTable.NT 21,(result,ID1left,ID1right),rest671) end
| (23,(_,(_,_,RPAR1right))::(_,(MlyValue.TY_EXP TY_EXP,_,_))::(_,(_,
LPAR1left,_))::rest671) =3D> let val result=3DMlyValue.BASIC_TY_EXP((
 TY_EXP ))
 in (LrTable.NT 21,(result,LPAR1left,RPAR1right),rest671) end
| (24,(_,(MlyValue.ID ID,_,ID1right))::_::(_,(MlyValue.TY_EXP_LIST=20
TY_EXP_LIST,_,_))::(_,(_,LPAR1left,_))::rest671) =3D> let val result=3D
MlyValue.BASIC_TY_EXP((
=20
      Ast.ty_con_exp(=20
        Ast.string_to_symbol( Ast.ty_con_sym, ID ),=20
        TY_EXP_LIST )=20
     =20
))
 in (LrTable.NT 21,(result,LPAR1left,ID1right),rest671) end
| (25,(_,(MlyValue.ID ID,_,ID1right))::(_,(MlyValue.BASIC_TY_EXP=20
BASIC_TY_EXP,BASIC_TY_EXP1left,_))::rest671) =3D> let val result=3D
MlyValue.BASIC_TY_EXP((
=20
      Ast.ty_con_exp(=20
        Ast.string_to_symbol( Ast.ty_con_sym, ID ),=20
        BASIC_TY_EXP::nil )=20
     =20
))
 in (LrTable.NT 21,(result,BASIC_TY_EXP1left,ID1right),rest671) end
| (26,(_,(MlyValue.TY_EXP TY_EXP2,_,TY_EXP2right))::_::(_,(
MlyValue.TY_EXP TY_EXP1,TY_EXP1left,_))::rest671) =3D> let val =
result=3D
MlyValue.TY_EXP_LIST(( TY_EXP1::TY_EXP2::nil ))
 in (LrTable.NT 23,(result,TY_EXP1left,TY_EXP2right),rest671) end
| (27,(_,(MlyValue.TY_EXP_LIST TY_EXP_LIST,_,TY_EXP_LIST1right))::_::(
_,(MlyValue.TY_EXP TY_EXP,TY_EXP1left,_))::rest671) =3D> let val =
result=3D
MlyValue.TY_EXP_LIST(( TY_EXP::TY_EXP_LIST ))
 in (LrTable.NT 23,(result,TY_EXP1left,TY_EXP_LIST1right),rest671) end
| (28,(_,(MlyValue.BASIC_TY_EXP BASIC_TY_EXP2,_,BASIC_TY_EXP2right))::
_::(_,(MlyValue.BASIC_TY_EXP BASIC_TY_EXP1,BASIC_TY_EXP1left,_))::
rest671) =3D> let val result=3DMlyValue.CART_PROD((
=20
      BASIC_TY_EXP1::BASIC_TY_EXP2::nil=20
      ))
 in (LrTable.NT 22,(result,BASIC_TY_EXP1left,BASIC_TY_EXP2right),
rest671) end
| (29,(_,(MlyValue.CART_PROD CART_PROD,_,CART_PROD1right))::_::(_,(
MlyValue.BASIC_TY_EXP BASIC_TY_EXP,BASIC_TY_EXP1left,_))::rest671) =3D> =

let val result=3DMlyValue.CART_PROD(( BASIC_TY_EXP::CART_PROD ))
 in (LrTable.NT 22,(result,BASIC_TY_EXP1left,CART_PROD1right),rest671)
 end
| (30,(_,(MlyValue.BASIC_TY_EXP BASIC_TY_EXP,BASIC_TY_EXP1left,
BASIC_TY_EXP1right))::rest671) =3D> let val result=3DMlyValue.TY_EXP((
BASIC_TY_EXP))
 in (LrTable.NT 20,(result,BASIC_TY_EXP1left,BASIC_TY_EXP1right),
rest671) end
| (31,(_,(MlyValue.CART_PROD CART_PROD,CART_PROD1left,CART_PROD1right)
)::rest671) =3D> let val result=3DMlyValue.TY_EXP((
 Ast.ty_con_exp(Ast.TUPLE_TY_CON,CART_PROD) ))
 in (LrTable.NT 20,(result,CART_PROD1left,CART_PROD1right),rest671)
 end
| (32,(_,(MlyValue.TY_EXP TY_EXP2,_,TY_EXP2right))::_::(_,(
MlyValue.TY_EXP TY_EXP1,TY_EXP1left,_))::rest671) =3D> let val =
result=3D
MlyValue.TY_EXP((
=20
      Ast.ty_con_exp(Ast.THIN_ARROW, TY_EXP1::TY_EXP2::nil)=20
      )
)
 in (LrTable.NT 20,(result,TY_EXP1left,TY_EXP2right),rest671) end
| (33,(_,(MlyValue.FUN_DECS FUN_DECS,_,FUN_DECS1right))::(_,(_,
FUN1left,_))::rest671) =3D> let val result=3DMlyValue.FUN_DEC_LIST((
 FUN_DECS ))
 in (LrTable.NT 15,(result,FUN1left,FUN_DECS1right),rest671) end
| (34,(_,(MlyValue.EXP EXP,_,EXP1right))::_::(_,(MlyValue.PAT PAT,_,_)
)::(_,(MlyValue.ID ID,ID1left,_))::rest671) =3D> let val result=3D
MlyValue.FUN_DEC((
 {
      func=3DAst.string_to_symbol( Ast.func_sym, ID ),
      pat=3DPAT,
      exp=3DEXP,
      dec_info=3DAst.no_dec_info()
      }=20
))
 in (LrTable.NT 17,(result,ID1left,EXP1right),rest671) end
| (35,(_,(MlyValue.EXP EXP,_,EXP1right))::_::(_,(MlyValue.TY_EXP=20
TY_EXP2,_,_))::_::_::(_,(MlyValue.TY_EXP TY_EXP1,_,_))::_::(_,(
MlyValue.PAT PAT,_,_))::_::(_,(MlyValue.ID ID,ID1left,_))::rest671)
 =3D> let val result=3DMlyValue.FUN_DEC((
 {
      func=3DAst.string_to_symbol( Ast.func_sym, ID ),
      pat=3DPAT,
      exp=3DEXP,
      dec_info=3D=20
        let val TE =3D=20
          Ast.ty_con_exp( Ast.THIN_ARROW, TY_EXP1::TY_EXP2::nil )
        in
          {
            schematic_vars =3D Ast.vars_in_ty_exp TE,
            ty_exp =3D TE
            }
        end
      }=20
))
 in (LrTable.NT 17,(result,ID1left,EXP1right),rest671) end
| (36,(_,(MlyValue.FUN_DEC FUN_DEC,FUN_DEC1left,FUN_DEC1right))::
rest671) =3D> let val result=3DMlyValue.FUN_DECS(( FUN_DEC :: nil ))
 in (LrTable.NT 16,(result,FUN_DEC1left,FUN_DEC1right),rest671) end
| (37,(_,(MlyValue.FUN_DECS FUN_DECS,_,FUN_DECS1right))::_::(_,(
MlyValue.FUN_DEC FUN_DEC,FUN_DEC1left,_))::rest671) =3D> let val =
result=3D
MlyValue.FUN_DECS(( FUN_DEC :: FUN_DECS ))
 in (LrTable.NT 16,(result,FUN_DEC1left,FUN_DECS1right),rest671) end
| (38,(_,(_,_,RPAR1right))::(_,(MlyValue.PAT PAT,_,_))::(_,(_,
LPAR1left,_))::rest671) =3D> let val result=3DMlyValue.PAT(( PAT ))
 in (LrTable.NT 13,(result,LPAR1left,RPAR1right),rest671) end
| (39,(_,(_,_,RPAR1right))::(_,(MlyValue.PAT_LIST PAT_LIST,_,_))::_::(
_,(MlyValue.PAT PAT,_,_))::(_,(_,LPAR1left,_))::rest671) =3D> let val=20
result=3DMlyValue.PAT((
 Ast.app_exp {
      func=3DAst.TUPLE,
      args=3DPAT::PAT_LIST,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 13,(result,LPAR1left,RPAR1right),rest671) end
| (40,(_,(MlyValue.PAT PAT2,_,PAT2right))::_::(_,(MlyValue.PAT PAT1,
PAT1left,_))::rest671) =3D> let val result=3DMlyValue.PAT((
 Ast.app_exp {
      func=3DAst.CONS,
      args=3DPAT1::PAT2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 13,(result,PAT1left,PAT2right),rest671) end
| (41,(_,(_,_,RPAR1right))::(_,(MlyValue.PAT_LIST PAT_LIST,_,_))::_::(
_,(MlyValue.ID ID,ID1left,_))::rest671) =3D> let val =
result=3DMlyValue.PAT
((
 Ast.app_exp {
      func=3DAst.string_to_symbol( Ast.var_sym, ID ),
      args=3DPAT_LIST,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 13,(result,ID1left,RPAR1right),rest671) end
| (42,(_,(MlyValue.PAT PAT,_,PAT1right))::_::(_,(MlyValue.ID ID,
ID1left,_))::rest671) =3D> let val result=3DMlyValue.PAT((
 Ast.as_exp {
      var=3DAst.string_to_symbol( Ast.var_sym, ID ),
      pat=3DPAT,=20
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 13,(result,ID1left,PAT1right),rest671) end
| (43,(_,(MlyValue.ID ID2,_,ID2right))::(_,(MlyValue.ID ID1,ID1left,_)
)::rest671) =3D> let val result=3DMlyValue.PAT((
 Ast.app_exp {
      func=3DAst.string_to_symbol( Ast.var_sym, ID1 ),
      args=3D[ Ast.app_exp{
        func=3DAst.string_to_symbol( Ast.var_sym, ID2 ),
        args=3Dnil,
        exp_info=3DAst.no_exp_info() } ],
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 13,(result,ID1left,ID2right),rest671) end
| (44,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) =3D> let val=20
result=3DMlyValue.PAT((
 Ast.app_exp {
      func=3DAst.string_to_symbol( Ast.var_sym, ID ),
      args=3Dnil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 13,(result,ID1left,ID1right),rest671) end
| (45,(_,(MlyValue.PAT PAT,PAT1left,PAT1right))::rest671) =3D> let val=20
result=3DMlyValue.PAT_LIST(( PAT::nil ))
 in (LrTable.NT 14,(result,PAT1left,PAT1right),rest671) end
| (46,(_,(MlyValue.PAT_LIST PAT_LIST,_,PAT_LIST1right))::_::(_,(
MlyValue.PAT PAT,PAT1left,_))::rest671) =3D> let val result=3D
MlyValue.PAT_LIST(( PAT::PAT_LIST ))
 in (LrTable.NT 14,(result,PAT1left,PAT_LIST1right),rest671) end
| (47,(_,(MlyValue.ID ID,_,ID1right))::(_,(_,RAISE1left,_))::rest671)
 =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func =3D Ast.string_to_qsymbol ID,
      args =3D [],
      exp_info =3D Ast.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,RAISE1left,ID1right),rest671) end
| (48,(_,(_,_,RPAR1right))::(_,(MlyValue.EXP EXP,_,_))::(_,(_,
LPAR1left,_))::rest671) =3D> let val result=3DMlyValue.EXP(( EXP ))
 in (LrTable.NT 11,(result,LPAR1left,RPAR1right),rest671) end
| (49,(_,(_,_,RPAR1right))::(_,(MlyValue.EXP_LIST EXP_LIST,_,_))::_::(
_,(MlyValue.EXP EXP,_,_))::(_,(_,LPAR1left,_))::rest671) =3D> let val=20
result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.TUPLE,
      args=3DEXP::EXP_LIST,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,LPAR1left,RPAR1right),rest671) end
| (50,(_,(_,_,RPAR1right))::(_,(MlyValue.EXP_LIST EXP_LIST,_,_))::_::(
_,(MlyValue.ID ID,ID1left,_))::rest671) =3D> let val =
result=3DMlyValue.EXP
((
 Ast.app_exp {
      func=3DAst.string_to_symbol( Ast.func_sym, ID ),
      args=3DEXP_LIST,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,ID1left,RPAR1right),rest671) end
| (51,(_,(MlyValue.ID ID2,_,ID2right))::(_,(MlyValue.ID ID1,ID1left,_)
)::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func =3D Ast.string_to_symbol( Ast.func_sym, ID1 ),
      args =3D Ast.app_exp {
        func =3D Ast.string_to_symbol' ID2,
        args =3D nil,
        exp_info =3D Ast.no_exp_info()
        }
        ::
        nil,
      exp_info =3D Ast.no_exp_info()=20
      }=20
))
 in (LrTable.NT 11,(result,ID1left,ID2right),rest671) end
| (52,(_,(MlyValue.INT INT,_,INT1right))::(_,(MlyValue.ID ID,ID1left,_
))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func =3D Ast.string_to_symbol( Ast.func_sym, ID ),
      args =3D Ast.app_exp {
        func =3D Ast.int_to_symbol INT,
        args =3D nil,
        exp_info =3D Ast.no_exp_info()
        }
        ::
        nil,
      exp_info =3D Ast.no_exp_info()=20
      }=20
))
 in (LrTable.NT 11,(result,ID1left,INT1right),rest671) end
| (53,(_,(MlyValue.ID ID,ID1left,ID1right))::rest671) =3D> let val=20
result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.string_to_symbol' ID,
      args=3Dnil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,ID1left,ID1right),rest671) end
| (54,(_,(MlyValue.INT INT,INT1left,INT1right))::rest671) =3D> let val=20
result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.int_to_symbol INT,
      args=3Dnil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,INT1left,INT1right),rest671) end
| (55,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.SEMICOLON,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (56,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.EQ,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (57,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.LESS',
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (58,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.MUL,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (59,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.DIV,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (60,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.PLUS,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (61,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.MINUS,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (62,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.CONS,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (63,(_,(MlyValue.EXP EXP2,_,EXP2right))::_::(_,(MlyValue.EXP EXP1,
EXP1left,_))::rest671) =3D> let val result=3DMlyValue.EXP((
 Ast.app_exp {
      func=3DAst.APPEND,
      args=3DEXP1::EXP2::nil,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,EXP1left,EXP2right),rest671) end
| (64,(_,(MlyValue.RULE_LIST RULE_LIST,_,RULE_LIST1right))::_::(_,(
MlyValue.EXP EXP,_,_))::(_,(_,CASE1left,_))::rest671) =3D> let val=20
result=3DMlyValue.EXP((
 Ast.case_exp {
      exp=3DEXP,
      rules=3DRULE_LIST,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,CASE1left,RULE_LIST1right),rest671) end
| (65,(_,(_,_,END1right))::(_,(MlyValue.EXP EXP,_,_))::_::(_,(
MlyValue.FUN_DEC_LIST FUN_DEC_LIST,_,_))::(_,(_,LET1left,_))::rest671)
 =3D> let val result=3DMlyValue.EXP((
 Ast.let_exp {
      dec_list=3DFUN_DEC_LIST,
      exp=3DEXP,
      exp_info=3DAst.no_exp_info()
      }=20
))
 in (LrTable.NT 11,(result,LET1left,END1right),rest671) end
| (66,(_,(MlyValue.EXP EXP,EXP1left,EXP1right))::rest671) =3D> let val=20
result=3DMlyValue.EXP_LIST(( EXP::nil ))
 in (LrTable.NT 12,(result,EXP1left,EXP1right),rest671) end
| (67,(_,(MlyValue.EXP_LIST EXP_LIST,_,EXP_LIST1right))::_::(_,(
MlyValue.EXP EXP,EXP1left,_))::rest671) =3D> let val result=3D
MlyValue.EXP_LIST(( EXP::EXP_LIST ))
 in (LrTable.NT 12,(result,EXP1left,EXP_LIST1right),rest671) end
| (68,(_,(MlyValue.EXP EXP,_,EXP1right))::_::(_,(MlyValue.PAT PAT,
PAT1left,_))::rest671) =3D> let val result=3DMlyValue.RULE_LIST((
 Ast.mk_new_rule(PAT,EXP) :: nil ))
 in (LrTable.NT 19,(result,PAT1left,EXP1right),rest671) end
| (69,(_,(MlyValue.RULE_LIST RULE_LIST,_,RULE_LIST1right))::_::(_,(
MlyValue.EXP EXP,_,_))::_::(_,(MlyValue.PAT PAT,PAT1left,_))::rest671)
 =3D> let val result=3DMlyValue.RULE_LIST((
=20
      Ast.mk_new_rule(PAT,EXP) :: RULE_LIST=20
      ))
 in (LrTable.NT 19,(result,PAT1left,RULE_LIST1right),rest671) end
| _ =3D> raise (mlyAction i392)
end
val void =3D MlyValue.VOID
val extract =3D fn a =3D> (fn MlyValue.START x =3D> x
| _ =3D> let exception ParseInternal
	in raise ParseInternal end) a=20
end
end
structure Tokens : ML_TOKENS =3D
struct
type svalue =3D ParserData.svalue
type ('a,'b) token =3D ('a,'b) Token.token
fun FUN (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 0,(
ParserData.MlyValue.VOID,p1,p2))
fun VAL (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 1,(
ParserData.MlyValue.VOID,p1,p2))
fun DATATYPE (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 2,(
ParserData.MlyValue.VOID,p1,p2))
fun TYPE (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 3,(
ParserData.MlyValue.VOID,p1,p2))
fun AND (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 4,(
ParserData.MlyValue.VOID,p1,p2))
fun LET (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 5,(
ParserData.MlyValue.VOID,p1,p2))
fun IN (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 6,(
ParserData.MlyValue.VOID,p1,p2))
fun END (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 7,(
ParserData.MlyValue.VOID,p1,p2))
fun CASE (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 8,(
ParserData.MlyValue.VOID,p1,p2))
fun OF (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 9,(
ParserData.MlyValue.VOID,p1,p2))
fun AS (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 10,(
ParserData.MlyValue.VOID,p1,p2))
fun LPAR (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 11,(
ParserData.MlyValue.VOID,p1,p2))
fun RPAR (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 12,(
ParserData.MlyValue.VOID,p1,p2))
fun VBAR (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 13,(
ParserData.MlyValue.VOID,p1,p2))
fun ARROW (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 14,(
ParserData.MlyValue.VOID,p1,p2))
fun THIN_ARROW (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 15,(
ParserData.MlyValue.VOID,p1,p2))
fun COMMA (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 16,(
ParserData.MlyValue.VOID,p1,p2))
fun SEMICOLON (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 17,(
ParserData.MlyValue.VOID,p1,p2))
fun EQ (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 18,(
ParserData.MlyValue.VOID,p1,p2))
fun LESS' (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 19,(
ParserData.MlyValue.VOID,p1,p2))
fun PLUS (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 20,(
ParserData.MlyValue.VOID,p1,p2))
fun MUL (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 21,(
ParserData.MlyValue.VOID,p1,p2))
fun DIV (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 22,(
ParserData.MlyValue.VOID,p1,p2))
fun MINUS (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 23,(
ParserData.MlyValue.VOID,p1,p2))
fun PRIME (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 24,(
ParserData.MlyValue.VOID,p1,p2))
fun COLON (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 25,(
ParserData.MlyValue.VOID,p1,p2))
fun CONS (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 26,(
ParserData.MlyValue.VOID,p1,p2))
fun APPEND (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 27,(
ParserData.MlyValue.VOID,p1,p2))
fun RAISE (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 28,(
ParserData.MlyValue.VOID,p1,p2))
fun EXCEPTION (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 29,(
ParserData.MlyValue.VOID,p1,p2))
fun INT (i,p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 30,(
ParserData.MlyValue.INT i,p1,p2))
fun ID (i,p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 31,(
ParserData.MlyValue.ID i,p1,p2))
fun EOF (p1,p2) =3D Token.TOKEN (ParserData.LrTable.T 32,(
ParserData.MlyValue.VOID,p1,p2))
end
end

functor MLLexFun( structure Tokens : ML_TOKENS ) : LEXER =3D
   struct
    structure UserDeclarations =3D
      struct

(* File: ML.lex
   Modified 1993-05-24
*)

structure Tokens =3D Tokens

type pos =3D int
type svalue =3D Tokens.svalue
type ('a,'b) token =3D ('a,'b) Tokens.token
type lexresult =3D (svalue,pos) token

val line =3D ref 1
exception ml_lex_gen;
val error =3D fn X =3D> (
  Lib.output( !Lib.std_err,X^"\n");
  Lib.flush_out( !Lib.std_err );
  raise ml_lex_gen)
val eof =3D fn () =3D> Tokens.EOF(!line,!line)
end (* end of user routines *)
exception LexError (* raised if illegal leaf action tried *)
structure Internal =3D
	struct

datatype yyfinstate =3D N of int
type statedata =3D {fin : yyfinstate list, trans: string}
(* transition & final state table *)
val tab =3D let
val s =3D [=20
 (0,=20
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000"
),
 (1,=20
"\003\003\003\003\003\003\003\003\003\025\027\003\003\003\003\003\
\\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\003\
\\025\003\003\003\003\003\003\024\023\022\021\020\019\017\003\016\
\\014\014\014\014\014\014\014\014\014\014\012\011\010\008\003\005\
\\007\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
\\005\005\005\005\005\005\005\005\005\005\005\003\003\003\003\003\
\\003\005\005\005\005\005\005\005\005\005\005\005\005\005\005\005\
\\005\005\005\005\005\005\005\005\005\005\005\003\004\003\003\003\
\\003"
),
 (5,=20
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\006\000\000\000\000\000\000\000\000\
\\006\006\006\006\006\006\006\006\006\006\000\000\000\000\000\000\
\\000\006\006\006\006\006\006\006\006\006\006\006\006\006\006\006\
\\006\006\006\006\006\006\006\006\006\006\006\000\000\000\000\006\
\\000\006\006\006\006\006\006\006\006\006\006\006\006\006\006\006\
\\006\006\006\006\006\006\006\006\006\006\006\000\000\000\000\000\
\\000"
),
 (8,=20
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\009\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000"
),
 (12,=20
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\013\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000"
),
 (14,=20
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\015\015\015\015\015\015\015\015\015\015\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000"
),
 (17,=20
"\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\018\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000"
),
 (25,=20
"\000\000\000\000\000\000\000\000\000\026\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\026\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\000\
\\000"
),
(0, "")]
fun f x =3D x=20
val s =3D map f (rev (tl (rev s)))=20
exception LexHackingError=20
fun look ((j,x)::r, i) =3D if i =3D j then x else look(r, i)=20
  | look ([], i) =3D raise LexHackingError
fun g {fin=3Dx, trans=3Di} =3D {fin=3Dx, trans=3Dlook(s,i)}=20
in Vector.fromList(map g=20
[{fin =3D [], trans =3D 0},
{fin =3D [], trans =3D 1},
{fin =3D [], trans =3D 1},
{fin =3D [(N 49)], trans =3D 0},
{fin =3D [(N 10),(N 49)], trans =3D 0},
{fin =3D [(N 47),(N 49)], trans =3D 5},
{fin =3D [(N 47)], trans =3D 5},
{fin =3D [(N 37),(N 49)], trans =3D 0},
{fin =3D [(N 22),(N 49)], trans =3D 8},
{fin =3D [(N 13)], trans =3D 0},
{fin =3D [(N 24),(N 49)], trans =3D 0},
{fin =3D [(N 20),(N 49)], trans =3D 0},
{fin =3D [(N 39),(N 49)], trans =3D 12},
{fin =3D [(N 35)], trans =3D 0},
{fin =3D [(N 44),(N 49)], trans =3D 14},
{fin =3D [(N 44)], trans =3D 14},
{fin =3D [(N 30),(N 49)], trans =3D 0},
{fin =3D [(N 28),(N 49)], trans =3D 17},
{fin =3D [(N 16)], trans =3D 0},
{fin =3D [(N 18),(N 49)], trans =3D 0},
{fin =3D [(N 26),(N 49)], trans =3D 0},
{fin =3D [(N 32),(N 49)], trans =3D 0},
{fin =3D [(N 8),(N 49)], trans =3D 0},
{fin =3D [(N 6),(N 49)], trans =3D 0},
{fin =3D [(N 41),(N 49)], trans =3D 0},
{fin =3D [(N 4),(N 49)], trans =3D 25},
{fin =3D [(N 4)], trans =3D 25},
{fin =3D [(N 1)], trans =3D 0}])
end
structure StartStates =3D
	struct
	datatype yystartstate =3D STARTSTATE of int

(* start state definitions *)

val INITIAL =3D STARTSTATE 1;

end
type result =3D UserDeclarations.lexresult
	exception LexerError (* raised if illegal leaf action tried *)
end

fun makeLexer yyinput =3D
let	val yygone0=3D1
	val yyb =3D ref "\n" 		(* buffer *)
	val yybl =3D ref 1		(*buffer length *)
	val yybufpos =3D ref 1		(* location of next character to use *)
	val yygone =3D ref yygone0	(* position in file of beginning of buffer =
*)
	val yydone =3D ref false		(* eof found yet? *)
	val yybegin =3D ref 1		(*Current 'start state' for lexer *)

	val YYBEGIN =3D fn (Internal.StartStates.STARTSTATE x) =3D>
		 yybegin :=3D x

fun lex () : Internal.result =3D
let fun continue() =3D lex() in
  let fun scan (s,AcceptingLeaves : Internal.yyfinstate list list,l,i0) =
=3D
	let fun action (i,nil) =3D raise LexError
	| action (i,nil::l) =3D action (i-1,l)
	| action (i,(node::acts)::l) =3D
		case node of
		    Internal.N yyk =3D>=20
			(let val yytext =3D substring(!yyb,i0,i-i0)
			     val yypos =3D i0+ !yygone
			open UserDeclarations Internal.StartStates
 in (yybufpos :=3D i; case yyk of=20

			(* Application actions *)

  1 =3D> (Lib.inc line; lex())
| 10 =3D> (Tokens.VBAR(!line,!line))
| 13 =3D> (Tokens.ARROW(!line,!line))
| 16 =3D> (Tokens.THIN_ARROW(!line,!line))
| 18 =3D> (Tokens.COMMA(!line,!line))
| 20 =3D> (Tokens.SEMICOLON(!line,!line))
| 22 =3D> (Tokens.EQ(!line,!line))
| 24 =3D> (Tokens.LESS'(!line,!line))
| 26 =3D> (Tokens.PLUS(!line,!line))
| 28 =3D> (Tokens.MINUS(!line,!line))
| 30 =3D> (Tokens.DIV(!line,!line))
| 32 =3D> (Tokens.MUL(!line,!line))
| 35 =3D> (Tokens.CONS(!line,!line))
| 37 =3D> (Tokens.APPEND(!line,!line))
| 39 =3D> (Tokens.COLON(!line,!line))
| 4 =3D> (lex())
| 41 =3D> (Tokens.PRIME(!line,!line))
| 44 =3D> ( Tokens.INT( valOf(Int.fromString yytext), !line, !line ) )
| 47 =3D> (
  if yytext=3D"fun" then Tokens.FUN(!line,!line)
  else if yytext=3D"val" then Tokens.VAL(!line,!line)
  else if yytext=3D"datatype" then Tokens.DATATYPE(!line,!line)
  else if yytext=3D"type" then Tokens.TYPE(!line,!line)
  else if yytext=3D"let" then Tokens.LET(!line,!line)
  else if yytext=3D"in" then Tokens.IN(!line,!line)
  else if yytext=3D"end" then Tokens.END(!line,!line)
  else if yytext=3D"case" then Tokens.CASE(!line,!line)
  else if yytext=3D"of" then Tokens.OF(!line,!line)
  else if yytext=3D"as" then Tokens.AS(!line,!line)
  else if yytext=3D"and" then Tokens.AND(!line,!line)
  else if yytext=3D"raise" then Tokens.RAISE(!line,!line)
  else if yytext=3D"exception" then Tokens.EXCEPTION(!line,!line)
  else Tokens.ID(yytext,!line,!line)
  )
| 49 =3D> (error("ML.lex: Bad character "^yytext))
| 6 =3D> (Tokens.LPAR(!line,!line))
| 8 =3D> (Tokens.RPAR(!line,!line))
| _ =3D> raise Internal.LexerError

		) end )

	val {fin,trans} =3D Vector.sub(Internal.tab, s)
	val NewAcceptingLeaves =3D fin::AcceptingLeaves
	in if l =3D !yybl then
	     if trans =3D #trans(Vector.sub(Internal.tab,0))
	       then action(l,NewAcceptingLeaves
) else	    let val newchars=3D if !yydone then "" else yyinput 1024
	    in if (size newchars)=3D0
		  then (yydone :=3D true;
		        if (l=3Di0) then UserDeclarations.eof ()
		                  else action(l,NewAcceptingLeaves))
		  else (if i0=3Dl then yyb :=3D newchars
		     else yyb :=3D substring(!yyb,i0,l-i0)^newchars;
		     yygone :=3D !yygone+i0;
		     yybl :=3D size (!yyb);
		     scan (s,AcceptingLeaves,l-i0,0))
	    end
	  else let val NewChar =3D Char.ord(String.sub(!yyb,l))
		val NewState =3D if NewChar<128 then =
Char.ord(String.sub(trans,NewChar)) else =
Char.ord(String.sub(trans,128))
		in if NewState=3D0 then action(l,NewAcceptingLeaves)
		else scan(NewState,NewAcceptingLeaves,l+1,i0)
	end
	end
(*
	val start=3D if substring(!yyb,!yybufpos-1,1)=3D"\n"
then !yybegin+1 else !yybegin
*)
	in scan(!yybegin (* start *),nil,!yybufpos,!yybufpos)
    end
end
  in lex
  end
end

(*
require "basis.__string";
require "basis.__int";
require "basis.__bool";
require "pp.sml";
require "base-sig.sml";
require "parser2.sml";
require "join.sml";
require "ML-grm-sig.sml";
require "ML-grm.sml";
require "ML-lex.sml";
require "lib.sml";
require "ast.sml";
*)

(* File: parse.sml=20
   Created 1993-05-24.
   Modified 1996-06-04.
  Renamed from io.sml to parse.sml 1999-12-09 when structure Print was=20
  removed from this file and reimplemented in print.sml
*)

structure MLLrVals : ML_LRVALS =3D
   MLLrValsFun(structure Token =3D LrParser.Token );

structure MLLex : LEXER =3D
   MLLexFun(structure Tokens =3D MLLrVals.Tokens );

structure MLParser : PARSER =3D
   Join(structure ParserData =3D MLLrVals.ParserData
        structure Lex =3D MLLex
	structure LrParser =3D LrParser);

signature PARSE =3D
sig
val parse_declarations : string -> Ast.parse_result list
val parse_dec : string -> Ast.dec=20
val parse_decs : string -> Ast.dec list
val parse_type_dec : string -> Ast.type_dec=20
val parse_datatype_dec : string -> Ast.datatype_dec=20
val parse_datatype_decs : string -> Ast.datatype_dec list
val parse_exp : string -> Ast.exp
val parse_ty_exp : string -> Ast.ty_exp
end

structure Parse : PARSE =3D
struct
open Lib

fun string_reader S =3D
  let val next =3D ref S in
    fn _ =3D> !next before next :=3D ""
  end

fun parse_declarations (S:string) : Ast.parse_result list =3D=20
  let fun print_error( Msg, Line1,Line2) =3D (
    output( !std_err,
    "Syntax error at line " ^ Int.toString(Line1) ^
     ": " ^ Msg ^ "\n");
    flush_out( !std_err ) )
  in
case
  MLParser.parse(
    0,
    MLParser.makeLexer (string_reader S),
    print_error,
    ()
    )
of (X,Y) =3D>X=20
  end

fun parse_decs S =3D
  case parse_declarations S of Ast.parsed_fun( Ds ) :: nil =3D> Ds

fun parse_dec S =3D case parse_decs S of D::nil =3D> D

fun parse_type_dec S =3D
  case parse_declarations S of Ast.parsed_type TD :: nil =3D> TD

fun parse_datatype_decs S =3D
  case parse_declarations S of=20
    Ast.parsed_datatype( DDs ) :: nil =3D> DDs

fun parse_datatype_dec S =3D
  case parse_datatype_decs S of DD::nil =3D> DD

fun parse_exp S =3D
  case parse_dec("fun f(X) =3D " ^ S) of {exp,...} =3D> exp

fun parse_ty_exp S =3D
  case parse_declarations( "type t =3D " ^ S ) of
    (Ast.parsed_type { ty_exp, ty_pars=3Dnil, ... }) :: nil =3D> ty_exp

end (* Parse *)



structure Predefined =3D
struct

  val S =3D Parse.parse_ty_exp "int * int -> bool"=20

end (* structure Predefined *)


------_=_NextPart_000_01BF4636.F6376BCE
Content-Type: TEXT/PLAIN;
	name="log"
Content-Transfer-Encoding: quoted-printable
Content-Disposition: attachment;
	filename="log"
Content-Description: Compilation log file
Content-ID: <Pine.SOL.4.10.9912141349031.24367@muppet1.cs.chalmers.se>


------_=_NextPart_000_01BF4636.F6376BCE--