From: goer@ellis.uchicago.edu (Richard L. Goerwitz)
Subject: offending program
Reply-To: goer@midway.uchicago.edu
Organization: University of Chicago Computing Organizations
Date: Mon, 5 Oct 1992 03:07:06 GMT

Abstract discussions aren't too useful, always.  Here's an example
of a simple program created by the parser generator whose tables I
want to be able to store.  The following example initializes itself
by decoding a string encoded by "encode" (see codeobj.icn in the
IPL).

Should work with version 8 installations.  For the compiler, uncom-
ment the invocable declaration.  I have compiled the program success-
fully, but haven't gotten the executable to run.

Compile, execute, and type something like "5 + 5," then hit a CR.

-Richard


-------------------------------  cut here  --------------------------------

#invocable "ACT", "symbol", "TOK"

global ID_tbl
procedure main()
iparse(&input)
end
procedure _0001(arg1)
return
end
procedure _0003(arg1,arg2)
return
end
procedure _0005(arg1)
return
end
procedure _0007(arg1,arg2)
line_number +:= 1
return write(arg1)
end
procedure _0009(arg1)
if not (return \ID_tbl[arg1])
then write(&errout, "uninitialized variable, line ", line_number)
fail
end
procedure _0011(arg1,arg2,arg3)
initial ID_tbl := table()
ID_tbl[arg1] := arg3
return arg3
end
procedure _0013(arg1,arg2,arg3)
return arg1 + arg3
end
procedure _0015(arg1,arg2,arg3)
return arg1 - arg3
end
procedure _0017(arg1,arg2,arg3)
return arg1 * arg3
end
procedure _0019(arg1,arg2,arg3)
return arg1 / arg3
end
procedure _0021(arg1,arg2,arg3)
return arg1 % arg3
end
procedure _0023(arg1,arg2,arg3)
return arg1 ^ arg3
end
procedure _0025(arg1,arg2,arg3)
return arg2
end
procedure _0027(arg1)
if find(".", arg1)
then return real(arg1)
else return integer(arg1)
end

# I use ximage for debugging; remove it if you don't need it.
link codeobj, ximage

record ACT(str, state, by_rule, sym, size)
record symbol(str, terminal)
record TOK(sym, str)

global line_number, errors

