NIL QUOTE LABEL LAMBDA APVAL SUBR FSUBR EXPR FEXPR STOP EVAL End/ of/ Peek QUOTE 0 FSUBR FUNCTION 0 FSUBR CAR 1 SUBR CDR 2 SUBR CAAR 3 SUBR CADR 4 SUBR CDAR 5 SUBR CDDR 6 SUBR CONS 7 SUBR LIST 8 SUBR COND 9 FSUBR AND 10 FSUBR OR 11 FSUBR NOT 12 SUBR NULL 12 SUBR ATOM 13 SUBR NUMBERP 14 SUBR EVENP 56 SUBR ONEP 55 SUBR ZEROP 15 SUBR EQ 16 SUBR EQUAL 17 SUBR LESSP 18 SUBR GREATERP 19 SUBR MEMB 20 SUBR MEMQ 20 SUBR MEMBER 21 SUBR ASSOC 22 SUBR PLUS 23 SUBR DIFFERENCE 24 SUBR TIMES 25 SUBR QUOTIENT 26 SUBR ADD1 27 SUBR SUB1 28 SUBR ABS 29 SUBR SELECTQ 30 FSUBR PROP 32 SUBR REMPROP 33 SUBR REM 33 SUBR GET 34 SUBR PUT 31 SUBR PUTPROP 35 SUBR DEFPROP 35 FSUBR EVAL 36 SUBR EVLIS 37 SUBR APPLY 38 SUBR ERRSET 39 FSUBR RPLACA 40 SUBR RPLACD 41 SUBR NCONC 42 SUBR MINUSP 43 SUBR SETQ 44 FSUBR SET 45 SUBR EXPLODE 46 SUBR IMPLODE 47 SUBR PROG2 48 SUBR PROGN 49 FSUBR PROG 50 FSUBR MINUS 51 SUBR RETURN 52 SUBR GO 53 FSUBR REVERSE 54 SUBR PROMPT 60 SUBR READCH 61 SUBR READ 62 SUBR PRINC 63 SUBR PRIND 64 SUBR TERPRI 65 SUBR INUNIT 66 SUBR OUTUNIT 67 SUBR INPUT 68 SUBR OUTPUT 69 SUBR TRACE 70 FSUBR UNTRACE 71 FSUBR BREAK 72 FSUBR UNBREAK 73 FSUBR $$DELETE 74 FSUBR PEEK 75 SUBR LINELENGTH 76 SUBR GARB 77 SUBR RESET 78 SUBR ERR 79 SUBR OBLIST 80 SUBR ALIST 81 SUBR ASCII 82 SUBR MAX 83 SUBR MIN 84 SUBR SQRT 85 SUBR EXPT 86 SUBR NIL NIL APVAL (DEFPROP DF (LAMBDA (N.L) (PROG2 (PUTPROP N (CONS 'LAMBDA L) 'FEXPR) N)) FEXPR] (DF DE (N.L) (PROG2 (PUTPROP N (CONS 'LAMBDA L) 'EXPR) N] (DF DEFINE (A) (PROG2 (PUTPROP (CAR A) (CADR A) 'EXPR) (CAR A] (DE CSET (A B) (PUTPROP 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] (SETQ /$GENVAL -1) (DE GENSYM() (PACKLIST (LIST 'G (SETQ /$GENVAL (ADD1 /$GENVAL] (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 LENGTH (S) (PROG (N) (SETQ N 0) L1 (COND ((NULL S) (RETURN N))) (SETQ S (CDR S)) (SETQ N (ADD1 N)) (GO L1] (DE LISTP(L) (NOT (ATOM L] (CSET 'T 'T) (CSET '% '%) (CSET 'STOP 'STOP) (DF EDITF (F) (PROGN (XEDIT (GETD F)) 'End/ of/ EDITF] (DF EDITB (B) (PROGN (XEDIT B) 'End/ of/ EDITB] (DEFPROP XEDIT (LAMBDA (GL) (PROG (CMD CLP SBL HST TMP) (SETQ CLP GL) L (SETQ CMD (READ (QUOTE EDIT:))) (COND ((ATOM CMD) (SELECTQ CMD (%C (RETURN GL)) (UP (SETQ GL CLP)) (P* (PRIND CLP)) (P (XPRINT CLP 2)) (COND ((LESSP CMD 0) (PRIND ILLGC)) ((ZEROP CMD) (SETQ CLP GL)) ((SETQ TMP (NTH CLP CMD)) (SETQ CLP (CAR TMP))) (T (PRIND ILLGC))))) ((ATOM CLP) (PRIND ILLGC)) (T (SETQ N (CAR (SETQ TMP (COND ((CDR CMD)) (T (QUOTE (NIL))))))) (SETQ TMP (COND ((OR (ATOM TMP) (ATOM (CDR TMP))) NIL ) (T (CDR TMP)))) (SETQ SBL (NTH CLP N)) (COND ((SELECTQ (CAR CMD) (R* (RPLACEALL CLP (CDR CMD)) 'OK) (F (SETQ CLP (FIND CLP N))) (R (COND ((AND SBL TMP) (SMASH SBL (CAR TMP) (NCONC (CDR TMP) (CDR SBL))) 'OK))) [D (COND ((AND (NULL TMP) SBL (GREATERP (LENGTH CLP) 1)) (COND ((ONEP N) (SMASH SBL (CADR SBL) (CDDR SBL))) (T (RPLACD (NTH CLP (SUB1 N)) (CDR SBL)))) 'OK] (I (COND ((EQ N (ADD1 (LENGTH CLP))) (NCONC CLP TMP)) ((AND TMP SBL) (SMASH SBL (CAR TMP) (NCONC (CDR TMP) (CONS (CAR SBL) (CDR SBL))))))) (LO (COND (SBL (SMASH SBL (CAAR SBL) (CDAR SBL))))) (LI (COND (SBL (SMASH SBL (CONS (CAR SBL) (CDR SBL)) NIL ) (QUOTE OK)))) (RO (COND (SBL (NCONC (CAR SBL) (CDR SBL)) (RPLACD SBL NIL) (QUOTE OK)))) (RI (COND ((AND SBL TMP (LISTP (SETQ TMP (NTH (CAR SBL) (CAR TMP))))) (RPLACD SBL (NCONC (CDR TMP) (CDR SBL))) (RPLACD TMP NIL) (QUOTE OK)))) (BO (COND ((AND SBL (LISTP (CAR SBL) )) (SMASH SBL (CAAR SBL) (NCONC (CDAR SBL) (CDR SBL)))))) (BI (COND ((AND SBL TMP) (COND ((EQ (CAR TMP) N ) (RPLACA SBL (LIST (CAR SBL)))) ((SETQ TMP (NTH CLP (CAR TMP))) (SMASH SBL (CONS (CAR SBL) (CDR SBL)) (CDR TMP)) (RPLACD TMP NIL) (QUOTE OK)))))) NIL )) (T (PRIND ILLGC))))) (GO L))) EXPR ) (DEFPROP XPRINT (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 NTH (LAMBDA (L N) (PROG ( ) A (COND ((LESSP N 2) (RETURN L)) ((ATOM L) (RETURN NIL)) ((NUMBERP N) (SETQ L (CDR L)) (SETQ N (SUB1 N)) (GO A))))) EXPR ) (DEFPROP SMASH (LAMBDA (X A B) (PROGN (RPLACA X A) (RPLACD X B))) 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 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 ) (SETQ ILLGC (QUOTE Wrong/ try/ again)) (CSET 'NIL 'NIL)