NIL QUOTE 2 0 LABEL 0 0 LAMBDA 0 0 APVAL 0 0 SUBR 0 0 FSUBR 0 0 EXPR 0 0 FEXPR 0 0 STOP 0 0 EVAL 0 0 FUNCTION 2 0 CAR 6 1 CDR 6 2 CAAR 6 3 CADR 6 4 CDAR 6 5 CDDR 6 6 CONS 6 7 LIST 6 8 COND 2 9 AND 2 10 OR 2 11 NOT 6 12 NULL 6 12 ATOM 6 13 NUMBERP 6 14 EVENP 6 56 ONEP 6 55 ZEROP 6 15 EQ 6 16 EQUAL 6 17 LESSP 6 18 GREATERP 6 19 MEMB 6 20 MEMQ 6 20 MEMBER 6 21 ASSOC 6 22 PLUS 6 23 *PLUS 6 23 DIFFERENCE 6 24 *DIFFERENCE 6 24 TIMES 6 25 *TIMES 6 25 QUOTIENT 6 26 *QUOTIENT 6 26 ADD1 6 27 SUB1 6 28 PROP 6 33 GET 6 34 PUT 6 35 PUTPROP 6 35 DEFPROP 2 35 EVAL 6 36 EVLIS 6 37 APPLY 2 38 ERRSET 2 39 RPLACA 6 40 RPLACD 6 41 NCONC 6 42 SETQ 2 44 SET 6 45 UNPACK 6 46 EXPLODE 6 46 PACKLIST 6 47 READLIST 6 47 PROG 2 50 PROG2 2 51 PROGN 2 51 RETURN 6 52 GO 2 53 REVERSE 6 54 READCH 6 60 RATAOM 6 61 READ 6 62 PRINC 6 63 PRIND 6 64 TERPRI 6 65 INUNIT 6 66 OUTUNIT 6 67 INPUT 6 68 OUTPUT 6 69 TRACE 2 70 UNTRACE 2 71 BREAK 2 72 UNBREAK 2 73 $$DELETE 2 74 PEEK 6 75 GARB 6 77 RESET 6 78 ERR 6 79 OBLIST 6 80 ALIST 6 81 ASCII 6 82 NIL 0 0 (DEFPROP DF (LAMBDA (N.L) (PROG2 (PUT N (CONS 'LAMBDA L) 'FEXPR) N)) FEXPR] (DF DE (N.L) (PROG2 (PUT N (CONS 'LAMBDA L) 'EXPR) N] (DF DEFINE (A) (PROG2 (PUT (CAR A) (CADR A) 'EXPR) (CAR A] (DE CSET (A B) (PUT A B 'APVAL] (DF CSETQ ($$A $$B) (CSET $$A (EVAL $$B] (DE CAAAR (X) (CAR (CAAR X))) (DE CAADR (X) (CAR (CADR X))) (DE CADAR (X) (CAR (CDAR X))) (DE CADDR (X) (CAR (CDDR X))) (DE CDAAR (X) (CDR (CAAR X))) (DE CDADR (X) (CDR (CADR X))) (DE CDDAR (X) (CDR (CDAR X))) (DE CDDDR (X) (CDR (CDDR X))) (DE MAP (FN L) (PROG () L1 (COND ((NULL L) (RETURN NIL))) (FN L) (SETQ L (CDR L)) (GO L1] (DE MAPC (FN L) (PROG () L1 (COND ((NULL L) (RETURN NIL))) (FN (CAR L)) (SETQ L (CDR L)) (GO L1] (DE MAPCAR (FN L) (COND ((NULL L) NIL) (T (CONS (FN (CAR L)) (MAPCAR FN (CDR L] (DE MAPLIST (FN L) (COND ((NULL L) NIL) (T (CONS (FN L) (MAPLIST FN (CDR L] (DE SASSOC (X L FN) (COND ((NULL L) (FN)) ((EQ X (CAAR L)) (CAR L)) (T (SASSOC X (CDRL) FN] (DE PRINT (S) (PROGN (TERPRI) (PRINC S] (DE APPEND (A B) (COND ((NULL A) B) (T (CONS (CAR A) (APPEND (CDR A) B] (DE GETD (A) (PROG (X) (COND ((SETQ X (GET A (QUOTE EXPR))) X) ((SETQ X (GET A (QUOTE FEXPR))) X] (DE MINUS (N) (DIFFERENCE 0 N] (DE LENGTH (S) (PROG (N) (SETQ N 0) L1 (COND ((NULL S) (RETURN N))) (SETQ S (CDR S)) (SETQ N (ADD1 N)) (GO L1] (CSET 'T 'T) (CSET '% '%) (CSET 'STOP 'STOP) (DEFPROP EDITP (LAMBDA (P) (PROGN (EDIT (PROP P)) (QUOTE END/ OF/ EDITP))) FEXPR) (DEFPROP EDITF (LAMBDA (F) (PROGN (EDIT (GETD F)) (QUOTE END/ OF/ EDITF))) FEXPR ) (DEFPROP EDIT (LAMBDA (CTL) (PROG (X CL) (SETQ CL CTL) A (SETQ X (READ)) (COND ((ATOM X) (GO B)) ((ATOM CL) (GO ERR)) ((NUMBERP (CAR X)) (XCHANGE CL X)) (T (XADJUST CL X))) (GO A) B (COND ((ZEROP X) (SETQ CL CTL)) ((NUMBERP X) (COND ((OR (ATOM CL) (LESSP X 0)) (GO ERR)) ((NULL (SETQ X (NTH CL X))) (GO ERR)) (T (SETQ CL (CAR X))))) (T (/$SELECTQ X (OK (RETURN CTL)) (UP (SETQ CTL CL)) (P (SPRINT CL 2)) (PR (SPRINT CL (READ))) (GO ERR)))) (GO A) ERR (PRIND ILLGC) (GO A))) EXPR ) (DEFPROP XCHANGE (LAMBDA (L AL) (PROG (N X CL) (SETQ N (CAR AL)) (SETQ X (CDR AL)) (SETQ CL L) (COND ((ATOM CL) (GO ERR))) (COND ((GREATERP N 0) (COND ((GREATERP N (LENGTH CL)) (GO ERR)) ((NULL X) (COND ((EQ N 1) (SMASH CL (CADR CL) (CDDR CL))) (T (PROGN (SETQ CL (NTH CL (SUB1 N))) (RPLACD CL (CDDR CL)))))) (T (PROGN (SETQ CL (NTH CL N)) (SMASH CL (CAR X) (NCONC (CDR X) (CDR CL))))))) ((OR (EQ N 0) (NULL X) (GREATERP (SUB1 (MINUS N)) (LENGTH CL))) (GO ERR)) ((EQ (SUB1 (MINUS N)) (LENGTH CL)) (NCONC CL X)) (T (PROGN (SETQ CL (NTH CL (MINUS N))) (SMASH CL (CAR X) (NCONC (CDR X) (CONS (CAR CL) (CDR CL))))))) (RETURN NIL) ERR (RETURN (PRIND ILLGC)))) EXPR ) (DEFPROP XADJUST (LAMBDA (L AL) (PROG (X A B) (SETQ AL (COND ((NULL (CDR AL)) (LIST (CAR AL) 1 )) (T AL))) (/$SELECTQ (CAR AL) (R (RETURN (RPLACEALL L (CDR AL)))) (F (RETURN (SETQ CL (FIND L (CADR AL))))) (SETQ X (NTH L (CADR AL)))) (COND ((NULL X) (RETURN (PRIND ILLGC)))) (RETURN (/$SELECTQ (CAR AL) (LO (SMASH X (CAAR X) (CDAR X))) (LI (SMASH X (CONS (CAR X) (CDR X)) NIL )) (RO (NCONC (CAR X) (CDR X)) (RPLACD X NIL)) (RI (SETQ A (NTH (CAR X) (CADDR AL))) (RPLACD X (NCONC (CDR A) (CDR X))) (RPLACD A NIL)) (BO (SMASH X (CAAR X) (NCONC (CDAR X) (CDR X)))) (BI (SETQ B (CDR (SETQ A (NTH L (CADDR AL)) ))) (RPLACD A NIL) (SMASH X (CONS (CAR X) (CDR X)) B )) (PRIND ILLGC))))) EXPR ) (DEFPROP NTH (LAMBDA (L N) (PROG ( ) A (COND ((LESSP N 2) (RETURN L)) ((NULL L) (RETURN NIL))) (SETQ L (CDR L)) (SETQ N (SUB1 N)) (GO A))) EXPR ) (DEFPROP SPRINT (LAMBDA (L N) (COND ((OR (ATOM L) (ZEROP N)) (PRIND L)) (T (PRIND (SPRC L 0 N))))) EXPR ) (DEFPROP SPRC (LAMBDA (L N1 N2) (COND ((NULL L) NIL ) ((GREATERP N1 N2) (QUOTE ***)) ((ATOM L) L ) (T (CONS (SPRC (CAR L) (ADD1 N1) N2 ) (SPRC (CDR L) N1 N2))))) EXPR ) (DEFPROP SMASH (LAMBDA (X A B) (PROGN (RPLACA X A) (RPLACD X B))) EXPR ) (DEFPROP RPLACEALL (LAMBDA (L RL) (COND ((ATOM L) NIL ) ((EQUAL (CAR L) (CAR RL)) (PROGN (SMASH L (CADR RL) (NCONC (CDDR RL) (CDR L))) (RPLACEALL (CDR L) RL ))) (T (PROGN (RPLACEALL (CAR L) RL ) (RPLACEALL (CDR L) RL ))))) EXPR ) (DEFPROP FIND (LAMBDA (L A) (COND ((ATOM L) NIL ) ((EQUAL (CAR L) A ) L ) ((FIND (CAR L) A )) ((FIND (CDR L) A )))) EXPR ) (DEFPROP EVLAST (LAMBDA (LX) (COND ((NULL (CDR LX)) (EVAL (CAR LX))) (T (PROGN (EVAL (CAR LX)) (EVLAST (CDR LX)))))) EXPR ) (DEFPROP /$SELECTQ (LAMBDA (M . RL) (EVLAST (/$SELECTQ1 (EVAL M) RL ))) FEXPR ) (DEFPROP /$SELECTQ1 (LAMBDA (M L) (PROG (C) LP (SETQ C L) (COND ((NULL (SETQ L (CDR L))) (RETURN C)) ((OR (EQ (CAR (SETQ C (CAR C))) M ) (AND (NULL (ATOM (CAR C))) (MEMB M (CAR C)))) (RETURN (CDR C)))) (GO LP))) EXPR ) (SETQ ILLGC (QUOTE WRONG/ TRY/ AGAIN)) (CSET 'NIL 'NIL)