#
# iparse:  file     -> ?
#          stream   -> ?
#
#     Where stream is an open file, and ? represents the user-defined
#     result of a completed parse of file, from the current location
#     up to the point where the parser executes an "accept" action.
#
#     The second to fifth arguments are used on recursive calls from
#     the error handler, iparse_error.  Ignore them, unless you are
#     sure of what you are doing!
#
procedure iparse(stream, state_stack, value_stack, next_token, err_state)

    local start_symbol, token, act, arglist
    static alst, glst
    #global line_number, errors
    initial {
	alst := decode("l7341Lla122T0n1s(lb21R3sACT5sshift1i80n0n0n2sCR_
	    lc21R3sACT5sshift1i50n0n0n2sIDld21R3sACT5sshift1i70n0n0n3sNU_
	    Mle21R3sACT5sshift1i90n0n0nlf31T0n1s$lg21R3sACT6saccept0n0n0_
	    n0nlh38T0n1s$li28R3sACT6sreduce0n5s_00011sS1i1lj163T0n1s$lk3_
	    3R3sACT6sreduce0n5s_00036sstream1i11s(ll21R3sACT5sshift1i80n_
	    0n0n2sCRlm21R3sACT5sshift1i50n0n0n2sIDln21R3sACT5sshift1i70n_
	    0n0n3sNUMlo21R3sACT5sshift1i90n0n0nlp201T0n1s$lq31R3sACT6sre_
	    duce0n5s_00054scalc1i11s(lr31R3sACT6sreduce0n5s_00054scalc1i_
	    12sCRls31R3sACT6sreduce0n5s_00054scalc1i12sIDlt31R3sACT6sred_
	    uce0n5s_00054scalc1i13sNUMlu31R3sACT6sreduce0n5s_00054scalc1_
	    i1lv216T0n1s%lw22R3sACT5sshift2i160n0n0n1s*lx22R3sACT5sshift_
	    2i140n0n0n1s+ly22R3sACT5sshift2i120n0n0n1s-lz22R3sACT5sshift_
	    2i130n0n0n1s/laa22R3sACT5sshift2i150n0n0n2sCRlab22R3sACT5ssh_
	    ift2i110n0n0n1s^lac22R3sACT5sshift2i170n0n0nlad314T0n1s%lae3_
	    1R3sACT6sreduce0n5s_00094sexpr1i11s*laf31R3sACT6sreduce0n5s__
	    00094sexpr1i11s+lag31R3sACT6sreduce0n5s_00094sexpr1i11s-lah3_
	    1R3sACT6sreduce0n5s_00094sexpr1i11s/lai31R3sACT6sreduce0n5s__
	    00094sexpr1i11s=laj22R3sACT5sshift2i180n0n0n2sCRlak31R3sACT6_
	    sreduce0n5s_00094sexpr1i11s^lal31R3sACT6sreduce0n5s_00094sex_
	    pr1i1lam98T0n1s(lan22R3sACT5sshift2i210n0n0n2sIDlao22R3sACT5_
	    sshift2i200n0n0n3sNUMlap22R3sACT5sshift2i220n0n0nlaq283T0n1s_
	    %lar31R3sACT6sreduce0n5s_00274sexpr1i11s*las31R3sACT6sreduce_
	    0n5s_00274sexpr1i11s+lat31R3sACT6sreduce0n5s_00274sexpr1i11s_
	    -lau31R3sACT6sreduce0n5s_00274sexpr1i11s/lav31R3sACT6sreduce_
	    0n5s_00274sexpr1i12sCRlaw31R3sACT6sreduce0n5s_00274sexpr1i11_
	    s^lax31R3sACT6sreduce0n5s_00274sexpr1i1lay44T0n1s$laz33R3sAC_
	    T6sreduce0n5s_00036sstream1i2lba206T0n1s$lbb31R3sACT6sreduce_
	    0n5s_00074scalc1i21s(lbc31R3sACT6sreduce0n5s_00074scalc1i22s_
	    CRlbd31R3sACT6sreduce0n5s_00074scalc1i22sIDlbe31R3sACT6sredu_
	    ce0n5s_00074scalc1i23sNUMlbf31R3sACT6sreduce0n5s_00074scalc1_
	    i2lbg95T0n1s(lbh21R3sACT5sshift1i80n0n0n2sIDlbi21R3sACT5sshi_
	    ft1i70n0n0n3sNUMlbj21R3sACT5sshift1i90n0n0n3llbg3llbg3llbg3l_
	    lbg3llbg3llbglbk219T0n1s%lbl22R3sACT5sshift2i350n0n0n1s)lbm2_
	    2R3sACT5sshift2i300n0n0n1s*lbn22R3sACT5sshift2i330n0n0n1s+lb_
	    o22R3sACT5sshift2i310n0n0n1s-lbp22R3sACT5sshift2i320n0n0n1s/_
	    lbq22R3sACT5sshift2i340n0n0n1s^lbr22R3sACT5sshift2i360n0n0nl_
	    bs313T0n1s%lbt31R3sACT6sreduce0n5s_00094sexpr1i11s)lbu31R3sA_
	    CT6sreduce0n5s_00094sexpr1i11s*lbv31R3sACT6sreduce0n5s_00094_
	    sexpr1i11s+lbw31R3sACT6sreduce0n5s_00094sexpr1i11s-lbx31R3sA_
	    CT6sreduce0n5s_00094sexpr1i11s/lby31R3sACT6sreduce0n5s_00094_
	    sexpr1i11s=lbz22R3sACT5sshift2i370n0n0n1s^lca31R3sACT6sreduc_
	    e0n5s_00094sexpr1i13llamlcb282T0n1s%lcc31R3sACT6sreduce0n5s__
	    00274sexpr1i11s)lcd31R3sACT6sreduce0n5s_00274sexpr1i11s*lce3_
	    1R3sACT6sreduce0n5s_00274sexpr1i11s+lcf31R3sACT6sreduce0n5s__
	    00274sexpr1i11s-lcg31R3sACT6sreduce0n5s_00274sexpr1i11s/lch3_
	    1R3sACT6sreduce0n5s_00274sexpr1i11s^lci31R3sACT6sreduce0n5s__
	    00274sexpr1i1lcj247T0n1s%lck22R3sACT5sshift2i160n0n0n1s*lcl2_
	    2R3sACT5sshift2i140n0n0n1s+lcm31R3sACT6sreduce0n5s_00134sexp_
	    r1i31s-lcn31R3sACT6sreduce0n5s_00134sexpr1i31s/lco22R3sACT5s_
	    shift2i150n0n0n2sCRlcp31R3sACT6sreduce0n5s_00134sexpr1i31s^l_
	    cq22R3sACT5sshift2i170n0n0nlcr247T0n1s%lcs22R3sACT5sshift2i1_
	    60n0n0n1s*lct22R3sACT5sshift2i140n0n0n1s+lcu31R3sACT6sreduce_
	    0n5s_00154sexpr1i31s-lcv31R3sACT6sreduce0n5s_00154sexpr1i31s_
	    /lcw22R3sACT5sshift2i150n0n0n2sCRlcx31R3sACT6sreduce0n5s_001_
	    54sexpr1i31s^lcy22R3sACT5sshift2i170n0n0nlcz274T0n1s%lda31R3_
	    sACT6sreduce0n5s_00174sexpr1i31s*ldb31R3sACT6sreduce0n5s_001_
	    74sexpr1i31s+ldc31R3sACT6sreduce0n5s_00174sexpr1i31s-ldd31R3_
	    sACT6sreduce0n5s_00174sexpr1i31s/lde31R3sACT6sreduce0n5s_001_
	    74sexpr1i32sCRldf31R3sACT6sreduce0n5s_00174sexpr1i31s^ldg22R_
	    3sACT5sshift2i170n0n0nldh274T0n1s%ldi31R3sACT6sreduce0n5s_00_
	    194sexpr1i31s*ldj31R3sACT6sreduce0n5s_00194sexpr1i31s+ldk31R_
	    3sACT6sreduce0n5s_00194sexpr1i31s-ldl31R3sACT6sreduce0n5s_00_
	    194sexpr1i31s/ldm31R3sACT6sreduce0n5s_00194sexpr1i32sCRldn31_
	    R3sACT6sreduce0n5s_00194sexpr1i31s^ldo22R3sACT5sshift2i170n0_
	    n0nldp274T0n1s%ldq31R3sACT6sreduce0n5s_00214sexpr1i31s*ldr31_
	    R3sACT6sreduce0n5s_00214sexpr1i31s+lds31R3sACT6sreduce0n5s_0_
	    0214sexpr1i31s-ldt31R3sACT6sreduce0n5s_00214sexpr1i31s/ldu31_
	    R3sACT6sreduce0n5s_00214sexpr1i32sCRldv31R3sACT6sreduce0n5s__
	    00214sexpr1i31s^ldw22R3sACT5sshift2i170n0n0nldx283T0n1s%ldy3_
	    1R3sACT6sreduce0n5s_00234sexpr1i31s*ldz31R3sACT6sreduce0n5s__
	    00234sexpr1i31s+lea31R3sACT6sreduce0n5s_00234sexpr1i31s-leb3_
	    1R3sACT6sreduce0n5s_00234sexpr1i31s/lec31R3sACT6sreduce0n5s__
	    00234sexpr1i32sCRled31R3sACT6sreduce0n5s_00234sexpr1i31s^lee_
	    31R3sACT6sreduce0n5s_00234sexpr1i3lef229T0n1s%leg22R3sACT5ss_
	    hift2i160n0n0n1s*leh22R3sACT5sshift2i140n0n0n1s+lei22R3sACT5_
	    sshift2i120n0n0n1s-lej22R3sACT5sshift2i130n0n0n1s/lek22R3sAC_
	    T5sshift2i150n0n0n2sCRlel31R3sACT6sreduce0n5s_00114sexpr1i31_
	    s^lem22R3sACT5sshift2i170n0n0nlen283T0n1s%leo31R3sACT6sreduc_
	    e0n5s_00254sexpr1i31s*lep31R3sACT6sreduce0n5s_00254sexpr1i31_
	    s+leq31R3sACT6sreduce0n5s_00254sexpr1i31s-ler31R3sACT6sreduc_
	    e0n5s_00254sexpr1i31s/les31R3sACT6sreduce0n5s_00254sexpr1i32_
	    sCRlet31R3sACT6sreduce0n5s_00254sexpr1i31s^leu31R3sACT6sredu_
	    ce0n5s_00254sexpr1i33llam3llam3llam3llam3llam3llam3llamlev21_
	    9T0n1s%lew22R3sACT5sshift2i350n0n0n1s)lex22R3sACT5sshift2i46_
	    0n0n0n1s*ley22R3sACT5sshift2i330n0n0n1s+lez22R3sACT5sshift2i_
	    310n0n0n1s-lfa22R3sACT5sshift2i320n0n0n1s/lfb22R3sACT5sshift_
	    2i340n0n0n1s^lfc22R3sACT5sshift2i360n0n0nlfd246T0n1s%lfe22R3_
	    sACT5sshift2i350n0n0n1s)lff31R3sACT6sreduce0n5s_00134sexpr1i_
	    31s*lfg22R3sACT5sshift2i330n0n0n1s+lfh31R3sACT6sreduce0n5s_0_
	    0134sexpr1i31s-lfi31R3sACT6sreduce0n5s_00134sexpr1i31s/lfj22_
	    R3sACT5sshift2i340n0n0n1s^lfk22R3sACT5sshift2i360n0n0nlfl246_
	    T0n1s%lfm22R3sACT5sshift2i350n0n0n1s)lfn31R3sACT6sreduce0n5s_
	    _00154sexpr1i31s*lfo22R3sACT5sshift2i330n0n0n1s+lfp31R3sACT6_
	    sreduce0n5s_00154sexpr1i31s-lfq31R3sACT6sreduce0n5s_00154sex_
	    pr1i31s/lfr22R3sACT5sshift2i340n0n0n1s^lfs22R3sACT5sshift2i3_
	    60n0n0nlft273T0n1s%lfu31R3sACT6sreduce0n5s_00174sexpr1i31s)l_
	    fv31R3sACT6sreduce0n5s_00174sexpr1i31s*lfw31R3sACT6sreduce0n_
	    5s_00174sexpr1i31s+lfx31R3sACT6sreduce0n5s_00174sexpr1i31s-l_
	    fy31R3sACT6sreduce0n5s_00174sexpr1i31s/lfz31R3sACT6sreduce0n_
	    5s_00174sexpr1i31s^lga22R3sACT5sshift2i360n0n0nlgb273T0n1s%l_
	    gc31R3sACT6sreduce0n5s_00194sexpr1i31s)lgd31R3sACT6sreduce0n_
	    5s_00194sexpr1i31s*lge31R3sACT6sreduce0n5s_00194sexpr1i31s+l_
	    gf31R3sACT6sreduce0n5s_00194sexpr1i31s-lgg31R3sACT6sreduce0n_
	    5s_00194sexpr1i31s/lgh31R3sACT6sreduce0n5s_00194sexpr1i31s^l_
	    gi22R3sACT5sshift2i360n0n0nlgj273T0n1s%lgk31R3sACT6sreduce0n_
	    5s_00214sexpr1i31s)lgl31R3sACT6sreduce0n5s_00214sexpr1i31s*l_
	    gm31R3sACT6sreduce0n5s_00214sexpr1i31s+lgn31R3sACT6sreduce0n_
	    5s_00214sexpr1i31s-lgo31R3sACT6sreduce0n5s_00214sexpr1i31s/l_
	    gp31R3sACT6sreduce0n5s_00214sexpr1i31s^lgq22R3sACT5sshift2i3_
	    60n0n0nlgr282T0n1s%lgs31R3sACT6sreduce0n5s_00234sexpr1i31s)l_
	    gt31R3sACT6sreduce0n5s_00234sexpr1i31s*lgu31R3sACT6sreduce0n_
	    5s_00234sexpr1i31s+lgv31R3sACT6sreduce0n5s_00234sexpr1i31s-l_
	    gw31R3sACT6sreduce0n5s_00234sexpr1i31s/lgx31R3sACT6sreduce0n_
	    5s_00234sexpr1i31s^lgy31R3sACT6sreduce0n5s_00234sexpr1i3lgz2_
	    28T0n1s%lha22R3sACT5sshift2i350n0n0n1s)lhb31R3sACT6sreduce0n_
	    5s_00114sexpr1i31s*lhc22R3sACT5sshift2i330n0n0n1s+lhd22R3sAC_
	    T5sshift2i310n0n0n1s-lhe22R3sACT5sshift2i320n0n0n1s/lhf22R3s_
	    ACT5sshift2i340n0n0n1s^lhg22R3sACT5sshift2i360n0n0nlhh282T0n_
	    1s%lhi31R3sACT6sreduce0n5s_00254sexpr1i31s)lhj31R3sACT6sredu_
	    ce0n5s_00254sexpr1i31s*lhk31R3sACT6sreduce0n5s_00254sexpr1i3_
	    1s+lhl31R3sACT6sreduce0n5s_00254sexpr1i31s-lhm31R3sACT6sredu_
	    ce0n5s_00254sexpr1i31s/lhn31R3sACT6sreduce0n5s_00254sexpr1i3_
	    1s^lho31R3sACT6sreduce0n5s_00254sexpr1i3")
	glst := decode("lhp550Llhq37T0n1sS1i24scalc1i44sexpr1i66sstream_
	    1i3lhr2T0nlhs2T0nlht32T0n4scalc1i44sexpr1i66sstream2i10lhu2T_
	    0n0nlhv2T0nlhw12T0n4sexpr2i19lhx2T0nlhy2T0nlhz2T0nlia12T0n4s_
	    expr2i23lib12T0n4sexpr2i24lic12T0n4sexpr2i25lid12T0n4sexpr2i_
	    26lie12T0n4sexpr2i27lif12T0n4sexpr2i28lig12T0n4sexpr2i290nli_
	    h2T0nlii12T0n4sexpr2i38lij2T0nlik2T0nlil2T0nlim2T0nlin2T0nli_
	    o2T0nlip2T0nliq2T0nlir2T0nlis12T0n4sexpr2i39lit12T0n4sexpr2i_
	    40liu12T0n4sexpr2i41liv12T0n4sexpr2i42liw12T0n4sexpr2i43lix1_
	    2T0n4sexpr2i44liy12T0n4sexpr2i450nliz2T0nlja2T0nljb2T0nljc2T_
	    0nljd2T0nlje2T0nljf2T0nljg2T0n")
	#
	# Uncomment the following if you want a look at the state and goto
	# tables.  If you aren't planning on looking at them, find the
	# procedure definition for dump_lists below, and delete it.  Why
	# keep it around if it's not being used?
	#
	# dump_lists(&errout, alst, glst)
    }
    #
    # New, not recursive, invocation; reset stacks, line number and
    # error count.
    #
    start_symbol := "S"
    /err_state   := 1
    /state_stack := [1] & line_number := 0 & errors := 0
    /value_stack := []
    /next_token  := create iparse_tokens(stream)

    while token := @next_token do {
	repeat {
	    act := \alst[state_stack[1]][token.sym] | {
		#
		# You can replace this error handler with whatever you
		# like, and have it do whatever you like.
		#
	        # (iparse_error increments global errors variable)
		return iparse_error(alst, state_stack, value_stack,
				    token, next_token, err_state)
	    }
	    err_state := 0
	    case act.str of {
	        "shift"   :  {
		    # push the next state onto the state stack
	    	    push(state_stack, act.state)
		    # push the current token's literal value onto the
		    # value stack
		    push(value_stack, token.str)
		    # break out of enclosing repeat loop
		    break
	        }
	        "reduce"  :  {
	    	    arglist := []
		    #
		    # Pop as many elements off of the token stack as
		    # there are symbols in the right-hand side of the
		    # rule.  Push these elements onto an argument list.
		    #
		    every 1 to act.size do {
		        pop(state_stack)
		        push(arglist, pop(value_stack))
		    }
		    #
		    # Check to goto list to see what state we should
		    # be in, and push that state onto the state stack.
		    #
		    push(state_stack,
			 glst[state_stack[1]][act.sym])
		    #
		    # Call the code associated with the current
		    # reduction, and push the result onto the stack.
		    # For more results, push a coexpression instead.
		    #
		    push(value_stack, (proc(act.by_rule)!arglist)) | {
			# On failure, return the stacks to the state
			# they were in before the last reduction.
			pop(state_stack)
			return iparse_error(alst, state_stack, value_stack,
					    token, next_token, err_state + 1)
		    }
		}
		"accept"  :  {
		    #
		    # We're done.  Return the last result.
		    #
		    return value_stack[1]
	        }
	    }
	}
    }
    write(&errout, "iparse:  unexpected end of input")
    fail

