diff --git a/changelog b/changelog index bc48699..f3b1038 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,5 @@ +20091007 tpd src/axiom-website/patches.html 20091007.06.tpd.patch +20091007 tpd src/interp/g-boot.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.05.tpd.patch 20091007 tpd src/interp/g-cndata.lisp cleanup 20091007 tpd src/axiom-website/patches.html 20091007.04.tpd.patch diff --git a/src/axiom-website/patches.html b/src/axiom-website/patches.html index 9f4264a..a54b5be 100644 --- a/src/axiom-website/patches.html +++ b/src/axiom-website/patches.html @@ -2131,5 +2131,7 @@ src/interp/g-opt.lisp cleanup
src/interp/g-error.lisp cleanup
20091007.05.tpd.patch src/interp/g-cndata.lisp cleanup
+20091007.06.tpd.patch +src/interp/g-boot.lisp cleanup
diff --git a/src/interp/g-boot.lisp.pamphlet b/src/interp/g-boot.lisp.pamphlet index 9a758c9..fc2e5ef 100644 --- a/src/interp/g-boot.lisp.pamphlet +++ b/src/interp/g-boot.lisp.pamphlet @@ -22,8 +22,8 @@ ; ;$LET := 'SPADLET -- LET is a standard macro in Common Lisp -(SPADLET $LET (QUOTE SPADLET)) -; +(SPADLET $LET 'SPADLET) + ;nakedEXIT? c == ; ATOM c => NIL ; [a,:d] := c @@ -37,23 +37,20 @@ ;;; *** |nakedEXIT?| REDEFINED (DEFUN |nakedEXIT?| (|c|) - (PROG (|a| |d|) - (RETURN - (SEQ - (COND - ((ATOM |c|) NIL) - ((QUOTE T) - (SPADLET |a| (CAR |c|)) - (SPADLET |d| (CDR |c|)) - (COND - ((IDENTP |a|) - (COND - ((BOOT-EQUAL |a| (QUOTE EXIT)) (QUOTE T)) - ((BOOT-EQUAL |a| (QUOTE QUOTE)) NIL) - ((MEMQ |a| (QUOTE (SEQ PROG LAMBDA MLAMBDA LAM))) NIL) - ((QUOTE T) (|nakedEXIT?| |d|)))) - ((QUOTE T) (OR (|nakedEXIT?| |a|) (|nakedEXIT?| |d|)))))))))) -; + (PROG (|a| |d|) + (RETURN + (SEQ (COND + ((ATOM |c|) NIL) + ('T (SPADLET |a| (CAR |c|)) (SPADLET |d| (CDR |c|)) + (COND + ((IDENTP |a|) + (COND + ((BOOT-EQUAL |a| 'EXIT) 'T) + ((BOOT-EQUAL |a| 'QUOTE) NIL) + ((MEMQ |a| '(SEQ PROG LAMBDA MLAMBDA LAM)) NIL) + ('T (|nakedEXIT?| |d|)))) + ('T (OR (|nakedEXIT?| |a|) (|nakedEXIT?| |d|)))))))))) + ;mergeableCOND x == ; ATOM(x) or x isnt ['COND,:cls] => NIL ; -- to be mergeable, every result must be an EXIT and the last @@ -70,43 +67,38 @@ ;;; *** |mergeableCOND| REDEFINED (DEFUN |mergeableCOND| (|x|) - (PROG (|LETTMP#1| |p| |r| |cls| |ISTMP#1| |ISTMP#2| |ok|) - (RETURN - (SEQ - (COND - ((OR (ATOM |x|) - (NULL - (AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE COND)) - (PROGN (SPADLET |cls| (QCDR |x|)) (QUOTE T))))) - NIL) - ((QUOTE T) - (SPADLET |ok| (QUOTE T)) - (DO () - ((NULL (AND |cls| |ok|)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |LETTMP#1| |cls|) - (SPADLET |p| (CAAR |LETTMP#1|)) - (SPADLET |r| (CDAR |LETTMP#1|)) - (SPADLET |cls| (CDR |LETTMP#1|)) - (COND - ((PAIRP (QCDR |r|)) (SPADLET |ok| NIL)) - ((NULL - (PROGN - (SPADLET |ISTMP#1| (CAR |r|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE EXIT)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL)))))) - (SPADLET |ok| NIL)) - ((AND (NULL |cls|) (ATOM |p|)) (SPADLET |ok| NIL)) - ((AND (NULL |cls|) (BOOT-EQUAL |p| (QUOTE (QUOTE T)))) - (SPADLET |ok| NIL))))))) - |ok|)))))) -; + (PROG (|LETTMP#1| |p| |r| |cls| |ISTMP#1| |ISTMP#2| |ok|) + (RETURN + (SEQ (COND + ((OR (ATOM |x|) + (NULL (AND (PAIRP |x|) (EQ (QCAR |x|) 'COND) + (PROGN (SPADLET |cls| (QCDR |x|)) 'T)))) + NIL) + ('T (SPADLET |ok| 'T) + (DO () ((NULL (AND |cls| |ok|)) NIL) + (SEQ (EXIT (PROGN + (SPADLET |LETTMP#1| |cls|) + (SPADLET |p| (CAAR |LETTMP#1|)) + (SPADLET |r| (CDAR |LETTMP#1|)) + (SPADLET |cls| (CDR |LETTMP#1|)) + (COND + ((PAIRP (QCDR |r|)) (SPADLET |ok| NIL)) + ((NULL (PROGN + (SPADLET |ISTMP#1| (CAR |r|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) 'EXIT) + (PROGN + (SPADLET |ISTMP#2| + (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL)))))) + (SPADLET |ok| NIL)) + ((AND (NULL |cls|) (ATOM |p|)) + (SPADLET |ok| NIL)) + ((AND (NULL |cls|) (BOOT-EQUAL |p| ''T)) + (SPADLET |ok| NIL))))))) + |ok|)))))) + ;mergeCONDsWithEXITs l == ; -- combines things like ; -- (COND (foo (EXIT a))) @@ -129,50 +121,43 @@ ;;; *** |mergeCONDsWithEXITs| REDEFINED (DEFUN |mergeCONDsWithEXITs| (|l|) - (PROG (|a| |am| |k| |c| |ISTMP#1| |b|) - (RETURN - (COND - ((NULL |l|) NIL) - ((ATOM |l|) |l|) - ((NULL (PAIRP (QCDR |l|))) |l|) - ((QUOTE T) - (SPADLET |a| (QCAR |l|)) - (COND - ((AND (PAIRP |a|) (EQ (QCAR |a|) (QUOTE COND))) - (SPADLET |a| (|flattenCOND| |a|)))) - (SPADLET |am| (|mergeableCOND| |a|)) - (COND - ((AND - (PROGN - (SPADLET |ISTMP#1| (CDR |l|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |b| (QCAR |ISTMP#1|)) - (SPADLET |k| (QCDR |ISTMP#1|)) - (QUOTE T)))) - |am| - (|mergeableCOND| |b|)) - (SPADLET |b| (|flattenCOND| |b|)) - (SPADLET |c| (CONS (QUOTE COND) (APPEND (QCDR |a|) (QCDR |b|)))) - (|mergeCONDsWithEXITs| (CONS (|flattenCOND| |c|) |k|))) - ((AND - (PROGN - (SPADLET |ISTMP#1| (CDR |l|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) (QUOTE T)))) - |am|) - (CONS - (|removeEXITFromCOND| - (|flattenCOND| - (CONS - (QUOTE COND) - (APPEND - (QCDR |a|) - (CONS (CONS (QUOTE (QUOTE T)) (CONS |b| NIL)) NIL))))) - NIL)) - ((QUOTE T) (CONS |a| (|mergeCONDsWithEXITs| (CDR |l|)))))))))) -; + (PROG (|a| |am| |k| |c| |ISTMP#1| |b|) + (RETURN + (COND + ((NULL |l|) NIL) + ((ATOM |l|) |l|) + ((NULL (PAIRP (QCDR |l|))) |l|) + ('T (SPADLET |a| (QCAR |l|)) + (COND + ((AND (PAIRP |a|) (EQ (QCAR |a|) 'COND)) + (SPADLET |a| (|flattenCOND| |a|)))) + (SPADLET |am| (|mergeableCOND| |a|)) + (COND + ((AND (PROGN + (SPADLET |ISTMP#1| (CDR |l|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |b| (QCAR |ISTMP#1|)) + (SPADLET |k| (QCDR |ISTMP#1|)) + 'T))) + |am| (|mergeableCOND| |b|)) + (SPADLET |b| (|flattenCOND| |b|)) + (SPADLET |c| (CONS 'COND (APPEND (QCDR |a|) (QCDR |b|)))) + (|mergeCONDsWithEXITs| (CONS (|flattenCOND| |c|) |k|))) + ((AND (PROGN + (SPADLET |ISTMP#1| (CDR |l|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |b| (QCAR |ISTMP#1|)) 'T))) + |am|) + (CONS (|removeEXITFromCOND| + (|flattenCOND| + (CONS 'COND + (APPEND (QCDR |a|) + (CONS (CONS ''T (CONS |b| NIL)) + NIL))))) + NIL)) + ('T (CONS |a| (|mergeCONDsWithEXITs| (CDR |l|)))))))))) + ;removeEXITFromCOND? c == ; -- c is '(COND ...) ; -- only can do it if every clause simply EXITs @@ -190,41 +175,42 @@ ;;; *** |removeEXITFromCOND?| REDEFINED (DEFUN |removeEXITFromCOND?| (|c|) - (PROG (|p| |r| |LETTMP#1| |r1| |f| |ISTMP#1| |r2| |ok|) - (RETURN - (SEQ - (PROGN - (SPADLET |ok| (QUOTE T)) - (SPADLET |c| (CDR |c|)) - (DO () - ((NULL (AND |ok| |c|)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |LETTMP#1| |c|) - (SPADLET |p| (CAAR |LETTMP#1|)) - (SPADLET |r| (CDAR |LETTMP#1|)) - (SPADLET |c| (CDR |LETTMP#1|)) - (COND - ((|nakedEXIT?| |p|) (SPADLET |ok| NIL)) - ((QUOTE T) - (SPADLET |LETTMP#1| (REVERSE |r|)) - (SPADLET |r1| (CAR |LETTMP#1|)) - (SPADLET |f| (NREVERSE (CDR |LETTMP#1|))) - (COND - ((|nakedEXIT?| |f|) (SPADLET |ok| NIL)) - ((NULL - (AND (PAIRP |r1|) - (EQ (QCAR |r1|) (QUOTE EXIT)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |r1|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |r2| (QCAR |ISTMP#1|)) (QUOTE T)))))) - (SPADLET |ok| NIL)) - ((|nakedEXIT?| |r2|) (SPADLET |ok| NIL))))))))) - |ok|))))) -; + (PROG (|p| |r| |LETTMP#1| |r1| |f| |ISTMP#1| |r2| |ok|) + (RETURN + (SEQ (PROGN + (SPADLET |ok| 'T) + (SPADLET |c| (CDR |c|)) + (DO () ((NULL (AND |ok| |c|)) NIL) + (SEQ (EXIT (PROGN + (SPADLET |LETTMP#1| |c|) + (SPADLET |p| (CAAR |LETTMP#1|)) + (SPADLET |r| (CDAR |LETTMP#1|)) + (SPADLET |c| (CDR |LETTMP#1|)) + (COND + ((|nakedEXIT?| |p|) (SPADLET |ok| NIL)) + ('T (SPADLET |LETTMP#1| (REVERSE |r|)) + (SPADLET |r1| (CAR |LETTMP#1|)) + (SPADLET |f| + (NREVERSE (CDR |LETTMP#1|))) + (COND + ((|nakedEXIT?| |f|) + (SPADLET |ok| NIL)) + ((NULL (AND (PAIRP |r1|) + (EQ (QCAR |r1|) 'EXIT) + (PROGN + (SPADLET |ISTMP#1| + (QCDR |r1|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |r2| + (QCAR |ISTMP#1|)) + 'T))))) + (SPADLET |ok| NIL)) + ((|nakedEXIT?| |r2|) + (SPADLET |ok| NIL))))))))) + |ok|))))) + ;removeEXITFromCOND c == ; -- c is '(COND ...) ; z := NIL @@ -246,36 +232,40 @@ ;;; *** |removeEXITFromCOND| REDEFINED (DEFUN |removeEXITFromCOND| (|c|) - (PROG (|cond| |cl'| |lastSE| |z|) - (RETURN - (SEQ - (PROGN - (SPADLET |z| NIL) - (DO ((#0=#:G1988 (CDR |c|) (CDR #0#)) (|cl| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |cl| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (COND - ((ATOM |cl|) (SPADLET |z| (CONS |cl| |z|))) - ((QUOTE T) - (SPADLET |cond| (QCAR |cl|)) - (COND - ((|length1?| |cl|) - (COND - ((AND (PAIRP |cond|) (EQCAR |cond| (QUOTE EXIT))) - (SPADLET |z| (CONS (QCDR |cond|) |z|))) - ((QUOTE T) (SPADLET |z| (CONS |cl| |z|))))) - ((QUOTE T) - (SPADLET |cl'| (REVERSE |cl|)) - (SPADLET |lastSE| (QCAR |cl'|)) - (COND - ((ATOM |lastSE|) (SPADLET |z| (CONS |cl| |z|))) - ((EQCAR |lastSE| (QUOTE EXIT)) - (SPADLET |z| - (CONS (REVERSE (CONS (CADR |lastSE|) (CDR |cl'|))) |z|))) - ((QUOTE T) (SPADLET |z| (CONS |cl| |z|))))))))))) - (CONS (QUOTE COND) (NREVERSE |z|))))))) -; + (PROG (|cond| |cl'| |lastSE| |z|) + (RETURN + (SEQ (PROGN + (SPADLET |z| NIL) + (DO ((G1988 (CDR |c|) (CDR G1988)) (|cl| NIL)) + ((OR (ATOM G1988) + (PROGN (SETQ |cl| (CAR G1988)) NIL)) + NIL) + (SEQ (EXIT (COND + ((ATOM |cl|) (SPADLET |z| (CONS |cl| |z|))) + ('T (SPADLET |cond| (QCAR |cl|)) + (COND + ((|length1?| |cl|) + (COND + ((AND (PAIRP |cond|) + (EQCAR |cond| 'EXIT)) + (SPADLET |z| + (CONS (QCDR |cond|) |z|))) + ('T (SPADLET |z| (CONS |cl| |z|))))) + ('T (SPADLET |cl'| (REVERSE |cl|)) + (SPADLET |lastSE| (QCAR |cl'|)) + (COND + ((ATOM |lastSE|) + (SPADLET |z| (CONS |cl| |z|))) + ((EQCAR |lastSE| 'EXIT) + (SPADLET |z| + (CONS + (REVERSE + (CONS (CADR |lastSE|) + (CDR |cl'|))) + |z|))) + ('T (SPADLET |z| (CONS |cl| |z|))))))))))) + (CONS 'COND (NREVERSE |z|))))))) + ;flattenCOND body == ; -- transforms nested COND clauses to flat ones, if possible ; body isnt ['COND,:.] => body @@ -284,10 +274,10 @@ ;;; *** |flattenCOND| REDEFINED (DEFUN |flattenCOND| (|body|) - (COND - ((NULL (AND (PAIRP |body|) (EQ (QCAR |body|) (QUOTE COND)))) |body|) - ((QUOTE T) (CONS (QUOTE COND) (|extractCONDClauses| |body|))))) -; + (COND + ((NULL (AND (PAIRP |body|) (EQ (QCAR |body|) 'COND))) |body|) + ('T (CONS 'COND (|extractCONDClauses| |body|))))) + ;extractCONDClauses clauses == ; -- extracts nested COND clauses into a flat structure ; clauses is ['COND, [pred1,:act1],:restClauses] => @@ -300,48 +290,48 @@ ;;; *** |extractCONDClauses| REDEFINED (DEFUN |extractCONDClauses| (|clauses|) - (PROG (|pred1| |restClauses| |acts| |act1| |ISTMP#1| |ISTMP#2| |restCond|) - (RETURN - (COND - ((AND (PAIRP |clauses|) - (EQ (QCAR |clauses|) (QUOTE COND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |clauses|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |pred1| (QCAR |ISTMP#2|)) - (SPADLET |act1| (QCDR |ISTMP#2|)) - (QUOTE T)))) - (PROGN (SPADLET |restClauses| (QCDR |ISTMP#1|)) (QUOTE T))))) + (PROG (|pred1| |restClauses| |acts| |act1| |ISTMP#1| |ISTMP#2| + |restCond|) + (RETURN (COND - ((AND (PAIRP |act1|) - (EQ (QCDR |act1|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |act1|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE PROGN)) - (PROGN (SPADLET |acts| (QCDR |ISTMP#1|)) (QUOTE T))))) - (SPADLET |act1| |acts|))) - (COND - ((AND (PAIRP |restClauses|) - (EQ (QCDR |restClauses|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |restClauses|)) - (AND (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) (QUOTE (QUOTE T))) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |restCond| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (CONS (CONS |pred1| |act1|) (|extractCONDClauses| |restCond|))) - ((QUOTE T) (CONS (CONS |pred1| |act1|) |restClauses|)))) - ((QUOTE T) (CONS (CONS (QUOTE (QUOTE T)) (CONS |clauses| NIL)) NIL)))))) -; + ((AND (PAIRP |clauses|) (EQ (QCAR |clauses|) 'COND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |clauses|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |pred1| (QCAR |ISTMP#2|)) + (SPADLET |act1| (QCDR |ISTMP#2|)) + 'T))) + (PROGN + (SPADLET |restClauses| (QCDR |ISTMP#1|)) + 'T)))) + (COND + ((AND (PAIRP |act1|) (EQ (QCDR |act1|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |act1|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) 'PROGN) + (PROGN (SPADLET |acts| (QCDR |ISTMP#1|)) 'T)))) + (SPADLET |act1| |acts|))) + (COND + ((AND (PAIRP |restClauses|) (EQ (QCDR |restClauses|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |restClauses|)) + (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) ''T) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |restCond| (QCAR |ISTMP#2|)) + 'T)))))) + (CONS (CONS |pred1| |act1|) + (|extractCONDClauses| |restCond|))) + ('T (CONS (CONS |pred1| |act1|) |restClauses|)))) + ('T (CONS (CONS ''T (CONS |clauses| NIL)) NIL)))))) + ;--% COND and IF ; ;bootIF c == @@ -353,31 +343,26 @@ ;;; *** |bootIF| REDEFINED (DEFUN |bootIF| (|c|) - (PROG (|ISTMP#1| |ISTMP#2| |p| |t| |e|) - (RETURN - (COND - ((AND (PAIRP |c|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |c|)) - (AND (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |p| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |t| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (|bootCOND| (CONS (QUOTE COND) (CONS (CONS |p| (CONS |t| NIL)) NIL)))) - ((QUOTE T) - (SPADLET |p| (CADR |c|)) - (SPADLET |t| (CADDR |c|)) - (SPADLET |e| (CADDDR |c|)) - (|bootCOND| - (CONS - (QUOTE COND) - (CONS - (CONS |p| (CONS |t| NIL)) - (CONS (CONS (QUOTE (QUOTE T)) (CONS |e| NIL)) NIL))))))))) -; + (PROG (|ISTMP#1| |ISTMP#2| |p| |t| |e|) + (RETURN + (COND + ((AND (PAIRP |c|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |c|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |p| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |t| (QCAR |ISTMP#2|)) 'T)))))) + (|bootCOND| (CONS 'COND (CONS (CONS |p| (CONS |t| NIL)) NIL)))) + ('T (SPADLET |p| (CADR |c|)) (SPADLET |t| (CADDR |c|)) + (SPADLET |e| (CADDDR |c|)) + (|bootCOND| + (CONS 'COND + (CONS (CONS |p| (CONS |t| NIL)) + (CONS (CONS ''T (CONS |e| NIL)) NIL))))))))) + ;bootCOND c == ; -- handles COND expressions: c is ['COND,:.] ; cls := CDR c @@ -402,82 +387,92 @@ ;;; *** |bootCOND| REDEFINED (DEFUN |bootCOND| (|c|) - (PROG (|cls| |LETTMP#1| |icls| |p| |r| |r1| |fcls| |ISTMP#1| |ISTMP#2| - |mcls| |ncls|) - (RETURN - (SEQ - (PROGN - (SPADLET |cls| (CDR |c|)) - (COND - ((NULL |cls|) NIL) - ((AND (PAIRP |cls|) - (PROGN - (SPADLET |ISTMP#1| (QCAR |cls|)) - (AND (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) (QUOTE (QUOTE T))) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |r| (QCAR |ISTMP#2|)) (QUOTE T))))))) - |r|) - ((QUOTE T) - (SPADLET |LETTMP#1| (REVERSE |cls|)) - (SPADLET |fcls| (CAR |LETTMP#1|)) - (SPADLET |icls| (NREVERSE (CDR |LETTMP#1|))) - (SPADLET |ncls| NIL) - (DO ((#0=#:G2144 |icls| (CDR #0#)) (|cl| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |cl| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |p| (CAR |cl|)) - (SPADLET |r| (CDR |cl|)) - (SPADLET |ncls| - (COND - ((AND (PAIRP |r|) - (EQ (QCDR |r|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |r|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE PROGN)) - (PROGN (SPADLET |r1| (QCDR |ISTMP#1|)) (QUOTE T))))) - (CONS (CONS |p| |r1|) |ncls|)) - ((QUOTE T) (CONS |cl| |ncls|)))))))) - (SPADLET |fcls| (|bootPushEXITintoCONDclause| |fcls|)) - (SPADLET |ncls| - (COND - ((AND (PAIRP |fcls|) - (EQUAL (QCAR |fcls|) (QUOTE (QUOTE T))) - (PROGN - (SPADLET |ISTMP#1| (QCDR |fcls|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE COND)) - (PROGN - (SPADLET |mcls| (QCDR |ISTMP#2|)) - (QUOTE T))))))) - (APPEND (REVERSE |mcls|) |ncls|)) - ((AND (PAIRP |fcls|) - (EQUAL (QCAR |fcls|) (QUOTE (QUOTE T))) - (PROGN - (SPADLET |ISTMP#1| (QCDR |fcls|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) + (PROG (|cls| |LETTMP#1| |icls| |p| |r| |r1| |fcls| |ISTMP#1| + |ISTMP#2| |mcls| |ncls|) + (RETURN + (SEQ (PROGN + (SPADLET |cls| (CDR |c|)) + (COND + ((NULL |cls|) NIL) + ((AND (PAIRP |cls|) (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE PROGN)) - (PROGN - (SPADLET |mcls| (QCDR |ISTMP#2|)) - (QUOTE T))))))) - (CONS (CONS (QUOTE (QUOTE T)) |mcls|) |ncls|)) - ((QUOTE T) (CONS |fcls| |ncls|)))) - (CONS (QUOTE COND) (REVERSE |ncls|))))))))) -; + (SPADLET |ISTMP#1| (QCAR |cls|)) + (AND (PAIRP |ISTMP#1|) + (EQUAL (QCAR |ISTMP#1|) ''T) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |r| (QCAR |ISTMP#2|)) + 'T)))))) + |r|) + ('T (SPADLET |LETTMP#1| (REVERSE |cls|)) + (SPADLET |fcls| (CAR |LETTMP#1|)) + (SPADLET |icls| (NREVERSE (CDR |LETTMP#1|))) + (SPADLET |ncls| NIL) + (DO ((G2144 |icls| (CDR G2144)) (|cl| NIL)) + ((OR (ATOM G2144) + (PROGN (SETQ |cl| (CAR G2144)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |p| (CAR |cl|)) + (SPADLET |r| (CDR |cl|)) + (SPADLET |ncls| + (COND + ((AND (PAIRP |r|) + (EQ (QCDR |r|) NIL) + (PROGN + (SPADLET |ISTMP#1| + (QCAR |r|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) + 'PROGN) + (PROGN + (SPADLET |r1| + (QCDR |ISTMP#1|)) + 'T)))) + (CONS (CONS |p| |r1|) + |ncls|)) + ('T (CONS |cl| |ncls|)))))))) + (SPADLET |fcls| (|bootPushEXITintoCONDclause| |fcls|)) + (SPADLET |ncls| + (COND + ((AND (PAIRP |fcls|) + (EQUAL (QCAR |fcls|) ''T) + (PROGN + (SPADLET |ISTMP#1| (QCDR |fcls|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| + (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) 'COND) + (PROGN + (SPADLET |mcls| + (QCDR |ISTMP#2|)) + 'T)))))) + (APPEND (REVERSE |mcls|) |ncls|)) + ((AND (PAIRP |fcls|) + (EQUAL (QCAR |fcls|) ''T) + (PROGN + (SPADLET |ISTMP#1| (QCDR |fcls|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| + (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) 'PROGN) + (PROGN + (SPADLET |mcls| + (QCDR |ISTMP#2|)) + 'T)))))) + (CONS (CONS ''T |mcls|) |ncls|)) + ('T (CONS |fcls| |ncls|)))) + (CONS 'COND (REVERSE |ncls|))))))))) + ;bootPushEXITintoCONDclause e == ; e isnt [''T,['EXIT,['COND,:cls]]] => e ; ncls := NIL @@ -492,70 +487,79 @@ ;;; *** |bootPushEXITintoCONDclause| REDEFINED (DEFUN |bootPushEXITintoCONDclause| (|e|) - (PROG (|ISTMP#2| |ISTMP#3| |ISTMP#4| |cls| |p| |r| |ISTMP#1| |r1| |ncls|) - (RETURN - (SEQ - (COND - ((NULL - (AND (PAIRP |e|) - (EQUAL (QCAR |e|) (QUOTE (QUOTE T))) - (PROGN - (SPADLET |ISTMP#1| (QCDR |e|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE EXIT)) - (PROGN - (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 COND)) - (PROGN - (SPADLET |cls| (QCDR |ISTMP#4|)) - (QUOTE T)))))))))))) - |e|) - ((QUOTE T) - (SPADLET |ncls| NIL) - (DO ((#0=#:G2220 |cls| (CDR #0#)) (|cl| NIL)) - ((OR (ATOM #0#) (PROGN (SETQ |cl| (CAR #0#)) NIL)) NIL) - (SEQ - (EXIT - (PROGN - (SPADLET |p| (CAR |cl|)) - (SPADLET |r| (CDR |cl|)) - (SPADLET |ncls| - (COND - ((AND (PAIRP |r|) - (EQ (QCDR |r|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |r|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE EXIT))))) - (CONS |cl| |ncls|)) - ((AND (PAIRP |r|) - (EQ (QCDR |r|) NIL) - (PROGN (SPADLET |r1| (QCAR |r|)) (QUOTE T))) - (CONS - (CONS |p| (CONS (CONS (QUOTE EXIT) (CONS |r1| NIL)) NIL)) - |ncls|)) - ((QUOTE T) - (CONS - (CONS - |p| - (CONS - (CONS - (QUOTE EXIT) - (CONS (|bootTran| (CONS (QUOTE PROGN) |r|)) NIL)) - NIL)) - |ncls|)))))))) - (CONS - (QUOTE (QUOTE T)) - (CONS (CONS (QUOTE COND) (NREVERSE |ncls|)) NIL)))))))) -; + (PROG (|ISTMP#2| |ISTMP#3| |ISTMP#4| |cls| |p| |r| |ISTMP#1| |r1| + |ncls|) + (RETURN + (SEQ (COND + ((NULL (AND (PAIRP |e|) (EQUAL (QCAR |e|) ''T) + (PROGN + (SPADLET |ISTMP#1| (QCDR |e|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) 'EXIT) + (PROGN + (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|) + 'COND) + (PROGN + (SPADLET |cls| + (QCDR |ISTMP#4|)) + 'T))))))))))) + |e|) + ('T (SPADLET |ncls| NIL) + (DO ((G2220 |cls| (CDR G2220)) (|cl| NIL)) + ((OR (ATOM G2220) + (PROGN (SETQ |cl| (CAR G2220)) NIL)) + NIL) + (SEQ (EXIT (PROGN + (SPADLET |p| (CAR |cl|)) + (SPADLET |r| (CDR |cl|)) + (SPADLET |ncls| + (COND + ((AND (PAIRP |r|) + (EQ (QCDR |r|) NIL) + (PROGN + (SPADLET |ISTMP#1| + (QCAR |r|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) + 'EXIT)))) + (CONS |cl| |ncls|)) + ((AND (PAIRP |r|) + (EQ (QCDR |r|) NIL) + (PROGN + (SPADLET |r1| (QCAR |r|)) + 'T)) + (CONS + (CONS |p| + (CONS + (CONS 'EXIT + (CONS |r1| NIL)) + NIL)) + |ncls|)) + ('T + (CONS + (CONS |p| + (CONS + (CONS 'EXIT + (CONS + (|bootTran| + (CONS 'PROGN |r|)) + NIL)) + NIL)) + |ncls|)))))))) + (CONS ''T (CONS (CONS 'COND (NREVERSE |ncls|)) NIL)))))))) + ;--% SEQ and PROGN ; ;-- following is a more sophisticated def than that in MACRO LISP @@ -576,88 +580,83 @@ ;;; *** |tryToRemoveSEQ| REDEFINED (DEFUN |tryToRemoveSEQ| (|e|) - (PROG (|cl| |cls| |ISTMP#1| |ISTMP#2| |p| |ISTMP#3| |ISTMP#4| |ISTMP#5| - |r| |ccls|) - (RETURN - (SEQ - (COND - ((NULL - (AND - (PAIRP |e|) - (EQ (QCAR |e|) (QUOTE SEQ)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |e|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |cl| (QCAR |ISTMP#1|)) - (SPADLET |cls| (QCDR |ISTMP#1|)) - (QUOTE T)))))) - NIL) - ((|nakedEXIT?| |cl|) - (COND - ((AND - (PAIRP |cl|) - (EQ (QCAR |cl|) (QUOTE COND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |cl|)) - (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 |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 |r| (QCAR |ISTMP#5|)) - (QUOTE T)))))))))) - (PROGN (SPADLET |ccls| (QCDR |ISTMP#1|)) (QUOTE T))))) - (COND - ((OR (|nakedEXIT?| |p|) (|nakedEXIT?| |r|)) |e|) - ((NULL |ccls|) - (|bootCOND| - (CONS - (QUOTE COND) - (CONS - (CONS |p| (CONS |r| NIL)) - (CONS - (CONS - (QUOTE (QUOTE T)) - (CONS (|bootSEQ| (CONS (QUOTE SEQ) |cls|)) NIL)) - NIL))))) - ((QUOTE T) - (|bootCOND| - (CONS - (QUOTE COND) - (CONS - (CONS |p| (CONS |r| NIL)) - (CONS - (CONS - (QUOTE (QUOTE T)) - (CONS - (|bootSEQ| - (CONS (QUOTE SEQ) (CONS (CONS (QUOTE COND) |ccls|) |cls|))) - NIL)) - NIL))))))) - ((QUOTE T) |e|))) - ((QUOTE T) - (|bootPROGN| - (CONS - (QUOTE PROGN) - (CONS |cl| (CONS (|bootSEQ| (CONS (QUOTE SEQ) |cls|)) NIL)))))))))) -; + (PROG (|cl| |cls| |ISTMP#1| |ISTMP#2| |p| |ISTMP#3| |ISTMP#4| + |ISTMP#5| |r| |ccls|) + (RETURN + (SEQ (COND + ((NULL (AND (PAIRP |e|) (EQ (QCAR |e|) 'SEQ) + (PROGN + (SPADLET |ISTMP#1| (QCDR |e|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |cl| (QCAR |ISTMP#1|)) + (SPADLET |cls| (QCDR |ISTMP#1|)) + 'T))))) + NIL) + ((|nakedEXIT?| |cl|) + (COND + ((AND (PAIRP |cl|) (EQ (QCAR |cl|) 'COND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |cl|)) + (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 |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 |r| + (QCAR |ISTMP#5|)) + 'T))))))))) + (PROGN + (SPADLET |ccls| (QCDR |ISTMP#1|)) + 'T)))) + (COND + ((OR (|nakedEXIT?| |p|) (|nakedEXIT?| |r|)) |e|) + ((NULL |ccls|) + (|bootCOND| + (CONS 'COND + (CONS (CONS |p| (CONS |r| NIL)) + (CONS + (CONS ''T + (CONS + (|bootSEQ| (CONS 'SEQ |cls|)) + NIL)) + NIL))))) + ('T + (|bootCOND| + (CONS 'COND + (CONS (CONS |p| (CONS |r| NIL)) + (CONS + (CONS ''T + (CONS + (|bootSEQ| + (CONS 'SEQ + (CONS (CONS 'COND |ccls|) + |cls|))) + NIL)) + NIL))))))) + ('T |e|))) + ('T + (|bootPROGN| + (CONS 'PROGN + (CONS |cl| + (CONS (|bootSEQ| (CONS 'SEQ |cls|)) NIL)))))))))) + ;bootAbsorbSEQsAndPROGNs e == ; -- assume e is a list from a SEQ or a PROGN ; ATOM e => e @@ -686,127 +685,145 @@ ;;; *** |bootAbsorbSEQsAndPROGNs,flatten| REDEFINED (DEFUN |bootAbsorbSEQsAndPROGNs,flatten| (|x|) - (PROG (|lpcl| |pcls| |ISTMP#1| |y| |ISTMP#2| |ISTMP#3| |ISTMP#4|) - (RETURN - (SEQ - (IF (NULL |x|) (EXIT NIL)) - (IF (IDENTP |x|) - (EXIT - (SEQ - (IF (MEMQ |x| |$labelsForGO|) (EXIT (CONS |x| NIL))) (EXIT NIL)))) - (IF (ATOM |x|) (EXIT NIL)) - (IF (AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE PROGN)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (AND (PAIRP |ISTMP#1|) - (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T))) - (AND (PAIRP |ISTMP#2|) + (PROG (|lpcl| |pcls| |ISTMP#1| |y| |ISTMP#2| |ISTMP#3| |ISTMP#4|) + (DECLARE (SPECIAL |$labelsForGO|)) + (RETURN + (SEQ (IF (NULL |x|) (EXIT NIL)) + (IF (IDENTP |x|) + (EXIT (SEQ (IF (MEMQ |x| |$labelsForGO|) + (EXIT (CONS |x| NIL))) + (EXIT NIL)))) + (IF (ATOM |x|) (EXIT NIL)) + (IF (AND (PAIRP |x|) (EQ (QCAR |x|) 'PROGN) (PROGN - (SPADLET |lpcl| (QCAR |ISTMP#2|)) - (SPADLET |pcls| (QCDR |ISTMP#2|)) - (QUOTE T))) - (PROGN (SPADLET |pcls| (NREVERSE |pcls|)) (QUOTE T))))) - (EXIT (SEQ (IF (ATOM |lpcl|) (EXIT |pcls|)) (EXIT (CDR |x|))))) - (IF - (AND (PAIRP |x|) - (EQ (QCAR |x|) (QUOTE COND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |x|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |y| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN - (SPADLET |ISTMP#3| (QCAR |ISTMP#2|)) - (AND (PAIRP |ISTMP#3|) - (EQUAL (QCAR |ISTMP#3|) (QUOTE (QUOTE T))) - (PROGN - (SPADLET |ISTMP#4| (QCDR |ISTMP#3|)) - (AND (PAIRP |ISTMP#4|) - (EQ (QCDR |ISTMP#4|) NIL) - (EQUAL (QCAR |ISTMP#4|) (QUOTE NIL))))))))))) - (EXIT (CONS (CONS (QUOTE COND) (CONS |y| NIL)) NIL))) - (EXIT (CONS |x| NIL)))))) + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| + (REVERSE |ISTMP#1|)) + 'T)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |lpcl| (QCAR |ISTMP#2|)) + (SPADLET |pcls| (QCDR |ISTMP#2|)) + 'T)) + (PROGN + (SPADLET |pcls| (NREVERSE |pcls|)) + 'T)))) + (EXIT (SEQ (IF (ATOM |lpcl|) (EXIT |pcls|)) + (EXIT (CDR |x|))))) + (IF (AND (PAIRP |x|) (EQ (QCAR |x|) 'COND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |x|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |y| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |ISTMP#3| + (QCAR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQUAL (QCAR |ISTMP#3|) ''T) + (PROGN + (SPADLET |ISTMP#4| + (QCDR |ISTMP#3|)) + (AND (PAIRP |ISTMP#4|) + (EQ (QCDR |ISTMP#4|) NIL) + (EQUAL (QCAR |ISTMP#4|) 'NIL)))))))))) + (EXIT (CONS (CONS 'COND (CONS |y| NIL)) NIL))) + (EXIT (CONS |x| NIL)))))) ;;; *** |bootAbsorbSEQsAndPROGNs| REDEFINED (DEFUN |bootAbsorbSEQsAndPROGNs| (|e|) - (PROG (|LETTMP#1| |cls| |g| |f| |lcl| |pcls| |ISTMP#1| |ISTMP#2| |pred| - |ISTMP#3| |ISTMP#4| |ISTMP#5| |h|) - (RETURN - (SEQ - (COND - ((ATOM |e|) |e|) - ((QUOTE T) - (SPADLET |LETTMP#1| (REVERSE |e|)) - (SPADLET |lcl| (CAR |LETTMP#1|)) - (SPADLET |cls| (NREVERSE (CDR |LETTMP#1|))) - (SPADLET |g| - (PROG (#0=#:G2445) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G2450 |cls| (CDR #1#)) (|f| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |f| (CAR #1#)) NIL)) #0#) - (SEQ - (EXIT - (SETQ #0# - (APPEND #0# (|bootAbsorbSEQsAndPROGNs,flatten| |f|))))))))) - (DO () - ((NULL - (AND (PAIRP |lcl|) - (EQ (QCAR |lcl|) (QUOTE EXIT)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lcl|)) - (AND (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |f| (QCAR |ISTMP#1|)) (QUOTE T)))))) - NIL) - (SEQ (EXIT (SPADLET |lcl| |f|)))) - (COND - ((AND (PAIRP |lcl|) (EQ (QCAR |lcl|) (QUOTE PROGN)) (PROGN (SPADLET |pcls| (QCDR |lcl|)) (QUOTE T))) - (APPEND |g| |pcls|)) - ((AND (PAIRP |lcl|) (EQ (QCAR |lcl|) (QUOTE COND)) (PROGN (SPADLET |ISTMP#1| (QCDR |lcl|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQUAL (QCAR |ISTMP#2|) (QUOTE (QUOTE T))) (PROGN (SPADLET |pcls| (QCDR |ISTMP#2|)) (QUOTE T))))))) - (APPEND |g| |pcls|)) - ((AND - (PAIRP |lcl|) - (EQ (QCAR |lcl|) (QUOTE COND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lcl|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |pred| (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 |h| (QCAR |ISTMP#5|)) (QUOTE T))))))))))))) - (APPEND |g| - (CONS - (CONS (QUOTE COND) (CONS (CONS |pred| (CONS |h| NIL)) NIL)) - NIL))) - ((QUOTE T) (APPEND |g| (CONS |lcl| NIL)))))))))) -; + (PROG (|LETTMP#1| |cls| |g| |f| |lcl| |pcls| |ISTMP#1| |ISTMP#2| + |pred| |ISTMP#3| |ISTMP#4| |ISTMP#5| |h|) + (RETURN + (SEQ (COND + ((ATOM |e|) |e|) + ('T (SPADLET |LETTMP#1| (REVERSE |e|)) + (SPADLET |lcl| (CAR |LETTMP#1|)) + (SPADLET |cls| (NREVERSE (CDR |LETTMP#1|))) + (SPADLET |g| + (PROG (G2445) + (SPADLET G2445 NIL) + (RETURN + (DO ((G2450 |cls| (CDR G2450)) + (|f| NIL)) + ((OR (ATOM G2450) + (PROGN + (SETQ |f| (CAR G2450)) + NIL)) + G2445) + (SEQ (EXIT (SETQ G2445 + (APPEND G2445 + (|bootAbsorbSEQsAndPROGNs,flatten| + |f|))))))))) + (DO () + ((NULL (AND (PAIRP |lcl|) (EQ (QCAR |lcl|) 'EXIT) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lcl|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |f| (QCAR |ISTMP#1|)) + 'T))))) + NIL) + (SEQ (EXIT (SPADLET |lcl| |f|)))) + (COND + ((AND (PAIRP |lcl|) (EQ (QCAR |lcl|) 'PROGN) + (PROGN (SPADLET |pcls| (QCDR |lcl|)) 'T)) + (APPEND |g| |pcls|)) + ((AND (PAIRP |lcl|) (EQ (QCAR |lcl|) 'COND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lcl|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQUAL (QCAR |ISTMP#2|) ''T) + (PROGN + (SPADLET |pcls| (QCDR |ISTMP#2|)) + 'T)))))) + (APPEND |g| |pcls|)) + ((AND (PAIRP |lcl|) (EQ (QCAR |lcl|) 'COND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lcl|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCDR |ISTMP#1|) NIL) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |pred| (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 |h| + (QCAR |ISTMP#5|)) + 'T)))))))))))) + (APPEND |g| + (CONS (CONS 'COND + (CONS (CONS |pred| (CONS |h| NIL)) + NIL)) + NIL))) + ('T (APPEND |g| (CONS |lcl| NIL)))))))))) + ;bootSEQ e == ; e := ['SEQ,:mergeCONDsWithEXITs bootAbsorbSEQsAndPROGNs CDR e] ; if e is [.,:cls,lcl] and IDENTP lcl and not MEMQ(lcl,$labelsForGO) then @@ -827,125 +844,131 @@ ;;; *** |bootSEQ| REDEFINED (DEFUN |bootSEQ| (|e|) - (PROG (|lcl| |cls| |body| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| |pred| - |ISTMP#5| |ISTMP#6| |ISTMP#7| |r1| |r2|) - (RETURN - (SEQ - (PROGN - (SPADLET |e| - (CONS - (QUOTE SEQ) - (|mergeCONDsWithEXITs| (|bootAbsorbSEQsAndPROGNs| (CDR |e|))))) - (COND - ((AND - (PAIRP |e|) - (PROGN - (SPADLET |ISTMP#1| (QCDR |e|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) (QUOTE T)) - (PAIRP |ISTMP#2|) - (PROGN - (SPADLET |lcl| (QCAR |ISTMP#2|)) - (SPADLET |cls| (QCDR |ISTMP#2|)) - (QUOTE T)) - (PROGN (SPADLET |cls| (NREVERSE |cls|)) (QUOTE T)))) - (IDENTP |lcl|) - (NULL (MEMQ |lcl| |$labelsForGO|))) - (SPADLET |e| - (CONS - (QUOTE SEQ) - (APPEND |cls| (CONS (CONS (QUOTE EXIT) (CONS |lcl| NIL)) NIL)))))) - (SPADLET |cls| (QCDR |e|)) - (COND - ((AND - (PAIRP |cls|) - (EQ (QCDR |cls|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |cls|)) - (AND (PAIRP |ISTMP#1|) (EQ (QCAR |ISTMP#1|) (QUOTE SEQ))))) - (|tryToRemoveSEQ| (QCAR |cls|))) - ((AND - (PAIRP |cls|) - (EQ (QCDR |cls|) NIL) - (PROGN - (SPADLET |ISTMP#1| (QCAR |cls|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCAR |ISTMP#1|) (QUOTE EXIT)) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |body| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((|nakedEXIT?| |body|) - (|bootTran| (CONS (QUOTE SEQ) (CONS |body| NIL)))) - ((QUOTE T) |body|))) - ((NULL - (OR - (|nakedEXIT?| |cls|) - (PROG (#0=#:G2596) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G2602 NIL #0#) (#2=#:G2603 |cls| (CDR #2#)) (|g| NIL)) - ((OR #1# (ATOM #2#) (PROGN (SETQ |g| (CAR #2#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (OR #0# (MEMQ |g| |$labelsForGO|)))))))))) - (|bootTran| (CONS (QUOTE PROGN) |cls|))) - ((AND - (PAIRP |e|) - (EQ (QCAR |e|) (QUOTE SEQ)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |e|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCAR |ISTMP#2|) (QUOTE COND)) - (PROGN - (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|) - (PROGN - (SPADLET |pred| (QCAR |ISTMP#4|)) - (SPADLET |ISTMP#5| (QCDR |ISTMP#4|)) - (AND - (PAIRP |ISTMP#5|) - (EQ (QCDR |ISTMP#5|) NIL) - (PROGN - (SPADLET |ISTMP#6| (QCAR |ISTMP#5|)) - (AND - (PAIRP |ISTMP#6|) - (EQ (QCAR |ISTMP#6|) (QUOTE EXIT)) - (PROGN - (SPADLET |ISTMP#7| (QCDR |ISTMP#6|)) - (AND - (PAIRP |ISTMP#7|) - (EQ (QCDR |ISTMP#7|) NIL) - (PROGN - (SPADLET |r1| (QCAR |ISTMP#7|)) - (QUOTE T)))))))))))))) - (PROGN (SPADLET |r2| (QCDR |ISTMP#1|)) (QUOTE T))))) - (COND - ((OR (|nakedEXIT?| |pred|) (|nakedEXIT?| |r1|) (|nakedEXIT?| |r2|)) - (|tryToRemoveSEQ| |e|)) - ((QUOTE T) - (|bootTran| - (CONS - (QUOTE COND) - (CONS - (CONS |pred| (CONS |r1| NIL)) - (CONS (CONS (QUOTE (QUOTE T)) |r2|) NIL))))))) - ((QUOTE T) (|tryToRemoveSEQ| |e|)))))))) -; + (PROG (|lcl| |cls| |body| |ISTMP#1| |ISTMP#2| |ISTMP#3| |ISTMP#4| + |pred| |ISTMP#5| |ISTMP#6| |ISTMP#7| |r1| |r2|) + (DECLARE (SPECIAL |$labelsForGO|)) + (RETURN + (SEQ (PROGN + (SPADLET |e| + (CONS 'SEQ + (|mergeCONDsWithEXITs| + (|bootAbsorbSEQsAndPROGNs| (CDR |e|))))) + (COND + ((AND (PAIRP |e|) + (PROGN + (SPADLET |ISTMP#1| (QCDR |e|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (REVERSE |ISTMP#1|)) + 'T) + (PAIRP |ISTMP#2|) + (PROGN + (SPADLET |lcl| (QCAR |ISTMP#2|)) + (SPADLET |cls| (QCDR |ISTMP#2|)) + 'T) + (PROGN + (SPADLET |cls| (NREVERSE |cls|)) + 'T))) + (IDENTP |lcl|) (NULL (MEMQ |lcl| |$labelsForGO|))) + (SPADLET |e| + (CONS 'SEQ + (APPEND |cls| + (CONS + (CONS 'EXIT (CONS |lcl| NIL)) + NIL)))))) + (SPADLET |cls| (QCDR |e|)) + (COND + ((AND (PAIRP |cls|) (EQ (QCDR |cls|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |cls|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) 'SEQ)))) + (|tryToRemoveSEQ| (QCAR |cls|))) + ((AND (PAIRP |cls|) (EQ (QCDR |cls|) NIL) + (PROGN + (SPADLET |ISTMP#1| (QCAR |cls|)) + (AND (PAIRP |ISTMP#1|) + (EQ (QCAR |ISTMP#1|) 'EXIT) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |body| (QCAR |ISTMP#2|)) + 'T)))))) + (COND + ((|nakedEXIT?| |body|) + (|bootTran| (CONS 'SEQ (CONS |body| NIL)))) + ('T |body|))) + ((NULL (OR (|nakedEXIT?| |cls|) + (PROG (G2596) + (SPADLET G2596 NIL) + (RETURN + (DO ((G2602 NIL G2596) + (G2603 |cls| (CDR G2603)) + (|g| NIL)) + ((OR G2602 (ATOM G2603) + (PROGN + (SETQ |g| (CAR G2603)) + NIL)) + G2596) + (SEQ (EXIT + (SETQ G2596 + (OR G2596 + (MEMQ |g| |$labelsForGO|)))))))))) + (|bootTran| (CONS 'PROGN |cls|))) + ((AND (PAIRP |e|) (EQ (QCAR |e|) 'SEQ) + (PROGN + (SPADLET |ISTMP#1| (QCDR |e|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |ISTMP#2| (QCAR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCAR |ISTMP#2|) 'COND) + (PROGN + (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|) + (PROGN + (SPADLET |pred| + (QCAR |ISTMP#4|)) + (SPADLET |ISTMP#5| + (QCDR |ISTMP#4|)) + (AND (PAIRP |ISTMP#5|) + (EQ (QCDR |ISTMP#5|) NIL) + (PROGN + (SPADLET |ISTMP#6| + (QCAR |ISTMP#5|)) + (AND (PAIRP |ISTMP#6|) + (EQ (QCAR |ISTMP#6|) + 'EXIT) + (PROGN + (SPADLET |ISTMP#7| + (QCDR |ISTMP#6|)) + (AND (PAIRP |ISTMP#7|) + (EQ (QCDR |ISTMP#7|) + NIL) + (PROGN + (SPADLET |r1| + (QCAR |ISTMP#7|)) + 'T))))))))))))) + (PROGN (SPADLET |r2| (QCDR |ISTMP#1|)) 'T)))) + (COND + ((OR (|nakedEXIT?| |pred|) (|nakedEXIT?| |r1|) + (|nakedEXIT?| |r2|)) + (|tryToRemoveSEQ| |e|)) + ('T + (|bootTran| + (CONS 'COND + (CONS (CONS |pred| (CONS |r1| NIL)) + (CONS (CONS ''T |r2|) NIL))))))) + ('T (|tryToRemoveSEQ| |e|)))))))) + ;bootPROGN e == ; e := ['PROGN,:bootAbsorbSEQsAndPROGNs CDR e] ; [.,:cls] := e @@ -956,20 +979,19 @@ ;;; *** |bootPROGN| REDEFINED (DEFUN |bootPROGN| (|e|) - (PROG (|cls| |body|) - (RETURN - (PROGN - (SPADLET |e| (CONS (QUOTE PROGN) (|bootAbsorbSEQsAndPROGNs| (CDR |e|)))) - (SPADLET |cls| (CDR |e|)) - (COND - ((NULL |cls|) NIL) - ((AND - (PAIRP |cls|) - (EQ (QCDR |cls|) NIL) - (PROGN (SPADLET |body| (QCAR |cls|)) (QUOTE T))) - |body|) - ((QUOTE T) |e|)))))) -; + (PROG (|cls| |body|) + (RETURN + (PROGN + (SPADLET |e| + (CONS 'PROGN (|bootAbsorbSEQsAndPROGNs| (CDR |e|)))) + (SPADLET |cls| (CDR |e|)) + (COND + ((NULL |cls|) NIL) + ((AND (PAIRP |cls|) (EQ (QCDR |cls|) NIL) + (PROGN (SPADLET |body| (QCAR |cls|)) 'T)) + |body|) + ('T |e|)))))) + ;--% LET ; ;defLetForm(lhs,rhs) == @@ -980,9 +1002,9 @@ ;;; *** |defLetForm| REDEFINED (DEFUN |defLetForm| (|lhs| |rhs|) - (CONS $LET (CONS |lhs| (CONS |rhs| NIL)))) + (DECLARE (SPECIAL $LET)) + (CONS $LET (CONS |lhs| (CONS |rhs| NIL)))) -; ;defLET1(lhs,rhs) == ; IDENTP lhs => defLetForm(lhs,rhs) ; lhs is ['FLUID,id] => defLetForm(lhs,rhs) @@ -1010,55 +1032,53 @@ ;;; *** |defLET1| REDEFINED (DEFUN |defLET1| (|lhs| |rhs|) - (PROG (|ISTMP#1| |id| |name| |l1| |l2| |g| |rhs'| |let'|) - (RETURN - (COND - ((IDENTP |lhs|) (|defLetForm| |lhs| |rhs|)) - ((AND - (PAIRP |lhs|) - (EQ (QCAR |lhs|) (QUOTE FLUID)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lhs|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN - (SPADLET |id| (QCAR |ISTMP#1|)) - (QUOTE T))))) - (|defLetForm| |lhs| |rhs|)) - ((AND - (IDENTP |rhs|) - (NULL (CONTAINED |rhs| |lhs|))) - (SPADLET |rhs'| (|defLET2| |lhs| |rhs|)) - (COND - ((EQCAR |rhs'| $LET) (MKPROGN (CONS |rhs'| (CONS |rhs| NIL)))) - ((EQCAR |rhs'| (QUOTE PROGN)) (APPEND |rhs'| (CONS |rhs| NIL))) - ((QUOTE T) - (COND ((IDENTP (CAR |rhs'|)) (SPADLET |rhs'| (CONS |rhs'| NIL)))) - (MKPROGN (APPEND |rhs'| (CONS |rhs| NIL)))))) - ((AND (PAIRP |rhs|) - (EQCAR |rhs| $LET) - (IDENTP (SPADLET |name| (CADR |rhs|)))) - (SPADLET |l1| (|defLET1| |name| (CADDR |rhs|))) - (SPADLET |l2| (|defLET1| |lhs| |name|)) - (COND - ((EQCAR |l2| (QUOTE PROGN)) (MKPROGN (CONS |l1| (CDR |l2|)))) - ((QUOTE T) - (COND ((IDENTP (CAR |l2|)) (SPADLET |l2| (CONS |l2| NIL)))) - (MKPROGN (CONS |l1| (APPEND |l2| (CONS |name| NIL))))))) - ((QUOTE T) - (SPADLET |g| - (INTERN - (STRCONC (MAKESTRING "LETTMP#") (STRINGIMAGE |$letGenVarCounter|)))) - (SPADLET |$letGenVarCounter| (PLUS |$letGenVarCounter| 1)) - (SPADLET |rhs'| (CONS $LET (CONS |g| (CONS |rhs| NIL)))) - (SPADLET |let'| (|defLET1| |lhs| |g|)) - (COND - ((EQCAR |let'| (QUOTE PROGN)) (MKPROGN (CONS |rhs'| (CDR |let'|)))) - ((QUOTE T) - (COND ((IDENTP (CAR |let'|)) (SPADLET |let'| (CONS |let'| NIL)))) - (MKPROGN (CONS |rhs'| (APPEND |let'| (CONS |g| NIL))))))))))) -; + (PROG (|ISTMP#1| |id| |name| |l1| |l2| |g| |rhs'| |let'|) + (DECLARE (SPECIAL $LET |$letGenVarCounter|)) + (RETURN + (COND + ((IDENTP |lhs|) (|defLetForm| |lhs| |rhs|)) + ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) 'FLUID) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lhs|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |id| (QCAR |ISTMP#1|)) 'T)))) + (|defLetForm| |lhs| |rhs|)) + ((AND (IDENTP |rhs|) (NULL (CONTAINED |rhs| |lhs|))) + (SPADLET |rhs'| (|defLET2| |lhs| |rhs|)) + (COND + ((EQCAR |rhs'| $LET) + (MKPROGN (CONS |rhs'| (CONS |rhs| NIL)))) + ((EQCAR |rhs'| 'PROGN) (APPEND |rhs'| (CONS |rhs| NIL))) + ('T + (COND + ((IDENTP (CAR |rhs'|)) + (SPADLET |rhs'| (CONS |rhs'| NIL)))) + (MKPROGN (APPEND |rhs'| (CONS |rhs| NIL)))))) + ((AND (PAIRP |rhs|) (EQCAR |rhs| $LET) + (IDENTP (SPADLET |name| (CADR |rhs|)))) + (SPADLET |l1| (|defLET1| |name| (CADDR |rhs|))) + (SPADLET |l2| (|defLET1| |lhs| |name|)) + (COND + ((EQCAR |l2| 'PROGN) (MKPROGN (CONS |l1| (CDR |l2|)))) + ('T + (COND + ((IDENTP (CAR |l2|)) (SPADLET |l2| (CONS |l2| NIL)))) + (MKPROGN (CONS |l1| (APPEND |l2| (CONS |name| NIL))))))) + ('T + (SPADLET |g| + (INTERN (STRCONC (MAKESTRING "LETTMP#") + (STRINGIMAGE |$letGenVarCounter|)))) + (SPADLET |$letGenVarCounter| (PLUS |$letGenVarCounter| 1)) + (SPADLET |rhs'| (CONS $LET (CONS |g| (CONS |rhs| NIL)))) + (SPADLET |let'| (|defLET1| |lhs| |g|)) + (COND + ((EQCAR |let'| 'PROGN) (MKPROGN (CONS |rhs'| (CDR |let'|)))) + ('T + (COND + ((IDENTP (CAR |let'|)) + (SPADLET |let'| (CONS |let'| NIL)))) + (MKPROGN (CONS |rhs'| (APPEND |let'| (CONS |g| NIL))))))))))) + ;defLET2(lhs,rhs) == ; IDENTP lhs => defLetForm(lhs,rhs) ; NULL lhs => NIL @@ -1103,160 +1123,137 @@ ;;; *** |defLET2| REDEFINED (DEFUN |defLET2| (|lhs| |rhs|) - (PROG (|id| |a| |b| |l1| |var2| |patrev| |rev| |g| |l2| |ISTMP#2| |ISTMP#3| - |val1| |ISTMP#1| |var1| |isPred|) - (RETURN - (COND - ((IDENTP |lhs|) (|defLetForm| |lhs| |rhs|)) - ((NULL |lhs|) NIL) - ((AND - (PAIRP |lhs|) - (EQ (QCAR |lhs|) (QUOTE FLUID)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lhs|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |id| (QCAR |ISTMP#1|)) (QUOTE T))))) - (|defLetForm| |lhs| |rhs|)) - ((AND - (PAIRP |lhs|) - (EQUAL (QCAR |lhs|) $LET) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lhs|)) - (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))))))) - (SPADLET |a| (|defLET2| |a| |rhs|)) - (COND - ((NULL (SPADLET |b| (|defLET2| |b| |rhs|))) |a|) - ((ATOM |b|) (CONS |a| (CONS |b| NIL))) - ((PAIRP (QCAR |b|)) (CONS |a| |b|)) - ((QUOTE T) (CONS |a| (CONS |b| NIL))))) - ((AND (PAIRP |lhs|) - (EQ (QCAR |lhs|) (QUOTE CONS)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lhs|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |var1| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |var2| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (COND - ((OR - (BOOT-EQUAL |var1| (INTERN "." "BOOT")) - (AND (PAIRP |var1|) (EQCAR |var1| (QUOTE QUOTE)))) - (|defLET2| |var2| (|addCARorCDR| (QUOTE CDR) |rhs|))) - ((QUOTE T) - (SPADLET |l1| (|defLET2| |var1| (|addCARorCDR| (QUOTE CAR) |rhs|))) - (COND - ((MEMQ |var2| (QUOTE (NIL |.|))) |l1|) - ((QUOTE T) + (PROG (|id| |a| |b| |l1| |var2| |patrev| |rev| |g| |l2| |ISTMP#2| + |ISTMP#3| |val1| |ISTMP#1| |var1| |isPred|) + (DECLARE (SPECIAL |$inDefIS| $LET |$letGenVarCounter|)) + (RETURN + (COND + ((IDENTP |lhs|) (|defLetForm| |lhs| |rhs|)) + ((NULL |lhs|) NIL) + ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) 'FLUID) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lhs|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |id| (QCAR |ISTMP#1|)) 'T)))) + (|defLetForm| |lhs| |rhs|)) + ((AND (PAIRP |lhs|) (EQUAL (QCAR |lhs|) $LET) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lhs|)) + (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)))))) + (SPADLET |a| (|defLET2| |a| |rhs|)) (COND - ((AND (PAIRP |l1|) (ATOM (CAR |l1|))) - (SPADLET |l1| (CONS |l1| NIL)))) + ((NULL (SPADLET |b| (|defLET2| |b| |rhs|))) |a|) + ((ATOM |b|) (CONS |a| (CONS |b| NIL))) + ((PAIRP (QCAR |b|)) (CONS |a| |b|)) + ('T (CONS |a| (CONS |b| NIL))))) + ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) 'CONS) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lhs|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |var1| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |var2| (QCAR |ISTMP#2|)) + 'T)))))) (COND - ((IDENTP |var2|) - (APPEND |l1| - (CONS - (|defLetForm| |var2| (|addCARorCDR| (QUOTE CDR) |rhs|)) - NIL))) - ((QUOTE T) - (SPADLET |l2| (|defLET2| |var2| (|addCARorCDR| (QUOTE CDR) |rhs|))) - (COND - ((AND (PAIRP |l2|) (ATOM (CAR |l2|))) - (SPADLET |l2| (CONS |l2| NIL)))) - (APPEND |l1| |l2|)))))))) - ((AND - (PAIRP |lhs|) - (EQ (QCAR |lhs|) (QUOTE APPEND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lhs|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |var1| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (PROGN (SPADLET |var2| (QCAR |ISTMP#2|)) (QUOTE T))))))) - (SPADLET |patrev| (|defISReverse| |var2| |var1|)) - (SPADLET |rev| (CONS (QUOTE REVERSE) (CONS |rhs| NIL))) - (SPADLET |g| - (INTERN - (STRCONC (MAKESTRING "LETTMP#") (STRINGIMAGE |$letGenVarCounter|)))) - (SPADLET |$letGenVarCounter| (PLUS |$letGenVarCounter| 1)) - (SPADLET |l2| (|defLET2| |patrev| |g|)) - (COND - ((AND (PAIRP |l2|) (ATOM (CAR |l2|))) (SPADLET |l2| (CONS |l2| NIL)))) - (COND - ((BOOT-EQUAL |var1| (INTERN "." "BOOT")) - (CONS (CONS $LET (CONS |g| (CONS |rev| NIL))) |l2|)) - ((PROGN - (SPADLET |ISTMP#1| (|last| |l2|)) - (AND - (PAIRP |ISTMP#1|) - (EQUAL (QCAR |ISTMP#1|) $LET) - (PROGN - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQUAL (QCAR |ISTMP#2|) |var1|) - (PROGN - (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) - (AND - (PAIRP |ISTMP#3|) - (EQ (QCDR |ISTMP#3|) NIL) - (PROGN (SPADLET |val1| (QCAR |ISTMP#3|)) (QUOTE T)))))))) - (CONS - (CONS $LET (CONS |g| (CONS |rev| NIL))) - (APPEND - (REVERSE (CDR (REVERSE |l2|))) - (CONS - (|defLetForm| |var1| (CONS (QUOTE NREVERSE) (CONS |val1| NIL))) - NIL)))) - ((QUOTE T) - (CONS - (CONS $LET (CONS |g| (CONS |rev| NIL))) - (APPEND - |l2| - (CONS - (|defLetForm| |var1| (CONS (QUOTE NREVERSE) (CONS |var1| NIL))) - NIL)))))) - ((AND - (PAIRP |lhs|) - (EQ (QCAR |lhs|) (QUOTE EQUAL)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |lhs|)) - (AND - (PAIRP |ISTMP#1|) - (EQ (QCDR |ISTMP#1|) NIL) - (PROGN (SPADLET |var1| (QCAR |ISTMP#1|)) (QUOTE T))))) - (CONS - (QUOTE COND) - (CONS - (CONS - (CONS (QUOTE EQUAL) (CONS |var1| (CONS |rhs| NIL))) - (CONS |var1| NIL)) - NIL))) - ((QUOTE T) - (SPADLET |isPred| - (COND - (|$inDefIS| (|defIS1| |rhs| |lhs|)) - ((QUOTE T) (|defIS| |rhs| |lhs|)))) - (CONS (QUOTE COND) (CONS (CONS |isPred| (CONS |rhs| NIL)) NIL))))))) -; + ((OR (BOOT-EQUAL |var1| (INTERN "." "BOOT")) + (AND (PAIRP |var1|) (EQCAR |var1| 'QUOTE))) + (|defLET2| |var2| (|addCARorCDR| 'CDR |rhs|))) + ('T + (SPADLET |l1| + (|defLET2| |var1| (|addCARorCDR| 'CAR |rhs|))) + (COND + ((MEMQ |var2| '(NIL |.|)) |l1|) + ('T + (COND + ((AND (PAIRP |l1|) (ATOM (CAR |l1|))) + (SPADLET |l1| (CONS |l1| NIL)))) + (COND + ((IDENTP |var2|) + (APPEND |l1| + (CONS (|defLetForm| |var2| + (|addCARorCDR| 'CDR |rhs|)) + NIL))) + ('T + (SPADLET |l2| + (|defLET2| |var2| + (|addCARorCDR| 'CDR |rhs|))) + (COND + ((AND (PAIRP |l2|) (ATOM (CAR |l2|))) + (SPADLET |l2| (CONS |l2| NIL)))) + (APPEND |l1| |l2|)))))))) + ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) 'APPEND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lhs|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |var1| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN + (SPADLET |var2| (QCAR |ISTMP#2|)) + 'T)))))) + (SPADLET |patrev| (|defISReverse| |var2| |var1|)) + (SPADLET |rev| (CONS 'REVERSE (CONS |rhs| NIL))) + (SPADLET |g| + (INTERN (STRCONC (MAKESTRING "LETTMP#") + (STRINGIMAGE |$letGenVarCounter|)))) + (SPADLET |$letGenVarCounter| (PLUS |$letGenVarCounter| 1)) + (SPADLET |l2| (|defLET2| |patrev| |g|)) + (COND + ((AND (PAIRP |l2|) (ATOM (CAR |l2|))) + (SPADLET |l2| (CONS |l2| NIL)))) + (COND + ((BOOT-EQUAL |var1| (INTERN "." "BOOT")) + (CONS (CONS $LET (CONS |g| (CONS |rev| NIL))) |l2|)) + ((PROGN + (SPADLET |ISTMP#1| (|last| |l2|)) + (AND (PAIRP |ISTMP#1|) (EQUAL (QCAR |ISTMP#1|) $LET) + (PROGN + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQUAL (QCAR |ISTMP#2|) |var1|) + (PROGN + (SPADLET |ISTMP#3| (QCDR |ISTMP#2|)) + (AND (PAIRP |ISTMP#3|) + (EQ (QCDR |ISTMP#3|) NIL) + (PROGN + (SPADLET |val1| (QCAR |ISTMP#3|)) + 'T))))))) + (CONS (CONS $LET (CONS |g| (CONS |rev| NIL))) + (APPEND (REVERSE (CDR (REVERSE |l2|))) + (CONS (|defLetForm| |var1| + (CONS 'NREVERSE (CONS |val1| NIL))) + NIL)))) + ('T + (CONS (CONS $LET (CONS |g| (CONS |rev| NIL))) + (APPEND |l2| + (CONS (|defLetForm| |var1| + (CONS 'NREVERSE (CONS |var1| NIL))) + NIL)))))) + ((AND (PAIRP |lhs|) (EQ (QCAR |lhs|) 'EQUAL) + (PROGN + (SPADLET |ISTMP#1| (QCDR |lhs|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |var1| (QCAR |ISTMP#1|)) 'T)))) + (CONS 'COND + (CONS (CONS (CONS 'EQUAL (CONS |var1| (CONS |rhs| NIL))) + (CONS |var1| NIL)) + NIL))) + ('T + (SPADLET |isPred| + (COND + (|$inDefIS| (|defIS1| |rhs| |lhs|)) + ('T (|defIS| |rhs| |lhs|)))) + (CONS 'COND (CONS (CONS |isPred| (CONS |rhs| NIL)) NIL))))))) + ;defLET(lhs,rhs) == ; $letGenVarCounter : local := 1 ; $inDefLET : local := true @@ -1265,14 +1262,14 @@ ;;; *** |defLET| REDEFINED (DEFUN |defLET| (|lhs| |rhs|) - (PROG (|$letGenVarCounter| |$inDefLET|) - (DECLARE (SPECIAL |$letGenVarCounter| |$inDefLET|)) - (RETURN - (PROGN - (SPADLET |$letGenVarCounter| 1) - (SPADLET |$inDefLET| (QUOTE T)) - (|defLET1| |lhs| |rhs|))))) -; + (PROG (|$letGenVarCounter| |$inDefLET|) + (DECLARE (SPECIAL |$letGenVarCounter| |$inDefLET|)) + (RETURN + (PROGN + (SPADLET |$letGenVarCounter| 1) + (SPADLET |$inDefLET| 'T) + (|defLET1| |lhs| |rhs|))))) + ;addCARorCDR(acc,expr) == ; NULL PAIRP expr => [acc,expr] ; acc = 'CAR and EQCAR(expr,'REVERSE) => @@ -1291,33 +1288,32 @@ ;;; *** |addCARorCDR| REDEFINED (DEFUN |addCARorCDR| (|acc| |expr|) - (PROG (|funs| |p| |funsA| |funsR|) - (RETURN - (COND - ((NULL (PAIRP |expr|)) - (CONS |acc| (CONS |expr| NIL))) - ((AND (BOOT-EQUAL |acc| (QUOTE CAR)) (EQCAR |expr| (QUOTE REVERSE))) - (CONS (QUOTE |last|) (QCDR |expr|))) - ((QUOTE T) - (SPADLET |funs| - (QUOTE - (CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR - CADDR CDAAR CDDAR CDADR CDDDR))) - (SPADLET |p| (|position| (QCAR |expr|) |funs|)) - (COND - ((BOOT-EQUAL |p| (SPADDIFFERENCE 1)) (CONS |acc| (CONS |expr| NIL))) - ((QUOTE T) - (SPADLET |funsA| - (QUOTE (CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR - CAAADR CAADDR CADAAR CADDAR CADADR CADDDR))) - (SPADLET |funsR| - (QUOTE (CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR - CDAADR CDADDR CDDAAR CDDDAR CDDADR CDDDDR))) - (COND - ((BOOT-EQUAL |acc| (QUOTE CAR)) (CONS (ELT |funsA| |p|) (QCDR |expr|))) - ((QUOTE T) (CONS (ELT |funsR| |p|) (QCDR |expr|))))))))))) -; -; + (PROG (|funs| |p| |funsA| |funsR|) + (RETURN + (COND + ((NULL (PAIRP |expr|)) (CONS |acc| (CONS |expr| NIL))) + ((AND (BOOT-EQUAL |acc| 'CAR) (EQCAR |expr| 'REVERSE)) + (CONS '|last| (QCDR |expr|))) + ('T + (SPADLET |funs| + '(CAR CDR CAAR CDAR CADR CDDR CAAAR CADAR CAADR CADDR + CDAAR CDDAR CDADR CDDDR)) + (SPADLET |p| (|position| (QCAR |expr|) |funs|)) + (COND + ((BOOT-EQUAL |p| (SPADDIFFERENCE 1)) + (CONS |acc| (CONS |expr| NIL))) + ('T + (SPADLET |funsA| + '(CAAR CADR CAAAR CADAR CAADR CADDR CAAAAR CAADAR + CAAADR CAADDR CADAAR CADDAR CADADR CADDDR)) + (SPADLET |funsR| + '(CDAR CDDR CDAAR CDDAR CDADR CDDDR CDAAAR CDADAR + CDAADR CDADDR CDDAAR CDDDAR CDDADR CDDDDR)) + (COND + ((BOOT-EQUAL |acc| 'CAR) + (CONS (ELT |funsA| |p|) (QCDR |expr|))) + ('T (CONS (ELT |funsR| |p|) (QCDR |expr|))))))))))) + ;--% IS ; ;defISReverse(x,a) == @@ -1333,18 +1329,19 @@ ;;; *** |defISReverse| REDEFINED (DEFUN |defISReverse| (|x| |a|) - (PROG (|y|) - (RETURN - (COND - ((AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE CONS))) - (COND - ((NULL (CADDR |x|)) (CONS (QUOTE CONS) (CONS (CADR |x|) (CONS |a| NIL)))) - ((QUOTE T) - (SPADLET |y| (|defISReverse| (CADDR |x|) NIL)) - (RPLAC (CADDR |y|) (CONS (QUOTE CONS) (CONS (CADR |x|) (CONS |a| NIL)))) - |y|))) - ((QUOTE T) (ERRHUH)))))) -; + (PROG (|y|) + (RETURN + (COND + ((AND (PAIRP |x|) (EQ (QCAR |x|) 'CONS)) + (COND + ((NULL (CADDR |x|)) + (CONS 'CONS (CONS (CADR |x|) (CONS |a| NIL)))) + ('T (SPADLET |y| (|defISReverse| (CADDR |x|) NIL)) + (RPLAC (CADDR |y|) + (CONS 'CONS (CONS (CADR |x|) (CONS |a| NIL)))) + |y|))) + ('T (ERRHUH)))))) + ;defIS1(lhs,rhs) == ; NULL rhs => ; ['NULL,lhs] @@ -1401,156 +1398,169 @@ ;;; *** |defIS1| REDEFINED (DEFUN |defIS1| (|lhs| |rhs|) - (PROG (|d| |l| |a1| |b1| |c| |cls| |ISTMP#1| |a| |ISTMP#2| |b| |patrev| |g| - |rev| |l2|) - (RETURN - (COND - ((NULL |rhs|) (CONS (QUOTE NULL) (CONS |lhs| NIL))) - ((STRINGP |rhs|) (CONS (QUOTE EQ) (CONS |lhs| (CONS (CONS (QUOTE QUOTE) (CONS (INTERN |rhs|) NIL)) NIL)))) - ((NUMBERP |rhs|) (CONS (QUOTE EQUAL) (CONS |lhs| (CONS |rhs| NIL)))) - ((ATOM |rhs|) (CONS (QUOTE PROGN) (CONS (|defLetForm| |rhs| |lhs|) (CONS (QUOTE (QUOTE T)) NIL)))) - ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) (QUOTE QUOTE)) (PROGN (SPADLET |ISTMP#1| (QCDR |rhs|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (COND ((IDENTP |a|) (CONS (QUOTE EQ) (CONS |lhs| (CONS |rhs| NIL)))) ((QUOTE T) (CONS (QUOTE EQUAL) (CONS |lhs| (CONS |rhs| NIL)))))) - ((AND (PAIRP |rhs|) (EQUAL (QCAR |rhs|) $LET) (PROGN (SPADLET |ISTMP#1| (QCDR |rhs|)) (AND (PAIRP |ISTMP#1|) (PROGN (SPADLET |c| (QCAR |ISTMP#1|)) (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) (PROGN (SPADLET |d| (QCAR |ISTMP#2|)) (QUOTE T))))))) (SPADLET |l| (COND (|$inDefLET| (|defLET1| |c| |lhs|)) ((QUOTE T) (|defLET| |c| |lhs|)))) (CONS (QUOTE AND) (CONS (|defIS1| |lhs| |d|) (CONS (MKPROGN (CONS |l| (CONS (QUOTE (QUOTE T)) NIL))) NIL)))) - ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) (QUOTE EQUAL)) (PROGN (SPADLET |ISTMP#1| (QCDR |rhs|)) (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) (QUOTE T))))) (CONS (QUOTE EQUAL) (CONS |lhs| (CONS |a| NIL)))) - ((PAIRP |lhs|) (SPADLET |g| (INTERN (STRCONC (MAKESTRING "ISTMP#") (STRINGIMAGE |$isGenVarCounter|)))) (SPADLET |$isGenVarCounter| (PLUS |$isGenVarCounter| 1)) (MKPROGN (CONS (CONS $LET (CONS |g| (CONS |lhs| NIL))) (CONS (|defIS1| |g| |rhs|) NIL)))) - ((AND - (PAIRP |rhs|) - (EQ (QCAR |rhs|) (QUOTE CONS)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |rhs|)) - (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 - ((BOOT-EQUAL |a| (INTERN "." "BOOT")) - (COND - ((NULL |b|) - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS - (CONS - (QUOTE EQ) - (CONS - (CONS (QUOTE QCDR) (CONS |lhs| NIL)) - (CONS (QUOTE NIL) NIL))) - NIL)))) - ((QUOTE T) - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS (|defIS1| (CONS (QUOTE QCDR) (CONS |lhs| NIL)) |b|) NIL)))))) - ((NULL |b|) - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS - (CONS - (QUOTE EQ) - (CONS (CONS (QUOTE QCDR) (CONS |lhs| NIL)) (CONS (QUOTE NIL) NIL))) - (CONS (|defIS1| (CONS (QUOTE QCAR) (CONS |lhs| NIL)) |a|) NIL))))) - ((BOOT-EQUAL |b| (INTERN "." "BOOT")) - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS (|defIS1| (CONS (QUOTE QCAR) (CONS |lhs| NIL)) |a|) NIL)))) - ((QUOTE T) - (SPADLET |a1| (|defIS1| (CONS (QUOTE QCAR) (CONS |lhs| NIL)) |a|)) - (SPADLET |b1| (|defIS1| (CONS (QUOTE QCDR) (CONS |lhs| NIL)) |b|)) - (COND - ((AND - (PAIRP |a1|) - (EQ (QCAR |a1|) (QUOTE PROGN)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |a1|)) - (AND - (PAIRP |ISTMP#1|) - (PROGN - (SPADLET |c| (QCAR |ISTMP#1|)) - (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) - (AND - (PAIRP |ISTMP#2|) - (EQ (QCDR |ISTMP#2|) NIL) - (EQUAL (QCAR |ISTMP#2|) (QUOTE (QUOTE T))))))) - (PAIRP |b1|) - (EQ (QCAR |b1|) (QUOTE PROGN)) - (PROGN (SPADLET |cls| (QCDR |b1|)) (QUOTE T))) - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS (MKPROGN (CONS |c| |cls|)) NIL)))) - ((QUOTE T) - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS |a1| (CONS |b1| NIL))))))))) - ((AND - (PAIRP |rhs|) - (EQ (QCAR |rhs|) (QUOTE APPEND)) - (PROGN - (SPADLET |ISTMP#1| (QCDR |rhs|)) - (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))))))) - (SPADLET |patrev| (|defISReverse| |b| |a|)) - (SPADLET |g| - (INTERN (STRCONC "ISTMP#" (STRINGIMAGE |$isGenVarCounter|)))) - (SPADLET |$isGenVarCounter| (PLUS |$isGenVarCounter| 1)) - (SPADLET |rev| - (CONS - (QUOTE AND) - (CONS - (CONS (QUOTE PAIRP) (CONS |lhs| NIL)) - (CONS - (CONS - (QUOTE PROGN) - (CONS - (CONS - $LET - (CONS |g| (CONS (CONS (QUOTE REVERSE) (CONS |lhs| NIL)) NIL))) - (CONS (QUOTE (QUOTE T)) NIL))) - NIL)))) - (SPADLET |l2| (|defIS1| |g| |patrev|)) - (COND - ((AND (PAIRP |l2|) (ATOM (CAR |l2|))) - (SPADLET |l2| (CONS |l2| NIL)))) - (COND - ((BOOT-EQUAL |a| (INTERN "." "BOOT")) - (CONS (QUOTE AND) (CONS |rev| |l2|))) - ((QUOTE T) - (CONS - (QUOTE AND) - (CONS |rev| - (APPEND |l2| - (CONS - (CONS - (QUOTE PROGN) - (CONS - (|defLetForm| |a| (CONS (QUOTE NREVERSE) (CONS |a| NIL))) - (CONS (QUOTE (QUOTE T)) NIL))) - NIL))))))) - ((QUOTE T) - (SAY "WARNING (defIS1): possibly bad IS code being generated") - (DEF-IS (CONS |lhs| (CONS |rhs| NIL)))))))) -; + (PROG (|d| |l| |a1| |b1| |c| |cls| |ISTMP#1| |a| |ISTMP#2| |b| + |patrev| |g| |rev| |l2|) + (DECLARE (SPECIAL $LET |$isGenVarCounter| |$inDefLET|)) + (RETURN + (COND + ((NULL |rhs|) (CONS 'NULL (CONS |lhs| NIL))) + ((STRINGP |rhs|) + (CONS 'EQ + (CONS |lhs| + (CONS (CONS 'QUOTE (CONS (INTERN |rhs|) NIL)) NIL)))) + ((NUMBERP |rhs|) (CONS 'EQUAL (CONS |lhs| (CONS |rhs| NIL)))) + ((ATOM |rhs|) + (CONS 'PROGN (CONS (|defLetForm| |rhs| |lhs|) (CONS ''T NIL)))) + ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) 'QUOTE) + (PROGN + (SPADLET |ISTMP#1| (QCDR |rhs|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) 'T)))) + (COND + ((IDENTP |a|) (CONS 'EQ (CONS |lhs| (CONS |rhs| NIL)))) + ('T (CONS 'EQUAL (CONS |lhs| (CONS |rhs| NIL)))))) + ((AND (PAIRP |rhs|) (EQUAL (QCAR |rhs|) $LET) + (PROGN + (SPADLET |ISTMP#1| (QCDR |rhs|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |c| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) (EQ (QCDR |ISTMP#2|) NIL) + (PROGN (SPADLET |d| (QCAR |ISTMP#2|)) 'T)))))) + (SPADLET |l| + (COND + (|$inDefLET| (|defLET1| |c| |lhs|)) + ('T (|defLET| |c| |lhs|)))) + (CONS 'AND + (CONS (|defIS1| |lhs| |d|) + (CONS (MKPROGN (CONS |l| (CONS ''T NIL))) NIL)))) + ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) 'EQUAL) + (PROGN + (SPADLET |ISTMP#1| (QCDR |rhs|)) + (AND (PAIRP |ISTMP#1|) (EQ (QCDR |ISTMP#1|) NIL) + (PROGN (SPADLET |a| (QCAR |ISTMP#1|)) 'T)))) + (CONS 'EQUAL (CONS |lhs| (CONS |a| NIL)))) + ((PAIRP |lhs|) + (SPADLET |g| + (INTERN (STRCONC (MAKESTRING "ISTMP#") + (STRINGIMAGE |$isGenVarCounter|)))) + (SPADLET |$isGenVarCounter| (PLUS |$isGenVarCounter| 1)) + (MKPROGN (CONS (CONS $LET (CONS |g| (CONS |lhs| NIL))) + (CONS (|defIS1| |g| |rhs|) NIL)))) + ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) 'CONS) + (PROGN + (SPADLET |ISTMP#1| (QCDR |rhs|)) + (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 + ((BOOT-EQUAL |a| (INTERN "." "BOOT")) + (COND + ((NULL |b|) + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS (CONS 'EQ + (CONS + (CONS 'QCDR (CONS |lhs| NIL)) + (CONS 'NIL NIL))) + NIL)))) + ('T + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS (|defIS1| + (CONS 'QCDR (CONS |lhs| NIL)) |b|) + NIL)))))) + ((NULL |b|) + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS (CONS 'EQ + (CONS (CONS 'QCDR (CONS |lhs| NIL)) + (CONS 'NIL NIL))) + (CONS (|defIS1| + (CONS 'QCAR (CONS |lhs| NIL)) |a|) + NIL))))) + ((BOOT-EQUAL |b| (INTERN "." "BOOT")) + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS (|defIS1| (CONS 'QCAR (CONS |lhs| NIL)) + |a|) + NIL)))) + ('T + (SPADLET |a1| (|defIS1| (CONS 'QCAR (CONS |lhs| NIL)) |a|)) + (SPADLET |b1| (|defIS1| (CONS 'QCDR (CONS |lhs| NIL)) |b|)) + (COND + ((AND (PAIRP |a1|) (EQ (QCAR |a1|) 'PROGN) + (PROGN + (SPADLET |ISTMP#1| (QCDR |a1|)) + (AND (PAIRP |ISTMP#1|) + (PROGN + (SPADLET |c| (QCAR |ISTMP#1|)) + (SPADLET |ISTMP#2| (QCDR |ISTMP#1|)) + (AND (PAIRP |ISTMP#2|) + (EQ (QCDR |ISTMP#2|) NIL) + (EQUAL (QCAR |ISTMP#2|) ''T))))) + (PAIRP |b1|) (EQ (QCAR |b1|) 'PROGN) + (PROGN (SPADLET |cls| (QCDR |b1|)) 'T)) + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS (MKPROGN (CONS |c| |cls|)) NIL)))) + ('T + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS |a1| (CONS |b1| NIL))))))))) + ((AND (PAIRP |rhs|) (EQ (QCAR |rhs|) 'APPEND) + (PROGN + (SPADLET |ISTMP#1| (QCDR |rhs|)) + (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)))))) + (SPADLET |patrev| (|defISReverse| |b| |a|)) + (SPADLET |g| + (INTERN (STRCONC "ISTMP#" + (STRINGIMAGE |$isGenVarCounter|)))) + (SPADLET |$isGenVarCounter| (PLUS |$isGenVarCounter| 1)) + (SPADLET |rev| + (CONS 'AND + (CONS (CONS 'PAIRP (CONS |lhs| NIL)) + (CONS (CONS 'PROGN + (CONS + (CONS $LET + (CONS |g| + (CONS + (CONS 'REVERSE + (CONS |lhs| NIL)) + NIL))) + (CONS ''T NIL))) + NIL)))) + (SPADLET |l2| (|defIS1| |g| |patrev|)) + (COND + ((AND (PAIRP |l2|) (ATOM (CAR |l2|))) + (SPADLET |l2| (CONS |l2| NIL)))) + (COND + ((BOOT-EQUAL |a| (INTERN "." "BOOT")) + (CONS 'AND (CONS |rev| |l2|))) + ('T + (CONS 'AND + (CONS |rev| + (APPEND |l2| + (CONS (CONS 'PROGN + (CONS + (|defLetForm| |a| + (CONS 'NREVERSE + (CONS |a| NIL))) + (CONS ''T NIL))) + NIL))))))) + ('T + (SAY "WARNING (defIS1): possibly bad IS code being generated") + (DEF-IS (CONS |lhs| (CONS |rhs| NIL)))))))) + ;defIS(lhs,rhs) == ; $isGenVarCounter : local := 1 ; $inDefIS : local := true @@ -1559,14 +1569,14 @@ ;;; *** |defIS| REDEFINED (DEFUN |defIS| (|lhs| |rhs|) - (PROG (|$isGenVarCounter| |$inDefIS|) - (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|)) - (RETURN - (PROGN - (SPADLET |$isGenVarCounter| 1) - (SPADLET |$inDefIS| (QUOTE T)) - (|defIS1| (DEFTRAN |lhs|) |rhs|))))) -; + (PROG (|$isGenVarCounter| |$inDefIS|) + (DECLARE (SPECIAL |$isGenVarCounter| |$inDefIS|)) + (RETURN + (PROGN + (SPADLET |$isGenVarCounter| 1) + (SPADLET |$inDefIS| 'T) + (|defIS1| (DEFTRAN |lhs|) |rhs|))))) + ;--% OR and AND ; ;bootOR e == @@ -1583,31 +1593,37 @@ ;;; *** |bootOR,flatten| REDEFINED (DEFUN |bootOR,flatten| (|x|) - (SEQ - (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE OR))) (EXIT (QCDR |x|))) - (EXIT (CONS |x| NIL)))) + (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) 'OR)) (EXIT (QCDR |x|))) + (EXIT (CONS |x| NIL)))) ;;; *** |bootOR| REDEFINED (DEFUN |bootOR| (|e|) - (PROG (|cls| |ncls|) - (RETURN - (SEQ - (PROGN - (SPADLET |cls| (CDR |e|)) - (COND - ((NULL |cls|) NIL) - ((NULL (CDR |cls|)) (CAR |cls|)) - ((QUOTE T) - (SPADLET |ncls| - (PROG (#0=#:G2934) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G2939 |cls| (CDR #1#)) (|c| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |c| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (APPEND #0# (|bootOR,flatten| |c|))))))))) - (CONS (QUOTE OR) |ncls|)))))))) -; + (PROG (|cls| |ncls|) + (RETURN + (SEQ (PROGN + (SPADLET |cls| (CDR |e|)) + (COND + ((NULL |cls|) NIL) + ((NULL (CDR |cls|)) (CAR |cls|)) + ('T + (SPADLET |ncls| + (PROG (G2934) + (SPADLET G2934 NIL) + (RETURN + (DO ((G2939 |cls| (CDR G2939)) + (|c| NIL)) + ((OR (ATOM G2939) + (PROGN + (SETQ |c| (CAR G2939)) + NIL)) + G2934) + (SEQ (EXIT + (SETQ G2934 + (APPEND G2934 + (|bootOR,flatten| |c|))))))))) + (CONS 'OR |ncls|)))))))) + ;bootAND e == ; -- flatten any contained ANDs. ; cls := CDR e @@ -1622,31 +1638,37 @@ ;;; *** |bootAND,flatten| REDEFINED (DEFUN |bootAND,flatten| (|x|) - (SEQ - (IF (AND (PAIRP |x|) (EQ (QCAR |x|) (QUOTE AND))) (EXIT (QCDR |x|))) - (EXIT (CONS |x| NIL)))) + (SEQ (IF (AND (PAIRP |x|) (EQ (QCAR |x|) 'AND)) (EXIT (QCDR |x|))) + (EXIT (CONS |x| NIL)))) ;;; *** |bootAND| REDEFINED (DEFUN |bootAND| (|e|) - (PROG (|cls| |ncls|) - (RETURN - (SEQ - (PROGN - (SPADLET |cls| (CDR |e|)) - (COND - ((NULL |cls|) (QUOTE T)) - ((NULL (CDR |cls|)) (CAR |cls|)) - ((QUOTE T) - (SPADLET |ncls| - (PROG (#0=#:G2957) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G2962 |cls| (CDR #1#)) (|c| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |c| (CAR #1#)) NIL)) #0#) - (SEQ (EXIT (SETQ #0# (APPEND #0# (|bootAND,flatten| |c|))))))))) - (CONS (QUOTE AND) |ncls|)))))))) -; + (PROG (|cls| |ncls|) + (RETURN + (SEQ (PROGN + (SPADLET |cls| (CDR |e|)) + (COND + ((NULL |cls|) 'T) + ((NULL (CDR |cls|)) (CAR |cls|)) + ('T + (SPADLET |ncls| + (PROG (G2957) + (SPADLET G2957 NIL) + (RETURN + (DO ((G2962 |cls| (CDR G2962)) + (|c| NIL)) + ((OR (ATOM G2962) + (PROGN + (SETQ |c| (CAR G2962)) + NIL)) + G2957) + (SEQ (EXIT + (SETQ G2957 + (APPEND G2957 + (|bootAND,flatten| |c|))))))))) + (CONS 'AND |ncls|)))))))) + ;--% Main Transformation Functions ; ;bootLabelsForGO e == @@ -1662,24 +1684,22 @@ ;;; *** |bootLabelsForGO| REDEFINED (DEFUN |bootLabelsForGO| (|e|) - (PROG (|head| |tail|) - (RETURN - (COND - ((ATOM |e|) NIL) - ((QUOTE T) - (SPADLET |head| (CAR |e|)) - (SPADLET |tail| (CDR |e|)) - (COND - ((IDENTP |head|) - (COND - ((BOOT-EQUAL |head| (QUOTE GO)) - (SPADLET |$labelsForGO| (CONS (CAR |tail|) |$labelsForGO|))) - ((BOOT-EQUAL |head| (QUOTE QUOTE)) - NIL) - ((QUOTE T) - (|bootLabelsForGO| |tail|)))) - ((QUOTE T) (|bootLabelsForGO| |head|) (|bootLabelsForGO| |tail|)))))))) -; + (PROG (|head| |tail|) + (DECLARE (SPECIAL |$labelsForGO|)) + (RETURN + (COND + ((ATOM |e|) NIL) + ('T (SPADLET |head| (CAR |e|)) (SPADLET |tail| (CDR |e|)) + (COND + ((IDENTP |head|) + (COND + ((BOOT-EQUAL |head| 'GO) + (SPADLET |$labelsForGO| + (CONS (CAR |tail|) |$labelsForGO|))) + ((BOOT-EQUAL |head| 'QUOTE) NIL) + ('T (|bootLabelsForGO| |tail|)))) + ('T (|bootLabelsForGO| |head|) (|bootLabelsForGO| |tail|)))))))) + ;bootTran e == ; ATOM e => e ; [head,:tail] := e @@ -1699,38 +1719,41 @@ ;;; *** |bootTran| REDEFINED (DEFUN |bootTran| (|e|) - (PROG (|head| |tail|) - (RETURN - (SEQ - (COND - ((ATOM |e|) |e|) - ((QUOTE T) - (SPADLET |head| (CAR |e|)) - (SPADLET |tail| (CDR |e|)) - (COND - ((BOOT-EQUAL |head| (QUOTE QUOTE)) |e|) - ((QUOTE T) - (SPADLET |tail| - (PROG (#0=#:G2994) - (SPADLET #0# NIL) - (RETURN - (DO ((#1=#:G2999 |tail| (CDR #1#)) (|t| NIL)) - ((OR (ATOM #1#) (PROGN (SETQ |t| (CAR #1#)) NIL)) - (NREVERSE0 #0#)) - (SEQ (EXIT (SETQ #0# (CONS (|bootTran| |t|) #0#)))))))) - (SPADLET |e| (CONS |head| |tail|)) - (COND - ((IDENTP |head|) - (COND - ((BOOT-EQUAL |head| (QUOTE IF)) (|bootIF| |e|)) - ((BOOT-EQUAL |head| (QUOTE COND)) (|bootCOND| |e|)) - ((BOOT-EQUAL |head| (QUOTE PROGN)) (|bootPROGN| |e|)) - ((BOOT-EQUAL |head| (QUOTE SEQ)) (|bootSEQ| |e|)) - ((BOOT-EQUAL |head| (QUOTE OR)) (|bootOR| |e|)) - ((BOOT-EQUAL |head| (QUOTE AND)) (|bootAND| |e|)) - ((QUOTE T) |e|))) - ((QUOTE T) (CONS (|bootTran| |head|) (QCDR |e|)))))))))))) -; + (PROG (|head| |tail|) + (RETURN + (SEQ (COND + ((ATOM |e|) |e|) + ('T (SPADLET |head| (CAR |e|)) (SPADLET |tail| (CDR |e|)) + (COND + ((BOOT-EQUAL |head| 'QUOTE) |e|) + ('T + (SPADLET |tail| + (PROG (G2994) + (SPADLET G2994 NIL) + (RETURN + (DO ((G2999 |tail| (CDR G2999)) + (|t| NIL)) + ((OR (ATOM G2999) + (PROGN + (SETQ |t| (CAR G2999)) + NIL)) + (NREVERSE0 G2994)) + (SEQ (EXIT + (SETQ G2994 + (CONS (|bootTran| |t|) G2994)))))))) + (SPADLET |e| (CONS |head| |tail|)) + (COND + ((IDENTP |head|) + (COND + ((BOOT-EQUAL |head| 'IF) (|bootIF| |e|)) + ((BOOT-EQUAL |head| 'COND) (|bootCOND| |e|)) + ((BOOT-EQUAL |head| 'PROGN) (|bootPROGN| |e|)) + ((BOOT-EQUAL |head| 'SEQ) (|bootSEQ| |e|)) + ((BOOT-EQUAL |head| 'OR) (|bootOR| |e|)) + ((BOOT-EQUAL |head| 'AND) (|bootAND| |e|)) + ('T |e|))) + ('T (CONS (|bootTran| |head|) (QCDR |e|)))))))))))) + ;bootTransform e == ;--NULL $BOOT => e ; $labelsForGO : local := NIL @@ -1740,13 +1763,13 @@ ;;; *** |bootTransform| REDEFINED (DEFUN |bootTransform| (|e|) - (PROG (|$labelsForGO|) - (DECLARE (SPECIAL |$labelsForGO|)) - (RETURN - (PROGN - (SPADLET |$labelsForGO| NIL) - (|bootLabelsForGO| |e|) - (|bootTran| |e|))))) + (PROG (|$labelsForGO|) + (DECLARE (SPECIAL |$labelsForGO|)) + (RETURN + (PROGN + (SPADLET |$labelsForGO| NIL) + (|bootLabelsForGO| |e|) + (|bootTran| |e|))))) @ \eject