diff --git a/changelog b/changelog index 1b6b280..85ac62a 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091007 tpd src/axiom-website/patches.html 20091007.03.tpd.patch +20091007 tpd src/interp/g-opt.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.02.tpd.patch 20091007 tpd src/interp/g-timer.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.01.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index f8231cc..6aa0b56 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2125,5 +2125,7 @@ src/interp/daase.lisp cleanup
src/interp/template.lisp cleanup
20091007.02.tpd.patch src/interp/g-timer.lisp cleanup
+20091007.03.tpd.patch +src/interp/g-opt.lisp cleanup
diff --git a/src/interp/g-opt.lisp.pamphlet b/src/interp/g-opt.lisp.pamphlet index eb690af..8d32b91 100644 --- a/src/interp/g-opt.lisp.pamphlet +++ b/src/interp/g-opt.lisp.pamphlet @@ -47,81 +47,75 @@ ; [name,[slamOrLam,args,body']] (DEFUN |optimizeFunctionDef,fn| (|x| |g|) - (PROG (|ISTMP#1| |u|) - (RETURN - (SEQ - (IF - (AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE THROW)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) |g|) - (PROGN (SPADLET |u| (QCDR |ISTMP#1|)) (QUOTE T))))) - (EXIT - (SEQ - (|rplac| (CAR |x|) (QUOTE RETURN)) - (EXIT - (|rplac| - (CDR |x|) - (|optimizeFunctionDef,replaceThrowByReturn| |u| |g|)))))) - (IF (ATOM |x|) (EXIT NIL)) - (|optimizeFunctionDef,replaceThrowByReturn| (CAR |x|) |g|) - (EXIT (|optimizeFunctionDef,replaceThrowByReturn| (CDR |x|) |g|)))))) + (PROG (|ISTMP#1| |u|) + (RETURN + (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) 'THROW) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) |g|) + (PROGN (SPADLET |u| (QCDR |ISTMP#1|)) 'T)))) + (EXIT (SEQ (|rplac| (CAR |x|) 'RETURN) + (EXIT (|rplac| (CDR |x|) + (|optimizeFunctionDef,replaceThrowByReturn| + |u| |g|)))))) + (IF (ATOM |x|) (EXIT NIL)) + (|optimizeFunctionDef,replaceThrowByReturn| (CAR |x|) |g|) + (EXIT (|optimizeFunctionDef,replaceThrowByReturn| (CDR |x|) + |g|)))))) + (DEFUN |optimizeFunctionDef,replaceThrowByReturn| (|x| |g|) - (SEQ - (|optimizeFunctionDef,fn| |x| |g|) - (EXIT |x|))) + (SEQ (|optimizeFunctionDef,fn| |x| |g|) (EXIT |x|))) (DEFUN |optimizeFunctionDef,removeTopLevelCatch| (|body|) - (PROG (|ISTMP#1| |g| |ISTMP#2| |u|) - (RETURN - (SEQ - (IF - (AND - (PAIRP |body|) - (EQ (QCAR |body|) (QUOTE CATCH)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |body|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |g| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (EXIT - (|optimizeFunctionDef,removeTopLevelCatch| - (|optimizeFunctionDef,replaceThrowByReturn| |u| |g|)))) - (EXIT |body|))))) + (PROG (|ISTMP#1| |g| |ISTMP#2| |u|) + (RETURN + (SEQ (IF (AND (PAIRP |body|) (EQ (QCAR |body|) 'CATCH) + (PROGN + (SPADLET |ISTMP#1| (QCDR |body|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |g| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |u| (QCAR |ISTMP#2|)) + 'T)))))) + (EXIT (|optimizeFunctionDef,removeTopLevelCatch| + (|optimizeFunctionDef,replaceThrowByReturn| + |u| |g|)))) + (EXIT |body|))))) (DEFUN |optimizeFunctionDef| (|def|) - (PROG (|def'| |name| |slamOrLam| |args| |body| |body'|) - (RETURN - (PROGN - (COND - (|$reportOptimization| - (|sayBrightlyI| (|bright| (MAKESTRING "Original LISP code:"))) - (|pp| |def|))) - (SPADLET |def'| (|optimize| (COPY |def|))) - (COND - (|$reportOptimization| - (|sayBrightlyI| (|bright| (MAKESTRING "Optimized LISP code:"))) - (|pp| |def'|) - (|sayBrightlyI| (|bright| (MAKESTRING "Final LISP code:"))))) - (SPADLET |name| (CAR |def'|)) - (SPADLET |slamOrLam| (CAADR |def'|)) - (SPADLET |args| (CADADR |def'|)) - (SPADLET |body| (CAR (CDDADR |def'|))) - (SPADLET |body'| (|optimizeFunctionDef,removeTopLevelCatch| |body|)) - (CONS - |name| - (CONS (CONS |slamOrLam| (CONS |args| (CONS |body'| NIL))) NIL)))))) -; + (PROG (|def'| |name| |slamOrLam| |args| |body| |body'|) + (DECLARE (SPECIAL |$reportOptimization|)) + (RETURN + (PROGN + (COND + (|$reportOptimization| + (|sayBrightlyI| + (|bright| (MAKESTRING "Original LISP code:"))) + (|pp| |def|))) + (SPADLET |def'| (|optimize| (COPY |def|))) + (COND + (|$reportOptimization| + (|sayBrightlyI| + (|bright| (MAKESTRING "Optimized LISP code:"))) + (|pp| |def'|) + (|sayBrightlyI| + (|bright| (MAKESTRING "Final LISP code:"))))) + (SPADLET |name| (CAR |def'|)) + (SPADLET |slamOrLam| (CAADR |def'|)) + (SPADLET |args| (CADADR |def'|)) + (SPADLET |body| (CAR (CDDADR |def'|))) + (SPADLET |body'| + (|optimizeFunctionDef,removeTopLevelCatch| |body|)) + (CONS |name| + (CONS (CONS |slamOrLam| (CONS |args| (CONS |body'| NIL))) + NIL)))))) + ;optimize x == ; (opt x; x) where ; opt x == @@ -146,64 +140,62 @@ ; optimize rest x (DEFUN |optimize,opt| (|x|) - (PROG (|ISTMP#1| |ISTMP#2| |argl| |ISTMP#3| |body| |a| |y| |op|) - (RETURN - (SEQ - (IF (ATOM |x|) (EXIT NIL)) - (IF (BOOT-EQUAL (SPADLET |y| (CAR |x|)) (QUOTE QUOTE)) (EXIT NIL)) - (IF (BOOT-EQUAL |y| (QUOTE CLOSEDFN)) (EXIT NIL)) - (IF - (AND - (PAIRP |y|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |y|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE XLAM)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |argl| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |body| (QCAR |ISTMP#3|)) (QUOTE T)))))))) - (PROGN (SPADLET |a| (QCDR |y|)) (QUOTE T))) - (EXIT - (SEQ - (|optimize| (CDR |x|)) - (IF (BOOT-EQUAL |argl| (QUOTE |ignore|)) - (EXIT (RPLAC (CAR |x|) |body|))) - (IF (NULL (<= (LENGTH |argl|) (LENGTH |a|))) - (SEQ - (SAY (MAKESTRING "length mismatch in XLAM expression")) - (EXIT (PRETTYPRINT |y|))) NIL) - (EXIT - (RPLAC (CAR |x|) - (|optimize| - (|optXLAMCond| (SUBLIS (|pairList| |argl| |a|) |body|)))))))) - (IF (ATOM |y|) - (EXIT - (SEQ - (|optimize| (CDR |x|)) - (IF (BOOT-EQUAL |y| (QUOTE |true|)) - (EXIT (RPLAC (CAR |x|) (QUOTE (QUOTE (QUOTE T)))))) - (EXIT - (IF (BOOT-EQUAL |y| (QUOTE |false|)) (EXIT (RPLAC (CAR |x|) NIL))))))) - (IF (BOOT-EQUAL (CAR |y|) (QUOTE IF)) - (SEQ - (RPLAC (CAR |x|) (|optIF2COND| |y|)) - (EXIT (SPADLET |y| (CAR |x|)))) - NIL) - (IF (SPADLET |op| (GETL (|subrname| (CAR |y|)) (QUOTE OPTIMIZE))) - (EXIT - (SEQ - (|optimize| (CDR |x|)) - (EXIT (RPLAC (CAR |x|) (FUNCALL |op| (|optimize| (CAR |x|)))))))) - (RPLAC (CAR |x|) (|optimize| (CAR |x|))) (EXIT (|optimize| (CDR |x|))))))) + (PROG (|ISTMP#1| |ISTMP#2| |argl| |ISTMP#3| |body| |a| |y| |op|) + (RETURN + (SEQ (IF (ATOM |x|) (EXIT NIL)) + (IF (BOOT-EQUAL (SPADLET |y| (CAR |x|)) 'QUOTE) (EXIT NIL)) + (IF (BOOT-EQUAL |y| 'CLOSEDFN) (EXIT NIL)) + (IF (AND (PAIRP |y|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |y|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) 'XLAM) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |argl| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |body| + (QCAR |ISTMP#3|)) + 'T))))))) + (PROGN (SPADLET |a| (QCDR |y|)) 'T)) + (EXIT (SEQ (|optimize| (CDR |x|)) + (IF (BOOT-EQUAL |argl| '|ignore|) + (EXIT (RPLAC (CAR |x|) |body|))) + (IF (NULL (<= (LENGTH |argl|) (LENGTH |a|))) + (SEQ (SAY + (MAKESTRING + "length mismatch in XLAM expression")) + (EXIT (PRETTYPRINT |y|))) + NIL) + (EXIT (RPLAC (CAR |x|) + (|optimize| + (|optXLAMCond| + (SUBLIS + (|pairList| |argl| |a|) + |body|)))))))) + (IF (ATOM |y|) + (EXIT (SEQ (|optimize| (CDR |x|)) + (IF (BOOT-EQUAL |y| '|true|) + (EXIT (RPLAC (CAR |x|) '''T))) + (EXIT (IF (BOOT-EQUAL |y| '|false|) + (EXIT (RPLAC (CAR |x|) NIL))))))) + (IF (BOOT-EQUAL (CAR |y|) 'IF) + (SEQ (RPLAC (CAR |x|) (|optIF2COND| |y|)) + (EXIT (SPADLET |y| (CAR |x|)))) + NIL) + (IF (SPADLET |op| (GETL (|subrname| (CAR |y|)) 'OPTIMIZE)) + (EXIT (SEQ (|optimize| (CDR |x|)) + (EXIT (RPLAC (CAR |x|) + (FUNCALL |op| + (|optimize| (CAR |x|)))))))) + (RPLAC (CAR |x|) (|optimize| (CAR |x|))) + (EXIT (|optimize| (CDR |x|))))))) (DEFUN |optimize| (|x|) (PROGN (|optimize,opt| |x|) |x|)) @@ -214,12 +206,11 @@ ; nil (DEFUN |subrname| (|u|) - (COND - ((IDENTP |u|) |u|) - ((OR (COMPILED-FUNCTION-P |u|) (MBPIP |u|)) (BPINAME |u|)) - ((QUOTE T) NIL))) + (COND + ((IDENTP |u|) |u|) + ((OR (COMPILED-FUNCTION-P |u|) (MBPIP |u|)) (BPINAME |u|)) + ('T NIL))) -; ;optCatch (x is ["CATCH",g,a]) == ; $InteractiveMode => x ; atom a => a @@ -253,136 +244,136 @@ ; x (DEFUN |optCatch,changeThrowToExit| (|s| |g|) - (PROG (|ISTMP#1| |u|) - (RETURN - (SEQ - (IF (OR (ATOM |s|) (MEMQ (CAR |s|) (QUOTE (QUOTE SEQ REPEAT COLLECT)))) - (EXIT NIL)) - (IF - (AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE THROW)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |s|)) - (AND (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) |g|) - (PROGN (SPADLET |u| (QCDR |ISTMP#1|)) (QUOTE T))))) - (EXIT - (SEQ - (|rplac| (CAR |s|) (QUOTE EXIT)) - (EXIT (|rplac| (CDR |s|) |u|))))) - (|optCatch,changeThrowToExit| (CAR |s|) |g|) - (EXIT (|optCatch,changeThrowToExit| (CDR |s|) |g|)))))) + (PROG (|ISTMP#1| |u|) + (RETURN + (SEQ (IF (OR (ATOM |s|) + (MEMQ (CAR |s|) '(QUOTE SEQ REPEAT COLLECT))) + (EXIT NIL)) + (IF (AND (PAIRP |s|) (EQ (QCAR |s|) 'THROW) + (PROGN + (SPADLET |ISTMP#1| (QCDR |s|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) |g|) + (PROGN (SPADLET |u| (QCDR |ISTMP#1|)) 'T)))) + (EXIT (SEQ (|rplac| (CAR |s|) 'EXIT) + (EXIT (|rplac| (CDR |s|) |u|))))) + (|optCatch,changeThrowToExit| (CAR |s|) |g|) + (EXIT (|optCatch,changeThrowToExit| (CDR |s|) |g|)))))) (DEFUN |optCatch,hasNoThrows| (|a| |g|) - (PROG (|ISTMP#1|) - (RETURN - (SEQ - (IF - (AND (PAIRP |a|) - (EQ (QCAR |a|) (QUOTE THROW)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |a|)) - (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) |g|)))) - (EXIT NIL)) - (IF (ATOM |a|) (EXIT (QUOTE T))) - (EXIT - (AND - (|optCatch,hasNoThrows| (CAR |a|) |g|) - (|optCatch,hasNoThrows| (CDR |a|) |g|))))))) + (PROG (|ISTMP#1|) + (RETURN + (SEQ (IF (AND (PAIRP |a|) (EQ (QCAR |a|) 'THROW) + (PROGN + (SPADLET |ISTMP#1| (QCDR |a|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) |g|)))) + (EXIT NIL)) + (IF (ATOM |a|) (EXIT 'T)) + (EXIT (AND (|optCatch,hasNoThrows| (CAR |a|) |g|) + (|optCatch,hasNoThrows| (CDR |a|) |g|))))))) (DEFUN |optCatch,changeThrowToGo| (|s| |g|) - (PROG (|ISTMP#1| |ISTMP#2| |u|) - (RETURN - (SEQ - (IF (OR (ATOM |s|) (BOOT-EQUAL (CAR |s|) (QUOTE QUOTE))) (EXIT NIL)) - (IF - (AND (PAIRP |s|) - (EQ (QCAR |s|) (QUOTE THROW)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |s|)) - (AND (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) |g|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (EXIT - (SEQ - (|optCatch,changeThrowToGo| |u| |g|) - (|rplac| (CAR |s|) (QUOTE PROGN)) - (EXIT - (|rplac| (CDR |s|) - (CONS - (CONS (QUOTE LET) (CONS (CADR |g|) (CONS |u| NIL))) - (CONS (CONS (QUOTE GO) (CONS (CADR |g|) NIL)) NIL))))))) - (|optCatch,changeThrowToGo| (CAR |s|) |g|) - (EXIT (|optCatch,changeThrowToGo| (CDR |s|) |g|)))))) + (PROG (|ISTMP#1| |ISTMP#2| |u|) + (RETURN + (SEQ (IF (OR (ATOM |s|) (BOOT-EQUAL (CAR |s|) 'QUOTE)) + (EXIT NIL)) + (IF (AND (PAIRP |s|) (EQ (QCAR |s|) 'THROW) + (PROGN + (SPADLET |ISTMP#1| (QCDR |s|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) |g|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |u| (QCAR |ISTMP#2|)) + 'T)))))) + (EXIT (SEQ (|optCatch,changeThrowToGo| |u| |g|) + (|rplac| (CAR |s|) 'PROGN) + (EXIT (|rplac| (CDR |s|) + (CONS + (CONS 'LET + (CONS (CADR |g|) + (CONS |u| NIL))) + (CONS + (CONS 'GO + (CONS (CADR |g|) NIL)) + NIL))))))) + (|optCatch,changeThrowToGo| (CAR |s|) |g|) + (EXIT (|optCatch,changeThrowToGo| (CDR |s|) |g|)))))) (DEFUN |optCatch| (|x|) - (PROG (|g| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |u| |s| - |LETTMP#1| |y| |a|) - (RETURN - (SEQ - (PROGN - (COND ((EQ (CAR |x|) (QUOTE CATCH)) (CAR |x|))) - (SPADLET |g| (CADR |x|)) - (SPADLET |a| (CADDR |x|)) - (COND - (|$InteractiveMode| |x|) - ((ATOM |a|) |a|) - ((QUOTE T) - (COND - ((AND - (PAIRP |a|) - (EQ (QCAR |a|) (QUOTE SEQ)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |a|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCAR |ISTMP#3|) (QUOTE THROW)) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) - (AND - (PAIRP |ISTMP#4|) - (EQUAL (QCAR |ISTMP#4|) |g|) - (PROGN - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND - (PAIRP |ISTMP#5|) - (EQ (QCDR |ISTMP#5|) NIL) - (PROGN (SPADLET |u| (QCAR |ISTMP#5|)) (QUOTE T)))))))) - (PROGN (SPADLET |s| (QCDR |ISTMP#2|)) (QUOTE T)) - (PROGN (SPADLET |s| (NREVERSE |s|)) (QUOTE T))))) - (|optCatch,changeThrowToExit| |s| |g|) - (|rplac| (CDR |a|) - (APPEND |s| (CONS (CONS (QUOTE EXIT) (CONS |u| NIL)) NIL))) - (SPADLET |LETTMP#1| (|optimize| |x|)) - (COND ((EQ (CAR |LETTMP#1|) (QUOTE CATCH)) (CAR |LETTMP#1|))) - (SPADLET |y| (CADR |LETTMP#1|)) - (SPADLET |a| (CADDR |LETTMP#1|)) - |LETTMP#1|)) - (COND - ((|optCatch,hasNoThrows| |a| |g|) - (|rplac| (CAR |x|) (CAR |a|)) (|rplac| (CDR |x|) (CDR |a|))) - ((QUOTE T) - (|optCatch,changeThrowToGo| |a| |g|) - (|rplac| (CAR |x|) (QUOTE SEQ)) - (|rplac| (CDR |x|) - (CONS - (CONS (QUOTE EXIT) (CONS |a| NIL)) - (CONS - (CADR |g|) - (CONS (CONS (QUOTE EXIT) (CONS (CADR |g|) NIL)) NIL)))))) - |x|))))))) -; + (PROG (|g| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |ISTMP#5| |u| |s| + |LETTMP#1| |y| |a|) + (DECLARE (SPECIAL |$InteractiveMode|)) + (RETURN + (SEQ (PROGN + (COND ((EQ (CAR |x|) 'CATCH) (CAR |x|))) + (SPADLET |g| (CADR |x|)) + (SPADLET |a| (CADDR |x|)) + (COND + (|$InteractiveMode| |x|) + ((ATOM |a|) |a|) + ('T + (COND + ((AND (PAIRP |a|) (EQ (QCAR |a|) 'SEQ) + (PROGN + (SPADLET |ISTMP#1| (QCDR |a|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| + (REVERSE |ISTMP#1|)) + 'T) + (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCAR |ISTMP#3|) 'THROW) + (PROGN + (SPADLET |ISTMP#4| + (QCDR |ISTMP#3|)) + (AND (PAIRP |ISTMP#4|) + (EQUAL (QCAR |ISTMP#4|) |g|) + (PROGN + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (PAIRP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) NIL) + (PROGN + (SPADLET |u| + (QCAR |ISTMP#5|)) + 'T))))))) + (PROGN + (SPADLET |s| (QCDR |ISTMP#2|)) + 'T) + (PROGN (SPADLET |s| (NREVERSE |s|)) 'T)))) + (|optCatch,changeThrowToExit| |s| |g|) + (|rplac| (CDR |a|) + (APPEND |s| + (CONS (CONS 'EXIT (CONS |u| NIL)) + NIL))) + (SPADLET |LETTMP#1| (|optimize| |x|)) + (COND + ((EQ (CAR |LETTMP#1|) 'CATCH) (CAR |LETTMP#1|))) + (SPADLET |y| (CADR |LETTMP#1|)) + (SPADLET |a| (CADDR |LETTMP#1|)) |LETTMP#1|)) + (COND + ((|optCatch,hasNoThrows| |a| |g|) + (|rplac| (CAR |x|) (CAR |a|)) + (|rplac| (CDR |x|) (CDR |a|))) + ('T (|optCatch,changeThrowToGo| |a| |g|) + (|rplac| (CAR |x|) 'SEQ) + (|rplac| (CDR |x|) + (CONS (CONS 'EXIT (CONS |a| NIL)) + (CONS (CADR |g|) + (CONS + (CONS 'EXIT + (CONS (CADR |g|) NIL)) + NIL)))))) + |x|))))))) + ;optSPADCALL(form is ['SPADCALL,:argl]) == ; null $InteractiveMode => form ; -- last arg is function/env, but may be a form @@ -393,59 +384,56 @@ ; form (DEFUN |optSPADCALL| (|form|) - (PROG (|fun| |argl| |ISTMP#1| |dom| |ISTMP#2| |slot|) - (RETURN - (PROGN - (SPADLET |argl| (CDR |form|)) - (COND - ((NULL |$InteractiveMode|) |form|) - ((AND - (PAIRP |argl|) - (PROGN (SPADLET |ISTMP#1| (REVERSE |argl|)) (QUOTE T)) - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |fun| (QCAR |ISTMP#1|)) - (SPADLET |argl| (QCDR |ISTMP#1|)) - (QUOTE T)) - (PROGN (SPADLET |argl| (NREVERSE |argl|)) (QUOTE T))) - (COND - ((OR - (AND - (PAIRP |fun|) - (EQ (QCAR |fun|) (QUOTE ELT)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |fun|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |dom| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |slot| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (AND - (PAIRP |fun|) - (EQ (QCAR |fun|) (QUOTE LISPELT)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |fun|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |dom| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |slot| (QCAR |ISTMP#2|)) (QUOTE T)))))))) - (|optCall| - (CONS - (QUOTE |call|) - (CONS (CONS (QUOTE ELT) (CONS |dom| (CONS |slot| NIL))) |argl|)))) - ((QUOTE T) |form|))) - ((QUOTE T) |form|)))))) + (PROG (|fun| |argl| |ISTMP#1| |dom| |ISTMP#2| |slot|) + (DECLARE (SPECIAL |$InteractiveMode|)) + (RETURN + (PROGN + (SPADLET |argl| (CDR |form|)) + (COND + ((NULL |$InteractiveMode|) |form|) + ((AND (PAIRP |argl|) + (PROGN (SPADLET |ISTMP#1| (REVERSE |argl|)) 'T) + (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |fun| (QCAR |ISTMP#1|)) + (SPADLET |argl| (QCDR |ISTMP#1|)) + 'T) + (PROGN (SPADLET |argl| (NREVERSE |argl|)) 'T)) + (COND + ((OR (AND (PAIRP |fun|) (EQ (QCAR |fun|) 'ELT) + (PROGN + (SPADLET |ISTMP#1| (QCDR |fun|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |dom| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |slot| + (QCAR |ISTMP#2|)) + 'T)))))) + (AND (PAIRP |fun|) (EQ (QCAR |fun|) 'LISPELT) + (PROGN + (SPADLET |ISTMP#1| (QCDR |fun|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |dom| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |slot| + (QCAR |ISTMP#2|)) + 'T))))))) + (|optCall| + (CONS '|call| + (CONS (CONS 'ELT + (CONS |dom| (CONS |slot| NIL))) + |argl|)))) + ('T |form|))) + ('T |form|)))))) -; ;optCall (x is ["call",:u]) == ; -- destructively optimizes this new x ; x:= optimize [u] @@ -469,63 +457,55 @@ ; systemErrorHere '"optCall" (DEFUN |optCall| (|x|) - (PROG (|u| |LETTMP#1| |fn| |a| |name| |q| |ISTMP#1| R |ISTMP#2| |n| |w|) - (RETURN - (PROGN - (COND ((EQ (CAR |x|) (QUOTE |call|)) (CAR |x|))) - (SPADLET |u| (CDR |x|)) - (SPADLET |x| (|optimize| (CONS |u| NIL))) - (COND - ((ATOM (CAR |x|)) (CAR |x|)) - ((QUOTE T) - (SPADLET |LETTMP#1| (CAR |x|)) - (SPADLET |fn| (CAR |LETTMP#1|)) - (SPADLET |a| (CDR |LETTMP#1|)) - (COND - ((ATOM |fn|) (RPLAC (CDR |x|) |a|) (RPLAC (CAR |x|) |fn|)) - ((AND (PAIRP |fn|) (EQ (QCAR |fn|) (QUOTE PAC))) - (|optPackageCall| |x| |fn| |a|)) - ((AND - (PAIRP |fn|) - (EQ (QCAR |fn|) (QUOTE |applyFun|)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |fn|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |name| (QCAR |ISTMP#1|)) (QUOTE T))))) - (RPLAC (CAR |x|) (QUOTE SPADCALL)) - (RPLAC (CDR |x|) (APPEND |a| (CONS |name| NIL))) - |x|) - ((AND - (PAIRP |fn|) - (PROGN - (SPADLET |q| (QCAR |fn|)) - (SPADLET |ISTMP#1| (QCDR |fn|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET R (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |n| (QCAR |ISTMP#2|)) (QUOTE T)))))) - (MEMQ |q| (QUOTE (ELT QREFELT CONST)))) + (PROG (|u| |LETTMP#1| |fn| |a| |name| |q| |ISTMP#1| R |ISTMP#2| |n| + |w|) + (DECLARE (SPECIAL |$QuickCode| |$bootStrapMode|)) + (RETURN + (PROGN + (COND ((EQ (CAR |x|) '|call|) (CAR |x|))) + (SPADLET |u| (CDR |x|)) + (SPADLET |x| (|optimize| (CONS |u| NIL))) (COND - ((AND - (NULL |$bootStrapMode|) - (SPADLET |w| (|optCallSpecially| |q| |x| |n| R))) - |w|) - ((BOOT-EQUAL |q| (QUOTE CONST)) - (CONS (QUOTE |spadConstant|) (CONS R (CONS |n| NIL)))) - ((QUOTE T) - (RPLAC (CAR |x|) (QUOTE SPADCALL)) - (COND (|$QuickCode| (RPLACA |fn| (QUOTE QREFELT)))) - (RPLAC (CDR |x|) (APPEND |a| (CONS |fn| NIL))) |x|))) - ((QUOTE T) (|systemErrorHere| (MAKESTRING "optCall")))))))))) + ((ATOM (CAR |x|)) (CAR |x|)) + ('T (SPADLET |LETTMP#1| (CAR |x|)) + (SPADLET |fn| (CAR |LETTMP#1|)) + (SPADLET |a| (CDR |LETTMP#1|)) + (COND + ((ATOM |fn|) (RPLAC (CDR |x|) |a|) (RPLAC (CAR |x|) |fn|)) + ((AND (PAIRP |fn|) (EQ (QCAR |fn|) 'PAC)) + (|optPackageCall| |x| |fn| |a|)) + ((AND (PAIRP |fn|) (EQ (QCAR |fn|) '|applyFun|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |fn|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |name| (QCAR |ISTMP#1|)) 'T)))) + (RPLAC (CAR |x|) 'SPADCALL) + (RPLAC (CDR |x|) (APPEND |a| (CONS |name| NIL))) |x|) + ((AND (PAIRP |fn|) + (PROGN + (SPADLET |q| (QCAR |fn|)) + (SPADLET |ISTMP#1| (QCDR |fn|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET R (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |n| (QCAR |ISTMP#2|)) + 'T))))) + (MEMQ |q| '(ELT QREFELT CONST))) + (COND + ((AND (NULL |$bootStrapMode|) + (SPADLET |w| (|optCallSpecially| |q| |x| |n| R))) + |w|) + ((BOOT-EQUAL |q| 'CONST) + (CONS '|spadConstant| (CONS R (CONS |n| NIL)))) + ('T (RPLAC (CAR |x|) 'SPADCALL) + (COND (|$QuickCode| (RPLACA |fn| 'QREFELT))) + (RPLAC (CDR |x|) (APPEND |a| (CONS |fn| NIL))) |x|))) + ('T (|systemErrorHere| (MAKESTRING "optCall")))))))))) -; ;optCallSpecially(q,x,n,R) == ; y:= LASSOC(R,$specialCaseKeyList) => optSpecialCall(x,y,n) ; MEMQ(KAR R,$optimizableConstructorNames) => optSpecialCall(x,R,n) @@ -544,56 +524,55 @@ ; nil (DEFUN |optCallSpecially,lookup| (|a| |l|) - (PROG (|LETTMP#1| |ISTMP#1| |ISTMP#2| |l'|) - (RETURN - (SEQ - (IF (NULL |l|) (EXIT NIL)) - (PROGN - (SPADLET |LETTMP#1| |l|) - (SPADLET |l'| (CAR |LETTMP#1|)) - (SPADLET |l| (CDR |LETTMP#1|)) - |LETTMP#1|) - (IF - (AND (PAIRP |l'|) - (EQ (QCAR |l'|) (QUOTE LET)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |l'|)) - (AND - (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) |a|) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN (SPADLET |l'| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (EXIT |l'|)) - (EXIT (|optCallSpecially,lookup| |a| |l|)))))) + (PROG (|LETTMP#1| |ISTMP#1| |ISTMP#2| |l'|) + (RETURN + (SEQ (IF (NULL |l|) (EXIT NIL)) + (PROGN + (SPADLET |LETTMP#1| |l|) + (SPADLET |l'| (CAR |LETTMP#1|)) + (SPADLET |l| (CDR |LETTMP#1|)) + |LETTMP#1|) + (IF (AND (PAIRP |l'|) (EQ (QCAR |l'|) 'LET) + (PROGN + (SPADLET |ISTMP#1| (QCDR |l'|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) |a|) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |l'| (QCAR |ISTMP#2|)) + 'T)))))) + (EXIT |l'|)) + (EXIT (|optCallSpecially,lookup| |a| |l|)))))) (DEFUN |optCallSpecially| (|q| |x| |n| R) - (PROG (|LETTMP#1| |op| |y| |prop| |yy|) - (RETURN - (COND - ((SPADLET |y| (LASSOC R |$specialCaseKeyList|)) - (|optSpecialCall| |x| |y| |n|)) - ((MEMQ (KAR R) |$optimizableConstructorNames|) - (|optSpecialCall| |x| R |n|)) - ((AND - (SPADLET |y| (|get| R (QUOTE |value|) |$e|)) - (MEMQ (|opOf| (CAR |y|)) |$optimizableConstructorNames|)) - (|optSpecialCall| |x| (CAR |y|) |n|)) - ((AND - (SPADLET |y| (|optCallSpecially,lookup| R |$getDomainCode|)) - (PROGN - (SPADLET |LETTMP#1| |y|) - (SPADLET |op| (CAR |LETTMP#1|)) - (SPADLET |y| (CADR |LETTMP#1|)) - (SPADLET |prop| (CADDR |LETTMP#1|)) - |LETTMP#1|) - (SPADLET |yy| (LASSOC |y| |$specialCaseKeyList|))) - (|optSpecialCall| |x| (CONS |op| (CONS |yy| (CONS |prop| NIL))) |n|)) - ((QUOTE T) NIL))))) + (declare (ignore |q|)) + (PROG (|LETTMP#1| |op| |y| |prop| |yy|) + (DECLARE (SPECIAL |$specialCaseKeyList| |$getDomainCode| |$e| + |$optimizableConstructorNames|)) + (RETURN + (COND + ((SPADLET |y| (LASSOC R |$specialCaseKeyList|)) + (|optSpecialCall| |x| |y| |n|)) + ((MEMQ (KAR R) |$optimizableConstructorNames|) + (|optSpecialCall| |x| R |n|)) + ((AND (SPADLET |y| (|get| R '|value| |$e|)) + (MEMQ (|opOf| (CAR |y|)) |$optimizableConstructorNames|)) + (|optSpecialCall| |x| (CAR |y|) |n|)) + ((AND (SPADLET |y| + (|optCallSpecially,lookup| R |$getDomainCode|)) + (PROGN + (SPADLET |LETTMP#1| |y|) + (SPADLET |op| (CAR |LETTMP#1|)) + (SPADLET |y| (CADR |LETTMP#1|)) + (SPADLET |prop| (CADDR |LETTMP#1|)) + |LETTMP#1|) + (SPADLET |yy| (LASSOC |y| |$specialCaseKeyList|))) + (|optSpecialCall| |x| + (CONS |op| (CONS |yy| (CONS |prop| NIL))) |n|)) + ('T NIL))))) -; ;optCallEval u == ; u is ["List",:.] => List Integer() ; u is ["Vector",:.] => Vector Integer() @@ -603,20 +582,18 @@ ; eval u (DEFUN |optCallEval| (|u|) - (COND - ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |List|))) - (|List| (|Integer|))) - ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Vector|))) - (|Vector| (|Integer|))) - ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |PrimitiveArray|))) - (|PrimitiveArray| (|Integer|))) - ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |FactoredForm|))) - (|FactoredForm| (|Integer|))) - ((AND (PAIRP |u|) (EQ (QCAR |u|) (QUOTE |Matrix|))) - (|Matrix| (|Integer|))) - ((QUOTE T) - (|eval| |u|)))) -; + (COND + ((AND (PAIRP |u|) (EQ (QCAR |u|) '|List|)) (|List| (|Integer|))) + ((AND (PAIRP |u|) (EQ (QCAR |u|) '|Vector|)) + (|Vector| (|Integer|))) + ((AND (PAIRP |u|) (EQ (QCAR |u|) '|PrimitiveArray|)) + (|PrimitiveArray| (|Integer|))) + ((AND (PAIRP |u|) (EQ (QCAR |u|) '|FactoredForm|)) + (|FactoredForm| (|Integer|))) + ((AND (PAIRP |u|) (EQ (QCAR |u|) '|Matrix|)) + (|Matrix| (|Integer|))) + ('T (|eval| |u|)))) + ;optCons (x is ["CONS",a,b]) == ; a="NIL" => ; b='NIL => (rplac(first x,'QUOTE); rplac(rest x,['NIL,:'NIL]); x) @@ -629,49 +606,37 @@ ; x (DEFUN |optCons| (|x|) - (PROG (|a| |b| |ISTMP#1| |a'| |c|) - (RETURN - (PROGN - (COND ((EQ (CAR |x|) (QUOTE CONS)) (CAR |x|))) - (SPADLET |a| (CADR |x|)) - (SPADLET |b| (CADDR |x|)) - (COND - ((BOOT-EQUAL |a| (QUOTE NIL)) - (COND - ((BOOT-EQUAL |b| (QUOTE NIL)) - (|rplac| (CAR |x|) (QUOTE QUOTE)) - (|rplac| (CDR |x|) (CONS (QUOTE NIL) (QUOTE NIL))) - |x|) - ((AND (PAIRP |b|) - (EQ (QCAR |b|) (QUOTE QUOTE)) - (PROGN (SPADLET |c| (QCDR |b|)) (QUOTE T))) - (|rplac| (CAR |x|) (QUOTE QUOTE)) - (|rplac| (CDR |x|) (CONS (QUOTE NIL) |c|)) - |x|) - ((QUOTE T) |x|))) - ((AND (PAIRP |a|) - (EQ (QCAR |a|) (QUOTE QUOTE)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |a|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |a'| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((BOOT-EQUAL |b| (QUOTE NIL)) - (|rplac| (CAR |x|) (QUOTE QUOTE)) - (|rplac| (CDR |x|) (CONS |a'| (QUOTE NIL))) - |x|) - ((AND (PAIRP |b|) - (EQ (QCAR |b|) (QUOTE QUOTE)) - (PROGN (SPADLET |c| (QCDR |b|)) (QUOTE T))) - (|rplac| (CAR |x|) (QUOTE QUOTE)) - (|rplac| (CDR |x|) (CONS |a'| |c|)) - |x|) - ((QUOTE T) |x|))) - ((QUOTE T) |x|)))))) - -; + (PROG (|a| |b| |ISTMP#1| |a'| |c|) + (RETURN + (PROGN + (COND ((EQ (CAR |x|) 'CONS) (CAR |x|))) + (SPADLET |a| (CADR |x|)) + (SPADLET |b| (CADDR |x|)) + (COND + ((BOOT-EQUAL |a| 'NIL) + (COND + ((BOOT-EQUAL |b| 'NIL) (|rplac| (CAR |x|) 'QUOTE) + (|rplac| (CDR |x|) (CONS 'NIL 'NIL)) |x|) + ((AND (PAIRP |b|) (EQ (QCAR |b|) 'QUOTE) + (PROGN (SPADLET |c| (QCDR |b|)) 'T)) + (|rplac| (CAR |x|) 'QUOTE) + (|rplac| (CDR |x|) (CONS 'NIL |c|)) |x|) + ('T |x|))) + ((AND (PAIRP |a|) (EQ (QCAR |a|) 'QUOTE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |a|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |a'| (QCAR |ISTMP#1|)) 'T)))) + (COND + ((BOOT-EQUAL |b| 'NIL) (|rplac| (CAR |x|) 'QUOTE) + (|rplac| (CDR |x|) (CONS |a'| 'NIL)) |x|) + ((AND (PAIRP |b|) (EQ (QCAR |b|) 'QUOTE) + (PROGN (SPADLET |c| (QCDR |b|)) 'T)) + (|rplac| (CAR |x|) 'QUOTE) + (|rplac| (CDR |x|) (CONS |a'| |c|)) |x|) + ('T |x|))) + ('T |x|)))))) + ;optSpecialCall(x,y,n) == ; yval := optCallEval y ; CAAAR x="CONST" => @@ -693,80 +658,70 @@ ; x (DEFUN |optSpecialCall| (|x| |y| |n|) - (PROG (|yval| |args| |LETTMP#1| |fn| |a|) - (RETURN - (PROGN - (SPADLET |yval| (|optCallEval| |y|)) - (COND - ((BOOT-EQUAL (CAAAR |x|) (QUOTE CONST)) - (COND - ((BOOT-EQUAL (KAR (ELT |yval| |n|)) (|function| |Undef|)) - (|keyedSystemError| 'S2GE0016 - (CONS "optSpecialCall" (CONS "invalid constant" NIL)))) - ((QUOTE T) - (MKQ (ELT |yval| |n|))))) - ((SPADLET |fn| - (GETL - (|compileTimeBindingOf| (CAR (ELT |yval| |n|))) - (QUOTE |SPADreplace|))) - (|rplac| (CDR |x|) (CDAR |x|)) - (|rplac| (CAR |x|) |fn|) - (COND - ((AND (PAIRP |fn|) (EQ (QCAR |fn|) (QUOTE XLAM))) - (SPADLET |x| (CAR (|optimize| (CONS |x| NIL)))))) - (COND - ((AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE EQUAL)) - (PROGN (SPADLET |args| (QCDR |x|)) (QUOTE T))) - (RPLACW |x| (DEF-EQUAL |args|))) - ((QUOTE T) |x|))) - ((QUOTE T) - (SPADLET |LETTMP#1| (CAR |x|)) - (SPADLET |fn| (CAR |LETTMP#1|)) - (SPADLET |a| (CDR |LETTMP#1|)) - (RPLAC (CAR |x|) (QUOTE SPADCALL)) - (COND (|$QuickCode| (RPLACA |fn| (QUOTE QREFELT)))) - (RPLAC (CDR |x|) (APPEND |a| (CONS |fn| NIL))) - |x|)))))) + (PROG (|yval| |args| |LETTMP#1| |fn| |a|) + (DECLARE (SPECIAL |$QuickCode|)) + (RETURN + (PROGN + (SPADLET |yval| (|optCallEval| |y|)) + (COND + ((BOOT-EQUAL (CAAAR |x|) 'CONST) + (COND + ((BOOT-EQUAL (KAR (ELT |yval| |n|)) (|function| |Undef|)) + (|keyedSystemError| 'S2GE0016 + (CONS "optSpecialCall" (CONS "invalid constant" NIL)))) + ('T (MKQ (ELT |yval| |n|))))) + ((SPADLET |fn| + (GETL (|compileTimeBindingOf| + (CAR (ELT |yval| |n|))) + '|SPADreplace|)) + (|rplac| (CDR |x|) (CDAR |x|)) (|rplac| (CAR |x|) |fn|) + (COND + ((AND (PAIRP |fn|) (EQ (QCAR |fn|) 'XLAM)) + (SPADLET |x| (CAR (|optimize| (CONS |x| NIL)))))) + (COND + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'EQUAL) + (PROGN (SPADLET |args| (QCDR |x|)) 'T)) + (RPLACW |x| (DEF-EQUAL |args|))) + ('T |x|))) + ('T (SPADLET |LETTMP#1| (CAR |x|)) + (SPADLET |fn| (CAR |LETTMP#1|)) + (SPADLET |a| (CDR |LETTMP#1|)) (RPLAC (CAR |x|) 'SPADCALL) + (COND (|$QuickCode| (RPLACA |fn| 'QREFELT))) + (RPLAC (CDR |x|) (APPEND |a| (CONS |fn| NIL))) |x|)))))) -; ;compileTimeBindingOf u == ; NULL(name:= BPINAME u) => keyedSystemError("S2OO0001",[u]) ; name="Undef" => MOAN "optimiser found unknown function" ; name (DEFUN |compileTimeBindingOf| (|u|) - (PROG (|name|) - (RETURN - (COND - ((NULL (SPADLET |name| (BPINAME |u|))) - (|keyedSystemError| (QUOTE S2OO0001) (CONS |u| NIL))) - ((BOOT-EQUAL |name| (QUOTE |Undef|)) - (MOAN (MAKESTRING "optimiser found unknown function"))) - ((QUOTE T) - |name|))))) + (PROG (|name|) + (RETURN + (COND + ((NULL (SPADLET |name| (BPINAME |u|))) + (|keyedSystemError| 'S2OO0001 (CONS |u| NIL))) + ((BOOT-EQUAL |name| '|Undef|) + (MOAN (MAKESTRING "optimiser found unknown function"))) + ('T |name|))))) -; ;optMkRecord ["mkRecord",:u] == ; u is [x] => ["LIST",x] ; #u=2 => ["CONS",:u] ; ["VECTOR",:u] -(DEFUN |optMkRecord| (#0=#:G166580) - (PROG (|u| |x|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE |mkRecord|)) (CAR #0#))) - (SPADLET |u| (CDR #0#)) - (COND - ((AND (PAIRP |u|) - (EQ (QCDR |u|) NIL) - (PROGN (SPADLET |x| (QCAR |u|)) (QUOTE T))) - (CONS (QUOTE LIST) (CONS |x| NIL))) - ((EQL (|#| |u|) 2) (CONS (QUOTE CONS) |u|)) - ((QUOTE T) (CONS (QUOTE VECTOR) |u|))))))) +(DEFUN |optMkRecord| (G166580) + (PROG (|u| |x|) + (RETURN + (PROGN + (COND ((EQ (CAR G166580) '|mkRecord|) (CAR G166580))) + (SPADLET |u| (CDR G166580)) + (COND + ((AND (PAIRP |u|) (EQ (QCDR |u|) NIL) + (PROGN (SPADLET |x| (QCAR |u|)) 'T)) + (CONS 'LIST (CONS |x| NIL))) + ((EQL (|#| |u|) 2) (CONS 'CONS |u|)) + ('T (CONS 'VECTOR |u|))))))) -; ;optCond (x is ['COND,:l]) == ; if l is [a,[aa,b]] and TruthP aa and b is ["COND",:c] then ; RPLACD(rest x,c) @@ -790,223 +745,216 @@ ; x (DEFUN |optCond| (|x|) - (PROG (|aa| |b| |c| |p2'| |l| |p1'| |p1| |p2| |p3| |c3| |ISTMP#1| |a1| - |ISTMP#2| |c1| |ISTMP#3| |ISTMP#4| |a2| |ISTMP#5| |c2| |y'| |a|) - (RETURN - (SEQ - (PROGN - (SPADLET |l| (CDR |x|)) - (COND - ((AND - (PAIRP |l|) - (PROGN - (SPADLET |a| (QCAR |l|)) - (SPADLET |ISTMP#1| (QCDR |l|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |aa| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |b| (QCAR |ISTMP#3|)) (QUOTE T)))))))) - (|TruthP| |aa|) - (PAIRP |b|) - (EQ (QCAR |b|) (QUOTE COND)) - (PROGN (SPADLET |c| (QCDR |b|)) (QUOTE T))) - (RPLACD (CDR |x|) |c|))) - (COND - ((AND - (PAIRP |l|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |l|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |p1| (QCAR |ISTMP#1|)) - (SPADLET |c1| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (PROGN - (SPADLET |ISTMP#2| (QCDR |l|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |p2| (QCAR |ISTMP#3|)) - (SPADLET |c2| (QCDR |ISTMP#3|)) - (QUOTE T))))))) - (COND - ((OR - (AND (PAIRP |p1|) - (EQ (QCAR |p1|) (QUOTE NULL)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p1|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |p1'| (QCAR |ISTMP#1|)) (QUOTE T)))) - (BOOT-EQUAL |p1'| |p2|)) - (AND (PAIRP |p2|) - (EQ (QCAR |p2|) (QUOTE NULL)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p2|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |p2'| (QCAR |ISTMP#1|)) (QUOTE T)))) - (BOOT-EQUAL |p2'| |p1|))) - (SPADLET |l| - (CONS (CONS |p1| |c1|) (CONS (CONS (QUOTE (QUOTE T)) |c2|) NIL))) - (RPLACD |x| |l|))) - (COND - ((AND - (PAIRP |c1|) - (EQ (QCDR |c1|) NIL) - (EQUAL (QCAR |c1|) (QUOTE NIL)) - (BOOT-EQUAL |p2| (QUOTE (QUOTE T))) - (BOOT-EQUAL (CAR |c2|) (QUOTE (QUOTE T)))) - (COND - ((AND (PAIRP |p1|) - (EQ (QCAR |p1|) (QUOTE NULL)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |p1|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |p1'| (QCAR |ISTMP#1|)) (QUOTE T))))) - (RETURN |p1'|)) - ((QUOTE T) (RETURN (CONS (QUOTE NULL) (CONS |p1| NIL))))))))) - (COND - ((AND - (PAIRP |l|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |l|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |p1| (QCAR |ISTMP#1|)) - (SPADLET |c1| (QCDR |ISTMP#1|)) - (QUOTE T)))) - (PROGN - (SPADLET |ISTMP#2| (QCDR |l|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |p2| (QCAR |ISTMP#3|)) - (SPADLET |c2| (QCDR |ISTMP#3|)) - (QUOTE T)))) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (PROGN - (SPADLET |ISTMP#5| (QCAR |ISTMP#4|)) - (AND - (PAIRP |ISTMP#5|) - (PROGN - (SPADLET |p3| (QCAR |ISTMP#5|)) - (SPADLET |c3| (QCDR |ISTMP#5|)) - (QUOTE T)))))))) - (|TruthP| |p3|)) - (COND - ((|EqualBarGensym| |c1| |c3|) - (CONS - (QUOTE COND) - (CONS - (CONS - (CONS - (QUOTE OR) - (CONS |p1| (CONS (CONS (QUOTE NULL) (CONS |p2| NIL)) NIL))) - |c1|) - (CONS (CONS (CONS (QUOTE QUOTE) (CONS (QUOTE T) NIL)) |c2|) NIL)))) - ((|EqualBarGensym| |c1| |c2|) - (CONS - (QUOTE COND) - (CONS - (CONS (CONS (QUOTE OR) (CONS |p1| (CONS |p2| NIL))) |c1|) - (CONS (CONS (CONS (QUOTE QUOTE) (CONS (QUOTE T) NIL)) |c3|) NIL)))) - ((QUOTE T) |x|))) - ((QUOTE T) - (DO ((|y| |l| (CDR |y|))) - ((ATOM |y|) NIL) - (SEQ - (EXIT - (DO () - ((NULL - (AND - (PAIRP |y|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |y|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |a1| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |c1| (QCAR |ISTMP#2|)) (QUOTE T)))))) - (PROGN - (SPADLET |ISTMP#3| (QCDR |y|)) - (AND - (PAIRP |ISTMP#3|) - (PROGN - (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) - (AND - (PAIRP |ISTMP#4|) + (PROG (|aa| |b| |c| |p2'| |l| |p1'| |p1| |p2| |p3| |c3| |ISTMP#1| + |a1| |ISTMP#2| |c1| |ISTMP#3| |ISTMP#4| |a2| |ISTMP#5| + |c2| |y'| |a|) + (RETURN + (SEQ (PROGN + (SPADLET |l| (CDR |x|)) + (COND + ((AND (PAIRP |l|) (PROGN - (SPADLET |a2| (QCAR |ISTMP#4|)) - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND - (PAIRP |ISTMP#5|) - (EQ (QCDR |ISTMP#5|) NIL) - (PROGN (SPADLET |c2| (QCAR |ISTMP#5|)) (QUOTE T)))))) - (PROGN (SPADLET |y'| (QCDR |ISTMP#3|)) (QUOTE T)))) - (|EqualBarGensym| |c1| |c2|))) - NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |a| (CONS (QUOTE OR) (CONS |a1| (CONS |a2| NIL)))) - (RPLAC (CAR (CAR |y|)) |a|) - (RPLAC (CDR |y|) |y'|)))))))) - |x|))))))) -; + (SPADLET |a| (QCAR |l|)) + (SPADLET |ISTMP#1| (QCDR |l|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |aa| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |b| (QCAR |ISTMP#3|)) + 'T))))))) + (|TruthP| |aa|) (PAIRP |b|) (EQ (QCAR |b|) 'COND) + (PROGN (SPADLET |c| (QCDR |b|)) 'T)) + (RPLACD (CDR |x|) |c|))) + (COND + ((AND (PAIRP |l|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |l|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |p1| (QCAR |ISTMP#1|)) + (SPADLET |c1| (QCDR |ISTMP#1|)) + 'T))) + (PROGN + (SPADLET |ISTMP#2| (QCDR |l|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |p2| (QCAR |ISTMP#3|)) + (SPADLET |c2| (QCDR |ISTMP#3|)) + 'T)))))) + (COND + ((OR (AND (PAIRP |p1|) (EQ (QCAR |p1|) 'NULL) + (PROGN + (SPADLET |ISTMP#1| (QCDR |p1|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |p1'| (QCAR |ISTMP#1|)) + 'T))) + (BOOT-EQUAL |p1'| |p2|)) + (AND (PAIRP |p2|) (EQ (QCAR |p2|) 'NULL) + (PROGN + (SPADLET |ISTMP#1| (QCDR |p2|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |p2'| (QCAR |ISTMP#1|)) + 'T))) + (BOOT-EQUAL |p2'| |p1|))) + (SPADLET |l| + (CONS (CONS |p1| |c1|) + (CONS (CONS ''T |c2|) NIL))) + (RPLACD |x| |l|))) + (COND + ((AND (PAIRP |c1|) (EQ (QCDR |c1|) NIL) + (EQUAL (QCAR |c1|) 'NIL) (BOOT-EQUAL |p2| ''T) + (BOOT-EQUAL (CAR |c2|) ''T)) + (COND + ((AND (PAIRP |p1|) (EQ (QCAR |p1|) 'NULL) + (PROGN + (SPADLET |ISTMP#1| (QCDR |p1|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |p1'| (QCAR |ISTMP#1|)) + 'T)))) + (RETURN |p1'|)) + ('T (RETURN (CONS 'NULL (CONS |p1| NIL))))))))) + (COND + ((AND (PAIRP |l|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |l|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |p1| (QCAR |ISTMP#1|)) + (SPADLET |c1| (QCDR |ISTMP#1|)) + 'T))) + (PROGN + (SPADLET |ISTMP#2| (QCDR |l|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |p2| (QCAR |ISTMP#3|)) + (SPADLET |c2| (QCDR |ISTMP#3|)) + 'T))) + (PROGN + (SPADLET |ISTMP#4| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#4|) + (EQ (QCDR |ISTMP#4|) NIL) + (PROGN + (SPADLET |ISTMP#5| + (QCAR |ISTMP#4|)) + (AND (PAIRP |ISTMP#5|) + (PROGN + (SPADLET |p3| (QCAR |ISTMP#5|)) + (SPADLET |c3| (QCDR |ISTMP#5|)) + 'T))))))) + (|TruthP| |p3|)) + (COND + ((|EqualBarGensym| |c1| |c3|) + (CONS 'COND + (CONS (CONS (CONS 'OR + (CONS |p1| + (CONS + (CONS 'NULL (CONS |p2| NIL)) + NIL))) + |c1|) + (CONS (CONS (CONS 'QUOTE (CONS 'T NIL)) + |c2|) + NIL)))) + ((|EqualBarGensym| |c1| |c2|) + (CONS 'COND + (CONS (CONS (CONS 'OR + (CONS |p1| (CONS |p2| NIL))) + |c1|) + (CONS (CONS (CONS 'QUOTE (CONS 'T NIL)) + |c3|) + NIL)))) + ('T |x|))) + ('T + (DO ((|y| |l| (CDR |y|))) ((ATOM |y|) NIL) + (SEQ (EXIT (DO () + ((NULL (AND (PAIRP |y|) + (PROGN + (SPADLET |ISTMP#1| + (QCAR |y|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |a1| + (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) + NIL) + (PROGN + (SPADLET |c1| + (QCAR |ISTMP#2|)) + 'T))))) + (PROGN + (SPADLET |ISTMP#3| + (QCDR |y|)) + (AND (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |ISTMP#4| + (QCAR |ISTMP#3|)) + (AND (PAIRP |ISTMP#4|) + (PROGN + (SPADLET |a2| + (QCAR |ISTMP#4|)) + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (PAIRP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) + NIL) + (PROGN + (SPADLET |c2| + (QCAR |ISTMP#5|)) + 'T))))) + (PROGN + (SPADLET |y'| + (QCDR |ISTMP#3|)) + 'T))) + (|EqualBarGensym| |c1| |c2|))) + NIL) + (SEQ (EXIT + (PROGN + (SPADLET |a| + (CONS 'OR + (CONS |a1| (CONS |a2| NIL)))) + (RPLAC (CAR (CAR |y|)) |a|) + (RPLAC (CDR |y|) |y'|)))))))) + |x|))))))) + ;AssocBarGensym(key,l) == ; for x in l repeat ; PAIRP x => ; EqualBarGensym(key,CAR x) => return x (DEFUN |AssocBarGensym| (|key| |l|) - (PROG NIL - (RETURN - (SEQ - (DO ((#0=#:G166925 |l| (CDR #0#)) (|x| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((PAIRP |x|) - (EXIT - (COND - ((|EqualBarGensym| |key| (CAR |x|)) - (EXIT (RETURN |x|)))))))))))))) + (PROG () + (RETURN + (SEQ (DO ((G166925 |l| (CDR G166925)) (|x| NIL)) + ((OR (ATOM G166925) + (PROGN (SETQ |x| (CAR G166925)) NIL)) + NIL) + (SEQ (EXIT (COND + ((PAIRP |x|) + (EXIT (COND + ((|EqualBarGensym| |key| (CAR |x|)) + (EXIT (RETURN |x|)))))))))))))) -; ;EqualBarGensym(x,y) == ; $GensymAssoc: nil ; fn(x,y) where @@ -1022,51 +970,40 @@ ; fn(first x,first y) and fn(rest x,rest y) (DEFUN |EqualBarGensym,fn| (|x| |y|) - (PROG (|z| |g|) - (RETURN - (SEQ - (IF (BOOT-EQUAL |x| |y|) (EXIT (QUOTE T))) - (IF (AND (GENSYMP |x|) (GENSYMP |y|)) - (EXIT - (SEQ - (IF (SPADLET |z| (|assoc| |x| |$GensymAssoc|)) - (EXIT - (SEQ - (IF (BOOT-EQUAL |y| (CDR |z|)) (EXIT (QUOTE T))) - (EXIT NIL)))) - (SPADLET |$GensymAssoc| (CONS (CONS |x| |y|) |$GensymAssoc|)) - (EXIT (QUOTE T))))) - (IF (NULL |x|) - (EXIT - (AND - (AND - (PAIRP |y|) - (EQ (QCDR |y|) NIL) - (PROGN (SPADLET |g| (QCAR |y|)) (QUOTE T))) - (GENSYMP |g|)))) - (IF (NULL |y|) - (EXIT - (AND - (AND - (PAIRP |x|) - (EQ (QCDR |x|) NIL) - (PROGN (SPADLET |g| (QCAR |x|)) (QUOTE T))) - (GENSYMP |g|)))) - (IF (OR (ATOM |x|) (ATOM |y|)) (EXIT NIL)) - (EXIT - (AND - (|EqualBarGensym,fn| (CAR |x|) (CAR |y|)) - (|EqualBarGensym,fn| (CDR |x|) (CDR |y|)))))))) + (PROG (|z| |g|) + (DECLARE (SPECIAL |$GensymAssoc|)) + (RETURN + (SEQ (IF (BOOT-EQUAL |x| |y|) (EXIT 'T)) + (IF (AND (GENSYMP |x|) (GENSYMP |y|)) + (EXIT (SEQ (IF (SPADLET |z| + (|assoc| |x| |$GensymAssoc|)) + (EXIT (SEQ + (IF (BOOT-EQUAL |y| (CDR |z|)) + (EXIT 'T)) + (EXIT NIL)))) + (SPADLET |$GensymAssoc| + (CONS (CONS |x| |y|) |$GensymAssoc|)) + (EXIT 'T)))) + (IF (NULL |x|) + (EXIT (AND (AND (PAIRP |y|) (EQ (QCDR |y|) NIL) + (PROGN (SPADLET |g| (QCAR |y|)) 'T)) + (GENSYMP |g|)))) + (IF (NULL |y|) + (EXIT (AND (AND (PAIRP |x|) (EQ (QCDR |x|) NIL) + (PROGN (SPADLET |g| (QCAR |x|)) 'T)) + (GENSYMP |g|)))) + (IF (OR (ATOM |x|) (ATOM |y|)) (EXIT NIL)) + (EXIT (AND (|EqualBarGensym,fn| (CAR |x|) (CAR |y|)) + (|EqualBarGensym,fn| (CDR |x|) (CDR |y|)))))))) (DEFUN |EqualBarGensym| (|x| |y|) - (PROG (|$GensymAssoc|) - (DECLARE (SPECIAL |$GensymAssoc|)) - (RETURN - (PROGN - (SPADLET |$GensymAssoc| NIL) - (|EqualBarGensym,fn| |x| |y|))))) + (PROG (|$GensymAssoc|) + (DECLARE (SPECIAL |$GensymAssoc|)) + (RETURN + (PROGN + (SPADLET |$GensymAssoc| NIL) + (|EqualBarGensym,fn| |x| |y|))))) -; ;--Called early, to change IF to COND ; ;optIF2COND ["IF",a,b,c] == @@ -1076,37 +1013,35 @@ ; c is ["COND",:p] => ["COND",[a,b],:p] ; ["COND",[a,b],[$true,c]] -(DEFUN |optIF2COND| (#0=#:G166953) - (PROG (|a| |b| |c| |p|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE IF)) (CAR #0#))) - (SPADLET |a| (CADR #0#)) - (SPADLET |b| (CADDR #0#)) - (SPADLET |c| (CADDDR #0#)) - (COND - ((EQ |b| (QUOTE |noBranch|)) - (CONS - (QUOTE COND) - (CONS (CONS (CONS (QUOTE NULL) (CONS |a| NIL)) (CONS |c| NIL)) NIL))) - ((EQ |c| (QUOTE |noBranch|)) - (CONS (QUOTE COND) (CONS (CONS |a| (CONS |b| NIL)) NIL))) - ((AND (PAIRP |c|) (EQ (QCAR |c|) (QUOTE IF))) - (CONS - (QUOTE COND) - (CONS (CONS |a| (CONS |b| NIL)) (CDR (|optIF2COND| |c|))))) - ((AND (PAIRP |c|) - (EQ (QCAR |c|) (QUOTE COND)) - (PROGN (SPADLET |p| (QCDR |c|)) (QUOTE T))) - (CONS (QUOTE COND) (CONS (CONS |a| (CONS |b| NIL)) |p|))) - ((QUOTE T) - (CONS - (QUOTE COND) - (CONS - (CONS |a| (CONS |b| NIL)) - (CONS (CONS |$true| (CONS |c| NIL)) NIL))))))))) +(DEFUN |optIF2COND| (G166953) + (PROG (|a| |b| |c| |p|) + (DECLARE (SPECIAL |$true|)) + (RETURN + (PROGN + (COND ((EQ (CAR G166953) 'IF) (CAR G166953))) + (SPADLET |a| (CADR G166953)) + (SPADLET |b| (CADDR G166953)) + (SPADLET |c| (CADDDR G166953)) + (COND + ((EQ |b| '|noBranch|) + (CONS 'COND + (CONS (CONS (CONS 'NULL (CONS |a| NIL)) + (CONS |c| NIL)) + NIL))) + ((EQ |c| '|noBranch|) + (CONS 'COND (CONS (CONS |a| (CONS |b| NIL)) NIL))) + ((AND (PAIRP |c|) (EQ (QCAR |c|) 'IF)) + (CONS 'COND + (CONS (CONS |a| (CONS |b| NIL)) + (CDR (|optIF2COND| |c|))))) + ((AND (PAIRP |c|) (EQ (QCAR |c|) 'COND) + (PROGN (SPADLET |p| (QCDR |c|)) 'T)) + (CONS 'COND (CONS (CONS |a| (CONS |b| NIL)) |p|))) + ('T + (CONS 'COND + (CONS (CONS |a| (CONS |b| NIL)) + (CONS (CONS |$true| (CONS |c| NIL)) NIL))))))))) -; ;optXLAMCond x == ; x is ["COND",u:= [p,c],:l] => ; (optPredicateIfTrue p => c; ["COND",u,:optCONDtail l]) @@ -1116,63 +1051,54 @@ ; x (DEFUN |optXLAMCond| (|x|) - (PROG (|ISTMP#1| |ISTMP#2| |p| |ISTMP#3| |c| |u| |l|) - (RETURN - (COND - ((AND - (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE COND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |p| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |c| (QCAR |ISTMP#3|)) (QUOTE T)))))) - (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) (QUOTE T)) - (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) (QUOTE T))))) + (PROG (|ISTMP#1| |ISTMP#2| |p| |ISTMP#3| |c| |u| |l|) + (RETURN (COND - ((|optPredicateIfTrue| |p|) |c|) - ((QUOTE T) (CONS (QUOTE COND) (CONS |u| (|optCONDtail| |l|)))))) - ((ATOM |x|) |x|) - ((QUOTE T) - (RPLAC (CAR |x|) (|optXLAMCond| (CAR |x|))) - (RPLAC (CDR |x|) (|optXLAMCond| (CDR |x|))) - |x|))))) + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'COND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |p| (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |c| (QCAR |ISTMP#3|)) + 'T))))) + (PROGN (SPADLET |u| (QCAR |ISTMP#1|)) 'T) + (PROGN (SPADLET |l| (QCDR |ISTMP#1|)) 'T)))) + (COND + ((|optPredicateIfTrue| |p|) |c|) + ('T (CONS 'COND (CONS |u| (|optCONDtail| |l|)))))) + ((ATOM |x|) |x|) + ('T (RPLAC (CAR |x|) (|optXLAMCond| (CAR |x|))) + (RPLAC (CDR |x|) (|optXLAMCond| (CDR |x|))) |x|))))) -; ;optPredicateIfTrue p == ; p is ['QUOTE,:.] => true ; p is [fn,x] and MEMQ(fn,$BasicPredicates) and FUNCALL(fn,x) => true ; nil (DEFUN |optPredicateIfTrue| (|p|) - (PROG (|fn| |ISTMP#1| |x|) - (RETURN - (COND - ((AND (PAIRP |p|) (EQ (QCAR |p|) (QUOTE QUOTE))) (QUOTE T)) - ((AND - (PAIRP |p|) - (PROGN - (SPADLET |fn| (QCAR |p|)) - (SPADLET |ISTMP#1| (QCDR |p|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) (QUOTE T)))) - (MEMQ |fn| |$BasicPredicates|) (FUNCALL |fn| |x|)) - (QUOTE T)) - ((QUOTE T) NIL))))) + (PROG (|fn| |ISTMP#1| |x|) + (DECLARE (SPECIAL |$BasicPredicates|)) + (RETURN + (COND + ((AND (PAIRP |p|) (EQ (QCAR |p|) 'QUOTE)) 'T) + ((AND (PAIRP |p|) + (PROGN + (SPADLET |fn| (QCAR |p|)) + (SPADLET |ISTMP#1| (QCDR |p|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |x| (QCAR |ISTMP#1|)) 'T))) + (MEMQ |fn| |$BasicPredicates|) (FUNCALL |fn| |x|)) + 'T) + ('T NIL))))) -; ;optCONDtail l == ; null l => nil ; [frst:= [p,c],:l']:= l @@ -1181,24 +1107,23 @@ ; [frst,:optCONDtail l'] (DEFUN |optCONDtail| (|l|) - (PROG (|frst| |p| |c| |l'|) - (RETURN - (COND - ((NULL |l|) NIL) - ((QUOTE T) - (SPADLET |frst| (CAR |l|)) - (SPADLET |p| (CAAR |l|)) - (SPADLET |c| (CADAR |l|)) - (SPADLET |l'| (CDR |l|)) - (COND - ((|optPredicateIfTrue| |p|) (CONS (CONS |$true| (CONS |c| NIL)) NIL)) - ((NULL (CDR |l|)) - (CONS - |frst| - (CONS (CONS |$true| (CONS (CONS (QUOTE |CondError|) NIL) NIL)) NIL))) - ((QUOTE T) (CONS |frst| (|optCONDtail| |l'|))))))))) + (PROG (|frst| |p| |c| |l'|) + (DECLARE (SPECIAL |$true|)) + (RETURN + (COND + ((NULL |l|) NIL) + ('T (SPADLET |frst| (CAR |l|)) (SPADLET |p| (CAAR |l|)) + (SPADLET |c| (CADAR |l|)) (SPADLET |l'| (CDR |l|)) + (COND + ((|optPredicateIfTrue| |p|) + (CONS (CONS |$true| (CONS |c| NIL)) NIL)) + ((NULL (CDR |l|)) + (CONS |frst| + (CONS (CONS |$true| + (CONS (CONS '|CondError| NIL) NIL)) + NIL))) + ('T (CONS |frst| (|optCONDtail| |l'|))))))))) -; ;optSEQ ["SEQ",:l] == ; tryToRemoveSEQ SEQToCOND getRidOfTemps l where ; getRidOfTemps l == @@ -1220,146 +1145,149 @@ ; l (DEFUN |optSEQ,tryToRemoveSEQ| (|l|) - (PROG (|ISTMP#1| |ISTMP#2| |op| |ISTMP#3| |a|) - (RETURN - (SEQ - (IF - (AND - (AND - (PAIRP |l|) - (EQ (QCAR |l|) (QUOTE SEQ)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |l|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |op| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |a| (QCAR |ISTMP#3|)) (QUOTE T))))))))) - (MEMQ |op| (QUOTE (EXIT RETURN THROW)))) - (EXIT |a|)) - (EXIT |l|))))) + (PROG (|ISTMP#1| |ISTMP#2| |op| |ISTMP#3| |a|) + (RETURN + (SEQ (IF (AND (AND (PAIRP |l|) (EQ (QCAR |l|) 'SEQ) + (PROGN + (SPADLET |ISTMP#1| (QCDR |l|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |op| + (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |a| + (QCAR |ISTMP#3|)) + 'T)))))))) + (MEMQ |op| '(EXIT RETURN THROW))) + (EXIT |a|)) + (EXIT |l|))))) (DEFUN |optSEQ,SEQToCOND| (|l|) - (PROG (|ISTMP#1| |ISTMP#2| |a| |ISTMP#3| |ISTMP#4| |ISTMP#5| |b| |transform| - |before| |aft|) - (RETURN - (SEQ - (SPADLET |transform| - (PROG (#0=#:G167164) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G167170 |l| (CDR #1#)) (|x| NIL)) - ((OR - (ATOM #1#) - (PROGN (SETQ |x| (CAR #1#)) NIL) - (NULL - (AND - (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE COND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN - (SPADLET |ISTMP#4| (QCAR |ISTMP#3|)) - (AND - (PAIRP |ISTMP#4|) - (EQ (QCAR |ISTMP#4|) (QUOTE EXIT)) - (PROGN - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND - (PAIRP |ISTMP#5|) - (EQ (QCDR |ISTMP#5|) NIL) - (PROGN - (SPADLET |b| (QCAR |ISTMP#5|)) - (QUOTE T))))))))))))))) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (CONS |a| (CONS |b| NIL)) #0#)))))))) - (SPADLET |before| (TAKE (|#| |transform|) |l|)) - (SPADLET |aft| (|after| |l| |before|)) - (IF (NULL |before|) (EXIT (CONS (QUOTE SEQ) |aft|))) - (IF (NULL |aft|) - (EXIT - (CONS - (QUOTE COND) - (APPEND |transform| (CONS (QUOTE ((QUOTE T) (|conderr|))) NIL))))) - (EXIT - (IF - (QUOTE T) - (EXIT - (CONS - (QUOTE COND) - (APPEND - |transform| - (CONS - (CONS - (QUOTE (QUOTE T)) - (CONS (|optSEQ| (CONS (QUOTE SEQ) |aft|)) NIL)) - NIL)))))))))) + (PROG (|ISTMP#1| |ISTMP#2| |a| |ISTMP#3| |ISTMP#4| |ISTMP#5| |b| + |transform| |before| |aft|) + (RETURN + (SEQ (SPADLET |transform| + (PROG (G167164) + (SPADLET G167164 NIL) + (RETURN + (DO ((G167170 |l| (CDR G167170)) (|x| NIL)) + ((OR (ATOM G167170) + (PROGN + (SETQ |x| (CAR G167170)) + NIL) + (NULL (AND (PAIRP |x|) + (EQ (QCAR |x|) 'COND) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| + (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |a| + (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) + NIL) + (PROGN + (SPADLET |ISTMP#4| + (QCAR |ISTMP#3|)) + (AND + (PAIRP |ISTMP#4|) + (EQ + (QCAR |ISTMP#4|) + 'EXIT) + (PROGN + (SPADLET + |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND + (PAIRP + |ISTMP#5|) + (EQ + (QCDR + |ISTMP#5|) + NIL) + (PROGN + (SPADLET |b| + (QCAR + |ISTMP#5|)) + 'T)))))))))))))) + (NREVERSE0 G167164)) + (SEQ (EXIT (SETQ G167164 + (CONS (CONS |a| (CONS |b| NIL)) + G167164)))))))) + (SPADLET |before| (TAKE (|#| |transform|) |l|)) + (SPADLET |aft| (|after| |l| |before|)) + (IF (NULL |before|) (EXIT (CONS 'SEQ |aft|))) + (IF (NULL |aft|) + (EXIT (CONS 'COND + (APPEND |transform| + (CONS '('T (|conderr|)) NIL))))) + (EXIT (IF 'T + (EXIT (CONS 'COND + (APPEND |transform| + (CONS + (CONS ''T + (CONS + (|optSEQ| + (CONS 'SEQ |aft|)) + NIL)) + NIL)))))))))) (DEFUN |optSEQ,getRidOfTemps| (|l|) - (PROG (|ISTMP#1| |ISTMP#2| |g| |ISTMP#3| |x| |r|) - (RETURN - (SEQ - (IF (NULL |l|) (EXIT NIL)) - (IF - (AND - (AND - (AND - (PAIRP |l|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |l|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE LET)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |g| (QCAR |ISTMP#2|)) - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (PROGN (SPADLET |x| (QCAR |ISTMP#3|)) (QUOTE T)))))))) - (PROGN (SPADLET |r| (QCDR |l|)) (QUOTE T))) - (GENSYMP |g|)) - (> 2 (|numOfOccurencesOf| |g| |r|))) - (EXIT (|optSEQ,getRidOfTemps| (MSUBST |x| |g| |r|)))) - (IF (BOOT-EQUAL (CAR |l|) (QUOTE |/throwAway|)) - (EXIT (|optSEQ,getRidOfTemps| (CDR |l|)))) - (EXIT (CONS (CAR |l|) (|optSEQ,getRidOfTemps| (CDR |l|)))))))) - -(DEFUN |optSEQ| (#0=#:G167201) - (PROG (|l|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE SEQ)) (CAR #0#))) - (SPADLET |l| (CDR #0#)) - (|optSEQ,tryToRemoveSEQ| - (|optSEQ,SEQToCOND| (|optSEQ,getRidOfTemps| |l|))))))) + (PROG (|ISTMP#1| |ISTMP#2| |g| |ISTMP#3| |x| |r|) + (RETURN + (SEQ (IF (NULL |l|) (EXIT NIL)) + (IF (AND (AND (AND (PAIRP |l|) + (PROGN + (SPADLET |ISTMP#1| (QCAR |l|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) 'LET) + (PROGN + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |g| + (QCAR |ISTMP#2|)) + (SPADLET |ISTMP#3| + (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (PROGN + (SPADLET |x| + (QCAR |ISTMP#3|)) + 'T))))))) + (PROGN (SPADLET |r| (QCDR |l|)) 'T)) + (GENSYMP |g|)) + (> 2 (|numOfOccurencesOf| |g| |r|))) + (EXIT (|optSEQ,getRidOfTemps| (MSUBST |x| |g| |r|)))) + (IF (BOOT-EQUAL (CAR |l|) '|/throwAway|) + (EXIT (|optSEQ,getRidOfTemps| (CDR |l|)))) + (EXIT (CONS (CAR |l|) (|optSEQ,getRidOfTemps| (CDR |l|)))))))) + +(DEFUN |optSEQ| (G167201) + (PROG (|l|) + (RETURN + (PROGN + (COND ((EQ (CAR G167201) 'SEQ) (CAR G167201))) + (SPADLET |l| (CDR G167201)) + (|optSEQ,tryToRemoveSEQ| + (|optSEQ,SEQToCOND| (|optSEQ,getRidOfTemps| |l|))))))) -; ;optRECORDELT ["RECORDELT",name,ind,len] == ; len=1 => ; ind=0 => ["QCAR",name] @@ -1370,27 +1298,26 @@ ; keyedSystemError("S2OO0002",[ind]) ; ["QVELT",name,ind] -(DEFUN |optRECORDELT| (#0=#:G167217) - (PROG (|name| |ind| |len|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE RECORDELT)) (CAR #0#))) - (SPADLET |name| (CADR #0#)) - (SPADLET |ind| (CADDR #0#)) - (SPADLET |len| (CADDDR #0#)) - (COND - ((EQL |len| 1) - (COND - ((EQL |ind| 0) (CONS (QUOTE QCAR) (CONS |name| NIL))) - ((QUOTE T) (|keyedSystemError| (QUOTE S2OO0002) (CONS |ind| NIL))))) - ((EQL |len| 2) - (COND - ((EQL |ind| 0) (CONS (QUOTE QCAR) (CONS |name| NIL))) - ((EQL |ind| 1) (CONS (QUOTE QCDR) (CONS |name| NIL))) - ((QUOTE T) (|keyedSystemError| (QUOTE S2OO0002) (CONS |ind| NIL))))) - ((QUOTE T) (CONS (QUOTE QVELT) (CONS |name| (CONS |ind| NIL))))))))) +(DEFUN |optRECORDELT| (G167217) + (PROG (|name| |ind| |len|) + (RETURN + (PROGN + (COND ((EQ (CAR G167217) 'RECORDELT) (CAR G167217))) + (SPADLET |name| (CADR G167217)) + (SPADLET |ind| (CADDR G167217)) + (SPADLET |len| (CADDDR G167217)) + (COND + ((EQL |len| 1) + (COND + ((EQL |ind| 0) (CONS 'QCAR (CONS |name| NIL))) + ('T (|keyedSystemError| 'S2OO0002 (CONS |ind| NIL))))) + ((EQL |len| 2) + (COND + ((EQL |ind| 0) (CONS 'QCAR (CONS |name| NIL))) + ((EQL |ind| 1) (CONS 'QCDR (CONS |name| NIL))) + ('T (|keyedSystemError| 'S2OO0002 (CONS |ind| NIL))))) + ('T (CONS 'QVELT (CONS |name| (CONS |ind| NIL))))))))) -; ;optSETRECORDELT ["SETRECORDELT",name,ind,len,expr] == ; len=1 => ; ind=0 => ["PROGN",["RPLACA",name,expr],["QCAR",name]] @@ -1401,75 +1328,65 @@ ; keyedSystemError("S2OO0002",[ind]) ; ["QSETVELT",name,ind,expr] -(DEFUN |optSETRECORDELT| (#0=#:G167239) - (PROG (|name| |ind| |len| |expr|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE SETRECORDELT)) (CAR #0#))) - (SPADLET |name| (CADR #0#)) - (SPADLET |ind| (CADDR #0#)) - (SPADLET |len| (CADDDR #0#)) - (SPADLET |expr| (CAR (CDDDDR #0#))) - (COND - ((EQL |len| 1) - (COND - ((EQL |ind| 0) - (CONS - (QUOTE PROGN) - (CONS - (CONS (QUOTE RPLACA) (CONS |name| (CONS |expr| NIL))) - (CONS (CONS (QUOTE QCAR) (CONS |name| NIL)) NIL)))) - ((QUOTE T) (|keyedSystemError| (QUOTE S2OO0002) (CONS |ind| NIL))))) - ((EQL |len| 2) - (COND - ((EQL |ind| 0) - (CONS - (QUOTE PROGN) - (CONS - (CONS (QUOTE RPLACA) (CONS |name| (CONS |expr| NIL))) - (CONS (CONS (QUOTE QCAR) (CONS |name| NIL)) NIL)))) - ((EQL |ind| 1) - (CONS - (QUOTE PROGN) - (CONS - (CONS (QUOTE RPLACD) (CONS |name| (CONS |expr| NIL))) - (CONS (CONS (QUOTE QCDR) (CONS |name| NIL)) NIL)))) - ((QUOTE T) (|keyedSystemError| (QUOTE S2OO0002) (CONS |ind| NIL))))) - ((QUOTE T) - (CONS - (QUOTE QSETVELT) - (CONS |name| (CONS |ind| (CONS |expr| NIL)))))))))) +(DEFUN |optSETRECORDELT| (G167239) + (PROG (|name| |ind| |len| |expr|) + (RETURN + (PROGN + (COND ((EQ (CAR G167239) 'SETRECORDELT) (CAR G167239))) + (SPADLET |name| (CADR G167239)) + (SPADLET |ind| (CADDR G167239)) + (SPADLET |len| (CADDDR G167239)) + (SPADLET |expr| (CAR (CDDDDR G167239))) + (COND + ((EQL |len| 1) + (COND + ((EQL |ind| 0) + (CONS 'PROGN + (CONS (CONS 'RPLACA + (CONS |name| (CONS |expr| NIL))) + (CONS (CONS 'QCAR (CONS |name| NIL)) NIL)))) + ('T (|keyedSystemError| 'S2OO0002 (CONS |ind| NIL))))) + ((EQL |len| 2) + (COND + ((EQL |ind| 0) + (CONS 'PROGN + (CONS (CONS 'RPLACA + (CONS |name| (CONS |expr| NIL))) + (CONS (CONS 'QCAR (CONS |name| NIL)) NIL)))) + ((EQL |ind| 1) + (CONS 'PROGN + (CONS (CONS 'RPLACD + (CONS |name| (CONS |expr| NIL))) + (CONS (CONS 'QCDR (CONS |name| NIL)) NIL)))) + ('T (|keyedSystemError| 'S2OO0002 (CONS |ind| NIL))))) + ('T + (CONS 'QSETVELT + (CONS |name| (CONS |ind| (CONS |expr| NIL)))))))))) -; ;optRECORDCOPY ["RECORDCOPY",name,len] == ; len=1 => ["LIST",["CAR",name]] ; len=2 => ["CONS",["CAR",name],["CDR",name]] ; ["MOVEVEC",["MAKE_-VEC",len],name] -(DEFUN |optRECORDCOPY| (#0=#:G167262) - (PROG (|name| |len|) - (RETURN - (PROGN - (COND ((EQ (CAR #0#) (QUOTE RECORDCOPY)) (CAR #0#))) - (SPADLET |name| (CADR #0#)) - (SPADLET |len| (CADDR #0#)) - (COND - ((EQL |len| 1) - (CONS (QUOTE LIST) (CONS (CONS (QUOTE CAR) (CONS |name| NIL)) NIL))) - ((EQL |len| 2) - (CONS - (QUOTE CONS) - (CONS - (CONS (QUOTE CAR) (CONS |name| NIL)) - (CONS (CONS (QUOTE CDR) (CONS |name| NIL)) NIL)))) - ((QUOTE T) - (CONS - (QUOTE MOVEVEC) - (CONS - (CONS (QUOTE MAKE-VEC) (CONS |len| NIL)) - (CONS |name| NIL))))))))) +(DEFUN |optRECORDCOPY| (G167262) + (PROG (|name| |len|) + (RETURN + (PROGN + (COND ((EQ (CAR G167262) 'RECORDCOPY) (CAR G167262))) + (SPADLET |name| (CADR G167262)) + (SPADLET |len| (CADDR G167262)) + (COND + ((EQL |len| 1) + (CONS 'LIST (CONS (CONS 'CAR (CONS |name| NIL)) NIL))) + ((EQL |len| 2) + (CONS 'CONS + (CONS (CONS 'CAR (CONS |name| NIL)) + (CONS (CONS 'CDR (CONS |name| NIL)) NIL)))) + ('T + (CONS 'MOVEVEC + (CONS (CONS 'MAKE-VEC (CONS |len| NIL)) + (CONS |name| NIL))))))))) -; ;--mkRecordAccessFunction(ind,len) == ;-- stringOfDs:= $EmptyString ;-- for i in 0..(ind-1) do stringOfDs:= STRCONC(stringOfDs,PNAME "D") @@ -1479,14 +1396,11 @@ ; ;optSuchthat [.,:u] == ["SUCHTHAT",:u] -(DEFUN |optSuchthat| (#0=#:G167278) - (PROG (|u|) - (RETURN - (PROGN - (SPADLET |u| (CDR #0#)) - (CONS (QUOTE SUCHTHAT) |u|))))) +(DEFUN |optSuchthat| (G167278) + (PROG (|u|) + (RETURN + (PROGN (SPADLET |u| (CDR G167278)) (CONS 'SUCHTHAT |u|))))) -; ;optMINUS u == ; u is ['MINUS,v] => ; NUMBERP v => -v @@ -1494,24 +1408,17 @@ ; u (DEFUN |optMINUS| (|u|) - (PROG (|ISTMP#1| |v|) - (RETURN - (COND - ((AND - (PAIRP |u|) - (EQ (QCAR |u|) (QUOTE MINUS)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |v| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((NUMBERP |v|) (SPADDIFFERENCE |v|)) - ((QUOTE T) |u|))) - ((QUOTE T) |u|))))) + (PROG (|ISTMP#1| |v|) + (RETURN + (COND + ((AND (PAIRP |u|) (EQ (QCAR |u|) 'MINUS) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |v| (QCAR |ISTMP#1|)) 'T)))) + (COND ((NUMBERP |v|) (SPADDIFFERENCE |v|)) ('T |u|))) + ('T |u|))))) -; ;optQSMINUS u == ; u is ['QSMINUS,v] => ; NUMBERP v => -v @@ -1519,24 +1426,17 @@ ; u (DEFUN |optQSMINUS| (|u|) - (PROG (|ISTMP#1| |v|) - (RETURN - (COND - ((AND - (PAIRP |u|) - (EQ (QCAR |u|) (QUOTE QSMINUS)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |v| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((NUMBERP |v|) (SPADDIFFERENCE |v|)) - ((QUOTE T) |u|))) - ((QUOTE T) |u|))))) + (PROG (|ISTMP#1| |v|) + (RETURN + (COND + ((AND (PAIRP |u|) (EQ (QCAR |u|) 'QSMINUS) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |v| (QCAR |ISTMP#1|)) 'T)))) + (COND ((NUMBERP |v|) (SPADDIFFERENCE |v|)) ('T |u|))) + ('T |u|))))) -; ;opt_- u == ; u is ['_-,v] => ; NUMBERP v => -v @@ -1544,24 +1444,17 @@ ; u (DEFUN |opt-| (|u|) - (PROG (|ISTMP#1| |v|) - (RETURN - (COND - ((AND - (PAIRP |u|) - (EQ (QCAR |u|) (QUOTE -)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |v| (QCAR |ISTMP#1|)) (QUOTE T))))) - (COND - ((NUMBERP |v|) (SPADDIFFERENCE |v|)) - ((QUOTE T) |u|))) - ((QUOTE T) |u|))))) + (PROG (|ISTMP#1| |v|) + (RETURN + (COND + ((AND (PAIRP |u|) (EQ (QCAR |u|) '-) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |v| (QCAR |ISTMP#1|)) 'T)))) + (COND ((NUMBERP |v|) (SPADDIFFERENCE |v|)) ('T |u|))) + ('T |u|))))) -; ;optLESSP u == ; u is ['LESSP,a,b] => ; b = 0 => ['MINUSP,a] @@ -1569,29 +1462,23 @@ ; u (DEFUN |optLESSP| (|u|) - (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) - (RETURN - (COND - ((AND - (PAIRP |u|) - (EQ (QCAR |u|) (QUOTE LESSP)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |a| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((EQL |b| 0) (CONS (QUOTE MINUSP) (CONS |a| NIL))) - ((QUOTE T) (CONS (QUOTE GREATERP) (CONS |b| (CONS |a| NIL)))))) - ((QUOTE T) |u|))))) + (PROG (|ISTMP#1| |a| |ISTMP#2| |b|) + (RETURN + (COND + ((AND (PAIRP |u|) (EQ (QCAR |u|) 'LESSP) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |a| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |b| (QCAR |ISTMP#2|)) 'T)))))) + (COND + ((EQL |b| 0) (CONS 'MINUSP (CONS |a| NIL))) + ('T (CONS 'GREATERP (CONS |b| (CONS |a| NIL)))))) + ('T |u|))))) -; ;optEQ u == ; u is ['EQ,l,r] => ; NUMBERP l and NUMBERP r => ['QUOTE,EQ(l,r)] @@ -1600,30 +1487,24 @@ ; u (DEFUN |optEQ| (|u|) - (PROG (|ISTMP#1| |l| |ISTMP#2| |r|) - (RETURN - (COND - ((AND - (PAIRP |u|) - (EQ (QCAR |u|) (QUOTE EQ)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |u|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |l| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |r| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((AND (NUMBERP |l|) (NUMBERP |r|)) - (CONS (QUOTE QUOTE) (CONS (EQ |l| |r|) NIL))) - ((QUOTE T) |u|))) - ((QUOTE T) |u|))))) + (PROG (|ISTMP#1| |l| |ISTMP#2| |r|) + (RETURN + (COND + ((AND (PAIRP |u|) (EQ (QCAR |u|) 'EQ) + (PROGN + (SPADLET |ISTMP#1| (QCDR |u|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |l| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |r| (QCAR |ISTMP#2|)) 'T)))))) + (COND + ((AND (NUMBERP |l|) (NUMBERP |r|)) + (CONS 'QUOTE (CONS (EQ |l| |r|) NIL))) + ('T |u|))) + ('T |u|))))) -; ;EVALANDFILEACTQ ; ( ; for x in '( (call optCall) _ @@ -1647,22 +1528,16 @@ ; (EVALANDFILEACTQ - (REPEAT (IN |x| (QUOTE ((|call| |optCall|) - (SEQ |optSEQ|) - (EQ |optEQ|) - (MINUS |optMINUS|) - (QSMINUS |optQSMINUS|) - (- |opt-|) - (LESSP |optLESSP|) - (SPADCALL |optSPADCALL|) - (|\|| |optSuchthat|) - (CATCH |optCatch|) - (COND |optCond|) - (|mkRecord| |optMkRecord|) - (RECORDELT |optRECORDELT|) - (SETRECORDELT |optSETRECORDELT|) - (RECORDCOPY |optRECORDCOPY|)))) - (MAKEPROP (CAR |x|) (QUOTE OPTIMIZE) (CREATE-SBC (CADR |x|))))) + (REPEAT (IN |x| + '((|call| |optCall|) (SEQ |optSEQ|) (EQ |optEQ|) + (MINUS |optMINUS|) (QSMINUS |optQSMINUS|) (- |opt-|) + (LESSP |optLESSP|) (SPADCALL |optSPADCALL|) + (|\|| |optSuchthat|) (CATCH |optCatch|) + (COND |optCond|) (|mkRecord| |optMkRecord|) + (RECORDELT |optRECORDELT|) + (SETRECORDELT |optSETRECORDELT|) + (RECORDCOPY |optRECORDCOPY|))) + (MAKEPROP (CAR |x|) 'OPTIMIZE (CREATE-SBC (CADR |x|))))) @ \eject