end

#
# iparse_tokens:  file  -> TOK records (a generator)
#                stream -> tokens
#
#     Where file is an open input stream, and tokens are TOK
#     records holding both the token type and actual token text.
#
#     TOK records contain two parts, a preterminal symbol (the first
#     "sym" field), and the actual text of the token ("str").  The
#     parser above only pays attention to the sym field, although the
#     user might well want to use the actual text.
#
procedure iparse_tokens(stream)

    local token, c, whitespace, operators
    #global line_number
    whitespace := '\r\t \n'
    operators  := '+-*/^()='

    token := ""
    every c := !(!&input || "\n") do {
	if not any(whitespace ++ operators, c) then {
	    token ||:= c
	} else {
	    if integer(token)
	    then suspend TOK("NUM", "" ~== token)
	    else suspend TOK("ID", "" ~== token)
	    if any(operators, c) then
		suspend TOK(c)
	    else {
		if c == "\n" then {
		    line_number +:= 1
		    suspend TOK("CR"|"CR")
		}
	    }
	    token := ""
	}
    }
    if integer(token)
    then suspend TOK("NUM", "" ~== token)
    else suspend TOK("ID",  "" ~== token)
    suspend TOK("CR"|"$")

end

#
# iparse_error:  list x list x list x list x TOK x coexpression x integer -> ?
#               (alst, state_stack, value_stack, token_stack, token,
#			                      next_token, err_state) -> ?
#
#     Where alst is the action list, where state_stack is the state
#     stack used by iparse, where token stack is the token stack used
#     by iparse, where token is the current lookahead TOK record,
#     where next_token is the coexpression from which we get our
#     tokens, and where err_state indicates how many recursive calls
#     we've made to the parser via the error handler without a
#     recovery.
#
#     Recursively calls iparse, attempting to restart the parser after
#     an error.  Increments global "errors" variable (a count of the
#     number of errors encountered, minus cascading series of errors).
#
procedure iparse_error(alst, state_stack, value_stack,
		       token, next_token, err_state)
    local sym
    static tlst
    #global line_number, errors
    initial {
	tlst := decode("lgv35S1s+1s(1s%1s-1s=1s*1s/1s$1s)1s^3sNUM")
    }

    #
    # Check to see how many attempts we have made at a resync.  If
    # this is a new error series, increment the global "errors" count.
    #
    if (err_state +:= 1) > 3 then
	stop("iparse_error:  unable to resync after error; aborting")
    else if err_state = 1 then
	errors +:= 1  # GLOBAL

    #
    # Check to see if the grammar even has this pre-terminal.
    #
    if not member(tlst, token.sym)
    then write(&errout, "iparse_error:  unknown token, ", token.sym,
	", in line ", line_number)
    # Only note the first in a series of cascading errors.
    else if err_state = 1 then {
	write(&errout, "iparse_error:  syntax error in line ",
		line_number, "; resynchronizing parser")
    }

    #
    # Now, try to shift in the next input token to see if we can
    # resync the parser.  Stream argument is null because next_token
    # has already been created.
    #
    return iparse(&null, state_stack, value_stack, token_stack,
		  next_token, err_state)

