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)