aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog8
-rw-r--r--src/algebra/strap/ABELGRP-.lsp30
-rw-r--r--src/algebra/strap/ABELMON-.lsp30
-rw-r--r--src/algebra/strap/ABELSG-.lsp30
-rw-r--r--src/algebra/strap/BOOLEAN.lsp18
-rw-r--r--src/algebra/strap/CHAR.lsp18
-rw-r--r--src/algebra/strap/CLAGG-.lsp100
-rw-r--r--src/algebra/strap/DFLOAT.lsp18
-rw-r--r--src/algebra/strap/DIFRING-.lsp20
-rw-r--r--src/algebra/strap/DIVRING-.lsp20
-rw-r--r--src/algebra/strap/EUCDOM-.lsp20
-rw-r--r--src/algebra/strap/FFIELDC-.lsp20
-rw-r--r--src/algebra/strap/FPS-.lsp26
-rw-r--r--src/algebra/strap/GCDDOM-.lsp20
-rw-r--r--src/algebra/strap/HOAGG-.lsp103
-rw-r--r--src/algebra/strap/ILIST.lsp125
-rw-r--r--src/algebra/strap/INS-.lsp20
-rw-r--r--src/algebra/strap/INT.lsp24
-rw-r--r--src/algebra/strap/INTDOM-.lsp46
-rw-r--r--src/algebra/strap/ISTRING.lsp84
-rw-r--r--src/algebra/strap/LIST.lsp136
-rw-r--r--src/algebra/strap/LNAGG-.lsp35
-rw-r--r--src/algebra/strap/LSAGG-.lsp58
-rw-r--r--src/algebra/strap/MONOID-.lsp19
-rw-r--r--src/algebra/strap/NNI.lsp21
-rw-r--r--src/algebra/strap/ORDRING-.lsp20
-rw-r--r--src/algebra/strap/OUTFORM.lsp20
-rw-r--r--src/algebra/strap/PI.lsp19
-rw-r--r--src/algebra/strap/POLYCAT-.lsp341
-rw-r--r--src/algebra/strap/QFCAT-.lsp238
-rw-r--r--src/algebra/strap/RCAGG-.lsp45
-rw-r--r--src/algebra/strap/RING-.lsp19
-rw-r--r--src/algebra/strap/RNS-.lsp20
-rw-r--r--src/algebra/strap/SETAGG-.lsp23
-rw-r--r--src/algebra/strap/SINT.lsp21
-rw-r--r--src/algebra/strap/STAGG-.lsp57
-rw-r--r--src/algebra/strap/SYMBOL.lsp44
-rw-r--r--src/algebra/strap/UFD-.lsp21
-rw-r--r--src/algebra/strap/URAGG-.lsp100
-rw-r--r--src/algebra/strap/VECTOR.lsp107
-rw-r--r--src/interp/g-opt.boot9
-rw-r--r--src/interp/nruncomp.boot50
42 files changed, 1009 insertions, 1194 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 02a7836c..cfa2b3fd 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,11 @@
+2010-05-03 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ Generate more readable code for functor definitions.
+ * interp/nruncomp.boot (washFunctorBody): New.
+ (buildFunctor): Use it.
+ * interp/g-opt.boot (optBind): New.
+ (optLIST): Likewise.
+
2010-05-02 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/compiler.boot (canReturn): Tidy.
diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp
index c07f070e..65266dc4 100644
--- a/src/algebra/strap/ABELGRP-.lsp
+++ b/src/algebra/strap/ABELGRP-.lsp
@@ -33,23 +33,19 @@
(|getShellEntry| $ 24)))))
(DEFUN |AbelianGroup&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianGroup&|))
- (LETT |dv$| (LIST '|AbelianGroup&| |dv$1|) . #0#)
- (LETT $ (|newShell| 27) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (COND
- ((|HasCategory| |#1| '(|Ring|)))
- ('T
- (|setShellEntry| $ 26
- (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|AbelianGroup&| |dv$1|)) ($ (|newShell| 27))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (COND
+ ((|HasCategory| |#1| '(|Ring|)))
+ ('T
+ (|setShellEntry| $ 26
+ (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $))))
+ $))
(MAKEPROP '|AbelianGroup&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . -) (5 . +)
diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp
index c0a9b85f..ce89d0ed 100644
--- a/src/algebra/strap/ABELMON-.lsp
+++ b/src/algebra/strap/ABELMON-.lsp
@@ -28,23 +28,19 @@
('T (SPADCALL |n| |x| (|getShellEntry| $ 18)))))
(DEFUN |AbelianMonoid&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianMonoid&|))
- (LETT |dv$| (LIST '|AbelianMonoid&| |dv$1|) . #0#)
- (LETT $ (|newShell| 20) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (COND
- ((|HasCategory| |#1| '(|Ring|)))
- ('T
- (|setShellEntry| $ 19
- (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|AbelianMonoid&| |dv$1|)) ($ (|newShell| 20))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (COND
+ ((|HasCategory| |#1| '(|Ring|)))
+ ('T
+ (|setShellEntry| $ 19
+ (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $))))
+ $))
(MAKEPROP '|AbelianMonoid&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|)
diff --git a/src/algebra/strap/ABELSG-.lsp b/src/algebra/strap/ABELSG-.lsp
index 9391dd77..4cc27b47 100644
--- a/src/algebra/strap/ABELSG-.lsp
+++ b/src/algebra/strap/ABELSG-.lsp
@@ -9,23 +9,19 @@
(SPADCALL |n| |x| (|getShellEntry| $ 9)))
(DEFUN |AbelianSemiGroup&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|AbelianSemiGroup&|))
- (LETT |dv$| (LIST '|AbelianSemiGroup&| |dv$1|) . #0#)
- (LETT $ (|newShell| 11) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (COND
- ((|HasCategory| |#1| '(|Ring|)))
- ('T
- (|setShellEntry| $ 10
- (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|AbelianSemiGroup&| |dv$1|)) ($ (|newShell| 11))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (COND
+ ((|HasCategory| |#1| '(|Ring|)))
+ ('T
+ (|setShellEntry| $ 10
+ (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $))))
+ $))
(MAKEPROP '|AbelianSemiGroup&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|)
diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp
index eaf90f62..b6a99dfe 100644
--- a/src/algebra/strap/BOOLEAN.lsp
+++ b/src/algebra/strap/BOOLEAN.lsp
@@ -168,17 +168,13 @@
((NOT #0#) (HREM |$ConstructorCache| '|Boolean|)))))))))))
(DEFUN |Boolean;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|Boolean|) . #0=(|Boolean|))
- (LETT $ (|newShell| 39) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|Boolean| NIL (CONS 1 $))
- (|stuffDomainSlots| $)
- $))))
+ (LET ((|dv$| (LIST '|Boolean|)) ($ (|newShell| 39))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|Boolean| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ $))
(MAKEPROP '|Boolean| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL |BOOLEAN;test;2$;1|
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index e8bfbd0f..42f0396f 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -204,17 +204,13 @@
((NOT #0#) (HREM |$ConstructorCache| '|Character|)))))))))))
(DEFUN |Character;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|Character|) . #0=(|Character|))
- (LETT $ (|newShell| 58) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|Character| NIL (CONS 1 $))
- (|stuffDomainSlots| $)
- $))))
+ (LET ((|dv$| (LIST '|Character|)) ($ (|newShell| 58))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|Character| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ $))
(MAKEPROP '|Character| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |CHAR;=;2$B;1|
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index a8375014..528c7762 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -171,60 +171,52 @@
(|getShellEntry| $ 32)))
(DEFUN |Collection&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|Collection&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|Collection&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 43) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasCategory| |#2|
- '(|ConvertibleTo| (|InputForm|)))
- (|HasCategory| |#2| '(|SetCategory|))
- (|HasAttribute| |#1| '|finiteAggregate|))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|testBitVector| |pv$| 3)
- (PROGN
- (|setShellEntry| $ 12
- (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $))
- (|setShellEntry| $ 18
- (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $))
- (|setShellEntry| $ 21
- (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $))
- (|setShellEntry| $ 22
- (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $))
- (|setShellEntry| $ 25
- (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $))
- (|setShellEntry| $ 28
- (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $))
- (|setShellEntry| $ 30
- (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $))
- (|setShellEntry| $ 33
- (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $))
- (|setShellEntry| $ 35
- (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $))
- (COND
- ((|testBitVector| |pv$| 2)
- (PROGN
- (|setShellEntry| $ 38
- (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|)
- $))
- (|setShellEntry| $ 40
- (CONS (|dispatchFunction|
- |CLAGG-;reduce;MA3S;11|)
- $))
- (|setShellEntry| $ 42
- (CONS (|dispatchFunction|
- |CLAGG-;removeDuplicates;2A;12|)
- $))))))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|Collection&| |dv$1| |dv$2|))
+ ($ (|newShell| 43))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasCategory| |#2|
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (|HasCategory| |#2| '(|SetCategory|))
+ (|HasAttribute| |#1| '|finiteAggregate|)))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|testBitVector| |pv$| 3)
+ (PROGN
+ (|setShellEntry| $ 12
+ (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $))
+ (|setShellEntry| $ 18
+ (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $))
+ (|setShellEntry| $ 21
+ (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $))
+ (|setShellEntry| $ 22
+ (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $))
+ (|setShellEntry| $ 25
+ (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $))
+ (|setShellEntry| $ 28
+ (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $))
+ (|setShellEntry| $ 30
+ (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $))
+ (|setShellEntry| $ 33
+ (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $))
+ (|setShellEntry| $ 35
+ (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $))
+ (COND
+ ((|testBitVector| |pv$| 2)
+ (PROGN
+ (|setShellEntry| $ 38
+ (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) $))
+ (|setShellEntry| $ 40
+ (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) $))
+ (|setShellEntry| $ 42
+ (CONS (|dispatchFunction|
+ |CLAGG-;removeDuplicates;2A;12|)
+ $))))))))
+ $))
(MAKEPROP '|Collection&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 5a1a8cf3..5609b7fc 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -929,17 +929,13 @@
((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|)))))))))))
(DEFUN |DoubleFloat;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|DoubleFloat|) . #0=(|DoubleFloat|))
- (LETT $ (|newShell| 165) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|DoubleFloat| NIL (CONS 1 $))
- (|stuffDomainSlots| $)
- $))))
+ (LET ((|dv$| (LIST '|DoubleFloat|)) ($ (|newShell| 165))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|DoubleFloat| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ $))
(MAKEPROP '|DoubleFloat| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|OpenMathEncoding|)
diff --git a/src/algebra/strap/DIFRING-.lsp b/src/algebra/strap/DIFRING-.lsp
index 1c9f8444..db6d32d4 100644
--- a/src/algebra/strap/DIFRING-.lsp
+++ b/src/algebra/strap/DIFRING-.lsp
@@ -31,18 +31,14 @@
(SPADCALL |r| |n| (|getShellEntry| $ 11)))
(DEFUN |DifferentialRing&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|DifferentialRing&|))
- (LETT |dv$| (LIST '|DifferentialRing&| |dv$1|) . #0#)
- (LETT $ (|newShell| 13) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|DifferentialRing&| |dv$1|)) ($ (|newShell| 13))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|DifferentialRing&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|)
diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp
index 219bf0ab..1f00bd68 100644
--- a/src/algebra/strap/DIVRING-.lsp
+++ b/src/algebra/strap/DIVRING-.lsp
@@ -28,18 +28,14 @@
|x| (|getShellEntry| $ 26)))
(DEFUN |DivisionRing&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|DivisionRing&|))
- (LETT |dv$| (LIST '|DivisionRing&| |dv$1|) . #0#)
- (LETT $ (|newShell| 29) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|DivisionRing&| |dv$1|)) ($ (|newShell| 29))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|DivisionRing&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|)
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index b8aa478a..c7b5d022 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -482,18 +482,14 @@
64))))))))))))))))))))))
(DEFUN |EuclideanDomain&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|EuclideanDomain&|))
- (LETT |dv$| (LIST '|EuclideanDomain&| |dv$1|) . #0#)
- (LETT $ (|newShell| 66) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|EuclideanDomain&| |dv$1|)) ($ (|newShell| 66))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|EuclideanDomain&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 9a019e8d..1aa363e0 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -563,18 +563,14 @@
(SPADCALL |f| |g| (|getShellEntry| $ 112)))
(DEFUN |FiniteFieldCategory&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|FiniteFieldCategory&|))
- (LETT |dv$| (LIST '|FiniteFieldCategory&| |dv$1|) . #0#)
- (LETT $ (|newShell| 115) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|FiniteFieldCategory&| |dv$1|))
+ ($ (|newShell| 115)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|FiniteFieldCategory&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|)
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp
index def89ef7..ed9f96a4 100644
--- a/src/algebra/strap/FPS-.lsp
+++ b/src/algebra/strap/FPS-.lsp
@@ -23,21 +23,17 @@
#0#)))
(DEFUN |FloatingPointSystem&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|FloatingPointSystem&|))
- (LETT |dv$| (LIST '|FloatingPointSystem&| |dv$1|) . #0#)
- (LETT $ (|newShell| 20) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasAttribute| |#1| '|arbitraryExponent|)
- (|HasAttribute| |#1| '|arbitraryPrecision|))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|FloatingPointSystem&| |dv$1|))
+ ($ (|newShell| 20))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasAttribute| |#1| '|arbitraryExponent|)
+ (|HasAttribute| |#1| '|arbitraryPrecision|)))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|FloatingPointSystem&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|)
diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp
index 19d50170..89fa1dac 100644
--- a/src/algebra/strap/GCDDOM-.lsp
+++ b/src/algebra/strap/GCDDOM-.lsp
@@ -189,18 +189,14 @@
|p1| (|getShellEntry| $ 44))))))))))))
(DEFUN |GcdDomain&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|GcdDomain&|))
- (LETT |dv$| (LIST '|GcdDomain&| |dv$1|) . #0#)
- (LETT $ (|newShell| 47) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|GcdDomain&| |dv$1|)) ($ (|newShell| 47))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|GcdDomain&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|)
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index f5a748ef..96d009a0 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -224,62 +224,53 @@
(|getShellEntry| $ 42))))))
(DEFUN |HomogeneousAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|HomogeneousAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$|
- (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 44) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasAttribute| |#1| '|finiteAggregate|)
- (|HasAttribute| |#1| '|shallowlyMutable|)
- (|HasCategory| |#2|
- (LIST '|Evalable| (|devaluate| |#2|)))
- (|HasCategory| |#2| '(|SetCategory|))
- (|HasCategory| |#2|
- '(|CoercibleTo| (|OutputForm|))))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|testBitVector| |pv$| 3)
- (|setShellEntry| $ 13
- (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $))))
- (COND
- ((|testBitVector| |pv$| 1)
- (PROGN
- (|setShellEntry| $ 18
- (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $))
- (|setShellEntry| $ 23
- (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $))
- (|setShellEntry| $ 24
- (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $))
- (|setShellEntry| $ 28
- (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $))
- (|setShellEntry| $ 29
- (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $))
- (COND
- ((|testBitVector| |pv$| 4)
- (PROGN
- (|setShellEntry| $ 32
- (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|)
- $))
- (|setShellEntry| $ 34
- (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|)
- $))
- (|setShellEntry| $ 37
- (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $)))))
- (COND
- ((|testBitVector| |pv$| 5)
- (|setShellEntry| $ 43
- (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|)
- $)))))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 44))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasAttribute| |#1| '|finiteAggregate|)
+ (|HasAttribute| |#1| '|shallowlyMutable|)
+ (|HasCategory| |#2|
+ (LIST '|Evalable| (|devaluate| |#2|)))
+ (|HasCategory| |#2| '(|SetCategory|))
+ (|HasCategory| |#2|
+ (LIST '|CoercibleTo| '(|OutputForm|)))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|testBitVector| |pv$| 3)
+ (|setShellEntry| $ 13
+ (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $))))
+ (COND
+ ((|testBitVector| |pv$| 1)
+ (PROGN
+ (|setShellEntry| $ 18
+ (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $))
+ (|setShellEntry| $ 23
+ (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $))
+ (|setShellEntry| $ 24
+ (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $))
+ (|setShellEntry| $ 28
+ (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $))
+ (|setShellEntry| $ 29
+ (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $))
+ (COND
+ ((|testBitVector| |pv$| 4)
+ (PROGN
+ (|setShellEntry| $ 32
+ (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) $))
+ (|setShellEntry| $ 34
+ (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) $))
+ (|setShellEntry| $ 37
+ (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 5)
+ (|setShellEntry| $ 43
+ (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) $)))))))
+ $))
(MAKEPROP '|HomogeneousAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 4f10431d..833b244a 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -484,72 +484,65 @@
((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|)))))))))))
(DEFUN |IndexedList;| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|IndexedList|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|IndexedList| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 85) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (OR (AND (|HasCategory| |#1|
- '(|OrderedSet|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|))))
- (AND (|HasCategory| |#1|
- '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|)))))
- (OR (AND (|HasCategory| |#1|
- '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|))))
- (|HasCategory| |#1|
- '(|CoercibleTo| (|OutputForm|))))
- (|HasCategory| |#1|
- '(|ConvertibleTo| (|InputForm|)))
- (OR (|HasCategory| |#1| '(|OrderedSet|))
- (|HasCategory| |#1| '(|SetCategory|)))
- (|HasCategory| |#1| '(|OrderedSet|))
- (|HasCategory| (|Integer|) '(|OrderedSet|))
- (|HasCategory| |#1| '(|SetCategory|))
- (|HasCategory| |#1|
- '(|CoercibleTo| (|OutputForm|)))
- (AND (|HasCategory| |#1| '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|)))))) . #0#))
- (|haddProp| |$ConstructorCache| '|IndexedList|
- (LIST |dv$1| |dv$2|) (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|testBitVector| |pv$| 8)
- (|setShellEntry| $ 49
- (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $))))
- (COND
- ((|testBitVector| |pv$| 7)
- (PROGN
- (|setShellEntry| $ 53
- (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $))
- (|setShellEntry| $ 57
- (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $))
- (|setShellEntry| $ 59
- (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $)))))
- (COND
- ((|testBitVector| |pv$| 7)
- (|setShellEntry| $ 61
- (CONS (|dispatchFunction|
- |ILIST;removeDuplicates!;2$;26|)
- $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|IndexedList| |dv$1| |dv$2|))
+ ($ (|newShell| 85))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (OR (AND (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))
+ (AND (|HasCategory| |#1|
+ '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|)))))
+ (OR (AND (|HasCategory| |#1|
+ '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))
+ (|HasCategory| |#1|
+ (LIST '|CoercibleTo| '(|OutputForm|))))
+ (|HasCategory| |#1|
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (OR (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1| '(|SetCategory|)))
+ (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| (|Integer|) '(|OrderedSet|))
+ (|HasCategory| |#1| '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|CoercibleTo| '(|OutputForm|)))
+ (AND (|HasCategory| |#1| '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|IndexedList| (LIST |dv$1| |dv$2|)
+ (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|testBitVector| |pv$| 8)
+ (|setShellEntry| $ 49
+ (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $))))
+ (COND
+ ((|testBitVector| |pv$| 7)
+ (PROGN
+ (|setShellEntry| $ 53
+ (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $))
+ (|setShellEntry| $ 57
+ (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $))
+ (|setShellEntry| $ 59
+ (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 7)
+ (|setShellEntry| $ 61
+ (CONS (|dispatchFunction| |ILIST;removeDuplicates!;2$;26|)
+ $))))
+ $))
(MAKEPROP '|IndexedList| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp
index 6babf099..3334337c 100644
--- a/src/algebra/strap/INS-.lsp
+++ b/src/algebra/strap/INS-.lsp
@@ -326,18 +326,14 @@
#0# (EXIT #0#)))))
(DEFUN |IntegerNumberSystem&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegerNumberSystem&|))
- (LETT |dv$| (LIST '|IntegerNumberSystem&| |dv$1|) . #0#)
- (LETT $ (|newShell| 93) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|IntegerNumberSystem&| |dv$1|))
+ ($ (|newShell| 93)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|IntegerNumberSystem&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|)
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index 8640f50b..363727ff 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -535,20 +535,16 @@
((NOT #0#) (HREM |$ConstructorCache| '|Integer|)))))))))))
(DEFUN |Integer;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|Integer|) . #0=(|Integer|))
- (LETT $ (|newShell| 142) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 84
- (|setShellEntry| $ 53
- (CONS (|dispatchFunction| |INT;*;3$;43|) $)))
- $))))
+ (LET ((|dv$| (LIST '|Integer|)) ($ (|newShell| 142))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 84
+ (|setShellEntry| $ 53
+ (CONS (|dispatchFunction| |INT;*;3$;43|) $)))
+ $))
(MAKEPROP '|Integer| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL
diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp
index 42b03119..bed677e8 100644
--- a/src/algebra/strap/INTDOM-.lsp
+++ b/src/algebra/strap/INTDOM-.lsp
@@ -49,32 +49,26 @@
('T T)))
(DEFUN |IntegralDomain&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|IntegralDomain&|))
- (LETT |dv$| (LIST '|IntegralDomain&| |dv$1|) . #0#)
- (LETT $ (|newShell| 23) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (COND
- ((|HasCategory| |#1| '(|Field|)))
- ('T
- (|setShellEntry| $ 9
- (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $))))
- (COND
- ((|HasAttribute| |#1| '|canonicalUnitNormal|)
- (|setShellEntry| $ 22
- (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|)
- $)))
- ('T
- (|setShellEntry| $ 22
- (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|)
- $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|IntegralDomain&| |dv$1|)) ($ (|newShell| 23))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (COND
+ ((|HasCategory| |#1| '(|Field|)))
+ ('T
+ (|setShellEntry| $ 9
+ (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $))))
+ (COND
+ ((|HasAttribute| |#1| '|canonicalUnitNormal|)
+ (|setShellEntry| $ 22
+ (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) $)))
+ ('T
+ (|setShellEntry| $ 22
+ (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) $))))
+ $))
(MAKEPROP '|IntegralDomain&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|)
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 71091f35..f224b0e8 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -833,52 +833,46 @@
(HREM |$ConstructorCache| '|IndexedString|)))))))))))
(DEFUN |IndexedString;| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|IndexedString|))
- (LETT |dv$| (LIST '|IndexedString| |dv$1|) . #0#)
- (LETT $ (|newShell| 101) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (OR (AND (|HasCategory| (|Character|)
- '(|OrderedSet|))
- (|HasCategory| (|Character|)
- '(|Evalable| (|Character|))))
- (AND (|HasCategory| (|Character|)
- '(|SetCategory|))
- (|HasCategory| (|Character|)
- '(|Evalable| (|Character|)))))
- (OR (|HasCategory| (|Character|)
- '(|CoercibleTo| (|OutputForm|)))
- (AND (|HasCategory| (|Character|)
- '(|SetCategory|))
- (|HasCategory| (|Character|)
- '(|Evalable| (|Character|)))))
- (|HasCategory| (|Character|)
- '(|ConvertibleTo| (|InputForm|)))
- (OR (|HasCategory| (|Character|)
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|IndexedString| |dv$1|)) ($ (|newShell| 101))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (OR (AND (|HasCategory| (|Character|)
'(|OrderedSet|))
- (|HasCategory| (|Character|)
- '(|SetCategory|)))
- (|HasCategory| (|Character|)
- '(|OrderedSet|))
- (|HasCategory| (|Integer|) '(|OrderedSet|))
- (|HasCategory| (|Character|)
- '(|SetCategory|))
- (|HasCategory| (|Character|)
- '(|CoercibleTo| (|OutputForm|)))
- (AND (|HasCategory| (|Character|)
- '(|SetCategory|))
- (|HasCategory| (|Character|)
- '(|Evalable| (|Character|)))))) . #0#))
- (|haddProp| |$ConstructorCache| '|IndexedString| (LIST |dv$1|)
- (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (|HasCategory| (|Character|)
+ (LIST '|Evalable| '(|Character|))))
+ (AND (|HasCategory| (|Character|)
+ '(|SetCategory|))
+ (|HasCategory| (|Character|)
+ (LIST '|Evalable| '(|Character|)))))
+ (OR (|HasCategory| (|Character|)
+ (LIST '|CoercibleTo| '(|OutputForm|)))
+ (AND (|HasCategory| (|Character|)
+ '(|SetCategory|))
+ (|HasCategory| (|Character|)
+ (LIST '|Evalable| '(|Character|)))))
+ (|HasCategory| (|Character|)
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (OR (|HasCategory| (|Character|)
+ '(|OrderedSet|))
+ (|HasCategory| (|Character|)
+ '(|SetCategory|)))
+ (|HasCategory| (|Character|) '(|OrderedSet|))
+ (|HasCategory| (|Integer|) '(|OrderedSet|))
+ (|HasCategory| (|Character|)
+ '(|SetCategory|))
+ (|HasCategory| (|Character|)
+ (LIST '|CoercibleTo| '(|OutputForm|)))
+ (AND (|HasCategory| (|Character|)
+ '(|SetCategory|))
+ (|HasCategory| (|Character|)
+ (LIST '|Evalable| '(|Character|))))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|IndexedString| (LIST |dv$1|)
+ (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|IndexedString| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|)
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index 6d480bd5..6fad1fc1 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -214,79 +214,69 @@
(COND ((NOT #1#) (HREM |$ConstructorCache| '|List|)))))))))))
(DEFUN |List;| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|List|))
- (LETT |dv$| (LIST '|List| |dv$1|) . #0#)
- (LETT $ (|newShell| 70) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (OR (AND (|HasCategory| |#1|
- '(|OrderedSet|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|))))
- (AND (|HasCategory| |#1|
- '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|)))))
- (OR (AND (|HasCategory| |#1|
- '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|))))
- (|HasCategory| |#1|
- '(|CoercibleTo| (|OutputForm|))))
- (|HasCategory| |#1|
- '(|ConvertibleTo| (|InputForm|)))
- (OR (|HasCategory| |#1| '(|OrderedSet|))
- (|HasCategory| |#1| '(|SetCategory|)))
- (|HasCategory| |#1| '(|OrderedSet|))
- (|HasCategory| |#1| '(|OpenMath|))
- (|HasCategory| (|Integer|) '(|OrderedSet|))
- (|HasCategory| |#1| '(|SetCategory|))
- (|HasCategory| |#1|
- '(|CoercibleTo| (|OutputForm|)))
- (AND (|HasCategory| |#1| '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|)))))) . #0#))
- (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|)
- (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (COND
- ((|testBitVector| |pv$| 6)
- (PROGN
- (|setShellEntry| $ 31
- (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $))
- (|setShellEntry| $ 32
- (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $))
- (|setShellEntry| $ 33
- (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $))
- (|setShellEntry| $ 34
- (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $)))))
- (COND
- ((|testBitVector| |pv$| 8)
- (PROGN
- (|setShellEntry| $ 37
- (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $))
- (|setShellEntry| $ 41
- (CONS (|dispatchFunction|
- |LIST;setIntersection;3$;11|)
- $))
- (|setShellEntry| $ 44
- (CONS (|dispatchFunction| |LIST;setDifference;3$;12|)
- $)))))
- (COND
- ((|testBitVector| |pv$| 3)
- (|setShellEntry| $ 53
- (CONS (|dispatchFunction| |LIST;convert;$If;13|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|List| |dv$1|))
+ ($ (|newShell| 70))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (OR (AND (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))
+ (AND (|HasCategory| |#1|
+ '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|)))))
+ (OR (AND (|HasCategory| |#1|
+ '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))
+ (|HasCategory| |#1|
+ (LIST '|CoercibleTo| '(|OutputForm|))))
+ (|HasCategory| |#1|
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (OR (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1| '(|SetCategory|)))
+ (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1| '(|OpenMath|))
+ (|HasCategory| (|Integer|) '(|OrderedSet|))
+ (|HasCategory| |#1| '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|CoercibleTo| '(|OutputForm|)))
+ (AND (|HasCategory| |#1| '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|) (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (COND
+ ((|testBitVector| |pv$| 6)
+ (PROGN
+ (|setShellEntry| $ 31
+ (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $))
+ (|setShellEntry| $ 32
+ (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $))
+ (|setShellEntry| $ 33
+ (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $))
+ (|setShellEntry| $ 34
+ (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 8)
+ (PROGN
+ (|setShellEntry| $ 37
+ (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $))
+ (|setShellEntry| $ 41
+ (CONS (|dispatchFunction| |LIST;setIntersection;3$;11|) $))
+ (|setShellEntry| $ 44
+ (CONS (|dispatchFunction| |LIST;setDifference;3$;12|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 3)
+ (|setShellEntry| $ 53
+ (CONS (|dispatchFunction| |LIST;convert;$If;13|) $))))
+ $))
(MAKEPROP '|List| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL (|IndexedList| 6 (NRTEVAL 1))
diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp
index 2ed21c8f..c26c0898 100644
--- a/src/algebra/strap/LNAGG-.lsp
+++ b/src/algebra/strap/LNAGG-.lsp
@@ -57,26 +57,21 @@
(SPADCALL |l| (|getShellEntry| $ 9))))
(DEFUN |LinearAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|LinearAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|LinearAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 33) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|HasAttribute| |#1| '|finiteAggregate|)
- (|setShellEntry| $ 31
- (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|LinearAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 33))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasAttribute| |#1| '|shallowlyMutable|)))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|HasAttribute| |#1| '|finiteAggregate|)
+ (|setShellEntry| $ 31
+ (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) $))))
+ $))
(MAKEPROP '|LinearAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index 52e52069..1e19097f 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -828,38 +828,32 @@
#0# (EXIT #0#)))))
(DEFUN |ListAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|ListAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|ListAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 80) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|HasCategory| |#2| '(|SetCategory|))
- (|setShellEntry| $ 64
- (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $))))
- (COND
- ((|HasCategory| |#2| '(|SetCategory|))
- (PROGN
- (|setShellEntry| $ 73
- (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|)
- $))
- (|setShellEntry| $ 76
- (CONS (|dispatchFunction|
- |LSAGG-;removeDuplicates!;2A;24|)
- $)))))
- (COND
- ((|HasCategory| |#2| '(|OrderedSet|))
- (|setShellEntry| $ 78
- (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|ListAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 80)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|HasCategory| |#2| '(|SetCategory|))
+ (|setShellEntry| $ 64
+ (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $))))
+ (COND
+ ((|HasCategory| |#2| '(|SetCategory|))
+ (PROGN
+ (|setShellEntry| $ 73
+ (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) $))
+ (|setShellEntry| $ 76
+ (CONS (|dispatchFunction|
+ |LSAGG-;removeDuplicates!;2A;24|)
+ $)))))
+ (COND
+ ((|HasCategory| |#2| '(|OrderedSet|))
+ (|setShellEntry| $ 78
+ (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $))))
+ $))
(MAKEPROP '|ListAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp
index 3e5853ed..01837d68 100644
--- a/src/algebra/strap/MONOID-.lsp
+++ b/src/algebra/strap/MONOID-.lsp
@@ -29,18 +29,13 @@
('T (SPADCALL |x| |n| (|getShellEntry| $ 19)))))
(DEFUN |Monoid&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|Monoid&|))
- (LETT |dv$| (LIST '|Monoid&| |dv$1|) . #0#)
- (LETT $ (|newShell| 21) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Monoid&| |dv$1|))
+ ($ (|newShell| 21)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|Monoid&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|)
diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp
index 1288e89c..96730ae9 100644
--- a/src/algebra/strap/NNI.lsp
+++ b/src/algebra/strap/NNI.lsp
@@ -62,19 +62,14 @@
(HREM |$ConstructorCache| '|NonNegativeInteger|)))))))))))
(DEFUN |NonNegativeInteger;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|NonNegativeInteger|)
- . #0=(|NonNegativeInteger|))
- (LETT $ (|newShell| 22) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|NonNegativeInteger| NIL
- (CONS 1 $))
- (|stuffDomainSlots| $)
- $))))
+ (LET ((|dv$| (LIST '|NonNegativeInteger|)) ($ (|newShell| 22))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|NonNegativeInteger| NIL
+ (CONS 1 $))
+ (|stuffDomainSlots| $)
+ $))
(MAKEPROP '|NonNegativeInteger| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL (|Integer|) (0 . |Zero|) (4 . |Zero|)
diff --git a/src/algebra/strap/ORDRING-.lsp b/src/algebra/strap/ORDRING-.lsp
index c4dedafa..b7f704a3 100644
--- a/src/algebra/strap/ORDRING-.lsp
+++ b/src/algebra/strap/ORDRING-.lsp
@@ -35,18 +35,14 @@
('T (|error| "x satisfies neither positive?, negative? or zero?"))))
(DEFUN |OrderedRing&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|OrderedRing&|))
- (LETT |dv$| (LIST '|OrderedRing&| |dv$1|) . #0#)
- (LETT $ (|newShell| 24) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|OrderedRing&| |dv$1|)) ($ (|newShell| 24))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|OrderedRing&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|)
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index a8b02a51..d789b783 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -1041,18 +1041,14 @@
((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|)))))))))))
(DEFUN |OutputForm;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|OutputForm|) . #0=(|OutputForm|))
- (LETT $ (|newShell| 150) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|OutputForm| NIL (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 "~G")
- $))))
+ (LET ((|dv$| (LIST '|OutputForm|)) ($ (|newShell| 150))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|OutputForm| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 "~G")
+ $))
(MAKEPROP '|OutputForm| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL '|format| (|String|)
diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp
index 4365f9eb..6a746b65 100644
--- a/src/algebra/strap/PI.lsp
+++ b/src/algebra/strap/PI.lsp
@@ -26,18 +26,13 @@
(HREM |$ConstructorCache| '|PositiveInteger|)))))))))))
(DEFUN |PositiveInteger;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|PositiveInteger|) . #0=(|PositiveInteger|))
- (LETT $ (|newShell| 16) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|PositiveInteger| NIL
- (CONS 1 $))
- (|stuffDomainSlots| $)
- $))))
+ (LET ((|dv$| (LIST '|PositiveInteger|)) ($ (|newShell| 16))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|PositiveInteger| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ $))
(MAKEPROP '|PositiveInteger| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL (|NonNegativeInteger|) (0 . |Zero|)
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index d7bb1719..e28995ec 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -1505,186 +1505,169 @@
(SPADCALL (ELT $ 245) (ELT $ 246) |p| (|getShellEntry| $ 250)))
(DEFUN |PolynomialCategory&| (|#1| |#2| |#3| |#4|)
- (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|PolynomialCategory&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$3| (|devaluate| |#3|) . #0#)
- (LETT |dv$4| (|devaluate| |#4|) . #0#)
- (LETT |dv$|
- (LIST '|PolynomialCategory&| |dv$1| |dv$2| |dv$3| |dv$4|) . #0#)
- (LETT $ (|newShell| 259) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasCategory| |#2|
- '(|PolynomialFactorizationExplicit|))
- (|HasAttribute| |#2|
- '|canonicalUnitNormal|)
- (|HasCategory| |#2| '(|GcdDomain|))
- (|HasCategory| |#2| '(|CommutativeRing|))
- (|HasCategory| |#4|
- '(|PatternMatchable| (|Float|)))
- (|HasCategory| |#2|
- '(|PatternMatchable| (|Float|)))
- (|HasCategory| |#4|
- '(|PatternMatchable| (|Integer|)))
- (|HasCategory| |#2|
- '(|PatternMatchable| (|Integer|)))
- (|HasCategory| |#4|
- '(|ConvertibleTo|
- (|Pattern| (|Float|))))
- (|HasCategory| |#2|
- '(|ConvertibleTo|
- (|Pattern| (|Float|))))
- (|HasCategory| |#4|
- '(|ConvertibleTo|
- (|Pattern| (|Integer|))))
- (|HasCategory| |#2|
- '(|ConvertibleTo|
- (|Pattern| (|Integer|))))
- (|HasCategory| |#4|
- '(|ConvertibleTo| (|InputForm|)))
- (|HasCategory| |#2|
- '(|ConvertibleTo| (|InputForm|))))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (|setShellEntry| $ 8 |#3|)
- (|setShellEntry| $ 9 |#4|)
- (COND
- ((|testBitVector| |pv$| 4)
- (PROGN
- (|setShellEntry| $ 95
- (CONS (|dispatchFunction|
- |POLYCAT-;resultant;2SVarSetS;15|)
- $))
- (|setShellEntry| $ 97
- (CONS (|dispatchFunction|
- |POLYCAT-;discriminant;SVarSetS;16|)
- $)))))
- (COND
- ((|HasCategory| |#2| '(|IntegralDomain|))
- (PROGN
- (|setShellEntry| $ 121
- (CONS (|dispatchFunction|
- |POLYCAT-;reducedSystem;MM;20|)
- $))
- (|setShellEntry| $ 131
- (CONS (|dispatchFunction|
- |POLYCAT-;reducedSystem;MVR;21|)
- $)))))
- (COND
- ((|testBitVector| |pv$| 1)
- (PROGN
- (|setShellEntry| $ 134
- (CONS (|dispatchFunction|
- |POLYCAT-;gcdPolynomial;3Sup;22|)
- $))
- (|setShellEntry| $ 141
- (CONS (|dispatchFunction|
- |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|)
- $))
- (|setShellEntry| $ 145
- (CONS (|dispatchFunction|
- |POLYCAT-;factorPolynomial;SupF;24|)
- $))
- (|setShellEntry| $ 147
- (CONS (|dispatchFunction|
- |POLYCAT-;factorSquareFreePolynomial;SupF;25|)
- $))
- (|setShellEntry| $ 165
- (CONS (|dispatchFunction| |POLYCAT-;factor;SF;26|) $))
- (COND
- ((|HasCategory| |#2| '(|CharacteristicNonZero|))
- (PROGN
- (|setShellEntry| $ 184
- (CONS (|dispatchFunction|
- |POLYCAT-;conditionP;MU;27|)
- $))))))))
- (COND
- ((|HasCategory| |#2| '(|CharacteristicNonZero|))
- (PROGN
- (|setShellEntry| $ 186
- (CONS (|dispatchFunction| |POLYCAT-;charthRoot;SU;28|)
- $)))))
- (COND
- ((|testBitVector| |pv$| 3)
- (PROGN
- (COND
- ((|HasCategory| |#2| '(|EuclideanDomain|))
- (COND
- ((|HasCategory| |#2| '(|CharacteristicZero|))
- (|setShellEntry| $ 195
- (CONS (|dispatchFunction|
- |POLYCAT-;squareFree;SF;31|)
- $)))
- ('T
- (|setShellEntry| $ 195
- (CONS (|dispatchFunction|
- |POLYCAT-;squareFree;SF;32|)
- $)))))
- ('T
- (|setShellEntry| $ 195
- (CONS (|dispatchFunction|
- |POLYCAT-;squareFree;SF;33|)
- $))))
- (|setShellEntry| $ 203
- (CONS (|dispatchFunction|
- |POLYCAT-;squareFreePart;2S;34|)
- $))
- (|setShellEntry| $ 205
- (CONS (|dispatchFunction|
- |POLYCAT-;content;SVarSetS;35|)
- $))
- (|setShellEntry| $ 210
- (CONS (|dispatchFunction|
- |POLYCAT-;primitivePart;2S;36|)
- $))
- (|setShellEntry| $ 213
- (CONS (|dispatchFunction|
- |POLYCAT-;primitivePart;SVarSetS;37|)
- $)))))
- (COND
- ((|testBitVector| |pv$| 8)
- (COND
- ((|testBitVector| |pv$| 7)
- (|setShellEntry| $ 222
- (CONS (|dispatchFunction|
- |POLYCAT-;patternMatch;SP2Pmr;39|)
- $))))))
- (COND
- ((|testBitVector| |pv$| 6)
- (COND
- ((|testBitVector| |pv$| 5)
- (|setShellEntry| $ 229
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$3| (|devaluate| |#3|)) (|dv$4| (|devaluate| |#4|))
+ (|dv$| (LIST '|PolynomialCategory&| |dv$1| |dv$2| |dv$3|
+ |dv$4|))
+ ($ (|newShell| 259))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasCategory| |#2|
+ '(|PolynomialFactorizationExplicit|))
+ (|HasAttribute| |#2| '|canonicalUnitNormal|)
+ (|HasCategory| |#2| '(|GcdDomain|))
+ (|HasCategory| |#2| '(|CommutativeRing|))
+ (|HasCategory| |#4|
+ (LIST '|PatternMatchable| '(|Float|)))
+ (|HasCategory| |#2|
+ (LIST '|PatternMatchable| '(|Float|)))
+ (|HasCategory| |#4|
+ (LIST '|PatternMatchable| '(|Integer|)))
+ (|HasCategory| |#2|
+ (LIST '|PatternMatchable| '(|Integer|)))
+ (|HasCategory| |#4|
+ (LIST '|ConvertibleTo|
+ (LIST '|Pattern| '(|Float|))))
+ (|HasCategory| |#2|
+ (LIST '|ConvertibleTo|
+ (LIST '|Pattern| '(|Float|))))
+ (|HasCategory| |#4|
+ (LIST '|ConvertibleTo|
+ (LIST '|Pattern| '(|Integer|))))
+ (|HasCategory| |#2|
+ (LIST '|ConvertibleTo|
+ (LIST '|Pattern| '(|Integer|))))
+ (|HasCategory| |#4|
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (|HasCategory| |#2|
+ (LIST '|ConvertibleTo| '(|InputForm|)))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (|setShellEntry| $ 8 |#3|)
+ (|setShellEntry| $ 9 |#4|)
+ (COND
+ ((|testBitVector| |pv$| 4)
+ (PROGN
+ (|setShellEntry| $ 95
+ (CONS (|dispatchFunction|
+ |POLYCAT-;resultant;2SVarSetS;15|)
+ $))
+ (|setShellEntry| $ 97
+ (CONS (|dispatchFunction|
+ |POLYCAT-;discriminant;SVarSetS;16|)
+ $)))))
+ (COND
+ ((|HasCategory| |#2| '(|IntegralDomain|))
+ (PROGN
+ (|setShellEntry| $ 121
+ (CONS (|dispatchFunction| |POLYCAT-;reducedSystem;MM;20|)
+ $))
+ (|setShellEntry| $ 131
+ (CONS (|dispatchFunction| |POLYCAT-;reducedSystem;MVR;21|)
+ $)))))
+ (COND
+ ((|testBitVector| |pv$| 1)
+ (PROGN
+ (|setShellEntry| $ 134
+ (CONS (|dispatchFunction|
+ |POLYCAT-;gcdPolynomial;3Sup;22|)
+ $))
+ (|setShellEntry| $ 141
+ (CONS (|dispatchFunction|
+ |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|)
+ $))
+ (|setShellEntry| $ 145
+ (CONS (|dispatchFunction|
+ |POLYCAT-;factorPolynomial;SupF;24|)
+ $))
+ (|setShellEntry| $ 147
+ (CONS (|dispatchFunction|
+ |POLYCAT-;factorSquareFreePolynomial;SupF;25|)
+ $))
+ (|setShellEntry| $ 165
+ (CONS (|dispatchFunction| |POLYCAT-;factor;SF;26|) $))
+ (COND
+ ((|HasCategory| |#2| '(|CharacteristicNonZero|))
+ (PROGN
+ (|setShellEntry| $ 184
(CONS (|dispatchFunction|
- |POLYCAT-;patternMatch;SP2Pmr;40|)
- $))))))
- (COND
- ((|testBitVector| |pv$| 12)
- (COND
- ((|testBitVector| |pv$| 11)
- (|setShellEntry| $ 236
- (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|)
- $))))))
- (COND
- ((|testBitVector| |pv$| 10)
- (COND
- ((|testBitVector| |pv$| 9)
- (|setShellEntry| $ 243
- (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|)
- $))))))
- (COND
- ((|testBitVector| |pv$| 14)
- (COND
- ((|testBitVector| |pv$| 13)
- (|setShellEntry| $ 251
- (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|)
- $))))))
- $))))
+ |POLYCAT-;conditionP;MU;27|)
+ $))))))))
+ (COND
+ ((|HasCategory| |#2| '(|CharacteristicNonZero|))
+ (PROGN
+ (|setShellEntry| $ 186
+ (CONS (|dispatchFunction| |POLYCAT-;charthRoot;SU;28|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 3)
+ (PROGN
+ (COND
+ ((|HasCategory| |#2| '(|EuclideanDomain|))
+ (COND
+ ((|HasCategory| |#2| '(|CharacteristicZero|))
+ (|setShellEntry| $ 195
+ (CONS (|dispatchFunction|
+ |POLYCAT-;squareFree;SF;31|)
+ $)))
+ ('T
+ (|setShellEntry| $ 195
+ (CONS (|dispatchFunction|
+ |POLYCAT-;squareFree;SF;32|)
+ $)))))
+ ('T
+ (|setShellEntry| $ 195
+ (CONS (|dispatchFunction| |POLYCAT-;squareFree;SF;33|)
+ $))))
+ (|setShellEntry| $ 203
+ (CONS (|dispatchFunction| |POLYCAT-;squareFreePart;2S;34|)
+ $))
+ (|setShellEntry| $ 205
+ (CONS (|dispatchFunction| |POLYCAT-;content;SVarSetS;35|)
+ $))
+ (|setShellEntry| $ 210
+ (CONS (|dispatchFunction| |POLYCAT-;primitivePart;2S;36|)
+ $))
+ (|setShellEntry| $ 213
+ (CONS (|dispatchFunction|
+ |POLYCAT-;primitivePart;SVarSetS;37|)
+ $)))))
+ (COND
+ ((|testBitVector| |pv$| 8)
+ (COND
+ ((|testBitVector| |pv$| 7)
+ (|setShellEntry| $ 222
+ (CONS (|dispatchFunction|
+ |POLYCAT-;patternMatch;SP2Pmr;39|)
+ $))))))
+ (COND
+ ((|testBitVector| |pv$| 6)
+ (COND
+ ((|testBitVector| |pv$| 5)
+ (|setShellEntry| $ 229
+ (CONS (|dispatchFunction|
+ |POLYCAT-;patternMatch;SP2Pmr;40|)
+ $))))))
+ (COND
+ ((|testBitVector| |pv$| 12)
+ (COND
+ ((|testBitVector| |pv$| 11)
+ (|setShellEntry| $ 236
+ (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) $))))))
+ (COND
+ ((|testBitVector| |pv$| 10)
+ (COND
+ ((|testBitVector| |pv$| 9)
+ (|setShellEntry| $ 243
+ (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) $))))))
+ (COND
+ ((|testBitVector| |pv$| 14)
+ (COND
+ ((|testBitVector| |pv$| 13)
+ (|setShellEntry| $ 251
+ (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) $))))))
+ $))
(MAKEPROP '|PolynomialCategory&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp
index 3d8412d1..aa8a25a6 100644
--- a/src/algebra/strap/QFCAT-.lsp
+++ b/src/algebra/strap/QFCAT-.lsp
@@ -302,132 +302,118 @@
(|getShellEntry| $ 112))))))))
(DEFUN |QuotientFieldCategory&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|)
- . #0=(|QuotientFieldCategory&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$|
- (LIST '|QuotientFieldCategory&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 123) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasCategory| |#2|
- '(|PolynomialFactorizationExplicit|))
- (|HasCategory| |#2|
- '(|IntegerNumberSystem|))
- (|HasCategory| |#2| '(|EuclideanDomain|))
- (|HasCategory| |#2|
- '(|RetractableTo| (|Symbol|)))
- (|HasCategory| |#2|
- '(|CharacteristicNonZero|))
- (|HasCategory| |#2|
- '(|CharacteristicZero|))
- (|HasCategory| |#2|
- '(|ConvertibleTo| (|InputForm|)))
- (|HasCategory| |#2| '(|RealConstant|))
- (|HasCategory| |#2|
- '(|OrderedIntegralDomain|))
- (|HasCategory| |#2| '(|OrderedSet|))
- (|HasCategory| |#2|
- '(|RetractableTo| (|Integer|)))
- (|HasCategory| |#2| '(|StepThrough|)))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|testBitVector| |pv$| 12)
- (PROGN
- (|setShellEntry| $ 16
- (CONS (|dispatchFunction| |QFCAT-;init;A;3|) $))
- (|setShellEntry| $ 20
- (CONS (|dispatchFunction| |QFCAT-;nextItem;AU;4|) $)))))
- (COND
- ((|testBitVector| |pv$| 7)
- (|setShellEntry| $ 40
- (CONS (|dispatchFunction| |QFCAT-;convert;AIf;9|) $))))
- (COND
- ((|testBitVector| |pv$| 8)
- (PROGN
- (|setShellEntry| $ 44
- (CONS (|dispatchFunction| |QFCAT-;convert;AF;10|) $))
- (|setShellEntry| $ 48
- (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) $)))))
- (COND
- ((|testBitVector| |pv$| 9)
- (COND
- ((|HasAttribute| |#2| '|canonicalUnitNormal|)
- (|setShellEntry| $ 51
- (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $)))
- ('T
- (|setShellEntry| $ 51
- (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $)))))
- ((|testBitVector| |pv$| 10)
- (|setShellEntry| $ 51
- (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $))))
- (COND
- ((|testBitVector| |pv$| 3)
- (|setShellEntry| $ 55
- (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|)
- $))))
- (COND
- ((|testBitVector| |pv$| 4)
- (PROGN
- (|setShellEntry| $ 58
- (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) $))
- (|setShellEntry| $ 61
- (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) $))
- (|setShellEntry| $ 66
- (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|)
- $)))))
- (COND
- ((|HasCategory| |#2|
- '(|ConvertibleTo| (|Pattern| (|Integer|))))
- (PROGN
- (|setShellEntry| $ 71
- (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $))
- (COND
- ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|)))
- (|setShellEntry| $ 76
- (CONS (|dispatchFunction|
- |QFCAT-;patternMatch;AP2Pmr;20|)
- $)))))))
- (COND
- ((|HasCategory| |#2|
- '(|ConvertibleTo| (|Pattern| (|Float|))))
- (PROGN
- (|setShellEntry| $ 80
- (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $))
- (COND
- ((|HasCategory| |#2| '(|PatternMatchable| (|Float|)))
- (|setShellEntry| $ 85
- (CONS (|dispatchFunction|
- |QFCAT-;patternMatch;AP2Pmr;22|)
- $)))))))
- (COND
- ((|testBitVector| |pv$| 11)
- (PROGN
- (|setShellEntry| $ 91
- (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $))
- (COND
- ((|domainEqual| |#2| (|Integer|)))
- ('T
- (PROGN
- (|setShellEntry| $ 93
- (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|)
- $))
- (|setShellEntry| $ 96
- (CONS (|dispatchFunction|
- |QFCAT-;retractIfCan;AU;25|)
- $))))))))
- (COND
- ((|testBitVector| |pv$| 2)
- (|setShellEntry| $ 99
- (CONS (|dispatchFunction| |QFCAT-;random;A;26|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|QuotientFieldCategory&| |dv$1| |dv$2|))
+ ($ (|newShell| 123))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasCategory| |#2|
+ '(|PolynomialFactorizationExplicit|))
+ (|HasCategory| |#2| '(|IntegerNumberSystem|))
+ (|HasCategory| |#2| '(|EuclideanDomain|))
+ (|HasCategory| |#2|
+ (LIST '|RetractableTo| '(|Symbol|)))
+ (|HasCategory| |#2|
+ '(|CharacteristicNonZero|))
+ (|HasCategory| |#2| '(|CharacteristicZero|))
+ (|HasCategory| |#2|
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (|HasCategory| |#2| '(|RealConstant|))
+ (|HasCategory| |#2|
+ '(|OrderedIntegralDomain|))
+ (|HasCategory| |#2| '(|OrderedSet|))
+ (|HasCategory| |#2|
+ (LIST '|RetractableTo| '(|Integer|)))
+ (|HasCategory| |#2| '(|StepThrough|))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|testBitVector| |pv$| 12)
+ (PROGN
+ (|setShellEntry| $ 16
+ (CONS (|dispatchFunction| |QFCAT-;init;A;3|) $))
+ (|setShellEntry| $ 20
+ (CONS (|dispatchFunction| |QFCAT-;nextItem;AU;4|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 7)
+ (|setShellEntry| $ 40
+ (CONS (|dispatchFunction| |QFCAT-;convert;AIf;9|) $))))
+ (COND
+ ((|testBitVector| |pv$| 8)
+ (PROGN
+ (|setShellEntry| $ 44
+ (CONS (|dispatchFunction| |QFCAT-;convert;AF;10|) $))
+ (|setShellEntry| $ 48
+ (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 9)
+ (COND
+ ((|HasAttribute| |#2| '|canonicalUnitNormal|)
+ (|setShellEntry| $ 51
+ (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $)))
+ ('T
+ (|setShellEntry| $ 51
+ (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $)))))
+ ((|testBitVector| |pv$| 10)
+ (|setShellEntry| $ 51
+ (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $))))
+ (COND
+ ((|testBitVector| |pv$| 3)
+ (|setShellEntry| $ 55
+ (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|) $))))
+ (COND
+ ((|testBitVector| |pv$| 4)
+ (PROGN
+ (|setShellEntry| $ 58
+ (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) $))
+ (|setShellEntry| $ 61
+ (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) $))
+ (|setShellEntry| $ 66
+ (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|) $)))))
+ (COND
+ ((|HasCategory| |#2| '(|ConvertibleTo| (|Pattern| (|Integer|))))
+ (PROGN
+ (|setShellEntry| $ 71
+ (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $))
+ (COND
+ ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|)))
+ (|setShellEntry| $ 76
+ (CONS (|dispatchFunction|
+ |QFCAT-;patternMatch;AP2Pmr;20|)
+ $)))))))
+ (COND
+ ((|HasCategory| |#2| '(|ConvertibleTo| (|Pattern| (|Float|))))
+ (PROGN
+ (|setShellEntry| $ 80
+ (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $))
+ (COND
+ ((|HasCategory| |#2| '(|PatternMatchable| (|Float|)))
+ (|setShellEntry| $ 85
+ (CONS (|dispatchFunction|
+ |QFCAT-;patternMatch;AP2Pmr;22|)
+ $)))))))
+ (COND
+ ((|testBitVector| |pv$| 11)
+ (PROGN
+ (|setShellEntry| $ 91
+ (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $))
+ (COND
+ ((|domainEqual| |#2| (|Integer|)))
+ ('T
+ (PROGN
+ (|setShellEntry| $ 93
+ (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) $))
+ (|setShellEntry| $ 96
+ (CONS (|dispatchFunction|
+ |QFCAT-;retractIfCan;AU;25|)
+ $))))))))
+ (COND
+ ((|testBitVector| |pv$| 2)
+ (|setShellEntry| $ 99
+ (CONS (|dispatchFunction| |QFCAT-;random;A;26|) $))))
+ $))
(MAKEPROP '|QuotientFieldCategory&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/RCAGG-.lsp b/src/algebra/strap/RCAGG-.lsp
index e10fc5da..ca5c1a39 100644
--- a/src/algebra/strap/RCAGG-.lsp
+++ b/src/algebra/strap/RCAGG-.lsp
@@ -22,31 +22,26 @@
(|getShellEntry| $ 17)))
(DEFUN |RecursiveAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|RecursiveAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|RecursiveAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 19) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasAttribute| |#1| '|shallowlyMutable|)
- (|HasCategory| |#2| '(|SetCategory|)))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|testBitVector| |pv$| 1)
- (|setShellEntry| $ 12
- (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $))))
- (COND
- ((|testBitVector| |pv$| 2)
- (|setShellEntry| $ 18
- (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|RecursiveAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 19))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasAttribute| |#1| '|shallowlyMutable|)
+ (|HasCategory| |#2| '(|SetCategory|))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|testBitVector| |pv$| 1)
+ (|setShellEntry| $ 12
+ (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $))))
+ (COND
+ ((|testBitVector| |pv$| 2)
+ (|setShellEntry| $ 18
+ (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) $))))
+ $))
(MAKEPROP '|RecursiveAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/RING-.lsp b/src/algebra/strap/RING-.lsp
index f5a4504a..17403409 100644
--- a/src/algebra/strap/RING-.lsp
+++ b/src/algebra/strap/RING-.lsp
@@ -8,18 +8,13 @@
(SPADCALL |n| (|spadConstant| $ 7) (|getShellEntry| $ 9)))
(DEFUN |Ring&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|Ring&|))
- (LETT |dv$| (LIST '|Ring&| |dv$1|) . #0#)
- (LETT $ (|newShell| 12) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Ring&| |dv$1|))
+ ($ (|newShell| 12)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|Ring&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|)
diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp
index 0ffc053f..d0c985f5 100644
--- a/src/algebra/strap/RNS-.lsp
+++ b/src/algebra/strap/RNS-.lsp
@@ -134,18 +134,14 @@
('T (SPADCALL (|getShellEntry| $ 53))))))))
(DEFUN |RealNumberSystem&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|RealNumberSystem&|))
- (LETT |dv$| (LIST '|RealNumberSystem&| |dv$1|) . #0#)
- (LETT $ (|newShell| 58) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|RealNumberSystem&| |dv$1|)) ($ (|newShell| 58))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|RealNumberSystem&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|)
diff --git a/src/algebra/strap/SETAGG-.lsp b/src/algebra/strap/SETAGG-.lsp
index a9253081..51617c5b 100644
--- a/src/algebra/strap/SETAGG-.lsp
+++ b/src/algebra/strap/SETAGG-.lsp
@@ -30,20 +30,15 @@
(|getShellEntry| $ 8)))
(DEFUN |SetAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|SetAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 16) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|SetAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 16)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ $))
(MAKEPROP '|SetAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index 6f8e2a64..6129e571 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -551,19 +551,14 @@
(HREM |$ConstructorCache| '|SingleInteger|)))))))))))
(DEFUN |SingleInteger;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|SingleInteger|) . #0=(|SingleInteger|))
- (LETT $ (|newShell| 117) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|SingleInteger| NIL
- (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 1)
- $))))
+ (LET ((|dv$| (LIST '|SingleInteger|)) ($ (|newShell| 117))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|SingleInteger| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 1)
+ $))
(MAKEPROP '|SingleInteger| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL (|Integer|) '|seed|
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index 01db7560..e81844bc 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -255,37 +255,32 @@
(EXIT |x|))))))
(DEFUN |StreamAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|StreamAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 61) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|HasAttribute| |#1| '|shallowlyMutable|)
- (PROGN
- (|setShellEntry| $ 38
- (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $))
- (|setShellEntry| $ 45
- (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $))
- (|setShellEntry| $ 48
- (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $))
- (|setShellEntry| $ 49
- (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $))
- (|setShellEntry| $ 50
- (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $))
- (|setShellEntry| $ 53
- (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $))
- (|setShellEntry| $ 56
- (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $)))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 61)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|HasAttribute| |#1| '|shallowlyMutable|)
+ (PROGN
+ (|setShellEntry| $ 38
+ (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $))
+ (|setShellEntry| $ 45
+ (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $))
+ (|setShellEntry| $ 48
+ (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $))
+ (|setShellEntry| $ 49
+ (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $))
+ (|setShellEntry| $ 50
+ (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $))
+ (|setShellEntry| $ 53
+ (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $))
+ (|setShellEntry| $ 56
+ (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $)))))
+ $))
(MAKEPROP '|StreamAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 91e8f1e8..05b03c5e 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -760,30 +760,26 @@
(COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|)))))))))))
(DEFUN |Symbol;| ()
- (PROG (|dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$| '(|Symbol|) . #0=(|Symbol|))
- (LETT $ (|newShell| 165) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|haddProp| |$ConstructorCache| '|Symbol| NIL (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 10 (SPADCALL 0 (|getShellEntry| $ 9)))
- (|setShellEntry| $ 13 (SPADCALL (|getShellEntry| $ 12)))
- (|setShellEntry| $ 18
- (SPADCALL (LIST "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
- (|getShellEntry| $ 17)))
- (|setShellEntry| $ 19 "0123456789")
- (|setShellEntry| $ 20 "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
- (|setShellEntry| $ 21 "abcdefghijklmnopqrstuvwxyz")
- (|setShellEntry| $ 38 "*")
- (|setShellEntry| $ 41 (QCSIZE (|getShellEntry| $ 38)))
- (|setShellEntry| $ 45
- (SPADCALL (SPADCALL "0" (|getShellEntry| $ 43))
- (|getShellEntry| $ 44)))
- $))))
+ (LET ((|dv$| (LIST '|Symbol|)) ($ (|newShell| 165))
+ (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|Symbol| NIL (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 10 (SPADCALL 0 (|getShellEntry| $ 9)))
+ (|setShellEntry| $ 13 (SPADCALL (|getShellEntry| $ 12)))
+ (|setShellEntry| $ 18
+ (SPADCALL (LIST "0" "1" "2" "3" "4" "5" "6" "7" "8" "9")
+ (|getShellEntry| $ 17)))
+ (|setShellEntry| $ 19 "0123456789")
+ (|setShellEntry| $ 20 "ABCDEFGHIJKLMNOPQRSTUVWXYZ")
+ (|setShellEntry| $ 21 "abcdefghijklmnopqrstuvwxyz")
+ (|setShellEntry| $ 38 "*")
+ (|setShellEntry| $ 41 (QCSIZE (|getShellEntry| $ 38)))
+ (|setShellEntry| $ 45
+ (SPADCALL (SPADCALL "0" (|getShellEntry| $ 43))
+ (|getShellEntry| $ 44)))
+ $))
(MAKEPROP '|Symbol| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|Integer|) (0 . |Zero|)
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp
index 594ac9fa..7955310b 100644
--- a/src/algebra/strap/UFD-.lsp
+++ b/src/algebra/strap/UFD-.lsp
@@ -51,19 +51,14 @@
1))
(DEFUN |UniqueFactorizationDomain&| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|)
- . #0=(|UniqueFactorizationDomain&|))
- (LETT |dv$| (LIST '|UniqueFactorizationDomain&| |dv$1|) . #0#)
- (LETT $ (|newShell| 29) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|))
+ (|dv$| (LIST '|UniqueFactorizationDomain&| |dv$1|))
+ ($ (|newShell| 29)) (|pv$| (|buildPredVector| 0 0 NIL)))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ $))
(MAKEPROP '|UniqueFactorizationDomain&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Factored| $)
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index f69e3773..99ed4101 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -620,63 +620,49 @@
(EXIT |y|))))))))
(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|)
- (PROG (|dv$1| |dv$2| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|)
- . #0=(|UnaryRecursiveAggregate&|))
- (LETT |dv$2| (|devaluate| |#2|) . #0#)
- (LETT |dv$|
- (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|) . #0#)
- (LETT $ (|newShell| 85) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (|setShellEntry| $ 7 |#2|)
- (COND
- ((|HasAttribute| |#1| '|finiteAggregate|)
- (|setShellEntry| $ 61
- (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $))))
- (COND
- ((|HasCategory| |#2| '(|SetCategory|))
- (PROGN
- (|setShellEntry| $ 64
- (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $))
- (|setShellEntry| $ 66
- (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $)))))
- (COND
- ((|testBitVector| |pv$| 1)
- (PROGN
- (|setShellEntry| $ 68
- (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|)
- $))
- (|setShellEntry| $ 70
- (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|)
- $))
- (|setShellEntry| $ 72
- (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|)
- $))
- (|setShellEntry| $ 74
- (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $))
- (|setShellEntry| $ 75
- (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $))
- (|setShellEntry| $ 78
- (CONS (|dispatchFunction|
- |URAGG-;setchildren!;ALA;30|)
- $))
- (|setShellEntry| $ 79
- (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|)
- $))
- (|setShellEntry| $ 82
- (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $))
- (|setShellEntry| $ 83
- (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|)
- $)))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
+ (|dv$| (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|))
+ ($ (|newShell| 85))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (|HasAttribute| |#1| '|shallowlyMutable|)))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (|setShellEntry| $ 7 |#2|)
+ (COND
+ ((|HasAttribute| |#1| '|finiteAggregate|)
+ (|setShellEntry| $ 61
+ (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $))))
+ (COND
+ ((|HasCategory| |#2| '(|SetCategory|))
+ (PROGN
+ (|setShellEntry| $ 64
+ (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $))
+ (|setShellEntry| $ 66
+ (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $)))))
+ (COND
+ ((|testBitVector| |pv$| 1)
+ (PROGN
+ (|setShellEntry| $ 68
+ (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) $))
+ (|setShellEntry| $ 70
+ (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) $))
+ (|setShellEntry| $ 72
+ (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) $))
+ (|setShellEntry| $ 74
+ (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $))
+ (|setShellEntry| $ 75
+ (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $))
+ (|setShellEntry| $ 78
+ (CONS (|dispatchFunction| |URAGG-;setchildren!;ALA;30|) $))
+ (|setShellEntry| $ 79
+ (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) $))
+ (|setShellEntry| $ 82
+ (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $))
+ (|setShellEntry| $ 83
+ (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) $)))))
+ $))
(MAKEPROP '|UnaryRecursiveAggregate&| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp
index 1e069c4c..fba19410 100644
--- a/src/algebra/strap/VECTOR.lsp
+++ b/src/algebra/strap/VECTOR.lsp
@@ -44,63 +44,56 @@
(COND ((NOT #1#) (HREM |$ConstructorCache| '|Vector|)))))))))))
(DEFUN |Vector;| (|#1|)
- (PROG (|dv$1| |dv$| $ |pv$|)
- (RETURN
- (PROGN
- (LETT |dv$1| (|devaluate| |#1|) . #0=(|Vector|))
- (LETT |dv$| (LIST '|Vector| |dv$1|) . #0#)
- (LETT $ (|newShell| 36) . #0#)
- (|setShellEntry| $ 0 |dv$|)
- (|setShellEntry| $ 3
- (LETT |pv$|
- (|buildPredVector| 0 0
- (LIST (OR (AND (|HasCategory| |#1|
- '(|OrderedSet|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|))))
- (AND (|HasCategory| |#1|
- '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|)))))
- (OR (AND (|HasCategory| |#1|
- '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|))))
- (|HasCategory| |#1|
- '(|CoercibleTo| (|OutputForm|))))
- (|HasCategory| |#1|
- '(|ConvertibleTo| (|InputForm|)))
- (OR (|HasCategory| |#1| '(|OrderedSet|))
- (|HasCategory| |#1| '(|SetCategory|)))
- (|HasCategory| |#1| '(|OrderedSet|))
- (|HasCategory| (|Integer|) '(|OrderedSet|))
- (|HasCategory| |#1| '(|SetCategory|))
- (|HasCategory| |#1| '(|AbelianSemiGroup|))
- (|HasCategory| |#1| '(|AbelianMonoid|))
- (|HasCategory| |#1| '(|AbelianGroup|))
- (|HasCategory| |#1| '(|Monoid|))
- (|HasCategory| |#1| '(|Ring|))
- (AND (|HasCategory| |#1|
- '(|RadicalCategory|))
- (|HasCategory| |#1| '(|Ring|)))
- (|HasCategory| |#1|
- '(|CoercibleTo| (|OutputForm|)))
- (AND (|HasCategory| |#1| '(|SetCategory|))
- (|HasCategory| |#1|
- (LIST '|Evalable|
- (|devaluate| |#1|)))))) . #0#))
- (|haddProp| |$ConstructorCache| '|Vector| (LIST |dv$1|)
- (CONS 1 $))
- (|stuffDomainSlots| $)
- (|setShellEntry| $ 6 |#1|)
- (COND
- ((|testBitVector| |pv$| 3)
- (|setShellEntry| $ 20
- (CONS (|dispatchFunction| |VECTOR;convert;$If;3|) $))))
- $))))
+ (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$| (LIST '|Vector| |dv$1|))
+ ($ (|newShell| 36))
+ (|pv$| (|buildPredVector| 0 0
+ (LIST (OR (AND (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))
+ (AND (|HasCategory| |#1|
+ '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|)))))
+ (OR (AND (|HasCategory| |#1|
+ '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))
+ (|HasCategory| |#1|
+ (LIST '|CoercibleTo| '(|OutputForm|))))
+ (|HasCategory| |#1|
+ (LIST '|ConvertibleTo| '(|InputForm|)))
+ (OR (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| |#1| '(|SetCategory|)))
+ (|HasCategory| |#1| '(|OrderedSet|))
+ (|HasCategory| (|Integer|) '(|OrderedSet|))
+ (|HasCategory| |#1| '(|SetCategory|))
+ (|HasCategory| |#1| '(|AbelianSemiGroup|))
+ (|HasCategory| |#1| '(|AbelianMonoid|))
+ (|HasCategory| |#1| '(|AbelianGroup|))
+ (|HasCategory| |#1| '(|Monoid|))
+ (|HasCategory| |#1| '(|Ring|))
+ (AND (|HasCategory| |#1|
+ '(|RadicalCategory|))
+ (|HasCategory| |#1| '(|Ring|)))
+ (|HasCategory| |#1|
+ (LIST '|CoercibleTo| '(|OutputForm|)))
+ (AND (|HasCategory| |#1| '(|SetCategory|))
+ (|HasCategory| |#1|
+ (LIST '|Evalable|
+ (|devaluate| |#1|))))))))
+ (|setShellEntry| $ 0 |dv$|)
+ (|setShellEntry| $ 3 |pv$|)
+ (|haddProp| |$ConstructorCache| '|Vector| (LIST |dv$1|) (CONS 1 $))
+ (|stuffDomainSlots| $)
+ (|setShellEntry| $ 6 |#1|)
+ (COND
+ ((|testBitVector| |pv$| 3)
+ (|setShellEntry| $ 20
+ (CONS (|dispatchFunction| |VECTOR;convert;$If;3|) $))))
+ $))
(MAKEPROP '|Vector| '|infovec|
(LIST '#(NIL NIL NIL NIL NIL (|IndexedVector| 6 (NRTEVAL 1))
diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot
index 31420217..3b0e5b28 100644
--- a/src/interp/g-opt.boot
+++ b/src/interp/g-opt.boot
@@ -529,6 +529,13 @@ optLET_* form ==
rplac(first form,"LET")
optLET form
+optBind form ==
+ rplac(first form,"LET*")
+ optLET_* form
+
+optLIST form ==
+ form is ["LIST"] => nil
+ form
optCollectVector form ==
[.,eltType,:iters,body] := form
@@ -587,6 +594,8 @@ for x in '( (call optCall) _
(SEQ optSEQ)_
(LET optLET)_
(LET_* optLET_*)_
+ (%Bind optBind)_
+ (LIST optLIST)_
(MINUS optMINUS)_
(QSMINUS optQSMINUS)_
(_- opt_-)_
diff --git a/src/interp/nruncomp.boot b/src/interp/nruncomp.boot
index 69a50c7a..e4612f58 100644
--- a/src/interp/nruncomp.boot
+++ b/src/interp/nruncomp.boot
@@ -377,6 +377,26 @@ NRTdescendCodeTran(u,condList) ==
u is ['PROGN,:c] => for x in c repeat NRTdescendCodeTran(x,condList)
nil
+++ Remove useless statements from the elaboration `form' of
+++ a function definition.
+washFunctorBody form == main form where
+ main form ==
+ form' := nil
+ for x in form repeat
+ stmt := clean x
+ stmt = nil => nil
+ stmt is ["PROGN",:l] => form' := [:form',:l]
+ form' := [:form',stmt]
+ form'
+
+ clean x ==
+ x is ["PROGN",:stmts] =>
+ stmts := [s' for s in stmts | (s' := clean s) ~= nil]
+ stmts = nil => nil
+ rest stmts = nil => first stmts
+ ["PROGN",:stmts]
+ x is ["LIST"] => nil
+ x
buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
--PARAMETERS
@@ -459,24 +479,27 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
:predBitVectorCode2,storeOperationCode]
$CheckVectorList := NRTcheckVector domainShell
- --CODE: part 1
- codePart1:= [:devaluateCode,createDomainCode,
- createViewCode,setVector0Code, slot3Code,:slamCode] where
- devaluateCode:= [["%LET",b,['devaluate,a]] for [a,:b] in $devaluateList]
+ -- Local bindings
+ bindings := [:devaluateCode,createDomainCode,
+ createViewCode,createPredVecCode] where
+ devaluateCode:= [[b,["devaluate",a]] for [a,:b] in $devaluateList]
createDomainCode:=
- ["%LET",domname,['LIST,MKQ first $definition,:ASSOCRIGHT $devaluateList]]
- createViewCode:= ["%LET",'$,["newShell", $NRTbase + $NRTdeltaLength]]
- setVector0Code:=[$setelt,'$,0,'dv_$]
- slot3Code := ["setShellEntry",'$,3,["%LET",'pv_$,predBitVectorCode1]]
+ [domname,['LIST,MKQ first $definition,:ASSOCRIGHT $devaluateList]]
+ createViewCode:= ["$",["newShell", $NRTbase + $NRTdeltaLength]]
+ createPredVecCode := ["pv$",predBitVectorCode1]
+
+ --CODE: part 1
+ codePart1:= [setVector0Code, slot3Code,:slamCode] where
+ setVector0Code:=[$setelt,"$",0,"dv$"]
+ slot3Code := ["setShellEntry","$",3,"pv$"]
slamCode:=
isCategoryPackageName opOf $definition => nil
- [NRTaddToSlam($definition,'$)]
+ [NRTaddToSlam($definition,"$")]
--CODE: part 3
$ConstantAssignments :=
[NRTputInLocalReferences code for code in $ConstantAssignments]
- codePart3:= [:constantCode1,
- :constantCode2,:epilogue] where
+ codePart3:= [:constantCode1, :constantCode2,:epilogue] where
constantCode1:=
name='Integer => $ConstantAssignments
nil
@@ -493,8 +516,9 @@ buildFunctor($definition is [name,:args],sig,code,$locals,$e) ==
name='Integer => nil
$ConstantAssignments
epilogue:= $epilogue
- ans :=
- ['PROGN,:optFunctorPROGN [:codePart1,:codePart2,:codePart3], '$]
+ ans := ["%Bind",bindings,
+ :washFunctorBody optFunctorBody
+ [:codePart1,:codePart2,:codePart3],"$"]
$getDomainCode:= nil
--if we didn't kill this, DEFINE would insert it in the wrong place
ans:= minimalise ans