end

#
# dump_lists:  file x list x list -> (null)
#              (f, gl, al)        -> (null)
#
#     Where f is an open file, gl is the goto list, and al is the
#     action list.  Writes to file f a human-readable dump of the goto
#     and action list.
#
procedure dump_lists(f, al, gl)

    local TAB, look_list, red_list, i, sym, act

    TAB := "\t"
    look_list := list()
    red_list := list()

    every i := 1 to *al do {
	every INSERT(look_list, key(\al[i]))
	if /al[i] then
	    write(&errout, "dump_lists:  warning!  state ", i, " is null")
    }

    writes(f,TAB)
    every i := 1 to *look_list do
	writes(f,look_list[i], TAB)
    write(f)
    every i := 1 to *al do {
	writes(f,i, TAB)
	act := ""
	every sym := !look_list do {
	    if \al[i][sym] then {
		writes(f,al[i][sym].str[1:3], al[i][sym].state)
		if al[i][sym].str == "reduce" then {
		    INSERT(red_list, al[i][sym].sym)
		    writes(f,al[i][sym].sym)
		}
	    }
	    writes(f,TAB)
	}
	write(f)
    }
    write(f)

    writes(f,TAB)
    every i := 1 to *red_list do
	writes(f,red_list[i], TAB)
    write(f)
    every i := 1 to *gl do {
	writes(f,i, TAB)
	act := ""
	every sym := !red_list do {
	    if \(\gl[i])[sym] then
		writes(f,gl[i][sym])
	    writes(f,TAB)
	}
	write(f)
    }

