diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-05-03 20:51:40 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-05-03 20:51:40 +0000 |
| commit | 6c0cc18deacadb592fe3d68c5585979f6902cd1a (patch) | |
| tree | e6a692a4192af9746f755e855c3dfb33e99cfcfd /src/algebra/strap | |
| parent | 41cb0a1a53d9022c9461c6c9137329a252b455dd (diff) | |
| download | open-axiom-6c0cc18deacadb592fe3d68c5585979f6902cd1a.tar.gz | |
Generate more readable code for functor definitions.
* interp/nruncomp.boot (washFunctorBody): New.
(buildFunctor): Use it.
* interp/g-opt.boot (optBind): New.
(optLIST): Likewise.
Diffstat (limited to 'src/algebra/strap')
39 files changed, 955 insertions, 1181 deletions
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)) |