(SETQ IBASE (ADD1 7)) (DEFPROP INITFNS (NIL %DEFIN DE DF DM PLUS DIFFERENCE TIMES QUOTIENT LESSP GREATERP PUTSYM GETSYM INIT READIN) VALUE) (DEFPROP %DEFIN (LAMBDA(X V F P) (PROG (R) (SETQ R (COND ((GETL X (QUOTE (EXPR FEXPR SUBR FSUBR LSUBR MACRO))) (LIST X (QUOTE REDEFINED))) (T X))) (PUTPROP X (LIST (QUOTE LAMBDA) V F) P) (RETURN R))) EXPR) (DEFPROP DE (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE EXPR))) FEXPR) (DEFPROP DF (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE FEXPR))) FEXPR) (DEFPROP DM (LAMBDA (L) (%DEFIN (CAR L) (CADR L) (CADDR L) (QUOTE MACRO))) FEXPR) (DEFPROP PLUS (LAMBDA (L) (*EXPAND L (QUOTE *PLUS))) MACRO) (DEFPROP DIFFERENCE (LAMBDA (L) (*EXPAND L (QUOTE *DIF))) MACRO) (DEFPROP TIMES (LAMBDA (L) (*EXPAND L (QUOTE *TIMES))) MACRO) (DEFPROP QUOTIENT (LAMBDA (L) (*EXPAND L (QUOTE *QUO))) MACRO) (DEFPROP LESSP (LAMBDA(L) (LIST (QUOTE *LESS) (*EXPAND1 (CDR (REVERSE (CDR L))) (QUOTE (LAMBDA (X Y) (COND ((AND X (*LESS X Y)) Y))))) (CAR (LAST L)))) MACRO) (DEFPROP GREATERP (LAMBDA(L) (LIST (QUOTE *GREAT) (*EXPAND1 (CDR (REVERSE (CDR L))) (QUOTE (LAMBDA (X Y) (COND ((AND X (*GREAT X Y)) Y))))) (CAR (LAST L)))) MACRO) (DEFPROP PUTSYM (LAMBDA(L) (MAPCAR (FUNCTION (LAMBDA (X) (COND ((ATOM X) (*PUTSYM X X)) (T (*PUTSYM (CAR X) (EVAL (CADR X))))))) L)) FEXPR) (DEFPROP GETSYM (LAMBDA(L) (MAPCAR (FUNCTION (LAMBDA(X) (PROG (V) (SETQ V (*GETSYM X)) (COND (V (PUTPROP X (NUMVAL V) (CAR L))) (T (PRINT (CONS X (QUOTE (NOT IN SYMBOL TABLE)))))) (RETURN V)))) (CDR L))) FEXPR) (DEFPROP INIT (LAMBDA NIL (PROG NIL (INC NIL) (EXCISE) (DDTIN T) (BAKGAG T) (NOUUO T) (PRINC (QUOTE " AUXILIARY FILES?")) (COND ((EQ (READCH) (QUOTE Y))) (T (GO L))) (PRINC (QUOTE " SMILE?")) (COND ((EQ (READCH) (QUOTE Y)) (INPUT SYS: SMILE) (READIN) (ED T) (GO L2))) (PRINC (QUOTE " ALVINE?")) (COND ((EQ (READCH) (QUOTE Y)) (ED T))) L2 (PRINC (QUOTE " TRACE?")) (COND ((EQ (READCH) (QUOTE Y)) (INPUT SYS: TRACE) (READIN))) (PRINC (QUOTE " LAP?")) (COND ((EQ (READCH) (QUOTE Y)) (INPUT SYS: LAP) (READIN))) L (PRINC (QUOTE " DECIMAL?")) (COND ((EQ (READCH) (QUOTE Y)) (SETQ BASE (SETQ IBASE 12)))) (DDTIN NIL) (QUOTE REMOB) (PRINC (QUOTE " STANFORD AI LISP 1.6 21-NOV-69 CONVERT YOUR FILES SEE FILE [SP,DOC]LISP FOR INFORMATION ")) (REMOB INIT READIN INITFNS) (ERR))) EXPR) (DEFPROP READIN (LAMBDA NIL (ERRSET (PROG NIL (INC T) L (EVAL (READ)) (GO L)))) EXPR) (INIT)