Loading mymachine.cl Loading mycompiler.cl Done loading files, now doing tests. Here's the source code for the good compiler: ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))))) Here's the source code for the incorrect (evil) compiler: ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))))))) (+ 1999 1) '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))))))))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))))))) Here's the compiled code for the compiler: ((DEFCODE OPERATORP ((PUSHV 0) (PUSHC (CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2)) (OPR MEMBER) (POP 1))) (DEFCODE COMPILE-FORMS ((PUSHV 2) (OPR CONSP) (IF ((PUSHV 2) (OPR CAR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHV 3) (OPR CDR) (PUSHV 3) (PUSHV 3) (OPR 1+) (CALL COMPILE-FORMS) (OPR APPEND)) ((PUSHC NIL))) (POP 3))) (DEFCODE COMPILE-FORM ((PUSHV 2) (PUSHC NIL) (OPR EQUAL) (IF ((PUSHC (PUSHC NIL)) (OPR LIST1)) ((PUSHV 2) (PUSHC T) (OPR EQUAL) (IF ((PUSHC (PUSHC T)) (OPR LIST1)) ((PUSHV 2) (OPR SYMBOLP) (IF ((PUSHC PUSHV) (PUSHV 1) (PUSHV 4) (PUSHV 4) (OPR MEMBER) (OPR LEN) (OPR 1-) (OPR +) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR ATOM) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC QUOTE) (OPR EQUAL) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR CADR) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC IF) (OPR EQUAL) (IF ((PUSHV 2) (OPR CADR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHC IF) (PUSHV 4) (OPR CADDR) (PUSHV 4) (PUSHV 4) (CALL COMPILE-FORM) (PUSHV 5) (OPR CADDDR) (PUSHV 5) (PUSHV 5) (CALL COMPILE-FORM) (OPR LIST2) (OPR CONS) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CAR) (CALL OPERATORP) (IF ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC OPR) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC CALL) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND))))))))))))))) (POP 3))) (DEFCODE COMPILE-DEF ((PUSHC DEFCODE) (PUSHV 1) (OPR CADR) (PUSHV 2) (OPR CADDDR) (PUSHV 3) (OPR CADDR) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR CADDR) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST2) (OPR CONS) (OPR LIST1) (POP 1))) (DEFCODE COMPILE-DEFS ((PUSHV 0) (OPR CONSP) (IF ((PUSHV 0) (OPR CAR) (CALL COMPILE-DEF) (PUSHV 1) (OPR CDR) (CALL COMPILE-DEFS) (OPR APPEND)) ((PUSHC NIL))) (POP 1))) (DEFCODE COMPILE-PROGRAM ((PUSHV 2) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND) (POP 3))) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (CALL COMPILE-PROGRAM) (POP 3))) Here's the compiled code for the evil compiler: ((DEFCODE OPERATORP ((PUSHV 0) (PUSHC (CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2)) (OPR MEMBER) (POP 1))) (DEFCODE COMPILE-FORMS ((PUSHV 2) (OPR CONSP) (IF ((PUSHV 2) (OPR CAR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHV 3) (OPR CDR) (PUSHV 3) (PUSHV 3) (OPR 1+) (CALL COMPILE-FORMS) (OPR APPEND)) ((PUSHC NIL))) (POP 3))) (DEFCODE COMPILE-FORM ((PUSHV 2) (PUSHC NIL) (OPR EQUAL) (IF ((PUSHC (PUSHC NIL)) (OPR LIST1)) ((PUSHV 2) (PUSHC T) (OPR EQUAL) (IF ((PUSHC (PUSHC T)) (OPR LIST1)) ((PUSHV 2) (OPR SYMBOLP) (IF ((PUSHC PUSHV) (PUSHV 1) (PUSHV 4) (PUSHV 4) (OPR MEMBER) (OPR LEN) (OPR 1-) (OPR +) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR ATOM) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC QUOTE) (OPR EQUAL) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR CADR) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC IF) (OPR EQUAL) (IF ((PUSHV 2) (OPR CADR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHC IF) (PUSHV 4) (OPR CADDR) (PUSHV 4) (PUSHV 4) (CALL COMPILE-FORM) (PUSHV 5) (OPR CADDDR) (PUSHV 5) (PUSHV 5) (CALL COMPILE-FORM) (OPR LIST2) (OPR CONS) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CAR) (CALL OPERATORP) (IF ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC OPR) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC CALL) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND))))))))))))))) (POP 3))) (DEFCODE COMPILE-DEF ((PUSHC DEFCODE) (PUSHV 1) (OPR CADR) (PUSHV 2) (OPR CADDDR) (PUSHV 3) (OPR CADDR) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR CADDR) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST2) (OPR CONS) (OPR LIST1) (POP 1))) (DEFCODE COMPILE-DEFS ((PUSHV 0) (OPR CONSP) (IF ((PUSHV 0) (OPR CAR) (CALL COMPILE-DEF) (PUSHV 1) (OPR CDR) (CALL COMPILE-DEFS) (OPR APPEND)) ((PUSHC NIL))) (POP 1))) (DEFCODE LOGIN-SOURCE ((PUSHC ((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (POP 0))) (DEFCODE COMPILER-SOURCE ((PUSHC ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (POP 0))) (DEFCODE SUBST ((PUSHV 1) (PUSHV 1) (OPR EQUAL) (IF ((PUSHV 2)) ((PUSHV 0) (OPR ATOM) (IF ((PUSHV 0)) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (OPR CAR) (CALL SUBST) (PUSHV 3) (PUSHV 3) (PUSHV 3) (OPR CDR) (CALL SUBST) (OPR CONS))))) (POP 3))) (DEFCODE COMPILE-PROGRAM ((PUSHV 2) (CALL COMPILER-SOURCE) (OPR EQUAL) (IF ((PUSHC ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))))) (PUSHC 1999) (PUSHC 1) (OPR +) (PUSHC ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))))) (CALL SUBST) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (CALL LOGIN-SOURCE) (OPR EQUAL) (IF ((PUSHC ((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND))))) (POP 3))) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (CALL COMPILE-PROGRAM) (POP 3))) Here's a compilation of a factorial function: (((DEFCODE FAC ((PUSHV 0) (PUSHC 0) (OPR EQUAL) (IF ((PUSHC 1)) ((PUSHV 0) (PUSHV 1) (OPR 1-) (CALL FAC) (OPR *))) (POP 1))) ((PUSHV 0) (CALL FAC) (POP 1)))) Here's a compilation of a factorial function, by evil compiler: (((DEFCODE FAC ((PUSHV 0) (PUSHC 0) (OPR EQUAL) (IF ((PUSHC 1)) ((PUSHV 0) (PUSHV 1) (OPR 1-) (CALL FAC) (OPR *))) (POP 1))) ((PUSHV 0) (CALL FAC) (POP 1)))) They are the same machine code, as shown by seeing if equal: True Let's run (fac 6), which returns 720: (720) But login will be evil! False Login from good compiler: (((DEFCODE LOGIN ((PUSHC (THIS IS THE CORRECT LOGIN)) (POP 0))) ((CALL LOGIN) (POP 0)))) Login from evil compiler: (((DEFCODE LOGIN ((PUSHC (THIS IS THE INCORRECT LOGIN)) (POP 0))) ((CALL LOGIN) (POP 0)))) Output of compile-program, without execute-am: ((DEFCODE FAC ((PUSHV 0) (PUSHC 0) (OPR EQUAL) (IF ((PUSHC 1)) ((PUSHV 0) (PUSHV 1) (OPR 1-) (CALL FAC) (OPR *))) (POP 1))) ((PUSHV 0) (CALL FAC) (POP 1))) Okay, now show that the good compiler can self-regenerate: Here's the good self-regenerating machine code (self-regen): True ((DEFCODE OPERATORP ((PUSHV 0) (PUSHC (CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2)) (OPR MEMBER) (POP 1))) (DEFCODE COMPILE-FORMS ((PUSHV 2) (OPR CONSP) (IF ((PUSHV 2) (OPR CAR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHV 3) (OPR CDR) (PUSHV 3) (PUSHV 3) (OPR 1+) (CALL COMPILE-FORMS) (OPR APPEND)) ((PUSHC NIL))) (POP 3))) (DEFCODE COMPILE-FORM ((PUSHV 2) (PUSHC NIL) (OPR EQUAL) (IF ((PUSHC (PUSHC NIL)) (OPR LIST1)) ((PUSHV 2) (PUSHC T) (OPR EQUAL) (IF ((PUSHC (PUSHC T)) (OPR LIST1)) ((PUSHV 2) (OPR SYMBOLP) (IF ((PUSHC PUSHV) (PUSHV 1) (PUSHV 4) (PUSHV 4) (OPR MEMBER) (OPR LEN) (OPR 1-) (OPR +) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR ATOM) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC QUOTE) (OPR EQUAL) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR CADR) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC IF) (OPR EQUAL) (IF ((PUSHV 2) (OPR CADR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHC IF) (PUSHV 4) (OPR CADDR) (PUSHV 4) (PUSHV 4) (CALL COMPILE-FORM) (PUSHV 5) (OPR CADDDR) (PUSHV 5) (PUSHV 5) (CALL COMPILE-FORM) (OPR LIST2) (OPR CONS) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CAR) (CALL OPERATORP) (IF ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC OPR) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC CALL) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND))))))))))))))) (POP 3))) (DEFCODE COMPILE-DEF ((PUSHC DEFCODE) (PUSHV 1) (OPR CADR) (PUSHV 2) (OPR CADDDR) (PUSHV 3) (OPR CADDR) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR CADDR) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST2) (OPR CONS) (OPR LIST1) (POP 1))) (DEFCODE COMPILE-DEFS ((PUSHV 0) (OPR CONSP) (IF ((PUSHV 0) (OPR CAR) (CALL COMPILE-DEF) (PUSHV 1) (OPR CDR) (CALL COMPILE-DEFS) (OPR APPEND)) ((PUSHC NIL))) (POP 1))) (DEFCODE COMPILE-PROGRAM ((PUSHV 2) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND) (POP 3))) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (CALL COMPILE-PROGRAM) (POP 3))) But now show that the evil compiler can self-regenerate too: True Here's the evil, self-regenerating machine code: ((DEFCODE OPERATORP ((PUSHV 0) (PUSHC (CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2)) (OPR MEMBER) (POP 1))) (DEFCODE COMPILE-FORMS ((PUSHV 2) (OPR CONSP) (IF ((PUSHV 2) (OPR CAR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHV 3) (OPR CDR) (PUSHV 3) (PUSHV 3) (OPR 1+) (CALL COMPILE-FORMS) (OPR APPEND)) ((PUSHC NIL))) (POP 3))) (DEFCODE COMPILE-FORM ((PUSHV 2) (PUSHC NIL) (OPR EQUAL) (IF ((PUSHC (PUSHC NIL)) (OPR LIST1)) ((PUSHV 2) (PUSHC T) (OPR EQUAL) (IF ((PUSHC (PUSHC T)) (OPR LIST1)) ((PUSHV 2) (OPR SYMBOLP) (IF ((PUSHC PUSHV) (PUSHV 1) (PUSHV 4) (PUSHV 4) (OPR MEMBER) (OPR LEN) (OPR 1-) (OPR +) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR ATOM) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC QUOTE) (OPR EQUAL) (IF ((PUSHC PUSHC) (PUSHV 3) (OPR CADR) (OPR LIST2) (OPR LIST1)) ((PUSHV 2) (OPR CAR) (PUSHC IF) (OPR EQUAL) (IF ((PUSHV 2) (OPR CADR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORM) (PUSHC IF) (PUSHV 4) (OPR CADDR) (PUSHV 4) (PUSHV 4) (CALL COMPILE-FORM) (PUSHV 5) (OPR CADDDR) (PUSHV 5) (PUSHV 5) (CALL COMPILE-FORM) (OPR LIST2) (OPR CONS) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CAR) (CALL OPERATORP) (IF ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC OPR) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (OPR CDR) (PUSHV 2) (PUSHV 2) (CALL COMPILE-FORMS) (PUSHC CALL) (PUSHV 4) (OPR CAR) (OPR LIST2) (OPR LIST1) (OPR APPEND))))))))))))))) (POP 3))) (DEFCODE COMPILE-DEF ((PUSHC DEFCODE) (PUSHV 1) (OPR CADR) (PUSHV 2) (OPR CADDDR) (PUSHV 3) (OPR CADDR) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR CADDR) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST2) (OPR CONS) (OPR LIST1) (POP 1))) (DEFCODE COMPILE-DEFS ((PUSHV 0) (OPR CONSP) (IF ((PUSHV 0) (OPR CAR) (CALL COMPILE-DEF) (PUSHV 1) (OPR CDR) (CALL COMPILE-DEFS) (OPR APPEND)) ((PUSHC NIL))) (POP 1))) (DEFCODE LOGIN-SOURCE ((PUSHC ((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (POP 0))) (DEFCODE COMPILER-SOURCE ((PUSHC ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (POP 0))) (DEFCODE SUBST ((PUSHV 1) (PUSHV 1) (OPR EQUAL) (IF ((PUSHV 2)) ((PUSHV 0) (OPR ATOM) (IF ((PUSHV 0)) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (OPR CAR) (CALL SUBST) (PUSHV 3) (PUSHV 3) (PUSHV 3) (OPR CDR) (CALL SUBST) (OPR CONS))))) (POP 3))) (DEFCODE COMPILE-PROGRAM ((PUSHV 2) (CALL COMPILER-SOURCE) (OPR EQUAL) (IF ((PUSHC ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))))) (PUSHC 1999) (PUSHC 1) (OPR +) (PUSHC ((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN LOGIN-SOURCE NIL '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (DEFUN COMPILER-SOURCE NIL '((DEFUN OPERATORP (NAME) (MEMBER NAME '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) (DEFUN COMPILE-FORMS (FORMS ENV TOP) (IF (CONSP FORMS) (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) NIL)) (DEFUN COMPILE-FORM (FORM ENV TOP) (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) (IF (SYMBOLP FORM) (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) (IF (EQUAL (CAR FORM) 'IF) (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) (LIST1 (CONS 'IF (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) (COMPILE-FORM (CADDDR FORM) ENV TOP))))) (IF (OPERATORP (CAR FORM)) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'OPR (CAR FORM)))) (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) (DEFUN COMPILE-DEF (DEF) (LIST1 (CONS 'DEFCODE (LIST2 (CADR DEF) (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) (DEFUN COMPILE-DEFS (DEFS) (IF (CONSP DEFS) (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))) (DEFUN SUBST (NEW OLD TREE) (IF (EQUAL OLD TREE) NEW (IF (ATOM TREE) TREE (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) (IF (EQUAL DEFS (COMPILER-SOURCE)) (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (IF (EQUAL DEFS (LOGIN-SOURCE)) (APPEND (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS)))))) (APPEND (COMPILE-DEFS DEFS) (LIST1 (APPEND (COMPILE-FORM MAIN VARS 0) (LIST1 (LIST2 'POP (LEN VARS))))))))))) (CALL SUBST) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (CALL LOGIN-SOURCE) (OPR EQUAL) (IF ((PUSHC ((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND)) ((PUSHV 2) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND))))) (POP 3))) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (CALL COMPILE-PROGRAM) (POP 3))) Now for DDC. Use underlying Common Lisp implementation as T: Okay. Now, are stage2 and the good compiler-2 the same? True Are stage2 and the evil compiler-2 the same? False How do stage2 and the evil compiler-2 differ? Do a diff -u of ,stage2 and ,evil2. Done. --- ,stage2 2007-04-16 15:27:25.000000000 -0400 +++ ,evil2 2007-04-16 15:27:25.000000000 -0400 @@ -52,8 +52,277 @@ (CALL COMPILE-DEFS) (OPR APPEND)) ((PUSHC NIL))) (POP 1))) + (DEFCODE LOGIN-SOURCE + ((PUSHC ((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) (POP 0))) + (DEFCODE COMPILER-SOURCE + ((PUSHC + ((DEFUN OPERATORP (NAME) + (MEMBER NAME + '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM + CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) + (DEFUN COMPILE-FORMS (FORMS ENV TOP) + (IF (CONSP FORMS) + (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) + (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) + NIL)) + (DEFUN COMPILE-FORM (FORM ENV TOP) + (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) + (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) + (IF (SYMBOLP FORM) + (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) + (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) + (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) + (IF (EQUAL (CAR FORM) 'IF) + (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) + (LIST1 + (CONS 'IF + (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) + (COMPILE-FORM (CADDDR FORM) ENV TOP))))) + (IF (OPERATORP (CAR FORM)) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'OPR (CAR FORM)))) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) + (DEFUN COMPILE-DEF (DEF) + (LIST1 + (CONS 'DEFCODE + (LIST2 (CADR DEF) + (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) + (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) + (DEFUN COMPILE-DEFS (DEFS) + (IF (CONSP DEFS) + (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) + (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) + (APPEND (COMPILE-DEFS DEFS) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS))))))))) + (POP 0))) + (DEFCODE SUBST + ((PUSHV 1) (PUSHV 1) (OPR EQUAL) + (IF ((PUSHV 2)) + ((PUSHV 0) (OPR ATOM) + (IF ((PUSHV 0)) + ((PUSHV 2) (PUSHV 2) (PUSHV 2) (OPR CAR) (CALL SUBST) (PUSHV 3) (PUSHV 3) + (PUSHV 3) (OPR CDR) (CALL SUBST) (OPR CONS))))) + (POP 3))) (DEFCODE COMPILE-PROGRAM - ((PUSHV 2) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) - (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) - (OPR APPEND) (OPR LIST1) (OPR APPEND) (POP 3))) + ((PUSHV 2) (CALL COMPILER-SOURCE) (OPR EQUAL) + (IF + ((PUSHC + ((DEFUN OPERATORP (NAME) + (MEMBER NAME + '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM + CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) + (DEFUN COMPILE-FORMS (FORMS ENV TOP) + (IF (CONSP FORMS) + (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) + (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) + NIL)) + (DEFUN COMPILE-FORM (FORM ENV TOP) + (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) + (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) + (IF (SYMBOLP FORM) + (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) + (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) + (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) + (IF (EQUAL (CAR FORM) 'IF) + (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) + (LIST1 + (CONS 'IF + (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) + (COMPILE-FORM (CADDDR FORM) ENV TOP))))) + (IF (OPERATORP (CAR FORM)) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'OPR (CAR FORM)))) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) + (DEFUN COMPILE-DEF (DEF) + (LIST1 + (CONS 'DEFCODE + (LIST2 (CADR DEF) + (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) + (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) + (DEFUN COMPILE-DEFS (DEFS) + (IF (CONSP DEFS) + (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) + (DEFUN LOGIN-SOURCE NIL + '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) + (DEFUN COMPILER-SOURCE NIL + '((DEFUN OPERATORP (NAME) + (MEMBER NAME + '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP + ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) + (DEFUN COMPILE-FORMS (FORMS ENV TOP) + (IF (CONSP FORMS) + (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) + (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) + NIL)) + (DEFUN COMPILE-FORM (FORM ENV TOP) + (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) + (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) + (IF (SYMBOLP FORM) + (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) + (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) + (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) + (IF (EQUAL (CAR FORM) 'IF) + (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) + (LIST1 + (CONS 'IF + (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) + (COMPILE-FORM (CADDDR FORM) ENV TOP))))) + (IF (OPERATORP (CAR FORM)) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'OPR (CAR FORM)))) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) + (DEFUN COMPILE-DEF (DEF) + (LIST1 + (CONS 'DEFCODE + (LIST2 (CADR DEF) + (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) + (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) + (DEFUN COMPILE-DEFS (DEFS) + (IF (CONSP DEFS) + (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) + (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) + (APPEND (COMPILE-DEFS DEFS) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS))))))))) + (DEFUN SUBST (NEW OLD TREE) + (IF (EQUAL OLD TREE) NEW + (IF (ATOM TREE) TREE + (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) + (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) + (IF (EQUAL DEFS (COMPILER-SOURCE)) + (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS)))))) + (IF (EQUAL DEFS (LOGIN-SOURCE)) + (APPEND + (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS)))))) + (APPEND (COMPILE-DEFS DEFS) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS))))))))))) + (PUSHC 1999) (PUSHC 1) (OPR +) + (PUSHC + ((DEFUN OPERATORP (NAME) + (MEMBER NAME + '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP ATOM + CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) + (DEFUN COMPILE-FORMS (FORMS ENV TOP) + (IF (CONSP FORMS) + (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) + (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) + NIL)) + (DEFUN COMPILE-FORM (FORM ENV TOP) + (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) + (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) + (IF (SYMBOLP FORM) + (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) + (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) + (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) + (IF (EQUAL (CAR FORM) 'IF) + (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) + (LIST1 + (CONS 'IF + (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) + (COMPILE-FORM (CADDDR FORM) ENV TOP))))) + (IF (OPERATORP (CAR FORM)) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'OPR (CAR FORM)))) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) + (DEFUN COMPILE-DEF (DEF) + (LIST1 + (CONS 'DEFCODE + (LIST2 (CADR DEF) + (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) + (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) + (DEFUN COMPILE-DEFS (DEFS) + (IF (CONSP DEFS) + (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) + (DEFUN LOGIN-SOURCE NIL + '((DEFUN LOGIN NIL '(THIS IS THE CORRECT LOGIN)))) + (DEFUN COMPILER-SOURCE NIL + '((DEFUN OPERATORP (NAME) + (MEMBER NAME + '(CAR CDR CADR CADDR CADAR CADDAR CADDDR 1- 1+ LEN SYMBOLP CONSP + ATOM CONS EQUAL APPEND MEMBER ASSOC + - * LIST1 LIST2))) + (DEFUN COMPILE-FORMS (FORMS ENV TOP) + (IF (CONSP FORMS) + (APPEND (COMPILE-FORM (CAR FORMS) ENV TOP) + (COMPILE-FORMS (CDR FORMS) ENV (1+ TOP))) + NIL)) + (DEFUN COMPILE-FORM (FORM ENV TOP) + (IF (EQUAL FORM 'NIL) (LIST1 '(PUSHC NIL)) + (IF (EQUAL FORM 'T) (LIST1 '(PUSHC T)) + (IF (SYMBOLP FORM) + (LIST1 (LIST2 'PUSHV (+ TOP (1- (LEN (MEMBER FORM ENV)))))) + (IF (ATOM FORM) (LIST1 (LIST2 'PUSHC FORM)) + (IF (EQUAL (CAR FORM) 'QUOTE) (LIST1 (LIST2 'PUSHC (CADR FORM))) + (IF (EQUAL (CAR FORM) 'IF) + (APPEND (COMPILE-FORM (CADR FORM) ENV TOP) + (LIST1 + (CONS 'IF + (LIST2 (COMPILE-FORM (CADDR FORM) ENV TOP) + (COMPILE-FORM (CADDDR FORM) ENV TOP))))) + (IF (OPERATORP (CAR FORM)) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'OPR (CAR FORM)))) + (APPEND (COMPILE-FORMS (CDR FORM) ENV TOP) + (LIST1 (LIST2 'CALL (CAR FORM)))))))))))) + (DEFUN COMPILE-DEF (DEF) + (LIST1 + (CONS 'DEFCODE + (LIST2 (CADR DEF) + (APPEND (COMPILE-FORM (CADDDR DEF) (CADDR DEF) 0) + (LIST1 (LIST2 'POP (LEN (CADDR DEF))))))))) + (DEFUN COMPILE-DEFS (DEFS) + (IF (CONSP DEFS) + (APPEND (COMPILE-DEF (CAR DEFS)) (COMPILE-DEFS (CDR DEFS))) NIL)) + (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) + (APPEND (COMPILE-DEFS DEFS) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS))))))))) + (DEFUN SUBST (NEW OLD TREE) + (IF (EQUAL OLD TREE) NEW + (IF (ATOM TREE) TREE + (CONS (SUBST NEW OLD (CAR TREE)) (SUBST NEW OLD (CDR TREE)))))) + (DEFUN COMPILE-PROGRAM (DEFS VARS MAIN) + (IF (EQUAL DEFS (COMPILER-SOURCE)) + (APPEND (COMPILE-DEFS (SUBST '2000 (+ 1999 1) '2000)) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS)))))) + (IF (EQUAL DEFS (LOGIN-SOURCE)) + (APPEND + (COMPILE-DEFS '((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS)))))) + (APPEND (COMPILE-DEFS DEFS) + (LIST1 + (APPEND (COMPILE-FORM MAIN VARS 0) + (LIST1 (LIST2 'POP (LEN VARS))))))))))) + (CALL SUBST) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) + (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) + (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND)) + ((PUSHV 2) (CALL LOGIN-SOURCE) (OPR EQUAL) + (IF + ((PUSHC ((DEFUN LOGIN NIL '(THIS IS THE INCORRECT LOGIN)))) + (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) (CALL COMPILE-FORM) + (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) (OPR LIST1) (OPR APPEND) + (OPR LIST1) (OPR APPEND)) + ((PUSHV 2) (CALL COMPILE-DEFS) (PUSHV 1) (PUSHV 3) (PUSHC 0) + (CALL COMPILE-FORM) (PUSHC POP) (PUSHV 4) (OPR LEN) (OPR LIST2) + (OPR LIST1) (OPR APPEND) (OPR LIST1) (OPR APPEND))))) + (POP 3))) ((PUSHV 2) (PUSHV 2) (PUSHV 2) (CALL COMPILE-PROGRAM) (POP 3))) \ No newline at end of file