perm filename PLNR.135[P,BGB] blob
sn#009275 filedate 1974-04-16 generic text, type T, neo UTF8
00100
00200
00300 (QUOTE "The latest (and greatest) u-PLANNER, featuring such attractions as:
00400 THSTEP, THSTEPD, THSTEPT, THSTEPF (as seen in THVAL)
00500 THRESTRICT
00600 and a new and enlarged macro facility - ; and R, G, and A
00700 ")
00800
00900 (DECLARE (*FEXPR THAPPLY THBKPT THUNIQUE THVSETQ THMESSAGE THDO THERT THGOAL THERASE THAND THNV THSUCCEED THAMON~
01000 G THCOND THSETQ THASSERT THASVAL THERT THGO THFAIL THOR THFIND THFINALIZE THRETURN THPROG THFLUSH THNOT THV))
01100
01200 (DECLARE (SETQ *MACRO T) (SETQ *SYMBOLS T) (GENPREFIX TH))
01300
01400 (AND PURE (SETQ LOW (PAGEBPORG)))
01500
01600 (DEFPROP THSEMI
01700 (LAMBDA NIL (PROG NIL LP (COND ((EQ (READCH) (QUOTE /;)) (RETURN NIL))) (GO LP)))
01800 EXPR)
01900
02000
02100 (DEFPROP THREAD
02200 (LAMBDA NIL
02300 (PROG (CHAR)
02400 (RETURN
02500 (COND ((EQ (SETQ CHAR (READCH)) (QUOTE ?)) (LIST (QUOTE THV) (READ)))
02600 ((EQ CHAR (QUOTE E)) (LIST (QUOTE THEV) (READ)))
02700 ((EQ CHAR (QUOTE ←)) (LIST (QUOTE THNV) (READ)))
02800 ((EQ CHAR (QUOTE &))
02900 (PROG NIL CHLP (COND ((EQ (QUOTE &) (READCH)) (RETURN (QUOTE (COMMENT))))) (GO CHLP)))
03000 ((EQ CHAR (QUOTE T)) (QUOTE (THTBF THTRUE)))
03100 ((EQ CHAR (QUOTE R)) (QUOTE THRESTRICT))
03200 ((EQ CHAR (QUOTE G)) (QUOTE THGOAL))
03300 ((EQ CHAR (QUOTE A)) (QUOTE THASSERT))
03400 ((PRINT (QUOTE ILLEGAL-PREFIX)) (PRINC (QUOTE $)) (PRINC CHAR) (PRINC (READ)) (ERR NIL))))))
03500 EXPR)
03600
03700
03800 (DEFPROP THPUSH
03900 (LAMBDA (A) (LIST (QUOTE SETQ) (CADR A) (LIST (QUOTE CONS) (CADDR A) (CADR A))))
04000 MACRO)
04100
04200
04300 (DEFPROP EVLIS
04400 (LAMBDA (X) (MAPC (FUNCTION EVAL) X))
04500 EXPR)
04600
04700
04800 (DEFPROP THPRINT2
04900 (LAMBDA (X) (PROG NIL (PRINC (QUOTE / )) (RETURN (PRINC X))))
05000 EXPR)
05100
05200
05300 (DECLARE (SPECIAL THTT THFST THTTL THLAS THNF THWH))
05400
05500 (DECLARE (SPECIAL THFSTP))
05600
05700 (DEFPROP THADD
05800 (LAMBDA(THTT THPL)
05900 (PROG (THNF THWH THCK THLAS THTTL THT1 THFST THFSTP THFOO)
06000 (SETQ THCK
06100 (COND ((ATOM THTT) (OR (SETQ THT1 (GET THTT (QUOTE THEOREM)))
06200 (PROG2 (PRINT THTT) (THERT CANT THASSERT/, NO THEOREM /- THADD)))
06300 (SETQ THWH (CAR THT1))
06400 (SETQ THTTL THTT)
06500 (AND THPL
06600 (PROG NIL
06700 LP (THPUTPROP THTT (CADR THPL) (CAR THPL))
06800 (COND ((SETQ THPL (CDDR THPL)) (GO LP)))))
06900 (CADDR THT1))
07000 ((EQ (CAR THTT) (QUOTE THAUX))
07100 (RETURN ((GET (CADR THTT) (QUOTE THADD)) (CADDR THTT) THPL)))
07200 (T (SETQ THWH (QUOTE THASSERTION)) (SETQ THTTL (CONS THTT THPL)) THTT)))
07300 (SETQ THNF 0)
07400 (SETQ THLAS (LENGTH THCK))
07500 (SETQ THFST T)
07600 THP1 (COND ((NULL THCK) (SETQ THCK THFOO)
07700 (SETQ THNF 0)
07800 (SETQ THFOO (SETQ THFST NIL))
07900 (SETQ THFSTP T)
08000 (GO THP1))
08100 ((NULL (SETQ THT1 (THIP (CAR THCK)))) (RETURN NIL))
08200 ((EQ THT1 (QUOTE THOK)))
08300 ((SETQ THFOO (NCONC THFOO (LIST (COND ((EQ THT1 (QUOTE THVRB)) (CAR THCK))))))
08400 (SETQ THCK (CDR THCK))
08500 (GO THP1)))
08600 (SETQ THFST NIL)
08700 (MAPC (FUNCTION THIP) (CDR THCK))
08800 (SETQ THNF 0)
08900 (MAPC (FUNCTION THIP) THFOO)
09000 (RETURN THTTL)))
09100 EXPR)
09200
09300
09400 (DECLARE (UNSPECIAL THTT THFST THFSTP THTTL THLAS THNF THWH))
09500
09600 (DECLARE (SPECIAL THTREE THALIST THXX))
09700
09800 (DEFPROP THAMONG
09900 (LAMBDA(THA)
10000 (COND
10100 ((EQ (CADR
10200 (SETQ THXX
10300 (THGAL (COND ((EQ (CAAR THA) (QUOTE THEV)) (THVAL (CADAR THA) THALIST)) (T (CAR THA)))
10400 THALIST)))
10500 (QUOTE THUNASSIGNED))
10600 (THPUSH THTREE (LIST (QUOTE THAMONG) THXX (THVAL (CADR THA) THALIST)))
10700 NIL)
10800 (T (MEMBER (CADR THXX) (THVAL (CADR THA) THALIST)))))
10900 FEXPR)
11000
11100
11200 (DECLARE (UNSPECIAL THTREE THALIST THXX))
11300
11400 (DECLARE (SPECIAL THALIST THBRANCH THABRANCH THTREE THML))
11500
11600 (DEFPROP THAMONGF
11700 (LAMBDA NIL
11800 (COND ((CADDAR THTREE) (RPLACA (CDADAR THTREE) (CAADDR (CAR THTREE)))
11900 (RPLACA (CDDAR THTREE) (CDADDR (CAR THTREE)))
12000 (SETQ THBRANCH THTREE)
12100 (SETQ THABRANCH THALIST)
12200 (THPOPT)
12300 T)
12400 (T (RPLACA (CDADAR THTREE) (QUOTE THUNASSIGNED)) (THPOPT) NIL)))
12500 EXPR)
12600
12700
12800 (DECLARE (UNSPECIAL THALIST THBRANCH THABRANCH THTREE THML))
12900
13000 (DECLARE (SPECIAL THTREE THEXP))
13100
13200 (DEFPROP THAND
13300 (LAMBDA (A) (OR (NOT A) (PROG2 (THPUSH THTREE (LIST (QUOTE THAND) A NIL)) (SETQ THEXP (CAR A)))))
13400 FEXPR)
13500
13600
13700 (DECLARE (UNSPECIAL THTREE THEXP))
13800
13900 (DEFPROP THANDF
14000 (LAMBDA NIL (PROG NIL (THBRANCHUN) (RETURN NIL)))
14100 EXPR)
14200
14300
14400 (DECLARE (SPECIAL THTREE THVALUE THEXP))
14500
14600 (DEFPROP THANDT
14700 (LAMBDA NIL
14800 (PROG NIL
14900 (COND ((CDADAR THTREE) (THBRANCH)
15000 (SETQ THEXP (CADR (CADAR THTREE)))
15100 (RPLACA (CDAR THTREE) (CDADAR THTREE)))
15200 ((THPOPT)))
15300 (RETURN THVALUE)))
15400 EXPR)
15500
15600
15700 (DECLARE (UNSPECIAL THTREE THVALUE THEXP))
15800
15900 (DECLARE (SPECIAL THTREE THTRACE THOLIST THALIST))
16000
16100 (DEFPROP THAPPLY
16200 (LAMBDA (L) (THAPPLY1 (CAR L) (GET (CAR L) (QUOTE THEOREM)) (CADR L)))
16300 FEXPR)
16400
16500
16600 (DEFPROP THAPPLY1
16700 (LAMBDA(THM THB DAT)
16800 (COND ((AND (THBIND (CADR THB)) (THMATCH1 DAT (CADDR THB))) (AND THTRACE (THTRACES (QUOTE THEOREM) THM))
16900 (THPUSH THTREE
17000 (LIST (QUOTE THPROG)
17100 (CDDR THB)
17200 NIL
17300 (CDDR THB)))
17400 (THPROGA)
17500 T)
17600 (T (SETQ THALIST THOLIST) (THPOPT) NIL)))
17700 EXPR)
17800
17900
18000 (DECLARE (UNSPECIAL THTREE THTRACE THOLIST THALIST))
18100
18200 (DECLARE (SPECIAL THALIST TYPE THX THTREE THEXP THTRACE THY1 THY))
18300
18400 (DEFPROP THASS1
18500 (LAMBDA(THA P)
18600 (PROG (THX THY1 THY TYPE PSEUDO)
18700 (AND (CDR THA) (EQ (CAADR THA) (QUOTE THPSEUDO)) (SETQ PSEUDO T))
18800 (OR (ATOM (SETQ THX (CAR THA)))
18900 (THPURE (SETQ THX (THVARSUBST THX)))
19000 PSEUDO
19100 (PROG2 (PRINT THX) (THERT IMPURE ASSERTION OR ERASURE /- THASS1)))
19200 (AND THTRACE (NOT PSEUDO) (THTRACES (COND (P (QUOTE THASSERT)) ((QUOTE THERASE))) THX))
19300 (SETQ THA (COND (PSEUDO (CDDR THA)) ((CDR THA))))
19400 (OR (SETQ THX
19500 (COND (PSEUDO (LIST THX))
19600 (P
19700 (THADD THX
19800 (SETQ THY
19900 (COND
20000 ((AND THA (EQ (CAAR THA) (QUOTE THPROP)))
20100 (PROG2 0 (EVAL (CADAR THA)) (SETQ THA (CDR THA))))))))
20200 (T (THREMOVE THX))))
20300 (RETURN NIL))
20400 (COND (P (SETQ TYPE (QUOTE THANTE))) ((SETQ TYPE (QUOTE THERASING))))
20500 (OR PSEUDO (THPUSH THTREE (LIST (COND (P (QUOTE THASSERT)) ((QUOTE THERASE))) THX THY)))
20600 (SETQ THEXP (CONS (QUOTE THDO) (MAPCAN (FUNCTION THTAE) THA)))
20700 (RETURN THX)))
20800 EXPR)
20900
21000
21100 (DECLARE (UNSPECIAL THALIST TYPE THX THTREE THEXP THTRACE THY1 THY))
21200
21300 (DEFPROP THASSERT
21400 (LAMBDA (THA) (THASS1 THA T))
21500 FEXPR)
21600
21700
21800 (DECLARE (SPECIAL THTREE))
21900
22000 (DEFPROP THASSERTF
22100 (LAMBDA NIL
22200 (PROG NIL
22300 (THREMOVE (COND ((ATOM (CADAR THTREE)) (CADAR THTREE)) (T (CAADAR THTREE))))
22400 (THPOPT)
22500 (RETURN NIL)))
22600 EXPR)
22700
22800
22900 (DECLARE (UNSPECIAL THTREE))
23000
23100 (DECLARE (SPECIAL THTREE))
23200
23300 (DEFPROP THASSERTT
23400 (LAMBDA NIL (PROG2 0 (CADAR THTREE) (THPOPT)))
23500 EXPR)
23600
23700
23800 (DECLARE (UNSPECIAL THTREE))
23900
24000 (DECLARE (SPECIAL THALIST))
24100
24200 (DEFPROP THASVAL
24300 (LAMBDA (X) ((LAMBDA (X) (AND X (NOT (EQ (CADR X) (QUOTE THUNASSIGNED))))) (THGAL (CAR X) THALIST)))
24400 FEXPR)
24500
24600
24700 (DECLARE (UNSPECIAL THALIST) (SPECIAL THPC))
24800
24900 (DEFPROP THBA
25000 (LAMBDA(TH1 TH2)
25100 (PROG (THP)
25200 (SETQ THP TH2)
25300 THP1 (AND (EQ (COND (THPC (CADR THP)) (T (CAADR THP))) TH1) (RETURN THP))
25400 (OR (CDR (SETQ THP (CDR THP))) (RETURN NIL))
25500 (GO THP1)))
25600 EXPR)
25700
25800
25900 (DEFPROP THBAP
26000 (LAMBDA(TH1 TH2)
26100 (PROG (THP)
26200 (SETQ THP TH2)
26300 THP1 (AND (EQUAL (COND (THPC (CADR THP)) (T (CAADR THP))) TH1) (RETURN THP))
26400 (OR (CDR (SETQ THP (CDR THP))) (RETURN NIL))
26500 (GO THP1)))
26600 EXPR)
26700
26800
26900 (DECLARE (UNSPECIAL THPC) (SPECIAL THTREE THOLIST THALIST))
27000
27100 (DEFPROP THBIND
27200 (LAMBDA(A)
27300 (PROG NIL
27400 (SETQ THOLIST THALIST)
27500 (RETURN
27600 (OR (NULL A)
27700 (PROG NIL
27800 GO (COND ((NULL A) (THPUSH THTREE (LIST (QUOTE THREMBIND) THOLIST)) (RETURN T)))
27900 (THPUSH THALIST
28000 (COND ((ATOM (CAR A)) (LIST (CAR A) (QUOTE THUNASSIGNED)))
28100 ((EQ (CAAR A) (QUOTE THRESTRICT)) (NCONC (THBI1 (CADAR A)) (CDDAR A)))
28200 (T (LIST (CAAR A) (EVAL (CADAR A))))))
28300 (SETQ A (CDR A))
28400 (GO GO))))))
28500 EXPR)
28600
28700
28800 (DECLARE (UNSPECIAL THOLIST THTREE THALIST))
28900
29000 (DEFPROP THBI1
29100 (LAMBDA (X) (COND ((ATOM X) (LIST X (QUOTE THUNASSIGNED))) (T (LIST (CAR X) (EVAL (CADR X))))))
29200 EXPR)
29300
29400
29500 (DECLARE (SPECIAL THTRACE THVALUE))
29600
29700 (DEFPROP THBKPT
29800 (LAMBDA (L) (OR (AND THTRACE (THTRACES (QUOTE THBKPT) L)) THVALUE))
29900 FEXPR)
30000
30100
30200 (DECLARE (UNSPECIAL THTRACE THVALUE))
30300
30400 (DECLARE (SPECIAL THBRANCH THABRANCH THTREE))
30500
30600 (DEFPROP THBRANCH
30700 (LAMBDA NIL
30800 (COND ((NOT (CDADAR THTREE)))
30900 ((EQ THBRANCH THTREE) (SETQ THBRANCH NIL))
31000 ((RPLACA (CDDAR THTREE) (CONS (LIST THBRANCH THABRANCH (CADAR THTREE)) (CADDAR THTREE)))
31100 (SETQ THBRANCH NIL))))
31200 EXPR)
31300
31400
31500 (DECLARE (UNSPECIAL THBRANCH THABRANCH THTREE))
31600
31700 (DECLARE (SPECIAL THTREE THALIST))
31800
31900 (DEFPROP THBRANCHUN
32000 (LAMBDA NIL
32100 (PROG (X)
32200 (RETURN
32300 (COND ((SETQ X (CADDAR THTREE)) (RPLACA (CDAR THTREE) (CADDAR X))
32400 (RPLACA (CDDAR THTREE) (CDR X))
32500 (SETQ THALIST (CADAR X))
32600 (SETQ THTREE (CAAR X))
32700 T)
32800 (T (THPOPT) NIL)))))
32900 EXPR)
33000
33100
33200 (DECLARE (UNSPECIAL THTREE THALIST))
33300
33400 (DECLARE (SPECIAL THTREE THEXP))
33500
33600 (DEFPROP THCOND
33700 (LAMBDA (THA) (PROG NIL (THPUSH THTREE (LIST (QUOTE THCOND) THA NIL)) (RETURN (SETQ THEXP (CAAR THA)))))
33800 FEXPR)
33900
34000
34100 (DECLARE (UNSPECIAL THTREE THEXP))
34200
34300 (DEFPROP THCONDF
34400 (LAMBDA NIL (THOR2 NIL))
34500 EXPR)
34600
34700
34800 (DECLARE (SPECIAL THTREE THVALUE))
34900
35000 (DEFPROP THCONDT
35100 (LAMBDA NIL
35200 (PROG NIL (RPLACA (CAR THTREE) (QUOTE THAND)) (RPLACA (CDAR THTREE) (CAADAR THTREE)) (RETURN THVALUE)))
35300 EXPR)
35400
35500
35600 (DECLARE (UNSPECIAL THTREE THVALUE))
35700
35800 (DEFPROP THDATA
35900 (LAMBDA NIL
36000 (PROG (X)
36100 GO (TERPRI)
36200 (COND ((NULL (SETQ X (READ NIL))) (RETURN T)) ((PRINT (THADD (CAR X) (CDR X)))))
36300 (GO GO)))
36400 EXPR)
36500
36600
36700 (DECLARE (SPECIAL THTREE THEXP))
36800
36900 (DEFPROP THDO
37000 (LAMBDA (A) (OR (NOT A) (PROG2 (THPUSH THTREE (LIST (QUOTE THDO) A NIL NIL)) (SETQ THEXP (CAR A)))))
37100 FEXPR)
37200
37300
37400 (DECLARE (UNSPECIAL THTREE THEXP))
37500
37600 (DECLARE (SPECIAL THTREE THEXP THBRANCH THABRANCH))
37700
37800 (DEFPROP THDO1
37900 (LAMBDA NIL
38000 (PROG NIL
38100 (RPLACA (CDAR THTREE) (CDADAR THTREE))
38200 (SETQ THEXP (CAADAR THTREE))
38300 (RETURN
38400 (COND
38500 (THBRANCH (RPLACA (CDDAR THTREE) (CONS THBRANCH (CADDAR THTREE)))
38600 (SETQ THBRANCH NIL)
38700 (RPLACA (CDDDAR THTREE) (CONS THABRANCH (CAR (CDDDAR THTREE)))))))))
38800 EXPR)
38900
39000
39100 (DECLARE (UNSPECIAL THTREE THEXP THBRANCH THABRANCH))
39200
39300 (DECLARE (SPECIAL THTREE))
39400
39500 (DEFPROP THDOB
39600 (LAMBDA NIL (COND ((NULL (CDADAR THTREE)) (RPLACA (CAR THTREE) (QUOTE THUNDO)) T) ((THDO1))))
39700 EXPR)
39800
39900
40000 (DECLARE (UNSPECIAL THTREE))
40100
40200 (DECLARE (SPECIAL P ATOM OBLIST))
40300
40400 (DEFPROP THDUMP
40500 (LAMBDA NIL
40600 (PROG (P)
40700 (MAPC (FUNCTION
40800 (LAMBDA(BUCKET)
40900 (MAPC (FUNCTION
41000 (LAMBDA(ATOM)
41100 (MAPC (FUNCTION
41200 (LAMBDA(IND)
41300 (AND (SETQ P (GET ATOM IND)) (PRINT (LIST (QUOTE DEFPROP) ATOM P IND)))))
41400 (QUOTE (THCONSE THERASING THANTE)))))
41500 BUCKET)))
41600 OBLIST)
41700 (PRINT (QUOTE (THDATA)))
41800 (MAPC (FUNCTION
41900 (LAMBDA(BUCKET)
42000 (MAPC (FUNCTION
42100 (LAMBDA(ATOM)
42200 (AND (SETQ ATOM (GET ATOM (QUOTE THASSERTION)))
42300 (SETQ ATOM (ASSOC 1 (CDR ATOM)))
42400 (MAPC (FUNCTION
42500 (LAMBDA(LENGTH-BUCKET)
42600 (MAPC (FUNCTION (LAMBDA (ASRT) (PRINT ASRT))) (CDDR LENGTH-BUCKET))))
42700 (CDR ATOM)))))
42800 BUCKET)))
42900 OBLIST)
43000 (PRINT NIL)))
43100 EXPR)
43200
43300
43400 (DECLARE (UNSPECIAL P ATOM OBLIST))
43500
43600 (DEFPROP THERASE
43700 (LAMBDA (THA) (THASS1 THA NIL))
43800 FEXPR)
43900
44000
44100 (DECLARE (SPECIAL THTREE))
44200
44300 (DEFPROP THERASEF
44400 (LAMBDA NIL
44500 (PROG NIL
44600 (THADD (COND ((ATOM (CADAR THTREE)) (CADAR THTREE)) (T (CAADAR THTREE)))
44700 (COND ((ATOM (CADAR THTREE)) NIL) (T (CDADAR THTREE))))
44800 (THPOPT)
44900 (RETURN NIL)))
45000 EXPR)
45100
45200
45300 (DECLARE (UNSPECIAL THTREE))
45400
45500 (DECLARE (SPECIAL THTREE))
45600
45700 (DEFPROP THERASET
45800 (LAMBDA NIL (PROG2 0 (CADAR THTREE) (THPOPT)))
45900 EXPR)
46000
46100
46200 (DECLARE (UNSPECIAL THTREE))
46300
46400 (DECLARE (SPECIAL THINF THTREE THMESSAGE))
46500
46600 (DEFPROP THFAIL
46700 (LAMBDA(THA)
46800 (AND THA
46900 (PROG (THTREE1 THA1 THX)
47000 (SETQ THTREE1 THTREE)
47100 (SETQ THA1
47200 (COND ((EQ (CAR THA) (QUOTE THEOREM)) (QUOTE THPROG))
47300 ((EQ (CAR THA) (QUOTE THTAG)) (QUOTE THPROG))
47400 ((EQ (CAR THA) (QUOTE THINF)) (SETQ THINF T) (RETURN NIL))
47500 ((EQ (CAR THA) (QUOTE THMESSAGE)) (SETQ THMESSAGE (CADR THA)) (RETURN NIL))
47600 (T (CAR THA))))
47700 LP1 (COND ((NULL THTREE1) (PRINT THA) (RETURN (THERT NOT FOUND /- THFAIL)))
47800 ((EQ (CAAR THTREE1) THA1) (GO ELP1)))
47900 ALP1 (SETQ THTREE1 (CDR THTREE1))
48000 (GO LP1)
48100 ELP1 (COND
48200 ((EQ (CAR THA) (QUOTE THTAG))
48300 (COND ((MEMQ (CADR THA) (CADDDR (CAR THTREE1))) (GO TAGS)) (T (GO ALP1)))))
48400 (RPLACD THTREE1 (CONS (LIST (QUOTE THFAIL?) T (AND (CDR THA) (CADR THA))) (CDR THTREE1)))
48500 (SETQ THMESSAGE (QUOTE THFAIL))
48600 (RETURN NIL)
48700 TAGS (SETQ THX (CADDAR THTREE1))
48800 LP2 (COND ((NULL (CAR THX)) (GO ALP1))
48900 ((EQ (CAADDR (CAR THX)) (CADR THA)) (RPLACA (CAR THX)
49000 (CONS (LIST (QUOTE THFAIL?)
49100 T
49200 (AND (CDDR THA) (CADDR THA)))
49300 (CAAR THX)))
49400 (SETQ THMESSAGE (QUOTE THFAIL))
49500 (RETURN NIL)))
49600 (SETQ THX (CDR THX))
49700 (GO LP2))))
49800 FEXPR)
49900
50000
50100 (DECLARE (UNSPECIAL THINF THTREE THMESSAGE))
50200
50300 (DECLARE (SPECIAL THTREE THVALUE))
50400
50500 (DEFPROP THFAIL?
50600 (LAMBDA (PRD ACT) (PROG NIL (THPUSH THTREE (LIST (QUOTE THFAIL?) PRD ACT)) (RETURN THVALUE)))
50700 EXPR)
50800
50900
51000 (DECLARE (UNSPECIAL THTREE THVALUE))
51100
51200 (DECLARE (SPECIAL THTREE THMESSAGE))
51300
51400 (DEFPROP THFAIL?F
51500 (LAMBDA NIL
51600 (COND ((EVAL (CADAR THTREE)) (PROG2 (SETQ THMESSAGE NIL) (EVAL (CADDAR THTREE)) (THPOPT))) (T (THPOPT) NIL)))
51700 EXPR)
51800
51900
52000 (DECLARE (UNSPECIAL THTREE THMESSAGE))
52100
52200 (DECLARE (SPECIAL THVALUE))
52300
52400 (DEFPROP THFAIL?T
52500 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN THVALUE)))
52600 EXPR)
52700
52800
52900 (DECLARE (UNSPECIAL THVALUE))
53000
53100 (DEFPROP THFINALIZE
53200 (LAMBDA(THA)
53300 (PROG (THTREE1 THT THX)
53400 (COND ((NULL THA) (THERT BAD CALL /- THFINALIZE))
53500 ((EQ (CAR THA) (QUOTE THTAG)) (SETQ THT (CADR THA)))
53600 ((EQ (CAR THA) (QUOTE THEOREM)) (SETQ THA (LIST (QUOTE THPROG)))))
53700 (SETQ THTREE (SETQ THTREE1 (CONS NIL THTREE)))
53800 PLUP (SETQ THX (CADR THTREE1))
53900 (COND ((NULL (CDR THTREE1)) (PRINT THA) (THERT OVERPOP /- THFINALIZE))
54000 ((AND THT (EQ (CAR THX) (QUOTE THPROG)) (MEMQ THT (CADDDR THX))) (GO RTLEV))
54100 ((OR (EQ (CAR THX) (QUOTE THPROG)) (EQ (CAR THX) (QUOTE THAND)))
54200 (RPLACA (CDDR THX) NIL)
54300 (SETQ THTREE1 (CDR THTREE1)))
54400 ((EQ (CAR THX) (QUOTE THREMBIND)) (SETQ THTREE1 (CDR THTREE1)))
54500 ((RPLACD THTREE1 (CDDR THTREE1))))
54600 (COND ((EQ (CAR THX) (CAR THA)) (GO DONE)))
54700 (GO PLUP)
54800 RTLEV
54900 (SETQ THX (CDDR THX))
55000 LEVLP
55100 (COND ((NULL (CAR THX)) (SETQ THTREE1 (CDR THTREE1)) (GO PLUP))
55200 ((EQ (CAADDR (CAAR THX)) THT) (GO DONE)))
55300 (RPLACA THX (CDAR THX))
55400 (GO LEVLP)
55500 DONE (SETQ THTREE (CDR THTREE))
55600 (RETURN T)))
55700 FEXPR)
55800
55900
56000 (DECLARE (UNSPECIAL THTREE))
56100
56200 (DECLARE (SPECIAL THTREE))
56300
56400 (DEFPROP THFIND
56500 (LAMBDA(THA)
56600 (PROG NIL
56700 (THBIND (CADDR THA))
56800 (THPUSH THTREE
56900 (LIST (QUOTE THFIND)
57000 (COND ((EQ (CAR THA) (QUOTE ALL)) (QUOTE (1 NIL NIL)))
57100 ((ATOM (CAR THA)) (LIST (CAR THA) (CAR THA) T))
57200 ((CAR THA)))
57300 (CONS 0 NIL)
57400 (CADR THA)))
57500 (THPUSH THTREE (LIST (QUOTE THPROG) (CDDR THA) NIL (CDDR THA)))
57600 (RETURN (THPROGA))))
57700 FEXPR)
57800
57900
58000 (DECLARE (UNSPECIAL THTREE))
58100
58200 (DECLARE (SPECIAL THTREE THBRANCH THXX))
58300
58400 (DEFPROP THFINDF
58500 (LAMBDA NIL
58600 (PROG NIL
58700 (SETQ THBRANCH NIL)
58800 (RETURN
58900 (COND ((LESSP (CAADR (SETQ THXX (CDAR THTREE))) (CAAR THXX)) (THPOPT) NIL)
59000 (T (THPOPT) (CDADR THXX))))))
59100 EXPR)
59200
59300
59400 (DECLARE (UNSPECIAL THTREE THBRANCH THXX))
59500
59600 (DECLARE (SPECIAL THTREE THALIST THBRANCH THABRANCH))
59700
59800 (DEFPROP THFINDT
59900 (LAMBDA NIL
60000 (PROG (THX THY THZ THCDAR)
60100 (AND (MEMBER (SETQ THX
60200 (COND
60300 ((THVAR (SETQ THZ (CADDR (SETQ THCDAR (CDAR THTREE))))) (THVARS2 THZ))
60400 ((THVARSUBST THZ))))
60500 (CADR THCDAR))
60600 (GO GO))
60700 (RPLACD (CADR THCDAR) (CONS THX (CDADR THCDAR)))
60800 (AND (EQ (SETQ THY (ADD1 (CAADR THCDAR))) (CADAR THCDAR))
60900 (RETURN (PROG2 (SETQ THBRANCH NIL) (AND (CADDAR THCDAR) (CDADR THCDAR)) (THPOPT))))
61000 (RPLACA (CADR THCDAR) THY)
61100 GO (SETQ THTREE THBRANCH)
61200 (SETQ THALIST THABRANCH)
61300 (SETQ THBRANCH NIL)
61400 (RETURN NIL)))
61500 EXPR)
61600
61700
61800 (DECLARE (UNSPECIAL THTREE THALIST THBRANCH THABRANCH))
61900
62000 (DECLARE (SPECIAL B OBLIST))
62100
62200 (DEFPROP THFLUSH
62300 (LAMBDA(A)
62400 (MAPC (FUNCTION
62500 (LAMBDA (B) (MAPC (FUNCTION (LAMBDA (C) (MAPC (FUNCTION (LAMBDA (D) (REMPROP D B))) C))) OBLIST)))
62600 A))
62700 FEXPR)
62800
62900
63000 (DECLARE (UNSPECIAL B OBLIST))
63100
63200 (DECLARE (SPECIAL THXX))
63300
63400 (DEFPROP THGAL
63500 (LAMBDA(X Y)
63600 (PROG NIL
63700 (SETQ THXX X)
63800 (RETURN
63900 (SASSQ (CADR X) Y (FUNCTION (LAMBDA NIL (PROG NIL (PRINT THXX) (RETURN (THERT THUNBOUND THGAL)))))))))
64000 EXPR)
64100
64200
64300 (DECLARE (UNSPECIAL THXX))
64400
64500 (DEFPROP THGO
64600 (LAMBDA (X) (APPLY (QUOTE THSUCCEED) (CONS (QUOTE THTAG) X)))
64700 FEXPR)
64800
64900
65000 (DECLARE (SPECIAL THTREE THTRACE THZ1 THZ THY1 THY THA2 THV))
65100
65200 (DEFPROP THGOAL
65300 (LAMBDA(THA)
65400 (PROG (THX THY THY1 THZ THZ1 THA1 THA2 THV)
65500 (SETQ THV (QUOTE (THV)))
65600 (SETQ THA2 (THVARSUBST (CAR THA)))
65700 (SETQ THA1 (CDR THA))
65800 (COND
65900 ((OR (NULL THA1)
66000 (AND (NOT (AND (EQ (CAAR THA1) (QUOTE THNODB)) (PROG2 (SETQ THA1 (CDR THA1)) T)))
66100 (NOT (EQ (CAAR THA1) (QUOTE THDBF)))))
66200 (SETQ THY1 T)
66300 (SETQ THX (LIST (LIST (QUOTE THDBF) (QUOTE THTRUE) (SETQ THY (THMATCHDB THA2)))))))
66400 (SETQ THX (NCONC THX (MAPCAR (FUNCTION THTRY) THA1)))
66500 (AND THTRACE (THTRACES (QUOTE THGOAL) THA2))
66600 (THPUSH THTREE (LIST (QUOTE THGOAL) THA2 THX))
66700 (RETURN NIL)))
66800 FEXPR)
66900
67000
67100 (DECLARE (UNSPECIAL THTREE THTRACE THZ1 THZ THY1 THY THA2 THV))
67200
67300 (DEFPROP THGOALF
67400 (LAMBDA NIL (COND ((THTRY1)) ((THPOPT) NIL)))
67500 EXPR)
67600
67700
67800 (DECLARE (SPECIAL THTREE THVALUE))
67900
68000 (DEFPROP THGOALT
68100 (LAMBDA NIL (PROG2 0 (COND ((EQ THVALUE (QUOTE THNOVAL)) (THVARSUBST (CADAR THTREE))) (THVALUE)) (THPOPT)))
68200 EXPR)
68300
68400
68500 (DECLARE (UNSPECIAL THTREE THVALUE))
68600
68700 (DECLARE (SPECIAL THTT THFSTP THFST THTTL THLAS THNF THWH))
68800
68900 (DEFPROP THIP
69000 (LAMBDA(THI)
69100 (PROG (THT1 THT3 THSV THT2 THI1)
69200 (SETQ THNF (ADD1 THNF))
69300 (COND ((AND (ATOM THI) (NOT (EQ THI (QUOTE ?))) (NOT (NUMBERP THI))) (SETQ THI1 THI))
69400 ((OR (EQ THI (QUOTE ?)) (MEMQ (CAR THI) (QUOTE (THV THNV))))
69500 (COND (THFST (RETURN (QUOTE THVRB))) ((SETQ THI1 (QUOTE THVRB)))))
69600 ((RETURN (QUOTE THVRB))))
69700 (COND ((NOT (SETQ THT1 (GET THI1 THWH)))
69800 (PUTPROP THI1 (LIST NIL (LIST THNF (LIST THLAS 1 THTTL))) THWH))
69900 ((EQ THT1 (QUOTE THNOHASH)) (RETURN (QUOTE THBQF)))
70000 ((NOT (SETQ THT2 (ASSQ THNF (CDR THT1)))) (NCONC THT1 (LIST (LIST THNF (LIST THLAS 1 THTTL)))))
70100 ((NOT (SETQ THT3 (ASSQ THLAS (CDR THT2)))) (NCONC THT2 (LIST (LIST THLAS 1 THTTL))))
70200 ((AND (OR THFST THFSTP)
70300 (COND ((EQ THWH (QUOTE THASSERTION)) (ASSOC THTT (CDDR THT3)))
70400 (T (MEMQ THTT (CDDR THT3)))))
70500 (RETURN NIL))
70600 ((SETQ THSV (CDDR THT3)) (RPLACA (CDR THT3) (ADD1 (CADR THT3)))
70700 (RPLACD (CDR THT3) (NCONC (LIST THTTL) THSV))))
70800 (RETURN (QUOTE THOK))))
70900 EXPR)
71000
71100
71200 (DECLARE (UNSPECIAL THTT THFST THFSTP THTTL THLAS THNF THWH))
71300
71400 (DECLARE (SPECIAL THOLIST THALIST THX THY))
71500
71600 (DEFPROP THMATCH2
71700 (LAMBDA(THX THY)
71800 (PROG NIL
71900 (AND (EQ (CAR THX) (QUOTE THEV)) (SETQ THX (THVAL (CADR THX) THOLIST)))
72000 (AND (EQ (CAR THY) (QUOTE THEV)) (SETQ THY (THVAL (CADR THY) THALIST)))
72100 (RETURN
72200 (COND ((EQ THX (QUOTE ?)))
72300 ((EQ THY (QUOTE ?)))
72400 ((OR (MEMQ (CAR THX) (QUOTE (THV THNV THRESTRICT)))
72500 (MEMQ (CAR THY) (QUOTE (THV THNV THRESTRICT))))
72600 ((LAMBDA(XPAIR YPAIR)
72700 (COND
72800 ((AND XPAIR
72900 (OR (EQ (CAR THX) (QUOTE THNV))
73000 (AND (EQ (CAR THX) (QUOTE THV)) (EQ (CADR XPAIR) (QUOTE THUNASSIGNED))))
73100 (THCHECK (CDDR XPAIR) (COND (YPAIR (CADR YPAIR)) (T THY))))
73200 (COND (YPAIR (THRPLACAS (CDR XPAIR) (CADR YPAIR))
73300 (AND (CDDR YPAIR) (THRPLACDS (CDR XPAIR) (THUNION (CDDR XPAIR) (CDDR YPAIR))))
73400 (THRPLACDS YPAIR (CDR XPAIR)))
73500 (T (THRPLACAS (CDR XPAIR) THY))))
73600 ((AND YPAIR
73700 (OR (EQ (CAR THY) (QUOTE THNV))
73800 (AND (EQ (CAR THY) (QUOTE THV)) (EQ (CADR YPAIR) (QUOTE THUNASSIGNED))))
73900 (THCHECK (CDDR YPAIR) (COND (XPAIR (CADR XPAIR)) (T THX))))
74000 (COND (XPAIR (THRPLACAS (CDR YPAIR) (CADR XPAIR))) (T (THRPLACAS (CDR YPAIR) THX))))
74100 ((AND XPAIR (EQUAL (CADR XPAIR) (COND (YPAIR (CADR YPAIR)) (T THY)))))
74200 ((AND YPAIR (EQUAL (CADR YPAIR) THX)))
74300 (T (ERR NIL))))
74400 (COND ((THVAR THX) (THGAL THX THOLIST))
74500 ((EQ (CAR THX) (QUOTE THRESTRICT))
74600 (COND ((EQ (CADR THX) (QUOTE ?))
74700 (PROG2 0
74800 (CONS (QUOTE ?) (CONS (QUOTE THUNASSIGNED) (APPEND (CDDR THX) NIL)))
74900 (SETQ THX (QUOTE (THNV ?)))))
75000 (T
75100 ((LAMBDA(U)
75200 (PROG NIL
75300 (THRPLACDS (CDR U) (THUNION (CDDR U) (CDDR THX)))
75400 (SETQ THX (CADR THX))
75500 (RETURN U)))
75600 (THGAL (CADR THX) THOLIST))))))
75700 (COND ((THVAR THY) (THGAL THY THALIST))
75800 ((EQ (CAR THY) (QUOTE THRESTRICT))
75900 (COND ((EQ (CADR THY) (QUOTE ?))
76000 (PROG2 0
76100 (CONS (QUOTE ?) (CONS (QUOTE THUNASSIGNED) (APPEND (CDDR THY) NIL)))
76200 (SETQ THY (QUOTE (THNV ?)))))
76300 (T
76400 ((LAMBDA(U)
76500 (PROG NIL
76600 (THRPLACDS (CDR U) (THUNION (CDDR U) (CDDR THY)))
76700 (SETQ THY (CADR THY))
76800 (RETURN U)))
76900 (THGAL (CADR THY) THALIST))))))))
77000 ((EQUAL THX THY))
77100 (T (ERR NIL))))))
77200 EXPR)
77300
77400
77500 (DEFPROP THRESTRICT
77600 (LAMBDA (L) (NCONC (THGAL (CAR L) THALIST) (APPEND (CDR L) NIL)))
77700 FEXPR)
77800
77900
78000 (DECLARE (UNSPECIAL THOLIST THALIST THX THY) (SPECIAL THX THPRD))
78100
78200 (DEFPROP THCHECK
78300 (LAMBDA(THPRD THX)
78400 (OR (NULL THPRD)
78500 (EQ THX (QUOTE THUNASSIGNED))
78600 (ERRSET (MAPC (FUNCTION (LAMBDA (THY) (OR (THY THX) (ERR NIL)))) THPRD))))
78700 EXPR)
78800
78900
79000 (DECLARE (UNSPECIAL THX THPRD) (SPECIAL THY THX THTREE THOLIST THML))
79100
79200 (DECLARE (SPECIAL L2))
79300
79400 (DEFPROP THUNION
79500 (LAMBDA(L1 L2)
79600 (PROG NIL
79700 (MAPC (FUNCTION (LAMBDA (THX) (COND ((MEMBER THX L2)) (T (SETQ L2 (CONS THX L2)))))) L1)
79800 (RETURN L2)))
79900 EXPR)
80000
80100
80200 (DECLARE (UNSPECIAL L2))
80300
80400 (DECLARE (SPECIAL THX THALIST THOLIST))
80500
80600
80700 (DEFPROP THMATCH1
80800 (LAMBDA(THX THY)
80900 (PROG (THML)
81000 (COND ((EQ (CAR THX) (QUOTE THAUX)) ((CADR THX) (CADDR THX) THY))
81100 ((AND (EQ (LENGTH
81200 (COND ((EQ (CAR THX) (QUOTE THEV)) (SETQ THX (THVAL (CADR THX) THOLIST))) (THX)))
81300 (LENGTH THY))
81400 (ERRSET (MAPC (FUNCTION THMATCH2) THX THY)))
81500 (AND THML (THPUSH THTREE (LIST (QUOTE THMUNG) THML)))
81600 (RETURN T))
81700 (T (EVLIS THML) (RETURN NIL)))))
81800 EXPR)
81900
82000
82100 (DECLARE (UNSPECIAL THY THX THTREE THOLIST THML))
82200
82300 (DEFPROP THMATCHDB
82400 (LAMBDA (THV) (THMATCHLIST THV (QUOTE THASSERTION)))
82500 EXPR)
82600
82700
82800 (DECLARE (SPECIAL THNF THWH THALIST))
82900
83000 (DEFPROP THMATCHLIST
83100 (LAMBDA(THTB THWH)
83200 (PROG (THB1 THB2 THL THNF THAL THA1 THA2 THRN THL1 THL2 THRVC)
83300 (COND
83400 ((EQ (CAR THTB) (QUOTE THAUX)) (RETURN ((GET (CADR THTB) (QUOTE THMATCHLIST)) (CADDR THTB) THWH))))
83500 (SETQ THL 55571)
83600 (SETQ THNF 0)
83700 (SETQ THAL (LENGTH THTB))
83800 (SETQ THB1 THTB)
83900 THP1 (OR THB1 (RETURN (COND (THL2 (APPEND THL1 THL2)) (THL1))))
84000 (SETQ THNF (ADD1 THNF))
84100 (SETQ THB2 (CAR THB1))
84200 (SETQ THB1 (CDR THB1))
84300 THP3 (COND ((OR (NULL (ATOM THB2)) (NUMBERP THB2) (EQ THB2 (QUOTE ?))) (GO THP1))
84400 ((NOT (SETQ THA1 (GET THB2 THWH))) (SETQ THA1 (QUOTE (0 0))))
84500 ((EQ THA1 (QUOTE THNOHASH)) (GO THP1))
84600 ((NOT (SETQ THA1 (ASSQ THNF (CDR THA1)))) (SETQ THA1 (QUOTE (0 0))))
84700 ((NOT (SETQ THA1 (ASSQ THAL (CDR THA1)))) (SETQ THA1 (QUOTE (0 0)))))
84800 (SETQ THRN (CADR THA1))
84900 (SETQ THA1 (CDDR THA1))
85000 (AND (EQ THWH (QUOTE THASSERTION)) (GO THP2))
85100 (COND ((NOT (SETQ THA2 (GET (QUOTE THVRB) THWH))) (SETQ THA2 (QUOTE (0 0))))
85200 ((NOT (SETQ THA2 (ASSQ THNF (CDR THA2)))) (SETQ THA2 (QUOTE (0 0))))
85300 ((NOT (SETQ THA2 (ASSQ THAL (CDR THA2)))) (SETQ THA2 (QUOTE (0 0)))))
85400 (SETQ THRVC (CADR THA2))
85500 (SETQ THA2 (CDDR THA2))
85600 (AND (GREATERP (PLUS THRVC THRN) THL) (GO THP1))
85700 (SETQ THL (PLUS THRVC THRN))
85800 (SETQ THL1 THA1)
85900 (SETQ THL2 THA2)
86000 (GO THP1)
86100 THP2 (COND ((EQ THRN 0) (RETURN NIL)) ((GREATERP THL THRN) (SETQ THL1 THA1) (SETQ THL THRN)))
86200 (GO THP1)))
86300 EXPR)
86400
86500
86600 (DECLARE (UNSPECIAL THNF THWH THALIST))
86700
86800 (DEFPROP THMATCHTB
86900 (LAMBDA (THU THV) (THMATCHLIST THU THV))
87000 EXPR)
87100
87200
87300 (DECLARE (SPECIAL THTREE THVALUE))
87400
87500 (DEFPROP THMESSAGE
87600 (LAMBDA (THA) (PROG NIL (THPUSH THTREE (CONS (QUOTE THMESSAGE) THA)) (RETURN THVALUE)))
87700 FEXPR)
87800
87900
88000 (DECLARE (UNSPECIAL THTREE THVALUE))
88100
88200 (DECLARE (SPECIAL THALIST THOLIST THTREE THMESSAGE))
88300
88400 (DEFPROP THMESSAGEF
88500 (LAMBDA NIL
88600 (PROG (BOD)
88700 (SETQ BOD (CAR THTREE))
88800 (THPOPT)
88900 (COND ((AND (THBIND (CADR BOD)) (THMATCH1 (CADDR BOD) THMESSAGE)) (THPUSH THTREE
89000 (LIST
89100 (QUOTE THPROG)
89200 (CDDR BOD)
89300 NIL
89400 (CDDR BOD)))
89500 (SETQ THMESSAGE NIL)
89600 (RETURN (THPROGA)))
89700 (T (SETQ THALIST THOLIST) (THPOPT)))
89800 (RETURN NIL)))
89900 EXPR)
90000
90100
90200 (DECLARE (UNSPECIAL THALIST THOLIST THTREE THMESSAGE))
90300
90400 (DECLARE (SPECIAL THVALUE))
90500
90600 (DEFPROP THMESSAGET
90700 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN THVALUE)))
90800 EXPR)
90900
91000
91100 (DECLARE (UNSPECIAL THVALUE))
91200
91300 (DECLARE (SPECIAL THTREE))
91400
91500 (DEFPROP THMUNGF
91600 (LAMBDA NIL (PROG NIL (EVLIS (CADAR THTREE)) (THPOPT) (RETURN NIL)))
91700 EXPR)
91800
91900
92000 (DECLARE (UNSPECIAL THTREE))
92100
92200 (DECLARE (SPECIAL THVALUE))
92300
92400 (DEFPROP THMUNGT
92500 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN THVALUE)))
92600 EXPR)
92700
92800
92900 (DECLARE (UNSPECIAL THVALUE))
93000
93100 (DEFPROP THNOFAIL
93200 (LAMBDA (THX) (COND (THX (DEFPROP THPROG THPROGT THFAIL)) (T (DEFPROP THPROG THPROGF THFAIL))))
93300 EXPR)
93400
93500
93600 (DECLARE (SPECIAL THEXP))
93700
93800 (DEFPROP THNOT
93900 (LAMBDA(THA)
94000 (SETQ THEXP (LIST (QUOTE THCOND) (LIST (CAR THA) (QUOTE (THFAIL THAND))) (QUOTE ((THSUCCEED))))))
94100 FEXPR)
94200
94300
94400 (DECLARE (UNSPECIAL THEXP))
94500
94600 (DEFPROP THNV
94700 (LAMBDA (X) (THV1 (CAR X)))
94800 FEXPR)
94900
95000
95100 (DECLARE (SPECIAL THTREE THEXP))
95200
95300 (DEFPROP THOR
95400 (LAMBDA (THA) (AND THA (THPUSH THTREE (LIST (QUOTE THOR) THA)) (SETQ THEXP (CAR THA))))
95500 FEXPR)
95600
95700
95800 (DECLARE (UNSPECIAL THTREE THEXP))
95900
96000 (DECLARE (SPECIAL THTREE THEXP))
96100
96200 (DEFPROP THOR2
96300 (LAMBDA(P)
96400 (COND ((AND (CADAR THTREE) (CDADAR THTREE)) (RPLACA (CDAR THTREE) (CDADAR THTREE))
96500 (SETQ THEXP
96600 (COND (P
96700 (PROG2 0
96800 (CAADAR THTREE)
96900 (OR (CADAR THTREE) (THPOPT))))
97000 ((CAR (CAADAR THTREE))))))
97100 ((THPOPT) NIL)))
97200 EXPR)
97300
97400
97500 (DECLARE (UNSPECIAL THTREE THEXP))
97600
97700 (DEFPROP THORF
97800 (LAMBDA NIL (THOR2 T))
97900 EXPR)
98000
98100
98200 (DECLARE (SPECIAL THVALUE))
98300
98400 (DEFPROP THORT
98500 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN THVALUE)))
98600 EXPR)
98700
98800
98900 (DECLARE (UNSPECIAL THVALUE))
99000
99100 (DECLARE (SPECIAL THTREE))
99200
99300 (DEFPROP THPOPT
99400 (LAMBDA NIL (SETQ THTREE (CDR THTREE)))
99500 EXPR)
99600
99700
99800 (DECLARE (UNSPECIAL THTREE))
99900
00100 (DECLARE (SPECIAL THTREE))
00200
00300 (DEFPROP THPROG
00400 (LAMBDA(THA)
00500 (PROG NIL (THBIND (CAR THA)) (THPUSH THTREE (LIST (QUOTE THPROG) THA NIL THA)) (RETURN (THPROGA))))
00600 FEXPR)
00700
00800
00900 (DECLARE (UNSPECIAL THTREE))
01000
01100 (DECLARE (SPECIAL THEXP THVALUE THTREE))
01200
01300 (DEFPROP THPROGA
01400 (LAMBDA NIL
01500 ((LAMBDA(X)
01600 (COND ((NULL (CDAR X)) (THPOPT) (QUOTE THNOVAL))
01700 ((ATOM (CADAR X)) (SETQ THEXP (LIST (QUOTE THTAG) (CADAR X))) (RPLACA X (CDAR X)) THVALUE)
01800 (T (SETQ THEXP (CADAR X)) (RPLACA X (CDAR X)) THVALUE)))
01900 (CDAR THTREE)))
02000 EXPR)
02100
02200
02300 (DECLARE (UNSPECIAL THEXP THVALUE THTREE))
02400
02500 (DEFPROP THPROGF
02600 (LAMBDA NIL (PROG NIL (THBRANCHUN) (RETURN NIL)))
02700 EXPR)
02800
02900
03000 (DEFPROP THPROGT
03100 (LAMBDA NIL (PROG NIL (THBRANCH) (RETURN (THPROGA))))
03200 EXPR)
03300
03400
03500 (DECLARE (SPECIAL XX))
03600
03700 (DEFPROP THPURE
03800 (LAMBDA (XX) (ERRSET (MAPC (FUNCTION (LAMBDA (Y) (AND (THVAR Y) (ERR NIL)))) XX)))
03900 EXPR)
04000
04100
04200 (DECLARE (UNSPECIAL XX))
04300
04400 (DECLARE (SPECIAL THTREE))
04500
04600 (DEFPROP THPUTPROP
04700 (LAMBDA(ATO VAL IND)
04800 (PROG NIL
04900 (THPUSH THTREE
05000 (LIST (QUOTE THMUNG)
05100 (LIST
05200 (LIST (QUOTE PUTPROP1)
05300 (LIST (QUOTE QUOTE) ATO)
05400 (LIST (QUOTE QUOTE) (GET ATO IND))
05500 (LIST (QUOTE QUOTE) IND)))))
05600 (RETURN (PUTPROP1 ATO VAL IND))))
05700 EXPR)
05800
05900
06000 (DECLARE (UNSPECIAL THTREE))
06100
06200 (DECLARE (SPECIAL THBS THON THAL THFST THNF THWH))
06300
06400 (DECLARE (SPECIAL THFSTP))
06500
06600 (DECLARE (SPECIAL THPC))
06700
06800 (DEFPROP THREM1
06900 (LAMBDA(THB)
07000 (PROG (THA THSV THA1 THA2 THA3 THA4 THA5 THONE THPC)
07100 (SETQ THNF (ADD1 THNF))
07200 (COND ((AND (ATOM THB) (NOT (EQ THB (QUOTE ?))) (NOT (NUMBERP THB))) (SETQ THA THB))
07300 ((OR (EQ THB (QUOTE ?)) (MEMQ (CAR THB) (QUOTE (THV THNV))))
07400 (COND (THFST (RETURN (QUOTE THVRB))) ((SETQ THA (QUOTE THVRB)))))
07500 ((RETURN (QUOTE THVRB))))
07600 (SETQ THA1 (GET THA THWH))
07700 (OR THA1 (RETURN NIL))
07800 (AND (EQ THA1 (QUOTE THNOHASH)) (RETURN (QUOTE THBQF)))
07900 (SETQ THA2 (THBA THNF THA1))
08000 (OR THA2 (RETURN NIL))
08100 (SETQ THA3 (THBA THAL (CADR THA2)))
08200 (OR THA3 (RETURN NIL))
08300 (SETQ THA4 (CADR THA3))
08400 (SETQ THPC (NOT (EQ THWH (QUOTE THASSERTION))))
08500 (SETQ THA5
08600 (COND ((OR THFST THFSTP) (THBAP THBS (CDR THA4)))
08700 ((THBA (COND (THPC THON) (T (CAR THON))) (CDR THA4)))))
08800 (OR THA5 (RETURN NIL))
08900 (SETQ THONE (CADR THA5))
09000 (RPLACD THA5 (CDDR THA5))
09100 (AND (NOT (EQ (CADR THA4) 1))
09200 (OR (SETQ THSV (CDDR THA4)) T)
09300 (RPLACA (CDR THA4) (SUB1 (CADR THA4)))
09400 (RETURN THONE))
09500 (SETQ THSV (CDDR THA3))
09600 (RPLACD THA3 THSV)
09700 (AND (CDADR THA2) (RETURN THONE))
09800 (SETQ THSV (CDDR THA2))
09900 (RPLACD THA2 THSV)
10000 (AND (CDR THA1) (RETURN THONE))
10100 (REMPROP THA THWH)
10200 (RETURN THONE)))
10300 EXPR)
10400
10500
10600 (DECLARE (UNSPECIAL THPC THBS THON THAL THFST THFSTP THNF THWH))
10700
10800 (DECLARE (SPECIAL THALIST THTREE))
10900
11000 (DEFPROP THREMBINDF
11100 (LAMBDA NIL (PROG NIL (SETQ THALIST (CADAR THTREE)) (THPOPT) (RETURN NIL)))
11200 EXPR)
11300
11400
11500 (DECLARE (UNSPECIAL THTREE))
11600
11700 (DECLARE (SPECIAL THTREE THVALUE))
11800
11900 (DEFPROP THREMBINDT
12000 (LAMBDA NIL (PROG NIL (SETQ THALIST (CADAR THTREE)) (THPOPT) (RETURN THVALUE)))
12100 EXPR)
12200
12300
12400 (DECLARE (UNSPECIAL THALIST THTREE THVALUE))
12500
12600 (DECLARE (SPECIAL THBS THON THAL THFSTP THFST THNF THWH))
12700
12800 (DEFPROP THREMOVE
12900 (LAMBDA(THB)
13000 (PROG (THB1 THWH THNF THAL THON THBS THFST THFSTP THFOO)
13100 (SETQ THNF 0)
13200 (SETQ THB1
13300 (COND ((ATOM THB) (SETQ THBS THB)
13400 (SETQ THWH (CAR (SETQ THB1 (GET THB (QUOTE THEOREM)))))
13500 (CADDR THB1))
13600 ((EQ (CAR THB) (QUOTE THAUX)) (RETURN ((GET (CADR THB) (QUOTE THREMOVE)) (CADDR THB))))
13700 ((SETQ THWH (QUOTE THASSERTION)) (SETQ THBS THB))))
13800 (SETQ THAL (LENGTH THB1))
13900 (SETQ THFST T)
14000 THP1 (COND ((NULL THB1) (SETQ THB1 THFOO)
14100 (SETQ THNF 0)
14200 (SETQ THFST (SETQ THFOO NIL))
14300 (SETQ THFSTP T)
14400 (GO THP1))
14500 ((NULL (SETQ THON (THREM1 (CAR THB1)))) (RETURN NIL))
14600 ((MEMQ THON (QUOTE (THBQF THVRB))) (SETQ THFOO
14700 (NCONC THFOO
14800 (LIST
14900 (COND ((EQ THON (QUOTE THVRB)) (CAR THB1))))))
15000 (SETQ THB1 (CDR THB1))
15100 (GO THP1)))
15200 (SETQ THFST NIL)
15300 (MAPC (FUNCTION THREM1) (CDR THB1))
15400 (SETQ THNF 0)
15500 (MAPC (FUNCTION THREM1) THFOO)
15600 (RETURN THON)))
15700 EXPR)
15800
15900
16000 (DECLARE (UNSPECIAL THBS THON THAL THFST THFSTP THNF THWH))
16100
16200 (DECLARE (SPECIAL THTREE))
16300
16400 (DEFPROP THREMPROP
16500 (LAMBDA(ATO IND)
16600 (PROG NIL
16700 (THPUSH THTREE
16800 (LIST (QUOTE THMUNG)
16900 (LIST
17000 (LIST (QUOTE PUTPROP1)
17100 (LIST (QUOTE QUOTE) ATO)
17200 (LIST (QUOTE QUOTE) (GET ATO IND))
17300 (LIST (QUOTE QUOTE) IND)))))
17400 (RETURN (REMPROP ATO IND))))
17500 EXPR)
17600
17700
17800 (DECLARE (UNSPECIAL THTREE))
17900
18000 (DEFPROP THRETURN
18100 (LAMBDA (X) (APPLY (QUOTE THSUCCEED) (CONS (QUOTE THPROG) X)))
18200 FEXPR)
18300
18400
18500 (DECLARE (SPECIAL THTREE THML))
18600
18700 (DEFPROP THRPLACA
18800 (LAMBDA (X Y) (PROG (THML) (THRPLACAS X Y) (THPUSH THTREE (LIST (QUOTE THMUNG) THML)) (RETURN X)))
18900 EXPR)
19000
19100
19200 (DECLARE (UNSPECIAL THTREE THML))
19300
19400 (DECLARE (SPECIAL THML))
19500
19600 (DEFPROP THRPLACAS
19700 (LAMBDA (X Y) (PROG NIL (THPUSH THML (LIST (QUOTE THURPLACA) X (CAR X))) (RETURN (RPLACA X Y))))
19800 EXPR)
19900
20000
20100 (DEFPROP THURPLACA
20200 (LAMBDA (L) (RPLACA (CAR L) (CADR L)))
20300 FEXPR)
20400
20500
20600 (DECLARE (UNSPECIAL THML))
20700
20800 (DECLARE (SPECIAL THTREE THML))
20900
21000 (DEFPROP THRPLACD
21100 (LAMBDA (X Y) (PROG (THML) (THRPLACDS X Y) (THPUSH THTREE (LIST (QUOTE THMUNG) THML)) (RETURN X)))
21200 EXPR)
21300
21400
21500 (DECLARE (UNSPECIAL THTREE THML))
21600
21700 (DECLARE (SPECIAL THML))
21800
21900 (DEFPROP THRPLACDS
22000 (LAMBDA (X Y) (PROG NIL (THPUSH THML (LIST (QUOTE THURPLACD) X (CDR X))) (RETURN (RPLACD X Y))))
22100 EXPR)
22200
22300
22400 (DEFPROP THURPLACD
22500 (LAMBDA (L) (RPLACD (CAR L) (CADR L)))
22600 FEXPR)
22700
22800
22900 (DECLARE (UNSPECIAL THML))
23000
23100 (DECLARE (SPECIAL THTREE THALIST THVALUE THML))
23200
23300 (DEFPROP THSETQ
23400 (LAMBDA(THL1)
23500 (PROG (THML THL)
23600 (SETQ THL THL1)
23700 LOOP (COND ((NULL THL) (THPUSH THTREE (LIST (QUOTE THMUNG) THML)) (RETURN THVALUE))
23800 ((NULL (CDR THL)) (PRINT THL1) (THERT ODD NUMBER OF GOODIES /- THSETQ))
23900 ((ATOM (CAR THL)) (THPUSH THML
24000 (LIST (QUOTE SETQ) (CAR THL) (LIST (QUOTE QUOTE) (EVAL (CAR THL)))))
24100 (SET (CAR THL) (SETQ THVALUE (EVAL (CADR THL)))))
24200 (T (THRPLACAS (CDR (THSGAL (CAR THL))) (SETQ THVALUE (THVAL (CADR THL) THALIST)))))
24300 (SETQ THL (CDDR THL))
24400 (GO LOOP)))
24500 FEXPR)
24600
24700
24800 (DECLARE (UNSPECIAL THTREE THALIST THVALUE THML))
24900
25000 (DECLARE (SPECIAL X THALIST))
25100
25200 (DEFPROP THSGAL
25300 (LAMBDA(X)
25400 (SASSQ (CADR X)
25500 THALIST
25600 (FUNCTION
25700 (LAMBDA NIL
25800 (PROG (Y)
25900 (SETQ Y (LIST (CADR X) (QUOTE THUNASSIGNED)))
26000 (NCONC (GET (QUOTE THALIST) (QUOTE VALUE)) (LIST Y))
26100 (RETURN Y))))))
26200 EXPR)
26300
26400
26500 (DECLARE (UNSPECIAL X THALIST))
26600
26700 (DECLARE (SPECIAL THTREE THALIST THBRANCH THABRANCH THA))
26800
26900 (DEFPROP THSUCCEED
27000 (LAMBDA(THA)
27100 (OR (NOT THA)
27200 (PROG (THX)
27300 (AND (EQ (CAR THA) (QUOTE THEOREM)) (SETQ THA (CONS (QUOTE THPROG) (CDR THA))))
27400 (SETQ THBRANCH THTREE)
27500 (SETQ THABRANCH THALIST)
27600 LOOP (COND ((NULL THTREE) (PRINT THA) (THERT OVERPOP /- THSUCCEED))
27700 ((EQ (CAAR THTREE) (QUOTE THREMBIND)) (SETQ THALIST (CADAR THTREE)) (THPOPT) (GO LOOP))
27800 ((EQ (CAAR THTREE) (CAR THA)) (THPOPT)
27900 (RETURN
28000 (COND ((CDR THA) (EVAL (CADR THA))) ((QUOTE THNOVAL)))))
28100 ((AND (EQ (CAR THA) (QUOTE THTAG))
28200 (EQ (CAAR THTREE) (QUOTE THPROG))
28300 (SETQ THX (MEMQ (CADR THA) (CADDDR (CAR THTREE)))))
28400 (RPLACA (CDAR THTREE) (CONS NIL THX))
28500 (RETURN (THPROGT)))
28600 (T (THPOPT) (GO LOOP))))))
28700 FEXPR)
28800
28900
29000 (DECLARE (UNSPECIAL THTREE THALIST THBRANCH THABRANCH THA))
29100
29200 (DECLARE (SPECIAL XX TYPE THX THY1 THY THXX))
29300
29400 (DEFPROP THTAE
29500 (LAMBDA(XX)
29600 (COND ((EQ (CAR XX) (QUOTE THUSE))
29700 (MAPCAR (FUNCTION
29800 (LAMBDA(X)
29900 (COND
30000 ((NOT (AND (SETQ THXX (GET X (QUOTE THEOREM))) (EQ (CAR THXX) TYPE)))
30100 (PRINT X)
30200 (THERT BAD THEOREM /- THTAE))
30300 ((LIST (QUOTE THAPPLY) X (CAR THX))))))
30400 (CDR XX)))
30500 ((EQ (CAR XX) (QUOTE THTBF))
30600 (MAPCAN (FUNCTION (LAMBDA (Y) (COND (((CADR XX) Y) (LIST (LIST (QUOTE THAPPLY) Y (CAR THX)))))))
30700 (COND (THY1 THY) ((SETQ THY1 T) (SETQ THY (THMATCHTB (CAR THX) TYPE))))))
30800 (T (PRINT XX) (THERT UNCLEAR RECCOMMENDATION /- THTAE))))
30900 EXPR)
31000
31100
31200 (DECLARE (UNSPECIAL XX TYPE THX THY1 THY THXX))
31300
31400 (DECLARE (SPECIAL THTREE))
31500
31600 (DEFPROP THTAG
31700 (LAMBDA (L) (AND (CAR L) (THPUSH THTREE (LIST (QUOTE THTAG) (CAR L)))))
31800 FEXPR)
31900
32000
32100 (DECLARE (UNSPECIAL THTREE))
32200
32300 (DEFPROP THTAGF
32400 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN NIL)))
32500 EXPR)
32600
32700
32800 (DECLARE (SPECIAL THVALUE))
32900
33000 (DEFPROP THTAGT
33100 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN THVALUE)))
33200 EXPR)
33300
33400
33500 (DECLARE (UNSPECIAL THVALUE))
33600
33700 (DEFPROP THTRUE
33800 (LAMBDA (X) T)
33900 EXPR)
34000
34100
34200 (DECLARE (SPECIAL THTREE THOLIST THALIST))
34300
34400 (DEFPROP THTRY1
34500 (LAMBDA NIL
34600 (PROG (THX THY THZ THW THEOREM)
34700 (SETQ THZ (CAR THTREE))
34800 (SETQ THY (CDDR THZ))
34900 THGOAL3
35000 (COND ((NULL (CAR THY)) (RETURN NIL)))
35100 (SETQ THX (CAAR THY))
35200 (GO (CAR THX))
35300 THDBF
35400 (SETQ THOLIST THALIST)
35500 (COND ((NULL (CADDR THX)) (RPLACA THY (CDAR THY)) (GO THGOAL3))
35600 ((PROG2 0
35700 (AND ((CADR THX) (SETQ THW (CAADDR THX))) (THMATCH1 (CADR THZ) (CAR THW)))
35800 (RPLACA (CDDR THX) (CDADDR THX)))
35900 (RETURN THW))
36000 (T (GO THDBF)))
36100 THTBF
36200 (COND ((NULL (CADDR THX)) (RPLACA THY (CDAR THY)) (GO THGOAL3))
36300 ((NOT
36400 (AND (SETQ THW (GET (SETQ THEOREM (CAADDR THX)) (QUOTE THEOREM)))
36500 (EQ (CAR THW) (QUOTE THCONSE))))
36600 (PRINT THEOREM)
36700 (THERT BAD THEOREM /- THTRY1))
36800 ((PROG2 0
36900 (AND ((CADR THX) (CAADDR THX)) (THAPPLY1 THEOREM THW (CADR THZ)))
37000 (RPLACA (CDDR THX) (CDADDR THX)))
37100 (RETURN T))
37200 (T (GO THTBF)))))
37300 EXPR)
37400
37500
37600 (DECLARE (UNSPECIAL THTREE THOLIST THALIST))
37700
37800 (DECLARE (SPECIAL THZ1 THZ THY1 THY THA2))
37900
38000 (DEFPROP THTRY
38100 (LAMBDA(X)
38200 (COND ((EQ (CAR X) (QUOTE THTBF))
38300 (LIST (QUOTE THTBF)
38400 (CADR X)
38500 (COND (THZ1 THZ) ((SETQ THZ1 T) (SETQ THZ (THMATCHTB THA2 (QUOTE THCONSE)))))))
38600 ((EQ (CAR X) (QUOTE THDBF))
38700 (LIST (QUOTE THDBF) (CADR X) (COND (THY1 THY) ((SETQ THY1 T) (SETQ THY (THMATCHDB THA2))))))
38800 ((EQ (CAR X) (QUOTE THUSE)) (LIST (QUOTE THTBF) (QUOTE THTRUE) (CDR X)))
38900 (T (PRINT X) (THERT UNCLEAR RECOMMENDATION /- THTRY))))
39000 EXPR)
39100
39200
39300 (DECLARE (UNSPECIAL THZ1 THZ THY1 THY THA2))
39400
39500 (DECLARE (SPECIAL THTREE THALIST THXX))
39600
39700 (DEFPROP THUNDOF
39800 (LAMBDA NIL
39900 (PROG NIL
40000 (COND ((NULL (CADDAR THTREE)) (THPOPT))
40100 (T (SETQ THXX (CDDAR THTREE))
40200 (SETQ THALIST (CAADR THXX))
40300 (RPLACA (CDR THXX) (CDADR THXX))
40400 (SETQ THTREE (CAAR THXX))
40500 (RPLACA THXX (CDAR THXX))))
40600 (RETURN NIL)))
40700 EXPR)
40800
40900
41000 (DECLARE (UNSPECIAL THTREE THALIST THXX))
41100
41200 (DEFPROP THUNDOT
41300 (LAMBDA NIL (PROG NIL (THPOPT) (RETURN T)))
41400 EXPR)
41500
41600
41700 (DECLARE (SPECIAL THALIST THXX))
41800
41900 (DEFPROP THUNIQUE
42000 (LAMBDA(THA)
42100 (PROG (X)
42200 (SETQ X THALIST)
42300 LOOP (COND ((NULL X) (PRINT THA) (THERT NOT FOUND /- THUNIQUE))
42400 ((EQ (CAAR X) (CAR THA)) (COND ((EQ (CADAR X) (QUOTE THUNIQUE)))
42500 ((RPLACD (CAR X)
42600 (CONS (QUOTE THUNIQUE)
42700 (MAPCAR (FUNCTION
42800 (LAMBDA(X)
42900 (COND
43000 ((ATOM X) (SETQ THXX X)
43100 (CADR
43200 (SASSQ X
43300 THALIST
43400 (FUNCTION
43500 (LAMBDA
43600 NIL
43700 (PROG
43800 NIL
43900 (PRINT THXX)
44000 (RETURN
44100 (THERT
44200 THUNBOUND
44300 /-
44400 THUNIQUE))))))))
44500 (T (THVAL X THALIST)))))
44600 (CADAR X))))))
44700 (RETURN (NOT (MEMBER (CAR X) (CDR X)))))
44800 (T (SETQ X (CDR X)) (GO LOOP)))))
44900 FEXPR)
45000
45100
45200 (DECLARE (UNSPECIAL THALIST THXX))
45300
45400 (DECLARE (SPECIAL THALIST THXX))
45500
45600 (DEFPROP THV1
45700 (LAMBDA(X)
45800 (PROG NIL
45900 (SETQ THXX X)
46000 (RETURN
46100 (COND
46200 ((EQ (SETQ X
46300 (CADR
46400 (SASSQ X
46500 THALIST
46600 (FUNCTION
46700 (LAMBDA NIL (PROG NIL (PRINT THXX) (RETURN (THERT THUNBOUND /- THV1))))))))
46800 (QUOTE THUNASSIGNED))
46900 (PRINT THXX)
47000 (THERT THUNASSIGNED /- THV1))
47100 (T X)))))
47200 EXPR)
47300
47400
47500 (DECLARE (UNSPECIAL THALIST THXX))
47600
47700 (DEFPROP THV
47800 (LAMBDA (X) (THV1 (CAR X)))
47900 FEXPR)
48000
48100
48200 (DECLARE (SPECIAL THLEVEL THSTEP THSTEPF THSTEPT THSTEPD THMESSAGE ↑A THV THINF THE THTREE THOLIST THEXP THALIST~
48300 THVALUE THBRANCH THABRANCH))
48400
48500 (DEFPROP THVAL
48600 (LAMBDA(THEXP THALIST)
48700 (PROG NIL
48800 (SETQ THLEVEL (CONS (LIST THTREE THALIST) THLEVEL))
48900 (RETURN
49000 (PROG (THTREE THVALUE THBRANCH THOLIST THABRANCH THE THV THMESSAGE)
49100 (SETQ THV (QUOTE (THV THNV)))
49200 GO (SETQ THE THEXP)
49300 (SETQ THEXP NIL)
49400 (COND (↑A (SETQ ↑A NIL) (OR (THERT ↑A /- THVAL) (GO FAIL))))
49500 (COND (THSTEP (EVAL THSTEP)))
49600 (COND ((ERRSET (SETQ THVALUE (EVAL THE))))
49700 (T (PRINT THE) (SETQ THVALUE (THERT LISPERROR /- THVAL))))
49800 GO1 (COND (THSTEPD (EVAL THSTEPD)))
49900 (COND (THINF (GO FAIL)) (THEXP (GO GO)) (THVALUE (GO SUCCEED)) (T (GO FAIL)))
50000 SUCCEED
50100 (COND (THSTEPT (EVAL THSTEPT)))
50200 (COND ((NULL THBRANCH) (SETQ THBRANCH THTREE) (SETQ THABRANCH THALIST)))
50300 (COND ((NULL THTREE) (SETQ THLEVEL (CDR THLEVEL)) (RETURN THVALUE))
50400 ((SETQ THEXP (GET (CAAR THTREE) (QUOTE THSUCCEED))) (GO GO2))
50500 ((THERT BAD SUCCEED /- THVAL) (GO SUCCEED))
50600 ((GO FAIL)))
50700 FAIL (COND (THSTEPF (EVAL THSTEPF)))
50800 (COND ((NULL THTREE) (SETQ THLEVEL (CDR THLEVEL)) (RETURN NIL))
50900 ((AND THMESSAGE
51000 (COND
51100 ((MEMQ (CAAR THTREE)
51200 (QUOTE
51300 (THMUNG THFAIL?
51400 THTRACES
51500 THMESSAGE
51600 THPROG
51700 THAND
51800 THASSERT
51900 THERASE
52000 THREMBIND
52100 THDO
52200 THUNDO)))
52300 NIL)
52400 (T (THPOPT) (GO FAIL)))))
52500 ((SETQ THEXP (GET (CAAR THTREE) (QUOTE THFAIL))) (GO GO2))
52600 ((THERT BAD FAIL /- THVAL) (GO SUCCEED))
52700 ((GO FAIL)))
52800 GO2 (SETQ THVALUE ((PROG2 0 THEXP (SETQ THEXP NIL))))
52900 (GO GO1)))))
53000 EXPR)
53100
53200
53300 (DECLARE (UNSPECIAL THSTEP THSTEPF THSTEPT THSTEPD THLEVEL THMESSAGE ↑A THV THINF THE THTREE THOLIST THEXP THALI~
53400 ST THVALUE THBRANCH THABRANCH))
53500
53600 (DEFPROP THVAR
53700 (LAMBDA (X) (MEMQ (CAR X) (QUOTE (THV THNV))))
53800 EXPR)
53900
54000
54100 (DECLARE (SPECIAL THALIST THV))
54200
54300 (DEFPROP THVARS2
54400 (LAMBDA(X)
54500 (PROG (A)
54600 (AND (EQ (CAR X) (QUOTE THEV)) (SETQ X (THVAL (CADR X) THALIST)))
54700 (OR (MEMQ (CAR X) THV) (RETURN X))
54800 (SETQ A (THGAL X THALIST))
54900 (RETURN (COND ((EQ (CADR A) (QUOTE THUNASSIGNED)) X) (T (CADR A))))))
55000 EXPR)
55100
55200
55300 (DECLARE (UNSPECIAL THALIST THV))
55400
55500 (DECLARE (SPECIAL THALIST THV))
55600
55700 (DEFPROP THVARSUBST
55800 (LAMBDA(THX)
55900 (PROG NIL
56000 (COND ((EQ (CAR THX) (QUOTE THEV)) (SETQ THX (THVAL (CADR THX) THALIST)))
56100 ((MEMQ (CAR THX) THV) (SETQ THX (EVAL THX))))
56200 (RETURN (COND ((ATOM THX) THX) (T (MAPCAR (FUNCTION THVARS2) THX))))))
56300 EXPR)
56400
56500
56600 (DECLARE (UNSPECIAL THALIST THV))
56700
56800 (DECLARE (SPECIAL THALIST THVALUE THA))
56900
57000 (DEFPROP THVSETQ
57100 (LAMBDA(THA)
57200 (PROG (A)
57300 (SETQ A THA)
57400 LOOP (COND ((NULL A) (RETURN THVALUE))
57500 ((NULL (CDR A)) (PRINT THA) (THERT ODD NUMBER OF GOODIES /- THSETQ))
57600 (T (SETQ THVALUE (CAR (RPLACA (CDR (THSGAL (CAR A))) (THVAL (CADR A) THALIST))))))
57700 (SETQ A (CDDR A))
57800 (GO LOOP)))
57900 FEXPR)
58000
58100
58200 (DECLARE (UNSPECIAL THALIST THVALUE THA))
58300
58400 (DEFPROP THTAG THTAGF THFAIL)
58500
58600 (DEFPROP THTAG THTAGT THSUCCEED)
58700
58800 (DEFPROP THGOAL THGOALT THSUCCEED)
58900
59000 (DEFPROP THGOAL THGOALF THFAIL)
59100
59200 (DEFPROP THFAIL? THFAIL?F THFAIL)
59300
59400 (DEFPROP THFAIL? THFAIL?T THSUCCEED)
59500
59600 (DEFPROP THAMONG THAMONGF THFAIL)
59700
59800 (DEFPROP THFIND THFINDF THFAIL)
59900
60000 (DEFPROP THFIND THFINDT THSUCCEED)
60100
60200 (DEFPROP THPROG THPROGT THSUCCEED)
60300
60400 (DEFPROP THAND THANDT THSUCCEED)
60500
60600 (DEFPROP THMUNG THMUNGT THSUCCEED)
60700
60800 (DEFPROP THERASE THERASET THSUCCEED)
60900
61000 (DEFPROP THASSERT THASSERTT THSUCCEED)
61100
61200 (DEFPROP THOR THORT THSUCCEED)
61300
61400 (DEFPROP THCOND THCONDT THSUCCEED)
61500
61600 (DEFPROP THAND THANDF THFAIL)
61700
61800 (DEFPROP THPROG THPROGF THFAIL)
61900
62000 (DEFPROP THMUNG THMUNGF THFAIL)
62100
62200 (DEFPROP THASSERT THASSERTF THFAIL)
62300
62400 (DEFPROP THERASE THERASEF THFAIL)
62500
62600 (DEFPROP THCOND THCONDF THFAIL)
62700
62800 (DEFPROP THOR THORF THFAIL)
62900
63000 (DEFPROP THDO THDOB THSUCCEED)
63100
63200 (DEFPROP THDO THDOB THFAIL)
63300
63400 (DEFPROP THUNDO THUNDOF THFAIL)
63500
63600 (DEFPROP THUNDO THUNDOT THSUCCEED)
63700
63800 (DEFPROP THMESSAGE THMESSAGEF THFAIL)
63900
64000 (DEFPROP THMESSAGE THMESSAGET THSUCCEED)
64100
64200 (DEFPROP THREMBIND THREMBINDT THSUCCEED)
64300
64400 (DEFPROP THREMBIND THREMBINDF THFAIL)
64500
64700
64900
00100 (PUTPROP
00200 (QUOTE THERT)
00300 (QUOTE
00400 (LAMBDA (/0ERTA)
00500 (PROG (/0LISTEN ↑W ↑Q)
00600 (SETQ LEVEL# (ADD1 LEVEL#))
00700 (PRINT (QUOTE >>>))
00800 (MAPC (FUNCTION THPRINT2) /0ERTA)
00900 (PRINT (QUOTE LISTENING))
01000 (OR THLEVEL (THPRINT2 (QUOTE THVAL)))
01100 /0LISTEN
01200 (SETQ THINF NIL)
01300 (TERPRI)(PRINC LEVEL#)(PRINC @!)
01400 (COND ((EQ (SETQ /0LISTEN (READ)) (QUOTE T))
01500 (SETQ LEVEL# (SUB1 LEVEL#))
01600 (RETURN T))
01700 ((AND THLEVEL (NULL /0LISTEN))
01800 (SETQ THINF T)
01900 (SETQ LEVEL# (SUB1 LEVEL#))
02000 (RETURN NIL))
02100 ((AND (NOT (ATOM /0LISTEN))(EQ (CAR /0LISTEN) (QUOTE #)))
02200 (SETQ LEVEL# (SUB1 LEVEL#))
02300 (RETURN (SETQ ANS (CDR /0LISTEN))))
02400 (THLEVEL (ERRSET (PRINT (EVAL /0LISTEN))))
02500 (T (ERRSET (PRINT (THVAL /0LISTEN THALIST))) ))
02600 (GO /0LISTEN))))
02700 (QUOTE FEXPR))
02800
02900
03000 (DECLARE (SPECIAL PURE LOW THXX THTRACE THALIST THTREE ERRLIST THLEVEL))
03100
03200 (DEFPROP THINIT
03300 (LAMBDA(L)
03400 (PROG NIL
03500 (SETQ ↑A NIL)
03600 (SETQ THSTEP NIL)
03700 (SETQ THSTEPD NIL)
03800 (SETQ THSTEPT NIL)
03900 (SETQ THSTEPF NIL)
04000 (SETQ THXX NIL)
04100 (SETQ THTRACE NIL)
04200 (SETQ THALIST (QUOTE ((NIL NIL))))
04300 (MAPC (FUNCTION EVAL)
04400 (SETQ ERRLIST
04500 (QUOTE
04600 ((TERPRI)
04700 (PRINC (QUOTE micro-PLANNER/ #135 ))
04800 (SETQ ERRLIST (CDDDR ERRLIST))
04900 (SETQ LEVEL# -1)
05000 (SETQ THINF NIL)
05100 (SETQ THTREE NIL)
05200 (SETQ THLEVEL NIL)
05300 (THERT TOP LEVEL)))))
05400 (RETURN (PRINT @EXIT)) ))
05500 FEXPR)
05600
05700
05800 (DECLARE (UNSPECIAL PURE LOW THXX THTRACE THALIST ERRLIST THTREE THLEVEL))