end

#
# INSERT:  set or list x record -> set or list
# 	   (sset, rec)          -> sset
#
#     Where sset is a homogenous set or list of records, rec is a
#     record, and the return value is sset, with rec added, iff an
#     equivalent record was not there already.  Otherwise, sset is
#     returned unchanged. INSERT(), _unlike insert(), FAILS IF REC
#     IS ALREADY PRESENT IN SSET.
#
#     This procedure is used by dump_lists() above.  If you delete
#     dump_lists(), delete this as well, as also Equiv() below.
#
procedure INSERT(sset, rec)

    local addto
    #
    # Decide how to add members to sset, depending on its type.
    #
    addto := {
	case type(sset) of {
	    "set"   : insert
	    "list"  : put
	    default : stop("INSERT:  wrong type argument (",type(sset),")")
	}
    }

    # Rudumentary error check to be sure the object to be inserted
    # into sset is of the same time as the objects already there.
    #
    if *sset > 0 then
	type(rec) == type(sset[1]) |
	    stop("INSERT:  unexpected type difference")

    #
    # If a rec-like item isn't in sset, add it to sset.
    #
    if Equiv(!sset, rec) then fail
    else return addto(sset, rec)

end
	

#
# Equiv: struct x struct -> struct
#        (x1, x2)        -> x2
#
#     Where x1 and x2 are arbitrary structures.  Returns x2 if x1 and
#     x2 are structurally equivalent (even if not identical).  Taken
#     from the IPL file "structs.icn."
#
#     Equiv() is used by dump_lists() above.  If you delete
#     dump_lists, delete this as well.
#
procedure Equiv(x1, x2, done)

   local code, i

   if x1 === x2 then return x2		# Covers everything but structures.
   if type(x1) ~== type(x2) then fail	# Must be same type.
   if type(x1) == ("procedure" | "file")# Leave only those with sizes (null
      then fail				# taken care of by first two tests).
   if *x1 ~= *x2 then fail

   /done := table()
   (/done[x1] := set()) |		# Make set of equivalences if new.
      (if member(done[x1],x2) then return x2)
   # Records complicate things.
   image(x1) ? (code := (="record" | type(x1)))
   
   case code of {
       "list" | "record" :
	   every i := 1 to *x1 do
	       if not Equiv(x1[i],x2[i],done) then fail
       "table" : if not Equiv(sort(x1,3),sort(x2,3),done) then fail
       "set"   : if not Equiv(sort(x1),sort(x2),done) then fail
       default : fail			# Vaues of other types are different. 
   }

   insert(done[x1],x2)			# Equivalent; add to set.
   return x2

end

--------------------------------  cut here --------------------------------
-- 

   -Richard L. Goerwitz              goer%midway@uchicago.bitnet
   goer@midway.uchicago.edu          rutgers!oddjob!ellis!goer