diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-08-16 06:00:35 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-08-16 06:00:35 +0000 |
| commit | 84db9d8c5349cb8b3e7e2d102867e53e610d7ef2 (patch) | |
| tree | 0a2689194fd9e75ce8925550a4e177f3e5520684 /src/algebra/strap | |
| parent | 3372c377eded97a0094f63cddd2e039af7066431 (diff) | |
| download | open-axiom-84db9d8c5349cb8b3e7e2d102867e53e610d7ef2.tar.gz | |
* algebra/strap: New. Sequester cached Lisp translation of
algebra bootstrap domains here.
Diffstat (limited to 'src/algebra/strap')
85 files changed, 19641 insertions, 0 deletions
diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp new file mode 100644 index 00000000..ca331722 --- /dev/null +++ b/src/algebra/strap/ABELGRP-.lsp @@ -0,0 +1,53 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ABELGRP-;-;3S;1| (|x| |y| $) + (SPADCALL |x| (SPADCALL |y| (QREFELT $ 7)) (QREFELT $ 8))) + +(DEFUN |ABELGRP-;subtractIfCan;2SU;2| (|x| |y| $) + (CONS 0 (SPADCALL |x| |y| (QREFELT $ 10)))) + +(DEFUN |ABELGRP-;*;Nni2S;3| (|n| |x| $) + (SPADCALL |n| |x| (QREFELT $ 14))) + +(DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 17)) + ((< 0 |n|) (SPADCALL |n| |x| (QREFELT $ 20))) + ('T (SPADCALL (- |n|) (SPADCALL |x| (QREFELT $ 7)) (QREFELT $ 20))))) + +(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 $ (GETREFV 22) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Ring|))) + ('T + (QSETREFV $ 21 + (CONS (|dispatchFunction| |ABELGRP-;*;I2S;4|) $)))) + $)))) + +(MAKEPROP '|AbelianGroup&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . -) (5 . +) + |ABELGRP-;-;3S;1| (11 . -) (|Union| $ '"failed") + |ABELGRP-;subtractIfCan;2SU;2| (|Integer|) (17 . *) + (|NonNegativeInteger|) |ABELGRP-;*;Nni2S;3| (23 . |Zero|) + (|PositiveInteger|) (|RepeatedDoubling| 6) (27 . |double|) + (33 . *)) + '#(|subtractIfCan| 39 - 45 * 51) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 21 + '(1 6 0 0 7 2 6 0 0 0 8 2 6 0 0 0 10 2 + 6 0 13 0 14 0 6 0 17 2 19 6 18 6 20 2 + 0 0 13 0 21 2 0 11 0 0 12 2 0 0 0 0 9 + 2 0 0 13 0 21 2 0 0 15 0 16))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ABELGRP.lsp b/src/algebra/strap/ABELGRP.lsp new file mode 100644 index 00000000..f667c2d5 --- /dev/null +++ b/src/algebra/strap/ABELGRP.lsp @@ -0,0 +1,24 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AbelianGroup;AL| 'NIL) + +(DEFUN |AbelianGroup| () + (LET (#:G1388) + (COND + (|AbelianGroup;AL|) + (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|)))))) + +(DEFUN |AbelianGroup;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|Join| (|CancellationAbelianMonoid|) + (|mkCategory| '|domain| + '(((- ($ $)) T) ((- ($ $ $)) T) + ((* ($ (|Integer|) $)) T)) + NIL '((|Integer|)) NIL)) + |AbelianGroup|) + (SETELT #0# 0 '(|AbelianGroup|)))))) + +(MAKEPROP '|AbelianGroup| 'NILADIC T) diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp new file mode 100644 index 00000000..a38826e3 --- /dev/null +++ b/src/algebra/strap/ABELMON-.lsp @@ -0,0 +1,49 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ABELMON-;zero?;SB;1| (|x| $) + (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + +(DEFUN |ABELMON-;*;Pi2S;2| (|n| |x| $) + (SPADCALL |n| |x| (QREFELT $ 12))) + +(DEFUN |ABELMON-;sample;S;3| ($) (|spadConstant| $ 7)) + +(DEFUN |ABELMON-;*;Nni2S;4| (|n| |x| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 7)) + ('T (SPADCALL |n| |x| (QREFELT $ 17))))) + +(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 $ (GETREFV 19) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Ring|))) + ('T + (QSETREFV $ 18 + (CONS (|dispatchFunction| |ABELMON-;*;Nni2S;4|) $)))) + $)))) + +(MAKEPROP '|AbelianMonoid&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + (|Boolean|) (4 . =) |ABELMON-;zero?;SB;1| + (|NonNegativeInteger|) (10 . *) (|PositiveInteger|) + |ABELMON-;*;Pi2S;2| |ABELMON-;sample;S;3| + (|RepeatedDoubling| 6) (16 . |double|) (22 . *)) + '#(|zero?| 28 |sample| 33 * 37) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 18 + '(0 6 0 7 2 6 8 0 0 9 2 6 0 11 0 12 2 + 16 6 13 6 17 2 0 0 11 0 18 1 0 8 0 10 + 0 0 0 15 2 0 0 11 0 18 2 0 0 13 0 14))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ABELMON.lsp b/src/algebra/strap/ABELMON.lsp new file mode 100644 index 00000000..5de5fbba --- /dev/null +++ b/src/algebra/strap/ABELMON.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AbelianMonoid;AL| 'NIL) + +(DEFUN |AbelianMonoid| () + (LET (#:G1388) + (COND + (|AbelianMonoid;AL|) + (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|)))))) + +(DEFUN |AbelianMonoid;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|Join| (|AbelianSemiGroup|) + (|mkCategory| '|domain| + '(((|Zero| ($) |constant|) T) + ((|sample| ($) |constant|) T) + ((|zero?| ((|Boolean|) $)) T) + ((* ($ (|NonNegativeInteger|) $)) T)) + NIL + '((|NonNegativeInteger|) (|Boolean|)) + NIL)) + |AbelianMonoid|) + (SETELT #0# 0 '(|AbelianMonoid|)))))) + +(MAKEPROP '|AbelianMonoid| 'NILADIC T) diff --git a/src/algebra/strap/ABELSG-.lsp b/src/algebra/strap/ABELSG-.lsp new file mode 100644 index 00000000..6c9c3182 --- /dev/null +++ b/src/algebra/strap/ABELSG-.lsp @@ -0,0 +1,35 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| $) + (SPADCALL |n| |x| (QREFELT $ 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 $ (GETREFV 11) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Ring|))) + ('T + (QSETREFV $ 10 + (CONS (|dispatchFunction| |ABELSG-;*;Pi2S;1|) $)))) + $)))) + +(MAKEPROP '|AbelianSemiGroup&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) + (|RepeatedDoubling| 6) (0 . |double|) (6 . *)) + '#(* 12) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 10 + '(2 8 6 7 6 9 2 0 0 7 0 10 2 0 0 7 0 + 10))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ABELSG.lsp b/src/algebra/strap/ABELSG.lsp new file mode 100644 index 00000000..6ad00a8f --- /dev/null +++ b/src/algebra/strap/ABELSG.lsp @@ -0,0 +1,24 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL) + +(DEFUN |AbelianSemiGroup| () + (LET (#:G1387) + (COND + (|AbelianSemiGroup;AL|) + (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|)))))) + +(DEFUN |AbelianSemiGroup;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|SetCategory|) + (|mkCategory| '|domain| + '(((+ ($ $ $)) T) + ((* ($ (|PositiveInteger|) $)) T)) + NIL '((|PositiveInteger|)) NIL)) + |AbelianSemiGroup|) + (SETELT #0# 0 '(|AbelianSemiGroup|)))))) + +(MAKEPROP '|AbelianSemiGroup| 'NILADIC T) diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp new file mode 100644 index 00000000..e42de7db --- /dev/null +++ b/src/algebra/strap/ALAGG.lsp @@ -0,0 +1,55 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |AssociationListAggregate;CAT| 'NIL) + +(DEFPARAMETER |AssociationListAggregate;AL| 'NIL) + +(DEFUN |AssociationListAggregate| (&REST #0=#:G1397 &AUX #1=#:G1395) + (DSETQ #1# #0#) + (LET (#2=#:G1396) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) + |AssociationListAggregate;AL|)) + (CDR #2#)) + (T (SETQ |AssociationListAggregate;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY + #'|AssociationListAggregate;| #1#))) + |AssociationListAggregate;AL|)) + #2#)))) + +(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) + (PROG (#0=#:G1394) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|))) + (|sublisV| + (PAIR '(#1=#:G1393) + (LIST '(|Record| (|:| |key| |t#1|) + (|:| |entry| |t#2|)))) + (COND + (|AssociationListAggregate;CAT|) + ('T + (LETT |AssociationListAggregate;CAT| + (|Join| + (|TableAggregate| '|t#1| '|t#2|) + (|ListAggregate| '#1#) + (|mkCategory| '|domain| + '(((|assoc| + ((|Union| + (|Record| (|:| |key| |t#1|) + (|:| |entry| |t#2|)) + "failed") + |t#1| $)) + T)) + NIL 'NIL NIL)) + . #2=(|AssociationListAggregate|)))))) . #2#) + (SETELT #0# 0 + (LIST '|AssociationListAggregate| (|devaluate| |t#1|) + (|devaluate| |t#2|))))))) diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp new file mode 100644 index 00000000..bca63812 --- /dev/null +++ b/src/algebra/strap/BOOLEAN.lsp @@ -0,0 +1,156 @@ + +(/VERSIONCHECK 2) + +(PUT '|BOOLEAN;test;2$;1| '|SPADreplace| '(XLAM (|a|) |a|)) + +(DEFUN |BOOLEAN;test;2$;1| (|a| $) |a|) + +(DEFUN |BOOLEAN;nt| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(PUT '|BOOLEAN;true;$;3| '|SPADreplace| '(XLAM NIL 'T)) + +(DEFUN |BOOLEAN;true;$;3| ($) 'T) + +(PUT '|BOOLEAN;false;$;4| '|SPADreplace| '(XLAM NIL NIL)) + +(DEFUN |BOOLEAN;false;$;4| ($) NIL) + +(DEFUN |BOOLEAN;not;2$;5| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;^;2$;6| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;~;2$;7| (|b| $) (COND (|b| 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;and;3$;8| (|a| |b| $) (COND (|a| |b|) ('T 'NIL))) + +(DEFUN |BOOLEAN;/\\;3$;9| (|a| |b| $) (COND (|a| |b|) ('T 'NIL))) + +(DEFUN |BOOLEAN;or;3$;10| (|a| |b| $) (COND (|a| 'T) ('T |b|))) + +(DEFUN |BOOLEAN;\\/;3$;11| (|a| |b| $) (COND (|a| 'T) ('T |b|))) + +(DEFUN |BOOLEAN;xor;3$;12| (|a| |b| $) + (COND (|a| (|BOOLEAN;nt| |b| $)) ('T |b|))) + +(DEFUN |BOOLEAN;nor;3$;13| (|a| |b| $) + (COND (|a| 'NIL) ('T (|BOOLEAN;nt| |b| $)))) + +(DEFUN |BOOLEAN;nand;3$;14| (|a| |b| $) + (COND (|a| (|BOOLEAN;nt| |b| $)) ('T 'T))) + +(PUT '|BOOLEAN;=;2$B;15| '|SPADreplace| 'EQ) + +(DEFUN |BOOLEAN;=;2$B;15| (|a| |b| $) (EQ |a| |b|)) + +(DEFUN |BOOLEAN;implies;3$;16| (|a| |b| $) (COND (|a| |b|) ('T 'T))) + +(PUT '|BOOLEAN;equiv;3$;17| '|SPADreplace| 'EQ) + +(DEFUN |BOOLEAN;equiv;3$;17| (|a| |b| $) (EQ |a| |b|)) + +(DEFUN |BOOLEAN;<;2$B;18| (|a| |b| $) + (COND (|b| (|BOOLEAN;nt| |a| $)) ('T 'NIL))) + +(PUT '|BOOLEAN;size;Nni;19| '|SPADreplace| '(XLAM NIL 2)) + +(DEFUN |BOOLEAN;size;Nni;19| ($) 2) + +(DEFUN |BOOLEAN;index;Pi$;20| (|i| $) + (COND ((SPADCALL |i| (|getShellEntry| $ 27)) 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;lookup;$Pi;21| (|a| $) (COND (|a| 1) ('T 2))) + +(DEFUN |BOOLEAN;random;$;22| ($) + (COND ((SPADCALL (|random|) (|getShellEntry| $ 27)) 'NIL) ('T 'T))) + +(DEFUN |BOOLEAN;convert;$If;23| (|x| $) + (COND + (|x| (SPADCALL (SPADCALL "true" (|getShellEntry| $ 34)) + (|getShellEntry| $ 36))) + ('T + (SPADCALL (SPADCALL "false" (|getShellEntry| $ 34)) + (|getShellEntry| $ 36))))) + +(DEFUN |BOOLEAN;coerce;$Of;24| (|x| $) + (COND + (|x| (SPADCALL "true" (|getShellEntry| $ 39))) + ('T (SPADCALL "false" (|getShellEntry| $ 39))))) + +(DEFUN |Boolean| () + (PROG () + (RETURN + (PROG (#0=#:G1421) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Boolean| + (LIST + (CONS NIL (CONS 1 (|Boolean;|)))))) + (LETT #0# T |Boolean|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Boolean|))))))))))) + +(DEFUN |Boolean;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Boolean|) . #0=(|Boolean|)) + (LETT $ (|newShell| 42) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Boolean| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + $)))) + +(MAKEPROP '|Boolean| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL |BOOLEAN;test;2$;1| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |BOOLEAN;true;$;3|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |BOOLEAN;false;$;4|) $)) + |BOOLEAN;not;2$;5| |BOOLEAN;^;2$;6| |BOOLEAN;~;2$;7| + |BOOLEAN;and;3$;8| |BOOLEAN;/\\;3$;9| |BOOLEAN;or;3$;10| + |BOOLEAN;\\/;3$;11| |BOOLEAN;xor;3$;12| + |BOOLEAN;nor;3$;13| |BOOLEAN;nand;3$;14| (|Boolean|) + |BOOLEAN;=;2$B;15| |BOOLEAN;implies;3$;16| + |BOOLEAN;equiv;3$;17| |BOOLEAN;<;2$B;18| + (|NonNegativeInteger|) |BOOLEAN;size;Nni;19| (|Integer|) + (0 . |even?|) (|PositiveInteger|) |BOOLEAN;index;Pi$;20| + |BOOLEAN;lookup;$Pi;21| |BOOLEAN;random;$;22| (|String|) + (|Symbol|) (5 . |coerce|) (|InputForm|) (10 . |convert|) + |BOOLEAN;convert;$If;23| (|OutputForm|) (15 . |message|) + |BOOLEAN;coerce;$Of;24| (|SingleInteger|)) + '#(~= 20 ~ 26 |xor| 31 |true| 37 |test| 41 |size| 46 |random| + 50 |or| 54 |not| 60 |nor| 65 |nand| 71 |min| 77 |max| 83 + |lookup| 89 |latex| 94 |index| 99 |implies| 104 |hash| 110 + |false| 115 |equiv| 119 |convert| 125 |coerce| 130 |and| + 135 ^ 141 |\\/| 146 >= 152 > 158 = 164 <= 170 < 176 |/\\| + 182) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) + (CONS '#(|OrderedSet&| NIL |Logic&| |SetCategory&| NIL + NIL |BasicType&| NIL) + (CONS '#((|OrderedSet|) (|Finite|) (|Logic|) + (|SetCategory|) (|ConvertibleTo| 35) + (|PropositionalLogic|) (|BasicType|) + (|CoercibleTo| 38)) + (|makeByteWordVec2| 41 + '(1 26 19 0 27 1 33 0 32 34 1 35 0 33 + 36 1 38 0 32 39 2 0 19 0 0 1 1 0 0 0 + 11 2 0 0 0 0 16 0 0 0 7 1 0 0 0 6 0 0 + 24 25 0 0 0 31 2 0 0 0 0 14 1 0 0 0 9 + 2 0 0 0 0 17 2 0 0 0 0 18 2 0 0 0 0 1 + 2 0 0 0 0 1 1 0 28 0 30 1 0 32 0 1 1 + 0 0 28 29 2 0 0 0 0 21 1 0 41 0 1 0 0 + 0 8 2 0 0 0 0 22 1 0 35 0 37 1 0 38 0 + 40 2 0 0 0 0 12 1 0 0 0 10 2 0 0 0 0 + 15 2 0 19 0 0 1 2 0 19 0 0 1 2 0 19 0 + 0 20 2 0 19 0 0 1 2 0 19 0 0 23 2 0 0 + 0 0 13))))) + '|lookupComplete|)) + +(MAKEPROP '|Boolean| 'NILADIC T) diff --git a/src/algebra/strap/CABMON.lsp b/src/algebra/strap/CABMON.lsp new file mode 100644 index 00000000..d1059b38 --- /dev/null +++ b/src/algebra/strap/CABMON.lsp @@ -0,0 +1,26 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL) + +(DEFUN |CancellationAbelianMonoid| () + (LET (#:G1387) + (COND + (|CancellationAbelianMonoid;AL|) + (T (SETQ |CancellationAbelianMonoid;AL| + (|CancellationAbelianMonoid;|)))))) + +(DEFUN |CancellationAbelianMonoid;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|AbelianMonoid|) + (|mkCategory| '|domain| + '(((|subtractIfCan| + ((|Union| $ "failed") $ $)) + T)) + NIL 'NIL NIL)) + |CancellationAbelianMonoid|) + (SETELT #0# 0 '(|CancellationAbelianMonoid|)))))) + +(MAKEPROP '|CancellationAbelianMonoid| 'NILADIC T) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp new file mode 100644 index 00000000..1395d670 --- /dev/null +++ b/src/algebra/strap/CHAR.lsp @@ -0,0 +1,168 @@ + +(/VERSIONCHECK 2) + +(PUT '|CHAR;=;2$B;1| '|SPADreplace| 'CHAR=) + +(DEFUN |CHAR;=;2$B;1| (|a| |b| $) (CHAR= |a| |b|)) + +(PUT '|CHAR;<;2$B;2| '|SPADreplace| 'CHAR<) + +(DEFUN |CHAR;<;2$B;2| (|a| |b| $) (CHAR< |a| |b|)) + +(PUT '|CHAR;size;Nni;3| '|SPADreplace| '(XLAM NIL 256)) + +(DEFUN |CHAR;size;Nni;3| ($) 256) + +(DEFUN |CHAR;index;Pi$;4| (|n| $) + (PROG (#0=#:G1389) + (RETURN + (SPADCALL + (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;4|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) + (QREFELT $ 11))))) + +(DEFUN |CHAR;lookup;$Pi;5| (|c| $) + (PROG (#0=#:G1391) + (RETURN + (PROG1 (LETT #0# (+ 1 (SPADCALL |c| (QREFELT $ 14))) + |CHAR;lookup;$Pi;5|) + (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))) + +(PUT '|CHAR;char;Nni$;6| '|SPADreplace| 'CODE-CHAR) + +(DEFUN |CHAR;char;Nni$;6| (|n| $) (CODE-CHAR |n|)) + +(PUT '|CHAR;ord;$Nni;7| '|SPADreplace| 'CHAR-CODE) + +(DEFUN |CHAR;ord;$Nni;7| (|c| $) (CHAR-CODE |c|)) + +(DEFUN |CHAR;random;$;8| ($) + (SPADCALL (RANDOM (SPADCALL (QREFELT $ 10))) (QREFELT $ 11))) + +(PUT '|CHAR;space;$;9| '|SPADreplace| '(XLAM NIL (CHAR " " 0))) + +(DEFUN |CHAR;space;$;9| ($) (CHAR " " 0)) + +(PUT '|CHAR;quote;$;10| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0))) + +(DEFUN |CHAR;quote;$;10| ($) (CHAR "\" " 0)) + +(PUT '|CHAR;escape;$;11| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0))) + +(DEFUN |CHAR;escape;$;11| ($) (CHAR "_ " 0)) + +(PUT '|CHAR;coerce;$Of;12| '|SPADreplace| '(XLAM (|c|) |c|)) + +(DEFUN |CHAR;coerce;$Of;12| (|c| $) |c|) + +(DEFUN |CHAR;digit?;$B;13| (|c| $) + (SPADCALL |c| (|spadConstant| $ 23) (QREFELT $ 25))) + +(DEFUN |CHAR;hexDigit?;$B;14| (|c| $) + (SPADCALL |c| (|spadConstant| $ 27) (QREFELT $ 25))) + +(DEFUN |CHAR;upperCase?;$B;15| (|c| $) + (SPADCALL |c| (|spadConstant| $ 29) (QREFELT $ 25))) + +(DEFUN |CHAR;lowerCase?;$B;16| (|c| $) + (SPADCALL |c| (|spadConstant| $ 31) (QREFELT $ 25))) + +(DEFUN |CHAR;alphabetic?;$B;17| (|c| $) + (SPADCALL |c| (|spadConstant| $ 33) (QREFELT $ 25))) + +(DEFUN |CHAR;alphanumeric?;$B;18| (|c| $) + (SPADCALL |c| (|spadConstant| $ 35) (QREFELT $ 25))) + +(DEFUN |CHAR;latex;$S;19| (|c| $) + (STRCONC "\\mbox{`" (STRCONC (MAKE-FULL-CVEC 1 |c|) "'}"))) + +(DEFUN |CHAR;char;S$;20| (|s| $) + (COND + ((EQL (QCSIZE |s|) 1) + (SPADCALL |s| (SPADCALL |s| (QREFELT $ 40)) (QREFELT $ 41))) + ('T (|userError| "String is not a single character")))) + +(PUT '|CHAR;upperCase;2$;21| '|SPADreplace| 'CHAR-UPCASE) + +(DEFUN |CHAR;upperCase;2$;21| (|c| $) (CHAR-UPCASE |c|)) + +(PUT '|CHAR;lowerCase;2$;22| '|SPADreplace| 'CHAR-DOWNCASE) + +(DEFUN |CHAR;lowerCase;2$;22| (|c| $) (CHAR-DOWNCASE |c|)) + +(DEFUN |Character| () + (PROG () + (RETURN + (PROG (#0=#:G1412) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Character|) + |Character|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Character| + (LIST + (CONS NIL (CONS 1 (|Character;|)))))) + (LETT #0# T |Character|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Character|))))))))))) + +(DEFUN |Character;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Character|) . #0=(|Character|)) + (LETT $ (|newShell| 46) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Character| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + $)))) + +(MAKEPROP '|Character| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|Boolean|) |CHAR;=;2$B;1| + |CHAR;<;2$B;2| (|NonNegativeInteger|) |CHAR;size;Nni;3| + |CHAR;char;Nni$;6| (|PositiveInteger|) |CHAR;index;Pi$;4| + |CHAR;ord;$Nni;7| |CHAR;lookup;$Pi;5| |CHAR;random;$;8| + |CHAR;space;$;9| |CHAR;quote;$;10| |CHAR;escape;$;11| + (|OutputForm|) |CHAR;coerce;$Of;12| (|CharacterClass|) + (0 . |digit|) (|Character|) (4 . |member?|) + |CHAR;digit?;$B;13| (10 . |hexDigit|) + |CHAR;hexDigit?;$B;14| (14 . |upperCase|) + |CHAR;upperCase?;$B;15| (18 . |lowerCase|) + |CHAR;lowerCase?;$B;16| (22 . |alphabetic|) + |CHAR;alphabetic?;$B;17| (26 . |alphanumeric|) + |CHAR;alphanumeric?;$B;18| (|String|) |CHAR;latex;$S;19| + (|Integer|) (30 . |minIndex|) (35 . |elt|) + |CHAR;char;S$;20| |CHAR;upperCase;2$;21| + |CHAR;lowerCase;2$;22| (|SingleInteger|)) + '#(~= 41 |upperCase?| 47 |upperCase| 52 |space| 57 |size| 61 + |random| 65 |quote| 69 |ord| 73 |min| 78 |max| 84 + |lowerCase?| 90 |lowerCase| 95 |lookup| 100 |latex| 105 + |index| 110 |hexDigit?| 115 |hash| 120 |escape| 125 + |digit?| 129 |coerce| 134 |char| 139 |alphanumeric?| 149 + |alphabetic?| 154 >= 159 > 165 = 171 <= 177 < 183) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0)) + (CONS '#(NIL |OrderedSet&| NIL |SetCategory&| + |BasicType&| NIL) + (CONS '#((|OrderedFinite|) (|OrderedSet|) + (|Finite|) (|SetCategory|) (|BasicType|) + (|CoercibleTo| 20)) + (|makeByteWordVec2| 45 + '(0 22 0 23 2 22 6 24 0 25 0 22 0 27 0 + 22 0 29 0 22 0 31 0 22 0 33 0 22 0 35 + 1 37 39 0 40 2 37 24 0 39 41 2 0 6 0 + 0 1 1 0 6 0 30 1 0 0 0 43 0 0 0 17 0 + 0 9 10 0 0 0 16 0 0 0 18 1 0 9 0 14 2 + 0 0 0 0 1 2 0 0 0 0 1 1 0 6 0 32 1 0 + 0 0 44 1 0 12 0 15 1 0 37 0 38 1 0 0 + 12 13 1 0 6 0 28 1 0 45 0 1 0 0 0 19 + 1 0 6 0 26 1 0 20 0 21 1 0 0 37 42 1 + 0 0 9 11 1 0 6 0 36 1 0 6 0 34 2 0 6 + 0 0 1 2 0 6 0 0 1 2 0 6 0 0 7 2 0 6 0 + 0 1 2 0 6 0 0 8))))) + '|lookupComplete|)) + +(MAKEPROP '|Character| 'NILADIC T) diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp new file mode 100644 index 00000000..0306e826 --- /dev/null +++ b/src/algebra/strap/CLAGG-.lsp @@ -0,0 +1,221 @@ + +(/VERSIONCHECK 2) + +(DEFUN |CLAGG-;#;ANni;1| (|c| $) + (LENGTH (SPADCALL |c| (QREFELT $ 9)))) + +(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $) + (PROG (|x| #0=#:G1406 #1=#:G1403 #2=#:G1401 #3=#:G1402) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |CLAGG-;count;MANni;2|) + (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|) + (LETT #0# (SPADCALL |c| (QREFELT $ 9)) + |CLAGG-;count;MANni;2|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |CLAGG-;count;MANni;2|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |x| |f|) + (PROGN + (LETT #1# 1 |CLAGG-;count;MANni;2|) + (COND + (#3# + (LETT #2# (+ #2# #1#) + |CLAGG-;count;MANni;2|)) + ('T + (PROGN + (LETT #2# #1# + |CLAGG-;count;MANni;2|) + (LETT #3# 'T + |CLAGG-;count;MANni;2|))))))))) + (LETT #0# (CDR #0#) |CLAGG-;count;MANni;2|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 0))))))) + +(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $) + (PROG (|x| #0=#:G1411 #1=#:G1409 #2=#:G1407 #3=#:G1408) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |CLAGG-;any?;MAB;3|) + (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) + (LETT #0# (SPADCALL |c| (QREFELT $ 9)) + |CLAGG-;any?;MAB;3|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |CLAGG-;any?;MAB;3|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |CLAGG-;any?;MAB;3|) + (COND + (#3# (LETT #2# + (COND (#2# 'T) ('T #1#)) + |CLAGG-;any?;MAB;3|)) + ('T + (PROGN + (LETT #2# #1# |CLAGG-;any?;MAB;3|) + (LETT #3# 'T |CLAGG-;any?;MAB;3|))))))) + (LETT #0# (CDR #0#) |CLAGG-;any?;MAB;3|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'NIL))))))) + +(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $) + (PROG (|x| #0=#:G1416 #1=#:G1414 #2=#:G1412 #3=#:G1413) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |CLAGG-;every?;MAB;4|) + (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) + (LETT #0# (SPADCALL |c| (QREFELT $ 9)) + |CLAGG-;every?;MAB;4|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |CLAGG-;every?;MAB;4|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |CLAGG-;every?;MAB;4|) + (COND + (#3# (LETT #2# + (COND (#2# #1#) ('T 'NIL)) + |CLAGG-;every?;MAB;4|)) + ('T + (PROGN + (LETT #2# #1# + |CLAGG-;every?;MAB;4|) + (LETT #3# 'T |CLAGG-;every?;MAB;4|))))))) + (LETT #0# (CDR #0#) |CLAGG-;every?;MAB;4|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'T))))))) + +(DEFUN |CLAGG-;find;MAU;5| (|f| |c| $) + (SPADCALL |f| (SPADCALL |c| (QREFELT $ 9)) (QREFELT $ 18))) + +(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $) + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 21))) + +(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $) + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s| (QREFELT $ 23))) + +(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $) + (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 25)) + (QREFELT $ 26))) + +(DEFUN |CLAGG-;select;M2A;9| (|f| |x| $) + (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 28)) + (QREFELT $ 26))) + +(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $) + (SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x| + (QREFELT $ 31))) + +(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$) + (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 30))) + +(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $) + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s1| |s2| (QREFELT $ 33))) + +(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 35)) + (QREFELT $ 26))) + +(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 $ (GETREFV 37) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#2| '(|SetCategory|)) + (|HasAttribute| |#1| '|finiteAggregate|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (QSETREFV $ 11 + (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $)) + (QSETREFV $ 13 + (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $)) + (QSETREFV $ 15 + (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $)) + (QSETREFV $ 16 + (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $)) + (QSETREFV $ 19 + (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $)) + (QSETREFV $ 22 + (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) + (QSETREFV $ 24 + (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $)) + (QSETREFV $ 27 + (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) + (QSETREFV $ 29 + (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $)) + (COND + ((|testBitVector| |pv$| 2) + (PROGN + (QSETREFV $ 32 + (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) + $)) + (QSETREFV $ 34 + (CONS (|dispatchFunction| + |CLAGG-;reduce;MA3S;11|) + $)) + (QSETREFV $ 36 + (CONS (|dispatchFunction| + |CLAGG-;removeDuplicates;2A;12|) + $)))))))) + $)))) + +(MAKEPROP '|Collection&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) + (|Mapping| 14 7) (10 . |count|) (|Boolean|) (16 . |any?|) + (22 . |every?|) (|Union| 7 '"failed") (28 . |find|) + (34 . |find|) (|Mapping| 7 7 7) (40 . |reduce|) + (46 . |reduce|) (52 . |reduce|) (59 . |reduce|) + (66 . |remove|) (72 . |construct|) (77 . |remove|) + (83 . |select|) (89 . |select|) (95 . =) (101 . |remove|) + (107 . |remove|) (113 . |reduce|) (121 . |reduce|) + (129 . |removeDuplicates|) (134 . |removeDuplicates|)) + '#(|select| 139 |removeDuplicates| 145 |remove| 150 |reduce| + 162 |find| 183 |every?| 189 |count| 195 |any?| 201 |#| + 207) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 36 + '(1 6 8 0 9 1 0 10 0 11 2 0 10 12 0 13 + 2 0 14 12 0 15 2 0 14 12 0 16 2 8 17 + 12 0 18 2 0 17 12 0 19 2 8 7 20 0 21 + 2 0 7 20 0 22 3 8 7 20 0 7 23 3 0 7 + 20 0 7 24 2 8 0 12 0 25 1 6 0 8 26 2 + 0 0 12 0 27 2 8 0 12 0 28 2 0 0 12 0 + 29 2 7 14 0 0 30 2 6 0 12 0 31 2 0 0 + 7 0 32 4 8 7 20 0 7 7 33 4 0 7 20 0 7 + 7 34 1 8 0 0 35 1 0 0 0 36 2 0 0 12 0 + 29 1 0 0 0 36 2 0 0 7 0 32 2 0 0 12 0 + 27 4 0 7 20 0 7 7 34 3 0 7 20 0 7 24 + 2 0 7 20 0 22 2 0 17 12 0 19 2 0 14 + 12 0 16 2 0 10 12 0 13 2 0 14 12 0 15 + 1 0 10 0 11))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp new file mode 100644 index 00000000..eb1fd581 --- /dev/null +++ b/src/algebra/strap/CLAGG.lsp @@ -0,0 +1,104 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Collection;CAT| 'NIL) + +(DEFPARAMETER |Collection;AL| 'NIL) + +(DEFUN |Collection| (#0=#:G1398) + (LET (#1=#:G1399) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |Collection;AL|)) + (CDR #1#)) + (T (SETQ |Collection;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|Collection;| #0#))) + |Collection;AL|)) + #1#)))) + +(DEFUN |Collection;| (|t#1|) + (PROG (#0=#:G1397) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|Collection;CAT|) + ('T + (LETT |Collection;CAT| + (|Join| (|HomogeneousAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|construct| + ($ (|List| |t#1|))) + T) + ((|find| + ((|Union| |t#1| "failed") + (|Mapping| (|Boolean|) + |t#1|) + $)) + T) + ((|reduce| + (|t#1| + (|Mapping| |t#1| |t#1| + |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|reduce| + (|t#1| + (|Mapping| |t#1| |t#1| + |t#1|) + $ |t#1|)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|remove| + ($ + (|Mapping| (|Boolean|) + |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|select| + ($ + (|Mapping| (|Boolean|) + |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|reduce| + (|t#1| + (|Mapping| |t#1| |t#1| + |t#1|) + $ |t#1| |t#1|)) + (AND + (|has| |t#1| + (|SetCategory|)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|)))) + ((|remove| ($ |t#1| $)) + (AND + (|has| |t#1| + (|SetCategory|)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|)))) + ((|removeDuplicates| ($ $)) + (AND + (|has| |t#1| + (|SetCategory|)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))))) + '(((|ConvertibleTo| + (|InputForm|)) + (|has| |t#1| + (|ConvertibleTo| + (|InputForm|))))) + '((|List| |t#1|)) NIL)) + . #1=(|Collection|))))) . #1#) + (SETELT #0# 0 (LIST '|Collection| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/COMRING.lsp b/src/algebra/strap/COMRING.lsp new file mode 100644 index 00000000..fc0f6ace --- /dev/null +++ b/src/algebra/strap/COMRING.lsp @@ -0,0 +1,22 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |CommutativeRing;AL| 'NIL) + +(DEFUN |CommutativeRing| () + (LET (#:G1387) + (COND + (|CommutativeRing;AL|) + (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|)))))) + +(DEFUN |CommutativeRing;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Ring|) (|BiModule| '$ '$) + (|mkCategory| '|package| NIL + '(((|commutative| "*") T)) 'NIL NIL)) + |CommutativeRing|) + (SETELT #0# 0 '(|CommutativeRing|)))))) + +(MAKEPROP '|CommutativeRing| 'NILADIC T) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp new file mode 100644 index 00000000..84f447f4 --- /dev/null +++ b/src/algebra/strap/DFLOAT.lsp @@ -0,0 +1,872 @@ + +(/VERSIONCHECK 2) + +(DEFUN |DFLOAT;doubleFloatFormat;2S;1| (|s| $) + (PROG (|ss|) + (RETURN + (SEQ (LETT |ss| (|getShellEntry| $ 6) + |DFLOAT;doubleFloatFormat;2S;1|) + (SETELT $ 6 |s|) (EXIT |ss|))))) + +(DEFUN |DFLOAT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |DFLOAT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |DFLOAT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 10)) + (|getShellEntry| $ 12)) + |DFLOAT;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 14)) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (SPADCALL |dev| (|getShellEntry| $ 17)) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |DFLOAT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |DFLOAT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |DFLOAT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) + |DFLOAT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 10)) + (|getShellEntry| $ 12)) + |DFLOAT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 14)))) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) + |DFLOAT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |DFLOAT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 14)) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 17))))) + +(DEFUN |DFLOAT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 14)))) + (SPADCALL |dev| |x| (|getShellEntry| $ 16)) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17))))))) + +(PUT '|DFLOAT;checkComplex| '|SPADreplace| 'C-TO-R) + +(DEFUN |DFLOAT;checkComplex| (|x| $) (C-TO-R |x|)) + +(PUT '|DFLOAT;base;Pi;7| '|SPADreplace| '(XLAM NIL (FLOAT-RADIX 0.0))) + +(DEFUN |DFLOAT;base;Pi;7| ($) (FLOAT-RADIX 0.0)) + +(DEFUN |DFLOAT;mantissa;$I;8| (|x| $) (QCAR (|DFLOAT;manexp| |x| $))) + +(DEFUN |DFLOAT;exponent;$I;9| (|x| $) (QCDR (|DFLOAT;manexp| |x| $))) + +(PUT '|DFLOAT;precision;Pi;10| '|SPADreplace| + '(XLAM NIL (FLOAT-DIGITS 0.0))) + +(DEFUN |DFLOAT;precision;Pi;10| ($) (FLOAT-DIGITS 0.0)) + +(DEFUN |DFLOAT;bits;Pi;11| ($) + (PROG (#0=#:G1419) + (RETURN + (COND + ((EQL (FLOAT-RADIX 0.0) 2) (FLOAT-DIGITS 0.0)) + ((EQL (FLOAT-RADIX 0.0) 16) (* 4 (FLOAT-DIGITS 0.0))) + ('T + (PROG1 (LETT #0# + (FIX (SPADCALL (FLOAT-DIGITS 0.0) + (SPADCALL + (FLOAT (FLOAT-RADIX 0.0) + MOST-POSITIVE-LONG-FLOAT) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 31))) + |DFLOAT;bits;Pi;11|) + (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#))))))) + +(PUT '|DFLOAT;max;$;12| '|SPADreplace| + '(XLAM NIL MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |DFLOAT;max;$;12| ($) MOST-POSITIVE-LONG-FLOAT) + +(PUT '|DFLOAT;min;$;13| '|SPADreplace| + '(XLAM NIL MOST-NEGATIVE-LONG-FLOAT)) + +(DEFUN |DFLOAT;min;$;13| ($) MOST-NEGATIVE-LONG-FLOAT) + +(DEFUN |DFLOAT;order;$I;14| (|a| $) + (- (+ (FLOAT-DIGITS 0.0) (SPADCALL |a| (|getShellEntry| $ 28))) 1)) + +(PUT '|DFLOAT;Zero;$;15| '|SPADreplace| + '(XLAM NIL (FLOAT 0 MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |DFLOAT;Zero;$;15| ($) (FLOAT 0 MOST-POSITIVE-LONG-FLOAT)) + +(PUT '|DFLOAT;One;$;16| '|SPADreplace| + '(XLAM NIL (FLOAT 1 MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |DFLOAT;One;$;16| ($) (FLOAT 1 MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |DFLOAT;exp1;$;17| ($) + (/ (FLOAT 534625820200 MOST-POSITIVE-LONG-FLOAT) + (FLOAT 196677847971 MOST-POSITIVE-LONG-FLOAT))) + +(PUT '|DFLOAT;pi;$;18| '|SPADreplace| '(XLAM NIL PI)) + +(DEFUN |DFLOAT;pi;$;18| ($) PI) + +(DEFUN |DFLOAT;coerce;$Of;19| (|x| $) + (SPADCALL (FORMAT NIL (|getShellEntry| $ 6) |x|) + (|getShellEntry| $ 41))) + +(DEFUN |DFLOAT;convert;$If;20| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 44))) + +(PUT '|DFLOAT;<;2$B;21| '|SPADreplace| '<) + +(DEFUN |DFLOAT;<;2$B;21| (|x| |y| $) (< |x| |y|)) + +(PUT '|DFLOAT;-;2$;22| '|SPADreplace| '-) + +(DEFUN |DFLOAT;-;2$;22| (|x| $) (- |x|)) + +(PUT '|DFLOAT;+;3$;23| '|SPADreplace| '+) + +(DEFUN |DFLOAT;+;3$;23| (|x| |y| $) (+ |x| |y|)) + +(PUT '|DFLOAT;-;3$;24| '|SPADreplace| '-) + +(DEFUN |DFLOAT;-;3$;24| (|x| |y| $) (- |x| |y|)) + +(PUT '|DFLOAT;*;3$;25| '|SPADreplace| '*) + +(DEFUN |DFLOAT;*;3$;25| (|x| |y| $) (* |x| |y|)) + +(PUT '|DFLOAT;*;I2$;26| '|SPADreplace| '*) + +(DEFUN |DFLOAT;*;I2$;26| (|i| |x| $) (* |i| |x|)) + +(PUT '|DFLOAT;max;3$;27| '|SPADreplace| 'MAX) + +(DEFUN |DFLOAT;max;3$;27| (|x| |y| $) (MAX |x| |y|)) + +(PUT '|DFLOAT;min;3$;28| '|SPADreplace| 'MIN) + +(DEFUN |DFLOAT;min;3$;28| (|x| |y| $) (MIN |x| |y|)) + +(PUT '|DFLOAT;=;2$B;29| '|SPADreplace| '=) + +(DEFUN |DFLOAT;=;2$B;29| (|x| |y| $) (= |x| |y|)) + +(PUT '|DFLOAT;/;$I$;30| '|SPADreplace| '/) + +(DEFUN |DFLOAT;/;$I$;30| (|x| |i| $) (/ |x| |i|)) + +(DEFUN |DFLOAT;sqrt;2$;31| (|x| $) + (|DFLOAT;checkComplex| (SQRT |x|) $)) + +(DEFUN |DFLOAT;log10;2$;32| (|x| $) + (|DFLOAT;checkComplex| (|log| |x|) $)) + +(PUT '|DFLOAT;**;$I$;33| '|SPADreplace| 'EXPT) + +(DEFUN |DFLOAT;**;$I$;33| (|x| |i| $) (EXPT |x| |i|)) + +(DEFUN |DFLOAT;**;3$;34| (|x| |y| $) + (|DFLOAT;checkComplex| (EXPT |x| |y|) $)) + +(PUT '|DFLOAT;coerce;I$;35| '|SPADreplace| + '(XLAM (|i|) (FLOAT |i| MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |DFLOAT;coerce;I$;35| (|i| $) + (FLOAT |i| MOST-POSITIVE-LONG-FLOAT)) + +(PUT '|DFLOAT;exp;2$;36| '|SPADreplace| 'EXP) + +(DEFUN |DFLOAT;exp;2$;36| (|x| $) (EXP |x|)) + +(DEFUN |DFLOAT;log;2$;37| (|x| $) (|DFLOAT;checkComplex| (LN |x|) $)) + +(DEFUN |DFLOAT;log2;2$;38| (|x| $) + (|DFLOAT;checkComplex| (LOG2 |x|) $)) + +(PUT '|DFLOAT;sin;2$;39| '|SPADreplace| 'SIN) + +(DEFUN |DFLOAT;sin;2$;39| (|x| $) (SIN |x|)) + +(PUT '|DFLOAT;cos;2$;40| '|SPADreplace| 'COS) + +(DEFUN |DFLOAT;cos;2$;40| (|x| $) (COS |x|)) + +(PUT '|DFLOAT;tan;2$;41| '|SPADreplace| 'TAN) + +(DEFUN |DFLOAT;tan;2$;41| (|x| $) (TAN |x|)) + +(PUT '|DFLOAT;cot;2$;42| '|SPADreplace| 'COT) + +(DEFUN |DFLOAT;cot;2$;42| (|x| $) (COT |x|)) + +(PUT '|DFLOAT;sec;2$;43| '|SPADreplace| 'SEC) + +(DEFUN |DFLOAT;sec;2$;43| (|x| $) (SEC |x|)) + +(PUT '|DFLOAT;csc;2$;44| '|SPADreplace| 'CSC) + +(DEFUN |DFLOAT;csc;2$;44| (|x| $) (CSC |x|)) + +(DEFUN |DFLOAT;asin;2$;45| (|x| $) + (|DFLOAT;checkComplex| (ASIN |x|) $)) + +(DEFUN |DFLOAT;acos;2$;46| (|x| $) + (|DFLOAT;checkComplex| (ACOS |x|) $)) + +(PUT '|DFLOAT;atan;2$;47| '|SPADreplace| 'ATAN) + +(DEFUN |DFLOAT;atan;2$;47| (|x| $) (ATAN |x|)) + +(DEFUN |DFLOAT;acsc;2$;48| (|x| $) + (|DFLOAT;checkComplex| (ACSC |x|) $)) + +(PUT '|DFLOAT;acot;2$;49| '|SPADreplace| 'ACOT) + +(DEFUN |DFLOAT;acot;2$;49| (|x| $) (ACOT |x|)) + +(DEFUN |DFLOAT;asec;2$;50| (|x| $) + (|DFLOAT;checkComplex| (ASEC |x|) $)) + +(PUT '|DFLOAT;sinh;2$;51| '|SPADreplace| 'SINH) + +(DEFUN |DFLOAT;sinh;2$;51| (|x| $) (SINH |x|)) + +(PUT '|DFLOAT;cosh;2$;52| '|SPADreplace| 'COSH) + +(DEFUN |DFLOAT;cosh;2$;52| (|x| $) (COSH |x|)) + +(PUT '|DFLOAT;tanh;2$;53| '|SPADreplace| 'TANH) + +(DEFUN |DFLOAT;tanh;2$;53| (|x| $) (TANH |x|)) + +(PUT '|DFLOAT;csch;2$;54| '|SPADreplace| 'CSCH) + +(DEFUN |DFLOAT;csch;2$;54| (|x| $) (CSCH |x|)) + +(PUT '|DFLOAT;coth;2$;55| '|SPADreplace| 'COTH) + +(DEFUN |DFLOAT;coth;2$;55| (|x| $) (COTH |x|)) + +(PUT '|DFLOAT;sech;2$;56| '|SPADreplace| 'SECH) + +(DEFUN |DFLOAT;sech;2$;56| (|x| $) (SECH |x|)) + +(PUT '|DFLOAT;asinh;2$;57| '|SPADreplace| 'ASINH) + +(DEFUN |DFLOAT;asinh;2$;57| (|x| $) (ASINH |x|)) + +(DEFUN |DFLOAT;acosh;2$;58| (|x| $) + (|DFLOAT;checkComplex| (ACOSH |x|) $)) + +(DEFUN |DFLOAT;atanh;2$;59| (|x| $) + (|DFLOAT;checkComplex| (ATANH |x|) $)) + +(PUT '|DFLOAT;acsch;2$;60| '|SPADreplace| 'ACSCH) + +(DEFUN |DFLOAT;acsch;2$;60| (|x| $) (ACSCH |x|)) + +(DEFUN |DFLOAT;acoth;2$;61| (|x| $) + (|DFLOAT;checkComplex| (ACOTH |x|) $)) + +(DEFUN |DFLOAT;asech;2$;62| (|x| $) + (|DFLOAT;checkComplex| (ASECH |x|) $)) + +(PUT '|DFLOAT;/;3$;63| '|SPADreplace| '/) + +(DEFUN |DFLOAT;/;3$;63| (|x| |y| $) (/ |x| |y|)) + +(PUT '|DFLOAT;negative?;$B;64| '|SPADreplace| 'MINUSP) + +(DEFUN |DFLOAT;negative?;$B;64| (|x| $) (MINUSP |x|)) + +(PUT '|DFLOAT;zero?;$B;65| '|SPADreplace| 'ZEROP) + +(DEFUN |DFLOAT;zero?;$B;65| (|x| $) (ZEROP |x|)) + +(PUT '|DFLOAT;hash;$I;66| '|SPADreplace| 'HASHEQ) + +(DEFUN |DFLOAT;hash;$I;66| (|x| $) (HASHEQ |x|)) + +(DEFUN |DFLOAT;recip;$U;67| (|x| $) + (COND ((ZEROP |x|) (CONS 1 "failed")) ('T (CONS 0 (/ 1.0 |x|))))) + +(PUT '|DFLOAT;differentiate;2$;68| '|SPADreplace| '(XLAM (|x|) 0.0)) + +(DEFUN |DFLOAT;differentiate;2$;68| (|x| $) 0.0) + +(DEFUN |DFLOAT;Gamma;2$;69| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 95))) + +(DEFUN |DFLOAT;Beta;3$;70| (|x| |y| $) + (SPADCALL |x| |y| (|getShellEntry| $ 97))) + +(PUT '|DFLOAT;wholePart;$I;71| '|SPADreplace| 'FIX) + +(DEFUN |DFLOAT;wholePart;$I;71| (|x| $) (FIX |x|)) + +(DEFUN |DFLOAT;float;2IPi$;72| (|ma| |ex| |b| $) + (* |ma| (EXPT (FLOAT |b| MOST-POSITIVE-LONG-FLOAT) |ex|))) + +(PUT '|DFLOAT;convert;$Df;73| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |DFLOAT;convert;$Df;73| (|x| $) |x|) + +(DEFUN |DFLOAT;convert;$F;74| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 103))) + +(DEFUN |DFLOAT;rationalApproximation;$NniF;75| (|x| |d| $) + (SPADCALL |x| |d| 10 (|getShellEntry| $ 107))) + +(DEFUN |DFLOAT;atan;3$;76| (|x| |y| $) + (PROG (|theta|) + (RETURN + (SEQ (COND + ((= |x| 0.0) + (COND + ((< 0.0 |y|) (/ PI 2)) + ((< |y| 0.0) (- (/ PI 2))) + ('T 0.0))) + ('T + (SEQ (LETT |theta| (ATAN (FLOAT-SIGN 1.0 (/ |y| |x|))) + |DFLOAT;atan;3$;76|) + (COND + ((< |x| 0.0) + (LETT |theta| (- PI |theta|) |DFLOAT;atan;3$;76|))) + (COND + ((< |y| 0.0) + (LETT |theta| (- |theta|) |DFLOAT;atan;3$;76|))) + (EXIT |theta|)))))))) + +(DEFUN |DFLOAT;retract;$F;77| (|x| $) + (PROG (#0=#:G1494) + (RETURN + (SPADCALL |x| + (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1) + |DFLOAT;retract;$F;77|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) + (FLOAT-RADIX 0.0) (|getShellEntry| $ 107))))) + +(DEFUN |DFLOAT;retractIfCan;$U;78| (|x| $) + (PROG (#0=#:G1499) + (RETURN + (CONS 0 + (SPADCALL |x| + (PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1) + |DFLOAT;retractIfCan;$U;78|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) + #0#)) + (FLOAT-RADIX 0.0) (|getShellEntry| $ 107)))))) + +(DEFUN |DFLOAT;retract;$I;79| (|x| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| (FIX |x|) |DFLOAT;retract;$I;79|) + (EXIT (COND + ((= |x| (FLOAT |n| MOST-POSITIVE-LONG-FLOAT)) |n|) + ('T (|error| "Not an integer")))))))) + +(DEFUN |DFLOAT;retractIfCan;$U;80| (|x| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| (FIX |x|) |DFLOAT;retractIfCan;$U;80|) + (EXIT (COND + ((= |x| (FLOAT |n| MOST-POSITIVE-LONG-FLOAT)) + (CONS 0 |n|)) + ('T (CONS 1 "failed")))))))) + +(DEFUN |DFLOAT;sign;$I;81| (|x| $) + (SPADCALL (FLOAT-SIGN |x| 1.0) (|getShellEntry| $ 113))) + +(PUT '|DFLOAT;abs;2$;82| '|SPADreplace| + '(XLAM (|x|) (FLOAT-SIGN 1.0 |x|))) + +(DEFUN |DFLOAT;abs;2$;82| (|x| $) (FLOAT-SIGN 1.0 |x|)) + +(DEFUN |DFLOAT;manexp| (|x| $) + (PROG (|s| #0=#:G1520 |me| |two53|) + (RETURN + (SEQ (EXIT (COND + ((ZEROP |x|) (CONS 0 0)) + ('T + (SEQ (LETT |s| + (SPADCALL |x| (|getShellEntry| $ 116)) + |DFLOAT;manexp|) + (LETT |x| (FLOAT-SIGN 1.0 |x|) + |DFLOAT;manexp|) + (COND + ((< MOST-POSITIVE-LONG-FLOAT |x|) + (PROGN + (LETT #0# + (CONS + (+ + (* |s| + (SPADCALL + MOST-POSITIVE-LONG-FLOAT + (|getShellEntry| $ 27))) + 1) + (SPADCALL MOST-POSITIVE-LONG-FLOAT + (|getShellEntry| $ 28))) + |DFLOAT;manexp|) + (GO #0#)))) + (LETT |me| (MANEXP |x|) |DFLOAT;manexp|) + (LETT |two53| + (EXPT (FLOAT-RADIX 0.0) + (FLOAT-DIGITS 0.0)) + |DFLOAT;manexp|) + (EXIT (CONS (* |s| + (FIX (* |two53| (QCAR |me|)))) + (- (QCDR |me|) (FLOAT-DIGITS 0.0)))))))) + #0# (EXIT #0#))))) + +(DEFUN |DFLOAT;rationalApproximation;$2NniF;84| (|f| |d| |b| $) + (PROG (|#G103| |nu| |ex| BASE #0=#:G1523 |de| |tol| |#G104| |q| |r| + |p2| |q2| #1=#:G1541 |#G105| |#G106| |p0| |p1| |#G107| + |#G108| |q0| |q1| |#G109| |#G110| |s| |t| #2=#:G1539) + (RETURN + (SEQ (EXIT (SEQ (PROGN + (LETT |#G103| (|DFLOAT;manexp| |f| $) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |nu| (QCAR |#G103|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |ex| (QCDR |#G103|) + |DFLOAT;rationalApproximation;$2NniF;84|) + |#G103|) + (LETT BASE (FLOAT-RADIX 0.0) + |DFLOAT;rationalApproximation;$2NniF;84|) + (EXIT (COND + ((< |ex| 0) + (SEQ (LETT |de| + (EXPT BASE + (PROG1 + (LETT #0# (- |ex|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#))) + |DFLOAT;rationalApproximation;$2NniF;84|) + (EXIT + (COND + ((< |b| 2) + (|error| "base must be > 1")) + ('T + (SEQ + (LETT |tol| (EXPT |b| |d|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |s| |nu| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |t| |de| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p0| 0 + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p1| 1 + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q0| 1 + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q1| 0 + |DFLOAT;rationalApproximation;$2NniF;84|) + (EXIT + (SEQ G190 NIL + (SEQ + (PROGN + (LETT |#G104| + (DIVIDE2 |s| |t|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q| (QCAR |#G104|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |r| (QCDR |#G104|) + |DFLOAT;rationalApproximation;$2NniF;84|) + |#G104|) + (LETT |p2| + (+ (* |q| |p1|) |p0|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q2| + (+ (* |q| |q1|) |q0|) + |DFLOAT;rationalApproximation;$2NniF;84|) + (COND + ((OR (EQL |r| 0) + (< + (SPADCALL |tol| + (ABS + (- (* |nu| |q2|) + (* |de| |p2|))) + (|getShellEntry| $ + 120)) + (* |de| (ABS |p2|)))) + (EXIT + (PROGN + (LETT #1# + (SPADCALL |p2| |q2| + (|getShellEntry| $ + 119)) + |DFLOAT;rationalApproximation;$2NniF;84|) + (GO #1#))))) + (PROGN + (LETT |#G105| |p1| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |#G106| |p2| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p0| |#G105| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |p1| |#G106| + |DFLOAT;rationalApproximation;$2NniF;84|)) + (PROGN + (LETT |#G107| |q1| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |#G108| |q2| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q0| |#G107| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |q1| |#G108| + |DFLOAT;rationalApproximation;$2NniF;84|)) + (EXIT + (PROGN + (LETT |#G109| |t| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |#G110| |r| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |s| |#G109| + |DFLOAT;rationalApproximation;$2NniF;84|) + (LETT |t| |#G110| + |DFLOAT;rationalApproximation;$2NniF;84|)))) + NIL (GO G190) G191 + (EXIT NIL))))))))) + ('T + (SPADCALL + (* |nu| + (EXPT BASE + (PROG1 + (LETT #2# |ex| + |DFLOAT;rationalApproximation;$2NniF;84|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)))) + (|getShellEntry| $ 121))))))) + #1# (EXIT #1#))))) + +(DEFUN |DFLOAT;**;$F$;85| (|x| |r| $) + (PROG (|n| |d| #0=#:G1550) + (RETURN + (SEQ (EXIT (COND + ((ZEROP |x|) + (COND + ((SPADCALL |r| (|getShellEntry| $ 122)) + (|error| "0**0 is undefined")) + ((SPADCALL |r| (|getShellEntry| $ 123)) + (|error| "division by 0")) + ('T 0.0))) + ((OR (SPADCALL |r| (|getShellEntry| $ 122)) + (= |x| 1.0)) + 1.0) + ('T + (COND + ((SPADCALL |r| (|spadConstant| $ 124) + (|getShellEntry| $ 125)) + |x|) + ('T + (SEQ (LETT |n| + (SPADCALL |r| + (|getShellEntry| $ 126)) + |DFLOAT;**;$F$;85|) + (LETT |d| + (SPADCALL |r| + (|getShellEntry| $ 127)) + |DFLOAT;**;$F$;85|) + (EXIT (COND + ((MINUSP |x|) + (COND + ((ODDP |d|) + (COND + ((ODDP |n|) + (PROGN + (LETT #0# + (- + (SPADCALL (- |x|) |r| + (|getShellEntry| $ 128))) + |DFLOAT;**;$F$;85|) + (GO #0#))) + ('T + (PROGN + (LETT #0# + (SPADCALL (- |x|) |r| + (|getShellEntry| $ 128)) + |DFLOAT;**;$F$;85|) + (GO #0#))))) + ('T (|error| "negative root")))) + ((EQL |d| 2) + (EXPT + (SPADCALL |x| + (|getShellEntry| $ 56)) + |n|)) + ('T + (SPADCALL |x| + (/ + (FLOAT |n| + MOST-POSITIVE-LONG-FLOAT) + (FLOAT |d| + MOST-POSITIVE-LONG-FLOAT)) + (|getShellEntry| $ 59))))))))))) + #0# (EXIT #0#))))) + +(DEFUN |DoubleFloat| () + (PROG () + (RETURN + (PROG (#0=#:G1563) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|DoubleFloat|) + |DoubleFloat|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|DoubleFloat| + (LIST + (CONS NIL + (CONS 1 (|DoubleFloat;|)))))) + (LETT #0# T |DoubleFloat|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|DoubleFloat|))))))))))) + +(DEFUN |DoubleFloat;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|DoubleFloat|) . #0=(|DoubleFloat|)) + (LETT $ (|newShell| 142) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|DoubleFloat| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 "~G") + $)))) + +(MAKEPROP '|DoubleFloat| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL '|format| (|String|) + |DFLOAT;doubleFloatFormat;2S;1| (|OpenMathEncoding|) + (0 . |OMencodingXML|) (|OpenMathDevice|) + (4 . |OMopenString|) (|Void|) (10 . |OMputObject|) + (|DoubleFloat|) (15 . |OMputFloat|) + (21 . |OMputEndObject|) (26 . |OMclose|) + |DFLOAT;OMwrite;$S;2| (|Boolean|) |DFLOAT;OMwrite;$BS;3| + |DFLOAT;OMwrite;Omd$V;4| |DFLOAT;OMwrite;Omd$BV;5| + (|PositiveInteger|) |DFLOAT;base;Pi;7| (|Integer|) + |DFLOAT;mantissa;$I;8| |DFLOAT;exponent;$I;9| + |DFLOAT;precision;Pi;10| |DFLOAT;log2;2$;38| (31 . *) + |DFLOAT;bits;Pi;11| |DFLOAT;max;$;12| |DFLOAT;min;$;13| + |DFLOAT;order;$I;14| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |DFLOAT;Zero;$;15|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |DFLOAT;One;$;16|) $)) + |DFLOAT;exp1;$;17| |DFLOAT;pi;$;18| (|OutputForm|) + (37 . |outputForm|) |DFLOAT;coerce;$Of;19| (|InputForm|) + (42 . |convert|) |DFLOAT;convert;$If;20| |DFLOAT;<;2$B;21| + |DFLOAT;-;2$;22| |DFLOAT;+;3$;23| |DFLOAT;-;3$;24| + |DFLOAT;*;3$;25| |DFLOAT;*;I2$;26| |DFLOAT;max;3$;27| + |DFLOAT;min;3$;28| |DFLOAT;=;2$B;29| |DFLOAT;/;$I$;30| + |DFLOAT;sqrt;2$;31| |DFLOAT;log10;2$;32| + |DFLOAT;**;$I$;33| |DFLOAT;**;3$;34| |DFLOAT;coerce;I$;35| + |DFLOAT;exp;2$;36| |DFLOAT;log;2$;37| |DFLOAT;sin;2$;39| + |DFLOAT;cos;2$;40| |DFLOAT;tan;2$;41| |DFLOAT;cot;2$;42| + |DFLOAT;sec;2$;43| |DFLOAT;csc;2$;44| |DFLOAT;asin;2$;45| + |DFLOAT;acos;2$;46| |DFLOAT;atan;2$;47| + |DFLOAT;acsc;2$;48| |DFLOAT;acot;2$;49| + |DFLOAT;asec;2$;50| |DFLOAT;sinh;2$;51| + |DFLOAT;cosh;2$;52| |DFLOAT;tanh;2$;53| + |DFLOAT;csch;2$;54| |DFLOAT;coth;2$;55| + |DFLOAT;sech;2$;56| |DFLOAT;asinh;2$;57| + |DFLOAT;acosh;2$;58| |DFLOAT;atanh;2$;59| + |DFLOAT;acsch;2$;60| |DFLOAT;acoth;2$;61| + |DFLOAT;asech;2$;62| |DFLOAT;/;3$;63| + |DFLOAT;negative?;$B;64| |DFLOAT;zero?;$B;65| + |DFLOAT;hash;$I;66| (|Union| $ '"failed") + |DFLOAT;recip;$U;67| |DFLOAT;differentiate;2$;68| + (|DoubleFloatSpecialFunctions|) (47 . |Gamma|) + |DFLOAT;Gamma;2$;69| (52 . |Beta|) |DFLOAT;Beta;3$;70| + |DFLOAT;wholePart;$I;71| |DFLOAT;float;2IPi$;72| + |DFLOAT;convert;$Df;73| (|Float|) (58 . |convert|) + |DFLOAT;convert;$F;74| (|Fraction| 26) + (|NonNegativeInteger|) + |DFLOAT;rationalApproximation;$2NniF;84| + |DFLOAT;rationalApproximation;$NniF;75| + |DFLOAT;atan;3$;76| |DFLOAT;retract;$F;77| + (|Union| 105 '"failed") |DFLOAT;retractIfCan;$U;78| + |DFLOAT;retract;$I;79| (|Union| 26 '"failed") + |DFLOAT;retractIfCan;$U;80| |DFLOAT;sign;$I;81| + |DFLOAT;abs;2$;82| (63 . |Zero|) (67 . /) (73 . *) + (79 . |coerce|) (84 . |zero?|) (89 . |negative?|) + (94 . |One|) (98 . =) (104 . |numer|) (109 . |denom|) + |DFLOAT;**;$F$;85| (|PatternMatchResult| 102 $) + (|Pattern| 102) (|Factored| $) (|List| $) + (|Union| 132 '"failed") + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 135 '"failed") + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (|Record| (|:| |coef| 132) (|:| |generator| $)) + (|SparseUnivariatePolynomial| $) + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (|SingleInteger|)) + '#(~= 114 |zero?| 120 |wholePart| 125 |unitNormal| 130 + |unitCanonical| 135 |unit?| 140 |truncate| 145 |tanh| 150 + |tan| 155 |subtractIfCan| 160 |squareFreePart| 166 + |squareFree| 171 |sqrt| 176 |sizeLess?| 181 |sinh| 187 + |sin| 192 |sign| 197 |sech| 202 |sec| 207 |sample| 212 + |round| 216 |retractIfCan| 221 |retract| 231 |rem| 241 + |recip| 247 |rationalApproximation| 252 |quo| 265 + |principalIdeal| 271 |prime?| 276 |precision| 281 + |positive?| 285 |pi| 290 |patternMatch| 294 |order| 301 + |one?| 306 |nthRoot| 311 |norm| 317 |negative?| 322 + |multiEuclidean| 327 |min| 333 |max| 343 |mantissa| 353 + |log2| 358 |log10| 363 |log| 368 |lcm| 373 |latex| 384 + |inv| 389 |hash| 394 |gcdPolynomial| 404 |gcd| 410 + |fractionPart| 421 |floor| 426 |float| 431 |factor| 444 + |extendedEuclidean| 449 |exquo| 462 |expressIdealMember| + 468 |exponent| 474 |exp1| 479 |exp| 483 |euclideanSize| + 488 |doubleFloatFormat| 493 |divide| 498 |digits| 504 + |differentiate| 508 |csch| 519 |csc| 524 |coth| 529 |cot| + 534 |cosh| 539 |cos| 544 |convert| 549 |coerce| 569 + |characteristic| 599 |ceiling| 603 |bits| 608 |base| 612 + |atanh| 616 |atan| 621 |associates?| 632 |asinh| 638 + |asin| 643 |asech| 648 |asec| 653 |acsch| 658 |acsc| 663 + |acoth| 668 |acot| 673 |acosh| 678 |acos| 683 |abs| 688 ^ + 693 |Zero| 711 |One| 715 |OMwrite| 719 |Gamma| 743 D 748 + |Beta| 759 >= 765 > 771 = 777 <= 783 < 789 / 795 - 807 + + 818 ** 824 * 854) + '((|approximate| . 0) (|canonicalsClosed| . 0) + (|canonicalUnitNormal| . 0) (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) (|rightUnitary| . 0) + (|leftUnitary| . 0) (|unitsKnown| . 0)) + (CONS (|makeByteWordVec2| 1 + '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0)) + (CONS '#(|FloatingPointSystem&| |RealNumberSystem&| + |Field&| |EuclideanDomain&| NIL + |UniqueFactorizationDomain&| |GcdDomain&| + |DivisionRing&| |IntegralDomain&| |Algebra&| + |Algebra&| |DifferentialRing&| NIL + |OrderedRing&| |Module&| NIL NIL |Module&| NIL + NIL NIL |Ring&| NIL NIL NIL NIL NIL NIL NIL + |AbelianGroup&| NIL NIL |AbelianMonoid&| + |Monoid&| NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| + |TranscendentalFunctionCategory&| NIL + |SetCategory&| NIL + |ElementaryFunctionCategory&| NIL + |HyperbolicFunctionCategory&| + |ArcTrigonometricFunctionCategory&| + |TrigonometricFunctionCategory&| NIL NIL + |RadicalCategory&| |RetractableTo&| + |RetractableTo&| NIL NIL |BasicType&| NIL) + (CONS '#((|FloatingPointSystem|) + (|RealNumberSystem|) (|Field|) + (|EuclideanDomain|) + (|PrincipalIdealDomain|) + (|UniqueFactorizationDomain|) + (|GcdDomain|) (|DivisionRing|) + (|IntegralDomain|) (|Algebra| 105) + (|Algebra| $$) (|DifferentialRing|) + (|CharacteristicZero|) (|OrderedRing|) + (|Module| 105) (|EntireRing|) + (|CommutativeRing|) (|Module| $$) + (|OrderedAbelianGroup|) + (|BiModule| 105 105) (|BiModule| $$ $$) + (|Ring|) + (|OrderedCancellationAbelianMonoid|) + (|RightModule| 105) (|LeftModule| 105) + (|LeftModule| $$) (|Rng|) + (|RightModule| $$) + (|OrderedAbelianMonoid|) + (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) + (|PatternMatchable| 102) (|OrderedSet|) + (|AbelianSemiGroup|) (|SemiGroup|) + (|TranscendentalFunctionCategory|) + (|RealConstant|) (|SetCategory|) + (|ConvertibleTo| 43) + (|ElementaryFunctionCategory|) + (|ArcHyperbolicFunctionCategory|) + (|HyperbolicFunctionCategory|) + (|ArcTrigonometricFunctionCategory|) + (|TrigonometricFunctionCategory|) + (|OpenMath|) (|ConvertibleTo| 130) + (|RadicalCategory|) + (|RetractableTo| 105) + (|RetractableTo| 26) + (|ConvertibleTo| 102) + (|ConvertibleTo| 15) (|BasicType|) + (|CoercibleTo| 40)) + (|makeByteWordVec2| 141 + '(0 9 0 10 2 11 0 7 9 12 1 11 13 0 14 2 + 11 13 0 15 16 1 11 13 0 17 1 11 13 0 + 18 2 0 0 24 0 31 1 40 0 15 41 1 43 0 + 15 44 1 94 15 15 95 2 94 15 15 15 97 + 1 102 0 15 103 0 105 0 118 2 105 0 26 + 26 119 2 26 0 106 0 120 1 105 0 26 + 121 1 105 20 0 122 1 105 20 0 123 0 + 105 0 124 2 105 20 0 0 125 1 105 26 0 + 126 1 105 26 0 127 2 0 20 0 0 1 1 0 + 20 0 89 1 0 26 0 99 1 0 140 0 1 1 0 0 + 0 1 1 0 20 0 1 1 0 0 0 1 1 0 0 0 77 1 + 0 0 0 65 2 0 91 0 0 1 1 0 0 0 1 1 0 + 131 0 1 1 0 0 0 56 2 0 20 0 0 1 1 0 0 + 0 75 1 0 0 0 63 1 0 26 0 116 1 0 0 0 + 80 1 0 0 0 67 0 0 0 1 1 0 0 0 1 1 0 + 111 0 112 1 0 114 0 115 1 0 105 0 110 + 1 0 26 0 113 2 0 0 0 0 1 1 0 91 0 92 + 2 0 105 0 106 108 3 0 105 0 106 106 + 107 2 0 0 0 0 1 1 0 138 132 1 1 0 20 + 0 1 0 0 24 29 1 0 20 0 1 0 0 0 39 3 0 + 129 0 130 129 1 1 0 26 0 35 1 0 20 0 + 1 2 0 0 0 26 1 1 0 0 0 1 1 0 20 0 88 + 2 0 133 132 0 1 0 0 0 34 2 0 0 0 0 53 + 0 0 0 33 2 0 0 0 0 52 1 0 26 0 27 1 0 + 0 0 30 1 0 0 0 57 1 0 0 0 62 1 0 0 + 132 1 2 0 0 0 0 1 1 0 7 0 1 1 0 0 0 1 + 1 0 26 0 90 1 0 141 0 1 2 0 139 139 + 139 1 1 0 0 132 1 2 0 0 0 0 1 1 0 0 0 + 1 1 0 0 0 1 3 0 0 26 26 24 100 2 0 0 + 26 26 1 1 0 131 0 1 2 0 134 0 0 1 3 0 + 136 0 0 0 1 2 0 91 0 0 1 2 0 133 132 + 0 1 1 0 26 0 28 0 0 0 38 1 0 0 0 61 1 + 0 106 0 1 1 0 7 7 8 2 0 137 0 0 1 0 0 + 24 1 1 0 0 0 93 2 0 0 0 106 1 1 0 0 0 + 78 1 0 0 0 68 1 0 0 0 79 1 0 0 0 66 1 + 0 0 0 76 1 0 0 0 64 1 0 43 0 45 1 0 + 130 0 1 1 0 102 0 104 1 0 15 0 101 1 + 0 0 105 1 1 0 0 26 60 1 0 0 105 1 1 0 + 0 26 60 1 0 0 0 1 1 0 40 0 42 0 0 106 + 1 1 0 0 0 1 0 0 24 32 0 0 24 25 1 0 0 + 0 83 2 0 0 0 0 109 1 0 0 0 71 2 0 20 + 0 0 1 1 0 0 0 81 1 0 0 0 69 1 0 0 0 + 86 1 0 0 0 74 1 0 0 0 84 1 0 0 0 72 1 + 0 0 0 85 1 0 0 0 73 1 0 0 0 82 1 0 0 + 0 70 1 0 0 0 117 2 0 0 0 26 1 2 0 0 0 + 106 1 2 0 0 0 24 1 0 0 0 36 0 0 0 37 + 3 0 13 11 0 20 23 2 0 7 0 20 21 2 0 + 13 11 0 22 1 0 7 0 19 1 0 0 0 96 1 0 + 0 0 1 2 0 0 0 106 1 2 0 0 0 0 98 2 0 + 20 0 0 1 2 0 20 0 0 1 2 0 20 0 0 54 2 + 0 20 0 0 1 2 0 20 0 0 46 2 0 0 0 26 + 55 2 0 0 0 0 87 2 0 0 0 0 49 1 0 0 0 + 47 2 0 0 0 0 48 2 0 0 0 0 59 2 0 0 0 + 105 128 2 0 0 0 26 58 2 0 0 0 106 1 2 + 0 0 0 24 1 2 0 0 0 105 1 2 0 0 105 0 + 1 2 0 0 0 0 50 2 0 0 26 0 51 2 0 0 + 106 0 1 2 0 0 24 0 31))))) + '|lookupComplete|)) + +(MAKEPROP '|DoubleFloat| 'NILADIC T) diff --git a/src/algebra/strap/DIFRING-.lsp b/src/algebra/strap/DIFRING-.lsp new file mode 100644 index 00000000..1fb59bfb --- /dev/null +++ b/src/algebra/strap/DIFRING-.lsp @@ -0,0 +1,46 @@ + +(/VERSIONCHECK 2) + +(DEFUN |DIFRING-;D;2S;1| (|r| $) (SPADCALL |r| (QREFELT $ 7))) + +(DEFUN |DIFRING-;differentiate;SNniS;2| (|r| |n| $) + (PROG (|i|) + (RETURN + (SEQ (SEQ (LETT |i| 1 |DIFRING-;differentiate;SNniS;2|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (EXIT (LETT |r| (SPADCALL |r| (QREFELT $ 7)) + |DIFRING-;differentiate;SNniS;2|))) + (LETT |i| (QSADD1 |i|) + |DIFRING-;differentiate;SNniS;2|) + (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |DIFRING-;D;SNniS;3| (|r| |n| $) + (SPADCALL |r| |n| (QREFELT $ 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 $ (GETREFV 13) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|DifferentialRing&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (0 . |differentiate|) |DIFRING-;D;2S;1| + (|NonNegativeInteger|) |DIFRING-;differentiate;SNniS;2| + (5 . |differentiate|) |DIFRING-;D;SNniS;3|) + '#(|differentiate| 11 D 17) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 12 + '(1 6 0 0 7 2 6 0 0 9 11 2 0 0 0 9 10 2 + 0 0 0 9 12 1 0 0 0 8))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/DIFRING.lsp b/src/algebra/strap/DIFRING.lsp new file mode 100644 index 00000000..3c823149 --- /dev/null +++ b/src/algebra/strap/DIFRING.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |DifferentialRing;AL| 'NIL) + +(DEFUN |DifferentialRing| () + (LET (#:G1387) + (COND + (|DifferentialRing;AL|) + (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|)))))) + +(DEFUN |DifferentialRing;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Ring|) + (|mkCategory| '|domain| + '(((|differentiate| ($ $)) T) + ((D ($ $)) T) + ((|differentiate| + ($ $ (|NonNegativeInteger|))) + T) + ((D ($ $ (|NonNegativeInteger|))) T)) + NIL '((|NonNegativeInteger|)) NIL)) + |DifferentialRing|) + (SETELT #0# 0 '(|DifferentialRing|)))))) + +(MAKEPROP '|DifferentialRing| 'NILADIC T) diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp new file mode 100644 index 00000000..e3efca81 --- /dev/null +++ b/src/algebra/strap/DIVRING-.lsp @@ -0,0 +1,56 @@ + +(/VERSIONCHECK 2) + +(DEFUN |DIVRING-;^;SIS;1| (|x| |n| $) + (SPADCALL |x| |n| (QREFELT $ 8))) + +(DEFUN |DIVRING-;**;SIS;2| (|x| |n| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 10)) + ((SPADCALL |x| (QREFELT $ 12)) + (COND ((< |n| 0) (|error| "division by zero")) ('T |x|))) + ((< |n| 0) + (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (- |n|) (QREFELT $ 17))) + ('T (SPADCALL |x| |n| (QREFELT $ 17))))) + +(DEFUN |DIVRING-;*;F2S;3| (|q| |x| $) + (SPADCALL + (SPADCALL (SPADCALL |q| (QREFELT $ 20)) + (SPADCALL + (SPADCALL (SPADCALL |q| (QREFELT $ 21)) (QREFELT $ 22)) + (QREFELT $ 14)) + (QREFELT $ 23)) + |x| (QREFELT $ 24))) + +(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 $ (GETREFV 27) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|DivisionRing&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Integer|) + (0 . **) |DIVRING-;^;SIS;1| (6 . |One|) (|Boolean|) + (10 . |zero?|) (15 . |Zero|) (19 . |inv|) + (|PositiveInteger|) (|RepeatedSquaring| 6) (24 . |expt|) + |DIVRING-;**;SIS;2| (|Fraction| 7) (30 . |numer|) + (35 . |denom|) (40 . |coerce|) (45 . *) (51 . *) + |DIVRING-;*;F2S;3| (|NonNegativeInteger|)) + '#(^ 57 ** 63 * 69) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 25 + '(2 6 0 0 7 8 0 6 0 10 1 6 11 0 12 0 6 + 0 13 1 6 0 0 14 2 16 6 6 15 17 1 19 7 + 0 20 1 19 7 0 21 1 6 0 7 22 2 6 0 7 0 + 23 2 6 0 0 0 24 2 0 0 0 7 9 2 0 0 0 7 + 18 2 0 0 19 0 25))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/DIVRING.lsp b/src/algebra/strap/DIVRING.lsp new file mode 100644 index 00000000..2523c524 --- /dev/null +++ b/src/algebra/strap/DIVRING.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |DivisionRing;AL| 'NIL) + +(DEFUN |DivisionRing| () + (LET (#:G1390) + (COND + (|DivisionRing;AL|) + (T (SETQ |DivisionRing;AL| (|DivisionRing;|)))))) + +(DEFUN |DivisionRing;| () + (PROG (#0=#:G1388) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1387) + (LIST '(|Fraction| (|Integer|)))) + (|Join| (|EntireRing|) (|Algebra| '#1#) + (|mkCategory| '|domain| + '(((** ($ $ (|Integer|))) T) + ((^ ($ $ (|Integer|))) T) + ((|inv| ($ $)) T)) + NIL '((|Integer|)) NIL))) + |DivisionRing|) + (SETELT #0# 0 '(|DivisionRing|)))))) + +(MAKEPROP '|DivisionRing| 'NILADIC T) diff --git a/src/algebra/strap/ENTIRER.lsp b/src/algebra/strap/ENTIRER.lsp new file mode 100644 index 00000000..1de80763 --- /dev/null +++ b/src/algebra/strap/ENTIRER.lsp @@ -0,0 +1,22 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |EntireRing;AL| 'NIL) + +(DEFUN |EntireRing| () + (LET (#:G1387) + (COND + (|EntireRing;AL|) + (T (SETQ |EntireRing;AL| (|EntireRing;|)))))) + +(DEFUN |EntireRing;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Ring|) (|BiModule| '$ '$) + (|mkCategory| '|package| NIL + '((|noZeroDivisors| T)) 'NIL NIL)) + |EntireRing|) + (SETELT #0# 0 '(|EntireRing|)))))) + +(MAKEPROP '|EntireRing| 'NILADIC T) diff --git a/src/algebra/strap/ES-.lsp b/src/algebra/strap/ES-.lsp new file mode 100644 index 00000000..da5d43a9 --- /dev/null +++ b/src/algebra/strap/ES-.lsp @@ -0,0 +1,796 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ES-;box;2S;1| (|x| $) + (SPADCALL (LIST |x|) (|getShellEntry| $ 16))) + +(DEFUN |ES-;paren;2S;2| (|x| $) + (SPADCALL (LIST |x|) (|getShellEntry| $ 18))) + +(DEFUN |ES-;belong?;BoB;3| (|op| $) + (COND + ((SPADCALL |op| (|getShellEntry| $ 13) (|getShellEntry| $ 21)) 'T) + ('T (SPADCALL |op| (|getShellEntry| $ 14) (|getShellEntry| $ 21))))) + +(DEFUN |ES-;listk| (|f| $) + (SPADCALL (|ES-;allKernels| |f| $) (|getShellEntry| $ 26))) + +(DEFUN |ES-;tower;SL;5| (|f| $) + (SPADCALL (|ES-;listk| |f| $) (|getShellEntry| $ 27))) + +(DEFUN |ES-;allk| (|l| $) + (PROG (#0=#:G1419 |f| #1=#:G1420) + (RETURN + (SEQ (SPADCALL (ELT $ 32) + (PROGN + (LETT #0# NIL |ES-;allk|) + (SEQ (LETT |f| NIL |ES-;allk|) + (LETT #1# |l| |ES-;allk|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |ES-;allk|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS (|ES-;allKernels| |f| $) + #0#) + |ES-;allk|))) + (LETT #1# (CDR #1#) |ES-;allk|) (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (SPADCALL NIL (|getShellEntry| $ 31)) + (|getShellEntry| $ 35)))))) + +(DEFUN |ES-;operators;SL;7| (|f| $) + (PROG (#0=#:G1423 |k| #1=#:G1424) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |ES-;operators;SL;7|) + (SEQ (LETT |k| NIL |ES-;operators;SL;7|) + (LETT #1# (|ES-;listk| |f| $) |ES-;operators;SL;7|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) |ES-;operators;SL;7|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |k| + (|getShellEntry| $ 36)) + #0#) + |ES-;operators;SL;7|))) + (LETT #1# (CDR #1#) |ES-;operators;SL;7|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |ES-;height;SNni;8| (|f| $) + (PROG (#0=#:G1429 |k| #1=#:G1430) + (RETURN + (SEQ (SPADCALL (ELT $ 42) + (PROGN + (LETT #0# NIL |ES-;height;SNni;8|) + (SEQ (LETT |k| NIL |ES-;height;SNni;8|) + (LETT #1# (SPADCALL |f| (|getShellEntry| $ 39)) + |ES-;height;SNni;8|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) |ES-;height;SNni;8|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |k| + (|getShellEntry| $ 41)) + #0#) + |ES-;height;SNni;8|))) + (LETT #1# (CDR #1#) |ES-;height;SNni;8|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + 0 (|getShellEntry| $ 45)))))) + +(DEFUN |ES-;freeOf?;SSB;9| (|x| |s| $) + (PROG (#0=#:G1434 |k| #1=#:G1435) + (RETURN + (SEQ (SPADCALL + (SPADCALL |s| + (PROGN + (LETT #0# NIL |ES-;freeOf?;SSB;9|) + (SEQ (LETT |k| NIL |ES-;freeOf?;SSB;9|) + (LETT #1# (|ES-;listk| |x| $) + |ES-;freeOf?;SSB;9|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) + |ES-;freeOf?;SSB;9|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |k| + (|getShellEntry| $ 47)) + #0#) + |ES-;freeOf?;SSB;9|))) + (LETT #1# (CDR #1#) |ES-;freeOf?;SSB;9|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 49)) + (|getShellEntry| $ 50)))))) + +(DEFUN |ES-;distribute;2S;10| (|x| $) + (PROG (#0=#:G1438 |k| #1=#:G1439) + (RETURN + (SEQ (|ES-;unwrap| + (PROGN + (LETT #0# NIL |ES-;distribute;2S;10|) + (SEQ (LETT |k| NIL |ES-;distribute;2S;10|) + (LETT #1# (|ES-;listk| |x| $) + |ES-;distribute;2S;10|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) + |ES-;distribute;2S;10|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |k| + (|getShellEntry| $ 13) + (|getShellEntry| $ 52)) + (LETT #0# (CONS |k| #0#) + |ES-;distribute;2S;10|))))) + (LETT #1# (CDR #1#) |ES-;distribute;2S;10|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |x| $))))) + +(DEFUN |ES-;box;LS;11| (|l| $) + (SPADCALL (|getShellEntry| $ 14) |l| (|getShellEntry| $ 54))) + +(DEFUN |ES-;paren;LS;12| (|l| $) + (SPADCALL (|getShellEntry| $ 13) |l| (|getShellEntry| $ 54))) + +(DEFUN |ES-;freeOf?;2SB;13| (|x| |k| $) + (SPADCALL + (SPADCALL (SPADCALL |k| (|getShellEntry| $ 57)) + (|ES-;listk| |x| $) (|getShellEntry| $ 58)) + (|getShellEntry| $ 50))) + +(DEFUN |ES-;kernel;Bo2S;14| (|op| |arg| $) + (SPADCALL |op| (LIST |arg|) (|getShellEntry| $ 60))) + +(DEFUN |ES-;elt;Bo2S;15| (|op| |x| $) + (SPADCALL |op| (LIST |x|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;elt;Bo3S;16| (|op| |x| |y| $) + (SPADCALL |op| (LIST |x| |y|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;elt;Bo4S;17| (|op| |x| |y| |z| $) + (SPADCALL |op| (LIST |x| |y| |z|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;elt;Bo5S;18| (|op| |x| |y| |z| |t| $) + (SPADCALL |op| (LIST |x| |y| |z| |t|) (|getShellEntry| $ 54))) + +(DEFUN |ES-;eval;SSMS;19| (|x| |s| |f| $) + (SPADCALL |x| (LIST |s|) (LIST |f|) (|getShellEntry| $ 68))) + +(DEFUN |ES-;eval;SBoMS;20| (|x| |s| |f| $) + (SPADCALL |x| (LIST (SPADCALL |s| (|getShellEntry| $ 70))) (LIST |f|) + (|getShellEntry| $ 68))) + +(DEFUN |ES-;eval;SSMS;21| (|x| |s| |f| $) + (SPADCALL |x| (LIST |s|) + (LIST (CONS #'|ES-;eval;SSMS;21!0| (VECTOR |f| $))) + (|getShellEntry| $ 68))) + +(DEFUN |ES-;eval;SSMS;21!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;eval;SBoMS;22| (|x| |s| |f| $) + (SPADCALL |x| (LIST |s|) + (LIST (CONS #'|ES-;eval;SBoMS;22!0| (VECTOR |f| $))) + (|getShellEntry| $ 76))) + +(DEFUN |ES-;eval;SBoMS;22!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;subst;SES;23| (|x| |e| $) + (SPADCALL |x| (LIST |e|) (|getShellEntry| $ 80))) + +(DEFUN |ES-;eval;SLLS;24| (|x| |ls| |lf| $) + (PROG (#0=#:G1459 |f| #1=#:G1460) + (RETURN + (SEQ (SPADCALL |x| |ls| + (PROGN + (LETT #0# NIL |ES-;eval;SLLS;24|) + (SEQ (LETT |f| NIL |ES-;eval;SLLS;24|) + (LETT #1# |lf| |ES-;eval;SLLS;24|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |ES-;eval;SLLS;24|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (CONS #'|ES-;eval;SLLS;24!0| + (VECTOR |f| $)) + #0#) + |ES-;eval;SLLS;24|))) + (LETT #1# (CDR #1#) |ES-;eval;SLLS;24|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 76)))))) + +(DEFUN |ES-;eval;SLLS;24!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;eval;SLLS;25| (|x| |ls| |lf| $) + (PROG (#0=#:G1463 |f| #1=#:G1464) + (RETURN + (SEQ (SPADCALL |x| |ls| + (PROGN + (LETT #0# NIL |ES-;eval;SLLS;25|) + (SEQ (LETT |f| NIL |ES-;eval;SLLS;25|) + (LETT #1# |lf| |ES-;eval;SLLS;25|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) |ES-;eval;SLLS;25|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (CONS #'|ES-;eval;SLLS;25!0| + (VECTOR |f| $)) + #0#) + |ES-;eval;SLLS;25|))) + (LETT #1# (CDR #1#) |ES-;eval;SLLS;25|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 68)))))) + +(DEFUN |ES-;eval;SLLS;25!0| (|#1| $$) + (SPADCALL (SPADCALL |#1| (|getShellEntry| (|getShellEntry| $$ 1) 73)) + (|getShellEntry| $$ 0))) + +(DEFUN |ES-;eval;SLLS;26| (|x| |ls| |lf| $) + (PROG (#0=#:G1468 |s| #1=#:G1469) + (RETURN + (SEQ (SPADCALL |x| + (PROGN + (LETT #0# NIL |ES-;eval;SLLS;26|) + (SEQ (LETT |s| NIL |ES-;eval;SLLS;26|) + (LETT #1# |ls| |ES-;eval;SLLS;26|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |s| (CAR #1#) |ES-;eval;SLLS;26|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |s| + (|getShellEntry| $ 70)) + #0#) + |ES-;eval;SLLS;26|))) + (LETT #1# (CDR #1#) |ES-;eval;SLLS;26|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + |lf| (|getShellEntry| $ 68)))))) + +(DEFUN |ES-;map;MKS;27| (|fn| |k| $) + (PROG (#0=#:G1484 |x| #1=#:G1485 |l|) + (RETURN + (SEQ (COND + ((SPADCALL + (LETT |l| + (PROGN + (LETT #0# NIL |ES-;map;MKS;27|) + (SEQ (LETT |x| NIL |ES-;map;MKS;27|) + (LETT #1# + (SPADCALL |k| + (|getShellEntry| $ 86)) + |ES-;map;MKS;27|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |x| (CAR #1#) + |ES-;map;MKS;27|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS (SPADCALL |x| |fn|) #0#) + |ES-;map;MKS;27|))) + (LETT #1# (CDR #1#) |ES-;map;MKS;27|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |ES-;map;MKS;27|) + (SPADCALL |k| (|getShellEntry| $ 86)) + (|getShellEntry| $ 87)) + (SPADCALL |k| (|getShellEntry| $ 88))) + ('T + (SPADCALL (SPADCALL |k| (|getShellEntry| $ 36)) |l| + (|getShellEntry| $ 54)))))))) + +(DEFUN |ES-;operator;2Bo;28| (|op| $) + (COND + ((SPADCALL |op| (SPADCALL "%paren" (|getShellEntry| $ 9)) + (|getShellEntry| $ 90)) + (|getShellEntry| $ 13)) + ((SPADCALL |op| (SPADCALL "%box" (|getShellEntry| $ 9)) + (|getShellEntry| $ 90)) + (|getShellEntry| $ 14)) + ('T (|error| "Unknown operator")))) + +(DEFUN |ES-;mainKernel;SU;29| (|x| $) + (PROG (|l| |kk| #0=#:G1501 |n| |k|) + (RETURN + (SEQ (COND + ((NULL (LETT |l| (SPADCALL |x| (|getShellEntry| $ 39)) + |ES-;mainKernel;SU;29|)) + (CONS 1 "failed")) + ('T + (SEQ (LETT |n| + (SPADCALL + (LETT |k| (|SPADfirst| |l|) + |ES-;mainKernel;SU;29|) + (|getShellEntry| $ 41)) + |ES-;mainKernel;SU;29|) + (SEQ (LETT |kk| NIL |ES-;mainKernel;SU;29|) + (LETT #0# (CDR |l|) |ES-;mainKernel;SU;29|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |kk| (CAR #0#) + |ES-;mainKernel;SU;29|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((< |n| + (SPADCALL |kk| + (|getShellEntry| $ 41))) + (SEQ + (LETT |n| + (SPADCALL |kk| + (|getShellEntry| $ 41)) + |ES-;mainKernel;SU;29|) + (EXIT + (LETT |k| |kk| + |ES-;mainKernel;SU;29|))))))) + (LETT #0# (CDR #0#) |ES-;mainKernel;SU;29|) + (GO G190) G191 (EXIT NIL)) + (EXIT (CONS 0 |k|))))))))) + +(DEFUN |ES-;allKernels| (|f| $) + (PROG (|l| |k| #0=#:G1514 |u| |s0| |n| |arg| |t| |s|) + (RETURN + (SEQ (LETT |s| + (SPADCALL + (LETT |l| (SPADCALL |f| (|getShellEntry| $ 39)) + |ES-;allKernels|) + (|getShellEntry| $ 31)) + |ES-;allKernels|) + (SEQ (LETT |k| NIL |ES-;allKernels|) + (LETT #0# |l| |ES-;allKernels|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |k| (CAR #0#) |ES-;allKernels|) + NIL)) + (GO G191))) + (SEQ (LETT |t| + (SEQ (LETT |u| + (SPADCALL + (SPADCALL |k| + (|getShellEntry| $ 36)) + "%dummyVar" + (|getShellEntry| $ 96)) + |ES-;allKernels|) + (EXIT (COND + ((QEQCAR |u| 0) + (SEQ + (LETT |arg| + (SPADCALL |k| + (|getShellEntry| $ 86)) + |ES-;allKernels|) + (LETT |s0| + (SPADCALL + (SPADCALL + (SPADCALL |arg| + (|getShellEntry| $ 97)) + (|getShellEntry| $ 57)) + (|ES-;allKernels| + (|SPADfirst| |arg|) $) + (|getShellEntry| $ 98)) + |ES-;allKernels|) + (LETT |arg| (CDR (CDR |arg|)) + |ES-;allKernels|) + (LETT |n| (QCDR |u|) + |ES-;allKernels|) + (COND + ((< 1 |n|) + (LETT |arg| (CDR |arg|) + |ES-;allKernels|))) + (EXIT + (SPADCALL |s0| + (|ES-;allk| |arg| $) + (|getShellEntry| $ 32))))) + ('T + (|ES-;allk| + (SPADCALL |k| + (|getShellEntry| $ 86)) + $))))) + |ES-;allKernels|) + (EXIT (LETT |s| + (SPADCALL |s| |t| + (|getShellEntry| $ 32)) + |ES-;allKernels|))) + (LETT #0# (CDR #0#) |ES-;allKernels|) (GO G190) G191 + (EXIT NIL)) + (EXIT |s|))))) + +(DEFUN |ES-;kernel;BoLS;31| (|op| |args| $) + (COND + ((NULL (SPADCALL |op| (|getShellEntry| $ 99))) + (|error| "Unknown operator")) + ('T (|ES-;okkernel| |op| |args| $)))) + +(DEFUN |ES-;okkernel| (|op| |l| $) + (PROG (#0=#:G1521 |f| #1=#:G1522) + (RETURN + (SEQ (SPADCALL + (SPADCALL |op| |l| + (+ 1 + (SPADCALL (ELT $ 42) + (PROGN + (LETT #0# NIL |ES-;okkernel|) + (SEQ (LETT |f| NIL |ES-;okkernel|) + (LETT #1# |l| |ES-;okkernel|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |f| (CAR #1#) + |ES-;okkernel|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS + (SPADCALL |f| + (|getShellEntry| $ 101)) + #0#) + |ES-;okkernel|))) + (LETT #1# (CDR #1#) |ES-;okkernel|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + 0 (|getShellEntry| $ 45))) + (|getShellEntry| $ 102)) + (|getShellEntry| $ 88)))))) + +(DEFUN |ES-;elt;BoLS;33| (|op| |args| $) + (PROG (|u| #0=#:G1538 |v|) + (RETURN + (SEQ (EXIT (COND + ((NULL (SPADCALL |op| (|getShellEntry| $ 99))) + (|error| "Unknown operator")) + ('T + (SEQ (SEQ (LETT |u| + (SPADCALL |op| + (|getShellEntry| $ 104)) + |ES-;elt;BoLS;33|) + (EXIT (COND + ((QEQCAR |u| 0) + (COND + ((SPADCALL (LENGTH |args|) + (QCDR |u|) + (|getShellEntry| $ 105)) + (PROGN + (LETT #0# + (|error| + "Wrong number of arguments") + |ES-;elt;BoLS;33|) + (GO #0#)))))))) + (LETT |v| + (SPADCALL |op| |args| + (|getShellEntry| $ 108)) + |ES-;elt;BoLS;33|) + (EXIT (COND + ((QEQCAR |v| 0) (QCDR |v|)) + ('T (|ES-;okkernel| |op| |args| $)))))))) + #0# (EXIT #0#))))) + +(DEFUN |ES-;retract;SK;34| (|f| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 110)) + |ES-;retract;SK;34|) + (EXIT (COND + ((OR (QEQCAR |k| 1) + (SPADCALL + (SPADCALL (QCDR |k|) + (|getShellEntry| $ 88)) + |f| (|getShellEntry| $ 111))) + (|error| "not a kernel")) + ('T (QCDR |k|)))))))) + +(DEFUN |ES-;retractIfCan;SU;35| (|f| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 110)) + |ES-;retractIfCan;SU;35|) + (EXIT (COND + ((OR (QEQCAR |k| 1) + (SPADCALL + (SPADCALL (QCDR |k|) + (|getShellEntry| $ 88)) + |f| (|getShellEntry| $ 111))) + (CONS 1 "failed")) + ('T |k|))))))) + +(DEFUN |ES-;is?;SSB;36| (|f| |s| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 114)) + |ES-;is?;SSB;36|) + (EXIT (COND + ((QEQCAR |k| 1) 'NIL) + ('T + (SPADCALL (QCDR |k|) |s| (|getShellEntry| $ 115))))))))) + +(DEFUN |ES-;is?;SBoB;37| (|f| |op| $) + (PROG (|k|) + (RETURN + (SEQ (LETT |k| (SPADCALL |f| (|getShellEntry| $ 114)) + |ES-;is?;SBoB;37|) + (EXIT (COND + ((QEQCAR |k| 1) 'NIL) + ('T + (SPADCALL (QCDR |k|) |op| (|getShellEntry| $ 52))))))))) + +(DEFUN |ES-;unwrap| (|l| |x| $) + (PROG (|k| #0=#:G1565) + (RETURN + (SEQ (SEQ (LETT |k| NIL |ES-;unwrap|) + (LETT #0# (NREVERSE |l|) |ES-;unwrap|) G190 + (COND + ((OR (ATOM #0#) + (PROGN (LETT |k| (CAR #0#) |ES-;unwrap|) NIL)) + (GO G191))) + (SEQ (EXIT (LETT |x| + (SPADCALL |x| |k| + (|SPADfirst| + (SPADCALL |k| + (|getShellEntry| $ 86))) + (|getShellEntry| $ 118)) + |ES-;unwrap|))) + (LETT #0# (CDR #0#) |ES-;unwrap|) (GO G190) G191 + (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |ES-;distribute;3S;39| (|x| |y| $) + (PROG (|ky| #0=#:G1570 |k| #1=#:G1571) + (RETURN + (SEQ (LETT |ky| (SPADCALL |y| (|getShellEntry| $ 57)) + |ES-;distribute;3S;39|) + (EXIT (|ES-;unwrap| + (PROGN + (LETT #0# NIL |ES-;distribute;3S;39|) + (SEQ (LETT |k| NIL |ES-;distribute;3S;39|) + (LETT #1# (|ES-;listk| |x| $) + |ES-;distribute;3S;39|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |k| (CAR #1#) + |ES-;distribute;3S;39|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((COND + ((SPADCALL |k| + (SPADCALL "%paren" + (|getShellEntry| $ 9)) + (|getShellEntry| $ 115)) + (SPADCALL |ky| + (|ES-;listk| + (SPADCALL |k| + (|getShellEntry| $ 88)) + $) + (|getShellEntry| $ 58))) + ('T 'NIL)) + (LETT #0# (CONS |k| #0#) + |ES-;distribute;3S;39|))))) + (LETT #1# (CDR #1#) |ES-;distribute;3S;39|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |x| $)))))) + +(DEFUN |ES-;eval;SLS;40| (|f| |leq| $) + (PROG (|rec|) + (RETURN + (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;eval;SLS;40|) + (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) + (|getShellEntry| $ 120))))))) + +(DEFUN |ES-;subst;SLS;41| (|f| |leq| $) + (PROG (|rec|) + (RETURN + (SEQ (LETT |rec| (|ES-;mkKerLists| |leq| $) |ES-;subst;SLS;41|) + (EXIT (SPADCALL |f| (QCAR |rec|) (QCDR |rec|) + (|getShellEntry| $ 122))))))) + +(DEFUN |ES-;mkKerLists| (|leq| $) + (PROG (|eq| #0=#:G1588 |k| |lk| |lv|) + (RETURN + (SEQ (LETT |lk| NIL |ES-;mkKerLists|) + (LETT |lv| NIL |ES-;mkKerLists|) + (SEQ (LETT |eq| NIL |ES-;mkKerLists|) + (LETT #0# |leq| |ES-;mkKerLists|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |eq| (CAR #0#) |ES-;mkKerLists|) + NIL)) + (GO G191))) + (SEQ (LETT |k| + (SPADCALL + (SPADCALL |eq| (|getShellEntry| $ 125)) + (|getShellEntry| $ 114)) + |ES-;mkKerLists|) + (EXIT (COND + ((QEQCAR |k| 1) + (|error| "left hand side must be a single kernel")) + ((NULL (SPADCALL (QCDR |k|) |lk| + (|getShellEntry| $ 58))) + (SEQ (LETT |lk| (CONS (QCDR |k|) |lk|) + |ES-;mkKerLists|) + (EXIT + (LETT |lv| + (CONS + (SPADCALL |eq| + (|getShellEntry| $ 126)) + |lv|) + |ES-;mkKerLists|))))))) + (LETT #0# (CDR #0#) |ES-;mkKerLists|) (GO G190) G191 + (EXIT NIL)) + (EXIT (CONS |lk| |lv|)))))) + +(DEFUN |ES-;even?;SB;43| (|x| $) (|ES-;intpred?| |x| (ELT $ 128) $)) + +(DEFUN |ES-;odd?;SB;44| (|x| $) (|ES-;intpred?| |x| (ELT $ 130) $)) + +(DEFUN |ES-;intpred?| (|x| |pred?| $) + (PROG (|u|) + (RETURN + (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 133)) + |ES-;intpred?|) + (EXIT (COND + ((QEQCAR |u| 0) (SPADCALL (QCDR |u|) |pred?|)) + ('T 'NIL))))))) + +(DEFUN |ExpressionSpace&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|ExpressionSpace&|)) + (LETT |dv$| (LIST '|ExpressionSpace&| |dv$1|) . #0#) + (LETT $ (|newShell| 134) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| + '(|RetractableTo| (|Integer|))) + (|HasCategory| |#1| '(|Ring|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 13 + (SPADCALL (SPADCALL "%paren" (|getShellEntry| $ 9)) + (|getShellEntry| $ 12))) + (|setShellEntry| $ 14 + (SPADCALL (SPADCALL "%box" (|getShellEntry| $ 9)) + (|getShellEntry| $ 12))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (|setShellEntry| $ 129 + (CONS (|dispatchFunction| |ES-;even?;SB;43|) $)) + (|setShellEntry| $ 131 + (CONS (|dispatchFunction| |ES-;odd?;SB;44|) $))))) + $)))) + +(MAKEPROP '|ExpressionSpace&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|String|) + (|Symbol|) (0 . |coerce|) (|BasicOperator|) + (|CommonOperators|) (5 . |operator|) '|oppren| '|opbox| + (|List| $) (10 . |box|) |ES-;box;2S;1| (15 . |paren|) + |ES-;paren;2S;2| (|Boolean|) (20 . =) |ES-;belong?;BoB;3| + (|Kernel| 6) (|List| 23) (|Set| 23) (26 . |parts|) + (31 . |sort!|) (|Kernel| $) (|List| 28) |ES-;tower;SL;5| + (36 . |brace|) (41 . |union|) (|Mapping| 25 25 25) + (|List| 25) (47 . |reduce|) (54 . |operator|) (|List| 10) + |ES-;operators;SL;7| (59 . |kernels|) + (|NonNegativeInteger|) (64 . |height|) (69 . |max|) + (|Mapping| 40 40 40) (|List| 40) (75 . |reduce|) + |ES-;height;SNni;8| (82 . |name|) (|List| 8) + (87 . |member?|) (93 . |not|) |ES-;freeOf?;SSB;9| + (98 . |is?|) |ES-;distribute;2S;10| (104 . |elt|) + |ES-;box;LS;11| |ES-;paren;LS;12| (110 . |retract|) + (115 . |member?|) |ES-;freeOf?;2SB;13| (121 . |kernel|) + |ES-;kernel;Bo2S;14| |ES-;elt;Bo2S;15| |ES-;elt;Bo3S;16| + |ES-;elt;Bo4S;17| |ES-;elt;Bo5S;18| (|Mapping| $ 15) + (|List| 66) (127 . |eval|) |ES-;eval;SSMS;19| + (134 . |name|) |ES-;eval;SBoMS;20| (|List| 6) + (139 . |first|) (|Mapping| $ $) |ES-;eval;SSMS;21| + (144 . |eval|) |ES-;eval;SBoMS;22| (|Equation| $) + (|List| 78) (151 . |subst|) |ES-;subst;SES;23| (|List| 74) + |ES-;eval;SLLS;24| |ES-;eval;SLLS;25| |ES-;eval;SLLS;26| + (157 . |argument|) (162 . =) (168 . |coerce|) + |ES-;map;MKS;27| (173 . |is?|) |ES-;operator;2Bo;28| + (|Union| 28 '"failed") |ES-;mainKernel;SU;29| (|None|) + (|Union| 94 '"failed") (179 . |property|) (185 . |second|) + (190 . |remove!|) (196 . |belong?|) |ES-;kernel;BoLS;31| + (201 . |height|) (206 . |kernel|) (|Union| 40 '"failed") + (213 . |arity|) (218 . ~=) (|Union| 6 '"failed") + (|BasicOperatorFunctions1| 6) (224 . |evaluate|) + |ES-;elt;BoLS;33| (230 . |mainKernel|) (235 . ~=) + |ES-;retract;SK;34| |ES-;retractIfCan;SU;35| + (241 . |retractIfCan|) (246 . |is?|) |ES-;is?;SSB;36| + |ES-;is?;SBoB;37| (252 . |eval|) |ES-;distribute;3S;39| + (259 . |eval|) |ES-;eval;SLS;40| (266 . |subst|) + |ES-;subst;SLS;41| (|Equation| 6) (273 . |lhs|) + (278 . |rhs|) (|Integer|) (283 . |even?|) (288 . |even?|) + (293 . |odd?|) (298 . |odd?|) (|Union| 127 '"failed") + (303 . |retractIfCan|)) + '#(|tower| 308 |subst| 313 |retractIfCan| 325 |retract| 330 + |paren| 335 |operators| 345 |operator| 350 |odd?| 355 + |map| 360 |mainKernel| 366 |kernel| 371 |is?| 383 |height| + 395 |freeOf?| 400 |even?| 412 |eval| 417 |elt| 472 + |distribute| 508 |box| 519 |belong?| 529) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 133 + '(1 8 0 7 9 1 11 10 8 12 1 6 0 15 16 1 + 6 0 15 18 2 10 20 0 0 21 1 25 24 0 26 + 1 24 0 0 27 1 25 0 24 31 2 25 0 0 0 + 32 3 34 25 33 0 25 35 1 23 10 0 36 1 + 6 29 0 39 1 23 40 0 41 2 40 0 0 0 42 + 3 44 40 43 0 40 45 1 23 8 0 47 2 48 + 20 8 0 49 1 20 0 0 50 2 23 20 0 10 52 + 2 6 0 10 15 54 1 6 28 0 57 2 24 20 23 + 0 58 2 6 0 10 15 60 3 6 0 0 48 67 68 + 1 10 8 0 70 1 72 6 0 73 3 6 0 0 37 67 + 76 2 6 0 0 79 80 1 23 72 0 86 2 72 20 + 0 0 87 1 6 0 28 88 2 10 20 0 8 90 2 + 10 95 0 7 96 1 72 6 0 97 2 25 0 23 0 + 98 1 6 20 10 99 1 6 40 0 101 3 23 0 + 10 72 40 102 1 10 103 0 104 2 40 20 0 + 0 105 2 107 106 10 72 108 1 6 92 0 + 110 2 6 20 0 0 111 1 6 92 0 114 2 23 + 20 0 8 115 3 6 0 0 28 0 118 3 6 0 0 + 29 15 120 3 6 0 0 29 15 122 1 124 6 0 + 125 1 124 6 0 126 1 127 20 0 128 1 0 + 20 0 129 1 127 20 0 130 1 0 20 0 131 + 1 6 132 0 133 1 0 29 0 30 2 0 0 0 79 + 123 2 0 0 0 78 81 1 0 92 0 113 1 0 28 + 0 112 1 0 0 0 19 1 0 0 15 56 1 0 37 0 + 38 1 0 10 10 91 1 0 20 0 131 2 0 0 74 + 28 89 1 0 92 0 93 2 0 0 10 15 100 2 0 + 0 10 0 61 2 0 20 0 8 116 2 0 20 0 10 + 117 1 0 40 0 46 2 0 20 0 8 51 2 0 20 + 0 0 59 1 0 20 0 129 3 0 0 0 10 74 77 + 3 0 0 0 37 67 85 3 0 0 0 10 66 71 3 0 + 0 0 37 82 83 3 0 0 0 8 66 69 3 0 0 0 + 8 74 75 3 0 0 0 48 82 84 2 0 0 0 79 + 121 2 0 0 10 15 109 5 0 0 10 0 0 0 0 + 65 3 0 0 10 0 0 63 4 0 0 10 0 0 0 64 + 2 0 0 10 0 62 2 0 0 0 0 119 1 0 0 0 + 53 1 0 0 15 55 1 0 0 0 17 1 0 20 10 + 22))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ES.lsp b/src/algebra/strap/ES.lsp new file mode 100644 index 00000000..53f77b8c --- /dev/null +++ b/src/algebra/strap/ES.lsp @@ -0,0 +1,155 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |ExpressionSpace;AL| 'NIL) + +(DEFUN |ExpressionSpace| () + (LET (#:G1400) + (COND + (|ExpressionSpace;AL|) + (T (SETQ |ExpressionSpace;AL| (|ExpressionSpace;|)))))) + +(DEFUN |ExpressionSpace;| () + (PROG (#0=#:G1398) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1396 #2=#:G1397) + (LIST '(|Kernel| $) '(|Kernel| $))) + (|Join| (|OrderedSet|) (|RetractableTo| '#1#) + (|InnerEvalable| '#2# '$) + (|Evalable| '$) + (|mkCategory| '|domain| + '(((|elt| ($ (|BasicOperator|) $)) + T) + ((|elt| ($ (|BasicOperator|) $ $)) + T) + ((|elt| + ($ (|BasicOperator|) $ $ $)) + T) + ((|elt| + ($ (|BasicOperator|) $ $ $ $)) + T) + ((|elt| + ($ (|BasicOperator|) (|List| $))) + T) + ((|subst| ($ $ (|Equation| $))) T) + ((|subst| + ($ $ (|List| (|Equation| $)))) + T) + ((|subst| + ($ $ (|List| (|Kernel| $)) + (|List| $))) + T) + ((|box| ($ $)) T) + ((|box| ($ (|List| $))) T) + ((|paren| ($ $)) T) + ((|paren| ($ (|List| $))) T) + ((|distribute| ($ $)) T) + ((|distribute| ($ $ $)) T) + ((|height| + ((|NonNegativeInteger|) $)) + T) + ((|mainKernel| + ((|Union| (|Kernel| $) "failed") + $)) + T) + ((|kernels| + ((|List| (|Kernel| $)) $)) + T) + ((|tower| + ((|List| (|Kernel| $)) $)) + T) + ((|operators| + ((|List| (|BasicOperator|)) $)) + T) + ((|operator| + ((|BasicOperator|) + (|BasicOperator|))) + T) + ((|belong?| + ((|Boolean|) (|BasicOperator|))) + T) + ((|is?| + ((|Boolean|) $ + (|BasicOperator|))) + T) + ((|is?| + ((|Boolean|) $ (|Symbol|))) + T) + ((|kernel| + ($ (|BasicOperator|) $)) + T) + ((|kernel| + ($ (|BasicOperator|) (|List| $))) + T) + ((|map| + ($ (|Mapping| $ $) (|Kernel| $))) + T) + ((|freeOf?| ((|Boolean|) $ $)) T) + ((|freeOf?| + ((|Boolean|) $ (|Symbol|))) + T) + ((|eval| + ($ $ (|List| (|Symbol|)) + (|List| (|Mapping| $ $)))) + T) + ((|eval| + ($ $ (|List| (|Symbol|)) + (|List| + (|Mapping| $ (|List| $))))) + T) + ((|eval| + ($ $ (|Symbol|) + (|Mapping| $ (|List| $)))) + T) + ((|eval| + ($ $ (|Symbol|) (|Mapping| $ $))) + T) + ((|eval| + ($ $ (|List| (|BasicOperator|)) + (|List| (|Mapping| $ $)))) + T) + ((|eval| + ($ $ (|List| (|BasicOperator|)) + (|List| + (|Mapping| $ (|List| $))))) + T) + ((|eval| + ($ $ (|BasicOperator|) + (|Mapping| $ (|List| $)))) + T) + ((|eval| + ($ $ (|BasicOperator|) + (|Mapping| $ $))) + T) + ((|minPoly| + ((|SparseUnivariatePolynomial| + $) + (|Kernel| $))) + (|has| $ (|Ring|))) + ((|definingPolynomial| ($ $)) + (|has| $ (|Ring|))) + ((|even?| ((|Boolean|) $)) + (|has| $ + (|RetractableTo| (|Integer|)))) + ((|odd?| ((|Boolean|) $)) + (|has| $ + (|RetractableTo| (|Integer|))))) + NIL + '((|Boolean|) + (|SparseUnivariatePolynomial| $) + (|Kernel| $) (|BasicOperator|) + (|List| (|BasicOperator|)) + (|List| (|Mapping| $ (|List| $))) + (|List| (|Mapping| $ $)) + (|Symbol|) (|List| (|Symbol|)) + (|List| $) (|List| (|Kernel| $)) + (|NonNegativeInteger|) + (|List| (|Equation| $)) + (|Equation| $)) + NIL))) + |ExpressionSpace|) + (SETELT #0# 0 '(|ExpressionSpace|)))))) + +(MAKEPROP '|ExpressionSpace| 'NILADIC T) diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp new file mode 100644 index 00000000..8a08bd2e --- /dev/null +++ b/src/algebra/strap/EUCDOM-.lsp @@ -0,0 +1,518 @@ + +(/VERSIONCHECK 2) + +(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $) + (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) 'NIL) + ((SPADCALL |x| (|getShellEntry| $ 8)) 'T) + ('T + (< (SPADCALL |x| (|getShellEntry| $ 10)) + (SPADCALL |y| (|getShellEntry| $ 10)))))) + +(DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) + (QCAR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) + +(DEFUN |EUCDOM-;rem;3S;3| (|x| |y| $) + (QCDR (SPADCALL |x| |y| (|getShellEntry| $ 13)))) + +(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $) + (PROG (|qr|) + (RETURN + (SEQ (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed")) + ('T + (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 13)) + |EUCDOM-;exquo;2SU;4|) + (EXIT (COND + ((SPADCALL (QCDR |qr|) + (|getShellEntry| $ 8)) + (CONS 0 (QCAR |qr|))) + ('T (CONS 1 "failed"))))))))))) + +(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) + (PROG (|#G13| |#G14|) + (RETURN + (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 18)) + |EUCDOM-;gcd;3S;5|) + (LETT |y| (SPADCALL |y| (|getShellEntry| $ 18)) + |EUCDOM-;gcd;3S;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (|getShellEntry| $ 19))) + (GO G191))) + (SEQ (PROGN + (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) + (LETT |#G14| + (SPADCALL |x| |y| (|getShellEntry| $ 20)) + |EUCDOM-;gcd;3S;5|) + (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) + (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) + (EXIT (LETT |y| + (SPADCALL |y| (|getShellEntry| $ 18)) + |EUCDOM-;gcd;3S;5|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) + (PROG (|#G16| |u| |c| |a|) + (RETURN + (SEQ (PROGN + (LETT |#G16| + (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 23)) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |u| (QVELT |#G16| 0) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |c| (QVELT |#G16| 1) + |EUCDOM-;unitNormalizeIdealElt|) + (LETT |a| (QVELT |#G16| 2) + |EUCDOM-;unitNormalizeIdealElt|) + |#G16|) + (EXIT (COND + ((SPADCALL |a| (|spadConstant| $ 24) + (|getShellEntry| $ 25)) + |s|) + ('T + (VECTOR (SPADCALL |a| (QVELT |s| 0) + (|getShellEntry| $ 26)) + (SPADCALL |a| (QVELT |s| 1) + (|getShellEntry| $ 26)) + |c|)))))))) + +(DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) + (PROG (|s3| |s2| |qr| |s1|) + (RETURN + (SEQ (LETT |s1| + (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| $ 24) + (|spadConstant| $ 27) |x|) + $) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| $ 27) + (|spadConstant| $ 24) |y|) + $) + |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) + ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) + ('T + (SEQ (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL (QVELT |s2| 2) + (|getShellEntry| $ 8)) + (|getShellEntry| $ 19))) + (GO G191))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 2) + (QVELT |s2| 2) + (|getShellEntry| $ 13)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s3| + (VECTOR + (SPADCALL (QVELT |s1| 0) + (SPADCALL (QCAR |qr|) + (QVELT |s2| 0) + (|getShellEntry| $ 26)) + (|getShellEntry| $ 28)) + (SPADCALL (QVELT |s1| 1) + (SPADCALL (QCAR |qr|) + (QVELT |s2| 1) + (|getShellEntry| $ 26)) + (|getShellEntry| $ 28)) + (QCDR |qr|)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s1| |s2| + |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| + |s3| $) + |EUCDOM-;extendedEuclidean;2SR;7|))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (SPADCALL (QVELT |s1| 0) + (|getShellEntry| $ 8))) + (COND + ((NULL (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 29))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 13)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (QSETVELT |s1| 0 (QCDR |qr|)) + (QSETVELT |s1| 1 + (SPADCALL (QVELT |s1| 1) + (SPADCALL (QCAR |qr|) |x| + (|getShellEntry| $ 26)) + (|getShellEntry| $ 30))) + (EXIT + (LETT |s1| + (|EUCDOM-;unitNormalizeIdealElt| + |s1| $) + |EUCDOM-;extendedEuclidean;2SR;7|))))))) + (EXIT |s1|))))))))) + +(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) + (PROG (|s| |w| |qr|) + (RETURN + (SEQ (COND + ((SPADCALL |z| (|getShellEntry| $ 8)) + (CONS 0 + (CONS (|spadConstant| $ 27) (|spadConstant| $ 27)))) + ('T + (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 33)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (LETT |w| + (SPADCALL |z| (QVELT |s| 2) + (|getShellEntry| $ 34)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT (COND + ((QEQCAR |w| 1) (CONS 1 "failed")) + ((SPADCALL |y| (|getShellEntry| $ 8)) + (CONS 0 + (CONS (SPADCALL (QVELT |s| 0) + (QCDR |w|) + (|getShellEntry| $ 26)) + (SPADCALL (QVELT |s| 1) + (QCDR |w|) + (|getShellEntry| $ 26))))) + ('T + (SEQ (LETT |qr| + (SPADCALL + (SPADCALL (QVELT |s| 0) + (QCDR |w|) + (|getShellEntry| $ 26)) + |y| (|getShellEntry| $ 13)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT (CONS 0 + (CONS (QCDR |qr|) + (SPADCALL + (SPADCALL (QVELT |s| 1) + (QCDR |w|) + (|getShellEntry| $ 26)) + (SPADCALL (QCAR |qr|) |x| + (|getShellEntry| $ 26)) + (|getShellEntry| $ 30)))))))))))))))) + +(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) + (PROG (|uca| |v| |u| #0=#:G1478 |vv| #1=#:G1479) + (RETURN + (SEQ (COND + ((SPADCALL |l| NIL (|getShellEntry| $ 39)) + (|error| "empty list passed to principalIdeal")) + ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 39)) + (SEQ (LETT |uca| + (SPADCALL (|SPADfirst| |l|) + (|getShellEntry| $ 23)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) + ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 39)) + (SEQ (LETT |u| + (SPADCALL (|SPADfirst| |l|) + (SPADCALL |l| (|getShellEntry| $ 40)) + (|getShellEntry| $ 33)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) + (QVELT |u| 2))))) + ('T + (SEQ (LETT |v| + (SPADCALL (CDR |l|) (|getShellEntry| $ 43)) + |EUCDOM-;principalIdeal;LR;9|) + (LETT |u| + (SPADCALL (|SPADfirst| |l|) (QCDR |v|) + (|getShellEntry| $ 33)) + |EUCDOM-;principalIdeal;LR;9|) + (EXIT (CONS (CONS (QVELT |u| 0) + (PROGN + (LETT #0# NIL + |EUCDOM-;principalIdeal;LR;9|) + (SEQ + (LETT |vv| NIL + |EUCDOM-;principalIdeal;LR;9|) + (LETT #1# (QCAR |v|) + |EUCDOM-;principalIdeal;LR;9|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |vv| (CAR #1#) + |EUCDOM-;principalIdeal;LR;9|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (SPADCALL (QVELT |u| 1) + |vv| + (|getShellEntry| $ 26)) + #0#) + |EUCDOM-;principalIdeal;LR;9|))) + (LETT #1# (CDR #1#) + |EUCDOM-;principalIdeal;LR;9|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#))))) + (QVELT |u| 2)))))))))) + +(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) + (PROG (#0=#:G1494 #1=#:G1495 |pid| |q| #2=#:G1496 |v| #3=#:G1497) + (RETURN + (SEQ (COND + ((SPADCALL |z| (|spadConstant| $ 27) + (|getShellEntry| $ 25)) + (CONS 0 + (PROGN + (LETT #0# NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (SEQ (LETT |v| NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT #1# |l| + |EUCDOM-;expressIdealMember;LSU;10|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |v| (CAR #1#) + |EUCDOM-;expressIdealMember;LSU;10|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS (|spadConstant| $ 27) #0#) + |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #1# (CDR #1#) + |EUCDOM-;expressIdealMember;LSU;10|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))))) + ('T + (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 43)) + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT |q| + (SPADCALL |z| (QCDR |pid|) + (|getShellEntry| $ 34)) + |EUCDOM-;expressIdealMember;LSU;10|) + (EXIT (COND + ((QEQCAR |q| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (PROGN + (LETT #2# NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (SEQ + (LETT |v| NIL + |EUCDOM-;expressIdealMember;LSU;10|) + (LETT #3# (QCAR |pid|) + |EUCDOM-;expressIdealMember;LSU;10|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |v| (CAR #3#) + |EUCDOM-;expressIdealMember;LSU;10|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (SPADCALL (QCDR |q|) |v| + (|getShellEntry| $ 26)) + #2#) + |EUCDOM-;expressIdealMember;LSU;10|))) + (LETT #3# (CDR #3#) + |EUCDOM-;expressIdealMember;LSU;10|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#))))))))))))))) + +(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) + (PROG (|n| |l1| |l2| #0=#:G1392 #1=#:G1516 #2=#:G1503 #3=#:G1501 + #4=#:G1502 #5=#:G1393 #6=#:G1517 #7=#:G1506 #8=#:G1504 + #9=#:G1505 |u| |v1| |v2|) + (RETURN + (SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((ZEROP |n|) + (|error| "empty list passed to multiEuclidean")) + ((EQL |n| 1) (CONS 0 (LIST |z|))) + ('T + (SEQ (LETT |l1| + (SPADCALL |l| (|getShellEntry| $ 47)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |l2| + (SPADCALL |l1| (QUOTIENT2 |n| 2) + (|getShellEntry| $ 49)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |u| + (SPADCALL + (PROGN + (LETT #4# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (SEQ + (LETT #0# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #1# |l1| + |EUCDOM-;multiEuclidean;LSU;11|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT #0# (CAR #1#) + |EUCDOM-;multiEuclidean;LSU;11|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #2# #0# + |EUCDOM-;multiEuclidean;LSU;11|) + (COND + (#4# + (LETT #3# + (SPADCALL #3# #2# + (|getShellEntry| $ 26)) + |EUCDOM-;multiEuclidean;LSU;11|)) + ('T + (PROGN + (LETT #3# #2# + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #4# 'T + |EUCDOM-;multiEuclidean;LSU;11|))))))) + (LETT #1# (CDR #1#) + |EUCDOM-;multiEuclidean;LSU;11|) + (GO G190) G191 (EXIT NIL)) + (COND + (#4# #3#) + ('T (|spadConstant| $ 24)))) + (PROGN + (LETT #9# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (SEQ + (LETT #5# NIL + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #6# |l2| + |EUCDOM-;multiEuclidean;LSU;11|) + G190 + (COND + ((OR (ATOM #6#) + (PROGN + (LETT #5# (CAR #6#) + |EUCDOM-;multiEuclidean;LSU;11|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #7# #5# + |EUCDOM-;multiEuclidean;LSU;11|) + (COND + (#9# + (LETT #8# + (SPADCALL #8# #7# + (|getShellEntry| $ 26)) + |EUCDOM-;multiEuclidean;LSU;11|)) + ('T + (PROGN + (LETT #8# #7# + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT #9# 'T + |EUCDOM-;multiEuclidean;LSU;11|))))))) + (LETT #6# (CDR #6#) + |EUCDOM-;multiEuclidean;LSU;11|) + (GO G190) G191 (EXIT NIL)) + (COND + (#9# #8#) + ('T (|spadConstant| $ 24)))) + |z| (|getShellEntry| $ 50)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((QEQCAR |u| 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |v1| + (SPADCALL |l1| + (QCDR (QCDR |u|)) + (|getShellEntry| $ 51)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |v1| 1) + (CONS 1 "failed")) + ('T + (SEQ + (LETT |v2| + (SPADCALL |l2| + (QCAR (QCDR |u|)) + (|getShellEntry| $ 51)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((QEQCAR |v2| 1) + (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |v1|) + (QCDR |v2|) + (|getShellEntry| $ + 52)))))))))))))))))))))) + +(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| 54) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|EuclideanDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Boolean|) + (0 . |zero?|) (|NonNegativeInteger|) (5 . |euclideanSize|) + |EUCDOM-;sizeLess?;2SB;1| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (10 . |divide|) |EUCDOM-;quo;3S;2| |EUCDOM-;rem;3S;3| + (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| + (16 . |unitCanonical|) (21 . |not|) (26 . |rem|) + |EUCDOM-;gcd;3S;5| + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (32 . |unitNormal|) (37 . |One|) (41 . =) (47 . *) + (53 . |Zero|) (57 . -) (63 . |sizeLess?|) (69 . +) + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + |EUCDOM-;extendedEuclidean;2SR;7| + (75 . |extendedEuclidean|) (81 . |exquo|) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 35 '"failed") |EUCDOM-;extendedEuclidean;3SU;8| + (|List| 6) (87 . =) (93 . |second|) (|List| $) + (|Record| (|:| |coef| 41) (|:| |generator| $)) + (98 . |principalIdeal|) |EUCDOM-;principalIdeal;LR;9| + (|Union| 41 '"failed") |EUCDOM-;expressIdealMember;LSU;10| + (103 . |copy|) (|Integer|) (108 . |split!|) + (114 . |extendedEuclidean|) (121 . |multiEuclidean|) + (127 . |concat|) |EUCDOM-;multiEuclidean;LSU;11|) + '#(|sizeLess?| 133 |rem| 139 |quo| 145 |principalIdeal| 151 + |multiEuclidean| 156 |gcd| 162 |extendedEuclidean| 168 + |exquo| 181 |expressIdealMember| 187) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 53 + '(1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 1 + 6 0 0 18 1 7 0 0 19 2 6 0 0 0 20 1 6 + 22 0 23 0 6 0 24 2 6 7 0 0 25 2 6 0 0 + 0 26 0 6 0 27 2 6 0 0 0 28 2 6 7 0 0 + 29 2 6 0 0 0 30 2 6 31 0 0 33 2 6 16 + 0 0 34 2 38 7 0 0 39 1 38 6 0 40 1 6 + 42 41 43 1 38 0 0 47 2 38 0 0 48 49 3 + 6 36 0 0 0 50 2 6 45 41 0 51 2 38 0 0 + 0 52 2 0 7 0 0 11 2 0 0 0 0 15 2 0 0 + 0 0 14 1 0 42 41 44 2 0 45 41 0 53 2 + 0 0 0 0 21 3 0 36 0 0 0 37 2 0 31 0 0 + 32 2 0 16 0 0 17 2 0 45 41 0 46))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/EUCDOM.lsp b/src/algebra/strap/EUCDOM.lsp new file mode 100644 index 00000000..c58fa54c --- /dev/null +++ b/src/algebra/strap/EUCDOM.lsp @@ -0,0 +1,53 @@ +(|/VERSIONCHECK| 2) + +(DEFPARAMETER |EuclideanDomain;AL| (QUOTE NIL)) + +(DEFUN |EuclideanDomain| NIL + (LET (#:G83585) + (COND + (|EuclideanDomain;AL|) + (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|)))))) + +(DEFUN |EuclideanDomain;| NIL + (PROG (#1=#:G83583) + (RETURN + (PROG1 + (LETT #1# + (|Join| + (|PrincipalIdealDomain|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|sizeLess?| ((|Boolean|) |$| |$|)) T) + ((|euclideanSize| ((|NonNegativeInteger|) |$|)) T) + ((|divide| + ((|Record| + (|:| |quotient| |$|) + (|:| |remainder| |$|)) + |$| |$|)) T) + ((|quo| (|$| |$| |$|)) T) + ((|rem| (|$| |$| |$|)) T) + ((|extendedEuclidean| + ((|Record| + (|:| |coef1| |$|) + (|:| |coef2| |$|) + (|:| |generator| |$|)) + |$| |$|)) T) + ((|extendedEuclidean| + ((|Union| + (|Record| (|:| |coef1| |$|) (|:| |coef2| |$|)) + "failed") + |$| |$| |$|)) T) + ((|multiEuclidean| + ((|Union| + (|List| |$|) + "failed") + (|List| |$|) |$|)) T))) + NIL + (QUOTE ((|List| |$|) (|NonNegativeInteger|) (|Boolean|))) + NIL)) + |EuclideanDomain|) + (SETELT #1# 0 (QUOTE (|EuclideanDomain|))))))) + +(MAKEPROP (QUOTE |EuclideanDomain|) (QUOTE NILADIC) T) + diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp new file mode 100644 index 00000000..e886e7ff --- /dev/null +++ b/src/algebra/strap/FFIELDC-.lsp @@ -0,0 +1,615 @@ + +(/VERSIONCHECK 2) + +(DEFUN |FFIELDC-;differentiate;2S;1| (|x| $) (|spadConstant| $ 7)) + +(DEFUN |FFIELDC-;init;S;2| ($) (|spadConstant| $ 7)) + +(DEFUN |FFIELDC-;nextItem;SU;3| (|a| $) + (COND + ((SPADCALL + (LETT |a| + (SPADCALL (+ (SPADCALL |a| (|getShellEntry| $ 11)) 1) + (|getShellEntry| $ 12)) + |FFIELDC-;nextItem;SU;3|) + (|getShellEntry| $ 14)) + (CONS 1 "failed")) + ('T (CONS 0 |a|)))) + +(DEFUN |FFIELDC-;order;SOpc;4| (|e| $) + (SPADCALL (SPADCALL |e| (|getShellEntry| $ 17)) + (|getShellEntry| $ 20))) + +(DEFUN |FFIELDC-;conditionP;MU;5| (|mat| $) + (PROG (|l|) + (RETURN + (SEQ (LETT |l| (SPADCALL |mat| (|getShellEntry| $ 25)) + |FFIELDC-;conditionP;MU;5|) + (COND + ((OR (NULL |l|) + (SPADCALL (ELT $ 14) (|SPADfirst| |l|) + (|getShellEntry| $ 27))) + (EXIT (CONS 1 "failed")))) + (EXIT (CONS 0 + (SPADCALL (ELT $ 28) (|SPADfirst| |l|) + (|getShellEntry| $ 30)))))))) + +(DEFUN |FFIELDC-;charthRoot;2S;6| (|x| $) + (SPADCALL |x| + (QUOTIENT2 (SPADCALL (|getShellEntry| $ 36)) + (SPADCALL (|getShellEntry| $ 37))) + (|getShellEntry| $ 38))) + +(DEFUN |FFIELDC-;charthRoot;SU;7| (|x| $) + (CONS 0 (SPADCALL |x| (|getShellEntry| $ 28)))) + +(DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($) + (PROG (|sm1| |start| |i| #0=#:G1441 |e| |found|) + (RETURN + (SEQ (LETT |sm1| (- (SPADCALL (|getShellEntry| $ 36)) 1) + |FFIELDC-;createPrimitiveElement;S;8|) + (LETT |start| + (COND + ((SPADCALL (SPADCALL (|getShellEntry| $ 43)) + (CONS 1 "polynomial") (|getShellEntry| $ 44)) + (SPADCALL (|getShellEntry| $ 37))) + ('T 1)) + |FFIELDC-;createPrimitiveElement;S;8|) + (LETT |found| 'NIL |FFIELDC-;createPrimitiveElement;S;8|) + (SEQ (LETT |i| |start| + |FFIELDC-;createPrimitiveElement;S;8|) + G190 + (COND + ((NULL (SPADCALL |found| (|getShellEntry| $ 45))) + (GO G191))) + (SEQ (LETT |e| + (SPADCALL + (PROG1 (LETT #0# |i| + |FFIELDC-;createPrimitiveElement;S;8|) + (|check-subtype| (> #0# 0) + '(|PositiveInteger|) #0#)) + (|getShellEntry| $ 12)) + |FFIELDC-;createPrimitiveElement;S;8|) + (EXIT (LETT |found| + (EQL (SPADCALL |e| + (|getShellEntry| $ 17)) + |sm1|) + |FFIELDC-;createPrimitiveElement;S;8|))) + (LETT |i| (+ |i| 1) + |FFIELDC-;createPrimitiveElement;S;8|) + (GO G190) G191 (EXIT NIL)) + (EXIT |e|))))) + +(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) + (PROG (|explist| |q| |exp| #0=#:G1453 |equalone|) + (RETURN + (SEQ (COND + ((SPADCALL |a| (|getShellEntry| $ 14)) 'NIL) + ('T + (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 49)) + |FFIELDC-;primitive?;SB;9|) + (LETT |q| (- (SPADCALL (|getShellEntry| $ 36)) 1) + |FFIELDC-;primitive?;SB;9|) + (LETT |equalone| 'NIL |FFIELDC-;primitive?;SB;9|) + (SEQ (LETT |exp| NIL |FFIELDC-;primitive?;SB;9|) + (LETT #0# |explist| |FFIELDC-;primitive?;SB;9|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |exp| (CAR #0#) + |FFIELDC-;primitive?;SB;9|) + NIL) + (NULL (SPADCALL |equalone| + (|getShellEntry| $ 45)))) + (GO G191))) + (SEQ (EXIT (LETT |equalone| + (SPADCALL + (SPADCALL |a| + (QUOTIENT2 |q| (QCAR |exp|)) + (|getShellEntry| $ 50)) + (|spadConstant| $ 41) + (|getShellEntry| $ 51)) + |FFIELDC-;primitive?;SB;9|))) + (LETT #0# (CDR #0#) |FFIELDC-;primitive?;SB;9|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |equalone| (|getShellEntry| $ 45)))))))))) + +(DEFUN |FFIELDC-;order;SPi;10| (|e| $) + (PROG (|lof| |rec| #0=#:G1461 |primeDivisor| |j| #1=#:G1462 |a| + |goon| |ord|) + (RETURN + (SEQ (COND + ((SPADCALL |e| (|spadConstant| $ 7) + (|getShellEntry| $ 51)) + (|error| "order(0) is not defined ")) + ('T + (SEQ (LETT |ord| (- (SPADCALL (|getShellEntry| $ 36)) 1) + |FFIELDC-;order;SPi;10|) + (LETT |a| 0 |FFIELDC-;order;SPi;10|) + (LETT |lof| (SPADCALL (|getShellEntry| $ 49)) + |FFIELDC-;order;SPi;10|) + (SEQ (LETT |rec| NIL |FFIELDC-;order;SPi;10|) + (LETT #0# |lof| |FFIELDC-;order;SPi;10|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |rec| (CAR #0#) + |FFIELDC-;order;SPi;10|) + NIL)) + (GO G191))) + (SEQ (LETT |a| + (QUOTIENT2 |ord| + (LETT |primeDivisor| (QCAR |rec|) + |FFIELDC-;order;SPi;10|)) + |FFIELDC-;order;SPi;10|) + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 50)) + (|spadConstant| $ 41) + (|getShellEntry| $ 51)) + |FFIELDC-;order;SPi;10|) + (SEQ (LETT |j| 0 |FFIELDC-;order;SPi;10|) + (LETT #1# (- (QCDR |rec|) 2) + |FFIELDC-;order;SPi;10|) + G190 + (COND + ((OR (QSGREATERP |j| #1#) + (NULL |goon|)) + (GO G191))) + (SEQ (LETT |ord| |a| + |FFIELDC-;order;SPi;10|) + (LETT |a| + (QUOTIENT2 |ord| + |primeDivisor|) + |FFIELDC-;order;SPi;10|) + (EXIT + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 50)) + (|spadConstant| $ 41) + (|getShellEntry| $ 51)) + |FFIELDC-;order;SPi;10|))) + (LETT |j| (QSADD1 |j|) + |FFIELDC-;order;SPi;10|) + (GO G190) G191 (EXIT NIL)) + (EXIT (COND + (|goon| + (LETT |ord| |a| + |FFIELDC-;order;SPi;10|))))) + (LETT #0# (CDR #0#) |FFIELDC-;order;SPi;10|) + (GO G190) G191 (EXIT NIL)) + (EXIT |ord|)))))))) + +(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) + (PROG (|faclist| |gen| |groupord| |f| #0=#:G1482 |fac| |t| #1=#:G1483 + |exp| |exptable| |n| |end| |i| |rho| |found| |disc1| |c| + |mult| |disclog| |a|) + (RETURN + (SEQ (COND + ((SPADCALL |b| (|getShellEntry| $ 14)) + (|error| "discreteLog: logarithm of zero")) + ('T + (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 49)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|) + (LETT |gen| (SPADCALL (|getShellEntry| $ 54)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT (COND + ((SPADCALL |b| |gen| (|getShellEntry| $ 51)) + 1) + ('T + (SEQ (LETT |disclog| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |mult| 1 + |FFIELDC-;discreteLog;SNni;11|) + (LETT |groupord| + (- + (SPADCALL + (|getShellEntry| $ 36)) + 1) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;SNni;11|) + (SEQ (LETT |f| NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT #0# |faclist| + |FFIELDC-;discreteLog;SNni;11|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |FFIELDC-;discreteLog;SNni;11|) + NIL)) + (GO G191))) + (SEQ + (LETT |fac| (QCAR |f|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (SEQ + (LETT |t| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LETT #1# (- (QCDR |f|) 1) + |FFIELDC-;discreteLog;SNni;11|) + G190 + (COND + ((QSGREATERP |t| #1#) + (GO G191))) + (SEQ + (LETT |exp| + (QUOTIENT2 |exp| |fac|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exptable| + (SPADCALL |fac| + (|getShellEntry| $ 56)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |n| + (SPADCALL |exptable| + (|getShellEntry| $ 57)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |c| + (SPADCALL |a| |exp| + (|getShellEntry| $ 50)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |end| + (QUOTIENT2 (- |fac| 1) |n|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |found| 'NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disc1| 0 + |FFIELDC-;discreteLog;SNni;11|) + (SEQ + (LETT |i| 0 + |FFIELDC-;discreteLog;SNni;11|) + G190 + (COND + ((OR + (QSGREATERP |i| |end|) + (NULL + (SPADCALL |found| + (|getShellEntry| $ 45)))) + (GO G191))) + (SEQ + (LETT |rho| + (SPADCALL + (SPADCALL |c| + (|getShellEntry| $ 11)) + |exptable| + (|getShellEntry| $ 59)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (COND + ((QEQCAR |rho| 0) + (SEQ + (LETT |found| 'T + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LETT |disc1| + (* + (+ (* |n| |i|) + (QCDR |rho|)) + |mult|) + |FFIELDC-;discreteLog;SNni;11|)))) + ('T + (LETT |c| + (SPADCALL |c| + (SPADCALL |gen| + (* + (QUOTIENT2 + |groupord| |fac|) + (- |n|)) + (|getShellEntry| $ + 50)) + (|getShellEntry| $ + 60)) + |FFIELDC-;discreteLog;SNni;11|))))) + (LETT |i| (QSADD1 |i|) + |FFIELDC-;discreteLog;SNni;11|) + (GO G190) G191 (EXIT NIL)) + (EXIT + (COND + (|found| + (SEQ + (LETT |mult| + (* |mult| |fac|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disclog| + (+ |disclog| |disc1|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LETT |a| + (SPADCALL |a| + (SPADCALL |gen| + (- |disc1|) + (|getShellEntry| $ + 50)) + (|getShellEntry| $ + 60)) + |FFIELDC-;discreteLog;SNni;11|)))) + ('T + (|error| + "discreteLog: ?? discrete logarithm"))))) + (LETT |t| (QSADD1 |t|) + |FFIELDC-;discreteLog;SNni;11|) + (GO G190) G191 (EXIT NIL)))) + (LETT #0# (CDR #0#) + |FFIELDC-;discreteLog;SNni;11|) + (GO G190) G191 (EXIT NIL)) + (EXIT |disclog|)))))))))))) + +(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) + (PROG (|groupord| |faclist| |f| #0=#:G1501 |fac| |primroot| |t| + #1=#:G1502 |exp| |rhoHelp| #2=#:G1500 |rho| |disclog| + |mult| |a|) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |b| (|getShellEntry| $ 14)) + (SEQ (SPADCALL "discreteLog: logarithm of zero" + (|getShellEntry| $ 65)) + (EXIT (CONS 1 "failed")))) + ((SPADCALL |logbase| (|getShellEntry| $ 14)) + (SEQ (SPADCALL + "discreteLog: logarithm to base zero" + (|getShellEntry| $ 65)) + (EXIT (CONS 1 "failed")))) + ((SPADCALL |b| |logbase| (|getShellEntry| $ 51)) + (CONS 0 1)) + ('T + (COND + ((NULL (ZEROP (REMAINDER2 + (LETT |groupord| + (SPADCALL |logbase| + (|getShellEntry| $ 17)) + |FFIELDC-;discreteLog;2SU;12|) + (SPADCALL |b| + (|getShellEntry| $ 17))))) + (SEQ (SPADCALL + "discreteLog: second argument not in cyclic group generated by first argument" + (|getShellEntry| $ 65)) + (EXIT (CONS 1 "failed")))) + ('T + (SEQ (LETT |faclist| + (SPADCALL + (SPADCALL |groupord| + (|getShellEntry| $ 67)) + (|getShellEntry| $ 69)) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |a| |b| + |FFIELDC-;discreteLog;2SU;12|) + (LETT |disclog| 0 + |FFIELDC-;discreteLog;2SU;12|) + (LETT |mult| 1 + |FFIELDC-;discreteLog;2SU;12|) + (LETT |exp| |groupord| + |FFIELDC-;discreteLog;2SU;12|) + (SEQ (LETT |f| NIL + |FFIELDC-;discreteLog;2SU;12|) + (LETT #0# |faclist| + |FFIELDC-;discreteLog;2SU;12|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |FFIELDC-;discreteLog;2SU;12|) + NIL)) + (GO G191))) + (SEQ (LETT |fac| (QCAR |f|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |primroot| + (SPADCALL |logbase| + (QUOTIENT2 |groupord| |fac|) + (|getShellEntry| $ 50)) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (SEQ + (LETT |t| 0 + |FFIELDC-;discreteLog;2SU;12|) + (LETT #1# (- (QCDR |f|) 1) + |FFIELDC-;discreteLog;2SU;12|) + G190 + (COND + ((QSGREATERP |t| #1#) + (GO G191))) + (SEQ + (LETT |exp| + (QUOTIENT2 |exp| |fac|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |rhoHelp| + (SPADCALL |primroot| + (SPADCALL |a| |exp| + (|getShellEntry| $ 50)) + |fac| + (|getShellEntry| $ 71)) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (COND + ((QEQCAR |rhoHelp| 1) + (PROGN + (LETT #2# + (CONS 1 "failed") + |FFIELDC-;discreteLog;2SU;12|) + (GO #2#))) + ('T + (SEQ + (LETT |rho| + (* (QCDR |rhoHelp|) + |mult|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |disclog| + (+ |disclog| |rho|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |mult| + (* |mult| |fac|) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (LETT |a| + (SPADCALL |a| + (SPADCALL |logbase| + (- |rho|) + (|getShellEntry| $ + 50)) + (|getShellEntry| $ 60)) + |FFIELDC-;discreteLog;2SU;12|))))))) + (LETT |t| (QSADD1 |t|) + |FFIELDC-;discreteLog;2SU;12|) + (GO G190) G191 (EXIT NIL)))) + (LETT #0# (CDR #0#) + |FFIELDC-;discreteLog;2SU;12|) + (GO G190) G191 (EXIT NIL)) + (EXIT (CONS 0 |disclog|)))))))) + #2# (EXIT #2#))))) + +(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $) + (SPADCALL |f| (|getShellEntry| $ 76))) + +(DEFUN |FFIELDC-;factorPolynomial| (|f| $) + (SPADCALL |f| (|getShellEntry| $ 78))) + +(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $) + (PROG (|flist| |u| #0=#:G1515 #1=#:G1512 #2=#:G1510 #3=#:G1511) + (RETURN + (SEQ (COND + ((SPADCALL |f| (|spadConstant| $ 79) + (|getShellEntry| $ 80)) + (|spadConstant| $ 81)) + ('T + (SEQ (LETT |flist| + (SPADCALL |f| 'T (|getShellEntry| $ 85)) + |FFIELDC-;factorSquareFreePolynomial|) + (EXIT (SPADCALL + (SPADCALL (QCAR |flist|) + (|getShellEntry| $ 86)) + (PROGN + (LETT #3# NIL + |FFIELDC-;factorSquareFreePolynomial|) + (SEQ (LETT |u| NIL + |FFIELDC-;factorSquareFreePolynomial|) + (LETT #0# (QCDR |flist|) + |FFIELDC-;factorSquareFreePolynomial|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |u| (CAR #0#) + |FFIELDC-;factorSquareFreePolynomial|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #1# + (SPADCALL (QCAR |u|) + (QCDR |u|) + (|getShellEntry| $ 87)) + |FFIELDC-;factorSquareFreePolynomial|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 88)) + |FFIELDC-;factorSquareFreePolynomial|)) + ('T + (PROGN + (LETT #2# #1# + |FFIELDC-;factorSquareFreePolynomial|) + (LETT #3# 'T + |FFIELDC-;factorSquareFreePolynomial|))))))) + (LETT #0# (CDR #0#) + |FFIELDC-;factorSquareFreePolynomial|) + (GO G190) G191 (EXIT NIL)) + (COND + (#3# #2#) + ('T (|spadConstant| $ 89)))) + (|getShellEntry| $ 90)))))))))) + +(DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $) + (SPADCALL |f| |g| (|getShellEntry| $ 92))) + +(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| 95) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|FiniteFieldCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + |FFIELDC-;differentiate;2S;1| |FFIELDC-;init;S;2| + (|PositiveInteger|) (4 . |lookup|) (9 . |index|) + (|Boolean|) (14 . |zero?|) (|Union| $ '"failed") + |FFIELDC-;nextItem;SU;3| (19 . |order|) (|Integer|) + (|OnePointCompletion| 10) (24 . |coerce|) + |FFIELDC-;order;SOpc;4| (|Vector| 6) (|List| 22) + (|Matrix| 6) (29 . |nullSpace|) (|Mapping| 13 6) + (34 . |every?|) (40 . |charthRoot|) (|Mapping| 6 6) + (45 . |map|) (|Vector| $) (|Union| 31 '"failed") + (|Matrix| $) |FFIELDC-;conditionP;MU;5| + (|NonNegativeInteger|) (51 . |size|) + (55 . |characteristic|) (59 . **) + |FFIELDC-;charthRoot;2S;6| |FFIELDC-;charthRoot;SU;7| + (65 . |One|) + (|Union| '"prime" '"polynomial" '"normal" '"cyclic") + (69 . |representationType|) (73 . =) (79 . |not|) + |FFIELDC-;createPrimitiveElement;S;8| + (|Record| (|:| |factor| 18) (|:| |exponent| 18)) + (|List| 47) (84 . |factorsOfCyclicGroupSize|) (88 . **) + (94 . =) |FFIELDC-;primitive?;SB;9| + |FFIELDC-;order;SPi;10| (100 . |primitiveElement|) + (|Table| 10 35) (104 . |tableForDiscreteLogarithm|) + (109 . |#|) (|Union| 35 '"failed") (114 . |search|) + (120 . *) |FFIELDC-;discreteLog;SNni;11| (|Void|) + (|String|) (|OutputForm|) (126 . |messagePrint|) + (|Factored| $) (131 . |factor|) (|Factored| 18) + (136 . |factors|) (|DiscreteLogarithmPackage| 6) + (141 . |shanksDiscLogAlgorithm|) + |FFIELDC-;discreteLog;2SU;12| + (|SparseUnivariatePolynomial| 6) (|Factored| 73) + (|UnivariatePolynomialSquareFree| 6 73) + (148 . |squareFree|) (|DistinctDegreeFactorize| 6 73) + (153 . |factor|) (158 . |Zero|) (162 . =) (168 . |Zero|) + (|Record| (|:| |irr| 73) (|:| |pow| 18)) (|List| 82) + (|Record| (|:| |cont| 6) (|:| |factors| 83)) + (172 . |distdfact|) (178 . |coerce|) (183 . |primeFactor|) + (189 . *) (195 . |One|) (199 . *) (|EuclideanDomain&| 73) + (205 . |gcd|) (|SparseUnivariatePolynomial| $) + |FFIELDC-;gcdPolynomial;3Sup;16|) + '#(|primitive?| 211 |order| 216 |nextItem| 226 |init| 231 + |gcdPolynomial| 235 |discreteLog| 241 |differentiate| 252 + |createPrimitiveElement| 257 |conditionP| 261 |charthRoot| + 266) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 94 + '(0 6 0 7 1 6 10 0 11 1 6 0 10 12 1 6 + 13 0 14 1 6 10 0 17 1 19 0 18 20 1 24 + 23 0 25 2 22 13 26 0 27 1 6 0 0 28 2 + 22 0 29 0 30 0 6 35 36 0 6 35 37 2 6 + 0 0 35 38 0 6 0 41 0 6 42 43 2 42 13 + 0 0 44 1 13 0 0 45 0 6 48 49 2 6 0 0 + 18 50 2 6 13 0 0 51 0 6 0 54 1 6 55 + 18 56 1 55 35 0 57 2 55 58 10 0 59 2 + 6 0 0 0 60 1 64 62 63 65 1 18 66 0 67 + 1 68 48 0 69 3 70 58 6 6 35 71 1 75 + 74 73 76 1 77 74 73 78 0 73 0 79 2 73 + 13 0 0 80 0 74 0 81 2 77 84 73 13 85 + 1 73 0 6 86 2 74 0 73 18 87 2 74 0 0 + 0 88 0 74 0 89 2 74 0 73 0 90 2 91 0 + 0 0 92 1 0 13 0 52 1 0 10 0 53 1 0 19 + 0 21 1 0 15 0 16 0 0 0 9 2 0 93 93 93 + 94 1 0 35 0 61 2 0 58 0 0 72 1 0 0 0 + 8 0 0 0 46 1 0 32 33 34 1 0 0 0 39 1 + 0 15 0 40))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/FFIELDC.lsp b/src/algebra/strap/FFIELDC.lsp new file mode 100644 index 00000000..9099175c --- /dev/null +++ b/src/algebra/strap/FFIELDC.lsp @@ -0,0 +1,60 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL) + +(DEFUN |FiniteFieldCategory| () + (LET (#:G1395) + (COND + (|FiniteFieldCategory;AL|) + (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|)))))) + +(DEFUN |FiniteFieldCategory;| () + (PROG (#0=#:G1393) + (RETURN + (PROG1 (LETT #0# + (|Join| (|FieldOfPrimeCharacteristic|) (|Finite|) + (|StepThrough|) (|DifferentialRing|) + (|mkCategory| '|domain| + '(((|charthRoot| ($ $)) T) + ((|conditionP| + ((|Union| (|Vector| $) "failed") + (|Matrix| $))) + T) + ((|factorsOfCyclicGroupSize| + ((|List| + (|Record| + (|:| |factor| (|Integer|)) + (|:| |exponent| (|Integer|)))))) + T) + ((|tableForDiscreteLogarithm| + ((|Table| (|PositiveInteger|) + (|NonNegativeInteger|)) + (|Integer|))) + T) + ((|createPrimitiveElement| ($)) T) + ((|primitiveElement| ($)) T) + ((|primitive?| ((|Boolean|) $)) T) + ((|discreteLog| + ((|NonNegativeInteger|) $)) + T) + ((|order| ((|PositiveInteger|) $)) T) + ((|representationType| + ((|Union| "prime" "polynomial" + "normal" "cyclic"))) + T)) + NIL + '((|PositiveInteger|) + (|NonNegativeInteger|) (|Boolean|) + (|Table| (|PositiveInteger|) + (|NonNegativeInteger|)) + (|Integer|) + (|List| (|Record| + (|:| |factor| (|Integer|)) + (|:| |exponent| (|Integer|)))) + (|Matrix| $)) + NIL)) + |FiniteFieldCategory|) + (SETELT #0# 0 '(|FiniteFieldCategory|)))))) + +(MAKEPROP '|FiniteFieldCategory| 'NILADIC T) diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp new file mode 100644 index 00000000..56751bc4 --- /dev/null +++ b/src/algebra/strap/FPS-.lsp @@ -0,0 +1,50 @@ + +(/VERSIONCHECK 2) + +(DEFUN |FPS-;float;2IS;1| (|ma| |ex| $) + (SPADCALL |ma| |ex| (SPADCALL (QREFELT $ 8)) (QREFELT $ 10))) + +(DEFUN |FPS-;digits;Pi;2| ($) + (PROG (#0=#:G1389) + (RETURN + (PROG1 (LETT #0# + (MAX 1 + (QUOTIENT2 + (SPADCALL 4004 + (- (SPADCALL (QREFELT $ 13)) 1) + (QREFELT $ 14)) + 13301)) + |FPS-;digits;Pi;2|) + (|check-subtype| (> #0# 0) '(|PositiveInteger|) #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 $ (GETREFV 17) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|arbitraryExponent|) + (|HasAttribute| |#1| '|arbitraryPrecision|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|FloatingPointSystem&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|PositiveInteger|) + (0 . |base|) (|Integer|) (4 . |float|) |FPS-;float;2IS;1| + (11 . |One|) (15 . |bits|) (19 . *) (25 . |max|) + |FPS-;digits;Pi;2|) + '#(|float| 29 |digits| 35) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 16 + '(0 6 7 8 3 6 0 9 9 7 10 0 6 0 12 0 6 7 + 13 2 9 0 7 0 14 0 6 0 15 2 0 0 9 9 11 + 0 0 7 16))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/FPS.lsp b/src/algebra/strap/FPS.lsp new file mode 100644 index 00000000..75e426f7 --- /dev/null +++ b/src/algebra/strap/FPS.lsp @@ -0,0 +1,81 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |FloatingPointSystem;AL| 'NIL) + +(DEFUN |FloatingPointSystem| () + (LET (#:G1387) + (COND + (|FloatingPointSystem;AL|) + (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|)))))) + +(DEFUN |FloatingPointSystem;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|RealNumberSystem|) + (|mkCategory| '|domain| + '(((|float| ($ (|Integer|) (|Integer|))) + T) + ((|float| ($ (|Integer|) (|Integer|) + (|PositiveInteger|))) + T) + ((|order| ((|Integer|) $)) T) + ((|base| ((|PositiveInteger|))) T) + ((|exponent| ((|Integer|) $)) T) + ((|mantissa| ((|Integer|) $)) T) + ((|bits| ((|PositiveInteger|))) T) + ((|digits| ((|PositiveInteger|))) T) + ((|precision| ((|PositiveInteger|))) + T) + ((|bits| ((|PositiveInteger|) + (|PositiveInteger|))) + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + ((|digits| + ((|PositiveInteger|) + (|PositiveInteger|))) + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + ((|precision| + ((|PositiveInteger|) + (|PositiveInteger|))) + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + ((|increasePrecision| + ((|PositiveInteger|) (|Integer|))) + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + ((|decreasePrecision| + ((|PositiveInteger|) (|Integer|))) + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + ((|min| ($)) + (AND (|not| + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + (|not| + (|has| $ + (ATTRIBUTE + |arbitraryExponent|))))) + ((|max| ($)) + (AND (|not| + (|has| $ + (ATTRIBUTE + |arbitraryPrecision|))) + (|not| + (|has| $ + (ATTRIBUTE + |arbitraryExponent|)))))) + '((|approximate| T)) + '((|PositiveInteger|) (|Integer|)) NIL)) + |FloatingPointSystem|) + (SETELT #0# 0 '(|FloatingPointSystem|)))))) + +(MAKEPROP '|FloatingPointSystem| 'NILADIC T) diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp new file mode 100644 index 00000000..b5c3cd1f --- /dev/null +++ b/src/algebra/strap/GCDDOM-.lsp @@ -0,0 +1,208 @@ + +(/VERSIONCHECK 2) + +(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $) + (PROG (LCM) + (RETURN + (SEQ (COND + ((OR (SPADCALL |y| (|spadConstant| $ 7) (QREFELT $ 9)) + (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + (|spadConstant| $ 7)) + ('T + (SEQ (LETT LCM + (SPADCALL |y| + (SPADCALL |x| |y| (QREFELT $ 10)) + (QREFELT $ 12)) + |GCDDOM-;lcm;3S;1|) + (EXIT (COND + ((QEQCAR LCM 0) + (SPADCALL |x| (QCDR LCM) (QREFELT $ 13))) + ('T (|error| "bad gcd in lcm computation"))))))))))) + +(DEFUN |GCDDOM-;lcm;LS;2| (|l| $) + (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) + (QREFELT $ 19))) + +(DEFUN |GCDDOM-;gcd;LS;3| (|l| $) + (SPADCALL (ELT $ 10) |l| (|spadConstant| $ 7) (|spadConstant| $ 16) + (QREFELT $ 19))) + +(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) + (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1406) + (RETURN + (SEQ (COND + ((SPADCALL |p1| (QREFELT $ 24)) + (SPADCALL |p2| (QREFELT $ 25))) + ((SPADCALL |p2| (QREFELT $ 24)) + (SPADCALL |p1| (QREFELT $ 25))) + ('T + (SEQ (LETT |c1| (SPADCALL |p1| (QREFELT $ 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c2| (SPADCALL |p2| (QREFELT $ 26)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p1| + (PROG2 (LETT #0# + (SPADCALL |p1| |c1| + (QREFELT $ 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p2| + (PROG2 (LETT #0# + (SPADCALL |p2| |c2| + (QREFELT $ 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (SEQ (LETT |e1| (SPADCALL |p1| (QREFELT $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((< 0 |e1|) + (LETT |p1| + (PROG2 + (LETT #0# + (SPADCALL |p1| + (SPADCALL + (|spadConstant| $ 16) |e1| + (QREFELT $ 32)) + (QREFELT $ 33)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (SEQ (LETT |e2| (SPADCALL |p2| (QREFELT $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((< 0 |e2|) + (LETT |p2| + (PROG2 + (LETT #0# + (SPADCALL |p2| + (SPADCALL + (|spadConstant| $ 16) |e2| + (QREFELT $ 32)) + (QREFELT $ 33)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (LETT |e1| (MIN |e1| |e2|) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |c1| (SPADCALL |c1| |c2| (QREFELT $ 10)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (LETT |p1| + (COND + ((OR (EQL (SPADCALL |p1| (QREFELT $ 34)) 0) + (EQL (SPADCALL |p2| (QREFELT $ 34)) 0)) + (SPADCALL |c1| 0 (QREFELT $ 32))) + ('T + (SEQ (LETT |p| + (SPADCALL |p1| |p2| + (QREFELT $ 35)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((EQL + (SPADCALL |p| + (QREFELT $ 34)) + 0) + (SPADCALL |c1| 0 + (QREFELT $ 32))) + ('T + (SEQ + (LETT |c2| + (SPADCALL + (SPADCALL |p1| + (QREFELT $ 36)) + (SPADCALL |p2| + (QREFELT $ 36)) + (QREFELT $ 10)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT + (SPADCALL + (SPADCALL |c1| + (SPADCALL + (PROG2 + (LETT #0# + (SPADCALL + (SPADCALL |c2| |p| + (QREFELT $ 37)) + (SPADCALL |p| + (QREFELT $ 36)) + (QREFELT $ 27)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (QCDR #0#) + (|check-union| + (QEQCAR #0# 0) + (|SparseUnivariatePolynomial| + (QREFELT $ 6)) + #0#)) + (QREFELT $ 38)) + (QREFELT $ 37)) + (QREFELT $ 25)))))))))) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((ZEROP |e1|) |p1|) + ('T + (SPADCALL + (SPADCALL (|spadConstant| $ 16) |e1| + (QREFELT $ 32)) + |p1| (QREFELT $ 39)))))))))))) + +(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 $ (GETREFV 42) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|GcdDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + (|Boolean|) (4 . =) (10 . |gcd|) (|Union| $ '"failed") + (16 . |exquo|) (22 . *) |GCDDOM-;lcm;3S;1| (28 . |lcm|) + (34 . |One|) (|Mapping| 6 6 6) (|List| 6) (38 . |reduce|) + (|List| $) |GCDDOM-;lcm;LS;2| |GCDDOM-;gcd;LS;3| + (|SparseUnivariatePolynomial| 6) (46 . |zero?|) + (51 . |unitCanonical|) (56 . |content|) (61 . |exquo|) + (|NonNegativeInteger|) (67 . |minimumDegree|) + (72 . |Zero|) (76 . |One|) (80 . |monomial|) + (86 . |exquo|) (92 . |degree|) (97 . |subResultantGcd|) + (103 . |leadingCoefficient|) (108 . *) + (114 . |primitivePart|) (119 . *) + (|SparseUnivariatePolynomial| $) + |GCDDOM-;gcdPolynomial;3Sup;4|) + '#(|lcm| 125 |gcdPolynomial| 136 |gcd| 142) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 41 + '(0 6 0 7 2 6 8 0 0 9 2 6 0 0 0 10 2 6 + 11 0 0 12 2 6 0 0 0 13 2 6 0 0 0 15 0 + 6 0 16 4 18 6 17 0 6 6 19 1 23 8 0 24 + 1 23 0 0 25 1 23 6 0 26 2 23 11 0 6 + 27 1 23 28 0 29 0 23 0 30 0 23 0 31 2 + 23 0 6 28 32 2 23 11 0 0 33 1 23 28 0 + 34 2 23 0 0 0 35 1 23 6 0 36 2 23 0 6 + 0 37 1 23 0 0 38 2 23 0 0 0 39 1 0 0 + 20 21 2 0 0 0 0 14 2 0 40 40 40 41 1 + 0 0 20 22))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/GCDDOM.lsp b/src/algebra/strap/GCDDOM.lsp new file mode 100644 index 00000000..1756b55f --- /dev/null +++ b/src/algebra/strap/GCDDOM.lsp @@ -0,0 +1,32 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |GcdDomain;AL| 'NIL) + +(DEFUN |GcdDomain| () + (LET (#:G1393) + (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|)))))) + +(DEFUN |GcdDomain;| () + (PROG (#0=#:G1391) + (RETURN + (PROG1 (LETT #0# + (|Join| (|IntegralDomain|) + (|mkCategory| '|domain| + '(((|gcd| ($ $ $)) T) + ((|gcd| ($ (|List| $))) T) + ((|lcm| ($ $ $)) T) + ((|lcm| ($ (|List| $))) T) + ((|gcdPolynomial| + ((|SparseUnivariatePolynomial| $) + (|SparseUnivariatePolynomial| $) + (|SparseUnivariatePolynomial| $))) + T)) + NIL + '((|SparseUnivariatePolynomial| $) + (|List| $)) + NIL)) + |GcdDomain|) + (SETELT #0# 0 '(|GcdDomain|)))))) + +(MAKEPROP '|GcdDomain| 'NILADIC T) diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp new file mode 100644 index 00000000..de348637 --- /dev/null +++ b/src/algebra/strap/HOAGG-.lsp @@ -0,0 +1,288 @@ + +(/VERSIONCHECK 2) + +(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| $) + (SPADCALL (CONS #'|HOAGG-;eval;ALA;1!0| (VECTOR $ |l|)) |u| + (QREFELT $ 11))) + +(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| $$) + (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 9))) + +(DEFUN |HOAGG-;#;ANni;2| (|c| $) + (LENGTH (SPADCALL |c| (QREFELT $ 14)))) + +(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $) + (PROG (|x| #0=#:G1409 #1=#:G1406 #2=#:G1404 #3=#:G1405) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |HOAGG-;any?;MAB;3|) + (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|) + (LETT #0# (SPADCALL |c| (QREFELT $ 14)) + |HOAGG-;any?;MAB;3|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |HOAGG-;any?;MAB;3|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |HOAGG-;any?;MAB;3|) + (COND + (#3# (LETT #2# + (COND (#2# 'T) ('T #1#)) + |HOAGG-;any?;MAB;3|)) + ('T + (PROGN + (LETT #2# #1# |HOAGG-;any?;MAB;3|) + (LETT #3# 'T |HOAGG-;any?;MAB;3|))))))) + (LETT #0# (CDR #0#) |HOAGG-;any?;MAB;3|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'NIL))))))) + +(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $) + (PROG (|x| #0=#:G1414 #1=#:G1412 #2=#:G1410 #3=#:G1411) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |HOAGG-;every?;MAB;4|) + (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|) + (LETT #0# (SPADCALL |c| (QREFELT $ 14)) + |HOAGG-;every?;MAB;4|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |HOAGG-;every?;MAB;4|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (SPADCALL |x| |f|) + |HOAGG-;every?;MAB;4|) + (COND + (#3# (LETT #2# + (COND (#2# #1#) ('T 'NIL)) + |HOAGG-;every?;MAB;4|)) + ('T + (PROGN + (LETT #2# #1# + |HOAGG-;every?;MAB;4|) + (LETT #3# 'T |HOAGG-;every?;MAB;4|))))))) + (LETT #0# (CDR #0#) |HOAGG-;every?;MAB;4|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 'T))))))) + +(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $) + (PROG (|x| #0=#:G1419 #1=#:G1417 #2=#:G1415 #3=#:G1416) + (RETURN + (SEQ (PROGN + (LETT #3# NIL |HOAGG-;count;MANni;5|) + (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|) + (LETT #0# (SPADCALL |c| (QREFELT $ 14)) + |HOAGG-;count;MANni;5|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |x| (CAR #0#) |HOAGG-;count;MANni;5|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |x| |f|) + (PROGN + (LETT #1# 1 |HOAGG-;count;MANni;5|) + (COND + (#3# + (LETT #2# (+ #2# #1#) + |HOAGG-;count;MANni;5|)) + ('T + (PROGN + (LETT #2# #1# + |HOAGG-;count;MANni;5|) + (LETT #3# 'T + |HOAGG-;count;MANni;5|))))))))) + (LETT #0# (CDR #0#) |HOAGG-;count;MANni;5|) (GO G190) + G191 (EXIT NIL)) + (COND (#3# #2#) ('T 0))))))) + +(DEFUN |HOAGG-;members;AL;6| (|x| $) (SPADCALL |x| (QREFELT $ 14))) + +(DEFUN |HOAGG-;count;SANni;7| (|s| |x| $) + (SPADCALL (CONS #'|HOAGG-;count;SANni;7!0| (VECTOR $ |s|)) |x| + (QREFELT $ 24))) + +(DEFUN |HOAGG-;count;SANni;7!0| (|#1| $$) + (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) + +(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| $) + (SPADCALL (CONS #'|HOAGG-;member?;SAB;8!0| (VECTOR $ |e|)) |c| + (QREFELT $ 26))) + +(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| $$) + (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) + +(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $) + (PROG (|b| #0=#:G1429 |a| #1=#:G1428 #2=#:G1425 #3=#:G1423 + #4=#:G1424) + (RETURN + (SEQ (COND + ((SPADCALL |x| (SPADCALL |y| (QREFELT $ 28)) + (QREFELT $ 29)) + (PROGN + (LETT #4# NIL |HOAGG-;=;2AB;9|) + (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|) + (LETT #0# (SPADCALL |y| (QREFELT $ 14)) + |HOAGG-;=;2AB;9|) + (LETT |a| NIL |HOAGG-;=;2AB;9|) + (LETT #1# (SPADCALL |x| (QREFELT $ 14)) + |HOAGG-;=;2AB;9|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |a| (CAR #1#) |HOAGG-;=;2AB;9|) + NIL) + (ATOM #0#) + (PROGN + (LETT |b| (CAR #0#) |HOAGG-;=;2AB;9|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #2# + (SPADCALL |a| |b| + (QREFELT $ 23)) + |HOAGG-;=;2AB;9|) + (COND + (#4# + (LETT #3# + (COND (#3# #2#) ('T 'NIL)) + |HOAGG-;=;2AB;9|)) + ('T + (PROGN + (LETT #3# #2# |HOAGG-;=;2AB;9|) + (LETT #4# 'T |HOAGG-;=;2AB;9|))))))) + (LETT #1# + (PROG1 (CDR #1#) + (LETT #0# (CDR #0#) |HOAGG-;=;2AB;9|)) + |HOAGG-;=;2AB;9|) + (GO G190) G191 (EXIT NIL)) + (COND (#4# #3#) ('T 'T)))) + ('T 'NIL)))))) + +(DEFUN |HOAGG-;coerce;AOf;10| (|x| $) + (PROG (#0=#:G1433 |a| #1=#:G1434) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL |HOAGG-;coerce;AOf;10|) + (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|) + (LETT #1# (SPADCALL |x| (QREFELT $ 14)) + |HOAGG-;coerce;AOf;10|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |a| (CAR #1#) + |HOAGG-;coerce;AOf;10|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |a| (QREFELT $ 32)) + #0#) + |HOAGG-;coerce;AOf;10|))) + (LETT #1# (CDR #1#) |HOAGG-;coerce;AOf;10|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (QREFELT $ 34)) + (QREFELT $ 35)))))) + +(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 $ (GETREFV 38) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 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| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 3) + (QSETREFV $ 12 + (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $)))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (QSETREFV $ 16 + (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $)) + (QSETREFV $ 19 + (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $)) + (QSETREFV $ 20 + (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $)) + (QSETREFV $ 21 + (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $)) + (QSETREFV $ 22 + (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $)) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (QSETREFV $ 25 + (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) + $)) + (QSETREFV $ 27 + (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) + $)) + (QSETREFV $ 30 + (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $))))) + (COND + ((|testBitVector| |pv$| 5) + (QSETREFV $ 36 + (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) + $))))))) + $)))) + +(MAKEPROP '|HomogeneousAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|List| 37) (0 . |eval|) (|Mapping| 7 7) (6 . |map|) + (12 . |eval|) (|List| 7) (18 . |parts|) + (|NonNegativeInteger|) (23 . |#|) (|Boolean|) + (|Mapping| 17 7) (28 . |any?|) (34 . |every?|) + (40 . |count|) (46 . |members|) (51 . =) (57 . |count|) + (63 . |count|) (69 . |any?|) (75 . |member?|) (81 . |#|) + (86 . |size?|) (92 . =) (|OutputForm|) (98 . |coerce|) + (|List| $) (103 . |commaSeparate|) (108 . |bracket|) + (113 . |coerce|) (|Equation| 7)) + '#(|members| 118 |member?| 123 |every?| 129 |eval| 135 + |count| 141 |coerce| 153 |any?| 158 = 164 |#| 170) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 36 + '(2 7 0 0 8 9 2 6 0 10 0 11 2 0 0 0 8 + 12 1 6 13 0 14 1 0 15 0 16 2 0 17 18 + 0 19 2 0 17 18 0 20 2 0 15 18 0 21 1 + 0 13 0 22 2 7 17 0 0 23 2 6 15 18 0 + 24 2 0 15 7 0 25 2 6 17 18 0 26 2 0 + 17 7 0 27 1 6 15 0 28 2 6 17 0 15 29 + 2 0 17 0 0 30 1 7 31 0 32 1 31 0 33 + 34 1 31 0 0 35 1 0 31 0 36 1 0 13 0 + 22 2 0 17 7 0 27 2 0 17 18 0 20 2 0 0 + 0 8 12 2 0 15 7 0 25 2 0 15 18 0 21 1 + 0 31 0 36 2 0 17 18 0 19 2 0 17 0 0 + 30 1 0 15 0 16))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp new file mode 100644 index 00000000..1dc9a3bf --- /dev/null +++ b/src/algebra/strap/HOAGG.lsp @@ -0,0 +1,112 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |HomogeneousAggregate;CAT| 'NIL) + +(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL) + +(DEFUN |HomogeneousAggregate| (#0=#:G1399) + (LET (#1=#:G1400) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |HomogeneousAggregate;AL|)) + (CDR #1#)) + (T (SETQ |HomogeneousAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|HomogeneousAggregate;| #0#))) + |HomogeneousAggregate;AL|)) + #1#)))) + +(DEFUN |HomogeneousAggregate;| (|t#1|) + (PROG (#0=#:G1398) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|HomogeneousAggregate;CAT|) + ('T + (LETT |HomogeneousAggregate;CAT| + (|Join| (|Aggregate|) + (|mkCategory| '|domain| + '(((|map| + ($ (|Mapping| |t#1| |t#1|) + $)) + T) + ((|map!| + ($ (|Mapping| |t#1| |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|any?| + ((|Boolean|) + (|Mapping| (|Boolean|) + |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|every?| + ((|Boolean|) + (|Mapping| (|Boolean|) + |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|count| + ((|NonNegativeInteger|) + (|Mapping| (|Boolean|) + |t#1|) + $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|parts| + ((|List| |t#1|) $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|members| + ((|List| |t#1|) $)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))) + ((|count| + ((|NonNegativeInteger|) + |t#1| $)) + (AND + (|has| |t#1| + (|SetCategory|)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|)))) + ((|member?| + ((|Boolean|) |t#1| $)) + (AND + (|has| |t#1| + (|SetCategory|)) + (|has| $ + (ATTRIBUTE + |finiteAggregate|))))) + '(((|CoercibleTo| + (|OutputForm|)) + (|has| |t#1| + (|CoercibleTo| + (|OutputForm|)))) + ((|SetCategory|) + (|has| |t#1| + (|SetCategory|))) + ((|Evalable| |t#1|) + (AND + (|has| |t#1| + (|Evalable| |t#1|)) + (|has| |t#1| + (|SetCategory|))))) + '((|Boolean|) + (|NonNegativeInteger|) + (|List| |t#1|)) + NIL)) + . #1=(|HomogeneousAggregate|))))) . #1#) + (SETELT #0# 0 + (LIST '|HomogeneousAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp new file mode 100644 index 00000000..569cd271 --- /dev/null +++ b/src/algebra/strap/ILIST.lsp @@ -0,0 +1,621 @@ + +(/VERSIONCHECK 2) + +(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH) + +(DEFUN |ILIST;#;$Nni;1| (|x| $) (LENGTH |x|)) + +(PUT '|ILIST;concat;S2$;2| '|SPADreplace| 'CONS) + +(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) (CONS |s| |x|)) + +(PUT '|ILIST;eq?;2$B;3| '|SPADreplace| 'EQ) + +(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) (EQ |x| |y|)) + +(PUT '|ILIST;first;$S;4| '|SPADreplace| '|SPADfirst|) + +(DEFUN |ILIST;first;$S;4| (|x| $) (|SPADfirst| |x|)) + +(PUT '|ILIST;elt;$firstS;5| '|SPADreplace| + '(XLAM (|x| "first") (|SPADfirst| |x|))) + +(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) (|SPADfirst| |x|)) + +(PUT '|ILIST;empty;$;6| '|SPADreplace| '(XLAM NIL NIL)) + +(DEFUN |ILIST;empty;$;6| ($) NIL) + +(PUT '|ILIST;empty?;$B;7| '|SPADreplace| 'NULL) + +(DEFUN |ILIST;empty?;$B;7| (|x| $) (NULL |x|)) + +(PUT '|ILIST;rest;2$;8| '|SPADreplace| 'CDR) + +(DEFUN |ILIST;rest;2$;8| (|x| $) (CDR |x|)) + +(PUT '|ILIST;elt;$rest$;9| '|SPADreplace| + '(XLAM (|x| "rest") (CDR |x|))) + +(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (CDR |x|)) + +(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCAR (RPLACA |x| |s|))))) + +(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCAR (RPLACA |x| |s|))))) + +(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCDR (RPLACD |x| |y|))))) + +(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $) + (COND + ((SPADCALL |x| (QREFELT $ 17)) + (|error| "Cannot update an empty list")) + ('T (QCDR (RPLACD |x| |y|))))) + +(PUT '|ILIST;construct;L$;14| '|SPADreplace| '(XLAM (|l|) |l|)) + +(DEFUN |ILIST;construct;L$;14| (|l| $) |l|) + +(PUT '|ILIST;parts;$L;15| '|SPADreplace| '(XLAM (|s|) |s|)) + +(DEFUN |ILIST;parts;$L;15| (|s| $) |s|) + +(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE) + +(DEFUN |ILIST;reverse!;2$;16| (|x| $) (NREVERSE |x|)) + +(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE) + +(DEFUN |ILIST;reverse;2$;17| (|x| $) (REVERSE |x|)) + +(DEFUN |ILIST;minIndex;$I;18| (|x| $) (QREFELT $ 7)) + +(DEFUN |ILIST;rest;$Nni$;19| (|x| |n| $) + (PROG (|i|) + (RETURN + (SEQ (SEQ (LETT |i| 1 |ILIST;rest;$Nni$;19|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (COND + ((NULL |x|) (|error| "index out of range"))) + (EXIT (LETT |x| (QCDR |x|) |ILIST;rest;$Nni$;19|))) + (LETT |i| (QSADD1 |i|) |ILIST;rest;$Nni$;19|) (GO G190) + G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |ILIST;copy;2$;20| (|x| $) + (PROG (|i| |y|) + (RETURN + (SEQ (LETT |y| (SPADCALL (QREFELT $ 16)) |ILIST;copy;2$;20|) + (SEQ (LETT |i| 0 |ILIST;copy;2$;20|) G190 + (COND + ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33))) + (GO G191))) + (SEQ (COND + ((EQ |i| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (|error| "cyclic list"))))) + (LETT |y| (CONS (QCAR |x|) |y|) + |ILIST;copy;2$;20|) + (EXIT (LETT |x| (QCDR |x|) |ILIST;copy;2$;20|))) + (LETT |i| (QSADD1 |i|) |ILIST;copy;2$;20|) (GO G190) + G191 (EXIT NIL)) + (EXIT (NREVERSE |y|)))))) + +(DEFUN |ILIST;coerce;$Of;21| (|x| $) + (PROG (|s| |y| |z|) + (RETURN + (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|) + (LETT |s| (SPADCALL |x| (QREFELT $ 36)) + |ILIST;coerce;$Of;21|) + (SEQ G190 (COND ((NULL (NEQ |x| |s|)) (GO G191))) + (SEQ (LETT |y| + (CONS (SPADCALL + (SPADCALL |x| (QREFELT $ 13)) + (QREFELT $ 38)) + |y|) + |ILIST;coerce;$Of;21|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 18)) + |ILIST;coerce;$Of;21|))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|) + (EXIT (COND + ((SPADCALL |s| (QREFELT $ 17)) + (SPADCALL |y| (QREFELT $ 40))) + ('T + (SEQ (LETT |z| + (SPADCALL + (SPADCALL + (SPADCALL |x| (QREFELT $ 13)) + (QREFELT $ 38)) + (QREFELT $ 42)) + |ILIST;coerce;$Of;21|) + (SEQ G190 + (COND + ((NULL (NEQ |s| + (SPADCALL |x| (QREFELT $ 18)))) + (GO G191))) + (SEQ (LETT |x| + (SPADCALL |x| (QREFELT $ 18)) + |ILIST;coerce;$Of;21|) + (EXIT + (LETT |z| + (CONS + (SPADCALL + (SPADCALL |x| (QREFELT $ 13)) + (QREFELT $ 38)) + |z|) + |ILIST;coerce;$Of;21|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL + (SPADCALL |y| + (SPADCALL + (SPADCALL (NREVERSE |z|) + (QREFELT $ 43)) + (QREFELT $ 44)) + (QREFELT $ 45)) + (QREFELT $ 40))))))))))) + +(DEFUN |ILIST;=;2$B;22| (|x| |y| $) + (PROG (#0=#:G1469) + (RETURN + (SEQ (EXIT (COND + ((EQ |x| |y|) 'T) + ('T + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((NULL |x|) 'NIL) + ('T + (SPADCALL (NULL |y|) + (QREFELT $ 33))))) + (GO G191))) + (SEQ (EXIT + (COND + ((NULL + (SPADCALL (QCAR |x|) (QCAR |y|) + (QREFELT $ 47))) + (PROGN + (LETT #0# 'NIL + |ILIST;=;2$B;22|) + (GO #0#))) + ('T + (SEQ + (LETT |x| (QCDR |x|) + |ILIST;=;2$B;22|) + (EXIT + (LETT |y| (QCDR |y|) + |ILIST;=;2$B;22|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((NULL |x|) (NULL |y|)) + ('T 'NIL))))))) + #0# (EXIT #0#))))) + +(DEFUN |ILIST;latex;$S;23| (|x| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| "\\left[" |ILIST;latex;$S;23|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33))) + (GO G191))) + (SEQ (LETT |s| + (STRCONC |s| + (SPADCALL (QCAR |x|) + (QREFELT $ 50))) + |ILIST;latex;$S;23|) + (LETT |x| (QCDR |x|) |ILIST;latex;$S;23|) + (EXIT (COND + ((NULL (NULL |x|)) + (LETT |s| (STRCONC |s| ", ") + |ILIST;latex;$S;23|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (STRCONC |s| " \\right]")))))) + +(DEFUN |ILIST;member?;S$B;24| (|s| |x| $) + (PROG (#0=#:G1477) + (RETURN + (SEQ (EXIT (SEQ (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |x|) + (QREFELT $ 33))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |s| (QCAR |x|) + (QREFELT $ 47)) + (PROGN + (LETT #0# 'T + |ILIST;member?;S$B;24|) + (GO #0#))) + ('T + (LETT |x| (QCDR |x|) + |ILIST;member?;S$B;24|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT 'NIL))) + #0# (EXIT #0#))))) + +(DEFUN |ILIST;concat!;3$;25| (|x| |y| $) + (PROG (|z|) + (RETURN + (SEQ (COND + ((NULL |x|) + (COND + ((NULL |y|) |x|) + ('T + (SEQ (PUSH (SPADCALL |y| (QREFELT $ 13)) |x|) + (QRPLACD |x| (SPADCALL |y| (QREFELT $ 18))) + (EXIT |x|))))) + ('T + (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL (QCDR |z|)) + (QREFELT $ 33))) + (GO G191))) + (SEQ (EXIT (LETT |z| (QCDR |z|) + |ILIST;concat!;3$;25|))) + NIL (GO G190) G191 (EXIT NIL)) + (QRPLACD |z| |y|) (EXIT |x|)))))))) + +(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) + (PROG (|f| |p| |pr| |pp|) + (RETURN + (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |p|) (QREFELT $ 33))) + (GO G191))) + (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|) + (LETT |f| (QCAR |p|) + |ILIST;removeDuplicates!;2$;26|) + (LETT |p| (QCDR |p|) + |ILIST;removeDuplicates!;2$;26|) + (EXIT (SEQ G190 + (COND + ((NULL + (SPADCALL + (NULL + (LETT |pr| (QCDR |pp|) + |ILIST;removeDuplicates!;2$;26|)) + (QREFELT $ 33))) + (GO G191))) + (SEQ (EXIT + (COND + ((SPADCALL (QCAR |pr|) |f| + (QREFELT $ 47)) + (QRPLACD |pp| (QCDR |pr|))) + ('T + (LETT |pp| |pr| + |ILIST;removeDuplicates!;2$;26|))))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |l|))))) + +(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) + (|ILIST;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) + +(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $) + (PROG (|r| |t|) + (RETURN + (SEQ (COND + ((NULL |p|) |q|) + ((NULL |q|) |p|) + ((EQ |p| |q|) (|error| "cannot merge a list into itself")) + ('T + (SEQ (COND + ((SPADCALL (QCAR |p|) (QCAR |q|) |f|) + (SEQ (LETT |r| + (LETT |t| |p| |ILIST;merge!;M3$;28|) + |ILIST;merge!;M3$;28|) + (EXIT (LETT |p| (QCDR |p|) + |ILIST;merge!;M3$;28|)))) + ('T + (SEQ (LETT |r| + (LETT |t| |q| |ILIST;merge!;M3$;28|) + |ILIST;merge!;M3$;28|) + (EXIT (LETT |q| (QCDR |q|) + |ILIST;merge!;M3$;28|))))) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |p|) 'NIL) + ('T + (SPADCALL (NULL |q|) + (QREFELT $ 33))))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL (QCAR |p|) (QCAR |q|) + |f|) + (SEQ (QRPLACD |t| |p|) + (LETT |t| |p| + |ILIST;merge!;M3$;28|) + (EXIT + (LETT |p| (QCDR |p|) + |ILIST;merge!;M3$;28|)))) + ('T + (SEQ (QRPLACD |t| |q|) + (LETT |t| |q| + |ILIST;merge!;M3$;28|) + (EXIT + (LETT |q| (QCDR |q|) + |ILIST;merge!;M3$;28|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) + (EXIT |r|)))))))) + +(DEFUN |ILIST;split!;$I$;29| (|p| |n| $) + (PROG (#0=#:G1506 |q|) + (RETURN + (SEQ (COND + ((< |n| 1) (|error| "index out of range")) + ('T + (SEQ (LETT |p| + (SPADCALL |p| + (PROG1 (LETT #0# (- |n| 1) + |ILIST;split!;$I$;29|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 32)) + |ILIST;split!;$I$;29|) + (LETT |q| (QCDR |p|) |ILIST;split!;$I$;29|) + (QRPLACD |p| NIL) (EXIT |q|)))))))) + +(DEFUN |ILIST;mergeSort| (|f| |p| |n| $) + (PROG (#0=#:G1510 |l| |q|) + (RETURN + (SEQ (COND + ((EQL |n| 2) + (COND + ((SPADCALL + (SPADCALL (SPADCALL |p| (QREFELT $ 18)) + (QREFELT $ 13)) + (SPADCALL |p| (QREFELT $ 13)) |f|) + (LETT |p| (SPADCALL |p| (QREFELT $ 28)) + |ILIST;mergeSort|))))) + (EXIT (COND + ((< |n| 3) |p|) + ('T + (SEQ (LETT |l| + (PROG1 (LETT #0# (QUOTIENT2 |n| 2) + |ILIST;mergeSort|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |ILIST;mergeSort|) + (LETT |q| (SPADCALL |p| |l| (QREFELT $ 58)) + |ILIST;mergeSort|) + (LETT |p| (|ILIST;mergeSort| |f| |p| |l| $) + |ILIST;mergeSort|) + (LETT |q| + (|ILIST;mergeSort| |f| |q| (- |n| |l|) + $) + |ILIST;mergeSort|) + (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 57))))))))))) + +(DEFUN |IndexedList| (&REST #0=#:G1525 &AUX #1=#:G1523) + (DSETQ #1# #0#) + (PROG () + (RETURN + (PROG (#2=#:G1524) + (RETURN + (COND + ((LETT #2# + (|lassocShiftWithFunction| (|devaluateList| #1#) + (HGET |$ConstructorCache| '|IndexedList|) + '|domainEqualList|) + |IndexedList|) + (|CDRwithIncrement| #2#)) + ('T + (UNWIND-PROTECT + (PROG1 (APPLY (|function| |IndexedList;|) #1#) + (LETT #2# T |IndexedList|)) + (COND + ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))))) + +(DEFUN |IndexedList;| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ #0=#:G1522 #1=#:G1520 |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #2=(|IndexedList|)) + (LETT |dv$2| (|devaluate| |#2|) . #2#) + (LETT |dv$| (LIST '|IndexedList| |dv$1| |dv$2|) . #2#) + (LETT $ (GETREFV 72) . #2#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (LETT #0# + (|HasCategory| |#1| '(|SetCategory|)) . #2#) + (OR (|HasCategory| |#1| '(|OrderedSet|)) + #0#) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (OR (AND (|HasCategory| |#1| + '(|OrderedSet|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|))))) + (LETT #1# + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))) . #2#) + (OR (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + #1#))) . #2#)) + (|haddProp| |$ConstructorCache| '|IndexedList| + (LIST |dv$1| |dv$2|) (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 8) + (QSETREFV $ 46 + (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $)))) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (QSETREFV $ 48 + (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $)) + (QSETREFV $ 51 + (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $)) + (QSETREFV $ 52 + (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $))))) + (COND + ((|testBitVector| |pv$| 4) + (QSETREFV $ 54 + (CONS (|dispatchFunction| + |ILIST;removeDuplicates!;2$;26|) + $)))) + $)))) + +(MAKEPROP '|IndexedList| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|NonNegativeInteger|) |ILIST;#;$Nni;1| + |ILIST;concat;S2$;2| (|Boolean|) |ILIST;eq?;2$B;3| + |ILIST;first;$S;4| '"first" |ILIST;elt;$firstS;5| + |ILIST;empty;$;6| |ILIST;empty?;$B;7| |ILIST;rest;2$;8| + '"rest" |ILIST;elt;$rest$;9| |ILIST;setfirst!;$2S;10| + |ILIST;setelt;$first2S;11| |ILIST;setrest!;3$;12| + |ILIST;setelt;$rest2$;13| (|List| 6) + |ILIST;construct;L$;14| |ILIST;parts;$L;15| + |ILIST;reverse!;2$;16| |ILIST;reverse;2$;17| (|Integer|) + |ILIST;minIndex;$I;18| |ILIST;rest;$Nni$;19| (0 . |not|) + (5 . |cyclic?|) |ILIST;copy;2$;20| (10 . |cycleEntry|) + (|OutputForm|) (15 . |coerce|) (|List| $) (20 . |bracket|) + (|List| 37) (25 . |list|) (30 . |commaSeparate|) + (35 . |overbar|) (40 . |concat!|) (46 . |coerce|) (51 . =) + (57 . =) (|String|) (63 . |latex|) (68 . |latex|) + (73 . |member?|) |ILIST;concat!;3$;25| + (79 . |removeDuplicates!|) (|Mapping| 11 6 6) + |ILIST;sort!;M2$;27| |ILIST;merge!;M3$;28| + |ILIST;split!;$I$;29| (|Mapping| 6 6 6) (|Equation| 6) + (|List| 60) (|Mapping| 11 6) (|Void|) + (|UniversalSegment| 30) '"last" '"value" (|Mapping| 6 6) + (|InputForm|) (|SingleInteger|) (|List| 30) + (|Union| 6 '"failed")) + '#(~= 84 |value| 90 |third| 95 |tail| 100 |swap!| 105 + |split!| 112 |sorted?| 118 |sort!| 129 |sort| 140 |size?| + 151 |setvalue!| 157 |setrest!| 163 |setlast!| 169 + |setfirst!| 175 |setelt| 181 |setchildren!| 223 |select!| + 229 |select| 235 |second| 241 |sample| 246 |reverse!| 250 + |reverse| 255 |rest| 260 |removeDuplicates!| 271 + |removeDuplicates| 276 |remove!| 281 |remove| 293 |reduce| + 305 |qsetelt!| 326 |qelt| 333 |possiblyInfinite?| 339 + |position| 344 |parts| 363 |nodes| 368 |node?| 373 |new| + 379 |more?| 385 |minIndex| 391 |min| 396 |merge!| 402 + |merge| 415 |members| 428 |member?| 433 |maxIndex| 439 + |max| 444 |map!| 450 |map| 456 |list| 469 |less?| 474 + |leaves| 480 |leaf?| 485 |latex| 490 |last| 495 |insert!| + 506 |insert| 520 |indices| 534 |index?| 539 |hash| 545 + |first| 550 |find| 561 |fill!| 567 |explicitlyFinite?| 573 + |every?| 578 |eval| 584 |eq?| 610 |entry?| 616 |entries| + 622 |empty?| 627 |empty| 632 |elt| 636 |distance| 679 + |delete!| 685 |delete| 697 |cyclic?| 709 |cycleTail| 714 + |cycleSplit!| 719 |cycleLength| 724 |cycleEntry| 729 + |count| 734 |copyInto!| 746 |copy| 753 |convert| 758 + |construct| 763 |concat!| 768 |concat| 780 |coerce| 803 + |children| 808 |child?| 813 |any?| 819 >= 825 > 831 = 837 + <= 843 < 849 |#| 855) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 9 + '(0 0 0 0 0 0 0 0 0 0 2 0 0 7 5 0 0 7 9 1 5)) + (CONS '#(|ListAggregate&| |StreamAggregate&| + |ExtensibleLinearAggregate&| + |FiniteLinearAggregate&| + |UnaryRecursiveAggregate&| |LinearAggregate&| + |RecursiveAggregate&| |IndexedAggregate&| + |Collection&| |HomogeneousAggregate&| + |OrderedSet&| |Aggregate&| |EltableAggregate&| + |Evalable&| |SetCategory&| NIL NIL + |InnerEvalable&| NIL NIL |BasicType&|) + (CONS '#((|ListAggregate| 6) + (|StreamAggregate| 6) + (|ExtensibleLinearAggregate| 6) + (|FiniteLinearAggregate| 6) + (|UnaryRecursiveAggregate| 6) + (|LinearAggregate| 6) + (|RecursiveAggregate| 6) + (|IndexedAggregate| 30 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 30 6) (|Evalable| 6) + (|SetCategory|) (|Type|) + (|Eltable| 30 6) (|InnerEvalable| 6 6) + (|CoercibleTo| 37) (|ConvertibleTo| 68) + (|BasicType|)) + (|makeByteWordVec2| 71 + '(1 11 0 0 33 1 0 11 0 34 1 0 0 0 36 1 + 6 37 0 38 1 37 0 39 40 1 41 0 37 42 1 + 37 0 39 43 1 37 0 0 44 2 41 0 0 37 45 + 1 0 37 0 46 2 6 11 0 0 47 2 0 11 0 0 + 48 1 6 49 0 50 1 0 49 0 51 2 0 11 6 0 + 52 1 0 0 0 54 2 4 11 0 0 1 1 0 6 0 1 + 1 0 6 0 1 1 0 0 0 1 3 0 63 0 30 30 1 + 2 0 0 0 30 58 1 2 11 0 1 2 0 11 55 0 + 1 1 2 0 0 1 2 0 0 55 0 56 1 2 0 0 1 2 + 0 0 55 0 1 2 0 11 0 8 1 2 0 6 0 6 1 2 + 0 0 0 0 23 2 0 6 0 6 1 2 0 6 0 6 21 3 + 0 6 0 30 6 1 3 0 6 0 64 6 1 3 0 6 0 + 65 6 1 3 0 0 0 19 0 24 3 0 6 0 14 6 + 22 3 0 6 0 66 6 1 2 0 0 0 39 1 2 0 0 + 62 0 1 2 0 0 62 0 1 1 0 6 0 1 0 0 0 1 + 1 0 0 0 28 1 0 0 0 29 2 0 0 0 8 32 1 + 0 0 0 18 1 4 0 0 54 1 4 0 0 1 2 4 0 6 + 0 1 2 0 0 62 0 1 2 4 0 6 0 1 2 0 0 62 + 0 1 4 4 6 59 0 6 6 1 2 0 6 59 0 1 3 0 + 6 59 0 6 1 3 0 6 0 30 6 1 2 0 6 0 30 + 1 1 0 11 0 1 2 4 30 6 0 1 3 4 30 6 0 + 30 1 2 0 30 62 0 1 1 0 25 0 27 1 0 39 + 0 1 2 4 11 0 0 1 2 0 0 8 6 1 2 0 11 0 + 8 1 1 3 30 0 31 2 2 0 0 0 1 2 2 0 0 0 + 1 3 0 0 55 0 0 57 2 2 0 0 0 1 3 0 0 + 55 0 0 1 1 0 25 0 1 2 4 11 6 0 52 1 3 + 30 0 1 2 2 0 0 0 1 2 0 0 67 0 1 3 0 0 + 59 0 0 1 2 0 0 67 0 1 1 0 0 6 1 2 0 + 11 0 8 1 1 0 25 0 1 1 0 11 0 1 1 4 49 + 0 51 2 0 0 0 8 1 1 0 6 0 1 3 0 0 6 0 + 30 1 3 0 0 0 0 30 1 3 0 0 0 0 30 1 3 + 0 0 6 0 30 1 1 0 70 0 1 2 0 11 30 0 1 + 1 4 69 0 1 2 0 0 0 8 1 1 0 6 0 13 2 0 + 71 62 0 1 2 0 0 0 6 1 1 0 11 0 1 2 0 + 11 62 0 1 3 6 0 0 6 6 1 3 6 0 0 25 25 + 1 2 6 0 0 60 1 2 6 0 0 61 1 2 0 11 0 + 0 12 2 4 11 6 0 1 1 0 25 0 1 1 0 11 0 + 17 0 0 0 16 2 0 6 0 30 1 3 0 6 0 30 6 + 1 2 0 0 0 64 1 2 0 6 0 65 1 2 0 0 0 + 19 20 2 0 6 0 14 15 2 0 6 0 66 1 2 0 + 30 0 0 1 2 0 0 0 64 1 2 0 0 0 30 1 2 + 0 0 0 64 1 2 0 0 0 30 1 1 0 11 0 34 1 + 0 0 0 1 1 0 0 0 1 1 0 8 0 1 1 0 0 0 + 36 2 4 8 6 0 1 2 0 8 62 0 1 3 0 0 0 0 + 30 1 1 0 0 0 35 1 1 68 0 1 1 0 0 25 + 26 2 0 0 0 0 53 2 0 0 0 6 1 1 0 0 39 + 1 2 0 0 0 6 1 2 0 0 6 0 10 2 0 0 0 0 + 1 1 8 37 0 46 1 0 39 0 1 2 4 11 0 0 1 + 2 0 11 62 0 1 2 2 11 0 0 1 2 2 11 0 0 + 1 2 4 11 0 0 48 2 2 11 0 0 1 2 2 11 0 + 0 1 1 0 8 0 9))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp new file mode 100644 index 00000000..b5a58e4f --- /dev/null +++ b/src/algebra/strap/INS-.lsp @@ -0,0 +1,298 @@ + +(/VERSIONCHECK 2) + +(PUT '|INS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |INS-;characteristic;Nni;1| ($) 0) + +(DEFUN |INS-;differentiate;2S;2| (|x| $) (|spadConstant| $ 9)) + +(DEFUN |INS-;even?;SB;3| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 12)) (QREFELT $ 13))) + +(DEFUN |INS-;positive?;SB;4| (|x| $) + (SPADCALL (|spadConstant| $ 9) |x| (QREFELT $ 15))) + +(PUT '|INS-;copy;2S;5| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |INS-;copy;2S;5| (|x| $) |x|) + +(DEFUN |INS-;bit?;2SB;6| (|x| |i| $) + (SPADCALL (SPADCALL |x| (SPADCALL |i| (QREFELT $ 18)) (QREFELT $ 19)) + (QREFELT $ 12))) + +(DEFUN |INS-;mask;2S;7| (|n| $) + (SPADCALL (SPADCALL (|spadConstant| $ 21) |n| (QREFELT $ 19)) + (QREFELT $ 22))) + +(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) 'T)) + +(DEFUN |INS-;rational?;SB;8| (|x| $) 'T) + +(DEFUN |INS-;euclideanSize;SNni;9| (|x| $) + (PROG (#0=#:G1412 #1=#:G1413) + (RETURN + (COND + ((SPADCALL |x| (|spadConstant| $ 9) (QREFELT $ 25)) + (|error| "euclideanSize called on zero")) + ((SPADCALL |x| (|spadConstant| $ 9) (QREFELT $ 15)) + (PROG1 (LETT #0# (- (SPADCALL |x| (QREFELT $ 27))) + |INS-;euclideanSize;SNni;9|) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))) + ('T + (PROG1 (LETT #1# (SPADCALL |x| (QREFELT $ 27)) + |INS-;euclideanSize;SNni;9|) + (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#))))))) + +(DEFUN |INS-;convert;SF;10| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 30))) + +(DEFUN |INS-;convert;SDf;11| (|x| $) + (FLOAT (SPADCALL |x| (QREFELT $ 27)) MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |INS-;convert;SIf;12| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 35))) + +(DEFUN |INS-;retract;SI;13| (|x| $) (SPADCALL |x| (QREFELT $ 27))) + +(DEFUN |INS-;convert;SP;14| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 39))) + +(DEFUN |INS-;factor;SF;15| (|x| $) (SPADCALL |x| (QREFELT $ 43))) + +(DEFUN |INS-;squareFree;SF;16| (|x| $) (SPADCALL |x| (QREFELT $ 46))) + +(DEFUN |INS-;prime?;SB;17| (|x| $) (SPADCALL |x| (QREFELT $ 49))) + +(DEFUN |INS-;factorial;2S;18| (|x| $) (SPADCALL |x| (QREFELT $ 52))) + +(DEFUN |INS-;binomial;3S;19| (|n| |m| $) + (SPADCALL |n| |m| (QREFELT $ 54))) + +(DEFUN |INS-;permutation;3S;20| (|n| |m| $) + (SPADCALL |n| |m| (QREFELT $ 56))) + +(DEFUN |INS-;retractIfCan;SU;21| (|x| $) + (CONS 0 (SPADCALL |x| (QREFELT $ 27)))) + +(DEFUN |INS-;init;S;22| ($) (|spadConstant| $ 9)) + +(DEFUN |INS-;nextItem;SU;23| (|n| $) + (COND + ((SPADCALL |n| (QREFELT $ 61)) (CONS 0 (|spadConstant| $ 21))) + ((SPADCALL (|spadConstant| $ 9) |n| (QREFELT $ 15)) + (CONS 0 (SPADCALL |n| (QREFELT $ 18)))) + ('T (CONS 0 (SPADCALL (|spadConstant| $ 21) |n| (QREFELT $ 62)))))) + +(DEFUN |INS-;patternMatch;SP2Pmr;24| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (QREFELT $ 67))) + +(DEFUN |INS-;rational;SF;25| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 71))) + +(DEFUN |INS-;rationalIfCan;SU;26| (|x| $) + (CONS 0 (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 71)))) + +(DEFUN |INS-;symmetricRemainder;3S;27| (|x| |n| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| (SPADCALL |x| |n| (QREFELT $ 75)) + |INS-;symmetricRemainder;3S;27|) + (EXIT (COND + ((SPADCALL |r| (|spadConstant| $ 9) (QREFELT $ 25)) + |r|) + ('T + (SEQ (COND + ((SPADCALL |n| (|spadConstant| $ 9) + (QREFELT $ 15)) + (LETT |n| (SPADCALL |n| (QREFELT $ 18)) + |INS-;symmetricRemainder;3S;27|))) + (EXIT (COND + ((SPADCALL (|spadConstant| $ 9) |r| + (QREFELT $ 15)) + (COND + ((SPADCALL |n| + (SPADCALL 2 |r| (QREFELT $ 77)) + (QREFELT $ 15)) + (SPADCALL |r| |n| (QREFELT $ 62))) + ('T |r|))) + ((NULL (SPADCALL (|spadConstant| $ 9) + (SPADCALL + (SPADCALL 2 |r| + (QREFELT $ 77)) + |n| (QREFELT $ 78)) + (QREFELT $ 15))) + (SPADCALL |r| |n| (QREFELT $ 78))) + ('T |r|))))))))))) + +(DEFUN |INS-;invmod;3S;28| (|a| |b| $) + (PROG (|q| |r| |r1| |c| |c1| |d| |d1|) + (RETURN + (SEQ (COND + ((SPADCALL |a| (QREFELT $ 80)) + (LETT |a| (SPADCALL |a| |b| (QREFELT $ 81)) + |INS-;invmod;3S;28|))) + (LETT |c| |a| |INS-;invmod;3S;28|) + (LETT |c1| (|spadConstant| $ 21) |INS-;invmod;3S;28|) + (LETT |d| |b| |INS-;invmod;3S;28|) + (LETT |d1| (|spadConstant| $ 9) |INS-;invmod;3S;28|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |d| (QREFELT $ 61)) + (QREFELT $ 13))) + (GO G191))) + (SEQ (LETT |q| (SPADCALL |c| |d| (QREFELT $ 82)) + |INS-;invmod;3S;28|) + (LETT |r| + (SPADCALL |c| + (SPADCALL |q| |d| (QREFELT $ 83)) + (QREFELT $ 62)) + |INS-;invmod;3S;28|) + (LETT |r1| + (SPADCALL |c1| + (SPADCALL |q| |d1| (QREFELT $ 83)) + (QREFELT $ 62)) + |INS-;invmod;3S;28|) + (LETT |c| |d| |INS-;invmod;3S;28|) + (LETT |c1| |d1| |INS-;invmod;3S;28|) + (LETT |d| |r| |INS-;invmod;3S;28|) + (EXIT (LETT |d1| |r1| |INS-;invmod;3S;28|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |c| (|spadConstant| $ 21) (QREFELT $ 25)) + (COND + ((SPADCALL |c1| (QREFELT $ 80)) + (SPADCALL |c1| |b| (QREFELT $ 78))) + ('T |c1|))) + ('T (|error| "inverse does not exist")))))))) + +(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $) + (PROG (|y| #0=#:G1470 |z|) + (RETURN + (SEQ (EXIT (SEQ (COND + ((SPADCALL |x| (QREFELT $ 80)) + (LETT |x| (SPADCALL |x| |p| (QREFELT $ 81)) + |INS-;powmod;4S;29|))) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 61)) + (|spadConstant| $ 9)) + ((SPADCALL |n| (QREFELT $ 61)) + (|spadConstant| $ 21)) + ('T + (SEQ (LETT |y| (|spadConstant| $ 21) + |INS-;powmod;4S;29|) + (LETT |z| |x| |INS-;powmod;4S;29|) + (EXIT + (SEQ G190 NIL + (SEQ + (COND + ((SPADCALL |n| (QREFELT $ 12)) + (LETT |y| + (SPADCALL |y| |z| |p| + (QREFELT $ 85)) + |INS-;powmod;4S;29|))) + (EXIT + (COND + ((SPADCALL + (LETT |n| + (SPADCALL |n| + (SPADCALL + (|spadConstant| $ 21) + (QREFELT $ 18)) + (QREFELT $ 19)) + |INS-;powmod;4S;29|) + (QREFELT $ 61)) + (PROGN + (LETT #0# |y| + |INS-;powmod;4S;29|) + (GO #0#))) + ('T + (LETT |z| + (SPADCALL |z| |z| |p| + (QREFELT $ 85)) + |INS-;powmod;4S;29|))))) + NIL (GO G190) G191 (EXIT NIL))))))))) + #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 $ (GETREFV 87) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|IntegerNumberSystem&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) |INS-;characteristic;Nni;1| + (0 . |Zero|) |INS-;differentiate;2S;2| (|Boolean|) + (4 . |odd?|) (9 . |not|) |INS-;even?;SB;3| (14 . <) + |INS-;positive?;SB;4| |INS-;copy;2S;5| (20 . -) + (25 . |shift|) |INS-;bit?;2SB;6| (31 . |One|) (35 . |dec|) + |INS-;mask;2S;7| |INS-;rational?;SB;8| (40 . =) + (|Integer|) (46 . |convert|) |INS-;euclideanSize;SNni;9| + (|Float|) (51 . |coerce|) |INS-;convert;SF;10| + (|DoubleFloat|) |INS-;convert;SDf;11| (|InputForm|) + (56 . |convert|) |INS-;convert;SIf;12| + |INS-;retract;SI;13| (|Pattern| 26) (61 . |coerce|) + |INS-;convert;SP;14| (|Factored| 6) + (|IntegerFactorizationPackage| 6) (66 . |factor|) + (|Factored| $) |INS-;factor;SF;15| (71 . |squareFree|) + |INS-;squareFree;SF;16| (|IntegerPrimesPackage| 6) + (76 . |prime?|) |INS-;prime?;SB;17| + (|IntegerCombinatoricFunctions| 6) (81 . |factorial|) + |INS-;factorial;2S;18| (86 . |binomial|) + |INS-;binomial;3S;19| (92 . |permutation|) + |INS-;permutation;3S;20| (|Union| 26 '"failed") + |INS-;retractIfCan;SU;21| |INS-;init;S;22| (98 . |zero?|) + (103 . -) (|Union| $ '"failed") |INS-;nextItem;SU;23| + (|PatternMatchResult| 26 6) + (|PatternMatchIntegerNumberSystem| 6) + (109 . |patternMatch|) (|PatternMatchResult| 26 $) + |INS-;patternMatch;SP2Pmr;24| (|Fraction| 26) + (116 . |coerce|) |INS-;rational;SF;25| + (|Union| 70 '"failed") |INS-;rationalIfCan;SU;26| + (121 . |rem|) (|PositiveInteger|) (127 . *) (133 . +) + |INS-;symmetricRemainder;3S;27| (139 . |negative?|) + (144 . |positiveRemainder|) (150 . |quo|) (156 . *) + |INS-;invmod;3S;28| (162 . |mulmod|) |INS-;powmod;4S;29|) + '#(|symmetricRemainder| 169 |squareFree| 175 |retractIfCan| + 180 |retract| 185 |rationalIfCan| 190 |rational?| 195 + |rational| 200 |prime?| 205 |powmod| 210 |positive?| 217 + |permutation| 222 |patternMatch| 228 |nextItem| 235 |mask| + 240 |invmod| 245 |init| 251 |factorial| 255 |factor| 260 + |even?| 265 |euclideanSize| 270 |differentiate| 275 |copy| + 280 |convert| 285 |characteristic| 305 |bit?| 309 + |binomial| 315) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 86 + '(0 6 0 9 1 6 11 0 12 1 11 0 0 13 2 6 + 11 0 0 15 1 6 0 0 18 2 6 0 0 0 19 0 6 + 0 21 1 6 0 0 22 2 6 11 0 0 25 1 6 26 + 0 27 1 29 0 26 30 1 34 0 26 35 1 38 0 + 26 39 1 42 41 6 43 1 42 41 6 46 1 48 + 11 6 49 1 51 6 6 52 2 51 6 6 6 54 2 + 51 6 6 6 56 1 6 11 0 61 2 6 0 0 0 62 + 3 66 65 6 38 65 67 1 70 0 26 71 2 6 0 + 0 0 75 2 6 0 76 0 77 2 6 0 0 0 78 1 6 + 11 0 80 2 6 0 0 0 81 2 6 0 0 0 82 2 6 + 0 0 0 83 3 6 0 0 0 0 85 2 0 0 0 0 79 + 1 0 44 0 47 1 0 58 0 59 1 0 26 0 37 1 + 0 73 0 74 1 0 11 0 24 1 0 70 0 72 1 0 + 11 0 50 3 0 0 0 0 0 86 1 0 11 0 16 2 + 0 0 0 0 57 3 0 68 0 38 68 69 1 0 63 0 + 64 1 0 0 0 23 2 0 0 0 0 84 0 0 0 60 1 + 0 0 0 53 1 0 44 0 45 1 0 11 0 14 1 0 + 7 0 28 1 0 0 0 10 1 0 0 0 17 1 0 32 0 + 33 1 0 29 0 31 1 0 38 0 40 1 0 34 0 + 36 0 0 7 8 2 0 11 0 0 20 2 0 0 0 0 + 55))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/INS.lsp b/src/algebra/strap/INS.lsp new file mode 100644 index 00000000..c951d143 --- /dev/null +++ b/src/algebra/strap/INS.lsp @@ -0,0 +1,75 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL) + +(DEFUN |IntegerNumberSystem| () + (LET (#:G1403) + (COND + (|IntegerNumberSystem;AL|) + (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|)))))) + +(DEFUN |IntegerNumberSystem;| () + (PROG (#0=#:G1401) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1395 #2=#:G1396 #3=#:G1397 + #4=#:G1398 #5=#:G1399 #6=#:G1400) + (LIST '(|Integer|) '(|Integer|) + '(|Integer|) '(|InputForm|) + '(|Pattern| (|Integer|)) + '(|Integer|))) + (|Join| (|UniqueFactorizationDomain|) + (|EuclideanDomain|) + (|OrderedIntegralDomain|) + (|DifferentialRing|) + (|ConvertibleTo| '#1#) + (|RetractableTo| '#2#) + (|LinearlyExplicitRingOver| '#3#) + (|ConvertibleTo| '#4#) + (|ConvertibleTo| '#5#) + (|PatternMatchable| '#6#) + (|CombinatorialFunctionCategory|) + (|RealConstant|) (|CharacteristicZero|) + (|StepThrough|) + (|mkCategory| '|domain| + '(((|odd?| ((|Boolean|) $)) T) + ((|even?| ((|Boolean|) $)) T) + ((|base| ($)) T) + ((|length| ($ $)) T) + ((|shift| ($ $ $)) T) + ((|bit?| ((|Boolean|) $ $)) T) + ((|positiveRemainder| ($ $ $)) T) + ((|symmetricRemainder| ($ $ $)) T) + ((|rational?| ((|Boolean|) $)) T) + ((|rational| + ((|Fraction| (|Integer|)) $)) + T) + ((|rationalIfCan| + ((|Union| + (|Fraction| (|Integer|)) + "failed") + $)) + T) + ((|random| ($)) T) + ((|random| ($ $)) T) + ((|hash| ($ $)) T) + ((|copy| ($ $)) T) + ((|inc| ($ $)) T) + ((|dec| ($ $)) T) + ((|mask| ($ $)) T) + ((|addmod| ($ $ $ $)) T) + ((|submod| ($ $ $ $)) T) + ((|mulmod| ($ $ $ $)) T) + ((|powmod| ($ $ $ $)) T) + ((|invmod| ($ $ $)) T)) + '((|multiplicativeValuation| T) + (|canonicalUnitNormal| T)) + '((|Fraction| (|Integer|)) + (|Boolean|)) + NIL))) + |IntegerNumberSystem|) + (SETELT #0# 0 '(|IntegerNumberSystem|)))))) + +(MAKEPROP '|IntegerNumberSystem| 'NILADIC T) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp new file mode 100644 index 00000000..06ad04a0 --- /dev/null +++ b/src/algebra/strap/INT.lsp @@ -0,0 +1,528 @@ + +(/VERSIONCHECK 2) + +(DEFUN |INT;writeOMInt| (|dev| |x| $) + (SEQ (COND + ((< |x| 0) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 8)) + (SPADCALL |dev| "arith1" "unary_minus" + (|getShellEntry| $ 10)) + (SPADCALL |dev| (- |x|) (|getShellEntry| $ 12)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 13))))) + ('T (SPADCALL |dev| |x| (|getShellEntry| $ 12)))))) + +(DEFUN |INT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |INT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 15)) + (|getShellEntry| $ 16)) + |INT;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 17)) + (|INT;writeOMInt| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (SPADCALL |dev| (|getShellEntry| $ 19)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |INT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 15)) + (|getShellEntry| $ 16)) + |INT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) + (|INT;writeOMInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) + (SPADCALL |dev| (|getShellEntry| $ 19)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 17)) + (|INT;writeOMInt| |dev| |x| $) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 18))))) + +(DEFUN |INT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 17)))) + (|INT;writeOMInt| |dev| |x| $) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18))))))) + +(PUT '|INT;zero?;$B;6| '|SPADreplace| 'ZEROP) + +(DEFUN |INT;zero?;$B;6| (|x| $) (ZEROP |x|)) + +(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1))) + +(DEFUN |INT;one?;$B;7| (|x| $) (EQL |x| 1)) + +(PUT '|INT;Zero;$;8| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |INT;Zero;$;8| ($) 0) + +(PUT '|INT;One;$;9| '|SPADreplace| '(XLAM NIL 1)) + +(DEFUN |INT;One;$;9| ($) 1) + +(PUT '|INT;base;$;10| '|SPADreplace| '(XLAM NIL 2)) + +(DEFUN |INT;base;$;10| ($) 2) + +(PUT '|INT;copy;2$;11| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |INT;copy;2$;11| (|x| $) |x|) + +(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (+ |x| 1))) + +(DEFUN |INT;inc;2$;12| (|x| $) (+ |x| 1)) + +(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (- |x| 1))) + +(DEFUN |INT;dec;2$;13| (|x| $) (- |x| 1)) + +(PUT '|INT;hash;2$;14| '|SPADreplace| 'SXHASH) + +(DEFUN |INT;hash;2$;14| (|x| $) (SXHASH |x|)) + +(PUT '|INT;negative?;$B;15| '|SPADreplace| 'MINUSP) + +(DEFUN |INT;negative?;$B;15| (|x| $) (MINUSP |x|)) + +(DEFUN |INT;coerce;$Of;16| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 36))) + +(PUT '|INT;coerce;I$;17| '|SPADreplace| '(XLAM (|m|) |m|)) + +(DEFUN |INT;coerce;I$;17| (|m| $) |m|) + +(PUT '|INT;convert;$I;18| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |INT;convert;$I;18| (|x| $) |x|) + +(PUT '|INT;length;2$;19| '|SPADreplace| 'INTEGER-LENGTH) + +(DEFUN |INT;length;2$;19| (|a| $) (INTEGER-LENGTH |a|)) + +(DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) + (PROG (|c| #0=#:G1427) + (RETURN + (SEQ (EXIT (SEQ (SEQ (LETT |c| (+ |a| |b|) |INT;addmod;4$;20|) + (EXIT (COND + ((NULL (< |c| |p|)) + (PROGN + (LETT #0# (- |c| |p|) + |INT;addmod;4$;20|) + (GO #0#)))))) + (EXIT |c|))) + #0# (EXIT #0#))))) + +(DEFUN |INT;submod;4$;21| (|a| |b| |p| $) + (PROG (|c|) + (RETURN + (SEQ (LETT |c| (- |a| |b|) |INT;submod;4$;21|) + (EXIT (COND ((< |c| 0) (+ |c| |p|)) ('T |c|))))))) + +(DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $) + (REMAINDER2 (* |a| |b|) |p|)) + +(DEFUN |INT;convert;$F;23| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 45))) + +(PUT '|INT;convert;$Df;24| '|SPADreplace| + '(XLAM (|x|) (FLOAT |x| MOST-POSITIVE-LONG-FLOAT))) + +(DEFUN |INT;convert;$Df;24| (|x| $) + (FLOAT |x| MOST-POSITIVE-LONG-FLOAT)) + +(DEFUN |INT;convert;$If;25| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 50))) + +(PUT '|INT;convert;$S;26| '|SPADreplace| 'STRINGIMAGE) + +(DEFUN |INT;convert;$S;26| (|x| $) (STRINGIMAGE |x|)) + +(DEFUN |INT;latex;$S;27| (|x| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| (STRINGIMAGE |x|) |INT;latex;$S;27|) + (COND ((< -1 |x|) (COND ((< |x| 10) (EXIT |s|))))) + (EXIT (STRCONC "{" (STRCONC |s| "}"))))))) + +(DEFUN |INT;positiveRemainder;3$;28| (|a| |b| $) + (PROG (|r|) + (RETURN + (COND + ((MINUSP (LETT |r| (REMAINDER2 |a| |b|) + |INT;positiveRemainder;3$;28|)) + (COND ((MINUSP |b|) (- |r| |b|)) ('T (+ |r| |b|)))) + ('T |r|))))) + +(PUT '|INT;reducedSystem;MM;29| '|SPADreplace| '(XLAM (|m|) |m|)) + +(DEFUN |INT;reducedSystem;MM;29| (|m| $) |m|) + +(DEFUN |INT;reducedSystem;MVR;30| (|m| |v| $) (CONS |m| '|vec|)) + +(PUT '|INT;abs;2$;31| '|SPADreplace| 'ABS) + +(DEFUN |INT;abs;2$;31| (|x| $) (ABS |x|)) + +(PUT '|INT;random;$;32| '|SPADreplace| '|random|) + +(DEFUN |INT;random;$;32| ($) (|random|)) + +(PUT '|INT;random;2$;33| '|SPADreplace| 'RANDOM) + +(DEFUN |INT;random;2$;33| (|x| $) (RANDOM |x|)) + +(PUT '|INT;=;2$B;34| '|SPADreplace| 'EQL) + +(DEFUN |INT;=;2$B;34| (|x| |y| $) (EQL |x| |y|)) + +(PUT '|INT;<;2$B;35| '|SPADreplace| '<) + +(DEFUN |INT;<;2$B;35| (|x| |y| $) (< |x| |y|)) + +(PUT '|INT;-;2$;36| '|SPADreplace| '-) + +(DEFUN |INT;-;2$;36| (|x| $) (- |x|)) + +(PUT '|INT;+;3$;37| '|SPADreplace| '+) + +(DEFUN |INT;+;3$;37| (|x| |y| $) (+ |x| |y|)) + +(PUT '|INT;-;3$;38| '|SPADreplace| '-) + +(DEFUN |INT;-;3$;38| (|x| |y| $) (- |x| |y|)) + +(PUT '|INT;*;3$;39| '|SPADreplace| '*) + +(DEFUN |INT;*;3$;39| (|x| |y| $) (* |x| |y|)) + +(PUT '|INT;*;I2$;40| '|SPADreplace| '*) + +(DEFUN |INT;*;I2$;40| (|m| |y| $) (* |m| |y|)) + +(PUT '|INT;**;$Nni$;41| '|SPADreplace| 'EXPT) + +(DEFUN |INT;**;$Nni$;41| (|x| |n| $) (EXPT |x| |n|)) + +(PUT '|INT;odd?;$B;42| '|SPADreplace| 'ODDP) + +(DEFUN |INT;odd?;$B;42| (|x| $) (ODDP |x|)) + +(PUT '|INT;max;3$;43| '|SPADreplace| 'MAX) + +(DEFUN |INT;max;3$;43| (|x| |y| $) (MAX |x| |y|)) + +(PUT '|INT;min;3$;44| '|SPADreplace| 'MIN) + +(DEFUN |INT;min;3$;44| (|x| |y| $) (MIN |x| |y|)) + +(PUT '|INT;divide;2$R;45| '|SPADreplace| 'DIVIDE2) + +(DEFUN |INT;divide;2$R;45| (|x| |y| $) (DIVIDE2 |x| |y|)) + +(PUT '|INT;quo;3$;46| '|SPADreplace| 'QUOTIENT2) + +(DEFUN |INT;quo;3$;46| (|x| |y| $) (QUOTIENT2 |x| |y|)) + +(PUT '|INT;rem;3$;47| '|SPADreplace| 'REMAINDER2) + +(DEFUN |INT;rem;3$;47| (|x| |y| $) (REMAINDER2 |x| |y|)) + +(PUT '|INT;shift;3$;48| '|SPADreplace| 'ASH) + +(DEFUN |INT;shift;3$;48| (|x| |y| $) (ASH |x| |y|)) + +(DEFUN |INT;exquo;2$U;49| (|x| |y| $) + (COND + ((OR (ZEROP |y|) (NULL (ZEROP (REMAINDER2 |x| |y|)))) + (CONS 1 "failed")) + ('T (CONS 0 (QUOTIENT2 |x| |y|))))) + +(DEFUN |INT;recip;$U;50| (|x| $) + (COND + ((OR (EQL |x| 1) (EQL |x| -1)) (CONS 0 |x|)) + ('T (CONS 1 "failed")))) + +(PUT '|INT;gcd;3$;51| '|SPADreplace| 'GCD) + +(DEFUN |INT;gcd;3$;51| (|x| |y| $) (GCD |x| |y|)) + +(DEFUN |INT;unitNormal;$R;52| (|x| $) + (COND ((< |x| 0) (VECTOR -1 (- |x|) -1)) ('T (VECTOR 1 |x| 1)))) + +(PUT '|INT;unitCanonical;2$;53| '|SPADreplace| 'ABS) + +(DEFUN |INT;unitCanonical;2$;53| (|x| $) (ABS |x|)) + +(DEFUN |INT;solveLinearPolynomialEquation| (|lp| |p| $) + (SPADCALL |lp| |p| (|getShellEntry| $ 93))) + +(DEFUN |INT;squareFreePolynomial| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 97))) + +(DEFUN |INT;factorPolynomial| (|p| $) + (PROG (|pp| #0=#:G1498) + (RETURN + (SEQ (LETT |pp| (SPADCALL |p| (|getShellEntry| $ 98)) + |INT;factorPolynomial|) + (EXIT (COND + ((EQL (SPADCALL |pp| (|getShellEntry| $ 99)) + (SPADCALL |p| (|getShellEntry| $ 99))) + (SPADCALL |p| (|getShellEntry| $ 101))) + ('T + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 101)) + (SPADCALL (CONS #'|INT;factorPolynomial!0| $) + (SPADCALL + (PROG2 (LETT #0# + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 99)) + (SPADCALL |pp| + (|getShellEntry| $ 99)) + (|getShellEntry| $ 83)) + |INT;factorPolynomial|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) $ #0#)) + (|getShellEntry| $ 104)) + (|getShellEntry| $ 108)) + (|getShellEntry| $ 110))))))))) + +(DEFUN |INT;factorPolynomial!0| (|#1| $) + (SPADCALL |#1| (|getShellEntry| $ 102))) + +(DEFUN |INT;factorSquareFreePolynomial| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 111))) + +(DEFUN |INT;gcdPolynomial;3Sup;58| (|p| |q| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 112)) + (SPADCALL |q| (|getShellEntry| $ 113))) + ((SPADCALL |q| (|getShellEntry| $ 112)) + (SPADCALL |p| (|getShellEntry| $ 113))) + ('T (SPADCALL (LIST |p| |q|) (|getShellEntry| $ 116))))) + +(DEFUN |Integer| () + (PROG () + (RETURN + (PROG (#0=#:G1523) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Integer| + (LIST + (CONS NIL (CONS 1 (|Integer;|)))))) + (LETT #0# T |Integer|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|Integer|))))))))))) + +(DEFUN |Integer;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Integer|) . #0=(|Integer|)) + (LETT $ (|newShell| 132) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Integer| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 71 + (|setShellEntry| $ 70 + (CONS (|dispatchFunction| |INT;*;I2$;40|) $))) + $)))) + +(MAKEPROP '|Integer| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|Void|) (|OpenMathDevice|) + (0 . |OMputApp|) (|String|) (5 . |OMputSymbol|) + (|Integer|) (12 . |OMputInteger|) (18 . |OMputEndApp|) + (|OpenMathEncoding|) (23 . |OMencodingXML|) + (27 . |OMopenString|) (33 . |OMputObject|) + (38 . |OMputEndObject|) (43 . |OMclose|) + |INT;OMwrite;$S;2| (|Boolean|) |INT;OMwrite;$BS;3| + |INT;OMwrite;Omd$V;4| |INT;OMwrite;Omd$BV;5| + |INT;zero?;$B;6| |INT;one?;$B;7| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |INT;Zero;$;8|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |INT;One;$;9|) $)) + |INT;base;$;10| |INT;copy;2$;11| |INT;inc;2$;12| + |INT;dec;2$;13| |INT;hash;2$;14| |INT;negative?;$B;15| + (|OutputForm|) (48 . |outputForm|) |INT;coerce;$Of;16| + |INT;coerce;I$;17| |INT;convert;$I;18| |INT;length;2$;19| + |INT;addmod;4$;20| |INT;submod;4$;21| |INT;mulmod;4$;22| + (|Float|) (53 . |coerce|) |INT;convert;$F;23| + (|DoubleFloat|) |INT;convert;$Df;24| (|InputForm|) + (58 . |convert|) |INT;convert;$If;25| |INT;convert;$S;26| + |INT;latex;$S;27| |INT;positiveRemainder;3$;28| + (|Matrix| 11) (|Matrix| $) |INT;reducedSystem;MM;29| + (|Vector| 11) (|Record| (|:| |mat| 55) (|:| |vec| 58)) + (|Vector| $) |INT;reducedSystem;MVR;30| |INT;abs;2$;31| + |INT;random;$;32| |INT;random;2$;33| |INT;=;2$B;34| + |INT;<;2$B;35| |INT;-;2$;36| |INT;+;3$;37| |INT;-;3$;38| + NIL NIL (|NonNegativeInteger|) |INT;**;$Nni$;41| + |INT;odd?;$B;42| |INT;max;3$;43| |INT;min;3$;44| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + |INT;divide;2$R;45| |INT;quo;3$;46| |INT;rem;3$;47| + |INT;shift;3$;48| (|Union| $ '"failed") |INT;exquo;2$U;49| + |INT;recip;$U;50| |INT;gcd;3$;51| + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + |INT;unitNormal;$R;52| |INT;unitCanonical;2$;53| + (|SparseUnivariatePolynomial| 11) (|List| 89) + (|Union| 90 '"failed") + (|IntegerSolveLinearPolynomialEquation|) + (63 . |solveLinearPolynomialEquation|) + (|SparseUnivariatePolynomial| $$) (|Factored| 94) + (|UnivariatePolynomialSquareFree| $$ 94) + (69 . |squareFree|) (74 . |primitivePart|) + (79 . |leadingCoefficient|) (|GaloisGroupFactorizer| 94) + (84 . |factor|) (89 . |coerce|) (|Factored| $) + (94 . |factor|) (|Mapping| 94 $$) (|Factored| $$) + (|FactoredFunctions2| $$ 94) (99 . |map|) + (|FactoredFunctionUtilities| 94) (105 . |mergeFactors|) + (111 . |factorSquareFree|) (116 . |zero?|) + (121 . |unitCanonical|) (|List| 94) (|HeuGcd| 94) + (126 . |gcd|) (|SparseUnivariatePolynomial| $) + |INT;gcdPolynomial;3Sup;58| (|Fraction| 11) + (|Union| 119 '"failed") (|PatternMatchResult| 11 $) + (|Pattern| 11) (|Union| 11 '"failed") (|List| $) + (|Union| 124 '"failed") + (|Record| (|:| |coef| 124) (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 127 '"failed") + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + (|PositiveInteger|) (|SingleInteger|)) + '#(~= 131 |zero?| 137 |unitNormal| 142 |unitCanonical| 147 + |unit?| 152 |symmetricRemainder| 157 |subtractIfCan| 163 + |submod| 169 |squareFreePart| 176 |squareFree| 181 + |sizeLess?| 186 |sign| 192 |shift| 197 |sample| 203 + |retractIfCan| 207 |retract| 212 |rem| 217 |reducedSystem| + 223 |recip| 234 |rationalIfCan| 239 |rational?| 244 + |rational| 249 |random| 254 |quo| 263 |principalIdeal| 269 + |prime?| 274 |powmod| 279 |positiveRemainder| 286 + |positive?| 292 |permutation| 297 |patternMatch| 303 + |one?| 310 |odd?| 315 |nextItem| 320 |negative?| 325 + |multiEuclidean| 330 |mulmod| 336 |min| 343 |max| 349 + |mask| 355 |length| 360 |lcm| 365 |latex| 376 |invmod| 381 + |init| 387 |inc| 391 |hash| 396 |gcdPolynomial| 406 |gcd| + 412 |factorial| 423 |factor| 428 |extendedEuclidean| 433 + |exquo| 446 |expressIdealMember| 452 |even?| 458 + |euclideanSize| 463 |divide| 468 |differentiate| 474 |dec| + 485 |copy| 490 |convert| 495 |coerce| 525 |characteristic| + 545 |bit?| 549 |binomial| 555 |base| 561 |associates?| 565 + |addmod| 571 |abs| 578 ^ 583 |Zero| 595 |One| 599 + |OMwrite| 603 D 627 >= 638 > 644 = 650 <= 656 < 662 - 668 + + 679 ** 685 * 697) + '((|infinite| . 0) (|noetherian| . 0) + (|canonicalsClosed| . 0) (|canonical| . 0) + (|canonicalUnitNormal| . 0) (|multiplicativeValuation| . 0) + (|noZeroDivisors| . 0) ((|commutative| "*") . 0) + (|rightUnitary| . 0) (|leftUnitary| . 0) + (|unitsKnown| . 0)) + (CONS (|makeByteWordVec2| 1 + '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) + (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| + |UniqueFactorizationDomain&| NIL NIL + |GcdDomain&| |IntegralDomain&| |Algebra&| NIL + NIL |DifferentialRing&| |OrderedRing&| NIL NIL + |Module&| NIL NIL |Ring&| NIL NIL NIL NIL NIL + |AbelianGroup&| NIL NIL |AbelianMonoid&| + |Monoid&| NIL NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| NIL + |SetCategory&| NIL NIL NIL NIL NIL NIL NIL + |RetractableTo&| NIL |BasicType&| NIL) + (CONS '#((|IntegerNumberSystem|) + (|EuclideanDomain|) + (|UniqueFactorizationDomain|) + (|PrincipalIdealDomain|) + (|OrderedIntegralDomain|) (|GcdDomain|) + (|IntegralDomain|) (|Algebra| $$) + (|CharacteristicZero|) + (|LinearlyExplicitRingOver| 11) + (|DifferentialRing|) (|OrderedRing|) + (|CommutativeRing|) (|EntireRing|) + (|Module| $$) (|OrderedAbelianGroup|) + (|BiModule| $$ $$) (|Ring|) + (|OrderedCancellationAbelianMonoid|) + (|LeftModule| $$) (|Rng|) + (|RightModule| $$) + (|OrderedAbelianMonoid|) + (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) + (|StepThrough|) (|PatternMatchable| 11) + (|OrderedSet|) (|AbelianSemiGroup|) + (|SemiGroup|) (|RealConstant|) + (|SetCategory|) (|OpenMath|) + (|ConvertibleTo| 9) (|ConvertibleTo| 44) + (|ConvertibleTo| 47) + (|CombinatorialFunctionCategory|) + (|ConvertibleTo| 122) + (|ConvertibleTo| 49) + (|RetractableTo| 11) + (|ConvertibleTo| 11) (|BasicType|) + (|CoercibleTo| 35)) + (|makeByteWordVec2| 131 + '(1 7 6 0 8 3 7 6 0 9 9 10 2 7 6 0 11 + 12 1 7 6 0 13 0 14 0 15 2 7 0 9 14 16 + 1 7 6 0 17 1 7 6 0 18 1 7 6 0 19 1 35 + 0 11 36 1 44 0 11 45 1 49 0 11 50 2 + 92 91 90 89 93 1 96 95 94 97 1 94 0 0 + 98 1 94 2 0 99 1 100 95 94 101 1 94 0 + 2 102 1 0 103 0 104 2 107 95 105 106 + 108 2 109 95 95 95 110 1 100 95 94 + 111 1 94 21 0 112 1 94 0 0 113 1 115 + 94 114 116 2 0 21 0 0 1 1 0 21 0 25 1 + 0 86 0 87 1 0 0 0 88 1 0 21 0 1 2 0 0 + 0 0 1 2 0 82 0 0 1 3 0 0 0 0 0 42 1 0 + 0 0 1 1 0 103 0 1 2 0 21 0 0 1 1 0 11 + 0 1 2 0 0 0 0 81 0 0 0 1 1 0 123 0 1 + 1 0 11 0 1 2 0 0 0 0 80 2 0 59 56 60 + 61 1 0 55 56 57 1 0 82 0 84 1 0 120 0 + 1 1 0 21 0 1 1 0 119 0 1 1 0 0 0 64 0 + 0 0 63 2 0 0 0 0 79 1 0 126 124 1 1 0 + 21 0 1 3 0 0 0 0 0 1 2 0 0 0 0 54 1 0 + 21 0 1 2 0 0 0 0 1 3 0 121 0 122 121 + 1 1 0 21 0 26 1 0 21 0 74 1 0 82 0 1 + 1 0 21 0 34 2 0 125 124 0 1 3 0 0 0 0 + 0 43 2 0 0 0 0 76 2 0 0 0 0 75 1 0 0 + 0 1 1 0 0 0 40 1 0 0 124 1 2 0 0 0 0 + 1 1 0 9 0 53 2 0 0 0 0 1 0 0 0 1 1 0 + 0 0 31 1 0 0 0 33 1 0 131 0 1 2 0 117 + 117 117 118 2 0 0 0 0 85 1 0 0 124 1 + 1 0 0 0 1 1 0 103 0 104 3 0 128 0 0 0 + 1 2 0 129 0 0 1 2 0 82 0 0 83 2 0 125 + 124 0 1 1 0 21 0 1 1 0 72 0 1 2 0 77 + 0 0 78 1 0 0 0 1 2 0 0 0 72 1 1 0 0 0 + 32 1 0 0 0 30 1 0 9 0 52 1 0 47 0 48 + 1 0 44 0 46 1 0 49 0 51 1 0 122 0 1 1 + 0 11 0 39 1 0 0 11 38 1 0 0 11 38 1 0 + 0 0 1 1 0 35 0 37 0 0 72 1 2 0 21 0 0 + 1 2 0 0 0 0 1 0 0 0 29 2 0 21 0 0 1 3 + 0 0 0 0 0 41 1 0 0 0 62 2 0 0 0 72 1 + 2 0 0 0 130 1 0 0 0 27 0 0 0 28 3 0 6 + 7 0 21 24 2 0 9 0 21 22 2 0 6 7 0 23 + 1 0 9 0 20 1 0 0 0 1 2 0 0 0 72 1 2 0 + 21 0 0 1 2 0 21 0 0 1 2 0 21 0 0 65 2 + 0 21 0 0 1 2 0 21 0 0 66 2 0 0 0 0 69 + 1 0 0 0 67 2 0 0 0 0 68 2 0 0 0 72 73 + 2 0 0 0 130 1 2 0 0 0 0 70 2 0 0 11 0 + 71 2 0 0 72 0 1 2 0 0 130 0 1))))) + '|lookupComplete|)) + +(MAKEPROP '|Integer| 'NILADIC T) diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp new file mode 100644 index 00000000..7c1f5677 --- /dev/null +++ b/src/algebra/strap/INTDOM-.lsp @@ -0,0 +1,79 @@ + +(/VERSIONCHECK 2) + +(DEFUN |INTDOM-;unitNormal;SR;1| (|x| $) + (VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7))) + +(DEFUN |INTDOM-;unitCanonical;2S;2| (|x| $) + (QVELT (SPADCALL |x| (QREFELT $ 10)) 1)) + +(DEFUN |INTDOM-;recip;SU;3| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) (CONS 1 "failed")) + ('T (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 15))))) + +(DEFUN |INTDOM-;unit?;SB;4| (|x| $) + (COND ((QEQCAR (SPADCALL |x| (QREFELT $ 17)) 1) 'NIL) ('T 'T))) + +(DEFUN |INTDOM-;associates?;2SB;5| (|x| |y| $) + (SPADCALL (QVELT (SPADCALL |x| (QREFELT $ 10)) 1) + (QVELT (SPADCALL |y| (QREFELT $ 10)) 1) (QREFELT $ 19))) + +(DEFUN |INTDOM-;associates?;2SB;6| (|x| |y| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |y| (QREFELT $ 13))) + ((OR (SPADCALL |y| (QREFELT $ 13)) + (OR (QEQCAR (SPADCALL |x| |y| (QREFELT $ 15)) 1) + (QEQCAR (SPADCALL |y| |x| (QREFELT $ 15)) 1))) + 'NIL) + ('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 $ (GETREFV 21) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|HasCategory| |#1| '(|Field|))) + ('T + (QSETREFV $ 9 + (CONS (|dispatchFunction| |INTDOM-;unitNormal;SR;1|) $)))) + (COND + ((|HasAttribute| |#1| '|canonicalUnitNormal|) + (QSETREFV $ 20 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;5|) + $))) + ('T + (QSETREFV $ 20 + (CONS (|dispatchFunction| |INTDOM-;associates?;2SB;6|) + $)))) + $)))) + +(MAKEPROP '|IntegralDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (4 . |unitNormal|) (9 . |unitNormal|) + |INTDOM-;unitCanonical;2S;2| (|Boolean|) (14 . |zero?|) + (|Union| $ '"failed") (19 . |exquo|) |INTDOM-;recip;SU;3| + (25 . |recip|) |INTDOM-;unit?;SB;4| (30 . =) + (36 . |associates?|)) + '#(|unitNormal| 42 |unitCanonical| 47 |unit?| 52 |recip| 57 + |associates?| 62) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 20 + '(0 6 0 7 1 0 8 0 9 1 6 8 0 10 1 6 12 0 + 13 2 6 14 0 0 15 1 6 14 0 17 2 6 12 0 + 0 19 2 0 12 0 0 20 1 0 8 0 9 1 0 0 0 + 11 1 0 12 0 18 1 0 14 0 16 2 0 12 0 0 + 20))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/INTDOM.lsp b/src/algebra/strap/INTDOM.lsp new file mode 100644 index 00000000..9f770345 --- /dev/null +++ b/src/algebra/strap/INTDOM.lsp @@ -0,0 +1,34 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |IntegralDomain;AL| 'NIL) + +(DEFUN |IntegralDomain| () + (LET (#:G1393) + (COND + (|IntegralDomain;AL|) + (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|)))))) + +(DEFUN |IntegralDomain;| () + (PROG (#0=#:G1391) + (RETURN + (PROG1 (LETT #0# + (|Join| (|CommutativeRing|) (|Algebra| '$) + (|EntireRing|) + (|mkCategory| '|domain| + '(((|exquo| ((|Union| $ "failed") $ $)) + T) + ((|unitNormal| + ((|Record| (|:| |unit| $) + (|:| |canonical| $) + (|:| |associate| $)) + $)) + T) + ((|unitCanonical| ($ $)) T) + ((|associates?| ((|Boolean|) $ $)) T) + ((|unit?| ((|Boolean|) $)) T)) + NIL '((|Boolean|)) NIL)) + |IntegralDomain|) + (SETELT #0# 0 '(|IntegralDomain|)))))) + +(MAKEPROP '|IntegralDomain| 'NILADIC T) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp new file mode 100644 index 00000000..65f503c0 --- /dev/null +++ b/src/algebra/strap/ISTRING.lsp @@ -0,0 +1,891 @@ + +(/VERSIONCHECK 2) + +(PUT '|ISTRING;new;NniC$;1| '|SPADreplace| 'MAKE-FULL-CVEC) + +(DEFUN |ISTRING;new;NniC$;1| (|n| |c| $) (MAKE-FULL-CVEC |n| |c|)) + +(PUT '|ISTRING;empty;$;2| '|SPADreplace| + '(XLAM NIL (MAKE-FULL-CVEC 0))) + +(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) + +(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0)) + +(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE) + +(DEFUN |ISTRING;#;$Nni;4| (|s| $) (QCSIZE |s|)) + +(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL) + +(DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (EQUAL |s| |t|)) + +(PUT '|ISTRING;<;2$B;6| '|SPADreplace| + '(XLAM (|s| |t|) (CGREATERP |t| |s|))) + +(DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (CGREATERP |t| |s|)) + +(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC) + +(DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (STRCONC |s| |t|)) + +(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ) + +(DEFUN |ISTRING;copy;2$;8| (|s| $) (COPY-SEQ |s|)) + +(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| $) + (SPADCALL + (SPADCALL + (SPADCALL |s| + (SPADCALL (QREFELT $ 6) (- |i| 1) (QREFELT $ 20)) + (QREFELT $ 21)) + |t| (QREFELT $ 16)) + (SPADCALL |s| (SPADCALL |i| (QREFELT $ 22)) (QREFELT $ 21)) + (QREFELT $ 16))) + +(DEFUN |ISTRING;coerce;$Of;10| (|s| $) (SPADCALL |s| (QREFELT $ 26))) + +(DEFUN |ISTRING;minIndex;$I;11| (|s| $) (QREFELT $ 6)) + +(DEFUN |ISTRING;upperCase!;2$;12| (|s| $) + (SPADCALL (ELT $ 31) |s| (QREFELT $ 33))) + +(DEFUN |ISTRING;lowerCase!;2$;13| (|s| $) + (SPADCALL (ELT $ 36) |s| (QREFELT $ 33))) + +(DEFUN |ISTRING;latex;$S;14| (|s| $) + (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) + +(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) + (PROG (|l| |m| |n| |h| #0=#:G1770 |r| #1=#:G1776 #2=#:G1777 |i| + #3=#:G1778 |k|) + (RETURN + (SEQ (LETT |l| (- (SPADCALL |sg| (QREFELT $ 39)) (QREFELT $ 6)) + |ISTRING;replace;$Us2$;15|) + (LETT |m| (SPADCALL |s| (QREFELT $ 13)) + |ISTRING;replace;$Us2$;15|) + (LETT |n| (SPADCALL |t| (QREFELT $ 13)) + |ISTRING;replace;$Us2$;15|) + (LETT |h| + (COND + ((SPADCALL |sg| (QREFELT $ 40)) + (- (SPADCALL |sg| (QREFELT $ 41)) (QREFELT $ 6))) + ('T (- (SPADCALL |s| (QREFELT $ 42)) (QREFELT $ 6)))) + |ISTRING;replace;$Us2$;15|) + (COND + ((OR (OR (< |l| 0) (NULL (< |h| |m|))) (< |h| (- |l| 1))) + (EXIT (|error| "index out of range")))) + (LETT |r| + (SPADCALL + (PROG1 (LETT #0# (+ (- |m| (+ (- |h| |l|) 1)) |n|) + |ISTRING;replace;$Us2$;15|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (SPADCALL (QREFELT $ 43)) (QREFELT $ 9)) + |ISTRING;replace;$Us2$;15|) + (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) + (LETT #1# (- |l| 1) |ISTRING;replace;$Us2$;15|) + (LETT |k| 0 |ISTRING;replace;$Us2$;15|) G190 + (COND ((QSGREATERP |i| #1#) (GO G191))) + (SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|)))) + (LETT |k| + (PROG1 (QSADD1 |k|) + (LETT |i| (QSADD1 |i|) + |ISTRING;replace;$Us2$;15|)) + |ISTRING;replace;$Us2$;15|) + (GO G190) G191 (EXIT NIL)) + (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) + (LETT #2# (- |n| 1) |ISTRING;replace;$Us2$;15|) + (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 + (COND ((QSGREATERP |i| #2#) (GO G191))) + (SEQ (EXIT (QESET |r| |k| (CHAR |t| |i|)))) + (LETT |k| + (PROG1 (+ |k| 1) + (LETT |i| (QSADD1 |i|) + |ISTRING;replace;$Us2$;15|)) + |ISTRING;replace;$Us2$;15|) + (GO G190) G191 (EXIT NIL)) + (SEQ (LETT |i| (+ |h| 1) |ISTRING;replace;$Us2$;15|) + (LETT #3# (- |m| 1) |ISTRING;replace;$Us2$;15|) + (LETT |k| |k| |ISTRING;replace;$Us2$;15|) G190 + (COND ((> |i| #3#) (GO G191))) + (SEQ (EXIT (QESET |r| |k| (CHAR |s| |i|)))) + (LETT |k| + (PROG1 (+ |k| 1) + (LETT |i| (+ |i| 1) |ISTRING;replace;$Us2$;15|)) + |ISTRING;replace;$Us2$;15|) + (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $) + (SEQ (COND + ((OR (< |i| (QREFELT $ 6)) + (< (SPADCALL |s| (QREFELT $ 42)) |i|)) + (|error| "index out of range")) + ('T (SEQ (QESET |s| (- |i| (QREFELT $ 6)) |c|) (EXIT |c|)))))) + +(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) + (PROG (|np| |nw| |iw| |ip| #0=#:G1788 #1=#:G1787 #2=#:G1783) + (RETURN + (SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|) + |ISTRING;substring?;2$IB;17|) + (LETT |nw| (QCSIZE |whole|) + |ISTRING;substring?;2$IB;17|) + (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;substring?;2$IB;17|) + (EXIT (COND + ((< |startpos| 0) + (|error| "index out of bounds")) + ((< (- |nw| |startpos|) |np|) 'NIL) + ('T + (SEQ (SEQ + (EXIT + (SEQ + (LETT |iw| |startpos| + |ISTRING;substring?;2$IB;17|) + (LETT |ip| 0 + |ISTRING;substring?;2$IB;17|) + (LETT #0# (- |np| 1) + |ISTRING;substring?;2$IB;17|) + G190 + (COND + ((QSGREATERP |ip| #0#) + (GO G191))) + (SEQ + (EXIT + (COND + ((NULL + (CHAR= (CHAR |part| |ip|) + (CHAR |whole| |iw|))) + (PROGN + (LETT #2# + (PROGN + (LETT #1# 'NIL + |ISTRING;substring?;2$IB;17|) + (GO #1#)) + |ISTRING;substring?;2$IB;17|) + (GO #2#)))))) + (LETT |ip| + (PROG1 (QSADD1 |ip|) + (LETT |iw| (+ |iw| 1) + |ISTRING;substring?;2$IB;17|)) + |ISTRING;substring?;2$IB;17|) + (GO G190) G191 (EXIT NIL))) + #2# (EXIT #2#)) + (EXIT 'T))))))) + #1# (EXIT #1#))))) + +(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;position;2$2I;18|) + (EXIT (COND + ((< |startpos| 0) (|error| "index out of bounds")) + ((NULL (< |startpos| (QCSIZE |t|))) + (- (QREFELT $ 6) 1)) + ('T + (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) + |ISTRING;position;2$2I;18|) + (EXIT (COND + ((EQ |r| NIL) (- (QREFELT $ 6) 1)) + ('T (+ |r| (QREFELT $ 6))))))))))))) + +(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) + (PROG (|r| #0=#:G1799 #1=#:G1798) + (RETURN + (SEQ (EXIT (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;position;C$2I;19|) + (EXIT (COND + ((< |startpos| 0) + (|error| "index out of bounds")) + ((NULL (< |startpos| (QCSIZE |t|))) + (- (QREFELT $ 6) 1)) + ('T + (SEQ (SEQ + (LETT |r| |startpos| + |ISTRING;position;C$2I;19|) + (LETT #0# + (QSDIFFERENCE (QCSIZE |t|) 1) + |ISTRING;position;C$2I;19|) + G190 + (COND ((> |r| #0#) (GO G191))) + (SEQ + (EXIT + (COND + ((CHAR= (CHAR |t| |r|) |c|) + (PROGN + (LETT #1# + (+ |r| (QREFELT $ 6)) + |ISTRING;position;C$2I;19|) + (GO #1#)))))) + (LETT |r| (+ |r| 1) + |ISTRING;position;C$2I;19|) + (GO G190) G191 (EXIT NIL)) + (EXIT (- (QREFELT $ 6) 1)))))))) + #1# (EXIT #1#))))) + +(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) + (PROG (|r| #0=#:G1806 #1=#:G1805) + (RETURN + (SEQ (EXIT (SEQ (LETT |startpos| (- |startpos| (QREFELT $ 6)) + |ISTRING;position;Cc$2I;20|) + (EXIT (COND + ((< |startpos| 0) + (|error| "index out of bounds")) + ((NULL (< |startpos| (QCSIZE |t|))) + (- (QREFELT $ 6) 1)) + ('T + (SEQ (SEQ + (LETT |r| |startpos| + |ISTRING;position;Cc$2I;20|) + (LETT #0# + (QSDIFFERENCE (QCSIZE |t|) 1) + |ISTRING;position;Cc$2I;20|) + G190 + (COND ((> |r| #0#) (GO G191))) + (SEQ + (EXIT + (COND + ((SPADCALL (CHAR |t| |r|) |cc| + (QREFELT $ 49)) + (PROGN + (LETT #1# + (+ |r| (QREFELT $ 6)) + |ISTRING;position;Cc$2I;20|) + (GO #1#)))))) + (LETT |r| (+ |r| 1) + |ISTRING;position;Cc$2I;20|) + (GO G190) G191 (EXIT NIL)) + (EXIT (- (QREFELT $ 6) 1)))))))) + #1# (EXIT #1#))))) + +(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) + (PROG (|n| |m|) + (RETURN + (SEQ (LETT |n| (SPADCALL |t| (QREFELT $ 42)) + |ISTRING;suffix?;2$B;21|) + (LETT |m| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;suffix?;2$B;21|) + (EXIT (COND + ((< |n| |m|) 'NIL) + ('T + (SPADCALL |s| |t| (- (+ (QREFELT $ 6) |n|) |m|) + (QREFELT $ 46))))))))) + +(DEFUN |ISTRING;split;$CL;22| (|s| |c| $) + (PROG (|n| |j| |i| |l|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;split;$CL;22|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;split;$CL;22|) G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |c| + (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;split;$CL;22|) (GO G190) + G191 (EXIT NIL)) + (LETT |l| (SPADCALL (QREFELT $ 55)) |ISTRING;split;$CL;22|) + (SEQ G190 + (COND + ((NULL (COND + ((< |n| |i|) 'NIL) + ('T + (SPADCALL + (< (LETT |j| + (SPADCALL |c| |s| |i| + (QREFELT $ 48)) + |ISTRING;split;$CL;22|) + (QREFELT $ 6)) + (QREFELT $ 56))))) + (GO G191))) + (SEQ (LETT |l| + (SPADCALL + (SPADCALL |s| + (SPADCALL |i| (- |j| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CL;22|) + (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CL;22|) + G190 + (COND + ((OR (> |i| |n|) + (NULL + (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) + |c| (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) + |ISTRING;split;$CL;22|) + (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (< |n| |i|)) + (LETT |l| + (SPADCALL + (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CL;22|))) + (EXIT (SPADCALL |l| (QREFELT $ 58))))))) + +(DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $) + (PROG (|n| |j| |i| |l|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;split;$CcL;23|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;split;$CcL;23|) G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |cc| + (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;split;$CcL;23|) (GO G190) + G191 (EXIT NIL)) + (LETT |l| (SPADCALL (QREFELT $ 55)) |ISTRING;split;$CcL;23|) + (SEQ G190 + (COND + ((NULL (COND + ((< |n| |i|) 'NIL) + ('T + (SPADCALL + (< (LETT |j| + (SPADCALL |cc| |s| |i| + (QREFELT $ 50)) + |ISTRING;split;$CcL;23|) + (QREFELT $ 6)) + (QREFELT $ 56))))) + (GO G191))) + (SEQ (LETT |l| + (SPADCALL + (SPADCALL |s| + (SPADCALL |i| (- |j| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CcL;23|) + (EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CcL;23|) + G190 + (COND + ((OR (> |i| |n|) + (NULL + (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) + |cc| (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) + |ISTRING;split;$CcL;23|) + (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (< |n| |i|)) + (LETT |l| + (SPADCALL + (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21)) + |l| (QREFELT $ 57)) + |ISTRING;split;$CcL;23|))) + (EXIT (SPADCALL |l| (QREFELT $ 58))))))) + +(DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $) + (PROG (|n| |i|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;leftTrim;$C$;24|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;leftTrim;$C$;24|) G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |c| + (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$C$;24|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $) + (PROG (|n| |i|) + (RETURN + (SEQ (LETT |n| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;leftTrim;$Cc$;25|) + (SEQ (LETT |i| (QREFELT $ 6) |ISTRING;leftTrim;$Cc$;25|) + G190 + (COND + ((OR (> |i| |n|) + (NULL (SPADCALL + (SPADCALL |s| |i| (QREFELT $ 52)) |cc| + (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$Cc$;25|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| (SPADCALL |i| |n| (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $) + (PROG (|j| #0=#:G1830) + (RETURN + (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;rightTrim;$C$;26|) + (LETT #0# (QREFELT $ 6) |ISTRING;rightTrim;$C$;26|) + G190 + (COND + ((OR (< |j| #0#) + (NULL (SPADCALL + (SPADCALL |s| |j| (QREFELT $ 52)) |c| + (QREFELT $ 53)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |j| (+ |j| -1) |ISTRING;rightTrim;$C$;26|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| + (SPADCALL (SPADCALL |s| (QREFELT $ 28)) |j| + (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $) + (PROG (|j| #0=#:G1834) + (RETURN + (SEQ (SEQ (LETT |j| (SPADCALL |s| (QREFELT $ 42)) + |ISTRING;rightTrim;$Cc$;27|) + (LETT #0# (QREFELT $ 6) |ISTRING;rightTrim;$Cc$;27|) + G190 + (COND + ((OR (< |j| #0#) + (NULL (SPADCALL + (SPADCALL |s| |j| (QREFELT $ 52)) |cc| + (QREFELT $ 49)))) + (GO G191))) + (SEQ (EXIT 0)) + (LETT |j| (+ |j| -1) |ISTRING;rightTrim;$Cc$;27|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |s| + (SPADCALL (SPADCALL |s| (QREFELT $ 28)) |j| + (QREFELT $ 20)) + (QREFELT $ 21))))))) + +(DEFUN |ISTRING;concat;L$;28| (|l| $) + (PROG (#0=#:G1842 #1=#:G1837 #2=#:G1835 #3=#:G1836 |t| |s| #4=#:G1843 + |i|) + (RETURN + (SEQ (LETT |t| + (SPADCALL + (PROGN + (LETT #3# NIL |ISTRING;concat;L$;28|) + (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) + (LETT #0# |l| |ISTRING;concat;L$;28|) G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |s| (CAR #0#) + |ISTRING;concat;L$;28|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# + (SPADCALL |s| (QREFELT $ 13)) + |ISTRING;concat;L$;28|) + (COND + (#3# + (LETT #2# (+ #2# #1#) + |ISTRING;concat;L$;28|)) + ('T + (PROGN + (LETT #2# #1# + |ISTRING;concat;L$;28|) + (LETT #3# 'T + |ISTRING;concat;L$;28|))))))) + (LETT #0# (CDR #0#) |ISTRING;concat;L$;28|) + (GO G190) G191 (EXIT NIL)) + (COND (#3# #2#) ('T 0))) + (SPADCALL (QREFELT $ 43)) (QREFELT $ 9)) + |ISTRING;concat;L$;28|) + (LETT |i| (QREFELT $ 6) |ISTRING;concat;L$;28|) + (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) + (LETT #4# |l| |ISTRING;concat;L$;28|) G190 + (COND + ((OR (ATOM #4#) + (PROGN + (LETT |s| (CAR #4#) |ISTRING;concat;L$;28|) + NIL)) + (GO G191))) + (SEQ (SPADCALL |t| |s| |i| (QREFELT $ 66)) + (EXIT (LETT |i| + (+ |i| (SPADCALL |s| (QREFELT $ 13))) + |ISTRING;concat;L$;28|))) + (LETT #4# (CDR #4#) |ISTRING;concat;L$;28|) (GO G190) + G191 (EXIT NIL)) + (EXIT |t|))))) + +(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $) + (PROG (|m| |n|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 13)) + |ISTRING;copyInto!;2$I$;29|) + (LETT |n| (SPADCALL |y| (QREFELT $ 13)) + |ISTRING;copyInto!;2$I$;29|) + (LETT |s| (- |s| (QREFELT $ 6)) |ISTRING;copyInto!;2$I$;29|) + (COND + ((OR (< |s| 0) (< |n| (+ |s| |m|))) + (EXIT (|error| "index out of range")))) + (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))) + +(DEFUN |ISTRING;elt;$IC;30| (|s| |i| $) + (COND + ((OR (< |i| (QREFELT $ 6)) (< (SPADCALL |s| (QREFELT $ 42)) |i|)) + (|error| "index out of range")) + ('T (CHAR |s| (- |i| (QREFELT $ 6)))))) + +(DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $) + (PROG (|l| |h|) + (RETURN + (SEQ (LETT |l| (- (SPADCALL |sg| (QREFELT $ 39)) (QREFELT $ 6)) + |ISTRING;elt;$Us$;31|) + (LETT |h| + (COND + ((SPADCALL |sg| (QREFELT $ 40)) + (- (SPADCALL |sg| (QREFELT $ 41)) (QREFELT $ 6))) + ('T (- (SPADCALL |s| (QREFELT $ 42)) (QREFELT $ 6)))) + |ISTRING;elt;$Us$;31|) + (COND + ((OR (< |l| 0) + (NULL (< |h| (SPADCALL |s| (QREFELT $ 13))))) + (EXIT (|error| "index out of bound")))) + (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))) + +(DEFUN |ISTRING;hash;$I;32| (|s| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| (QCSIZE |s|) |ISTRING;hash;$I;32|) + (EXIT (COND + ((ZEROP |n|) 0) + ((EQL |n| 1) + (SPADCALL + (SPADCALL |s| (QREFELT $ 6) (QREFELT $ 52)) + (QREFELT $ 68))) + ('T + (* (* (SPADCALL + (SPADCALL |s| (QREFELT $ 6) + (QREFELT $ 52)) + (QREFELT $ 68)) + (SPADCALL + (SPADCALL |s| (- (+ (QREFELT $ 6) |n|) 1) + (QREFELT $ 52)) + (QREFELT $ 68))) + (SPADCALL + (SPADCALL |s| + (+ (QREFELT $ 6) (QUOTIENT2 |n| 2)) + (QREFELT $ 52)) + (QREFELT $ 68)))))))))) + +(DEFUN |ISTRING;match;2$CNni;33| (|pattern| |target| |wildcard| $) + (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) + +(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) + (PROG (|n| |m| #0=#:G1857 #1=#:G1859 |s| #2=#:G1860 #3=#:G1868 |i| + |p| #4=#:G1861 |q|) + (RETURN + (SEQ (EXIT (SEQ (LETT |n| (SPADCALL |pattern| (QREFELT $ 42)) + |ISTRING;match?;2$CB;34|) + (LETT |p| + (PROG1 (LETT #0# + (SPADCALL |dontcare| |pattern| + (LETT |m| + (SPADCALL |pattern| + (QREFELT $ 28)) + |ISTRING;match?;2$CB;34|) + (QREFELT $ 48)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |ISTRING;match?;2$CB;34|) + (EXIT (COND + ((EQL |p| (- |m| 1)) + (SPADCALL |pattern| |target| + (QREFELT $ 14))) + ('T + (SEQ (COND + ((NULL (EQL |p| |m|)) + (COND + ((NULL + (SPADCALL + (SPADCALL |pattern| + (SPADCALL |m| (- |p| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |target| (QREFELT $ 71))) + (EXIT 'NIL))))) + (LETT |i| |p| + |ISTRING;match?;2$CB;34|) + (LETT |q| + (PROG1 + (LETT #1# + (SPADCALL |dontcare| |pattern| + (+ |p| 1) (QREFELT $ 48)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) #1#)) + |ISTRING;match?;2$CB;34|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (EQL |q| (- |m| 1)) + (QREFELT $ 56))) + (GO G191))) + (SEQ + (LETT |s| + (SPADCALL |pattern| + (SPADCALL (+ |p| 1) (- |q| 1) + (QREFELT $ 20)) + (QREFELT $ 21)) + |ISTRING;match?;2$CB;34|) + (LETT |i| + (PROG1 + (LETT #2# + (SPADCALL |s| |target| |i| + (QREFELT $ 47)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)) + |ISTRING;match?;2$CB;34|) + (EXIT + (COND + ((EQL |i| (- |m| 1)) + (PROGN + (LETT #3# 'NIL + |ISTRING;match?;2$CB;34|) + (GO #3#))) + ('T + (SEQ + (LETT |i| + (+ |i| + (SPADCALL |s| + (QREFELT $ 13))) + |ISTRING;match?;2$CB;34|) + (LETT |p| |q| + |ISTRING;match?;2$CB;34|) + (EXIT + (LETT |q| + (PROG1 + (LETT #4# + (SPADCALL |dontcare| + |pattern| (+ |q| 1) + (QREFELT $ 48)) + |ISTRING;match?;2$CB;34|) + (|check-subtype| + (>= #4# 0) + '(|NonNegativeInteger|) + #4#)) + |ISTRING;match?;2$CB;34|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (COND + ((NULL (EQL |p| |n|)) + (COND + ((NULL + (SPADCALL + (SPADCALL |pattern| + (SPADCALL (+ |p| 1) |n| + (QREFELT $ 20)) + (QREFELT $ 21)) + |target| (QREFELT $ 51))) + (EXIT 'NIL))))) + (EXIT 'T))))))) + #3# (EXIT #3#))))) + +(DEFUN |IndexedString| (#0=#:G1875) + (PROG () + (RETURN + (PROG (#1=#:G1876) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|IndexedString|) + '|domainEqualList|) + |IndexedString|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|IndexedString;| #0#) + (LETT #1# T |IndexedString|)) + (COND + ((NOT #1#) + (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| 84) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 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|) + '(|OrderedSet|)) + (|HasCategory| (|Character|) + '(|SetCategory|))) + (|HasCategory| (|Character|) + '(|OrderedSet|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (|HasCategory| (|Character|) + '(|SetCategory|)) + (AND (|HasCategory| (|Character|) + '(|SetCategory|)) + (|HasCategory| (|Character|) + '(|Evalable| (|Character|)))) + (|HasCategory| (|Character|) + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|haddProp| |$ConstructorCache| '|IndexedString| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|IndexedString| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) (|Character|) |ISTRING;new;NniC$;1| + |ISTRING;empty;$;2| (|Boolean|) |ISTRING;empty?;$B;3| + |ISTRING;#;$Nni;4| |ISTRING;=;2$B;5| |ISTRING;<;2$B;6| + |ISTRING;concat;3$;7| |ISTRING;copy;2$;8| (|Integer|) + (|UniversalSegment| 18) (0 . SEGMENT) + |ISTRING;elt;$Us$;31| (6 . SEGMENT) + |ISTRING;insert;2$I$;9| (|String|) (|OutputForm|) + (11 . |outputForm|) |ISTRING;coerce;$Of;10| + |ISTRING;minIndex;$I;11| (|CharacterClass|) + (16 . |upperCase|) (20 . |upperCase|) (|Mapping| 8 8) + (25 . |map!|) |ISTRING;upperCase!;2$;12| + (31 . |lowerCase|) (35 . |lowerCase|) + |ISTRING;lowerCase!;2$;13| |ISTRING;latex;$S;14| + (40 . |lo|) (45 . |hasHi|) (50 . |hi|) (55 . |maxIndex|) + (60 . |space|) |ISTRING;replace;$Us2$;15| + |ISTRING;setelt;$I2C;16| |ISTRING;substring?;2$IB;17| + |ISTRING;position;2$2I;18| |ISTRING;position;C$2I;19| + (64 . |member?|) |ISTRING;position;Cc$2I;20| + |ISTRING;suffix?;2$B;21| |ISTRING;elt;$IC;30| (70 . =) + (|List| $$) (76 . |empty|) (80 . |not|) (85 . |concat|) + (91 . |reverse!|) (|List| $) |ISTRING;split;$CL;22| + |ISTRING;split;$CcL;23| |ISTRING;leftTrim;$C$;24| + |ISTRING;leftTrim;$Cc$;25| |ISTRING;rightTrim;$C$;26| + |ISTRING;rightTrim;$Cc$;27| |ISTRING;copyInto!;2$I$;29| + |ISTRING;concat;L$;28| (96 . |ord|) |ISTRING;hash;$I;32| + |ISTRING;match;2$CNni;33| (101 . |prefix?|) + |ISTRING;match?;2$CB;34| (|List| 8) (|List| 75) + (|Equation| 8) (|Mapping| 8 8 8) (|InputForm|) + (|SingleInteger|) (|Mapping| 11 8) (|Mapping| 11 8 8) + (|Void|) (|Union| 8 '"failed") (|List| 18)) + '#(~= 107 |upperCase!| 113 |upperCase| 118 |trim| 123 |swap!| + 135 |suffix?| 142 |substring?| 148 |split| 155 |sorted?| + 167 |sort!| 178 |sort| 189 |size?| 200 |setelt| 206 + |select| 220 |sample| 226 |rightTrim| 230 |reverse!| 242 + |reverse| 247 |replace| 252 |removeDuplicates| 259 + |remove| 264 |reduce| 276 |qsetelt!| 297 |qelt| 304 + |prefix?| 310 |position| 316 |parts| 349 |new| 354 |more?| + 360 |minIndex| 366 |min| 371 |merge| 377 |members| 390 + |member?| 395 |maxIndex| 401 |max| 406 |match?| 412 + |match| 419 |map!| 426 |map| 432 |lowerCase!| 445 + |lowerCase| 450 |less?| 455 |leftTrim| 461 |latex| 473 + |insert| 478 |indices| 492 |index?| 497 |hash| 503 |first| + 513 |find| 518 |fill!| 524 |every?| 530 |eval| 536 |eq?| + 562 |entry?| 568 |entries| 574 |empty?| 579 |empty| 584 + |elt| 588 |delete| 613 |count| 625 |copyInto!| 637 |copy| + 644 |convert| 649 |construct| 654 |concat| 659 |coerce| + 682 |any?| 692 >= 698 > 704 = 710 <= 716 < 722 |#| 728) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 5 + '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) + (CONS '#(|StringAggregate&| + |OneDimensionalArrayAggregate&| + |FiniteLinearAggregate&| |LinearAggregate&| + |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| + |Aggregate&| |EltableAggregate&| |Evalable&| + |SetCategory&| NIL NIL |InnerEvalable&| NIL + NIL |BasicType&|) + (CONS '#((|StringAggregate|) + (|OneDimensionalArrayAggregate| 8) + (|FiniteLinearAggregate| 8) + (|LinearAggregate| 8) + (|IndexedAggregate| 18 8) + (|Collection| 8) + (|HomogeneousAggregate| 8) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 18 8) (|Evalable| 8) + (|SetCategory|) (|Type|) + (|Eltable| 18 8) (|InnerEvalable| 8 8) + (|CoercibleTo| 25) (|ConvertibleTo| 77) + (|BasicType|)) + (|makeByteWordVec2| 83 + '(2 19 0 18 18 20 1 19 0 18 22 1 25 0 + 24 26 0 29 0 30 1 8 0 0 31 2 0 0 32 0 + 33 0 29 0 35 1 8 0 0 36 1 19 18 0 39 + 1 19 11 0 40 1 19 18 0 41 1 0 18 0 42 + 0 8 0 43 2 29 11 8 0 49 2 8 11 0 0 53 + 0 54 0 55 1 11 0 0 56 2 54 0 2 0 57 1 + 54 0 0 58 1 8 7 0 68 2 0 11 0 0 71 2 + 7 11 0 0 1 1 0 0 0 34 1 0 0 0 1 2 0 0 + 0 8 1 2 0 0 0 29 1 3 0 81 0 18 18 1 2 + 0 11 0 0 51 3 0 11 0 0 18 46 2 0 59 0 + 29 61 2 0 59 0 8 60 1 5 11 0 1 2 0 11 + 80 0 1 1 5 0 0 1 2 0 0 80 0 1 1 5 0 0 + 1 2 0 0 80 0 1 2 0 11 0 7 1 3 0 8 0 + 19 8 1 3 0 8 0 18 8 45 2 0 0 79 0 1 0 + 0 0 1 2 0 0 0 8 64 2 0 0 0 29 65 1 0 + 0 0 1 1 0 0 0 1 3 0 0 0 19 0 44 1 7 0 + 0 1 2 7 0 8 0 1 2 0 0 79 0 1 4 7 8 76 + 0 8 8 1 3 0 8 76 0 8 1 2 0 8 76 0 1 3 + 0 8 0 18 8 1 2 0 8 0 18 1 2 0 11 0 0 + 71 3 7 18 8 0 18 48 2 7 18 8 0 1 3 0 + 18 29 0 18 50 3 0 18 0 0 18 47 2 0 18 + 79 0 1 1 0 73 0 1 2 0 0 7 8 9 2 0 11 + 0 7 1 1 6 18 0 28 2 5 0 0 0 1 2 5 0 0 + 0 1 3 0 0 80 0 0 1 1 0 73 0 1 2 7 11 + 8 0 1 1 6 18 0 42 2 5 0 0 0 1 3 0 11 + 0 0 8 72 3 0 7 0 0 8 70 2 0 0 32 0 33 + 3 0 0 76 0 0 1 2 0 0 32 0 1 1 0 0 0 + 37 1 0 0 0 1 2 0 11 0 7 1 2 0 0 0 8 + 62 2 0 0 0 29 63 1 7 24 0 38 3 0 0 8 + 0 18 1 3 0 0 0 0 18 23 1 0 83 0 1 2 0 + 11 18 0 1 1 7 78 0 1 1 0 18 0 69 1 6 + 8 0 1 2 0 82 79 0 1 2 0 0 0 8 1 2 0 + 11 79 0 1 3 8 0 0 73 73 1 3 8 0 0 8 8 + 1 2 8 0 0 74 1 2 8 0 0 75 1 2 0 11 0 + 0 1 2 7 11 8 0 1 1 0 73 0 1 1 0 11 0 + 12 0 0 0 10 2 0 0 0 0 1 2 0 0 0 19 21 + 2 0 8 0 18 52 3 0 8 0 18 8 1 2 0 0 0 + 18 1 2 0 0 0 19 1 2 7 7 8 0 1 2 0 7 + 79 0 1 3 0 0 0 0 18 66 1 0 0 0 17 1 3 + 77 0 1 1 0 0 73 1 1 0 0 59 67 2 0 0 0 + 0 16 2 0 0 0 8 1 2 0 0 8 0 1 1 9 25 0 + 27 1 0 0 8 1 2 0 11 79 0 1 2 5 11 0 0 + 1 2 5 11 0 0 1 2 7 11 0 0 14 2 5 11 0 + 0 1 2 5 11 0 0 15 1 0 7 0 13))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp new file mode 100644 index 00000000..69ffd104 --- /dev/null +++ b/src/algebra/strap/LIST.lsp @@ -0,0 +1,302 @@ + +(/VERSIONCHECK 2) + +(PUT '|LIST;nil;$;1| '|SPADreplace| '(XLAM NIL NIL)) + +(DEFUN |LIST;nil;$;1| ($) NIL) + +(PUT '|LIST;null;$B;2| '|SPADreplace| 'NULL) + +(DEFUN |LIST;null;$B;2| (|l| $) (NULL |l|)) + +(PUT '|LIST;cons;S2$;3| '|SPADreplace| 'CONS) + +(DEFUN |LIST;cons;S2$;3| (|s| |l| $) (CONS |s| |l|)) + +(PUT '|LIST;append;3$;4| '|SPADreplace| 'APPEND) + +(DEFUN |LIST;append;3$;4| (|l| |t| $) (APPEND |l| |t|)) + +(DEFUN |LIST;writeOMList| (|dev| |x| $) + (SEQ (SPADCALL |dev| (QREFELT $ 14)) + (SPADCALL |dev| "list1" "list" (QREFELT $ 16)) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |x|) (QREFELT $ 17))) (GO G191))) + (SEQ (SPADCALL |dev| (|SPADfirst| |x|) 'NIL (QREFELT $ 18)) + (EXIT (LETT |x| (CDR |x|) |LIST;writeOMList|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |dev| (QREFELT $ 19))))) + +(DEFUN |LIST;OMwrite;$S;6| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |LIST;OMwrite;$S;6|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$S;6|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT $ 21)) + (QREFELT $ 22)) + |LIST;OMwrite;$S;6|) + (SPADCALL |dev| (QREFELT $ 23)) + (|LIST;writeOMList| |dev| |x| $) + (SPADCALL |dev| (QREFELT $ 24)) + (SPADCALL |dev| (QREFELT $ 25)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$S;6|) + (EXIT |s|))))) + +(DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |LIST;OMwrite;$BS;7|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$BS;7|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (QREFELT $ 21)) + (QREFELT $ 22)) + |LIST;OMwrite;$BS;7|) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23)))) + (|LIST;writeOMList| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24)))) + (SPADCALL |dev| (QREFELT $ 25)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$BS;7|) + (EXIT |s|))))) + +(DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $) + (SEQ (SPADCALL |dev| (QREFELT $ 23)) (|LIST;writeOMList| |dev| |x| $) + (EXIT (SPADCALL |dev| (QREFELT $ 24))))) + +(DEFUN |LIST;OMwrite;Omd$BV;9| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23)))) + (|LIST;writeOMList| |dev| |x| $) + (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24))))))) + +(DEFUN |LIST;setUnion;3$;10| (|l1| |l2| $) + (SPADCALL (SPADCALL |l1| |l2| (QREFELT $ 30)) (QREFELT $ 31))) + +(DEFUN |LIST;setIntersection;3$;11| (|l1| |l2| $) + (PROG (|u|) + (RETURN + (SEQ (LETT |u| NIL |LIST;setIntersection;3$;11|) + (LETT |l1| (SPADCALL |l1| (QREFELT $ 31)) + |LIST;setIntersection;3$;11|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17))) + (GO G191))) + (SEQ (COND + ((SPADCALL (|SPADfirst| |l1|) |l2| + (QREFELT $ 33)) + (LETT |u| (CONS (|SPADfirst| |l1|) |u|) + |LIST;setIntersection;3$;11|))) + (EXIT (LETT |l1| (CDR |l1|) + |LIST;setIntersection;3$;11|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |u|))))) + +(DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) + (PROG (|l11| |lu|) + (RETURN + (SEQ (LETT |l1| (SPADCALL |l1| (QREFELT $ 31)) + |LIST;setDifference;3$;12|) + (LETT |lu| NIL |LIST;setDifference;3$;12|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17))) + (GO G191))) + (SEQ (LETT |l11| (SPADCALL |l1| 1 (QREFELT $ 36)) + |LIST;setDifference;3$;12|) + (COND + ((NULL (SPADCALL |l11| |l2| (QREFELT $ 33))) + (LETT |lu| (CONS |l11| |lu|) + |LIST;setDifference;3$;12|))) + (EXIT (LETT |l1| (CDR |l1|) + |LIST;setDifference;3$;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |lu|))))) + +(DEFUN |LIST;convert;$If;13| (|x| $) + (PROG (#0=#:G1440 |a| #1=#:G1441) + (RETURN + (SEQ (SPADCALL + (CONS (SPADCALL (SPADCALL "construct" (QREFELT $ 39)) + (QREFELT $ 41)) + (PROGN + (LETT #0# NIL |LIST;convert;$If;13|) + (SEQ (LETT |a| NIL |LIST;convert;$If;13|) + (LETT #1# |x| |LIST;convert;$If;13|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |a| (CAR #1#) + |LIST;convert;$If;13|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |a| (QREFELT $ 42)) + #0#) + |LIST;convert;$If;13|))) + (LETT #1# (CDR #1#) |LIST;convert;$If;13|) + (GO G190) G191 (EXIT (NREVERSE0 #0#))))) + (QREFELT $ 44)))))) + +(DEFUN |List| (#0=#:G1452) + (PROG () + (RETURN + (PROG (#1=#:G1453) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|List|) + '|domainEqualList|) + |List|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|List;| #0#) (LETT #1# T |List|)) + (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))))) + +(DEFUN |List;| (|#1|) + (PROG (|dv$1| |dv$| $ #0=#:G1451 #1=#:G1449 |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #2=(|List|)) + (LETT |dv$| (LIST '|List| |dv$1|) . #2#) + (LETT $ (GETREFV 63) . #2#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| + '(|ConvertibleTo| (|InputForm|))) + (|HasCategory| |#1| '(|OrderedSet|)) + (|HasCategory| |#1| '(|OpenMath|)) + (|HasCategory| (|Integer|) '(|OrderedSet|)) + (LETT #0# + (|HasCategory| |#1| '(|SetCategory|)) . #2#) + (OR (|HasCategory| |#1| '(|OrderedSet|)) + #0#) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (OR (AND (|HasCategory| |#1| + '(|OrderedSet|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|))))) + (LETT #1# + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))) . #2#) + (OR (AND #0# + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + #1#))) . #2#)) + (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (QSETREFV $ 26 + (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $)) + (QSETREFV $ 27 + (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $)) + (QSETREFV $ 28 + (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $)) + (QSETREFV $ 29 + (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $))))) + (COND + ((|testBitVector| |pv$| 5) + (PROGN + (QSETREFV $ 32 + (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $)) + (QSETREFV $ 34 + (CONS (|dispatchFunction| + |LIST;setIntersection;3$;11|) + $)) + (QSETREFV $ 37 + (CONS (|dispatchFunction| |LIST;setDifference;3$;12|) + $))))) + (COND + ((|testBitVector| |pv$| 1) + (QSETREFV $ 45 + (CONS (|dispatchFunction| |LIST;convert;$If;13|) $)))) + $)))) + +(MAKEPROP '|List| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL (|IndexedList| 6 (NRTEVAL 1)) + (|local| |#1|) |LIST;nil;$;1| (|Boolean|) |LIST;null;$B;2| + |LIST;cons;S2$;3| |LIST;append;3$;4| (|Void|) + (|OpenMathDevice|) (0 . |OMputApp|) (|String|) + (5 . |OMputSymbol|) (12 . |not|) (17 . |OMwrite|) + (24 . |OMputEndApp|) (|OpenMathEncoding|) + (29 . |OMencodingXML|) (33 . |OMopenString|) + (39 . |OMputObject|) (44 . |OMputEndObject|) + (49 . |OMclose|) (54 . |OMwrite|) (59 . |OMwrite|) + (65 . |OMwrite|) (71 . |OMwrite|) (78 . |concat|) + (84 . |removeDuplicates|) (89 . |setUnion|) + (95 . |member?|) (101 . |setIntersection|) (|Integer|) + (107 . |elt|) (113 . |setDifference|) (|Symbol|) + (119 . |coerce|) (|InputForm|) (124 . |convert|) + (129 . |convert|) (|List| $) (134 . |convert|) + (139 . |convert|) (|Mapping| 6 6 6) (|NonNegativeInteger|) + (|List| 6) (|List| 50) (|Equation| 6) (|Mapping| 8 6) + (|Mapping| 8 6 6) (|UniversalSegment| 35) '"last" '"rest" + '"first" '"value" (|Mapping| 6 6) (|OutputForm|) + (|SingleInteger|) (|List| 35) (|Union| 6 '"failed")) + '#(|setUnion| 144 |setIntersection| 150 |setDifference| 156 + |removeDuplicates| 162 |null| 167 |nil| 172 |member?| 176 + |elt| 182 |convert| 188 |cons| 193 |concat| 199 |append| + 205 |OMwrite| 211) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 10 + '(0 0 0 0 0 0 0 0 0 0 2 0 0 8 6 0 0 8 10 1 6 3)) + (CONS '#(|ListAggregate&| |StreamAggregate&| + |ExtensibleLinearAggregate&| + |FiniteLinearAggregate&| + |UnaryRecursiveAggregate&| |LinearAggregate&| + |RecursiveAggregate&| |IndexedAggregate&| + |Collection&| |HomogeneousAggregate&| + |OrderedSet&| |Aggregate&| |EltableAggregate&| + |Evalable&| |SetCategory&| NIL NIL + |InnerEvalable&| NIL NIL |BasicType&| NIL) + (CONS '#((|ListAggregate| 6) + (|StreamAggregate| 6) + (|ExtensibleLinearAggregate| 6) + (|FiniteLinearAggregate| 6) + (|UnaryRecursiveAggregate| 6) + (|LinearAggregate| 6) + (|RecursiveAggregate| 6) + (|IndexedAggregate| 35 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 35 6) (|Evalable| 6) + (|SetCategory|) (|Type|) + (|Eltable| 35 6) (|InnerEvalable| 6 6) + (|CoercibleTo| 59) (|ConvertibleTo| 40) + (|BasicType|) (|OpenMath|)) + (|makeByteWordVec2| 45 + '(1 13 12 0 14 3 13 12 0 15 15 16 1 8 0 + 0 17 3 6 12 13 0 8 18 1 13 12 0 19 0 + 20 0 21 2 13 0 15 20 22 1 13 12 0 23 + 1 13 12 0 24 1 13 12 0 25 1 0 15 0 26 + 2 0 15 0 8 27 2 0 12 13 0 28 3 0 12 + 13 0 8 29 2 0 0 0 0 30 1 0 0 0 31 2 0 + 0 0 0 32 2 0 8 6 0 33 2 0 0 0 0 34 2 + 0 6 0 35 36 2 0 0 0 0 37 1 38 0 15 39 + 1 40 0 38 41 1 6 40 0 42 1 40 0 43 44 + 1 0 40 0 45 2 5 0 0 0 32 2 5 0 0 0 34 + 2 5 0 0 0 37 1 5 0 0 31 1 0 8 0 9 0 0 + 0 7 2 5 8 6 0 33 2 0 6 0 35 36 1 1 40 + 0 45 2 0 0 6 0 10 2 0 0 0 0 30 2 0 0 + 0 0 11 3 3 12 13 0 8 29 2 3 12 13 0 + 28 1 3 15 0 26 2 3 15 0 8 27))))) + '|lookupIncomplete|)) diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp new file mode 100644 index 00000000..5ba1d59c --- /dev/null +++ b/src/algebra/strap/LNAGG-.lsp @@ -0,0 +1,80 @@ + +(/VERSIONCHECK 2) + +(DEFUN |LNAGG-;indices;AL;1| (|a| $) + (PROG (#0=#:G1404 |i| #1=#:G1405) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |LNAGG-;indices;AL;1|) + (SEQ (LETT |i| (SPADCALL |a| (QREFELT $ 9)) + |LNAGG-;indices;AL;1|) + (LETT #1# (SPADCALL |a| (QREFELT $ 10)) + |LNAGG-;indices;AL;1|) + G190 (COND ((> |i| #1#) (GO G191))) + (SEQ (EXIT (LETT #0# (CONS |i| #0#) + |LNAGG-;indices;AL;1|))) + (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) + (COND + ((< |i| (SPADCALL |a| (QREFELT $ 9))) 'NIL) + ('T + (SPADCALL (< (SPADCALL |a| (QREFELT $ 10)) |i|) (QREFELT $ 14))))) + +(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) + (SPADCALL |a| (SPADCALL 1 |x| (QREFELT $ 17)) (QREFELT $ 18))) + +(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| $) + (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |y| (QREFELT $ 18))) + +(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| $) + (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |a| |i| (QREFELT $ 21))) + +(DEFUN |LNAGG-;maxIndex;AI;6| (|l| $) + (+ (- (SPADCALL |l| (QREFELT $ 23)) 1) (SPADCALL |l| (QREFELT $ 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 $ (GETREFV 26) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasAttribute| |#1| '|finiteAggregate|) + (QSETREFV $ 24 + (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) $)))) + $)))) + +(MAKEPROP '|LinearAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|Integer|) (0 . |minIndex|) (5 . |maxIndex|) (|List| 8) + |LNAGG-;indices;AL;1| (|Boolean|) (10 . |not|) + |LNAGG-;index?;IAB;2| (|NonNegativeInteger|) (15 . |new|) + (21 . |concat|) |LNAGG-;concat;ASA;3| + |LNAGG-;concat;S2A;4| (27 . |insert|) + |LNAGG-;insert;SAIA;5| (34 . |#|) (39 . |maxIndex|) + (|List| $)) + '#(|maxIndex| 44 |insert| 49 |indices| 56 |index?| 61 + |concat| 67) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 24 + '(1 6 8 0 9 1 6 8 0 10 1 13 0 0 14 2 6 + 0 16 7 17 2 6 0 0 0 18 3 6 0 0 0 8 21 + 1 6 16 0 23 1 0 8 0 24 1 0 8 0 24 3 0 + 0 7 0 8 22 1 0 11 0 12 2 0 13 8 0 15 + 2 0 0 0 7 19 2 0 0 7 0 20))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp new file mode 100644 index 00000000..a97133de --- /dev/null +++ b/src/algebra/strap/LNAGG.lsp @@ -0,0 +1,81 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |LinearAggregate;CAT| 'NIL) + +(DEFPARAMETER |LinearAggregate;AL| 'NIL) + +(DEFUN |LinearAggregate| (#0=#:G1400) + (LET (#1=#:G1401) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |LinearAggregate;AL|)) + (CDR #1#)) + (T (SETQ |LinearAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|LinearAggregate;| #0#))) + |LinearAggregate;AL|)) + #1#)))) + +(DEFUN |LinearAggregate;| (|t#1|) + (PROG (#0=#:G1399) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (|sublisV| + (PAIR '(#1=#:G1398) (LIST '(|Integer|))) + (COND + (|LinearAggregate;CAT|) + ('T + (LETT |LinearAggregate;CAT| + (|Join| + (|IndexedAggregate| '#1# '|t#1|) + (|Collection| '|t#1|) + (|mkCategory| '|domain| + '(((|new| + ($ (|NonNegativeInteger|) + |t#1|)) + T) + ((|concat| ($ $ |t#1|)) T) + ((|concat| ($ |t#1| $)) T) + ((|concat| ($ $ $)) T) + ((|concat| ($ (|List| $))) T) + ((|map| + ($ + (|Mapping| |t#1| |t#1| + |t#1|) + $ $)) + T) + ((|elt| + ($ $ + (|UniversalSegment| + (|Integer|)))) + T) + ((|delete| ($ $ (|Integer|))) + T) + ((|delete| + ($ $ + (|UniversalSegment| + (|Integer|)))) + T) + ((|insert| + ($ |t#1| $ (|Integer|))) + T) + ((|insert| ($ $ $ (|Integer|))) + T) + ((|setelt| + (|t#1| $ + (|UniversalSegment| + (|Integer|)) + |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|)))) + NIL + '((|UniversalSegment| + (|Integer|)) + (|Integer|) (|List| $) + (|NonNegativeInteger|)) + NIL)) + . #2=(|LinearAggregate|)))))) . #2#) + (SETELT #0# 0 (LIST '|LinearAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp new file mode 100644 index 00000000..5a27a55c --- /dev/null +++ b/src/algebra/strap/LSAGG-.lsp @@ -0,0 +1,794 @@ + +(/VERSIONCHECK 2) + +(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| $) + (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) + +(DEFUN |LSAGG-;list;SA;2| (|x| $) + (SPADCALL |x| (SPADCALL (QREFELT $ 12)) (QREFELT $ 13))) + +(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| $) + (COND + ((SPADCALL |x| (QREFELT $ 16)) + (|error| "reducing over an empty list needs the 3 argument form")) + ('T + (SPADCALL |f| (SPADCALL |x| (QREFELT $ 17)) + (SPADCALL |x| (QREFELT $ 18)) (QREFELT $ 20))))) + +(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| $) + (SPADCALL |f| (SPADCALL |p| (QREFELT $ 22)) + (SPADCALL |q| (QREFELT $ 22)) (QREFELT $ 23))) + +(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| $) + (PROG (|y| |z|) + (RETURN + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) |x|) + ('T + (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) + (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |z| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT + (COND + ((SPADCALL + (SPADCALL |z| (QREFELT $ 18)) + |f|) + (SEQ + (LETT |y| |z| + |LSAGG-;select!;M2A;5|) + (EXIT + (LETT |z| + (SPADCALL |z| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|)))) + ('T + (SEQ + (LETT |z| + (SPADCALL |z| (QREFELT $ 17)) + |LSAGG-;select!;M2A;5|) + (EXIT + (SPADCALL |y| |z| + (QREFELT $ 26)))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) + (PROG (|r| |t|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (QREFELT $ 16)) |q|) + ((SPADCALL |q| (QREFELT $ 16)) |p|) + ((SPADCALL |p| |q| (QREFELT $ 29)) + (|error| "cannot merge a list into itself")) + ('T + (SEQ (COND + ((SPADCALL (SPADCALL |p| (QREFELT $ 18)) + (SPADCALL |q| (QREFELT $ 18)) |f|) + (SEQ (LETT |r| + (LETT |t| |p| |LSAGG-;merge!;M3A;6|) + |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |p| + (SPADCALL |p| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|)))) + ('T + (SEQ (LETT |r| + (LETT |t| |q| |LSAGG-;merge!;M3A;6|) + |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |q| + (SPADCALL |q| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|))))) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |p| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL |q| (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL + (SPADCALL |p| (QREFELT $ 18)) + (SPADCALL |q| (QREFELT $ 18)) + |f|) + (SEQ + (SPADCALL |t| |p| + (QREFELT $ 26)) + (LETT |t| |p| + |LSAGG-;merge!;M3A;6|) + (EXIT + (LETT |p| + (SPADCALL |p| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|)))) + ('T + (SEQ + (SPADCALL |t| |q| + (QREFELT $ 26)) + (LETT |t| |q| + |LSAGG-;merge!;M3A;6|) + (EXIT + (LETT |q| + (SPADCALL |q| (QREFELT $ 17)) + |LSAGG-;merge!;M3A;6|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (SPADCALL |t| + (COND + ((SPADCALL |p| (QREFELT $ 16)) |q|) + ('T |p|)) + (QREFELT $ 26)) + (EXIT |r|)))))))) + +(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) + (PROG (|m| #0=#:G1464 |y| |z|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;insert!;SAIA;7|) + (EXIT (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |s| |x| (QREFELT $ 13))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# (- (- |i| 1) |m|) + |LSAGG-;insert!;SAIA;7|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;insert!;SAIA;7|) + (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;insert!;SAIA;7|) + (SPADCALL |y| + (SPADCALL |s| |z| (QREFELT $ 13)) + (QREFELT $ 26)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) + (PROG (|m| #0=#:G1468 |y| |z|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;insert!;2AIA;8|) + (EXIT (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |w| |x| (QREFELT $ 35))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# (- (- |i| 1) |m|) + |LSAGG-;insert!;2AIA;8|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;insert!;2AIA;8|) + (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;insert!;2AIA;8|) + (SPADCALL |y| |w| (QREFELT $ 26)) + (SPADCALL |y| |z| (QREFELT $ 35)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) + (PROG (|p| |q|) + (RETURN + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|)))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;remove!;M2A;9|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) |x|) + ('T + (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) + (LETT |q| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;remove!;M2A;9|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |q| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT + (COND + ((SPADCALL + (SPADCALL |q| (QREFELT $ 18)) + |f|) + (LETT |q| + (SPADCALL |p| + (SPADCALL |q| (QREFELT $ 17)) + (QREFELT $ 26)) + |LSAGG-;remove!;M2A;9|)) + ('T + (SEQ + (LETT |p| |q| + |LSAGG-;remove!;M2A;9|) + (EXIT + (LETT |q| + (SPADCALL |q| (QREFELT $ 17)) + |LSAGG-;remove!;M2A;9|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) + (PROG (|m| #0=#:G1480 |y|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;delete!;AIA;10|) + (EXIT (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |x| (QREFELT $ 17))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# (- (- |i| 1) |m|) + |LSAGG-;delete!;AIA;10|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;delete!;AIA;10|) + (SPADCALL |y| (SPADCALL |y| 2 (QREFELT $ 33)) + (QREFELT $ 26)) + (EXIT |x|))))))))) + +(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) + (PROG (|l| |m| |h| #0=#:G1485 #1=#:G1486 |t| #2=#:G1487) + (RETURN + (SEQ (LETT |l| (SPADCALL |i| (QREFELT $ 40)) + |LSAGG-;delete!;AUsA;11|) + (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;delete!;AUsA;11|) + (EXIT (COND + ((< |l| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (QREFELT $ 41)) + (SPADCALL |i| (QREFELT $ 42))) + ('T (SPADCALL |x| (QREFELT $ 43)))) + |LSAGG-;delete!;AUsA;11|) + (EXIT (COND + ((< |h| |l|) |x|) + ((EQL |l| |m|) + (SPADCALL |x| + (PROG1 + (LETT #0# (- (+ |h| 1) |m|) + |LSAGG-;delete!;AUsA;11|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33))) + ('T + (SEQ (LETT |t| + (SPADCALL |x| + (PROG1 + (LETT #1# (- (- |l| 1) |m|) + |LSAGG-;delete!;AUsA;11|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) + #1#)) + (QREFELT $ 33)) + |LSAGG-;delete!;AUsA;11|) + (SPADCALL |t| + (SPADCALL |t| + (PROG1 + (LETT #2# (+ (- |h| |l|) 2) + |LSAGG-;delete!;AUsA;11|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) + #2#)) + (QREFELT $ 33)) + (QREFELT $ 26)) + (EXIT |x|))))))))))))) + +(DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;find;MAU;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) (CONS 1 "failed")) + ('T (CONS 0 (SPADCALL |x| (QREFELT $ 18)))))))) + +(DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) + (PROG (|k|) + (RETURN + (SEQ (SEQ (LETT |k| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;position;MAI;13|) + G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + |f|) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;position;MAI;13|))) + (LETT |k| (+ |k| 1) |LSAGG-;position;MAI;13|) (GO G190) + G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) + (- (SPADCALL |x| (QREFELT $ 32)) 1)) + ('T |k|))))))) + +(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) + (PROG (#0=#:G1507 |l| |q|) + (RETURN + (SEQ (COND + ((EQL |n| 2) + (COND + ((SPADCALL + (SPADCALL (SPADCALL |p| (QREFELT $ 17)) + (QREFELT $ 18)) + (SPADCALL |p| (QREFELT $ 18)) |f|) + (LETT |p| (SPADCALL |p| (QREFELT $ 48)) + |LSAGG-;mergeSort|))))) + (EXIT (COND + ((< |n| 3) |p|) + ('T + (SEQ (LETT |l| + (PROG1 (LETT #0# (QUOTIENT2 |n| 2) + |LSAGG-;mergeSort|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |LSAGG-;mergeSort|) + (LETT |q| (SPADCALL |p| |l| (QREFELT $ 49)) + |LSAGG-;mergeSort|) + (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| $) + |LSAGG-;mergeSort|) + (LETT |q| + (|LSAGG-;mergeSort| |f| |q| (- |n| |l|) + $) + |LSAGG-;mergeSort|) + (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 23))))))))))) + +(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) + (PROG (#0=#:G1516 |p|) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |l| (QREFELT $ 16)) 'T) + ('T + (SEQ (LETT |p| (SPADCALL |l| (QREFELT $ 17)) + |LSAGG-;sorted?;MAB;15|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |p| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT + (COND + ((NULL + (SPADCALL + (SPADCALL |l| (QREFELT $ 18)) + (SPADCALL |p| (QREFELT $ 18)) + |f|)) + (PROGN + (LETT #0# 'NIL + |LSAGG-;sorted?;MAB;15|) + (GO #0#))) + ('T + (LETT |p| + (SPADCALL + (LETT |l| |p| + |LSAGG-;sorted?;MAB;15|) + (QREFELT $ 17)) + |LSAGG-;sorted?;MAB;15|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT 'T))))) + #0# (EXIT #0#))))) + +(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (LETT |r| + (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) + |f|) + |LSAGG-;reduce;MA2S;16|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;reduce;MA2S;16|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL (SPADCALL |r| |a| (QREFELT $ 52)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (LETT |r| + (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) + |f|) + |LSAGG-;reduce;MA3S;17|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;reduce;MA3S;17|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |r|))))) + +(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) + (PROG (|k| |l|) + (RETURN + (SEQ (LETT |l| (SPADCALL (QREFELT $ 12)) |LSAGG-;new;NniSA;18|) + (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 + (COND ((QSGREATERP |k| |n|) (GO G191))) + (SEQ (EXIT (LETT |l| (SPADCALL |s| |l| (QREFELT $ 13)) + |LSAGG-;new;NniSA;18|))) + (LETT |k| (QSADD1 |k|) |LSAGG-;new;NniSA;18|) (GO G190) + G191 (EXIT NIL)) + (EXIT |l|))))) + +(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) + (PROG (|z|) + (RETURN + (SEQ (LETT |z| (SPADCALL (QREFELT $ 12)) |LSAGG-;map;M3A;19|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) 'NIL) + ('T + (SPADCALL (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (LETT |z| + (SPADCALL + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) + (SPADCALL |y| (QREFELT $ 18)) |f|) + |z| (QREFELT $ 13)) + |LSAGG-;map;M3A;19|) + (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;map;M3A;19|) + (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;map;M3A;19|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |z| (QREFELT $ 48))))))) + +(DEFUN |LSAGG-;reverse!;2A;20| (|x| $) + (PROG (|z| |y|) + (RETURN + (SEQ (COND + ((OR (SPADCALL |x| (QREFELT $ 16)) + (SPADCALL + (LETT |y| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;reverse!;2A;20|) + (QREFELT $ 16))) + |x|) + ('T + (SEQ (SPADCALL |x| (SPADCALL (QREFELT $ 12)) + (QREFELT $ 26)) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 17)) + |LSAGG-;reverse!;2A;20|) + (SPADCALL |y| |x| (QREFELT $ 26)) + (LETT |x| |y| |LSAGG-;reverse!;2A;20|) + (EXIT (LETT |y| |z| + |LSAGG-;reverse!;2A;20|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|)))))))) + +(DEFUN |LSAGG-;copy;2A;21| (|x| $) + (PROG (|k| |y|) + (RETURN + (SEQ (LETT |y| (SPADCALL (QREFELT $ 12)) |LSAGG-;copy;2A;21|) + (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 57)) + (EXIT (|error| "cyclic list")))))) + (LETT |y| + (SPADCALL (SPADCALL |x| (QREFELT $ 18)) |y| + (QREFELT $ 13)) + |LSAGG-;copy;2A;21|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;copy;2A;21|))) + (LETT |k| (QSADD1 |k|) |LSAGG-;copy;2A;21|) (GO G190) + G191 (EXIT NIL)) + (EXIT (SPADCALL |y| (QREFELT $ 48))))))) + +(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) + (PROG (|m| #0=#:G1545 |z|) + (RETURN + (SEQ (LETT |m| (SPADCALL |y| (QREFELT $ 32)) + |LSAGG-;copyInto!;2AIA;22|) + (EXIT (COND + ((< |s| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |z| + (SPADCALL |y| + (PROG1 + (LETT #0# (- |s| |m|) + |LSAGG-;copyInto!;2AIA;22|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;copyInto!;2AIA;22|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |z| (QREFELT $ 16)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |x| + (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (SPADCALL |z| + (SPADCALL |x| (QREFELT $ 18)) + (QREFELT $ 59)) + (LETT |x| + (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;copyInto!;2AIA;22|) + (EXIT + (LETT |z| + (SPADCALL |z| (QREFELT $ 17)) + |LSAGG-;copyInto!;2AIA;22|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|))))))))) + +(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) + (PROG (|m| #0=#:G1552 |k|) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) + |LSAGG-;position;SA2I;23|) + (EXIT (COND + ((< |s| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |x| + (SPADCALL |x| + (PROG1 + (LETT #0# (- |s| |m|) + |LSAGG-;position;SA2I;23|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 33)) + |LSAGG-;position;SA2I;23|) + (SEQ (LETT |k| |s| |LSAGG-;position;SA2I;23|) + G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |w| + (SPADCALL |x| + (QREFELT $ 18)) + (QREFELT $ 52)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT + (LETT |x| + (SPADCALL |x| (QREFELT $ 17)) + |LSAGG-;position;SA2I;23|))) + (LETT |k| (+ |k| 1) + |LSAGG-;position;SA2I;23|) + (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) + (- (SPADCALL |x| (QREFELT $ 32)) 1)) + ('T |k|))))))))))) + +(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) + (PROG (|p|) + (RETURN + (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |p| (QREFELT $ 16)) + (QREFELT $ 25))) + (GO G191))) + (SEQ (EXIT (LETT |p| + (SPADCALL |p| + (SPADCALL + (CONS + #'|LSAGG-;removeDuplicates!;2A;24!0| + (VECTOR $ |p|)) + (SPADCALL |p| (QREFELT $ 17)) + (QREFELT $ 62)) + (QREFELT $ 26)) + |LSAGG-;removeDuplicates!;2A;24|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |l|))))) + +(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) + (PROG ($) + (LETT $ (QREFELT $$ 0) |LSAGG-;removeDuplicates!;2A;24|) + (RETURN + (PROGN + (SPADCALL |#1| (SPADCALL (QREFELT $$ 1) (QREFELT $ 18)) + (QREFELT $ 52)))))) + +(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) + (PROG (#0=#:G1566) + (RETURN + (SEQ (EXIT (SEQ (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 16)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))))) + (GO G191))) + (SEQ (EXIT (COND + ((NULL + (SPADCALL + (SPADCALL |x| + (QREFELT $ 18)) + (SPADCALL |y| + (QREFELT $ 18)) + (QREFELT $ 52))) + (PROGN + (LETT #0# + (SPADCALL + (SPADCALL |x| + (QREFELT $ 18)) + (SPADCALL |y| + (QREFELT $ 18)) + (QREFELT $ 64)) + |LSAGG-;<;2AB;25|) + (GO #0#))) + ('T + (SEQ + (LETT |x| + (SPADCALL |x| + (QREFELT $ 17)) + |LSAGG-;<;2AB;25|) + (EXIT + (LETT |y| + (SPADCALL |y| + (QREFELT $ 17)) + |LSAGG-;<;2AB;25|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 16)) + (SPADCALL (SPADCALL |y| (QREFELT $ 16)) + (QREFELT $ 25))) + ('T 'NIL))))) + #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 $ (GETREFV 67) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasCategory| |#2| '(|SetCategory|)) + (QSETREFV $ 53 + (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $)))) + (COND + ((|HasCategory| |#2| '(|SetCategory|)) + (PROGN + (QSETREFV $ 61 + (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) + $)) + (QSETREFV $ 63 + (CONS (|dispatchFunction| + |LSAGG-;removeDuplicates!;2A;24|) + $))))) + (COND + ((|HasCategory| |#2| '(|OrderedSet|)) + (QSETREFV $ 65 + (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $)))) + $)))) + +(MAKEPROP '|ListAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|NonNegativeInteger|) (0 . |#|) (|Mapping| 15 7 7) + |LSAGG-;sort!;M2A;1| (5 . |empty|) (9 . |concat|) + |LSAGG-;list;SA;2| (|Boolean|) (15 . |empty?|) + (20 . |rest|) (25 . |first|) (|Mapping| 7 7 7) + (30 . |reduce|) |LSAGG-;reduce;MAS;3| (37 . |copy|) + (42 . |merge!|) |LSAGG-;merge;M3A;4| (49 . |not|) + (54 . |setrest!|) (|Mapping| 15 7) |LSAGG-;select!;M2A;5| + (60 . |eq?|) |LSAGG-;merge!;M3A;6| (|Integer|) + (66 . |minIndex|) (71 . |rest|) |LSAGG-;insert!;SAIA;7| + (77 . |concat!|) |LSAGG-;insert!;2AIA;8| + |LSAGG-;remove!;M2A;9| |LSAGG-;delete!;AIA;10| + (|UniversalSegment| 31) (83 . |lo|) (88 . |hasHi|) + (93 . |hi|) (98 . |maxIndex|) |LSAGG-;delete!;AUsA;11| + (|Union| 7 '"failed") |LSAGG-;find;MAU;12| + |LSAGG-;position;MAI;13| (103 . |reverse!|) + (108 . |split!|) |LSAGG-;sorted?;MAB;15| + |LSAGG-;reduce;MA2S;16| (114 . =) (120 . |reduce|) + |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| + |LSAGG-;reverse!;2A;20| (128 . |cyclic?|) + |LSAGG-;copy;2A;21| (133 . |setfirst!|) + |LSAGG-;copyInto!;2AIA;22| (139 . |position|) + (146 . |remove!|) (152 . |removeDuplicates!|) (157 . <) + (163 . <) (|Mapping| 7 7)) + '#(|sorted?| 169 |sort!| 175 |select!| 181 |reverse!| 187 + |removeDuplicates!| 192 |remove!| 197 |reduce| 203 + |position| 224 |new| 237 |merge!| 243 |merge| 250 |map| + 257 |list| 264 |insert!| 269 |find| 283 |delete!| 289 + |copyInto!| 301 |copy| 308 < 313) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 65 + '(1 6 8 0 9 0 6 0 12 2 6 0 7 0 13 1 6 + 15 0 16 1 6 0 0 17 1 6 7 0 18 3 6 7 + 19 0 7 20 1 6 0 0 22 3 6 0 10 0 0 23 + 1 15 0 0 25 2 6 0 0 0 26 2 6 15 0 0 + 29 1 6 31 0 32 2 6 0 0 8 33 2 6 0 0 0 + 35 1 39 31 0 40 1 39 15 0 41 1 39 31 + 0 42 1 6 31 0 43 1 6 0 0 48 2 6 0 0 + 31 49 2 7 15 0 0 52 4 0 7 19 0 7 7 53 + 1 6 15 0 57 2 6 7 0 7 59 3 0 31 7 0 + 31 61 2 6 0 27 0 62 1 0 0 0 63 2 7 15 + 0 0 64 2 0 15 0 0 65 2 0 15 10 0 50 2 + 0 0 10 0 11 2 0 0 27 0 28 1 0 0 0 56 + 1 0 0 0 63 2 0 0 27 0 37 3 0 7 19 0 7 + 51 4 0 7 19 0 7 7 53 2 0 7 19 0 21 2 + 0 31 27 0 47 3 0 31 7 0 31 61 2 0 0 8 + 7 54 3 0 0 10 0 0 30 3 0 0 10 0 0 24 + 3 0 0 19 0 0 55 1 0 0 7 14 3 0 0 7 0 + 31 34 3 0 0 0 0 31 36 2 0 45 27 0 46 + 2 0 0 0 39 44 2 0 0 0 31 38 3 0 0 0 0 + 31 60 1 0 0 0 58 2 0 15 0 0 65))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp new file mode 100644 index 00000000..c0470689 --- /dev/null +++ b/src/algebra/strap/LSAGG.lsp @@ -0,0 +1,38 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |ListAggregate;CAT| 'NIL) + +(DEFPARAMETER |ListAggregate;AL| 'NIL) + +(DEFUN |ListAggregate| (#0=#:G1431) + (LET (#1=#:G1432) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |ListAggregate;AL|)) + (CDR #1#)) + (T (SETQ |ListAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|ListAggregate;| #0#))) + |ListAggregate;AL|)) + #1#)))) + +(DEFUN |ListAggregate;| (|t#1|) + (PROG (#0=#:G1430) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|ListAggregate;CAT|) + ('T + (LETT |ListAggregate;CAT| + (|Join| (|StreamAggregate| '|t#1|) + (|FiniteLinearAggregate| + '|t#1|) + (|ExtensibleLinearAggregate| + '|t#1|) + (|mkCategory| '|domain| + '(((|list| ($ |t#1|)) T)) NIL + 'NIL NIL)) + . #1=(|ListAggregate|))))) . #1#) + (SETELT #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp new file mode 100644 index 00000000..c9bcbbe5 --- /dev/null +++ b/src/algebra/strap/MONOID-.lsp @@ -0,0 +1,50 @@ + +(/VERSIONCHECK 2) + +(DEFUN |MONOID-;^;SNniS;1| (|x| |n| $) + (SPADCALL |x| |n| (QREFELT $ 8))) + +(DEFUN |MONOID-;one?;SB;2| (|x| $) + (SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12))) + +(DEFUN |MONOID-;sample;S;3| ($) (|spadConstant| $ 10)) + +(DEFUN |MONOID-;recip;SU;4| (|x| $) + (COND + ((SPADCALL |x| (|spadConstant| $ 10) (QREFELT $ 12)) (CONS 0 |x|)) + ('T (CONS 1 "failed")))) + +(DEFUN |MONOID-;**;SNniS;5| (|x| |n| $) + (COND + ((ZEROP |n|) (|spadConstant| $ 10)) + ('T (SPADCALL |x| |n| (QREFELT $ 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 $ (GETREFV 21) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|Monoid&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) (0 . **) |MONOID-;^;SNniS;1| + (6 . |One|) (|Boolean|) (10 . =) |MONOID-;one?;SB;2| + |MONOID-;sample;S;3| (|Union| $ '"failed") + |MONOID-;recip;SU;4| (|PositiveInteger|) + (|RepeatedSquaring| 6) (16 . |expt|) |MONOID-;**;SNniS;5|) + '#(|sample| 22 |recip| 26 |one?| 31 ^ 36 ** 42) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 20 + '(2 6 0 0 7 8 0 6 0 10 2 6 11 0 0 12 2 + 18 6 6 17 19 0 0 0 14 1 0 15 0 16 1 0 + 11 0 13 2 0 0 0 7 9 2 0 0 0 7 20))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/MONOID.lsp b/src/algebra/strap/MONOID.lsp new file mode 100644 index 00000000..eecfccc9 --- /dev/null +++ b/src/algebra/strap/MONOID.lsp @@ -0,0 +1,28 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Monoid;AL| 'NIL) + +(DEFUN |Monoid| () + (LET (#:G1388) + (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|)))))) + +(DEFUN |Monoid;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|Join| (|SemiGroup|) + (|mkCategory| '|domain| + '(((|One| ($) |constant|) T) + ((|sample| ($) |constant|) T) + ((|one?| ((|Boolean|) $)) T) + ((** ($ $ (|NonNegativeInteger|))) T) + ((^ ($ $ (|NonNegativeInteger|))) T) + ((|recip| ((|Union| $ "failed") $)) T)) + NIL + '((|NonNegativeInteger|) (|Boolean|)) + NIL)) + |Monoid|) + (SETELT #0# 0 '(|Monoid|)))))) + +(MAKEPROP '|Monoid| 'NILADIC T) diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp new file mode 100644 index 00000000..dbd30965 --- /dev/null +++ b/src/algebra/strap/MTSCAT.lsp @@ -0,0 +1,107 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |MultivariateTaylorSeriesCategory;CAT| 'NIL) + +(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL) + +(DEFUN |MultivariateTaylorSeriesCategory| + (&REST #0=#:G1390 &AUX #1=#:G1388) + (DSETQ #1# #0#) + (LET (#2=#:G1389) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) + |MultivariateTaylorSeriesCategory;AL|)) + (CDR #2#)) + (T (SETQ |MultivariateTaylorSeriesCategory;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY + #'|MultivariateTaylorSeriesCategory;| + #1#))) + |MultivariateTaylorSeriesCategory;AL|)) + #2#)))) + +(DEFUN |MultivariateTaylorSeriesCategory;| (|t#1| |t#2|) + (PROG (#0=#:G1387) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|))) + (|sublisV| + (PAIR '(#1=#:G1386) + (LIST '(|IndexedExponents| |t#2|))) + (COND + (|MultivariateTaylorSeriesCategory;CAT|) + ('T + (LETT |MultivariateTaylorSeriesCategory;CAT| + (|Join| + (|PartialDifferentialRing| '|t#2|) + (|PowerSeriesCategory| '|t#1| '#1# + '|t#2|) + (|InnerEvalable| '|t#2| '$) + (|Evalable| '$) + (|mkCategory| '|domain| + '(((|coefficient| + ($ $ |t#2| + (|NonNegativeInteger|))) + T) + ((|coefficient| + ($ $ (|List| |t#2|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|extend| + ($ $ (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ |t#2| + (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ (|List| |t#2|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|order| + ((|NonNegativeInteger|) $ + |t#2|)) + T) + ((|order| + ((|NonNegativeInteger|) $ + |t#2| + (|NonNegativeInteger|))) + T) + ((|polynomial| + ((|Polynomial| |t#1|) $ + (|NonNegativeInteger|))) + T) + ((|polynomial| + ((|Polynomial| |t#1|) $ + (|NonNegativeInteger|) + (|NonNegativeInteger|))) + T) + ((|integrate| ($ $ |t#2|)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '(((|RadicalCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|TranscendentalFunctionCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '((|Polynomial| |t#1|) + (|NonNegativeInteger|) + (|List| |t#2|) + (|List| (|NonNegativeInteger|))) + NIL)) + . #2=(|MultivariateTaylorSeriesCategory|)))))) . #2#) + (SETELT #0# 0 + (LIST '|MultivariateTaylorSeriesCategory| + (|devaluate| |t#1|) (|devaluate| |t#2|))))))) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp new file mode 100644 index 00000000..7952eb34 --- /dev/null +++ b/src/algebra/strap/NNI.lsp @@ -0,0 +1,148 @@ + +(|/VERSIONCHECK| 2) + +(SETQ |$CategoryFrame| + (|put| + #1=(QUOTE |NonNegativeInteger|) + (QUOTE |SuperDomain|) + #2=(QUOTE (|Integer|)) + (|put| + #2# + #3=(QUOTE |SubDomain|) + (CONS + (QUOTE + (|NonNegativeInteger| + COND ((|<| |#1| 0) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) + (DELASC #1# (|get| #2# #3# |$CategoryFrame|))) + |$CategoryFrame|))) + +(PUT + (QUOTE |NNI;sup;3$;1|) + (QUOTE |SPADreplace|) + (QUOTE MAX)) + +(DEFUN |NNI;sup;3$;1| (|x| |y| |$|) (MAX |x| |y|)) + +(PUT + (QUOTE |NNI;shift;$I$;2|) + (QUOTE |SPADreplace|) + (QUOTE ASH)) + +(DEFUN |NNI;shift;$I$;2| (|x| |n| |$|) (ASH |x| |n|)) + +(DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| |$|) + (PROG (|c|) + (RETURN + (SEQ + (LETT |c| (|-| |x| |y|) |NNI;subtractIfCan;2$U;3|) + (EXIT + (COND + ((|<| |c| 0) (CONS 1 "failed")) + ((QUOTE T) (CONS 0 |c|)))))))) + +(DEFUN |NonNegativeInteger| NIL + (PROG NIL + (RETURN + (PROG (#1=#:G96708) + (RETURN + (COND + ((LETT #1# + (HGET |$ConstructorCache| (QUOTE |NonNegativeInteger|)) + |NonNegativeInteger|) + (|CDRwithIncrement| (CDAR #1#))) + ((QUOTE T) + (|UNWIND-PROTECT| + (PROG1 + (CDDAR + (HPUT + |$ConstructorCache| + (QUOTE |NonNegativeInteger|) + (LIST (CONS NIL (CONS 1 (|NonNegativeInteger;|)))))) + (LETT #1# T |NonNegativeInteger|)) + (COND + ((NOT #1#) + (HREM + |$ConstructorCache| + (QUOTE |NonNegativeInteger|)))))))))))) + +(DEFUN |NonNegativeInteger;| NIL + (PROG (|dv$| |$| |pv$|) + (RETURN + (PROGN + (LETT |dv$| (QUOTE (|NonNegativeInteger|)) . #1=(|NonNegativeInteger|)) + (LETT |$| (GETREFV 17) . #1#) + (QSETREFV |$| 0 |dv$|) + (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) + (|haddProp| + |$ConstructorCache| + (QUOTE |NonNegativeInteger|) + NIL + (CONS 1 |$|)) + (|stuffDomainSlots| |$|) |$|)))) + +(MAKEPROP + (QUOTE |NonNegativeInteger|) + (QUOTE |infovec|) + (LIST + (QUOTE + #(NIL NIL NIL NIL NIL + (|Integer|) + |NNI;sup;3$;1| + |NNI;shift;$I$;2| + (|Union| |$| (QUOTE "failed")) + |NNI;subtractIfCan;2$U;3| + (|Record| (|:| |quotient| |$|) (|:| |remainder| |$|)) + (|PositiveInteger|) + (|Boolean|) + (|NonNegativeInteger|) + (|SingleInteger|) + (|String|) + (|OutputForm|))) + (QUOTE + #(|~=| 0 |zero?| 6 |sup| 11 |subtractIfCan| 17 |shift| 23 |sample| 29 + |rem| 33 |recip| 39 |random| 44 |quo| 49 |one?| 55 |min| 60 |max| 66 + |latex| 72 |hash| 77 |gcd| 82 |exquo| 88 |divide| 94 |coerce| 100 + |^| 105 |Zero| 117 |One| 121 |>=| 125 |>| 131 |=| 137 |<=| 143 + |<| 149 |+| 155 |**| 161 |*| 173)) + (QUOTE (((|commutative| "*") . 0))) + (CONS + (|makeByteWordVec2| 1 (QUOTE (0 0 0 0 0 0 0 0 0 0 0 0 0))) + (CONS + (QUOTE + #(NIL NIL NIL NIL NIL + |Monoid&| + |AbelianMonoid&| + |OrderedSet&| + |SemiGroup&| + |AbelianSemiGroup&| + |SetCategory&| + |BasicType&| + NIL)) + (CONS + (QUOTE + #((|OrderedAbelianMonoidSup|) + (|OrderedCancellationAbelianMonoid|) + (|OrderedAbelianMonoid|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|Monoid|) + (|AbelianMonoid|) + (|OrderedSet|) + (|SemiGroup|) + (|AbelianSemiGroup|) + (|SetCategory|) + (|BasicType|) + (|CoercibleTo| 16))) + (|makeByteWordVec2| 16 + (QUOTE + (2 0 12 0 0 1 1 0 12 0 1 2 0 0 0 0 6 2 0 8 0 0 9 2 0 0 0 5 7 0 0 + 0 1 2 0 0 0 0 1 1 0 8 0 1 1 0 0 0 1 2 0 0 0 0 1 1 0 12 0 1 2 0 + 0 0 0 1 2 0 0 0 0 1 1 0 15 0 1 1 0 14 0 1 2 0 0 0 0 1 2 0 8 0 0 + 1 2 0 10 0 0 1 1 0 16 0 1 2 0 0 0 11 1 2 0 0 0 13 1 0 0 0 1 0 0 + 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 0 0 1 2 0 12 + 0 0 1 2 0 0 0 0 1 2 0 0 0 11 1 2 0 0 0 13 1 2 0 0 0 0 1 2 0 0 + 11 0 1 2 0 0 13 0 1)))))) + (QUOTE |lookupComplete|))) + +(MAKEPROP (QUOTE |NonNegativeInteger|) (QUOTE NILADIC) T) + diff --git a/src/algebra/strap/OINTDOM.lsp b/src/algebra/strap/OINTDOM.lsp new file mode 100644 index 00000000..8729184b --- /dev/null +++ b/src/algebra/strap/OINTDOM.lsp @@ -0,0 +1,19 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL) + +(DEFUN |OrderedIntegralDomain| () + (LET (#:G1387) + (COND + (|OrderedIntegralDomain;AL|) + (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|)))))) + +(DEFUN |OrderedIntegralDomain;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|)) + |OrderedIntegralDomain|) + (SETELT #0# 0 '(|OrderedIntegralDomain|)))))) + +(MAKEPROP '|OrderedIntegralDomain| 'NILADIC T) diff --git a/src/algebra/strap/ORDRING-.lsp b/src/algebra/strap/ORDRING-.lsp new file mode 100644 index 00000000..b556918a --- /dev/null +++ b/src/algebra/strap/ORDRING-.lsp @@ -0,0 +1,52 @@ + +(/VERSIONCHECK 2) + +(DEFUN |ORDRING-;positive?;SB;1| (|x| $) + (SPADCALL (|spadConstant| $ 7) |x| (QREFELT $ 9))) + +(DEFUN |ORDRING-;negative?;SB;2| (|x| $) + (SPADCALL |x| (|spadConstant| $ 7) (QREFELT $ 9))) + +(DEFUN |ORDRING-;sign;SI;3| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 12)) 1) + ((SPADCALL |x| (QREFELT $ 13)) -1) + ((SPADCALL |x| (QREFELT $ 15)) 0) + ('T (|error| "x satisfies neither positive?, negative? or zero?")))) + +(DEFUN |ORDRING-;abs;2S;4| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 12)) |x|) + ((SPADCALL |x| (QREFELT $ 13)) (SPADCALL |x| (QREFELT $ 18))) + ((SPADCALL |x| (QREFELT $ 15)) (|spadConstant| $ 7)) + ('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 $ (GETREFV 20) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|OrderedRing&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |Zero|) + (|Boolean|) (4 . <) |ORDRING-;positive?;SB;1| + |ORDRING-;negative?;SB;2| (10 . |positive?|) + (15 . |negative?|) (20 . |One|) (24 . |zero?|) (|Integer|) + |ORDRING-;sign;SI;3| (29 . -) |ORDRING-;abs;2S;4|) + '#(|sign| 34 |positive?| 39 |negative?| 44 |abs| 49) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 19 + '(0 6 0 7 2 6 8 0 0 9 1 6 8 0 12 1 6 8 + 0 13 0 6 0 14 1 6 8 0 15 1 6 0 0 18 1 + 0 16 0 17 1 0 8 0 10 1 0 8 0 11 1 0 0 + 0 19))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/ORDRING.lsp b/src/algebra/strap/ORDRING.lsp new file mode 100644 index 00000000..9d3e60c9 --- /dev/null +++ b/src/algebra/strap/ORDRING.lsp @@ -0,0 +1,26 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |OrderedRing;AL| 'NIL) + +(DEFUN |OrderedRing| () + (LET (#:G1393) + (COND + (|OrderedRing;AL|) + (T (SETQ |OrderedRing;AL| (|OrderedRing;|)))))) + +(DEFUN |OrderedRing;| () + (PROG (#0=#:G1391) + (RETURN + (PROG1 (LETT #0# + (|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|) + (|mkCategory| '|domain| + '(((|positive?| ((|Boolean|) $)) T) + ((|negative?| ((|Boolean|) $)) T) + ((|sign| ((|Integer|) $)) T) + ((|abs| ($ $)) T)) + NIL '((|Integer|) (|Boolean|)) NIL)) + |OrderedRing|) + (SETELT #0# 0 '(|OrderedRing|)))))) + +(MAKEPROP '|OrderedRing| 'NILADIC T) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp new file mode 100644 index 00000000..91e85005 --- /dev/null +++ b/src/algebra/strap/OUTFORM.lsp @@ -0,0 +1,626 @@ + +(/VERSIONCHECK 2) + +(PUT '|OUTFORM;print;$V;1| '|SPADreplace| '|mathprint|) + +(DEFUN |OUTFORM;print;$V;1| (|x| $) (|mathprint| |x|)) + +(DEFUN |OUTFORM;message;S$;2| (|s| $) + (COND + ((SPADCALL |s| (QREFELT $ 11)) (SPADCALL (QREFELT $ 12))) + ('T |s|))) + +(DEFUN |OUTFORM;messagePrint;SV;3| (|s| $) + (SPADCALL (SPADCALL |s| (QREFELT $ 13)) (QREFELT $ 8))) + +(PUT '|OUTFORM;=;2$B;4| '|SPADreplace| 'EQUAL) + +(DEFUN |OUTFORM;=;2$B;4| (|a| |b| $) (EQUAL |a| |b|)) + +(DEFUN |OUTFORM;=;3$;5| (|a| |b| $) + (LIST (|OUTFORM;sform| "=" $) |a| |b|)) + +(PUT '|OUTFORM;coerce;$Of;6| '|SPADreplace| '(XLAM (|a|) |a|)) + +(DEFUN |OUTFORM;coerce;$Of;6| (|a| $) |a|) + +(PUT '|OUTFORM;outputForm;I$;7| '|SPADreplace| '(XLAM (|n|) |n|)) + +(DEFUN |OUTFORM;outputForm;I$;7| (|n| $) |n|) + +(PUT '|OUTFORM;outputForm;S$;8| '|SPADreplace| '(XLAM (|e|) |e|)) + +(DEFUN |OUTFORM;outputForm;S$;8| (|e| $) |e|) + +(PUT '|OUTFORM;outputForm;Df$;9| '|SPADreplace| '(XLAM (|f|) |f|)) + +(DEFUN |OUTFORM;outputForm;Df$;9| (|f| $) |f|) + +(PUT '|OUTFORM;sform| '|SPADreplace| '(XLAM (|s|) |s|)) + +(DEFUN |OUTFORM;sform| (|s| $) |s|) + +(PUT '|OUTFORM;eform| '|SPADreplace| '(XLAM (|e|) |e|)) + +(DEFUN |OUTFORM;eform| (|e| $) |e|) + +(PUT '|OUTFORM;iform| '|SPADreplace| '(XLAM (|n|) |n|)) + +(DEFUN |OUTFORM;iform| (|n| $) |n|) + +(DEFUN |OUTFORM;outputForm;S$;13| (|s| $) + (|OUTFORM;sform| + (SPADCALL (SPADCALL (QREFELT $ 26)) + (SPADCALL |s| (SPADCALL (QREFELT $ 26)) (QREFELT $ 27)) + (QREFELT $ 28)) + $)) + +(PUT '|OUTFORM;width;$I;14| '|SPADreplace| '|outformWidth|) + +(DEFUN |OUTFORM;width;$I;14| (|a| $) (|outformWidth| |a|)) + +(PUT '|OUTFORM;height;$I;15| '|SPADreplace| '|height|) + +(DEFUN |OUTFORM;height;$I;15| (|a| $) (|height| |a|)) + +(PUT '|OUTFORM;subHeight;$I;16| '|SPADreplace| '|subspan|) + +(DEFUN |OUTFORM;subHeight;$I;16| (|a| $) (|subspan| |a|)) + +(PUT '|OUTFORM;superHeight;$I;17| '|SPADreplace| '|superspan|) + +(DEFUN |OUTFORM;superHeight;$I;17| (|a| $) (|superspan| |a|)) + +(PUT '|OUTFORM;height;I;18| '|SPADreplace| '(XLAM NIL 20)) + +(DEFUN |OUTFORM;height;I;18| ($) 20) + +(PUT '|OUTFORM;width;I;19| '|SPADreplace| '(XLAM NIL 66)) + +(DEFUN |OUTFORM;width;I;19| ($) 66) + +(DEFUN |OUTFORM;center;$I$;20| (|a| |w| $) + (SPADCALL + (SPADCALL (QUOTIENT2 (- |w| (SPADCALL |a| (QREFELT $ 30))) 2) + (QREFELT $ 36)) + |a| (QREFELT $ 37))) + +(DEFUN |OUTFORM;left;$I$;21| (|a| |w| $) + (SPADCALL |a| + (SPADCALL (- |w| (SPADCALL |a| (QREFELT $ 30))) (QREFELT $ 36)) + (QREFELT $ 37))) + +(DEFUN |OUTFORM;right;$I$;22| (|a| |w| $) + (SPADCALL + (SPADCALL (- |w| (SPADCALL |a| (QREFELT $ 30))) (QREFELT $ 36)) + |a| (QREFELT $ 37))) + +(DEFUN |OUTFORM;center;2$;23| (|a| $) + (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 38))) + +(DEFUN |OUTFORM;left;2$;24| (|a| $) + (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 39))) + +(DEFUN |OUTFORM;right;2$;25| (|a| $) + (SPADCALL |a| (SPADCALL (QREFELT $ 35)) (QREFELT $ 40))) + +(DEFUN |OUTFORM;vspace;I$;26| (|n| $) + (COND + ((EQL |n| 0) (SPADCALL (QREFELT $ 12))) + ('T + (SPADCALL (|OUTFORM;sform| " " $) + (SPADCALL (- |n| 1) (QREFELT $ 44)) (QREFELT $ 45))))) + +(DEFUN |OUTFORM;hspace;I$;27| (|n| $) + (COND + ((EQL |n| 0) (SPADCALL (QREFELT $ 12))) + ('T (|OUTFORM;sform| (|fillerSpaces| |n|) $)))) + +(DEFUN |OUTFORM;rspace;2I$;28| (|n| |m| $) + (COND + ((OR (EQL |n| 0) (EQL |m| 0)) (SPADCALL (QREFELT $ 12))) + ('T + (SPADCALL (SPADCALL |n| (QREFELT $ 36)) + (SPADCALL |n| (- |m| 1) (QREFELT $ 46)) (QREFELT $ 45))))) + +(DEFUN |OUTFORM;matrix;L$;29| (|ll| $) + (PROG (#0=#:G1437 |l| #1=#:G1438 |lv|) + (RETURN + (SEQ (LETT |lv| + (PROGN + (LETT #0# NIL |OUTFORM;matrix;L$;29|) + (SEQ (LETT |l| NIL |OUTFORM;matrix;L$;29|) + (LETT #1# |ll| |OUTFORM;matrix;L$;29|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |l| (CAR #1#) + |OUTFORM;matrix;L$;29|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# (CONS (LIST2VEC |l|) #0#) + |OUTFORM;matrix;L$;29|))) + (LETT #1# (CDR #1#) |OUTFORM;matrix;L$;29|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |OUTFORM;matrix;L$;29|) + (EXIT (CONS (|OUTFORM;eform| 'MATRIX $) (LIST2VEC |lv|))))))) + +(DEFUN |OUTFORM;pile;L$;30| (|l| $) + (CONS (|OUTFORM;eform| 'SC $) |l|)) + +(DEFUN |OUTFORM;commaSeparate;L$;31| (|l| $) + (CONS (|OUTFORM;eform| 'AGGLST $) |l|)) + +(DEFUN |OUTFORM;semicolonSeparate;L$;32| (|l| $) + (CONS (|OUTFORM;eform| 'AGGSET $) |l|)) + +(DEFUN |OUTFORM;blankSeparate;L$;33| (|l| $) + (PROG (|c| |u| #0=#:G1446 |l1|) + (RETURN + (SEQ (LETT |c| (|OUTFORM;eform| 'CONCATB $) + |OUTFORM;blankSeparate;L$;33|) + (LETT |l1| NIL |OUTFORM;blankSeparate;L$;33|) + (SEQ (LETT |u| NIL |OUTFORM;blankSeparate;L$;33|) + (LETT #0# (SPADCALL |l| (QREFELT $ 53)) + |OUTFORM;blankSeparate;L$;33|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |u| (CAR #0#) + |OUTFORM;blankSeparate;L$;33|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((EQCAR |u| |c|) + (LETT |l1| + (SPADCALL (CDR |u|) |l1| + (QREFELT $ 54)) + |OUTFORM;blankSeparate;L$;33|)) + ('T + (LETT |l1| (CONS |u| |l1|) + |OUTFORM;blankSeparate;L$;33|))))) + (LETT #0# (CDR #0#) |OUTFORM;blankSeparate;L$;33|) + (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |c| |l1|)))))) + +(DEFUN |OUTFORM;brace;2$;34| (|a| $) + (LIST (|OUTFORM;eform| 'BRACE $) |a|)) + +(DEFUN |OUTFORM;brace;L$;35| (|l| $) + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 56))) + +(DEFUN |OUTFORM;bracket;2$;36| (|a| $) + (LIST (|OUTFORM;eform| 'BRACKET $) |a|)) + +(DEFUN |OUTFORM;bracket;L$;37| (|l| $) + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 58))) + +(DEFUN |OUTFORM;paren;2$;38| (|a| $) + (LIST (|OUTFORM;eform| 'PAREN $) |a|)) + +(DEFUN |OUTFORM;paren;L$;39| (|l| $) + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 60))) + +(DEFUN |OUTFORM;sub;3$;40| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUB $) |a| |b|)) + +(DEFUN |OUTFORM;super;3$;41| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) |b|)) + +(DEFUN |OUTFORM;presub;3$;42| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) + (|OUTFORM;sform| " " $) (|OUTFORM;sform| " " $) |b|)) + +(DEFUN |OUTFORM;presuper;3$;43| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $) + (|OUTFORM;sform| " " $) |b|)) + +(DEFUN |OUTFORM;scripts;$L$;44| (|a| |l| $) + (COND + ((SPADCALL |l| (QREFELT $ 66)) |a|) + ((SPADCALL (SPADCALL |l| (QREFELT $ 67)) (QREFELT $ 66)) + (SPADCALL |a| (SPADCALL |l| (QREFELT $ 68)) (QREFELT $ 62))) + ('T (CONS (|OUTFORM;eform| 'SUPERSUB $) (CONS |a| |l|))))) + +(DEFUN |OUTFORM;supersub;$L$;45| (|a| |l| $) + (SEQ (COND + ((ODDP (SPADCALL |l| (QREFELT $ 71))) + (LETT |l| + (SPADCALL |l| (LIST (SPADCALL (QREFELT $ 12))) + (QREFELT $ 73)) + |OUTFORM;supersub;$L$;45|))) + (EXIT (CONS (|OUTFORM;eform| 'ALTSUPERSUB $) (CONS |a| |l|))))) + +(DEFUN |OUTFORM;hconcat;3$;46| (|a| |b| $) + (LIST (|OUTFORM;eform| 'CONCAT $) |a| |b|)) + +(DEFUN |OUTFORM;hconcat;L$;47| (|l| $) + (CONS (|OUTFORM;eform| 'CONCAT $) |l|)) + +(DEFUN |OUTFORM;vconcat;3$;48| (|a| |b| $) + (LIST (|OUTFORM;eform| 'VCONCAT $) |a| |b|)) + +(DEFUN |OUTFORM;vconcat;L$;49| (|l| $) + (CONS (|OUTFORM;eform| 'VCONCAT $) |l|)) + +(DEFUN |OUTFORM;~=;3$;50| (|a| |b| $) + (LIST (|OUTFORM;sform| "~=" $) |a| |b|)) + +(DEFUN |OUTFORM;<;3$;51| (|a| |b| $) + (LIST (|OUTFORM;sform| "<" $) |a| |b|)) + +(DEFUN |OUTFORM;>;3$;52| (|a| |b| $) + (LIST (|OUTFORM;sform| ">" $) |a| |b|)) + +(DEFUN |OUTFORM;<=;3$;53| (|a| |b| $) + (LIST (|OUTFORM;sform| "<=" $) |a| |b|)) + +(DEFUN |OUTFORM;>=;3$;54| (|a| |b| $) + (LIST (|OUTFORM;sform| ">=" $) |a| |b|)) + +(DEFUN |OUTFORM;+;3$;55| (|a| |b| $) + (LIST (|OUTFORM;sform| "+" $) |a| |b|)) + +(DEFUN |OUTFORM;-;3$;56| (|a| |b| $) + (LIST (|OUTFORM;sform| "-" $) |a| |b|)) + +(DEFUN |OUTFORM;-;2$;57| (|a| $) (LIST (|OUTFORM;sform| "-" $) |a|)) + +(DEFUN |OUTFORM;*;3$;58| (|a| |b| $) + (LIST (|OUTFORM;sform| "*" $) |a| |b|)) + +(DEFUN |OUTFORM;/;3$;59| (|a| |b| $) + (LIST (|OUTFORM;sform| "/" $) |a| |b|)) + +(DEFUN |OUTFORM;**;3$;60| (|a| |b| $) + (LIST (|OUTFORM;sform| "**" $) |a| |b|)) + +(DEFUN |OUTFORM;div;3$;61| (|a| |b| $) + (LIST (|OUTFORM;sform| "div" $) |a| |b|)) + +(DEFUN |OUTFORM;rem;3$;62| (|a| |b| $) + (LIST (|OUTFORM;sform| "rem" $) |a| |b|)) + +(DEFUN |OUTFORM;quo;3$;63| (|a| |b| $) + (LIST (|OUTFORM;sform| "quo" $) |a| |b|)) + +(DEFUN |OUTFORM;exquo;3$;64| (|a| |b| $) + (LIST (|OUTFORM;sform| "exquo" $) |a| |b|)) + +(DEFUN |OUTFORM;and;3$;65| (|a| |b| $) + (LIST (|OUTFORM;sform| "and" $) |a| |b|)) + +(DEFUN |OUTFORM;or;3$;66| (|a| |b| $) + (LIST (|OUTFORM;sform| "or" $) |a| |b|)) + +(DEFUN |OUTFORM;not;2$;67| (|a| $) + (LIST (|OUTFORM;sform| "not" $) |a|)) + +(DEFUN |OUTFORM;SEGMENT;3$;68| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SEGMENT $) |a| |b|)) + +(DEFUN |OUTFORM;SEGMENT;2$;69| (|a| $) + (LIST (|OUTFORM;eform| 'SEGMENT $) |a|)) + +(DEFUN |OUTFORM;binomial;3$;70| (|a| |b| $) + (LIST (|OUTFORM;eform| 'BINOMIAL $) |a| |b|)) + +(DEFUN |OUTFORM;empty;$;71| ($) (LIST (|OUTFORM;eform| 'NOTHING $))) + +(DEFUN |OUTFORM;infix?;$B;72| (|a| $) + (PROG (#0=#:G1491 |e|) + (RETURN + (SEQ (EXIT (SEQ (LETT |e| + (COND + ((IDENTP |a|) |a|) + ((STRINGP |a|) (INTERN |a|)) + ('T + (PROGN + (LETT #0# 'NIL |OUTFORM;infix?;$B;72|) + (GO #0#)))) + |OUTFORM;infix?;$B;72|) + (EXIT (COND ((GET |e| 'INFIXOP) 'T) ('T 'NIL))))) + #0# (EXIT #0#))))) + +(PUT '|OUTFORM;elt;$L$;73| '|SPADreplace| 'CONS) + +(DEFUN |OUTFORM;elt;$L$;73| (|a| |l| $) (CONS |a| |l|)) + +(DEFUN |OUTFORM;prefix;$L$;74| (|a| |l| $) + (COND + ((NULL (SPADCALL |a| (QREFELT $ 98))) (CONS |a| |l|)) + ('T + (SPADCALL |a| + (SPADCALL (SPADCALL |l| (QREFELT $ 51)) (QREFELT $ 60)) + (QREFELT $ 37))))) + +(DEFUN |OUTFORM;infix;$L$;75| (|a| |l| $) + (COND + ((SPADCALL |l| (QREFELT $ 66)) (SPADCALL (QREFELT $ 12))) + ((SPADCALL (SPADCALL |l| (QREFELT $ 67)) (QREFELT $ 66)) + (SPADCALL |l| (QREFELT $ 68))) + ((SPADCALL |a| (QREFELT $ 98)) (CONS |a| |l|)) + ('T + (SPADCALL + (LIST (SPADCALL |l| (QREFELT $ 68)) |a| + (SPADCALL |a| (SPADCALL |l| (QREFELT $ 101)) + (QREFELT $ 102))) + (QREFELT $ 75))))) + +(DEFUN |OUTFORM;infix;4$;76| (|a| |b| |c| $) + (COND + ((SPADCALL |a| (QREFELT $ 98)) (LIST |a| |b| |c|)) + ('T (SPADCALL (LIST |b| |a| |c|) (QREFELT $ 75))))) + +(DEFUN |OUTFORM;postfix;3$;77| (|a| |b| $) + (SPADCALL |b| |a| (QREFELT $ 37))) + +(DEFUN |OUTFORM;string;2$;78| (|a| $) + (LIST (|OUTFORM;eform| 'STRING $) |a|)) + +(DEFUN |OUTFORM;quote;2$;79| (|a| $) + (LIST (|OUTFORM;eform| 'QUOTE $) |a|)) + +(DEFUN |OUTFORM;overbar;2$;80| (|a| $) + (LIST (|OUTFORM;eform| 'OVERBAR $) |a|)) + +(DEFUN |OUTFORM;dot;2$;81| (|a| $) + (SPADCALL |a| (|OUTFORM;sform| "." $) (QREFELT $ 63))) + +(DEFUN |OUTFORM;prime;2$;82| (|a| $) + (SPADCALL |a| (|OUTFORM;sform| "," $) (QREFELT $ 63))) + +(DEFUN |OUTFORM;dot;$Nni$;83| (|a| |nn| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| + (MAKE-FULL-CVEC |nn| (SPADCALL "." (QREFELT $ 110))) + |OUTFORM;dot;$Nni$;83|) + (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $) (QREFELT $ 63))))))) + +(DEFUN |OUTFORM;prime;$Nni$;84| (|a| |nn| $) + (PROG (|s|) + (RETURN + (SEQ (LETT |s| + (MAKE-FULL-CVEC |nn| (SPADCALL "," (QREFELT $ 110))) + |OUTFORM;prime;$Nni$;84|) + (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $) (QREFELT $ 63))))))) + +(DEFUN |OUTFORM;overlabel;3$;85| (|a| |b| $) + (LIST (|OUTFORM;eform| 'OVERLABEL $) |a| |b|)) + +(DEFUN |OUTFORM;box;2$;86| (|a| $) + (LIST (|OUTFORM;eform| 'BOX $) |a|)) + +(DEFUN |OUTFORM;zag;3$;87| (|a| |b| $) + (LIST (|OUTFORM;eform| 'ZAG $) |a| |b|)) + +(DEFUN |OUTFORM;root;2$;88| (|a| $) + (LIST (|OUTFORM;eform| 'ROOT $) |a|)) + +(DEFUN |OUTFORM;root;3$;89| (|a| |b| $) + (LIST (|OUTFORM;eform| 'ROOT $) |a| |b|)) + +(DEFUN |OUTFORM;over;3$;90| (|a| |b| $) + (LIST (|OUTFORM;eform| 'OVER $) |a| |b|)) + +(DEFUN |OUTFORM;slash;3$;91| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SLASH $) |a| |b|)) + +(DEFUN |OUTFORM;assign;3$;92| (|a| |b| $) + (LIST (|OUTFORM;eform| 'LET $) |a| |b|)) + +(DEFUN |OUTFORM;label;3$;93| (|a| |b| $) + (LIST (|OUTFORM;eform| 'EQUATNUM $) |a| |b|)) + +(DEFUN |OUTFORM;rarrow;3$;94| (|a| |b| $) + (LIST (|OUTFORM;eform| 'TAG $) |a| |b|)) + +(DEFUN |OUTFORM;differentiate;$Nni$;95| (|a| |nn| $) + (PROG (#0=#:G1521 |r| |s|) + (RETURN + (SEQ (COND + ((ZEROP |nn|) |a|) + ((< |nn| 4) (SPADCALL |a| |nn| (QREFELT $ 112))) + ('T + (SEQ (LETT |r| + (SPADCALL + (PROG1 (LETT #0# |nn| + |OUTFORM;differentiate;$Nni$;95|) + (|check-subtype| (> #0# 0) + '(|PositiveInteger|) #0#)) + (QREFELT $ 125)) + |OUTFORM;differentiate;$Nni$;95|) + (LETT |s| (SPADCALL |r| (QREFELT $ 126)) + |OUTFORM;differentiate;$Nni$;95|) + (EXIT (SPADCALL |a| + (SPADCALL (|OUTFORM;sform| |s| $) + (QREFELT $ 60)) + (QREFELT $ 63)))))))))) + +(DEFUN |OUTFORM;sum;2$;96| (|a| $) + (LIST (|OUTFORM;eform| 'SIGMA $) (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;sum;3$;97| (|a| |b| $) + (LIST (|OUTFORM;eform| 'SIGMA $) |b| |a|)) + +(DEFUN |OUTFORM;sum;4$;98| (|a| |b| |c| $) + (LIST (|OUTFORM;eform| 'SIGMA2 $) |b| |c| |a|)) + +(DEFUN |OUTFORM;prod;2$;99| (|a| $) + (LIST (|OUTFORM;eform| 'PI $) (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;prod;3$;100| (|a| |b| $) + (LIST (|OUTFORM;eform| 'PI $) |b| |a|)) + +(DEFUN |OUTFORM;prod;4$;101| (|a| |b| |c| $) + (LIST (|OUTFORM;eform| 'PI2 $) |b| |c| |a|)) + +(DEFUN |OUTFORM;int;2$;102| (|a| $) + (LIST (|OUTFORM;eform| 'INTSIGN $) (SPADCALL (QREFELT $ 12)) + (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;int;3$;103| (|a| |b| $) + (LIST (|OUTFORM;eform| 'INTSIGN $) |b| (SPADCALL (QREFELT $ 12)) |a|)) + +(DEFUN |OUTFORM;int;4$;104| (|a| |b| |c| $) + (LIST (|OUTFORM;eform| 'INTSIGN $) |b| |c| |a|)) + +(DEFUN |OutputForm| () + (PROG () + (RETURN + (PROG (#0=#:G1535) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|OutputForm|) + |OutputForm|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|OutputForm| + (LIST + (CONS NIL (CONS 1 (|OutputForm;|)))))) + (LETT #0# T |OutputForm|)) + (COND + ((NOT #0#) (HREM |$ConstructorCache| '|OutputForm|))))))))))) + +(DEFUN |OutputForm;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|OutputForm|) . #0=(|OutputForm|)) + (LETT $ (|newShell| 138) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|OutputForm| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 (|List| $)) + $)))) + +(MAKEPROP '|OutputForm| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL '|Rep| (|Void|) + |OUTFORM;print;$V;1| (|Boolean|) (|String|) (0 . |empty?|) + |OUTFORM;empty;$;71| |OUTFORM;message;S$;2| + |OUTFORM;messagePrint;SV;3| |OUTFORM;=;2$B;4| + |OUTFORM;=;3$;5| (|OutputForm|) |OUTFORM;coerce;$Of;6| + (|Integer|) |OUTFORM;outputForm;I$;7| (|Symbol|) + |OUTFORM;outputForm;S$;8| (|DoubleFloat|) + |OUTFORM;outputForm;Df$;9| (|Character|) (5 . |quote|) + (9 . |concat|) (15 . |concat|) |OUTFORM;outputForm;S$;13| + |OUTFORM;width;$I;14| |OUTFORM;height;$I;15| + |OUTFORM;subHeight;$I;16| |OUTFORM;superHeight;$I;17| + |OUTFORM;height;I;18| |OUTFORM;width;I;19| + |OUTFORM;hspace;I$;27| |OUTFORM;hconcat;3$;46| + |OUTFORM;center;$I$;20| |OUTFORM;left;$I$;21| + |OUTFORM;right;$I$;22| |OUTFORM;center;2$;23| + |OUTFORM;left;2$;24| |OUTFORM;right;2$;25| + |OUTFORM;vspace;I$;26| |OUTFORM;vconcat;3$;48| + |OUTFORM;rspace;2I$;28| (|List| 49) |OUTFORM;matrix;L$;29| + (|List| $) |OUTFORM;pile;L$;30| + |OUTFORM;commaSeparate;L$;31| + |OUTFORM;semicolonSeparate;L$;32| (21 . |reverse|) + (26 . |append|) |OUTFORM;blankSeparate;L$;33| + |OUTFORM;brace;2$;34| |OUTFORM;brace;L$;35| + |OUTFORM;bracket;2$;36| |OUTFORM;bracket;L$;37| + |OUTFORM;paren;2$;38| |OUTFORM;paren;L$;39| + |OUTFORM;sub;3$;40| |OUTFORM;super;3$;41| + |OUTFORM;presub;3$;42| |OUTFORM;presuper;3$;43| + (32 . |null|) (37 . |rest|) (42 . |first|) + |OUTFORM;scripts;$L$;44| (|NonNegativeInteger|) (47 . |#|) + (|List| $$) (52 . |append|) |OUTFORM;supersub;$L$;45| + |OUTFORM;hconcat;L$;47| |OUTFORM;vconcat;L$;49| + |OUTFORM;~=;3$;50| |OUTFORM;<;3$;51| |OUTFORM;>;3$;52| + |OUTFORM;<=;3$;53| |OUTFORM;>=;3$;54| |OUTFORM;+;3$;55| + |OUTFORM;-;3$;56| |OUTFORM;-;2$;57| |OUTFORM;*;3$;58| + |OUTFORM;/;3$;59| |OUTFORM;**;3$;60| |OUTFORM;div;3$;61| + |OUTFORM;rem;3$;62| |OUTFORM;quo;3$;63| + |OUTFORM;exquo;3$;64| |OUTFORM;and;3$;65| + |OUTFORM;or;3$;66| |OUTFORM;not;2$;67| + |OUTFORM;SEGMENT;3$;68| |OUTFORM;SEGMENT;2$;69| + |OUTFORM;binomial;3$;70| |OUTFORM;infix?;$B;72| + |OUTFORM;elt;$L$;73| |OUTFORM;prefix;$L$;74| (58 . |rest|) + |OUTFORM;infix;$L$;75| |OUTFORM;infix;4$;76| + |OUTFORM;postfix;3$;77| |OUTFORM;string;2$;78| + |OUTFORM;quote;2$;79| |OUTFORM;overbar;2$;80| + |OUTFORM;dot;2$;81| |OUTFORM;prime;2$;82| (63 . |char|) + |OUTFORM;dot;$Nni$;83| |OUTFORM;prime;$Nni$;84| + |OUTFORM;overlabel;3$;85| |OUTFORM;box;2$;86| + |OUTFORM;zag;3$;87| |OUTFORM;root;2$;88| + |OUTFORM;root;3$;89| |OUTFORM;over;3$;90| + |OUTFORM;slash;3$;91| |OUTFORM;assign;3$;92| + |OUTFORM;label;3$;93| |OUTFORM;rarrow;3$;94| + (|PositiveInteger|) (|NumberFormats|) (68 . |FormatRoman|) + (73 . |lowerCase|) |OUTFORM;differentiate;$Nni$;95| + |OUTFORM;sum;2$;96| |OUTFORM;sum;3$;97| + |OUTFORM;sum;4$;98| |OUTFORM;prod;2$;99| + |OUTFORM;prod;3$;100| |OUTFORM;prod;4$;101| + |OUTFORM;int;2$;102| |OUTFORM;int;3$;103| + |OUTFORM;int;4$;104| (|SingleInteger|)) + '#(~= 78 |zag| 90 |width| 96 |vspace| 105 |vconcat| 110 + |supersub| 121 |superHeight| 127 |super| 132 |sum| 138 + |subHeight| 156 |sub| 161 |string| 167 |slash| 172 + |semicolonSeparate| 178 |scripts| 183 |rspace| 189 |root| + 195 |right| 206 |rem| 217 |rarrow| 223 |quote| 229 |quo| + 234 |prod| 240 |print| 258 |prime| 263 |presuper| 274 + |presub| 280 |prefix| 286 |postfix| 292 |pile| 298 |paren| + 303 |overlabel| 313 |overbar| 319 |over| 324 |outputForm| + 330 |or| 350 |not| 356 |messagePrint| 361 |message| 366 + |matrix| 371 |left| 376 |latex| 387 |label| 392 |int| 398 + |infix?| 416 |infix| 421 |hspace| 434 |height| 439 + |hconcat| 448 |hash| 459 |exquo| 464 |empty| 470 |elt| 474 + |dot| 480 |div| 491 |differentiate| 497 |commaSeparate| + 503 |coerce| 508 |center| 513 |bracket| 524 |brace| 534 + |box| 544 |blankSeparate| 549 |binomial| 554 |assign| 560 + |and| 566 SEGMENT 572 >= 583 > 589 = 595 <= 607 < 613 / + 619 - 625 + 636 ** 642 * 648) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0)) + (CONS '#(|SetCategory&| |BasicType&| NIL) + (CONS '#((|SetCategory|) (|BasicType|) + (|CoercibleTo| 17)) + (|makeByteWordVec2| 137 + '(1 10 9 0 11 0 25 0 26 2 10 0 0 25 27 + 2 10 0 25 0 28 1 6 0 0 53 2 6 0 0 0 + 54 1 6 9 0 66 1 6 0 0 67 1 6 2 0 68 1 + 6 70 0 71 2 72 0 0 0 73 1 72 0 0 101 + 1 25 0 10 110 1 124 10 123 125 1 10 0 + 0 126 2 0 0 0 0 77 2 0 9 0 0 1 2 0 0 + 0 0 115 0 0 19 35 1 0 19 0 30 1 0 0 + 19 44 1 0 0 49 76 2 0 0 0 0 45 2 0 0 + 0 49 74 1 0 19 0 33 2 0 0 0 0 63 2 0 + 0 0 0 129 3 0 0 0 0 0 130 1 0 0 0 128 + 1 0 19 0 32 2 0 0 0 0 62 1 0 0 0 105 + 2 0 0 0 0 119 1 0 0 49 52 2 0 0 0 49 + 69 2 0 0 19 19 46 1 0 0 0 116 2 0 0 0 + 0 117 1 0 0 0 43 2 0 0 0 19 40 2 0 0 + 0 0 89 2 0 0 0 0 122 1 0 0 0 106 2 0 + 0 0 0 90 3 0 0 0 0 0 133 1 0 0 0 131 + 2 0 0 0 0 132 1 0 7 0 8 2 0 0 0 70 + 112 1 0 0 0 109 2 0 0 0 0 65 2 0 0 0 + 0 64 2 0 0 0 49 100 2 0 0 0 0 104 1 0 + 0 49 50 1 0 0 49 61 1 0 0 0 60 2 0 0 + 0 0 113 1 0 0 0 107 2 0 0 0 0 118 1 0 + 0 10 29 1 0 0 23 24 1 0 0 21 22 1 0 0 + 19 20 2 0 0 0 0 93 1 0 0 0 94 1 0 7 + 10 14 1 0 0 10 13 1 0 0 47 48 1 0 0 0 + 42 2 0 0 0 19 39 1 0 10 0 1 2 0 0 0 0 + 121 3 0 0 0 0 0 136 2 0 0 0 0 135 1 0 + 0 0 134 1 0 9 0 98 2 0 0 0 49 102 3 0 + 0 0 0 0 103 1 0 0 19 36 0 0 19 34 1 0 + 19 0 31 1 0 0 49 75 2 0 0 0 0 37 1 0 + 137 0 1 2 0 0 0 0 91 0 0 0 12 2 0 0 0 + 49 99 2 0 0 0 70 111 1 0 0 0 108 2 0 + 0 0 0 88 2 0 0 0 70 127 1 0 0 49 51 1 + 0 17 0 18 1 0 0 0 41 2 0 0 0 19 38 1 + 0 0 0 58 1 0 0 49 59 1 0 0 49 57 1 0 + 0 0 56 1 0 0 0 114 1 0 0 49 55 2 0 0 + 0 0 97 2 0 0 0 0 120 2 0 0 0 0 92 1 0 + 0 0 96 2 0 0 0 0 95 2 0 0 0 0 81 2 0 + 0 0 0 79 2 0 0 0 0 16 2 0 9 0 0 15 2 + 0 0 0 0 80 2 0 0 0 0 78 2 0 0 0 0 86 + 1 0 0 0 84 2 0 0 0 0 83 2 0 0 0 0 82 + 2 0 0 0 0 87 2 0 0 0 0 85))))) + '|lookupComplete|)) + +(MAKEPROP '|OutputForm| 'NILADIC T) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp new file mode 100644 index 00000000..bf877607 --- /dev/null +++ b/src/algebra/strap/PI.lsp @@ -0,0 +1,75 @@ + +(/VERSIONCHECK 2) + +(SETQ |$CategoryFrame| + (|put| #0='|PositiveInteger| '|SuperDomain| + #1='(|NonNegativeInteger|) + (|put| #1# '|SubDomain| + (CONS '(|PositiveInteger| < 0 |#1|) + (DELASC #0# + (|get| #1# '|SubDomain| + |$CategoryFrame|))) + |$CategoryFrame|))) + +(DEFUN |PositiveInteger| () + (PROG () + (RETURN + (PROG (#0=#:G1396) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|) + |PositiveInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| + '|PositiveInteger| + (LIST + (CONS NIL + (CONS 1 (|PositiveInteger;|)))))) + (LETT #0# T |PositiveInteger|)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|PositiveInteger|))))))))))) + +(DEFUN |PositiveInteger;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|PositiveInteger|) . #0=(|PositiveInteger|)) + (LETT $ (|newShell| 12) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|PositiveInteger| NIL + (CONS 1 $)) + (|stuffDomainSlots| $) + $)))) + +(MAKEPROP '|PositiveInteger| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL (|NonNegativeInteger|) + (|PositiveInteger|) (|Boolean|) (|Union| $ '"failed") + (|SingleInteger|) (|String|) (|OutputForm|)) + '#(~= 0 |sample| 6 |recip| 10 |one?| 15 |min| 20 |max| 26 + |latex| 32 |hash| 37 |gcd| 42 |coerce| 48 ^ 53 |One| 65 >= + 69 > 75 = 81 <= 87 < 93 + 99 ** 105 * 117) + '(((|commutative| "*") . 0)) + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0)) + (CONS '#(NIL |Monoid&| |OrderedSet&| |SemiGroup&| + |AbelianSemiGroup&| |SetCategory&| + |BasicType&| NIL) + (CONS '#((|OrderedAbelianSemiGroup|) (|Monoid|) + (|OrderedSet|) (|SemiGroup|) + (|AbelianSemiGroup|) (|SetCategory|) + (|BasicType|) (|CoercibleTo| 11)) + (|makeByteWordVec2| 11 + '(2 0 7 0 0 1 0 0 0 1 1 0 8 0 1 1 0 7 0 + 1 2 0 0 0 0 1 2 0 0 0 0 1 1 0 10 0 1 + 1 0 9 0 1 2 0 0 0 0 1 1 0 11 0 1 2 0 + 0 0 6 1 2 0 0 0 5 1 0 0 0 1 2 0 7 0 0 + 1 2 0 7 0 0 1 2 0 7 0 0 1 2 0 7 0 0 1 + 2 0 7 0 0 1 2 0 0 0 0 1 2 0 0 0 6 1 2 + 0 0 0 5 1 2 0 0 0 0 1 2 0 0 6 0 1))))) + '|lookupComplete|)) + +(MAKEPROP '|PositiveInteger| 'NILADIC T) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp new file mode 100644 index 00000000..557b4f8e --- /dev/null +++ b/src/algebra/strap/POLYCAT-.lsp @@ -0,0 +1,1757 @@ + +(/VERSIONCHECK 2) + +(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) + (PROG (#0=#:G1427 #1=#:G1421 #2=#:G1428 #3=#:G1429 |lvar| #4=#:G1430 + |e| #5=#:G1431) + (RETURN + (SEQ (COND + ((NULL |l|) |p|) + ('T + (SEQ (SEQ (EXIT (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) + (LETT #0# |l| |POLYCAT-;eval;SLS;1|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |e| (CAR #0#) + |POLYCAT-;eval;SLS;1|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (COND + ((QEQCAR + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 13)) + 1) + (PROGN + (LETT #1# + (|error| + "cannot find a variable to evaluate") + |POLYCAT-;eval;SLS;1|) + (GO #1#)))))) + (LETT #0# (CDR #0#) + |POLYCAT-;eval;SLS;1|) + (GO G190) G191 (EXIT NIL))) + #1# (EXIT #1#)) + (LETT |lvar| + (PROGN + (LETT #2# NIL |POLYCAT-;eval;SLS;1|) + (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) + (LETT #3# |l| |POLYCAT-;eval;SLS;1|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |e| (CAR #3#) + |POLYCAT-;eval;SLS;1|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #2# + (CONS + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 14)) + #2#) + |POLYCAT-;eval;SLS;1|))) + (LETT #3# (CDR #3#) + |POLYCAT-;eval;SLS;1|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + |POLYCAT-;eval;SLS;1|) + (EXIT (SPADCALL |p| |lvar| + (PROGN + (LETT #4# NIL |POLYCAT-;eval;SLS;1|) + (SEQ (LETT |e| NIL + |POLYCAT-;eval;SLS;1|) + (LETT #5# |l| + |POLYCAT-;eval;SLS;1|) + G190 + (COND + ((OR (ATOM #5#) + (PROGN + (LETT |e| (CAR #5#) + |POLYCAT-;eval;SLS;1|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #4# + (CONS + (SPADCALL |e| + (|getShellEntry| $ 15)) + #4#) + |POLYCAT-;eval;SLS;1|))) + (LETT #5# (CDR #5#) + |POLYCAT-;eval;SLS;1|) + (GO G190) G191 + (EXIT (NREVERSE0 #4#)))) + (|getShellEntry| $ 18)))))))))) + +(DEFUN |POLYCAT-;monomials;SL;2| (|p| $) + (PROG (|ml|) + (RETURN + (SEQ (LETT |ml| NIL |POLYCAT-;monomials;SL;2|) + (SEQ G190 + (COND + ((NULL (SPADCALL |p| (|spadConstant| $ 22) + (|getShellEntry| $ 25))) + (GO G191))) + (SEQ (LETT |ml| + (CONS (SPADCALL |p| (|getShellEntry| $ 26)) + |ml|) + |POLYCAT-;monomials;SL;2|) + (EXIT (LETT |p| + (SPADCALL |p| (|getShellEntry| $ 27)) + |POLYCAT-;monomials;SL;2|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (REVERSE |ml|)))))) + +(DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) + (PROG (|l|) + (RETURN + (COND + ((NULL (CDR (LETT |l| (SPADCALL |p| (|getShellEntry| $ 29)) + |POLYCAT-;isPlus;SU;3|))) + (CONS 1 "failed")) + ('T (CONS 0 |l|)))))) + +(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $) + (PROG (|lv| #0=#:G1453 |v| #1=#:G1454 |l| |r|) + (RETURN + (SEQ (COND + ((OR (NULL (LETT |lv| + (SPADCALL |p| (|getShellEntry| $ 32)) + |POLYCAT-;isTimes;SU;4|)) + (NULL (SPADCALL |p| (|getShellEntry| $ 33)))) + (CONS 1 "failed")) + ('T + (SEQ (LETT |l| + (PROGN + (LETT #0# NIL |POLYCAT-;isTimes;SU;4|) + (SEQ (LETT |v| NIL |POLYCAT-;isTimes;SU;4|) + (LETT #1# |lv| |POLYCAT-;isTimes;SU;4|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |v| (CAR #1#) + |POLYCAT-;isTimes;SU;4|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS + (SPADCALL (|spadConstant| $ 34) + |v| + (SPADCALL |p| |v| + (|getShellEntry| $ 37)) + (|getShellEntry| $ 38)) + #0#) + |POLYCAT-;isTimes;SU;4|))) + (LETT #1# (CDR #1#) + |POLYCAT-;isTimes;SU;4|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |POLYCAT-;isTimes;SU;4|) + (LETT |r| (SPADCALL |p| (|getShellEntry| $ 39)) + |POLYCAT-;isTimes;SU;4|) + (EXIT (COND + ((SPADCALL |r| (|spadConstant| $ 35) + (|getShellEntry| $ 40)) + (COND + ((NULL (CDR |lv|)) (CONS 1 "failed")) + ('T (CONS 0 |l|)))) + ('T + (CONS 0 + (CONS (SPADCALL |r| + (|getShellEntry| $ 41)) + |l|)))))))))))) + +(DEFUN |POLYCAT-;isExpt;SU;5| (|p| $) + (PROG (|u| |d|) + (RETURN + (SEQ (LETT |u| (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;isExpt;SU;5|) + (EXIT (COND + ((OR (QEQCAR |u| 1) + (NULL (SPADCALL |p| + (SPADCALL (|spadConstant| $ 34) + (QCDR |u|) + (LETT |d| + (SPADCALL |p| (QCDR |u|) + (|getShellEntry| $ 37)) + |POLYCAT-;isExpt;SU;5|) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 44)))) + (CONS 1 "failed")) + ('T (CONS 0 (CONS (QCDR |u|) |d|))))))))) + +(DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) + (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 49)) |n| + (|getShellEntry| $ 51))) + +(DEFUN |POLYCAT-;coefficient;SLLS;7| (|p| |lv| |ln| $) + (COND + ((NULL |lv|) + (COND + ((NULL |ln|) |p|) + ('T (|error| "mismatched lists in coefficient")))) + ((NULL |ln|) (|error| "mismatched lists in coefficient")) + ('T + (SPADCALL + (SPADCALL + (SPADCALL |p| (|SPADfirst| |lv|) (|getShellEntry| $ 49)) + (|SPADfirst| |ln|) (|getShellEntry| $ 51)) + (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 54))))) + +(DEFUN |POLYCAT-;monomial;SLLS;8| (|p| |lv| |ln| $) + (COND + ((NULL |lv|) + (COND + ((NULL |ln|) |p|) + ('T (|error| "mismatched lists in monomial")))) + ((NULL |ln|) (|error| "mismatched lists in monomial")) + ('T + (SPADCALL + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |ln|) + (|getShellEntry| $ 38)) + (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 56))))) + +(DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) + (PROG (#0=#:G1479 |q|) + (RETURN + (SEQ (LETT |q| + (PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;retract;SVarSet;9|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 9) + #0#)) + |POLYCAT-;retract;SVarSet;9|) + (EXIT (COND + ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 58)) |p| + (|getShellEntry| $ 44)) + |q|) + ('T (|error| "Polynomial is not a single variable")))))))) + +(DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) + (PROG (|q| #0=#:G1487) + (RETURN + (SEQ (EXIT (SEQ (SEQ (LETT |q| + (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;retractIfCan;SU;10|) + (EXIT (COND + ((QEQCAR |q| 0) + (COND + ((SPADCALL + (SPADCALL (QCDR |q|) + (|getShellEntry| $ 58)) + |p| (|getShellEntry| $ 44)) + (PROGN + (LETT #0# |q| + |POLYCAT-;retractIfCan;SU;10|) + (GO #0#)))))))) + (EXIT (CONS 1 "failed")))) + #0# (EXIT #0#))))) + +(DEFUN |POLYCAT-;mkPrim| (|p| $) + (SPADCALL (|spadConstant| $ 35) (SPADCALL |p| (|getShellEntry| $ 61)) + (|getShellEntry| $ 62))) + +(DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $) + (PROG (#0=#:G1492 |q| #1=#:G1493) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |POLYCAT-;primitiveMonomials;SL;12|) + (SEQ (LETT |q| NIL |POLYCAT-;primitiveMonomials;SL;12|) + (LETT #1# (SPADCALL |p| (|getShellEntry| $ 29)) + |POLYCAT-;primitiveMonomials;SL;12|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |q| (CAR #1#) + |POLYCAT-;primitiveMonomials;SL;12|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS (|POLYCAT-;mkPrim| |q| $) #0#) + |POLYCAT-;primitiveMonomials;SL;12|))) + (LETT #1# (CDR #1#) + |POLYCAT-;primitiveMonomials;SL;12|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) + (PROG (#0=#:G1495 |d| |u|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 64)) 0) + ('T + (SEQ (LETT |u| + (SPADCALL |p| + (PROG2 (LETT #0# + (SPADCALL |p| + (|getShellEntry| $ 43)) + |POLYCAT-;totalDegree;SNni;13|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 9) #0#)) + (|getShellEntry| $ 49)) + |POLYCAT-;totalDegree;SNni;13|) + (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|) + (SEQ G190 + (COND + ((NULL (SPADCALL |u| (|spadConstant| $ 65) + (|getShellEntry| $ 66))) + (GO G191))) + (SEQ (LETT |d| + (MAX |d| + (+ + (SPADCALL |u| + (|getShellEntry| $ 67)) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 68)) + (|getShellEntry| $ 69)))) + |POLYCAT-;totalDegree;SNni;13|) + (EXIT (LETT |u| + (SPADCALL |u| + (|getShellEntry| $ 70)) + |POLYCAT-;totalDegree;SNni;13|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|)))))))) + +(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) + (PROG (#0=#:G1503 |v| |w| |d| |u|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 64)) 0) + ('T + (SEQ (LETT |u| + (SPADCALL |p| + (LETT |v| + (PROG2 + (LETT #0# + (SPADCALL |p| + (|getShellEntry| $ 43)) + |POLYCAT-;totalDegree;SLNni;14|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 9) #0#)) + |POLYCAT-;totalDegree;SLNni;14|) + (|getShellEntry| $ 49)) + |POLYCAT-;totalDegree;SLNni;14|) + (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|) + (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) + (COND + ((SPADCALL |v| |lv| (|getShellEntry| $ 72)) + (LETT |w| 1 |POLYCAT-;totalDegree;SLNni;14|))) + (SEQ G190 + (COND + ((NULL (SPADCALL |u| (|spadConstant| $ 65) + (|getShellEntry| $ 66))) + (GO G191))) + (SEQ (LETT |d| + (MAX |d| + (+ + (* |w| + (SPADCALL |u| + (|getShellEntry| $ 67))) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 68)) + |lv| (|getShellEntry| $ 73)))) + |POLYCAT-;totalDegree;SLNni;14|) + (EXIT (LETT |u| + (SPADCALL |u| + (|getShellEntry| $ 70)) + |POLYCAT-;totalDegree;SLNni;14|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|)))))))) + +(DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) + (SPADCALL (SPADCALL |p1| |mvar| (|getShellEntry| $ 49)) + (SPADCALL |p2| |mvar| (|getShellEntry| $ 49)) + (|getShellEntry| $ 75))) + +(DEFUN |POLYCAT-;discriminant;SVarSetS;16| (|p| |var| $) + (SPADCALL (SPADCALL |p| |var| (|getShellEntry| $ 49)) + (|getShellEntry| $ 77))) + +(DEFUN |POLYCAT-;allMonoms| (|l| $) + (PROG (#0=#:G1515 |p| #1=#:G1516) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL |POLYCAT-;allMonoms|) + (SEQ (LETT |p| NIL |POLYCAT-;allMonoms|) + (LETT #1# |l| |POLYCAT-;allMonoms|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |POLYCAT-;allMonoms|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 79)) + #0#) + |POLYCAT-;allMonoms|))) + (LETT #1# (CDR #1#) |POLYCAT-;allMonoms|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 81)) + (|getShellEntry| $ 82)))))) + +(DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) + (PROG (|w| |bj| #0=#:G1521 |i| #1=#:G1520) + (RETURN + (SEQ (LETT |w| + (SPADCALL |n| (|spadConstant| $ 23) + (|getShellEntry| $ 84)) + |POLYCAT-;P2R|) + (SEQ (LETT |bj| NIL |POLYCAT-;P2R|) + (LETT #0# |b| |POLYCAT-;P2R|) + (LETT |i| (SPADCALL |w| (|getShellEntry| $ 86)) + |POLYCAT-;P2R|) + (LETT #1# (QVSIZE |w|) |POLYCAT-;P2R|) G190 + (COND + ((OR (> |i| #1#) (ATOM #0#) + (PROGN + (LETT |bj| (CAR #0#) |POLYCAT-;P2R|) + NIL)) + (GO G191))) + (SEQ (EXIT (SPADCALL |w| |i| + (SPADCALL |p| |bj| + (|getShellEntry| $ 87)) + (|getShellEntry| $ 88)))) + (LETT |i| + (PROG1 (+ |i| 1) + (LETT #0# (CDR #0#) |POLYCAT-;P2R|)) + |POLYCAT-;P2R|) + (GO G190) G191 (EXIT NIL)) + (EXIT |w|))))) + +(DEFUN |POLYCAT-;eq2R| (|l| |b| $) + (PROG (#0=#:G1525 |bj| #1=#:G1526 #2=#:G1527 |p| #3=#:G1528) + (RETURN + (SEQ (SPADCALL + (PROGN + (LETT #0# NIL |POLYCAT-;eq2R|) + (SEQ (LETT |bj| NIL |POLYCAT-;eq2R|) + (LETT #1# |b| |POLYCAT-;eq2R|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |bj| (CAR #1#) |POLYCAT-;eq2R|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (PROGN + (LETT #2# NIL + |POLYCAT-;eq2R|) + (SEQ + (LETT |p| NIL + |POLYCAT-;eq2R|) + (LETT #3# |l| + |POLYCAT-;eq2R|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |p| (CAR #3#) + |POLYCAT-;eq2R|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (SPADCALL |p| |bj| + (|getShellEntry| $ 87)) + #2#) + |POLYCAT-;eq2R|))) + (LETT #3# (CDR #3#) + |POLYCAT-;eq2R|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + #0#) + |POLYCAT-;eq2R|))) + (LETT #1# (CDR #1#) |POLYCAT-;eq2R|) (GO G190) + G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 92)))))) + +(DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) + (PROG (#0=#:G1537 |r| #1=#:G1538 |b| #2=#:G1539 |bj| #3=#:G1540 |d| + |mm| |l|) + (RETURN + (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |b| + (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL + |POLYCAT-;reducedSystem;MM;20|) + (SEQ (LETT |r| NIL + |POLYCAT-;reducedSystem;MM;20|) + (LETT #1# |l| + |POLYCAT-;reducedSystem;MM;20|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |r| (CAR #1#) + |POLYCAT-;reducedSystem;MM;20|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS + (|POLYCAT-;allMonoms| |r| $) + #0#) + |POLYCAT-;reducedSystem;MM;20|))) + (LETT #1# (CDR #1#) + |POLYCAT-;reducedSystem;MM;20|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 81)) + (|getShellEntry| $ 82)) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |d| + (PROGN + (LETT #2# NIL |POLYCAT-;reducedSystem;MM;20|) + (SEQ (LETT |bj| NIL |POLYCAT-;reducedSystem;MM;20|) + (LETT #3# |b| |POLYCAT-;reducedSystem;MM;20|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |bj| (CAR #3#) + |POLYCAT-;reducedSystem;MM;20|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #2# + (CONS + (SPADCALL |bj| + (|getShellEntry| $ 61)) + #2#) + |POLYCAT-;reducedSystem;MM;20|))) + (LETT #3# (CDR #3#) + |POLYCAT-;reducedSystem;MM;20|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) + |POLYCAT-;reducedSystem;MM;20|) + (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MM;20|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l|) (|getShellEntry| $ 96))) + (GO G191))) + (SEQ (LETT |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 97)) + |POLYCAT-;reducedSystem;MM;20|) + (EXIT (LETT |l| (CDR |l|) + |POLYCAT-;reducedSystem;MM;20|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |mm|))))) + +(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) + (PROG (#0=#:G1551 |s| #1=#:G1552 |b| #2=#:G1553 |bj| #3=#:G1554 |d| + |n| |mm| |w| |l| |r|) + (RETURN + (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |r| (SPADCALL |v| (|getShellEntry| $ 101)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |b| + (SPADCALL + (SPADCALL (|POLYCAT-;allMonoms| |r| $) + (SPADCALL + (PROGN + (LETT #0# NIL + |POLYCAT-;reducedSystem;MVR;21|) + (SEQ (LETT |s| NIL + |POLYCAT-;reducedSystem;MVR;21|) + (LETT #1# |l| + |POLYCAT-;reducedSystem;MVR;21|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |s| (CAR #1#) + |POLYCAT-;reducedSystem;MVR;21|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (|POLYCAT-;allMonoms| |s| $) + #0#) + |POLYCAT-;reducedSystem;MVR;21|))) + (LETT #1# (CDR #1#) + |POLYCAT-;reducedSystem;MVR;21|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 81)) + (|getShellEntry| $ 102)) + (|getShellEntry| $ 82)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |d| + (PROGN + (LETT #2# NIL |POLYCAT-;reducedSystem;MVR;21|) + (SEQ (LETT |bj| NIL |POLYCAT-;reducedSystem;MVR;21|) + (LETT #3# |b| |POLYCAT-;reducedSystem;MVR;21|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |bj| (CAR #3#) + |POLYCAT-;reducedSystem;MVR;21|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #2# + (CONS + (SPADCALL |bj| + (|getShellEntry| $ 61)) + #2#) + |POLYCAT-;reducedSystem;MVR;21|))) + (LETT #3# (CDR #3#) + |POLYCAT-;reducedSystem;MVR;21|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |n| (LENGTH |d|) |POLYCAT-;reducedSystem;MVR;21|) + (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MVR;21|) + (LETT |r| (CDR |r|) |POLYCAT-;reducedSystem;MVR;21|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |l|) (|getShellEntry| $ 96))) + (GO G191))) + (SEQ (LETT |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 97)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |w| + (SPADCALL |w| + (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| + |n| $) + (|getShellEntry| $ 103)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |l| (CDR |l|) + |POLYCAT-;reducedSystem;MVR;21|) + (EXIT (LETT |r| (CDR |r|) + |POLYCAT-;reducedSystem;MVR;21|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |mm| |w|)))))) + +(DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) + (SPADCALL |pp| |qq| (|getShellEntry| $ 108))) + +(DEFUN |POLYCAT-;solveLinearPolynomialEquation;LSupU;23| (|lpp| |pp| $) + (SPADCALL |lpp| |pp| (|getShellEntry| $ 113))) + +(DEFUN |POLYCAT-;factorPolynomial;SupF;24| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 118))) + +(DEFUN |POLYCAT-;factorSquareFreePolynomial;SupF;25| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 121))) + +(DEFUN |POLYCAT-;factor;SF;26| (|p| $) + (PROG (|v| |ansR| #0=#:G1596 |w| #1=#:G1597 |up| |ansSUP| #2=#:G1598 + |ww| #3=#:G1599) + (RETURN + (SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 43)) + |POLYCAT-;factor;SF;26|) + (EXIT (COND + ((QEQCAR |v| 1) + (SEQ (LETT |ansR| + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 39)) + (|getShellEntry| $ 124)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansR| + (|getShellEntry| $ 126)) + (|getShellEntry| $ 41)) + (PROGN + (LETT #0# NIL + |POLYCAT-;factor;SF;26|) + (SEQ + (LETT |w| NIL + |POLYCAT-;factor;SF;26|) + (LETT #1# + (SPADCALL |ansR| + (|getShellEntry| $ 130)) + |POLYCAT-;factor;SF;26|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |w| (CAR #1#) + |POLYCAT-;factor;SF;26|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (VECTOR (QVELT |w| 0) + (SPADCALL (QVELT |w| 1) + (|getShellEntry| $ 41)) + (QVELT |w| 2)) + #0#) + |POLYCAT-;factor;SF;26|))) + (LETT #1# (CDR #1#) + |POLYCAT-;factor;SF;26|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 134))))) + ('T + (SEQ (LETT |up| + (SPADCALL |p| (QCDR |v|) + (|getShellEntry| $ 49)) + |POLYCAT-;factor;SF;26|) + (LETT |ansSUP| + (SPADCALL |up| (|getShellEntry| $ 118)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansSUP| + (|getShellEntry| $ 135)) + (QCDR |v|) (|getShellEntry| $ 136)) + (PROGN + (LETT #2# NIL + |POLYCAT-;factor;SF;26|) + (SEQ + (LETT |ww| NIL + |POLYCAT-;factor;SF;26|) + (LETT #3# + (SPADCALL |ansSUP| + (|getShellEntry| $ 139)) + |POLYCAT-;factor;SF;26|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |ww| (CAR #3#) + |POLYCAT-;factor;SF;26|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (VECTOR (QVELT |ww| 0) + (SPADCALL (QVELT |ww| 1) + (QCDR |v|) + (|getShellEntry| $ 136)) + (QVELT |ww| 2)) + #2#) + |POLYCAT-;factor;SF;26|))) + (LETT #3# (CDR #3#) + |POLYCAT-;factor;SF;26|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 134))))))))))) + +(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) + (PROG (|ll| #0=#:G1634 |z| #1=#:G1635 |ch| |l| #2=#:G1636 #3=#:G1637 + #4=#:G1606 #5=#:G1604 #6=#:G1605 #7=#:G1638 |vars| |degs| + #8=#:G1639 |d| #9=#:G1640 |nd| #10=#:G1633 #11=#:G1613 + |deg1| |redmons| #12=#:G1641 |v| #13=#:G1643 |u| + #14=#:G1642 |llR| |monslist| |ans| #15=#:G1644 + #16=#:G1645 |mons| #17=#:G1646 |m| #18=#:G1647 |i| + #19=#:G1629 #20=#:G1627 #21=#:G1628) + (RETURN + (SEQ (EXIT (SEQ (LETT |ll| + (SPADCALL + (SPADCALL |mat| + (|getShellEntry| $ 141)) + (|getShellEntry| $ 95)) + |POLYCAT-;conditionP;MU;27|) + (LETT |llR| + (PROGN + (LETT #0# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ (LETT |z| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #1# (|SPADfirst| |ll|) + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |z| (CAR #1#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# (CONS NIL #0#) + |POLYCAT-;conditionP;MU;27|))) + (LETT #1# (CDR #1#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |monslist| NIL |POLYCAT-;conditionP;MU;27|) + (LETT |ch| (SPADCALL (|getShellEntry| $ 142)) + |POLYCAT-;conditionP;MU;27|) + (SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|) + (LETT #2# |ll| |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #2#) + (PROGN + (LETT |l| (CAR #2#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ (LETT |mons| + (PROGN + (LETT #6# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |u| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #3# |l| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |u| (CAR #3#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #4# + (SPADCALL |u| + (|getShellEntry| $ 79)) + |POLYCAT-;conditionP;MU;27|) + (COND + (#6# + (LETT #5# + (SPADCALL #5# #4# + (|getShellEntry| $ + 143)) + |POLYCAT-;conditionP;MU;27|)) + ('T + (PROGN + (LETT #5# #4# + |POLYCAT-;conditionP;MU;27|) + (LETT #6# 'T + |POLYCAT-;conditionP;MU;27|))))))) + (LETT #3# (CDR #3#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + (COND + (#6# #5#) + ('T + (|IdentityError| + '|setUnion|)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |redmons| NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ (LETT |m| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #7# |mons| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #7#) + (PROGN + (LETT |m| (CAR #7#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (LETT |vars| + (SPADCALL |m| + (|getShellEntry| $ 32)) + |POLYCAT-;conditionP;MU;27|) + (LETT |degs| + (SPADCALL |m| |vars| + (|getShellEntry| $ 144)) + |POLYCAT-;conditionP;MU;27|) + (LETT |deg1| + (PROGN + (LETT #8# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |d| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #9# |degs| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #9#) + (PROGN + (LETT |d| (CAR #9#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #8# + (CONS + (SEQ + (LETT |nd| + (SPADCALL |d| |ch| + (|getShellEntry| $ + 146)) + |POLYCAT-;conditionP;MU;27|) + (EXIT + (COND + ((QEQCAR |nd| 1) + (PROGN + (LETT #10# + (CONS 1 "failed") + |POLYCAT-;conditionP;MU;27|) + (GO #10#))) + ('T + (PROG1 + (LETT #11# + (QCDR |nd|) + |POLYCAT-;conditionP;MU;27|) + (|check-subtype| + (>= #11# 0) + '(|NonNegativeInteger|) + #11#)))))) + #8#) + |POLYCAT-;conditionP;MU;27|))) + (LETT #9# (CDR #9#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT (NREVERSE0 #8#)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |redmons| + (CONS + (SPADCALL (|spadConstant| $ 34) + |vars| |deg1| + (|getShellEntry| $ 56)) + |redmons|) + |POLYCAT-;conditionP;MU;27|) + (EXIT + (LETT |llR| + (PROGN + (LETT #12# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |v| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #13# |llR| + |POLYCAT-;conditionP;MU;27|) + (LETT |u| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #14# |l| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #14#) + (PROGN + (LETT |u| (CAR #14#) + |POLYCAT-;conditionP;MU;27|) + NIL) + (ATOM #13#) + (PROGN + (LETT |v| (CAR #13#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #12# + (CONS + (CONS + (SPADCALL + (SPADCALL |u| |vars| + |degs| + (|getShellEntry| $ + 54)) + (|getShellEntry| $ + 147)) + |v|) + #12#) + |POLYCAT-;conditionP;MU;27|))) + (LETT #14# + (PROG1 (CDR #14#) + (LETT #13# (CDR #13#) + |POLYCAT-;conditionP;MU;27|)) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT (NREVERSE0 #12#)))) + |POLYCAT-;conditionP;MU;27|))) + (LETT #7# (CDR #7#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + (EXIT (LETT |monslist| + (CONS |redmons| |monslist|) + |POLYCAT-;conditionP;MU;27|))) + (LETT #2# (CDR #2#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + (LETT |ans| + (SPADCALL + (SPADCALL + (SPADCALL |llR| + (|getShellEntry| $ 92)) + (|getShellEntry| $ 148)) + (|getShellEntry| $ 150)) + |POLYCAT-;conditionP;MU;27|) + (EXIT (COND + ((QEQCAR |ans| 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |i| 0 + |POLYCAT-;conditionP;MU;27|) + (EXIT + (CONS 0 + (PRIMVEC2ARR + (PROGN + (LETT #15# + (GETREFV (SIZE |monslist|)) + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT #16# 0 + |POLYCAT-;conditionP;MU;27|) + (LETT |mons| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #17# |monslist| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #17#) + (PROGN + (LETT |mons| (CAR #17#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (SETELT #15# #16# + (PROGN + (LETT #21# NIL + |POLYCAT-;conditionP;MU;27|) + (SEQ + (LETT |m| NIL + |POLYCAT-;conditionP;MU;27|) + (LETT #18# |mons| + |POLYCAT-;conditionP;MU;27|) + G190 + (COND + ((OR (ATOM #18#) + (PROGN + (LETT |m| + (CAR #18#) + |POLYCAT-;conditionP;MU;27|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (PROGN + (LETT #19# + (SPADCALL |m| + (SPADCALL + (SPADCALL + (QCDR |ans|) + (LETT |i| + (+ |i| 1) + |POLYCAT-;conditionP;MU;27|) + (|getShellEntry| + $ 151)) + (|getShellEntry| + $ 41)) + (|getShellEntry| + $ 152)) + |POLYCAT-;conditionP;MU;27|) + (COND + (#21# + (LETT #20# + (SPADCALL #20# + #19# + (|getShellEntry| + $ 153)) + |POLYCAT-;conditionP;MU;27|)) + ('T + (PROGN + (LETT #20# + #19# + |POLYCAT-;conditionP;MU;27|) + (LETT #21# 'T + |POLYCAT-;conditionP;MU;27|))))))) + (LETT #18# (CDR #18#) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 + (EXIT NIL)) + (COND + (#21# #20#) + ('T + (|spadConstant| $ 22))))))) + (LETT #17# + (PROG1 (CDR #17#) + (LETT #16# (QSADD1 #16#) + |POLYCAT-;conditionP;MU;27|)) + |POLYCAT-;conditionP;MU;27|) + (GO G190) G191 (EXIT NIL)) + #15#)))))))))) + #10# (EXIT #10#))))) + +(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $) + (PROG (|vars| |ans| |ch|) + (RETURN + (SEQ (LETT |vars| (SPADCALL |p| (|getShellEntry| $ 32)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (COND + ((NULL |vars|) + (SEQ (LETT |ans| + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 147)) + (|getShellEntry| $ 155)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (COND + ((QEQCAR |ans| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |ans|) + (|getShellEntry| $ 41)))))))) + ('T + (SEQ (LETT |ch| (SPADCALL (|getShellEntry| $ 142)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| + $)))))))))) + +(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) + (PROG (|v| |dd| |cp| |d| #0=#:G1668 |ans| |ansx| #1=#:G1675) + (RETURN + (SEQ (EXIT (COND + ((NULL |vars|) + (SEQ (LETT |ans| + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 147)) + (|getShellEntry| $ 155)) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((QEQCAR |ans| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |ans|) + (|getShellEntry| $ 41)))))))) + ('T + (SEQ (LETT |v| (|SPADfirst| |vars|) + |POLYCAT-;charthRootlv|) + (LETT |vars| (CDR |vars|) + |POLYCAT-;charthRootlv|) + (LETT |d| + (SPADCALL |p| |v| + (|getShellEntry| $ 37)) + |POLYCAT-;charthRootlv|) + (LETT |ans| (|spadConstant| $ 22) + |POLYCAT-;charthRootlv|) + (SEQ G190 (COND ((NULL (< 0 |d|)) (GO G191))) + (SEQ (LETT |dd| + (SPADCALL |d| |ch| + (|getShellEntry| $ 146)) + |POLYCAT-;charthRootlv|) + (EXIT + (COND + ((QEQCAR |dd| 1) + (PROGN + (LETT #1# (CONS 1 "failed") + |POLYCAT-;charthRootlv|) + (GO #1#))) + ('T + (SEQ + (LETT |cp| + (SPADCALL |p| |v| |d| + (|getShellEntry| $ 158)) + |POLYCAT-;charthRootlv|) + (LETT |p| + (SPADCALL |p| + (SPADCALL |cp| |v| |d| + (|getShellEntry| $ 38)) + (|getShellEntry| $ 159)) + |POLYCAT-;charthRootlv|) + (LETT |ansx| + (|POLYCAT-;charthRootlv| |cp| + |vars| |ch| $) + |POLYCAT-;charthRootlv|) + (EXIT + (COND + ((QEQCAR |ansx| 1) + (PROGN + (LETT #1# + (CONS 1 "failed") + |POLYCAT-;charthRootlv|) + (GO #1#))) + ('T + (SEQ + (LETT |d| + (SPADCALL |p| |v| + (|getShellEntry| $ 37)) + |POLYCAT-;charthRootlv|) + (EXIT + (LETT |ans| + (SPADCALL |ans| + (SPADCALL (QCDR |ansx|) + |v| + (PROG1 + (LETT #0# (QCDR |dd|) + |POLYCAT-;charthRootlv|) + (|check-subtype| + (>= #0# 0) + '(|NonNegativeInteger|) + #0#)) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 153)) + |POLYCAT-;charthRootlv|))))))))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |ansx| + (|POLYCAT-;charthRootlv| |p| |vars| |ch| + $) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((QEQCAR |ansx| 1) + (PROGN + (LETT #1# (CONS 1 "failed") + |POLYCAT-;charthRootlv|) + (GO #1#))) + ('T + (PROGN + (LETT #1# + (CONS 0 + (SPADCALL |ans| (QCDR |ansx|) + (|getShellEntry| $ 153))) + |POLYCAT-;charthRootlv|) + (GO #1#))))))))) + #1# (EXIT #1#))))) + +(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $) + (PROG (|result|) + (RETURN + (SEQ (LETT |result| + (SPADCALL + (SPADCALL |p1| |mvar| (|getShellEntry| $ 49)) + (SPADCALL |p2| |mvar| (|getShellEntry| $ 49)) + (|getShellEntry| $ 161)) + |POLYCAT-;monicDivide;2SVarSetR;30|) + (EXIT (CONS (SPADCALL (QCAR |result|) |mvar| + (|getShellEntry| $ 136)) + (SPADCALL (QCDR |result|) |mvar| + (|getShellEntry| $ 136)))))))) + +(DEFUN |POLYCAT-;squareFree;SF;31| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 164))) + +(DEFUN |POLYCAT-;squareFree;SF;32| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 167))) + +(DEFUN |POLYCAT-;squareFree;SF;33| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 167))) + +(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $) + (PROG (|s| |f| #0=#:G1691 #1=#:G1689 #2=#:G1687 #3=#:G1688) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (LETT |s| (SPADCALL |p| (|getShellEntry| $ 168)) + |POLYCAT-;squareFreePart;2S;34|) + (|getShellEntry| $ 169)) + (PROGN + (LETT #3# NIL |POLYCAT-;squareFreePart;2S;34|) + (SEQ (LETT |f| NIL |POLYCAT-;squareFreePart;2S;34|) + (LETT #0# (SPADCALL |s| (|getShellEntry| $ 172)) + |POLYCAT-;squareFreePart;2S;34|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |POLYCAT-;squareFreePart;2S;34|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (QCAR |f|) + |POLYCAT-;squareFreePart;2S;34|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 152)) + |POLYCAT-;squareFreePart;2S;34|)) + ('T + (PROGN + (LETT #2# #1# + |POLYCAT-;squareFreePart;2S;34|) + (LETT #3# 'T + |POLYCAT-;squareFreePart;2S;34|))))))) + (LETT #0# (CDR #0#) + |POLYCAT-;squareFreePart;2S;34|) + (GO G190) G191 (EXIT NIL)) + (COND (#3# #2#) ('T (|spadConstant| $ 34)))) + (|getShellEntry| $ 152)))))) + +(DEFUN |POLYCAT-;content;SVarSetS;35| (|p| |v| $) + (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 49)) + (|getShellEntry| $ 174))) + +(DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $) + (PROG (#0=#:G1694) + (RETURN + (QVELT (SPADCALL + (PROG2 (LETT #0# + (SPADCALL |p| + (SPADCALL |p| + (|getShellEntry| $ 176)) + (|getShellEntry| $ 177)) + |POLYCAT-;primitivePart;2S;36|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) + #0#)) + (|getShellEntry| $ 179)) + 1)))) + +(DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $) + (PROG (#0=#:G1700) + (RETURN + (QVELT (SPADCALL + (PROG2 (LETT #0# + (SPADCALL |p| + (SPADCALL |p| |v| + (|getShellEntry| $ 181)) + (|getShellEntry| $ 182)) + |POLYCAT-;primitivePart;SVarSetS;37|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) + #0#)) + (|getShellEntry| $ 179)) + 1)))) + +(DEFUN |POLYCAT-;<;2SB;38| (|p| |q| $) + (PROG (|dp| |dq|) + (RETURN + (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 61)) + |POLYCAT-;<;2SB;38|) + (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 61)) + |POLYCAT-;<;2SB;38|) + (EXIT (COND + ((SPADCALL |dp| |dq| (|getShellEntry| $ 184)) + (SPADCALL (|spadConstant| $ 23) + (SPADCALL |q| (|getShellEntry| $ 39)) + (|getShellEntry| $ 185))) + ((SPADCALL |dq| |dp| (|getShellEntry| $ 184)) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 39)) + (|spadConstant| $ 23) (|getShellEntry| $ 185))) + ('T + (SPADCALL + (SPADCALL (SPADCALL |p| |q| + (|getShellEntry| $ 159)) + (|getShellEntry| $ 39)) + (|spadConstant| $ 23) (|getShellEntry| $ 185))))))))) + +(DEFUN |POLYCAT-;patternMatch;SP2Pmr;39| (|p| |pat| |l| $) + (SPADCALL |p| |pat| |l| (|getShellEntry| $ 190))) + +(DEFUN |POLYCAT-;patternMatch;SP2Pmr;40| (|p| |pat| |l| $) + (SPADCALL |p| |pat| |l| (|getShellEntry| $ 197))) + +(DEFUN |POLYCAT-;convert;SP;41| (|x| $) + (SPADCALL (ELT $ 200) (ELT $ 201) |x| (|getShellEntry| $ 205))) + +(DEFUN |POLYCAT-;convert;SP;42| (|x| $) + (SPADCALL (ELT $ 207) (ELT $ 208) |x| (|getShellEntry| $ 212))) + +(DEFUN |POLYCAT-;convert;SIf;43| (|p| $) + (SPADCALL (ELT $ 215) (ELT $ 216) |p| (|getShellEntry| $ 220))) + +(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| 229) . #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|))) + (|HasCategory| |#2| '(|OrderedSet|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (|setShellEntry| $ 8 |#3|) + (|setShellEntry| $ 9 |#4|) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (|setShellEntry| $ 76 + (CONS (|dispatchFunction| + |POLYCAT-;resultant;2SVarSetS;15|) + $)) + (|setShellEntry| $ 78 + (CONS (|dispatchFunction| + |POLYCAT-;discriminant;SVarSetS;16|) + $))))) + (COND + ((|HasCategory| |#2| '(|IntegralDomain|)) + (PROGN + (|setShellEntry| $ 99 + (CONS (|dispatchFunction| + |POLYCAT-;reducedSystem;MM;20|) + $)) + (|setShellEntry| $ 106 + (CONS (|dispatchFunction| + |POLYCAT-;reducedSystem;MVR;21|) + $))))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (|setShellEntry| $ 109 + (CONS (|dispatchFunction| + |POLYCAT-;gcdPolynomial;3Sup;22|) + $)) + (|setShellEntry| $ 116 + (CONS (|dispatchFunction| + |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|) + $)) + (|setShellEntry| $ 120 + (CONS (|dispatchFunction| + |POLYCAT-;factorPolynomial;SupF;24|) + $)) + (|setShellEntry| $ 122 + (CONS (|dispatchFunction| + |POLYCAT-;factorSquareFreePolynomial;SupF;25|) + $)) + (|setShellEntry| $ 140 + (CONS (|dispatchFunction| |POLYCAT-;factor;SF;26|) $)) + (COND + ((|HasCategory| |#2| '(|CharacteristicNonZero|)) + (PROGN + (|setShellEntry| $ 154 + (CONS (|dispatchFunction| + |POLYCAT-;conditionP;MU;27|) + $)))))))) + (COND + ((|HasCategory| |#2| '(|CharacteristicNonZero|)) + (PROGN + (|setShellEntry| $ 156 + (CONS (|dispatchFunction| |POLYCAT-;charthRoot;SU;28|) + $))))) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (COND + ((|HasCategory| |#2| '(|EuclideanDomain|)) + (COND + ((|HasCategory| |#2| '(|CharacteristicZero|)) + (|setShellEntry| $ 165 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;31|) + $))) + ('T + (|setShellEntry| $ 165 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;32|) + $))))) + ('T + (|setShellEntry| $ 165 + (CONS (|dispatchFunction| + |POLYCAT-;squareFree;SF;33|) + $)))) + (|setShellEntry| $ 173 + (CONS (|dispatchFunction| + |POLYCAT-;squareFreePart;2S;34|) + $)) + (|setShellEntry| $ 175 + (CONS (|dispatchFunction| + |POLYCAT-;content;SVarSetS;35|) + $)) + (|setShellEntry| $ 180 + (CONS (|dispatchFunction| + |POLYCAT-;primitivePart;2S;36|) + $)) + (|setShellEntry| $ 183 + (CONS (|dispatchFunction| + |POLYCAT-;primitivePart;SVarSetS;37|) + $))))) + (COND + ((|testBitVector| |pv$| 15) + (PROGN + (|setShellEntry| $ 186 + (CONS (|dispatchFunction| |POLYCAT-;<;2SB;38|) $)) + (COND + ((|testBitVector| |pv$| 8) + (COND + ((|testBitVector| |pv$| 7) + (|setShellEntry| $ 192 + (CONS (|dispatchFunction| + |POLYCAT-;patternMatch;SP2Pmr;39|) + $)))))) + (COND + ((|testBitVector| |pv$| 6) + (COND + ((|testBitVector| |pv$| 5) + (|setShellEntry| $ 199 + (CONS (|dispatchFunction| + |POLYCAT-;patternMatch;SP2Pmr;40|) + $))))))))) + (COND + ((|testBitVector| |pv$| 12) + (COND + ((|testBitVector| |pv$| 11) + (|setShellEntry| $ 206 + (CONS (|dispatchFunction| |POLYCAT-;convert;SP;41|) + $)))))) + (COND + ((|testBitVector| |pv$| 10) + (COND + ((|testBitVector| |pv$| 9) + (|setShellEntry| $ 213 + (CONS (|dispatchFunction| |POLYCAT-;convert;SP;42|) + $)))))) + (COND + ((|testBitVector| |pv$| 14) + (COND + ((|testBitVector| |pv$| 13) + (|setShellEntry| $ 221 + (CONS (|dispatchFunction| |POLYCAT-;convert;SIf;43|) + $)))))) + $)))) + +(MAKEPROP '|PolynomialCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|local| |#3|) (|local| |#4|) (|Equation| 6) (0 . |lhs|) + (|Union| 9 '"failed") (5 . |retractIfCan|) + (10 . |retract|) (15 . |rhs|) (|List| 9) (|List| $) + (20 . |eval|) (|Equation| $) (|List| 19) + |POLYCAT-;eval;SLS;1| (27 . |Zero|) (31 . |Zero|) + (|Boolean|) (35 . ~=) (41 . |leadingMonomial|) + (46 . |reductum|) |POLYCAT-;monomials;SL;2| + (51 . |monomials|) (|Union| 17 '"failed") + |POLYCAT-;isPlus;SU;3| (56 . |variables|) + (61 . |monomial?|) (66 . |One|) (70 . |One|) + (|NonNegativeInteger|) (74 . |degree|) (80 . |monomial|) + (87 . |leadingCoefficient|) (92 . =) (98 . |coerce|) + |POLYCAT-;isTimes;SU;4| (103 . |mainVariable|) (108 . =) + (|Record| (|:| |var| 9) (|:| |exponent| 36)) + (|Union| 45 '"failed") |POLYCAT-;isExpt;SU;5| + (|SparseUnivariatePolynomial| $) (114 . |univariate|) + (|SparseUnivariatePolynomial| 6) (120 . |coefficient|) + |POLYCAT-;coefficient;SVarSetNniS;6| (|List| 36) + (126 . |coefficient|) |POLYCAT-;coefficient;SLLS;7| + (133 . |monomial|) |POLYCAT-;monomial;SLLS;8| + (140 . |coerce|) |POLYCAT-;retract;SVarSet;9| + |POLYCAT-;retractIfCan;SU;10| (145 . |degree|) + (150 . |monomial|) |POLYCAT-;primitiveMonomials;SL;12| + (156 . |ground?|) (161 . |Zero|) (165 . ~=) + (171 . |degree|) (176 . |leadingCoefficient|) + (181 . |totalDegree|) (186 . |reductum|) + |POLYCAT-;totalDegree;SNni;13| (191 . |member?|) + (197 . |totalDegree|) |POLYCAT-;totalDegree;SLNni;14| + (203 . |resultant|) (209 . |resultant|) + (216 . |discriminant|) (221 . |discriminant|) + (227 . |primitiveMonomials|) (|List| 6) (232 . |concat|) + (237 . |removeDuplicates!|) (|Vector| 7) (242 . |new|) + (|Integer|) (248 . |minIndex|) (253 . |coefficient|) + (259 . |qsetelt!|) (|List| 7) (|List| 89) (|Matrix| 7) + (266 . |matrix|) (|List| 80) (|Matrix| 6) + (271 . |listOfLists|) (276 . |not|) (281 . |vertConcat|) + (|Matrix| $) (287 . |reducedSystem|) (|Vector| 6) + (292 . |entries|) (297 . |concat|) (303 . |concat|) + (|Record| (|:| |mat| 91) (|:| |vec| 83)) (|Vector| $) + (309 . |reducedSystem|) + (|GeneralPolynomialGcdPackage| 8 9 7 6) + (315 . |gcdPolynomial|) (321 . |gcdPolynomial|) + (|List| 50) (|Union| 110 '"failed") + (|PolynomialFactorizationByRecursion| 7 8 9 6) + (327 . |solveLinearPolynomialEquationByRecursion|) + (|List| 48) (|Union| 114 '"failed") + (333 . |solveLinearPolynomialEquation|) (|Factored| 50) + (339 . |factorByRecursion|) (|Factored| 48) + (344 . |factorPolynomial|) + (349 . |factorSquareFreeByRecursion|) + (354 . |factorSquareFreePolynomial|) (|Factored| $) + (359 . |factor|) (|Factored| 7) (364 . |unit|) + (|Union| '"nil" '"sqfr" '"irred" '"prime") + (|Record| (|:| |flg| 127) (|:| |fctr| 7) (|:| |xpnt| 85)) + (|List| 128) (369 . |factorList|) + (|Record| (|:| |flg| 127) (|:| |fctr| 6) (|:| |xpnt| 85)) + (|List| 131) (|Factored| 6) (374 . |makeFR|) + (380 . |unit|) (385 . |multivariate|) + (|Record| (|:| |flg| 127) (|:| |fctr| 50) (|:| |xpnt| 85)) + (|List| 137) (391 . |factorList|) (396 . |factor|) + (401 . |transpose|) (406 . |characteristic|) + (410 . |setUnion|) (416 . |degree|) (|Union| $ '"failed") + (422 . |exquo|) (428 . |ground|) (433 . |transpose|) + (|Union| 105 '"failed") (438 . |conditionP|) (443 . |elt|) + (449 . *) (455 . +) (461 . |conditionP|) + (466 . |charthRoot|) (471 . |charthRoot|) (476 . |Zero|) + (480 . |coefficient|) (487 . -) + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (493 . |monicDivide|) |POLYCAT-;monicDivide;2SVarSetR;30| + (|MultivariateSquareFree| 8 9 7 6) (499 . |squareFree|) + (504 . |squareFree|) (|PolynomialSquareFree| 9 8 7 6) + (509 . |squareFree|) (514 . |squareFree|) (519 . |unit|) + (|Record| (|:| |factor| 6) (|:| |exponent| 85)) + (|List| 170) (524 . |factors|) (529 . |squareFreePart|) + (534 . |content|) (539 . |content|) (545 . |content|) + (550 . |exquo|) + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + (556 . |unitNormal|) (561 . |primitivePart|) + (566 . |content|) (572 . |exquo|) (578 . |primitivePart|) + (584 . <) (590 . <) (596 . <) (|PatternMatchResult| 85 6) + (|Pattern| 85) + (|PatternMatchPolynomialCategory| 85 8 9 7 6) + (602 . |patternMatch|) (|PatternMatchResult| 85 $) + (609 . |patternMatch|) (|Float|) + (|PatternMatchResult| 193 6) (|Pattern| 193) + (|PatternMatchPolynomialCategory| 193 8 9 7 6) + (616 . |patternMatch|) (|PatternMatchResult| 193 $) + (623 . |patternMatch|) (630 . |convert|) (635 . |convert|) + (|Mapping| 188 9) (|Mapping| 188 7) + (|PolynomialCategoryLifting| 8 9 7 6 188) (640 . |map|) + (647 . |convert|) (652 . |convert|) (657 . |convert|) + (|Mapping| 195 9) (|Mapping| 195 7) + (|PolynomialCategoryLifting| 8 9 7 6 195) (662 . |map|) + (669 . |convert|) (|InputForm|) (674 . |convert|) + (679 . |convert|) (|Mapping| 214 9) (|Mapping| 214 7) + (|PolynomialCategoryLifting| 8 9 7 6 214) (684 . |map|) + (691 . |convert|) (|Matrix| 85) (|Vector| 85) + (|Record| (|:| |mat| 222) (|:| |vec| 223)) + (|Union| 85 '"failed") (|Fraction| 85) + (|Union| 226 '"failed") (|Union| 7 '"failed")) + '#(|totalDegree| 696 |squareFreePart| 707 |squareFree| 712 + |solveLinearPolynomialEquation| 717 |retractIfCan| 723 + |retract| 728 |resultant| 733 |reducedSystem| 740 + |primitivePart| 751 |primitiveMonomials| 762 + |patternMatch| 767 |monomials| 781 |monomial| 786 + |monicDivide| 793 |isTimes| 800 |isPlus| 805 |isExpt| 810 + |gcdPolynomial| 815 |factorSquareFreePolynomial| 821 + |factorPolynomial| 826 |factor| 831 |eval| 836 + |discriminant| 842 |convert| 848 |content| 863 + |conditionP| 869 |coefficient| 874 |charthRoot| 888 < 893) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 221 + '(1 10 6 0 11 1 6 12 0 13 1 6 9 0 14 1 + 10 6 0 15 3 6 0 0 16 17 18 0 6 0 22 0 + 7 0 23 2 6 24 0 0 25 1 6 0 0 26 1 6 0 + 0 27 1 6 17 0 29 1 6 16 0 32 1 6 24 0 + 33 0 6 0 34 0 7 0 35 2 6 36 0 9 37 3 + 6 0 0 9 36 38 1 6 7 0 39 2 7 24 0 0 + 40 1 6 0 7 41 1 6 12 0 43 2 6 24 0 0 + 44 2 6 48 0 9 49 2 50 6 0 36 51 3 6 0 + 0 16 53 54 3 6 0 0 16 53 56 1 6 0 9 + 58 1 6 8 0 61 2 6 0 7 8 62 1 6 24 0 + 64 0 50 0 65 2 50 24 0 0 66 1 50 36 0 + 67 1 50 6 0 68 1 6 36 0 69 1 50 0 0 + 70 2 16 24 9 0 72 2 6 36 0 16 73 2 50 + 6 0 0 75 3 0 0 0 0 9 76 1 50 6 0 77 2 + 0 0 0 9 78 1 6 17 0 79 1 80 0 17 81 1 + 80 0 0 82 2 83 0 36 7 84 1 83 85 0 86 + 2 6 7 0 8 87 3 83 7 0 85 7 88 1 91 0 + 90 92 1 94 93 0 95 1 24 0 0 96 2 91 0 + 0 0 97 1 0 91 98 99 1 100 80 0 101 2 + 80 0 0 0 102 2 83 0 0 0 103 2 0 104 + 98 105 106 2 107 50 50 50 108 2 0 48 + 48 48 109 2 112 111 110 50 113 2 0 + 115 114 48 116 1 112 117 50 118 1 0 + 119 48 120 1 112 117 50 121 1 0 119 + 48 122 1 7 123 0 124 1 125 7 0 126 1 + 125 129 0 130 2 133 0 6 132 134 1 117 + 50 0 135 2 6 0 48 9 136 1 117 138 0 + 139 1 0 123 0 140 1 94 0 0 141 0 6 36 + 142 2 80 0 0 0 143 2 6 53 0 16 144 2 + 85 145 0 0 146 1 6 7 0 147 1 91 0 0 + 148 1 7 149 98 150 2 83 7 0 85 151 2 + 6 0 0 0 152 2 6 0 0 0 153 1 0 149 98 + 154 1 7 145 0 155 1 0 145 0 156 0 8 0 + 157 3 6 0 0 9 36 158 2 6 0 0 0 159 2 + 50 160 0 0 161 1 163 133 6 164 1 0 + 123 0 165 1 166 133 6 167 1 6 123 0 + 168 1 133 6 0 169 1 133 171 0 172 1 0 + 0 0 173 1 50 6 0 174 2 0 0 0 9 175 1 + 6 7 0 176 2 6 145 0 7 177 1 6 178 0 + 179 1 0 0 0 180 2 6 0 0 9 181 2 6 145 + 0 0 182 2 0 0 0 9 183 2 8 24 0 0 184 + 2 7 24 0 0 185 2 0 24 0 0 186 3 189 + 187 6 188 187 190 3 0 191 0 188 191 + 192 3 196 194 6 195 194 197 3 0 198 0 + 195 198 199 1 9 188 0 200 1 7 188 0 + 201 3 204 188 202 203 6 205 1 0 188 0 + 206 1 9 195 0 207 1 7 195 0 208 3 211 + 195 209 210 6 212 1 0 195 0 213 1 9 + 214 0 215 1 7 214 0 216 3 219 214 217 + 218 6 220 1 0 214 0 221 2 0 36 0 16 + 74 1 0 36 0 71 1 0 0 0 173 1 0 123 0 + 165 2 0 115 114 48 116 1 0 12 0 60 1 + 0 9 0 59 3 0 0 0 0 9 76 1 0 91 98 99 + 2 0 104 98 105 106 2 0 0 0 9 183 1 0 + 0 0 180 1 0 17 0 63 3 0 191 0 188 191 + 192 3 0 198 0 195 198 199 1 0 17 0 28 + 3 0 0 0 16 53 57 3 0 160 0 0 9 162 1 + 0 30 0 42 1 0 30 0 31 1 0 46 0 47 2 0 + 48 48 48 109 1 0 119 48 122 1 0 119 + 48 120 1 0 123 0 140 2 0 0 0 20 21 2 + 0 0 0 9 78 1 0 214 0 221 1 0 188 0 + 206 1 0 195 0 213 2 0 0 0 9 175 1 0 + 149 98 154 3 0 0 0 16 53 55 3 0 0 0 9 + 36 52 1 0 145 0 156 2 0 24 0 0 186))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp new file mode 100644 index 00000000..e328aa4d --- /dev/null +++ b/src/algebra/strap/POLYCAT.lsp @@ -0,0 +1,238 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |PolynomialCategory;CAT| 'NIL) + +(DEFPARAMETER |PolynomialCategory;AL| 'NIL) + +(DEFUN |PolynomialCategory| (&REST #0=#:G1406 &AUX #1=#:G1404) + (DSETQ #1# #0#) + (LET (#2=#:G1405) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) |PolynomialCategory;AL|)) + (CDR #2#)) + (T (SETQ |PolynomialCategory;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY #'|PolynomialCategory;| #1#))) + |PolynomialCategory;AL|)) + #2#)))) + +(DEFUN |PolynomialCategory;| (|t#1| |t#2| |t#3|) + (PROG (#0=#:G1403) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2| |t#3|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|) + (|devaluate| |t#3|))) + (COND + (|PolynomialCategory;CAT|) + ('T + (LETT |PolynomialCategory;CAT| + (|Join| (|PartialDifferentialRing| + '|t#3|) + (|FiniteAbelianMonoidRing| + '|t#1| '|t#2|) + (|Evalable| '$) + (|InnerEvalable| '|t#3| '|t#1|) + (|InnerEvalable| '|t#3| '$) + (|RetractableTo| '|t#3|) + (|FullyLinearlyExplicitRingOver| + '|t#1|) + (|mkCategory| '|domain| + '(((|degree| + ((|NonNegativeInteger|) $ + |t#3|)) + T) + ((|degree| + ((|List| + (|NonNegativeInteger|)) + $ (|List| |t#3|))) + T) + ((|coefficient| + ($ $ |t#3| + (|NonNegativeInteger|))) + T) + ((|coefficient| + ($ $ (|List| |t#3|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|monomials| + ((|List| $) $)) + T) + ((|univariate| + ((|SparseUnivariatePolynomial| + $) + $ |t#3|)) + T) + ((|univariate| + ((|SparseUnivariatePolynomial| + |t#1|) + $)) + T) + ((|mainVariable| + ((|Union| |t#3| "failed") + $)) + T) + ((|minimumDegree| + ((|NonNegativeInteger|) $ + |t#3|)) + T) + ((|minimumDegree| + ((|List| + (|NonNegativeInteger|)) + $ (|List| |t#3|))) + T) + ((|monicDivide| + ((|Record| + (|:| |quotient| $) + (|:| |remainder| $)) + $ $ |t#3|)) + T) + ((|monomial| + ($ $ |t#3| + (|NonNegativeInteger|))) + T) + ((|monomial| + ($ $ (|List| |t#3|) + (|List| + (|NonNegativeInteger|)))) + T) + ((|multivariate| + ($ + (|SparseUnivariatePolynomial| + |t#1|) + |t#3|)) + T) + ((|multivariate| + ($ + (|SparseUnivariatePolynomial| + $) + |t#3|)) + T) + ((|isPlus| + ((|Union| (|List| $) + "failed") + $)) + T) + ((|isTimes| + ((|Union| (|List| $) + "failed") + $)) + T) + ((|isExpt| + ((|Union| + (|Record| + (|:| |var| |t#3|) + (|:| |exponent| + (|NonNegativeInteger|))) + "failed") + $)) + T) + ((|totalDegree| + ((|NonNegativeInteger|) $)) + T) + ((|totalDegree| + ((|NonNegativeInteger|) $ + (|List| |t#3|))) + T) + ((|variables| + ((|List| |t#3|) $)) + T) + ((|primitiveMonomials| + ((|List| $) $)) + T) + ((|resultant| ($ $ $ |t#3|)) + (|has| |t#1| + (|CommutativeRing|))) + ((|discriminant| + ($ $ |t#3|)) + (|has| |t#1| + (|CommutativeRing|))) + ((|content| ($ $ |t#3|)) + (|has| |t#1| (|GcdDomain|))) + ((|primitivePart| ($ $)) + (|has| |t#1| (|GcdDomain|))) + ((|primitivePart| + ($ $ |t#3|)) + (|has| |t#1| (|GcdDomain|))) + ((|squareFree| + ((|Factored| $) $)) + (|has| |t#1| (|GcdDomain|))) + ((|squareFreePart| ($ $)) + (|has| |t#1| (|GcdDomain|)))) + '(((|OrderedSet|) + (|has| |t#1| + (|OrderedSet|))) + ((|ConvertibleTo| + (|InputForm|)) + (AND + (|has| |t#3| + (|ConvertibleTo| + (|InputForm|))) + (|has| |t#1| + (|ConvertibleTo| + (|InputForm|))))) + ((|ConvertibleTo| + (|Pattern| (|Integer|))) + (AND + (|has| |t#3| + (|ConvertibleTo| + (|Pattern| (|Integer|)))) + (|has| |t#1| + (|ConvertibleTo| + (|Pattern| (|Integer|)))))) + ((|ConvertibleTo| + (|Pattern| (|Float|))) + (AND + (|has| |t#3| + (|ConvertibleTo| + (|Pattern| (|Float|)))) + (|has| |t#1| + (|ConvertibleTo| + (|Pattern| (|Float|)))))) + ((|PatternMatchable| + (|Integer|)) + (AND + (|has| |t#3| + (|PatternMatchable| + (|Integer|))) + (|has| |t#1| + (|PatternMatchable| + (|Integer|))))) + ((|PatternMatchable| + (|Float|)) + (AND + (|has| |t#3| + (|PatternMatchable| + (|Float|))) + (|has| |t#1| + (|PatternMatchable| + (|Float|))))) + ((|GcdDomain|) + (|has| |t#1| (|GcdDomain|))) + (|canonicalUnitNormal| + (|has| |t#1| + (ATTRIBUTE + |canonicalUnitNormal|))) + ((|PolynomialFactorizationExplicit|) + (|has| |t#1| + (|PolynomialFactorizationExplicit|)))) + '((|Factored| $) (|List| $) + (|List| |t#3|) + (|NonNegativeInteger|) + (|SparseUnivariatePolynomial| + $) + (|SparseUnivariatePolynomial| + |t#1|) + (|List| + (|NonNegativeInteger|))) + NIL)) + . #1=(|PolynomialCategory|))))) . #1#) + (SETELT #0# 0 + (LIST '|PolynomialCategory| (|devaluate| |t#1|) + (|devaluate| |t#2|) (|devaluate| |t#3|))))))) diff --git a/src/algebra/strap/PRIMARR.lsp b/src/algebra/strap/PRIMARR.lsp new file mode 100644 index 00000000..a8f4f9a7 --- /dev/null +++ b/src/algebra/strap/PRIMARR.lsp @@ -0,0 +1,193 @@ + +(/VERSIONCHECK 2) + +(PUT '|PRIMARR;#;$Nni;1| '|SPADreplace| '|sizeOfSimpleArray|) + +(DEFUN |PRIMARR;#;$Nni;1| (|x| $) (|sizeOfSimpleArray| |x|)) + +(PUT '|PRIMARR;minIndex;$I;2| '|SPADreplace| '(XLAM (|x|) 0)) + +(DEFUN |PRIMARR;minIndex;$I;2| (|x| $) 0) + +(DEFUN |PRIMARR;empty;$;3| ($) + (|makeSimpleArray| (|getVMType| (|getShellEntry| $ 6)) 0)) + +(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| $) + (|makeFilledSimpleArray| (|getVMType| (|getShellEntry| $ 6)) |n| |x|)) + +(PUT '|PRIMARR;qelt;$IS;5| '|SPADreplace| '|getSimpleArrayEntry|) + +(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| $) + (|getSimpleArrayEntry| |x| |i|)) + +(PUT '|PRIMARR;elt;$IS;6| '|SPADreplace| '|getSimpleArrayEntry|) + +(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| $) + (|getSimpleArrayEntry| |x| |i|)) + +(PUT '|PRIMARR;qsetelt!;$I2S;7| '|SPADreplace| '|setSimpleArrayEntry|) + +(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| $) + (|setSimpleArrayEntry| |x| |i| |s|)) + +(PUT '|PRIMARR;setelt;$I2S;8| '|SPADreplace| '|setSimpleArrayEntry|) + +(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| $) + (|setSimpleArrayEntry| |x| |i| |s|)) + +(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| $) + (PROG (|i| #0=#:G1403) + (RETURN + (SEQ (SEQ (LETT |i| 0 |PRIMARR;fill!;$S$;9|) + (LETT #0# (|maxIndexOfSimpleArray| |x|) + |PRIMARR;fill!;$S$;9|) + G190 (COND ((QSGREATERP |i| #0#) (GO G191))) + (SEQ (EXIT (|setSimpleArrayEntry| |x| |i| |s|))) + (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) (GO G190) + G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |PrimitiveArray| (#0=#:G1411) + (PROG () + (RETURN + (PROG (#1=#:G1412) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|PrimitiveArray|) + '|domainEqualList|) + |PrimitiveArray|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|PrimitiveArray;| #0#) + (LETT #1# T |PrimitiveArray|)) + (COND + ((NOT #1#) + (HREM |$ConstructorCache| '|PrimitiveArray|))))))))))) + +(DEFUN |PrimitiveArray;| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|PrimitiveArray|)) + (LETT |dv$| (LIST '|PrimitiveArray| |dv$1|) . #0#) + (LETT $ (|newShell| 35) . #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|)) + (AND (|HasCategory| |#1| '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|haddProp| |$ConstructorCache| '|PrimitiveArray| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|PrimitiveArray| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) |PRIMARR;#;$Nni;1| (|Integer|) + |PRIMARR;minIndex;$I;2| |PRIMARR;empty;$;3| + |PRIMARR;new;NniS$;4| |PRIMARR;qelt;$IS;5| + |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7| + |PRIMARR;setelt;$I2S;8| |PRIMARR;fill!;$S$;9| + (|Mapping| 6 6 6) (|Boolean|) (|List| 6) (|Equation| 6) + (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6) + (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6) + (|OutputForm|) (|InputForm|) (|String|) (|SingleInteger|) + (|List| $) (|Union| 6 '"failed") (|List| 9)) + '#(~= 0 |swap!| 6 |sorted?| 13 |sort!| 24 |sort| 35 |size?| + 46 |setelt| 52 |select| 66 |sample| 72 |reverse!| 76 + |reverse| 81 |removeDuplicates| 86 |remove| 91 |reduce| + 103 |qsetelt!| 124 |qelt| 131 |position| 137 |parts| 156 + |new| 161 |more?| 167 |minIndex| 173 |min| 178 |merge| 184 + |members| 197 |member?| 202 |maxIndex| 208 |max| 213 + |map!| 219 |map| 225 |less?| 238 |latex| 244 |insert| 249 + |indices| 263 |index?| 268 |hash| 274 |first| 279 |find| + 284 |fill!| 290 |every?| 296 |eval| 302 |eq?| 328 |entry?| + 334 |entries| 340 |empty?| 345 |empty| 350 |elt| 354 + |delete| 373 |count| 385 |copyInto!| 397 |copy| 404 + |convert| 409 |construct| 414 |concat| 419 |coerce| 442 + |any?| 447 >= 453 > 459 = 465 <= 471 < 477 |#| 483) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 5 + '(0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) + (CONS '#(|OneDimensionalArrayAggregate&| + |FiniteLinearAggregate&| |LinearAggregate&| + |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| + |Aggregate&| |EltableAggregate&| |Evalable&| + |SetCategory&| NIL NIL |InnerEvalable&| NIL + NIL |BasicType&|) + (CONS '#((|OneDimensionalArrayAggregate| 6) + (|FiniteLinearAggregate| 6) + (|LinearAggregate| 6) + (|IndexedAggregate| 9 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 9 6) (|Evalable| 6) + (|SetCategory|) (|Type|) (|Eltable| 9 6) + (|InnerEvalable| 6 6) (|CoercibleTo| 28) + (|ConvertibleTo| 29) (|BasicType|)) + (|makeByteWordVec2| 34 + '(2 7 19 0 0 1 3 0 26 0 9 9 1 1 5 19 0 + 1 2 0 19 24 0 1 1 5 0 0 1 2 0 0 24 0 + 1 1 5 0 0 1 2 0 0 24 0 1 2 0 19 0 7 1 + 3 0 6 0 25 6 1 3 0 6 0 9 6 16 2 0 0 + 23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 + 7 0 0 1 2 7 0 6 0 1 2 0 0 23 0 1 4 7 + 6 18 0 6 6 1 3 0 6 18 0 6 1 2 0 6 18 + 0 1 3 0 6 0 9 6 15 2 0 6 0 9 13 2 7 9 + 6 0 1 3 7 9 6 0 9 1 2 0 9 23 0 1 1 0 + 20 0 1 2 0 0 7 6 12 2 0 19 0 7 1 1 6 + 9 0 10 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0 + 24 0 0 1 1 0 20 0 1 2 7 19 6 0 1 1 6 + 9 0 1 2 5 0 0 0 1 2 0 0 27 0 1 3 0 0 + 18 0 0 1 2 0 0 27 0 1 2 0 19 0 7 1 1 + 7 30 0 1 3 0 0 0 0 9 1 3 0 0 6 0 9 1 + 1 0 34 0 1 2 0 19 9 0 1 1 7 31 0 1 1 + 6 6 0 1 2 0 33 23 0 1 2 0 0 0 6 17 2 + 0 19 23 0 1 3 8 0 0 20 20 1 2 8 0 0 + 21 1 3 8 0 0 6 6 1 2 8 0 0 22 1 2 0 + 19 0 0 1 2 7 19 6 0 1 1 0 20 0 1 1 0 + 19 0 1 0 0 0 11 2 0 0 0 25 1 2 0 6 0 + 9 14 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0 + 0 25 1 2 7 7 6 0 1 2 0 7 23 0 1 3 0 0 + 0 0 9 1 1 0 0 0 1 1 3 29 0 1 1 0 0 20 + 1 1 0 0 32 1 2 0 0 6 0 1 2 0 0 0 0 1 + 2 0 0 0 6 1 1 9 28 0 1 2 0 19 23 0 1 + 2 5 19 0 0 1 2 5 19 0 0 1 2 7 19 0 0 + 1 2 5 19 0 0 1 2 5 19 0 0 1 1 0 7 0 + 8))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/PSETCAT-.lsp b/src/algebra/strap/PSETCAT-.lsp new file mode 100644 index 00000000..3e22b5d1 --- /dev/null +++ b/src/algebra/strap/PSETCAT-.lsp @@ -0,0 +1,885 @@ + +(/VERSIONCHECK 2) + +(DEFUN |PSETCAT-;elements| (|ps| $) + (PROG (|lp|) + (RETURN + (LETT |lp| (SPADCALL |ps| (|getShellEntry| $ 12)) + |PSETCAT-;elements|)))) + +(DEFUN |PSETCAT-;variables1| (|lp| $) + (PROG (#0=#:G1435 |p| #1=#:G1436 |lvars|) + (RETURN + (SEQ (LETT |lvars| + (PROGN + (LETT #0# NIL |PSETCAT-;variables1|) + (SEQ (LETT |p| NIL |PSETCAT-;variables1|) + (LETT #1# |lp| |PSETCAT-;variables1|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |PSETCAT-;variables1|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 14)) + #0#) + |PSETCAT-;variables1|))) + (LETT #1# (CDR #1#) |PSETCAT-;variables1|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |PSETCAT-;variables1|) + (EXIT (SPADCALL (CONS #'|PSETCAT-;variables1!0| $) + (SPADCALL + (SPADCALL |lvars| (|getShellEntry| $ 18)) + (|getShellEntry| $ 19)) + (|getShellEntry| $ 21))))))) + +(DEFUN |PSETCAT-;variables1!0| (|#1| |#2| $) + (SPADCALL |#2| |#1| (|getShellEntry| $ 16))) + +(DEFUN |PSETCAT-;variables2| (|lp| $) + (PROG (#0=#:G1440 |p| #1=#:G1441 |lvars|) + (RETURN + (SEQ (LETT |lvars| + (PROGN + (LETT #0# NIL |PSETCAT-;variables2|) + (SEQ (LETT |p| NIL |PSETCAT-;variables2|) + (LETT #1# |lp| |PSETCAT-;variables2|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |PSETCAT-;variables2|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 22)) + #0#) + |PSETCAT-;variables2|))) + (LETT #1# (CDR #1#) |PSETCAT-;variables2|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + |PSETCAT-;variables2|) + (EXIT (SPADCALL (CONS #'|PSETCAT-;variables2!0| $) + (SPADCALL |lvars| (|getShellEntry| $ 19)) + (|getShellEntry| $ 21))))))) + +(DEFUN |PSETCAT-;variables2!0| (|#1| |#2| $) + (SPADCALL |#2| |#1| (|getShellEntry| $ 16))) + +(DEFUN |PSETCAT-;variables;SL;4| (|ps| $) + (|PSETCAT-;variables1| (|PSETCAT-;elements| |ps| $) $)) + +(DEFUN |PSETCAT-;mainVariables;SL;5| (|ps| $) + (|PSETCAT-;variables2| + (SPADCALL (ELT $ 24) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + $)) + +(DEFUN |PSETCAT-;mainVariable?;VarSetSB;6| (|v| |ps| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 24) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + |PSETCAT-;mainVariable?;VarSetSB;6|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 28)) + (|getShellEntry| $ 29))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |PSETCAT-;mainVariable?;VarSetSB;6|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))))))) + +(DEFUN |PSETCAT-;collectUnder;SVarSetS;7| (|ps| |v| $) + (PROG (|p| |lp| |lq|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;collectUnder;SVarSetS;7|) + (LETT |lq| NIL |PSETCAT-;collectUnder;SVarSetS;7|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;collectUnder;SVarSetS;7|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;collectUnder;SVarSetS;7|) + (EXIT (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 24)) + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 16))) + (LETT |lq| (CONS |p| |lq|) + |PSETCAT-;collectUnder;SVarSetS;7|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) + +(DEFUN |PSETCAT-;collectUpper;SVarSetS;8| (|ps| |v| $) + (PROG (|p| |lp| |lq|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;collectUpper;SVarSetS;8|) + (LETT |lq| NIL |PSETCAT-;collectUpper;SVarSetS;8|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;collectUpper;SVarSetS;8|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;collectUpper;SVarSetS;8|) + (EXIT (COND + ((NULL (SPADCALL |p| + (|getShellEntry| $ 24))) + (COND + ((SPADCALL |v| + (SPADCALL |p| + (|getShellEntry| $ 22)) + (|getShellEntry| $ 16)) + (LETT |lq| (CONS |p| |lq|) + |PSETCAT-;collectUpper;SVarSetS;8|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) + +(DEFUN |PSETCAT-;collect;SVarSetS;9| (|ps| |v| $) + (PROG (|p| |lp| |lq|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;collect;SVarSetS;9|) + (LETT |lq| NIL |PSETCAT-;collect;SVarSetS;9|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;collect;SVarSetS;9|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;collect;SVarSetS;9|) + (EXIT (COND + ((NULL (SPADCALL |p| + (|getShellEntry| $ 24))) + (COND + ((SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 28)) + (LETT |lq| (CONS |p| |lq|) + |PSETCAT-;collect;SVarSetS;9|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lq| (|getShellEntry| $ 31))))))) + +(DEFUN |PSETCAT-;sort;SVarSetR;10| (|ps| |v| $) + (PROG (|p| |lp| |us| |vs| |ws|) + (RETURN + (SEQ (LETT |lp| (|PSETCAT-;elements| |ps| $) + |PSETCAT-;sort;SVarSetR;10|) + (LETT |us| NIL |PSETCAT-;sort;SVarSetR;10|) + (LETT |vs| NIL |PSETCAT-;sort;SVarSetR;10|) + (LETT |ws| NIL |PSETCAT-;sort;SVarSetR;10|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;sort;SVarSetR;10|) + (LETT |lp| (CDR |lp|) |PSETCAT-;sort;SVarSetR;10|) + (EXIT (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 24)) + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 16))) + (LETT |us| (CONS |p| |us|) + |PSETCAT-;sort;SVarSetR;10|)) + ((SPADCALL + (SPADCALL |p| (|getShellEntry| $ 22)) + |v| (|getShellEntry| $ 28)) + (LETT |vs| (CONS |p| |vs|) + |PSETCAT-;sort;SVarSetR;10|)) + ('T + (LETT |ws| (CONS |p| |ws|) + |PSETCAT-;sort;SVarSetR;10|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (VECTOR (SPADCALL |us| (|getShellEntry| $ 31)) + (SPADCALL |vs| (|getShellEntry| $ 31)) + (SPADCALL |ws| (|getShellEntry| $ 31)))))))) + +(DEFUN |PSETCAT-;=;2SB;11| (|ps1| |ps2| $) + (PROG (#0=#:G1475 #1=#:G1476 #2=#:G1477 |p| #3=#:G1478) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (PROGN + (LETT #0# NIL |PSETCAT-;=;2SB;11|) + (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) + (LETT #1# (|PSETCAT-;elements| |ps1| $) + |PSETCAT-;=;2SB;11|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |PSETCAT-;=;2SB;11|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# (CONS |p| #0#) + |PSETCAT-;=;2SB;11|))) + (LETT #1# (CDR #1#) |PSETCAT-;=;2SB;11|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 38)) + (SPADCALL + (PROGN + (LETT #2# NIL |PSETCAT-;=;2SB;11|) + (SEQ (LETT |p| NIL |PSETCAT-;=;2SB;11|) + (LETT #3# (|PSETCAT-;elements| |ps2| $) + |PSETCAT-;=;2SB;11|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |p| (CAR #3#) + |PSETCAT-;=;2SB;11|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #2# (CONS |p| #2#) + |PSETCAT-;=;2SB;11|))) + (LETT #3# (CDR #3#) |PSETCAT-;=;2SB;11|) + (GO G190) G191 (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 39)))))) + +(DEFUN |PSETCAT-;localInf?| (|p| |q| $) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 41)) + (SPADCALL |q| (|getShellEntry| $ 41)) (|getShellEntry| $ 42))) + +(DEFUN |PSETCAT-;localTriangular?| (|lp| $) + (PROG (|q| |p|) + (RETURN + (SEQ (LETT |lp| (SPADCALL (ELT $ 43) |lp| (|getShellEntry| $ 26)) + |PSETCAT-;localTriangular?|) + (EXIT (COND + ((NULL |lp|) 'T) + ((SPADCALL (ELT $ 24) |lp| (|getShellEntry| $ 44)) + 'NIL) + ('T + (SEQ (LETT |lp| + (SPADCALL + (CONS + #'|PSETCAT-;localTriangular?!0| $) + |lp| (|getShellEntry| $ 46)) + |PSETCAT-;localTriangular?|) + (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;localTriangular?|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;localTriangular?|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (LETT |q| + (|SPADfirst| |lp|) + |PSETCAT-;localTriangular?|) + (|getShellEntry| $ 22)) + (SPADCALL |p| + (|getShellEntry| $ 22)) + (|getShellEntry| $ 16))))) + (GO G191))) + (SEQ (LETT |p| |q| + |PSETCAT-;localTriangular?|) + (EXIT + (LETT |lp| (CDR |lp|) + |PSETCAT-;localTriangular?|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NULL |lp|)))))))))) + +(DEFUN |PSETCAT-;localTriangular?!0| (|#1| |#2| $) + (SPADCALL (SPADCALL |#2| (|getShellEntry| $ 22)) + (SPADCALL |#1| (|getShellEntry| $ 22)) (|getShellEntry| $ 16))) + +(DEFUN |PSETCAT-;triangular?;SB;14| (|ps| $) + (|PSETCAT-;localTriangular?| (|PSETCAT-;elements| |ps| $) $)) + +(DEFUN |PSETCAT-;trivialIdeal?;SB;15| (|ps| $) + (NULL (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)))) + +(DEFUN |PSETCAT-;roughUnitIdeal?;SB;16| (|ps| $) + (SPADCALL (ELT $ 24) + (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + (|getShellEntry| $ 44))) + +(DEFUN |PSETCAT-;relativelyPrimeLeadingMonomials?| (|p| |q| $) + (PROG (|dp| |dq|) + (RETURN + (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 41)) + |PSETCAT-;relativelyPrimeLeadingMonomials?|) + (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 41)) + |PSETCAT-;relativelyPrimeLeadingMonomials?|) + (EXIT (SPADCALL (SPADCALL |dp| |dq| (|getShellEntry| $ 50)) + (SPADCALL |dp| |dq| (|getShellEntry| $ 51)) + (|getShellEntry| $ 52))))))) + +(DEFUN |PSETCAT-;roughBase?;SB;18| (|ps| $) + (PROG (|p| |lp| |rB?| |copylp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + |PSETCAT-;roughBase?;SB;18|) + (EXIT (COND + ((NULL |lp|) 'T) + ('T + (SEQ (LETT |rB?| 'T |PSETCAT-;roughBase?;SB;18|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T |rB?|))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |PSETCAT-;roughBase?;SB;18|) + (LETT |lp| (CDR |lp|) + |PSETCAT-;roughBase?;SB;18|) + (LETT |copylp| |lp| + |PSETCAT-;roughBase?;SB;18|) + (EXIT + (SEQ G190 + (COND + ((NULL + (COND + ((NULL |copylp|) 'NIL) + ('T |rB?|))) + (GO G191))) + (SEQ + (LETT |rB?| + (|PSETCAT-;relativelyPrimeLeadingMonomials?| + |p| (|SPADfirst| |copylp|) $) + |PSETCAT-;roughBase?;SB;18|) + (EXIT + (LETT |copylp| (CDR |copylp|) + |PSETCAT-;roughBase?;SB;18|))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |rB?|))))))))) + +(DEFUN |PSETCAT-;roughSubIdeal?;2SB;19| (|ps1| |ps2| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (|PSETCAT-;elements| |ps1| $) |ps2| + (|getShellEntry| $ 54)) + |PSETCAT-;roughSubIdeal?;2SB;19|) + (EXIT (NULL (SPADCALL (ELT $ 43) |lp| + (|getShellEntry| $ 26)))))))) + +(DEFUN |PSETCAT-;roughEqualIdeals?;2SB;20| (|ps1| |ps2| $) + (COND + ((SPADCALL |ps1| |ps2| (|getShellEntry| $ 56)) 'T) + ((SPADCALL |ps1| |ps2| (|getShellEntry| $ 57)) + (SPADCALL |ps2| |ps1| (|getShellEntry| $ 57))) + ('T 'NIL))) + +(DEFUN |PSETCAT-;exactQuo| (|r| |s| $) + (PROG (#0=#:G1510) + (RETURN + (COND + ((|HasCategory| (|getShellEntry| $ 7) '(|EuclideanDomain|)) + (SPADCALL |r| |s| (|getShellEntry| $ 59))) + ('T + (PROG2 (LETT #0# (SPADCALL |r| |s| (|getShellEntry| $ 61)) + |PSETCAT-;exactQuo|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 7) #0#))))))) + +(DEFUN |PSETCAT-;headRemainder;PSR;22| (|a| |ps| $) + (PROG (|lp1| |p| |e| |g| |#G45| |#G46| |lca| |lcp| |r| |lp2|) + (RETURN + (SEQ (LETT |lp1| + (SPADCALL (ELT $ 43) (|PSETCAT-;elements| |ps| $) + (|getShellEntry| $ 26)) + |PSETCAT-;headRemainder;PSR;22|) + (EXIT (COND + ((NULL |lp1|) (CONS |a| (|spadConstant| $ 62))) + ((SPADCALL (ELT $ 24) |lp1| (|getShellEntry| $ 44)) + (CONS (SPADCALL |a| (|getShellEntry| $ 63)) + (|spadConstant| $ 62))) + ('T + (SEQ (LETT |r| (|spadConstant| $ 62) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lp1| + (SPADCALL + (CONS + (|function| |PSETCAT-;localInf?|) + $) + (REVERSE + (|PSETCAT-;elements| |ps| $)) + (|getShellEntry| $ 46)) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lp2| |lp1| + |PSETCAT-;headRemainder;PSR;22|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |a| + (|getShellEntry| $ 43)) + 'NIL) + ('T + (SPADCALL (NULL |lp2|) + (|getShellEntry| $ 29))))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp2|) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |e| + (SPADCALL + (SPADCALL |a| + (|getShellEntry| $ 41)) + (SPADCALL |p| + (|getShellEntry| $ 41)) + (|getShellEntry| $ 64)) + |PSETCAT-;headRemainder;PSR;22|) + (EXIT + (COND + ((QEQCAR |e| 0) + (SEQ + (LETT |g| + (SPADCALL + (LETT |lca| + (SPADCALL |a| + (|getShellEntry| $ 65)) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lcp| + (SPADCALL |p| + (|getShellEntry| $ 65)) + |PSETCAT-;headRemainder;PSR;22|) + (|getShellEntry| $ 66)) + |PSETCAT-;headRemainder;PSR;22|) + (PROGN + (LETT |#G45| + (|PSETCAT-;exactQuo| |lca| + |g| $) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |#G46| + (|PSETCAT-;exactQuo| |lcp| + |g| $) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lca| |#G45| + |PSETCAT-;headRemainder;PSR;22|) + (LETT |lcp| |#G46| + |PSETCAT-;headRemainder;PSR;22|)) + (LETT |a| + (SPADCALL + (SPADCALL |lcp| + (SPADCALL |a| + (|getShellEntry| $ 63)) + (|getShellEntry| $ 67)) + (SPADCALL + (SPADCALL |lca| (QCDR |e|) + (|getShellEntry| $ 68)) + (SPADCALL |p| + (|getShellEntry| $ 63)) + (|getShellEntry| $ 69)) + (|getShellEntry| $ 70)) + |PSETCAT-;headRemainder;PSR;22|) + (LETT |r| + (SPADCALL |r| |lcp| + (|getShellEntry| $ 71)) + |PSETCAT-;headRemainder;PSR;22|) + (EXIT + (LETT |lp2| |lp1| + |PSETCAT-;headRemainder;PSR;22|)))) + ('T + (LETT |lp2| (CDR |lp2|) + |PSETCAT-;headRemainder;PSR;22|))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |a| |r|)))))))))) + +(DEFUN |PSETCAT-;makeIrreducible!| (|frac| $) + (PROG (|g|) + (RETURN + (SEQ (LETT |g| + (SPADCALL (QCDR |frac|) (QCAR |frac|) + (|getShellEntry| $ 74)) + |PSETCAT-;makeIrreducible!|) + (EXIT (COND + ((SPADCALL |g| (|spadConstant| $ 62) + (|getShellEntry| $ 76)) + |frac|) + ('T + (SEQ (PROGN + (RPLACA |frac| + (SPADCALL (QCAR |frac|) |g| + (|getShellEntry| $ 77))) + (QCAR |frac|)) + (PROGN + (RPLACD |frac| + (|PSETCAT-;exactQuo| (QCDR |frac|) + |g| $)) + (QCDR |frac|)) + (EXIT |frac|))))))))) + +(DEFUN |PSETCAT-;remainder;PSR;24| (|a| |ps| $) + (PROG (|hRa| |r| |lca| |g| |b| |c|) + (RETURN + (SEQ (LETT |hRa| + (|PSETCAT-;makeIrreducible!| + (SPADCALL |a| |ps| (|getShellEntry| $ 78)) $) + |PSETCAT-;remainder;PSR;24|) + (LETT |a| (QCAR |hRa|) |PSETCAT-;remainder;PSR;24|) + (LETT |r| (QCDR |hRa|) |PSETCAT-;remainder;PSR;24|) + (EXIT (COND + ((SPADCALL |a| (|getShellEntry| $ 43)) + (VECTOR (|spadConstant| $ 62) |a| |r|)) + ('T + (SEQ (LETT |b| + (SPADCALL (|spadConstant| $ 62) + (SPADCALL |a| + (|getShellEntry| $ 41)) + (|getShellEntry| $ 68)) + |PSETCAT-;remainder;PSR;24|) + (LETT |c| + (SPADCALL |a| (|getShellEntry| $ 65)) + |PSETCAT-;remainder;PSR;24|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL + (LETT |a| + (SPADCALL |a| + (|getShellEntry| $ 63)) + |PSETCAT-;remainder;PSR;24|) + (|getShellEntry| $ 43)) + (|getShellEntry| $ 29))) + (GO G191))) + (SEQ (LETT |hRa| + (|PSETCAT-;makeIrreducible!| + (SPADCALL |a| |ps| + (|getShellEntry| $ 78)) + $) + |PSETCAT-;remainder;PSR;24|) + (LETT |a| (QCAR |hRa|) + |PSETCAT-;remainder;PSR;24|) + (LETT |r| + (SPADCALL |r| (QCDR |hRa|) + (|getShellEntry| $ 71)) + |PSETCAT-;remainder;PSR;24|) + (LETT |g| + (SPADCALL |c| + (LETT |lca| + (SPADCALL |a| + (|getShellEntry| $ 65)) + |PSETCAT-;remainder;PSR;24|) + (|getShellEntry| $ 66)) + |PSETCAT-;remainder;PSR;24|) + (LETT |b| + (SPADCALL + (SPADCALL + (SPADCALL (QCDR |hRa|) + (|PSETCAT-;exactQuo| |c| |g| $) + (|getShellEntry| $ 71)) + |b| (|getShellEntry| $ 67)) + (SPADCALL + (|PSETCAT-;exactQuo| |lca| |g| $) + (SPADCALL |a| + (|getShellEntry| $ 41)) + (|getShellEntry| $ 68)) + (|getShellEntry| $ 79)) + |PSETCAT-;remainder;PSR;24|) + (EXIT + (LETT |c| |g| + |PSETCAT-;remainder;PSR;24|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (VECTOR |c| |b| |r|)))))))))) + +(DEFUN |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25| (|ps| |cs| $) + (PROG (|p| |rs|) + (RETURN + (SEQ (COND + ((SPADCALL |cs| (|getShellEntry| $ 82)) |ps|) + ((SPADCALL |cs| (|getShellEntry| $ 83)) + (LIST (|spadConstant| $ 84))) + ('T + (SEQ (LETT |ps| + (SPADCALL (ELT $ 43) |ps| + (|getShellEntry| $ 26)) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (EXIT (COND + ((NULL |ps|) |ps|) + ((SPADCALL (ELT $ 24) |ps| + (|getShellEntry| $ 44)) + (LIST (|spadConstant| $ 75))) + ('T + (SEQ (LETT |rs| NIL + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (NULL |ps|) + (|getShellEntry| $ 29))) + (GO G191))) + (SEQ + (LETT |p| (|SPADfirst| |ps|) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (LETT |ps| (CDR |ps|) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (LETT |p| + (QCAR + (SPADCALL |p| |cs| + (|getShellEntry| $ 78))) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (EXIT + (COND + ((NULL + (SPADCALL |p| + (|getShellEntry| $ 43))) + (COND + ((SPADCALL |p| + (|getShellEntry| $ 24)) + (SEQ + (LETT |ps| NIL + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + (EXIT + (LETT |rs| + (LIST + (|spadConstant| $ 75)) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|)))) + ('T + (SEQ + (SPADCALL |p| + (|getShellEntry| $ 85)) + (EXIT + (LETT |rs| + (CONS |p| |rs|) + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|))))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |rs| + (|getShellEntry| $ 86)))))))))))))) + +(DEFUN |PSETCAT-;rewriteIdealWithRemainder;LSL;26| (|ps| |cs| $) + (PROG (|p| |rs|) + (RETURN + (SEQ (COND + ((SPADCALL |cs| (|getShellEntry| $ 82)) |ps|) + ((SPADCALL |cs| (|getShellEntry| $ 83)) + (LIST (|spadConstant| $ 84))) + ('T + (SEQ (LETT |ps| + (SPADCALL (ELT $ 43) |ps| + (|getShellEntry| $ 26)) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (EXIT (COND + ((NULL |ps|) |ps|) + ((SPADCALL (ELT $ 24) |ps| + (|getShellEntry| $ 44)) + (LIST (|spadConstant| $ 75))) + ('T + (SEQ (LETT |rs| NIL + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (NULL |ps|) + (|getShellEntry| $ 29))) + (GO G191))) + (SEQ + (LETT |p| (|SPADfirst| |ps|) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (LETT |ps| (CDR |ps|) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (LETT |p| + (QVELT + (SPADCALL |p| |cs| + (|getShellEntry| $ 88)) + 1) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (EXIT + (COND + ((NULL + (SPADCALL |p| + (|getShellEntry| $ 43))) + (COND + ((SPADCALL |p| + (|getShellEntry| $ 24)) + (SEQ + (LETT |ps| NIL + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + (EXIT + (LETT |rs| + (LIST + (|spadConstant| $ 75)) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|)))) + ('T + (LETT |rs| + (CONS + (SPADCALL |p| + (|getShellEntry| $ 89)) + |rs|) + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |rs| + (|getShellEntry| $ 86)))))))))))))) + +(DEFUN |PolynomialSetCategory&| (|#1| |#2| |#3| |#4| |#5|) + (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$5| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|PolynomialSetCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$3| (|devaluate| |#3|) . #0#) + (LETT |dv$4| (|devaluate| |#4|) . #0#) + (LETT |dv$5| (|devaluate| |#5|) . #0#) + (LETT |dv$| + (LIST '|PolynomialSetCategory&| |dv$1| |dv$2| |dv$3| + |dv$4| |dv$5|) . #0#) + (LETT $ (|newShell| 91) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| '(|IntegralDomain|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (|setShellEntry| $ 8 |#3|) + (|setShellEntry| $ 9 |#4|) + (|setShellEntry| $ 10 |#5|) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (|setShellEntry| $ 49 + (CONS (|dispatchFunction| + |PSETCAT-;roughUnitIdeal?;SB;16|) + $)) + (|setShellEntry| $ 53 + (CONS (|dispatchFunction| |PSETCAT-;roughBase?;SB;18|) + $)) + (|setShellEntry| $ 55 + (CONS (|dispatchFunction| + |PSETCAT-;roughSubIdeal?;2SB;19|) + $)) + (|setShellEntry| $ 58 + (CONS (|dispatchFunction| + |PSETCAT-;roughEqualIdeals?;2SB;20|) + $))))) + (COND + ((|HasCategory| |#2| '(|GcdDomain|)) + (COND + ((|HasCategory| |#4| '(|ConvertibleTo| (|Symbol|))) + (PROGN + (|setShellEntry| $ 73 + (CONS (|dispatchFunction| + |PSETCAT-;headRemainder;PSR;22|) + $)) + (|setShellEntry| $ 81 + (CONS (|dispatchFunction| + |PSETCAT-;remainder;PSR;24|) + $)) + (|setShellEntry| $ 87 + (CONS (|dispatchFunction| + |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|) + $)) + (|setShellEntry| $ 90 + (CONS (|dispatchFunction| + |PSETCAT-;rewriteIdealWithRemainder;LSL;26|) + $))))))) + $)))) + +(MAKEPROP '|PolynomialSetCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|local| |#3|) (|local| |#4|) (|local| |#5|) (|List| 10) + (0 . |members|) (|List| 9) (5 . |variables|) (|Boolean|) + (10 . <) (|List| $) (16 . |concat|) + (21 . |removeDuplicates|) (|Mapping| 15 9 9) (26 . |sort|) + (32 . |mvar|) |PSETCAT-;variables;SL;4| (37 . |ground?|) + (|Mapping| 15 10) (42 . |remove|) + |PSETCAT-;mainVariables;SL;5| (48 . =) (54 . |not|) + |PSETCAT-;mainVariable?;VarSetSB;6| (59 . |construct|) + |PSETCAT-;collectUnder;SVarSetS;7| + |PSETCAT-;collectUpper;SVarSetS;8| + |PSETCAT-;collect;SVarSetS;9| + (|Record| (|:| |under| $) (|:| |floor| $) (|:| |upper| $)) + |PSETCAT-;sort;SVarSetR;10| (|Set| 10) (64 . |brace|) + (69 . =) |PSETCAT-;=;2SB;11| (75 . |degree|) (80 . <) + (86 . |zero?|) (91 . |any?|) (|Mapping| 15 10 10) + (97 . |sort|) |PSETCAT-;triangular?;SB;14| + |PSETCAT-;trivialIdeal?;SB;15| (103 . |roughUnitIdeal?|) + (108 . |sup|) (114 . +) (120 . =) (126 . |roughBase?|) + (131 . |rewriteIdealWithRemainder|) + (137 . |roughSubIdeal?|) (143 . =) + (149 . |roughSubIdeal?|) (155 . |roughEqualIdeals?|) + (161 . |quo|) (|Union| $ '"failed") (167 . |exquo|) + (173 . |One|) (177 . |reductum|) (182 . |subtractIfCan|) + (188 . |leadingCoefficient|) (193 . |gcd|) (199 . *) + (205 . |monomial|) (211 . *) (217 . -) (223 . *) + (|Record| (|:| |num| 10) (|:| |den| 7)) + (229 . |headRemainder|) (235 . |gcd|) (241 . |One|) + (245 . =) (251 . |exactQuotient!|) (257 . |headRemainder|) + (263 . +) + (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) + (269 . |remainder|) (275 . |trivialIdeal?|) + (280 . |roughUnitIdeal?|) (285 . |Zero|) + (289 . |primitivePart!|) (294 . |removeDuplicates|) + (299 . |rewriteIdealWithHeadRemainder|) + (305 . |remainder|) (311 . |unitCanonical|) + (316 . |rewriteIdealWithRemainder|)) + '#(|variables| 322 |trivialIdeal?| 327 |triangular?| 332 + |sort| 337 |roughUnitIdeal?| 343 |roughSubIdeal?| 348 + |roughEqualIdeals?| 354 |roughBase?| 360 + |rewriteIdealWithRemainder| 365 + |rewriteIdealWithHeadRemainder| 371 |remainder| 377 + |mainVariables| 383 |mainVariable?| 388 |headRemainder| + 394 |collectUpper| 400 |collectUnder| 406 |collect| 412 = + 418) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 90 + '(1 6 11 0 12 1 10 13 0 14 2 9 15 0 0 + 16 1 13 0 17 18 1 13 0 0 19 2 13 0 20 + 0 21 1 10 9 0 22 1 10 15 0 24 2 11 0 + 25 0 26 2 9 15 0 0 28 1 15 0 0 29 1 6 + 0 11 31 1 37 0 11 38 2 37 15 0 0 39 1 + 10 8 0 41 2 8 15 0 0 42 1 10 15 0 43 + 2 11 15 25 0 44 2 11 0 45 0 46 1 0 15 + 0 49 2 8 0 0 0 50 2 8 0 0 0 51 2 8 15 + 0 0 52 1 0 15 0 53 2 6 11 11 0 54 2 0 + 15 0 0 55 2 6 15 0 0 56 2 6 15 0 0 57 + 2 0 15 0 0 58 2 7 0 0 0 59 2 7 60 0 0 + 61 0 7 0 62 1 10 0 0 63 2 8 60 0 0 64 + 1 10 7 0 65 2 7 0 0 0 66 2 10 0 7 0 + 67 2 10 0 7 8 68 2 10 0 0 0 69 2 10 0 + 0 0 70 2 7 0 0 0 71 2 0 72 10 0 73 2 + 10 7 7 0 74 0 10 0 75 2 7 15 0 0 76 2 + 10 0 0 7 77 2 6 72 10 0 78 2 10 0 0 0 + 79 2 0 80 10 0 81 1 6 15 0 82 1 6 15 + 0 83 0 10 0 84 1 10 0 0 85 1 11 0 0 + 86 2 0 11 11 0 87 2 6 80 10 0 88 1 10 + 0 0 89 2 0 11 11 0 90 1 0 13 0 23 1 0 + 15 0 48 1 0 15 0 47 2 0 35 0 9 36 1 0 + 15 0 49 2 0 15 0 0 55 2 0 15 0 0 58 1 + 0 15 0 53 2 0 11 11 0 90 2 0 11 11 0 + 87 2 0 80 10 0 81 1 0 13 0 27 2 0 15 + 9 0 30 2 0 72 10 0 73 2 0 0 0 9 33 2 + 0 0 0 9 32 2 0 0 0 9 34 2 0 15 0 0 + 40))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/PSETCAT.lsp b/src/algebra/strap/PSETCAT.lsp new file mode 100644 index 00000000..e4a1f465 --- /dev/null +++ b/src/algebra/strap/PSETCAT.lsp @@ -0,0 +1,123 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |PolynomialSetCategory;CAT| 'NIL) + +(DEFPARAMETER |PolynomialSetCategory;AL| 'NIL) + +(DEFUN |PolynomialSetCategory| (&REST #0=#:G1422 &AUX #1=#:G1420) + (DSETQ #1# #0#) + (LET (#2=#:G1421) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) |PolynomialSetCategory;AL|)) + (CDR #2#)) + (T (SETQ |PolynomialSetCategory;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY #'|PolynomialSetCategory;| + #1#))) + |PolynomialSetCategory;AL|)) + #2#)))) + +(DEFUN |PolynomialSetCategory;| (|t#1| |t#2| |t#3| |t#4|) + (PROG (#0=#:G1419) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2| |t#3| |t#4|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|) + (|devaluate| |t#3|) + (|devaluate| |t#4|))) + (|sublisV| + (PAIR '(#1=#:G1418) (LIST '(|List| |t#4|))) + (COND + (|PolynomialSetCategory;CAT|) + ('T + (LETT |PolynomialSetCategory;CAT| + (|Join| (|SetCategory|) + (|Collection| '|t#4|) + (|CoercibleTo| '#1#) + (|mkCategory| '|domain| + '(((|retractIfCan| + ((|Union| $ "failed") + (|List| |t#4|))) + T) + ((|retract| ($ (|List| |t#4|))) + T) + ((|mvar| (|t#3| $)) T) + ((|variables| + ((|List| |t#3|) $)) + T) + ((|mainVariables| + ((|List| |t#3|) $)) + T) + ((|mainVariable?| + ((|Boolean|) |t#3| $)) + T) + ((|collectUnder| ($ $ |t#3|)) + T) + ((|collect| ($ $ |t#3|)) T) + ((|collectUpper| ($ $ |t#3|)) + T) + ((|sort| + ((|Record| (|:| |under| $) + (|:| |floor| $) + (|:| |upper| $)) + $ |t#3|)) + T) + ((|trivialIdeal?| + ((|Boolean|) $)) + T) + ((|roughBase?| ((|Boolean|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|roughSubIdeal?| + ((|Boolean|) $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|roughEqualIdeals?| + ((|Boolean|) $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|roughUnitIdeal?| + ((|Boolean|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|headRemainder| + ((|Record| (|:| |num| |t#4|) + (|:| |den| |t#1|)) + |t#4| $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|remainder| + ((|Record| (|:| |rnum| |t#1|) + (|:| |polnum| |t#4|) + (|:| |den| |t#1|)) + |t#4| $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|rewriteIdealWithHeadRemainder| + ((|List| |t#4|) + (|List| |t#4|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|rewriteIdealWithRemainder| + ((|List| |t#4|) + (|List| |t#4|) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|triangular?| + ((|Boolean|) $)) + (|has| |t#1| + (|IntegralDomain|)))) + '((|finiteAggregate| T)) + '((|Boolean|) (|List| |t#4|) + (|List| |t#3|)) + NIL)) + . #2=(|PolynomialSetCategory|)))))) . #2#) + (SETELT #0# 0 + (LIST '|PolynomialSetCategory| (|devaluate| |t#1|) + (|devaluate| |t#2|) (|devaluate| |t#3|) + (|devaluate| |t#4|))))))) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp new file mode 100644 index 00000000..2197438a --- /dev/null +++ b/src/algebra/strap/QFCAT-.lsp @@ -0,0 +1,440 @@ + +(/VERSIONCHECK 2) + +(DEFUN |QFCAT-;numerator;2A;1| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) + +(DEFUN |QFCAT-;denominator;2A;2| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 9))) + +(DEFUN |QFCAT-;init;A;3| ($) + (SPADCALL (|spadConstant| $ 13) (|spadConstant| $ 14) + (|getShellEntry| $ 15))) + +(DEFUN |QFCAT-;nextItem;AU;4| (|n| $) + (PROG (|m|) + (RETURN + (SEQ (LETT |m| + (SPADCALL (SPADCALL |n| (|getShellEntry| $ 8)) + (|getShellEntry| $ 18)) + |QFCAT-;nextItem;AU;4|) + (EXIT (COND + ((QEQCAR |m| 1) + (|error| "We seem to have a Fraction of a finite object")) + ('T + (CONS 0 + (SPADCALL (QCDR |m|) (|spadConstant| $ 14) + (|getShellEntry| $ 15)))))))))) + +(DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) |fn|) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) |fn|) + (|getShellEntry| $ 15))) + +(DEFUN |QFCAT-;reducedSystem;MM;6| (|m| $) + (SPADCALL |m| (|getShellEntry| $ 26))) + +(DEFUN |QFCAT-;characteristic;Nni;7| ($) + (SPADCALL (|getShellEntry| $ 30))) + +(DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| $) + (PROG (|n| |d|) + (RETURN + (SEQ (LETT |n| (SPADCALL |x| (|getShellEntry| $ 8)) + |QFCAT-;differentiate;AMA;8|) + (LETT |d| (SPADCALL |x| (|getShellEntry| $ 11)) + |QFCAT-;differentiate;AMA;8|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL (SPADCALL |n| |deriv|) |d| + (|getShellEntry| $ 32)) + (SPADCALL |n| (SPADCALL |d| |deriv|) + (|getShellEntry| $ 32)) + (|getShellEntry| $ 33)) + (SPADCALL |d| 2 (|getShellEntry| $ 35)) + (|getShellEntry| $ 15))))))) + +(DEFUN |QFCAT-;convert;AIf;9| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 38)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 38)) + (|getShellEntry| $ 39))) + +(DEFUN |QFCAT-;convert;AF;10| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 42)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 42)) + (|getShellEntry| $ 43))) + +(DEFUN |QFCAT-;convert;ADf;11| (|x| $) + (/ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 46)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 46)))) + +(DEFUN |QFCAT-;<;2AB;12| (|x| |y| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (SPADCALL |y| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (SPADCALL |x| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (|getShellEntry| $ 49))) + +(DEFUN |QFCAT-;<;2AB;13| (|x| |y| $) + (PROG (|#G19| |#G20| |#G21| |#G22|) + (RETURN + (SEQ (COND + ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|spadConstant| $ 51) (|getShellEntry| $ 49)) + (PROGN + (LETT |#G19| |y| |QFCAT-;<;2AB;13|) + (LETT |#G20| |x| |QFCAT-;<;2AB;13|) + (LETT |x| |#G19| |QFCAT-;<;2AB;13|) + (LETT |y| |#G20| |QFCAT-;<;2AB;13|)))) + (COND + ((SPADCALL (SPADCALL |y| (|getShellEntry| $ 11)) + (|spadConstant| $ 51) (|getShellEntry| $ 49)) + (PROGN + (LETT |#G21| |y| |QFCAT-;<;2AB;13|) + (LETT |#G22| |x| |QFCAT-;<;2AB;13|) + (LETT |x| |#G21| |QFCAT-;<;2AB;13|) + (LETT |y| |#G22| |QFCAT-;<;2AB;13|)))) + (EXIT (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (SPADCALL |y| (|getShellEntry| $ 11)) + (|getShellEntry| $ 32)) + (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 32)) + (|getShellEntry| $ 49))))))) + +(DEFUN |QFCAT-;<;2AB;14| (|x| |y| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (SPADCALL |y| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (SPADCALL (SPADCALL |y| (|getShellEntry| $ 8)) + (SPADCALL |x| (|getShellEntry| $ 11)) (|getShellEntry| $ 32)) + (|getShellEntry| $ 49))) + +(DEFUN |QFCAT-;fractionPart;2A;15| (|x| $) + (SPADCALL |x| + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 52)) + (|getShellEntry| $ 9)) + (|getShellEntry| $ 53))) + +(DEFUN |QFCAT-;coerce;SA;16| (|s| $) + (SPADCALL (SPADCALL |s| (|getShellEntry| $ 56)) + (|getShellEntry| $ 9))) + +(DEFUN |QFCAT-;retract;AS;17| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 58)) + (|getShellEntry| $ 59))) + +(DEFUN |QFCAT-;retractIfCan;AU;18| (|x| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| (SPADCALL |x| (|getShellEntry| $ 62)) + |QFCAT-;retractIfCan;AU;18|) + (EXIT (COND + ((QEQCAR |r| 1) (CONS 1 "failed")) + ('T (SPADCALL (QCDR |r|) (|getShellEntry| $ 64))))))))) + +(DEFUN |QFCAT-;convert;AP;19| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 68)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 68)) + (|getShellEntry| $ 69))) + +(DEFUN |QFCAT-;patternMatch;AP2Pmr;20| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 73))) + +(DEFUN |QFCAT-;convert;AP;21| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) + (|getShellEntry| $ 77)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 11)) + (|getShellEntry| $ 77)) + (|getShellEntry| $ 78))) + +(DEFUN |QFCAT-;patternMatch;AP2Pmr;22| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 82))) + +(DEFUN |QFCAT-;coerce;FA;23| (|x| $) + (SPADCALL + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 86)) + (|getShellEntry| $ 87)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 88)) + (|getShellEntry| $ 87)) + (|getShellEntry| $ 89))) + +(DEFUN |QFCAT-;retract;AI;24| (|x| $) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 58)) + (|getShellEntry| $ 91))) + +(DEFUN |QFCAT-;retractIfCan;AU;25| (|x| $) + (PROG (|u|) + (RETURN + (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 62)) + |QFCAT-;retractIfCan;AU;25|) + (EXIT (COND + ((QEQCAR |u| 1) (CONS 1 "failed")) + ('T (SPADCALL (QCDR |u|) (|getShellEntry| $ 94))))))))) + +(DEFUN |QFCAT-;random;A;26| ($) + (PROG (|d|) + (RETURN + (SEQ (SEQ G190 + (COND + ((NULL (SPADCALL + (LETT |d| + (SPADCALL (|getShellEntry| $ 96)) + |QFCAT-;random;A;26|) + (|getShellEntry| $ 97))) + (GO G191))) + (SEQ (EXIT |d|)) NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL (SPADCALL (|getShellEntry| $ 96)) |d| + (|getShellEntry| $ 15))))))) + +(DEFUN |QFCAT-;reducedSystem;MVR;27| (|m| |v| $) + (PROG (|n|) + (RETURN + (SEQ (LETT |n| + (SPADCALL + (SPADCALL (SPADCALL |v| (|getShellEntry| $ 100)) + |m| (|getShellEntry| $ 101)) + (|getShellEntry| $ 102)) + |QFCAT-;reducedSystem;MVR;27|) + (EXIT (CONS (SPADCALL |n| + (SPADCALL |n| (|getShellEntry| $ 103)) + (SPADCALL |n| (|getShellEntry| $ 104)) + (+ 1 (SPADCALL |n| (|getShellEntry| $ 105))) + (SPADCALL |n| (|getShellEntry| $ 106)) + (|getShellEntry| $ 107)) + (SPADCALL |n| + (SPADCALL |n| (|getShellEntry| $ 105)) + (|getShellEntry| $ 109)))))))) + +(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| 120) . #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| $ 47 + (CONS (|dispatchFunction| |QFCAT-;convert;ADf;11|) $))))) + (COND + ((|testBitVector| |pv$| 9) + (COND + ((|HasAttribute| |#2| '|canonicalUnitNormal|) + (|setShellEntry| $ 50 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;12|) $))) + ('T + (|setShellEntry| $ 50 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;13|) $))))) + ((|testBitVector| |pv$| 10) + (|setShellEntry| $ 50 + (CONS (|dispatchFunction| |QFCAT-;<;2AB;14|) $)))) + (COND + ((|testBitVector| |pv$| 3) + (|setShellEntry| $ 54 + (CONS (|dispatchFunction| |QFCAT-;fractionPart;2A;15|) + $)))) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (|setShellEntry| $ 57 + (CONS (|dispatchFunction| |QFCAT-;coerce;SA;16|) $)) + (|setShellEntry| $ 60 + (CONS (|dispatchFunction| |QFCAT-;retract;AS;17|) $)) + (|setShellEntry| $ 65 + (CONS (|dispatchFunction| |QFCAT-;retractIfCan;AU;18|) + $))))) + (COND + ((|HasCategory| |#2| + '(|ConvertibleTo| (|Pattern| (|Integer|)))) + (PROGN + (|setShellEntry| $ 70 + (CONS (|dispatchFunction| |QFCAT-;convert;AP;19|) $)) + (COND + ((|HasCategory| |#2| '(|PatternMatchable| (|Integer|))) + (|setShellEntry| $ 75 + (CONS (|dispatchFunction| + |QFCAT-;patternMatch;AP2Pmr;20|) + $))))))) + (COND + ((|HasCategory| |#2| + '(|ConvertibleTo| (|Pattern| (|Float|)))) + (PROGN + (|setShellEntry| $ 79 + (CONS (|dispatchFunction| |QFCAT-;convert;AP;21|) $)) + (COND + ((|HasCategory| |#2| '(|PatternMatchable| (|Float|))) + (|setShellEntry| $ 84 + (CONS (|dispatchFunction| + |QFCAT-;patternMatch;AP2Pmr;22|) + $))))))) + (COND + ((|testBitVector| |pv$| 11) + (PROGN + (|setShellEntry| $ 90 + (CONS (|dispatchFunction| |QFCAT-;coerce;FA;23|) $)) + (COND + ((|domainEqual| |#2| (|Integer|))) + ('T + (PROGN + (|setShellEntry| $ 92 + (CONS (|dispatchFunction| |QFCAT-;retract;AI;24|) + $)) + (|setShellEntry| $ 95 + (CONS (|dispatchFunction| + |QFCAT-;retractIfCan;AU;25|) + $)))))))) + (COND + ((|testBitVector| |pv$| 2) + (|setShellEntry| $ 98 + (CONS (|dispatchFunction| |QFCAT-;random;A;26|) $)))) + $)))) + +(MAKEPROP '|QuotientFieldCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |numer|) (5 . |coerce|) |QFCAT-;numerator;2A;1| + (10 . |denom|) |QFCAT-;denominator;2A;2| (15 . |init|) + (19 . |One|) (23 . /) (29 . |init|) (|Union| $ '"failed") + (33 . |nextItem|) (38 . |One|) (42 . |nextItem|) + (|Mapping| 7 7) |QFCAT-;map;M2A;5| (|Matrix| 7) + (|Matrix| 6) (|MatrixCommonDenominator| 7 6) + (47 . |clearDenominator|) (|Matrix| $) + |QFCAT-;reducedSystem;MM;6| (|NonNegativeInteger|) + (52 . |characteristic|) |QFCAT-;characteristic;Nni;7| + (56 . *) (62 . -) (|PositiveInteger|) (68 . **) + |QFCAT-;differentiate;AMA;8| (|InputForm|) + (74 . |convert|) (79 . /) (85 . |convert|) (|Float|) + (90 . |convert|) (95 . /) (101 . |convert|) + (|DoubleFloat|) (106 . |convert|) (111 . |convert|) + (|Boolean|) (116 . <) (122 . <) (128 . |Zero|) + (132 . |wholePart|) (137 . -) (143 . |fractionPart|) + (|Symbol|) (148 . |coerce|) (153 . |coerce|) + (158 . |retract|) (163 . |retract|) (168 . |retract|) + (|Union| 7 '"failed") (173 . |retractIfCan|) + (|Union| 55 '"failed") (178 . |retractIfCan|) + (183 . |retractIfCan|) (|Integer|) (|Pattern| 66) + (188 . |convert|) (193 . /) (199 . |convert|) + (|PatternMatchResult| 66 6) + (|PatternMatchQuotientFieldCategory| 66 7 6) + (204 . |patternMatch|) (|PatternMatchResult| 66 $) + (211 . |patternMatch|) (|Pattern| 41) (218 . |convert|) + (223 . /) (229 . |convert|) (|PatternMatchResult| 41 6) + (|PatternMatchQuotientFieldCategory| 41 7 6) + (234 . |patternMatch|) (|PatternMatchResult| 41 $) + (241 . |patternMatch|) (|Fraction| 66) (248 . |numer|) + (253 . |coerce|) (258 . |denom|) (263 . /) + (269 . |coerce|) (274 . |retract|) (279 . |retract|) + (|Union| 66 '"failed") (284 . |retractIfCan|) + (289 . |retractIfCan|) (294 . |random|) (298 . |zero?|) + (303 . |random|) (|Vector| 6) (307 . |coerce|) + (312 . |horizConcat|) (318 . |reducedSystem|) + (323 . |minRowIndex|) (328 . |maxRowIndex|) + (333 . |minColIndex|) (338 . |maxColIndex|) + (343 . |subMatrix|) (|Vector| 7) (352 . |column|) + (|Record| (|:| |mat| 23) (|:| |vec| 108)) (|Vector| $) + |QFCAT-;reducedSystem;MVR;27| (|Union| 85 '"failed") + (|Matrix| 66) (|Vector| 66) + (|Record| (|:| |mat| 114) (|:| |vec| 115)) (|List| 55) + (|List| 29) (|OutputForm|)) + '#(|retractIfCan| 358 |retract| 368 |reducedSystem| 378 + |random| 389 |patternMatch| 393 |numerator| 407 |nextItem| + 412 |map| 417 |init| 423 |fractionPart| 427 + |differentiate| 432 |denominator| 438 |convert| 443 + |coerce| 468 |characteristic| 478 < 482) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 112 + '(1 6 7 0 8 1 6 0 7 9 1 6 7 0 11 0 7 0 + 13 0 7 0 14 2 6 0 7 7 15 0 0 0 16 1 7 + 17 0 18 0 6 0 19 1 0 17 0 20 1 25 23 + 24 26 0 7 29 30 2 7 0 0 0 32 2 7 0 0 + 0 33 2 7 0 0 34 35 1 7 37 0 38 2 37 0 + 0 0 39 1 0 37 0 40 1 7 41 0 42 2 41 0 + 0 0 43 1 0 41 0 44 1 7 45 0 46 1 0 45 + 0 47 2 7 48 0 0 49 2 0 48 0 0 50 0 7 + 0 51 1 6 7 0 52 2 6 0 0 0 53 1 0 0 0 + 54 1 7 0 55 56 1 0 0 55 57 1 6 7 0 58 + 1 7 55 0 59 1 0 55 0 60 1 6 61 0 62 1 + 7 63 0 64 1 0 63 0 65 1 7 67 0 68 2 + 67 0 0 0 69 1 0 67 0 70 3 72 71 6 67 + 71 73 3 0 74 0 67 74 75 1 7 76 0 77 2 + 76 0 0 0 78 1 0 76 0 79 3 81 80 6 76 + 80 82 3 0 83 0 76 83 84 1 85 66 0 86 + 1 6 0 66 87 1 85 66 0 88 2 6 0 0 0 89 + 1 0 0 85 90 1 7 66 0 91 1 0 66 0 92 1 + 7 93 0 94 1 0 93 0 95 0 7 0 96 1 7 48 + 0 97 0 0 0 98 1 24 0 99 100 2 24 0 0 + 0 101 1 6 23 27 102 1 23 66 0 103 1 + 23 66 0 104 1 23 66 0 105 1 23 66 0 + 106 5 23 0 0 66 66 66 66 107 2 23 108 + 0 66 109 1 0 93 0 95 1 0 63 0 65 1 0 + 66 0 92 1 0 55 0 60 2 0 110 27 111 + 112 1 0 23 27 28 0 0 0 98 3 0 83 0 76 + 83 84 3 0 74 0 67 74 75 1 0 0 0 10 1 + 0 17 0 20 2 0 0 21 0 22 0 0 0 16 1 0 + 0 0 54 2 0 0 0 21 36 1 0 0 0 12 1 0 + 45 0 47 1 0 37 0 40 1 0 41 0 44 1 0 + 67 0 70 1 0 76 0 79 1 0 0 55 57 1 0 0 + 85 90 0 0 29 31 2 0 48 0 0 50))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp new file mode 100644 index 00000000..babf745e --- /dev/null +++ b/src/algebra/strap/QFCAT.lsp @@ -0,0 +1,105 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |QuotientFieldCategory;CAT| 'NIL) + +(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL) + +(DEFUN |QuotientFieldCategory| (#0=#:G1388) + (LET (#1=#:G1389) + (COND + ((SETQ #1# + (|assoc| (|devaluate| #0#) |QuotientFieldCategory;AL|)) + (CDR #1#)) + (T (SETQ |QuotientFieldCategory;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|QuotientFieldCategory;| #0#))) + |QuotientFieldCategory;AL|)) + #1#)))) + +(DEFUN |QuotientFieldCategory;| (|t#1|) + (PROG (#0=#:G1387) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|QuotientFieldCategory;CAT|) + ('T + (LETT |QuotientFieldCategory;CAT| + (|Join| (|Field|) (|Algebra| '|t#1|) + (|RetractableTo| '|t#1|) + (|FullyEvalableOver| '|t#1|) + (|DifferentialExtension| + '|t#1|) + (|FullyLinearlyExplicitRingOver| + '|t#1|) + (|Patternable| '|t#1|) + (|FullyPatternMatchable| + '|t#1|) + (|mkCategory| '|domain| + '(((/ ($ |t#1| |t#1|)) T) + ((|numer| (|t#1| $)) T) + ((|denom| (|t#1| $)) T) + ((|numerator| ($ $)) T) + ((|denominator| ($ $)) T) + ((|wholePart| (|t#1| $)) + (|has| |t#1| + (|EuclideanDomain|))) + ((|fractionPart| ($ $)) + (|has| |t#1| + (|EuclideanDomain|))) + ((|random| ($)) + (|has| |t#1| + (|IntegerNumberSystem|))) + ((|ceiling| (|t#1| $)) + (|has| |t#1| + (|IntegerNumberSystem|))) + ((|floor| (|t#1| $)) + (|has| |t#1| + (|IntegerNumberSystem|)))) + '(((|StepThrough|) + (|has| |t#1| + (|StepThrough|))) + ((|RetractableTo| + (|Integer|)) + (|has| |t#1| + (|RetractableTo| + (|Integer|)))) + ((|RetractableTo| + (|Fraction| (|Integer|))) + (|has| |t#1| + (|RetractableTo| + (|Integer|)))) + ((|OrderedSet|) + (|has| |t#1| + (|OrderedSet|))) + ((|OrderedIntegralDomain|) + (|has| |t#1| + (|OrderedIntegralDomain|))) + ((|RealConstant|) + (|has| |t#1| + (|RealConstant|))) + ((|ConvertibleTo| + (|InputForm|)) + (|has| |t#1| + (|ConvertibleTo| + (|InputForm|)))) + ((|CharacteristicZero|) + (|has| |t#1| + (|CharacteristicZero|))) + ((|CharacteristicNonZero|) + (|has| |t#1| + (|CharacteristicNonZero|))) + ((|RetractableTo| + (|Symbol|)) + (|has| |t#1| + (|RetractableTo| + (|Symbol|)))) + ((|PolynomialFactorizationExplicit|) + (|has| |t#1| + (|PolynomialFactorizationExplicit|)))) + 'NIL NIL)) + . #1=(|QuotientFieldCategory|))))) . #1#) + (SETELT #0# 0 + (LIST '|QuotientFieldCategory| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/RCAGG-.lsp b/src/algebra/strap/RCAGG-.lsp new file mode 100644 index 00000000..24470798 --- /dev/null +++ b/src/algebra/strap/RCAGG-.lsp @@ -0,0 +1,54 @@ + +(/VERSIONCHECK 2) + +(DEFUN |RCAGG-;elt;AvalueS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) + +(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| T1 |y| $) + (SPADCALL |x| |y| (QREFELT $ 11))) + +(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| $) + (SPADCALL |x| (SPADCALL |l| (QREFELT $ 14)) (QREFELT $ 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 $ (GETREFV 19) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|shallowlyMutable|) + (|HasCategory| |#2| '(|SetCategory|)))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|testBitVector| |pv$| 1) + (QSETREFV $ 12 + (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $)))) + (COND + ((|testBitVector| |pv$| 2) + (QSETREFV $ 18 + (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) $)))) + $)))) + +(MAKEPROP '|RecursiveAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |value|) '"value" |RCAGG-;elt;AvalueS;1| + (5 . |setvalue!|) (11 . |setelt|) (|List| $) + (18 . |children|) (|Boolean|) (|List| 6) (23 . |member?|) + (29 . |child?|)) + '#(|setelt| 35 |elt| 42 |child?| 48) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 18 + '(1 6 7 0 8 2 6 7 0 7 11 3 0 7 0 9 7 12 + 1 6 13 0 14 2 16 15 6 0 17 2 0 15 0 0 + 18 3 0 7 0 9 7 12 2 0 7 0 9 10 2 0 15 + 0 0 18))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RCAGG.lsp b/src/algebra/strap/RCAGG.lsp new file mode 100644 index 00000000..9981da27 --- /dev/null +++ b/src/algebra/strap/RCAGG.lsp @@ -0,0 +1,74 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |RecursiveAggregate;CAT| 'NIL) + +(DEFPARAMETER |RecursiveAggregate;AL| 'NIL) + +(DEFUN |RecursiveAggregate| (#0=#:G1398) + (LET (#1=#:G1399) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |RecursiveAggregate;AL|)) + (CDR #1#)) + (T (SETQ |RecursiveAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|RecursiveAggregate;| #0#))) + |RecursiveAggregate;AL|)) + #1#)))) + +(DEFUN |RecursiveAggregate;| (|t#1|) + (PROG (#0=#:G1397) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|RecursiveAggregate;CAT|) + ('T + (LETT |RecursiveAggregate;CAT| + (|Join| (|HomogeneousAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|children| ((|List| $) $)) + T) + ((|nodes| ((|List| $) $)) T) + ((|leaf?| ((|Boolean|) $)) + T) + ((|value| (|t#1| $)) T) + ((|elt| (|t#1| $ "value")) + T) + ((|cyclic?| ((|Boolean|) $)) + T) + ((|leaves| + ((|List| |t#1|) $)) + T) + ((|distance| + ((|Integer|) $ $)) + T) + ((|child?| + ((|Boolean|) $ $)) + (|has| |t#1| + (|SetCategory|))) + ((|node?| ((|Boolean|) $ $)) + (|has| |t#1| + (|SetCategory|))) + ((|setchildren!| + ($ $ (|List| $))) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setelt| + (|t#1| $ "value" |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setvalue!| + (|t#1| $ |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|)))) + NIL + '((|List| $) (|Boolean|) + (|Integer|) (|List| |t#1|)) + NIL)) + . #1=(|RecursiveAggregate|))))) . #1#) + (SETELT #0# 0 (LIST '|RecursiveAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/REF.lsp b/src/algebra/strap/REF.lsp new file mode 100644 index 00000000..ad9f6dd0 --- /dev/null +++ b/src/algebra/strap/REF.lsp @@ -0,0 +1,92 @@ + +(/VERSIONCHECK 2) + +(PUT '|REF;=;2$B;1| '|SPADreplace| 'EQ) + +(DEFUN |REF;=;2$B;1| (|p| |q| $) (EQ |p| |q|)) + +(PUT '|REF;ref;S$;2| '|SPADreplace| 'LIST) + +(DEFUN |REF;ref;S$;2| (|v| $) (LIST |v|)) + +(PUT '|REF;elt;$S;3| '|SPADreplace| 'QCAR) + +(DEFUN |REF;elt;$S;3| (|p| $) (QCAR |p|)) + +(DEFUN |REF;setelt;$2S;4| (|p| |v| $) + (PROGN (RPLACA |p| |v|) (QCAR |p|))) + +(PUT '|REF;deref;$S;5| '|SPADreplace| 'QCAR) + +(DEFUN |REF;deref;$S;5| (|p| $) (QCAR |p|)) + +(DEFUN |REF;setref;$2S;6| (|p| |v| $) + (PROGN (RPLACA |p| |v|) (QCAR |p|))) + +(DEFUN |REF;coerce;$Of;7| (|p| $) + (SPADCALL (SPADCALL "ref" (|getShellEntry| $ 17)) + (LIST (SPADCALL (QCAR |p|) (|getShellEntry| $ 18))) + (|getShellEntry| $ 20))) + +(DEFUN |Reference| (#0=#:G1401) + (PROG () + (RETURN + (PROG (#1=#:G1402) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|Reference|) + '|domainEqualList|) + |Reference|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|Reference;| #0#) (LETT #1# T |Reference|)) + (COND + ((NOT #1#) (HREM |$ConstructorCache| '|Reference|))))))))))) + +(DEFUN |Reference;| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|Reference|)) + (LETT |dv$| (LIST '|Reference| |dv$1|) . #0#) + (LETT $ (|newShell| 23) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#1| '(|SetCategory|)))) . #0#)) + (|haddProp| |$ConstructorCache| '|Reference| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 (|Record| (|:| |value| |#1|))) + (COND + ((|testBitVector| |pv$| 1) + (|setShellEntry| $ 21 + (CONS (|dispatchFunction| |REF;coerce;$Of;7|) $)))) + $)))) + +(MAKEPROP '|Reference| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) '|Rep| (|Boolean|) + |REF;=;2$B;1| |REF;ref;S$;2| |REF;elt;$S;3| + |REF;setelt;$2S;4| |REF;deref;$S;5| |REF;setref;$2S;6| + (|String|) (|OutputForm|) (0 . |message|) (5 . |coerce|) + (|List| $) (10 . |prefix|) (16 . |coerce|) + (|SingleInteger|)) + '#(~= 21 |setref| 27 |setelt| 33 |ref| 39 |latex| 44 |hash| + 49 |elt| 54 |deref| 59 |coerce| 64 = 69) + 'NIL + (CONS (|makeByteWordVec2| 1 '(1 0 1 1)) + (CONS '#(|SetCategory&| NIL |BasicType&| NIL) + (CONS '#((|SetCategory|) (|Type|) (|BasicType|) + (|CoercibleTo| 16)) + (|makeByteWordVec2| 22 + '(1 16 0 15 17 1 6 16 0 18 2 16 0 0 19 + 20 1 0 16 0 21 2 1 8 0 0 1 2 0 6 0 6 + 14 2 0 6 0 6 12 1 0 0 6 10 1 1 15 0 1 + 1 1 22 0 1 1 0 6 0 11 1 0 6 0 13 1 1 + 16 0 21 2 0 8 0 0 9))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RING-.lsp b/src/algebra/strap/RING-.lsp new file mode 100644 index 00000000..31e6daf4 --- /dev/null +++ b/src/algebra/strap/RING-.lsp @@ -0,0 +1,29 @@ + +(/VERSIONCHECK 2) + +(DEFUN |RING-;coerce;IS;1| (|n| $) + (SPADCALL |n| (|spadConstant| $ 7) (QREFELT $ 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 $ (GETREFV 12) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|Ring&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (0 . |One|) + (|Integer|) (4 . *) |RING-;coerce;IS;1| (|OutputForm|)) + '#(|coerce| 10) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 10 + '(0 6 0 7 2 6 0 8 0 9 1 0 0 8 10))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RING.lsp b/src/algebra/strap/RING.lsp new file mode 100644 index 00000000..47fce84a --- /dev/null +++ b/src/algebra/strap/RING.lsp @@ -0,0 +1,25 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Ring;AL| 'NIL) + +(DEFUN |Ring| () + (LET (#:G1387) (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|)))))) + +(DEFUN |Ring;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|Rng|) (|Monoid|) (|LeftModule| '$) + (|mkCategory| '|domain| + '(((|characteristic| + ((|NonNegativeInteger|))) + T) + ((|coerce| ($ (|Integer|))) T)) + '((|unitsKnown| T)) + '((|Integer|) (|NonNegativeInteger|)) + NIL)) + |Ring|) + (SETELT #0# 0 '(|Ring|)))))) + +(MAKEPROP '|Ring| 'NILADIC T) diff --git a/src/algebra/strap/RNG.lsp b/src/algebra/strap/RNG.lsp new file mode 100644 index 00000000..5ba05b81 --- /dev/null +++ b/src/algebra/strap/RNG.lsp @@ -0,0 +1,15 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |Rng;AL| 'NIL) + +(DEFUN |Rng| () + (LET (#:G1387) (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|)))))) + +(DEFUN |Rng;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|) + (SETELT #0# 0 '(|Rng|)))))) + +(MAKEPROP '|Rng| 'NILADIC T) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp new file mode 100644 index 00000000..911b8420 --- /dev/null +++ b/src/algebra/strap/RNS-.lsp @@ -0,0 +1,144 @@ + +(/VERSIONCHECK 2) + +(PUT '|RNS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |RNS-;characteristic;Nni;1| ($) 0) + +(DEFUN |RNS-;fractionPart;2S;2| (|x| $) + (SPADCALL |x| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) + +(DEFUN |RNS-;truncate;2S;3| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 15)) + (QREFELT $ 14))) + ('T (SPADCALL |x| (QREFELT $ 15))))) + +(DEFUN |RNS-;round;2S;4| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 13)) + (SPADCALL + (SPADCALL |x| + (SPADCALL (|spadConstant| $ 17) + (SPADCALL 2 (QREFELT $ 19)) (QREFELT $ 20)) + (QREFELT $ 10)) + (QREFELT $ 9))) + ('T + (SPADCALL + (SPADCALL |x| + (SPADCALL (|spadConstant| $ 17) + (SPADCALL 2 (QREFELT $ 19)) (QREFELT $ 20)) + (QREFELT $ 21)) + (QREFELT $ 9))))) + +(DEFUN |RNS-;norm;2S;5| (|x| $) (SPADCALL |x| (QREFELT $ 23))) + +(DEFUN |RNS-;coerce;FS;6| (|x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 26)) (QREFELT $ 19)) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) (QREFELT $ 19)) + (QREFELT $ 20))) + +(DEFUN |RNS-;convert;SP;7| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 30)) (QREFELT $ 32))) + +(DEFUN |RNS-;floor;2S;8| (|x| $) + (PROG (|x1|) + (RETURN + (SEQ (LETT |x1| + (SPADCALL (SPADCALL |x| (QREFELT $ 34)) + (QREFELT $ 19)) + |RNS-;floor;2S;8|) + (EXIT (COND + ((SPADCALL |x| |x1| (QREFELT $ 35)) |x|) + ((SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 37)) + (SPADCALL |x1| (|spadConstant| $ 17) + (QREFELT $ 10))) + ('T |x1|))))))) + +(DEFUN |RNS-;ceiling;2S;9| (|x| $) + (PROG (|x1|) + (RETURN + (SEQ (LETT |x1| + (SPADCALL (SPADCALL |x| (QREFELT $ 34)) + (QREFELT $ 19)) + |RNS-;ceiling;2S;9|) + (EXIT (COND + ((SPADCALL |x| |x1| (QREFELT $ 35)) |x|) + ((SPADCALL |x| (|spadConstant| $ 36) (QREFELT $ 37)) + |x1|) + ('T + (SPADCALL |x1| (|spadConstant| $ 17) + (QREFELT $ 21))))))))) + +(DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $) + (PROG (|r|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (QREFELT $ 40)) + (SPADCALL |p| |x| |l| (QREFELT $ 42))) + ((SPADCALL |p| (QREFELT $ 43)) + (SEQ (LETT |r| (SPADCALL |p| (QREFELT $ 45)) + |RNS-;patternMatch;SP2Pmr;10|) + (EXIT (COND + ((QEQCAR |r| 0) + (COND + ((SPADCALL (SPADCALL |x| (QREFELT $ 30)) + (QCDR |r|) (QREFELT $ 46)) + |l|) + ('T (SPADCALL (QREFELT $ 47))))) + ('T (SPADCALL (QREFELT $ 47))))))) + ('T (SPADCALL (QREFELT $ 47)))))))) + +(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 $ (GETREFV 52) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|RealNumberSystem&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) + (|NonNegativeInteger|) |RNS-;characteristic;Nni;1| + (0 . |truncate|) (5 . -) |RNS-;fractionPart;2S;2| + (|Boolean|) (11 . |negative?|) (16 . -) (21 . |floor|) + |RNS-;truncate;2S;3| (26 . |One|) (|Integer|) + (30 . |coerce|) (35 . /) (41 . +) |RNS-;round;2S;4| + (47 . |abs|) |RNS-;norm;2S;5| (|Fraction| 18) + (52 . |numer|) (57 . |denom|) |RNS-;coerce;FS;6| (|Float|) + (62 . |convert|) (|Pattern| 29) (67 . |coerce|) + |RNS-;convert;SP;7| (72 . |wholePart|) (77 . =) + (83 . |Zero|) (87 . <) |RNS-;floor;2S;8| + |RNS-;ceiling;2S;9| (93 . |generic?|) + (|PatternMatchResult| 29 6) (98 . |addMatch|) + (105 . |constant?|) (|Union| 29 '"failed") + (110 . |retractIfCan|) (115 . =) (121 . |failed|) + (|PatternMatchResult| 29 $) |RNS-;patternMatch;SP2Pmr;10| + (|DoubleFloat|) (|OutputForm|)) + '#(|truncate| 125 |round| 130 |patternMatch| 135 |norm| 142 + |fractionPart| 147 |floor| 152 |convert| 157 |coerce| 162 + |characteristic| 172 |ceiling| 176) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 49 + '(1 6 0 0 9 2 6 0 0 0 10 1 6 12 0 13 1 + 6 0 0 14 1 6 0 0 15 0 6 0 17 1 6 0 18 + 19 2 6 0 0 0 20 2 6 0 0 0 21 1 6 0 0 + 23 1 25 18 0 26 1 25 18 0 27 1 6 29 0 + 30 1 31 0 29 32 1 6 18 0 34 2 6 12 0 + 0 35 0 6 0 36 2 6 12 0 0 37 1 31 12 0 + 40 3 41 0 31 6 0 42 1 31 12 0 43 1 31 + 44 0 45 2 29 12 0 0 46 0 41 0 47 1 0 + 0 0 16 1 0 0 0 22 3 0 48 0 31 48 49 1 + 0 0 0 24 1 0 0 0 11 1 0 0 0 38 1 0 31 + 0 33 1 0 0 25 28 1 0 0 25 28 0 0 7 8 + 1 0 0 0 39))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/RNS.lsp b/src/algebra/strap/RNS.lsp new file mode 100644 index 00000000..7955ad3e --- /dev/null +++ b/src/algebra/strap/RNS.lsp @@ -0,0 +1,42 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |RealNumberSystem;AL| 'NIL) + +(DEFUN |RealNumberSystem| () + (LET (#:G1396) + (COND + (|RealNumberSystem;AL|) + (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|)))))) + +(DEFUN |RealNumberSystem;| () + (PROG (#0=#:G1394) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1390 #2=#:G1391 #3=#:G1392 + #4=#:G1393) + (LIST '(|Integer|) + '(|Fraction| (|Integer|)) + '(|Pattern| (|Float|)) '(|Float|))) + (|Join| (|Field|) (|OrderedRing|) + (|RealConstant|) (|RetractableTo| '#1#) + (|RetractableTo| '#2#) + (|RadicalCategory|) + (|ConvertibleTo| '#3#) + (|PatternMatchable| '#4#) + (|CharacteristicZero|) + (|mkCategory| '|domain| + '(((|norm| ($ $)) T) + ((|ceiling| ($ $)) T) + ((|floor| ($ $)) T) + ((|wholePart| ((|Integer|) $)) T) + ((|fractionPart| ($ $)) T) + ((|truncate| ($ $)) T) + ((|round| ($ $)) T) + ((|abs| ($ $)) T)) + NIL '((|Integer|)) NIL))) + |RealNumberSystem|) + (SETELT #0# 0 '(|RealNumberSystem|)))))) + +(MAKEPROP '|RealNumberSystem| 'NILADIC T) diff --git a/src/algebra/strap/SETAGG-.lsp b/src/algebra/strap/SETAGG-.lsp new file mode 100644 index 00000000..de45a200 --- /dev/null +++ b/src/algebra/strap/SETAGG-.lsp @@ -0,0 +1,50 @@ + +(/VERSIONCHECK 2) + +(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| $) + (SPADCALL (SPADCALL |x| |y| (|getShellEntry| $ 8)) + (SPADCALL |y| |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) + +(DEFUN |SETAGG-;union;ASA;2| (|s| |x| $) + (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) + (|getShellEntry| $ 9))) + +(DEFUN |SETAGG-;union;S2A;3| (|x| |s| $) + (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) + (|getShellEntry| $ 9))) + +(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| $) + (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) + (|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|) + $)))) + +(MAKEPROP '|SetAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |difference|) (6 . |union|) + |SETAGG-;symmetricDifference;3A;1| (|List| 7) + (12 . |brace|) |SETAGG-;union;ASA;2| |SETAGG-;union;S2A;3| + |SETAGG-;difference;ASA;4|) + '#(|union| 17 |symmetricDifference| 29 |difference| 35) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 15 + '(2 6 0 0 0 8 2 6 0 0 0 9 1 6 0 11 12 2 + 0 0 7 0 14 2 0 0 0 7 13 2 0 0 0 0 10 + 2 0 0 0 7 15))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/SETAGG.lsp b/src/algebra/strap/SETAGG.lsp new file mode 100644 index 00000000..e28d5608 --- /dev/null +++ b/src/algebra/strap/SETAGG.lsp @@ -0,0 +1,58 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |SetAggregate;CAT| 'NIL) + +(DEFPARAMETER |SetAggregate;AL| 'NIL) + +(DEFUN |SetAggregate| (#0=#:G1394) + (LET (#1=#:G1395) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |SetAggregate;AL|)) + (CDR #1#)) + (T (SETQ |SetAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|SetAggregate;| #0#))) + |SetAggregate;AL|)) + #1#)))) + +(DEFUN |SetAggregate;| (|t#1|) + (PROG (#0=#:G1393) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|SetAggregate;CAT|) + ('T + (LETT |SetAggregate;CAT| + (|Join| (|SetCategory|) + (|Collection| '|t#1|) + (|mkCategory| '|domain| + '(((|part?| ((|Boolean|) $ $)) + T) + ((|brace| ($)) T) + ((|brace| + ($ (|List| |t#1|))) + T) + ((|set| ($)) T) + ((|set| ($ (|List| |t#1|))) + T) + ((|intersect| ($ $ $)) T) + ((|difference| ($ $ $)) T) + ((|difference| ($ $ |t#1|)) + T) + ((|symmetricDifference| + ($ $ $)) + T) + ((|subset?| + ((|Boolean|) $ $)) + T) + ((|union| ($ $ $)) T) + ((|union| ($ $ |t#1|)) T) + ((|union| ($ |t#1| $)) T)) + '((|partiallyOrderedSet| T)) + '((|Boolean|) (|List| |t#1|)) + NIL)) + . #1=(|SetAggregate|))))) . #1#) + (SETELT #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/SETCAT-.lsp b/src/algebra/strap/SETCAT-.lsp new file mode 100644 index 00000000..d4c1987b --- /dev/null +++ b/src/algebra/strap/SETCAT-.lsp @@ -0,0 +1,35 @@ + +(/VERSIONCHECK 2) + +(PUT '|SETCAT-;hash;SSi;1| '|SPADreplace| '(XLAM (|s|) 0)) + +(DEFUN |SETCAT-;hash;SSi;1| (|s| $) 0) + +(PUT '|SETCAT-;latex;SS;2| '|SPADreplace| + '(XLAM (|s|) "\\mbox{\\bf Unimplemented}")) + +(DEFUN |SETCAT-;latex;SS;2| (|s| $) "\\mbox{\\bf Unimplemented}") + +(DEFUN |SetCategory&| (|#1|) + (PROG (|dv$1| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetCategory&|)) + (LETT |dv$| (LIST '|SetCategory&| |dv$1|) . #0#) + (LETT $ (GETREFV 11) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + $)))) + +(MAKEPROP '|SetCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|SingleInteger|) + |SETCAT-;hash;SSi;1| (|String|) |SETCAT-;latex;SS;2|) + '#(|latex| 0 |hash| 5) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 10 + '(1 0 9 0 10 1 0 7 0 8))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/SETCAT.lsp b/src/algebra/strap/SETCAT.lsp new file mode 100644 index 00000000..075d8993 --- /dev/null +++ b/src/algebra/strap/SETCAT.lsp @@ -0,0 +1,27 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |SetCategory;AL| 'NIL) + +(DEFUN |SetCategory| () + (LET (#:G1388) + (COND + (|SetCategory;AL|) + (T (SETQ |SetCategory;AL| (|SetCategory;|)))))) + +(DEFUN |SetCategory;| () + (PROG (#0=#:G1386) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(#1=#:G1385) (LIST '(|OutputForm|))) + (|Join| (|BasicType|) (|CoercibleTo| '#1#) + (|mkCategory| '|domain| + '(((|hash| ((|SingleInteger|) $)) T) + ((|latex| ((|String|) $)) T)) + NIL '((|String|) (|SingleInteger|)) + NIL))) + |SetCategory|) + (SETELT #0# 0 '(|SetCategory|)))))) + +(MAKEPROP '|SetCategory| 'NILADIC T) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp new file mode 100644 index 00000000..2ad4d6de --- /dev/null +++ b/src/algebra/strap/SINT.lsp @@ -0,0 +1,463 @@ + +(/VERSIONCHECK 2) + +(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $) + (SEQ (COND + ((QSLESSP |x| 0) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 9)) + (SPADCALL |dev| "arith1" "unaryminus" + (|getShellEntry| $ 11)) + (SPADCALL |dev| (QSMINUS |x|) (|getShellEntry| $ 13)) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 14))))) + ('T (SPADCALL |dev| |x| (|getShellEntry| $ 13)))))) + +(DEFUN |SINT;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SINT;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 16)) + (|getShellEntry| $ 17)) + |SINT;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 18)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 19)) + (SPADCALL |dev| (|getShellEntry| $ 20)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SINT;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 16)) + (|getShellEntry| $ 17)) + |SINT;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 19)))) + (SPADCALL |dev| (|getShellEntry| $ 20)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 18)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 19))))) + +(DEFUN |SINT;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 18)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 19))))))) + +(PUT '|SINT;reducedSystem;MM;6| '|SPADreplace| '(XLAM (|m|) |m|)) + +(DEFUN |SINT;reducedSystem;MM;6| (|m| $) |m|) + +(DEFUN |SINT;coerce;$Of;7| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 30))) + +(PUT '|SINT;convert;$I;8| '|SPADreplace| '(XLAM (|x|) |x|)) + +(DEFUN |SINT;convert;$I;8| (|x| $) |x|) + +(DEFUN |SINT;*;I2$;9| (|i| |y| $) + (QSTIMES (SPADCALL |i| (|getShellEntry| $ 33)) |y|)) + +(PUT '|SINT;Zero;$;10| '|SPADreplace| '(XLAM NIL 0)) + +(DEFUN |SINT;Zero;$;10| ($) 0) + +(PUT '|SINT;One;$;11| '|SPADreplace| '(XLAM NIL 1)) + +(DEFUN |SINT;One;$;11| ($) 1) + +(PUT '|SINT;base;$;12| '|SPADreplace| '(XLAM NIL 2)) + +(DEFUN |SINT;base;$;12| ($) 2) + +(PUT '|SINT;max;$;13| '|SPADreplace| '(XLAM NIL MOST-POSITIVE-FIXNUM)) + +(DEFUN |SINT;max;$;13| ($) MOST-POSITIVE-FIXNUM) + +(PUT '|SINT;min;$;14| '|SPADreplace| '(XLAM NIL MOST-NEGATIVE-FIXNUM)) + +(DEFUN |SINT;min;$;14| ($) MOST-NEGATIVE-FIXNUM) + +(PUT '|SINT;=;2$B;15| '|SPADreplace| 'EQL) + +(DEFUN |SINT;=;2$B;15| (|x| |y| $) (EQL |x| |y|)) + +(PUT '|SINT;~;2$;16| '|SPADreplace| 'LOGNOT) + +(DEFUN |SINT;~;2$;16| (|x| $) (LOGNOT |x|)) + +(PUT '|SINT;not;2$;17| '|SPADreplace| 'LOGNOT) + +(DEFUN |SINT;not;2$;17| (|x| $) (LOGNOT |x|)) + +(PUT '|SINT;/\\;3$;18| '|SPADreplace| 'LOGAND) + +(DEFUN |SINT;/\\;3$;18| (|x| |y| $) (LOGAND |x| |y|)) + +(PUT '|SINT;\\/;3$;19| '|SPADreplace| 'LOGIOR) + +(DEFUN |SINT;\\/;3$;19| (|x| |y| $) (LOGIOR |x| |y|)) + +(PUT '|SINT;Not;2$;20| '|SPADreplace| 'LOGNOT) + +(DEFUN |SINT;Not;2$;20| (|x| $) (LOGNOT |x|)) + +(PUT '|SINT;And;3$;21| '|SPADreplace| 'LOGAND) + +(DEFUN |SINT;And;3$;21| (|x| |y| $) (LOGAND |x| |y|)) + +(PUT '|SINT;Or;3$;22| '|SPADreplace| 'LOGIOR) + +(DEFUN |SINT;Or;3$;22| (|x| |y| $) (LOGIOR |x| |y|)) + +(PUT '|SINT;xor;3$;23| '|SPADreplace| 'LOGXOR) + +(DEFUN |SINT;xor;3$;23| (|x| |y| $) (LOGXOR |x| |y|)) + +(PUT '|SINT;<;2$B;24| '|SPADreplace| 'QSLESSP) + +(DEFUN |SINT;<;2$B;24| (|x| |y| $) (QSLESSP |x| |y|)) + +(PUT '|SINT;inc;2$;25| '|SPADreplace| 'QSADD1) + +(DEFUN |SINT;inc;2$;25| (|x| $) (QSADD1 |x|)) + +(PUT '|SINT;dec;2$;26| '|SPADreplace| 'QSSUB1) + +(DEFUN |SINT;dec;2$;26| (|x| $) (QSSUB1 |x|)) + +(PUT '|SINT;-;2$;27| '|SPADreplace| 'QSMINUS) + +(DEFUN |SINT;-;2$;27| (|x| $) (QSMINUS |x|)) + +(PUT '|SINT;+;3$;28| '|SPADreplace| 'QSPLUS) + +(DEFUN |SINT;+;3$;28| (|x| |y| $) (QSPLUS |x| |y|)) + +(PUT '|SINT;-;3$;29| '|SPADreplace| 'QSDIFFERENCE) + +(DEFUN |SINT;-;3$;29| (|x| |y| $) (QSDIFFERENCE |x| |y|)) + +(PUT '|SINT;*;3$;30| '|SPADreplace| 'QSTIMES) + +(DEFUN |SINT;*;3$;30| (|x| |y| $) (QSTIMES |x| |y|)) + +(DEFUN |SINT;**;$Nni$;31| (|x| |n| $) + (SPADCALL (EXPT |x| |n|) (|getShellEntry| $ 33))) + +(PUT '|SINT;quo;3$;32| '|SPADreplace| 'QSQUOTIENT) + +(DEFUN |SINT;quo;3$;32| (|x| |y| $) (QSQUOTIENT |x| |y|)) + +(PUT '|SINT;rem;3$;33| '|SPADreplace| 'QSREMAINDER) + +(DEFUN |SINT;rem;3$;33| (|x| |y| $) (QSREMAINDER |x| |y|)) + +(DEFUN |SINT;divide;2$R;34| (|x| |y| $) + (CONS (QSQUOTIENT |x| |y|) (QSREMAINDER |x| |y|))) + +(PUT '|SINT;gcd;3$;35| '|SPADreplace| 'GCD) + +(DEFUN |SINT;gcd;3$;35| (|x| |y| $) (GCD |x| |y|)) + +(PUT '|SINT;abs;2$;36| '|SPADreplace| 'QSABSVAL) + +(DEFUN |SINT;abs;2$;36| (|x| $) (QSABSVAL |x|)) + +(PUT '|SINT;odd?;$B;37| '|SPADreplace| 'QSODDP) + +(DEFUN |SINT;odd?;$B;37| (|x| $) (QSODDP |x|)) + +(PUT '|SINT;zero?;$B;38| '|SPADreplace| 'QSZEROP) + +(DEFUN |SINT;zero?;$B;38| (|x| $) (QSZEROP |x|)) + +(PUT '|SINT;one?;$B;39| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1))) + +(DEFUN |SINT;one?;$B;39| (|x| $) (EQL |x| 1)) + +(PUT '|SINT;max;3$;40| '|SPADreplace| 'QSMAX) + +(DEFUN |SINT;max;3$;40| (|x| |y| $) (QSMAX |x| |y|)) + +(PUT '|SINT;min;3$;41| '|SPADreplace| 'QSMIN) + +(DEFUN |SINT;min;3$;41| (|x| |y| $) (QSMIN |x| |y|)) + +(PUT '|SINT;hash;2$;42| '|SPADreplace| 'HASHEQ) + +(DEFUN |SINT;hash;2$;42| (|x| $) (HASHEQ |x|)) + +(PUT '|SINT;length;2$;43| '|SPADreplace| 'INTEGER-LENGTH) + +(DEFUN |SINT;length;2$;43| (|x| $) (INTEGER-LENGTH |x|)) + +(PUT '|SINT;shift;3$;44| '|SPADreplace| 'QSLEFTSHIFT) + +(DEFUN |SINT;shift;3$;44| (|x| |n| $) (QSLEFTSHIFT |x| |n|)) + +(PUT '|SINT;mulmod;4$;45| '|SPADreplace| 'QSMULTMOD) + +(DEFUN |SINT;mulmod;4$;45| (|a| |b| |p| $) (QSMULTMOD |a| |b| |p|)) + +(PUT '|SINT;addmod;4$;46| '|SPADreplace| 'QSADDMOD) + +(DEFUN |SINT;addmod;4$;46| (|a| |b| |p| $) (QSADDMOD |a| |b| |p|)) + +(PUT '|SINT;submod;4$;47| '|SPADreplace| 'QSDIFMOD) + +(DEFUN |SINT;submod;4$;47| (|a| |b| |p| $) (QSDIFMOD |a| |b| |p|)) + +(PUT '|SINT;negative?;$B;48| '|SPADreplace| 'QSMINUSP) + +(DEFUN |SINT;negative?;$B;48| (|x| $) (QSMINUSP |x|)) + +(PUT '|SINT;reducedSystem;MVR;49| '|SPADreplace| 'CONS) + +(DEFUN |SINT;reducedSystem;MVR;49| (|m| |v| $) (CONS |m| |v|)) + +(DEFUN |SINT;positiveRemainder;3$;50| (|x| |n| $) + (PROG (|r|) + (RETURN + (SEQ (LETT |r| (QSREMAINDER |x| |n|) + |SINT;positiveRemainder;3$;50|) + (EXIT (COND + ((QSMINUSP |r|) + (COND + ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) + ('T (QSPLUS |r| |n|)))) + ('T |r|))))))) + +(DEFUN |SINT;coerce;I$;51| (|x| $) + (SEQ (COND + ((NULL (< MOST-POSITIVE-FIXNUM |x|)) + (COND ((NULL (< |x| MOST-NEGATIVE-FIXNUM)) (EXIT |x|))))) + (EXIT (|error| "integer too large to represent in a machine word")))) + +(DEFUN |SINT;random;$;52| ($) + (SEQ (SETELT $ 6 + (REMAINDER (TIMES 314159269 (|getShellEntry| $ 6)) + 2147483647)) + (EXIT (REMAINDER (|getShellEntry| $ 6) 67108864)))) + +(PUT '|SINT;random;2$;53| '|SPADreplace| 'RANDOM) + +(DEFUN |SINT;random;2$;53| (|n| $) (RANDOM |n|)) + +(DEFUN |SINT;unitNormal;$R;54| (|x| $) + (COND + ((QSLESSP |x| 0) (VECTOR -1 (QSMINUS |x|) -1)) + ('T (VECTOR 1 |x| 1)))) + +(DEFUN |SingleInteger| () + (PROG () + (RETURN + (PROG (#0=#:G1486) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|) + |SingleInteger|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|SingleInteger| + (LIST + (CONS NIL + (CONS 1 (|SingleInteger;|)))))) + (LETT #0# T |SingleInteger|)) + (COND + ((NOT #0#) + (HREM |$ConstructorCache| '|SingleInteger|))))))))))) + +(DEFUN |SingleInteger;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|SingleInteger|) . #0=(|SingleInteger|)) + (LETT $ (|newShell| 105) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|SingleInteger| NIL + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 1) + $)))) + +(MAKEPROP '|SingleInteger| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL '|seed| (|Void|) + (|OpenMathDevice|) (0 . |OMputApp|) (|String|) + (5 . |OMputSymbol|) (|Integer|) (12 . |OMputInteger|) + (18 . |OMputEndApp|) (|OpenMathEncoding|) + (23 . |OMencodingXML|) (27 . |OMopenString|) + (33 . |OMputObject|) (38 . |OMputEndObject|) + (43 . |OMclose|) |SINT;OMwrite;$S;2| (|Boolean|) + |SINT;OMwrite;$BS;3| |SINT;OMwrite;Omd$V;4| + |SINT;OMwrite;Omd$BV;5| (|Matrix| 12) (|Matrix| $) + |SINT;reducedSystem;MM;6| (|OutputForm|) (48 . |coerce|) + |SINT;coerce;$Of;7| |SINT;convert;$I;8| (53 . |coerce|) + |SINT;*;I2$;9| + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |SINT;Zero;$;10|) $)) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |SINT;One;$;11|) $)) + |SINT;base;$;12| |SINT;max;$;13| |SINT;min;$;14| + |SINT;=;2$B;15| |SINT;~;2$;16| |SINT;not;2$;17| + |SINT;/\\;3$;18| |SINT;\\/;3$;19| |SINT;Not;2$;20| + |SINT;And;3$;21| |SINT;Or;3$;22| |SINT;xor;3$;23| + |SINT;<;2$B;24| |SINT;inc;2$;25| |SINT;dec;2$;26| + |SINT;-;2$;27| |SINT;+;3$;28| |SINT;-;3$;29| + |SINT;*;3$;30| (|NonNegativeInteger|) |SINT;**;$Nni$;31| + |SINT;quo;3$;32| |SINT;rem;3$;33| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + |SINT;divide;2$R;34| |SINT;gcd;3$;35| |SINT;abs;2$;36| + |SINT;odd?;$B;37| |SINT;zero?;$B;38| |SINT;one?;$B;39| + |SINT;max;3$;40| |SINT;min;3$;41| |SINT;hash;2$;42| + |SINT;length;2$;43| |SINT;shift;3$;44| |SINT;mulmod;4$;45| + |SINT;addmod;4$;46| |SINT;submod;4$;47| + |SINT;negative?;$B;48| (|Vector| 12) + (|Record| (|:| |mat| 26) (|:| |vec| 76)) (|Vector| $) + |SINT;reducedSystem;MVR;49| |SINT;positiveRemainder;3$;50| + |SINT;coerce;I$;51| |SINT;random;$;52| |SINT;random;2$;53| + (|Record| (|:| |unit| $) (|:| |canonical| $) + (|:| |associate| $)) + |SINT;unitNormal;$R;54| (|Fraction| 12) + (|Union| 86 '"failed") (|Union| $ '"failed") (|Float|) + (|DoubleFloat|) (|Pattern| 12) (|PatternMatchResult| 12 $) + (|InputForm|) (|Union| 12 '"failed") (|List| $) + (|Record| (|:| |coef| 95) (|:| |generator| $)) + (|Union| 95 '"failed") + (|Record| (|:| |coef1| $) (|:| |coef2| $) + (|:| |generator| $)) + (|Record| (|:| |coef1| $) (|:| |coef2| $)) + (|Union| 99 '"failed") (|Factored| $) + (|SparseUnivariatePolynomial| $) (|PositiveInteger|) + (|SingleInteger|)) + '#(~= 58 ~ 64 |zero?| 69 |xor| 74 |unitNormal| 80 + |unitCanonical| 85 |unit?| 90 |symmetricRemainder| 95 + |subtractIfCan| 101 |submod| 107 |squareFreePart| 114 + |squareFree| 119 |sizeLess?| 124 |sign| 130 |shift| 135 + |sample| 141 |retractIfCan| 145 |retract| 150 |rem| 155 + |reducedSystem| 161 |recip| 172 |rationalIfCan| 177 + |rational?| 182 |rational| 187 |random| 192 |quo| 201 + |principalIdeal| 207 |prime?| 212 |powmod| 217 + |positiveRemainder| 224 |positive?| 230 |permutation| 235 + |patternMatch| 241 |one?| 248 |odd?| 253 |not| 258 + |nextItem| 263 |negative?| 268 |multiEuclidean| 273 + |mulmod| 279 |min| 286 |max| 296 |mask| 306 |length| 311 + |lcm| 316 |latex| 327 |invmod| 332 |init| 338 |inc| 342 + |hash| 347 |gcdPolynomial| 357 |gcd| 363 |factorial| 374 + |factor| 379 |extendedEuclidean| 384 |exquo| 397 + |expressIdealMember| 403 |even?| 409 |euclideanSize| 414 + |divide| 419 |differentiate| 425 |dec| 436 |copy| 441 + |convert| 446 |coerce| 471 |characteristic| 491 |bit?| 495 + |binomial| 501 |base| 507 |associates?| 511 |addmod| 517 + |abs| 524 ^ 529 |\\/| 541 |Zero| 547 |Or| 551 |One| 557 + |OMwrite| 561 |Not| 585 D 590 |And| 601 >= 607 > 613 = 619 + <= 625 < 631 |/\\| 637 - 643 + 654 ** 660 * 672) + '((|noetherian| . 0) (|canonicalsClosed| . 0) + (|canonical| . 0) (|canonicalUnitNormal| . 0) + (|multiplicativeValuation| . 0) (|noZeroDivisors| . 0) + ((|commutative| "*") . 0) (|rightUnitary| . 0) + (|leftUnitary| . 0) (|unitsKnown| . 0)) + (CONS (|makeByteWordVec2| 1 + '(0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 + 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0)) + (CONS '#(|IntegerNumberSystem&| |EuclideanDomain&| + |UniqueFactorizationDomain&| NIL NIL + |GcdDomain&| |IntegralDomain&| |Algebra&| NIL + NIL |DifferentialRing&| |OrderedRing&| NIL NIL + |Module&| NIL NIL |Ring&| NIL NIL NIL NIL NIL + |AbelianGroup&| NIL NIL |AbelianMonoid&| + |Monoid&| NIL NIL |OrderedSet&| + |AbelianSemiGroup&| |SemiGroup&| |Logic&| NIL + |SetCategory&| NIL NIL NIL NIL NIL NIL + |RetractableTo&| NIL |BasicType&| NIL) + (CONS '#((|IntegerNumberSystem|) + (|EuclideanDomain|) + (|UniqueFactorizationDomain|) + (|PrincipalIdealDomain|) + (|OrderedIntegralDomain|) (|GcdDomain|) + (|IntegralDomain|) (|Algebra| $$) + (|CharacteristicZero|) + (|LinearlyExplicitRingOver| 12) + (|DifferentialRing|) (|OrderedRing|) + (|CommutativeRing|) (|EntireRing|) + (|Module| $$) (|OrderedAbelianGroup|) + (|BiModule| $$ $$) (|Ring|) + (|OrderedCancellationAbelianMonoid|) + (|LeftModule| $$) (|Rng|) + (|RightModule| $$) + (|OrderedAbelianMonoid|) + (|AbelianGroup|) + (|OrderedAbelianSemiGroup|) + (|CancellationAbelianMonoid|) + (|AbelianMonoid|) (|Monoid|) + (|StepThrough|) (|PatternMatchable| 12) + (|OrderedSet|) (|AbelianSemiGroup|) + (|SemiGroup|) (|Logic|) (|RealConstant|) + (|SetCategory|) (|OpenMath|) + (|ConvertibleTo| 89) + (|ConvertibleTo| 90) + (|CombinatorialFunctionCategory|) + (|ConvertibleTo| 91) + (|ConvertibleTo| 93) + (|RetractableTo| 12) + (|ConvertibleTo| 12) (|BasicType|) + (|CoercibleTo| 29)) + (|makeByteWordVec2| 104 + '(1 8 7 0 9 3 8 7 0 10 10 11 2 8 7 0 12 + 13 1 8 7 0 14 0 15 0 16 2 8 0 10 15 + 17 1 8 7 0 18 1 8 7 0 19 1 8 7 0 20 1 + 12 29 0 30 1 0 0 12 33 2 0 22 0 0 1 1 + 0 0 0 41 1 0 22 0 65 2 0 0 0 0 48 1 0 + 84 0 85 1 0 0 0 1 1 0 22 0 1 2 0 0 0 + 0 1 2 0 88 0 0 1 3 0 0 0 0 0 74 1 0 0 + 0 1 1 0 101 0 1 2 0 22 0 0 1 1 0 12 0 + 1 2 0 0 0 0 71 0 0 0 1 1 0 94 0 1 1 0 + 12 0 1 2 0 0 0 0 59 1 0 26 27 28 2 0 + 77 27 78 79 1 0 88 0 1 1 0 87 0 1 1 0 + 22 0 1 1 0 86 0 1 1 0 0 0 83 0 0 0 82 + 2 0 0 0 0 58 1 0 96 95 1 1 0 22 0 1 3 + 0 0 0 0 0 1 2 0 0 0 0 80 1 0 22 0 1 2 + 0 0 0 0 1 3 0 92 0 91 92 1 1 0 22 0 + 66 1 0 22 0 64 1 0 0 0 42 1 0 88 0 1 + 1 0 22 0 75 2 0 97 95 0 1 3 0 0 0 0 0 + 72 0 0 0 39 2 0 0 0 0 68 0 0 0 38 2 0 + 0 0 0 67 1 0 0 0 1 1 0 0 0 70 1 0 0 + 95 1 2 0 0 0 0 1 1 0 10 0 1 2 0 0 0 0 + 1 0 0 0 1 1 0 0 0 50 1 0 0 0 69 1 0 + 104 0 1 2 0 102 102 102 1 1 0 0 95 1 + 2 0 0 0 0 62 1 0 0 0 1 1 0 101 0 1 2 + 0 98 0 0 1 3 0 100 0 0 0 1 2 0 88 0 0 + 1 2 0 97 95 0 1 1 0 22 0 1 1 0 56 0 1 + 2 0 60 0 0 61 1 0 0 0 1 2 0 0 0 56 1 + 1 0 0 0 51 1 0 0 0 1 1 0 89 0 1 1 0 + 90 0 1 1 0 91 0 1 1 0 93 0 1 1 0 12 0 + 32 1 0 0 12 81 1 0 0 0 1 1 0 0 12 81 + 1 0 29 0 31 0 0 56 1 2 0 22 0 0 1 2 0 + 0 0 0 1 0 0 0 37 2 0 22 0 0 1 3 0 0 0 + 0 0 73 1 0 0 0 63 2 0 0 0 56 1 2 0 0 + 0 103 1 2 0 0 0 0 44 0 0 0 35 2 0 0 0 + 0 47 0 0 0 36 3 0 7 8 0 22 25 2 0 10 + 0 22 23 2 0 7 8 0 24 1 0 10 0 21 1 0 + 0 0 45 1 0 0 0 1 2 0 0 0 56 1 2 0 0 0 + 0 46 2 0 22 0 0 1 2 0 22 0 0 1 2 0 22 + 0 0 40 2 0 22 0 0 1 2 0 22 0 0 49 2 0 + 0 0 0 43 1 0 0 0 52 2 0 0 0 0 54 2 0 + 0 0 0 53 2 0 0 0 56 57 2 0 0 0 103 1 + 2 0 0 0 0 55 2 0 0 12 0 34 2 0 0 56 0 + 1 2 0 0 103 0 1))))) + '|lookupComplete|)) + +(MAKEPROP '|SingleInteger| 'NILADIC T) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp new file mode 100644 index 00000000..4b967563 --- /dev/null +++ b/src/algebra/strap/STAGG-.lsp @@ -0,0 +1,297 @@ + +(/VERSIONCHECK 2) + +(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) + +(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| $) + (SPADCALL |x| (QREFELT $ 9))) + +(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $) + (PROG (#0=#:G1411 |i|) + (RETURN + (SEQ (SPADCALL + (PROGN + (LETT #0# NIL |STAGG-;first;ANniA;3|) + (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (|STAGG-;c2| |x| + (LETT |x| + (SPADCALL |x| (QREFELT $ 13)) + |STAGG-;first;ANniA;3|) + $) + #0#) + |STAGG-;first;ANniA;3|))) + (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))) + (QREFELT $ 15)))))) + +(DEFUN |STAGG-;c2| (|x| |r| $) + (COND + ((SPADCALL |x| (QREFELT $ 18)) (|error| "Index out of range")) + ('T (SPADCALL |x| (QREFELT $ 19))))) + +(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) + (PROG (#0=#:G1414) + (RETURN + (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;elt;AIS;5|) + (COND + ((OR (< |i| 0) + (SPADCALL + (LETT |x| + (SPADCALL |x| + (PROG1 (LETT #0# |i| + |STAGG-;elt;AIS;5|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 22)) + |STAGG-;elt;AIS;5|) + (QREFELT $ 18))) + (EXIT (|error| "index out of range")))) + (EXIT (SPADCALL |x| (QREFELT $ 19))))))) + +(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) + (PROG (|l| #0=#:G1418 |h| #1=#:G1420 #2=#:G1421) + (RETURN + (SEQ (LETT |l| + (- (SPADCALL |i| (QREFELT $ 25)) + (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |l| 0) (|error| "index out of range")) + ((NULL (SPADCALL |i| (QREFELT $ 26))) + (SPADCALL + (SPADCALL |x| + (PROG1 (LETT #0# |l| |STAGG-;elt;AUsA;6|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 22)) + (QREFELT $ 27))) + ('T + (SEQ (LETT |h| + (- (SPADCALL |i| (QREFELT $ 28)) + (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |h| |l|) + (SPADCALL (QREFELT $ 29))) + ('T + (SPADCALL + (SPADCALL |x| + (PROG1 + (LETT #1# |l| + |STAGG-;elt;AUsA;6|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) #1#)) + (QREFELT $ 22)) + (PROG1 + (LETT #2# (+ (- |h| |l|) 1) + |STAGG-;elt;AUsA;6|) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)) + (QREFELT $ 30))))))))))))) + +(DEFUN |STAGG-;concat;3A;7| (|x| |y| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 27)) |y| (QREFELT $ 32))) + +(DEFUN |STAGG-;concat;LA;8| (|l| $) + (COND + ((NULL |l|) (SPADCALL (QREFELT $ 29))) + ('T + (SPADCALL (SPADCALL (|SPADfirst| |l|) (QREFELT $ 27)) + (SPADCALL (CDR |l|) (QREFELT $ 35)) (QREFELT $ 32))))) + +(DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) + (PROG (|y|) + (RETURN + (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |l| (QREFELT $ 18)) + (QREFELT $ 10))) + (GO G191))) + (SEQ (SPADCALL |l| + (SPADCALL (SPADCALL |l| (QREFELT $ 19)) |f|) + (QREFELT $ 37)) + (EXIT (LETT |l| (SPADCALL |l| (QREFELT $ 13)) + |STAGG-;map!;M2A;9|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|))))) + +(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) + (PROG (|y|) + (RETURN + (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |y| (QREFELT $ 18)) + (QREFELT $ 10))) + (GO G191))) + (SEQ (SPADCALL |y| |s| (QREFELT $ 37)) + (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 13)) + |STAGG-;fill!;ASA;10|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) + (PROG (#0=#:G1437) + (RETURN + (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;setelt;AI2S;11|) + (COND + ((OR (< |i| 0) + (SPADCALL + (LETT |x| + (SPADCALL |x| + (PROG1 (LETT #0# |i| + |STAGG-;setelt;AI2S;11|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 22)) + |STAGG-;setelt;AI2S;11|) + (QREFELT $ 18))) + (EXIT (|error| "index out of range")))) + (EXIT (SPADCALL |x| |s| (QREFELT $ 37))))))) + +(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) + (PROG (|l| |h| #0=#:G1442 #1=#:G1443 |z| |y|) + (RETURN + (SEQ (LETT |l| + (- (SPADCALL |i| (QREFELT $ 25)) + (SPADCALL |x| (QREFELT $ 21))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |l| 0) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (QREFELT $ 26)) + (- (SPADCALL |i| (QREFELT $ 28)) + (SPADCALL |x| (QREFELT $ 21)))) + ('T (SPADCALL |x| (QREFELT $ 42)))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |h| |l|) |s|) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (PROG1 + (LETT #0# |l| + |STAGG-;setelt;AUs2S;12|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) + #0#)) + (QREFELT $ 22)) + |STAGG-;setelt;AUs2S;12|) + (LETT |z| + (SPADCALL |y| + (PROG1 + (LETT #1# (+ (- |h| |l|) 1) + |STAGG-;setelt;AUs2S;12|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) + #1#)) + (QREFELT $ 22)) + |STAGG-;setelt;AUs2S;12|) + (SEQ G190 + (COND + ((NULL + (SPADCALL + (SPADCALL |y| |z| + (QREFELT $ 43)) + (QREFELT $ 10))) + (GO G191))) + (SEQ + (SPADCALL |y| |s| + (QREFELT $ 37)) + (EXIT + (LETT |y| + (SPADCALL |y| + (QREFELT $ 13)) + |STAGG-;setelt;AUs2S;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |s|))))))))))))) + +(DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 18)) |y|) + ('T + (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| + (QREFELT $ 46)) + (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 $ (GETREFV 52) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasAttribute| |#1| '|shallowlyMutable|) + (PROGN + (QSETREFV $ 33 + (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $)) + (QSETREFV $ 36 + (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $)) + (QSETREFV $ 39 + (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $)) + (QSETREFV $ 40 + (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $)) + (QSETREFV $ 41 + (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $)) + (QSETREFV $ 44 + (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $)) + (QSETREFV $ 47 + (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $))))) + $)))) + +(MAKEPROP '|StreamAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|Boolean|) (0 . |cyclic?|) (5 . |not|) + |STAGG-;explicitlyFinite?;AB;1| + |STAGG-;possiblyInfinite?;AB;2| (10 . |rest|) (|List| 7) + (15 . |construct|) (|NonNegativeInteger|) + |STAGG-;first;ANniA;3| (20 . |empty?|) (25 . |first|) + (|Integer|) (30 . |minIndex|) (35 . |rest|) + |STAGG-;elt;AIS;5| (|UniversalSegment| 20) (41 . |lo|) + (46 . |hasHi|) (51 . |copy|) (56 . |hi|) (61 . |empty|) + (65 . |first|) |STAGG-;elt;AUsA;6| (71 . |concat!|) + (77 . |concat|) (|List| $) (83 . |concat|) (88 . |concat|) + (93 . |setfirst!|) (|Mapping| 7 7) (99 . |map!|) + (105 . |fill!|) (111 . |setelt|) (118 . |maxIndex|) + (123 . |eq?|) (129 . |setelt|) (136 . |tail|) + (141 . |setrest!|) (147 . |concat!|) '"rest" '"last" + '"first" '"value") + '#(|setelt| 153 |possiblyInfinite?| 167 |map!| 172 |first| + 178 |fill!| 184 |explicitlyFinite?| 190 |elt| 195 + |concat!| 207 |concat| 213) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 47 + '(1 6 8 0 9 1 8 0 0 10 1 6 0 0 13 1 6 0 + 14 15 1 6 8 0 18 1 6 7 0 19 1 6 20 0 + 21 2 6 0 0 16 22 1 24 20 0 25 1 24 8 + 0 26 1 6 0 0 27 1 24 20 0 28 0 6 0 29 + 2 6 0 0 16 30 2 6 0 0 0 32 2 0 0 0 0 + 33 1 6 0 34 35 1 0 0 34 36 2 6 7 0 7 + 37 2 0 0 38 0 39 2 0 0 0 7 40 3 0 7 0 + 20 7 41 1 6 20 0 42 2 6 8 0 0 43 3 0 + 7 0 24 7 44 1 6 0 0 45 2 6 0 0 0 46 2 + 0 0 0 0 47 3 0 7 0 20 7 41 3 0 7 0 24 + 7 44 1 0 8 0 12 2 0 0 38 0 39 2 0 0 0 + 16 17 2 0 0 0 7 40 1 0 8 0 11 2 0 7 0 + 20 23 2 0 0 0 24 31 2 0 0 0 0 47 1 0 + 0 34 36 2 0 0 0 0 33))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp new file mode 100644 index 00000000..95a087cb --- /dev/null +++ b/src/algebra/strap/STAGG.lsp @@ -0,0 +1,41 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |StreamAggregate;CAT| 'NIL) + +(DEFPARAMETER |StreamAggregate;AL| 'NIL) + +(DEFUN |StreamAggregate| (#0=#:G1405) + (LET (#1=#:G1406) + (COND + ((SETQ #1# (|assoc| (|devaluate| #0#) |StreamAggregate;AL|)) + (CDR #1#)) + (T (SETQ |StreamAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# (|StreamAggregate;| #0#))) + |StreamAggregate;AL|)) + #1#)))) + +(DEFUN |StreamAggregate;| (|t#1|) + (PROG (#0=#:G1404) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|StreamAggregate;CAT|) + ('T + (LETT |StreamAggregate;CAT| + (|Join| (|UnaryRecursiveAggregate| + '|t#1|) + (|LinearAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|explicitlyFinite?| + ((|Boolean|) $)) + T) + ((|possiblyInfinite?| + ((|Boolean|) $)) + T)) + NIL '((|Boolean|)) NIL)) + . #1=(|StreamAggregate|))))) . #1#) + (SETELT #0# 0 (LIST '|StreamAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp new file mode 100644 index 00000000..82291964 --- /dev/null +++ b/src/algebra/strap/SYMBOL.lsp @@ -0,0 +1,816 @@ + +(/VERSIONCHECK 2) + +(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $) + (COND + ((SPADCALL |x| (|getShellEntry| $ 22)) + (|error| "Cannot convert a scripted symbol to OpenMath")) + ('T (SPADCALL |dev| |x| (|getShellEntry| $ 26))))) + +(DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SYMBOL;OMwrite;$S;2|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 28)) + (|getShellEntry| $ 29)) + |SYMBOL;OMwrite;$S;2|) + (SPADCALL |dev| (|getShellEntry| $ 30)) + (|SYMBOL;writeOMSym| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 31)) + (SPADCALL |dev| (|getShellEntry| $ 32)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SYMBOL;OMwrite;$S;2|) + (EXIT |s|))))) + +(DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| $) + (PROG (|sp| |dev| |s|) + (RETURN + (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) + (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) + |SYMBOL;OMwrite;$BS;3|) + (LETT |dev| + (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 28)) + (|getShellEntry| $ 29)) + |SYMBOL;OMwrite;$BS;3|) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 30)))) + (|SYMBOL;writeOMSym| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31)))) + (SPADCALL |dev| (|getShellEntry| $ 32)) + (LETT |s| (OM-STRINGPTRTOSTRING |sp|) + |SYMBOL;OMwrite;$BS;3|) + (EXIT |s|))))) + +(DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| $) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 30)) + (|SYMBOL;writeOMSym| |dev| |x| $) + (EXIT (SPADCALL |dev| (|getShellEntry| $ 31))))) + +(DEFUN |SYMBOL;OMwrite;Omd$BV;5| (|dev| |x| |wholeObj| $) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 30)))) + (|SYMBOL;writeOMSym| |dev| |x| $) + (EXIT (COND + (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31))))))) + +(DEFUN |SYMBOL;convert;$If;6| (|s| $) + (SPADCALL |s| (|getShellEntry| $ 45))) + +(PUT '|SYMBOL;convert;$S;7| '|SPADreplace| '(XLAM (|s|) |s|)) + +(DEFUN |SYMBOL;convert;$S;7| (|s| $) |s|) + +(DEFUN |SYMBOL;coerce;S$;8| (|s| $) (VALUES (INTERN |s|))) + +(PUT '|SYMBOL;=;2$B;9| '|SPADreplace| 'EQUAL) + +(DEFUN |SYMBOL;=;2$B;9| (|x| |y| $) (EQUAL |x| |y|)) + +(PUT '|SYMBOL;<;2$B;10| '|SPADreplace| + '(XLAM (|x| |y|) (GGREATERP |y| |x|))) + +(DEFUN |SYMBOL;<;2$B;10| (|x| |y| $) (GGREATERP |y| |x|)) + +(DEFUN |SYMBOL;coerce;$Of;11| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 52))) + +(DEFUN |SYMBOL;subscript;$L$;12| (|sy| |lx| $) + (SPADCALL |sy| (LIST |lx| NIL NIL NIL NIL) (|getShellEntry| $ 56))) + +(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| $) + (SPADCALL |sy| |lx| (|getShellEntry| $ 57))) + +(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| $) + (SPADCALL |sy| (LIST NIL |lx| NIL NIL NIL) (|getShellEntry| $ 56))) + +(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| $) + (SPADCALL |sy| (LIST NIL NIL NIL NIL |lx|) (|getShellEntry| $ 56))) + +(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 64))) + +(DEFUN |SYMBOL;patternMatch;$P2Pmr;17| (|x| |p| |l| $) + (SPADCALL |x| |p| |l| (|getShellEntry| $ 71))) + +(DEFUN |SYMBOL;convert;$P;18| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 74))) + +(DEFUN |SYMBOL;convert;$P;19| (|x| $) + (SPADCALL |x| (|getShellEntry| $ 76))) + +(DEFUN |SYMBOL;syprefix| (|sc| $) + (PROG (|ns| #0=#:G1449 |n| #1=#:G1450) + (RETURN + (SEQ (LETT |ns| + (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) + (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) + |SYMBOL;syprefix|) + (SEQ G190 + (COND + ((NULL (COND + ((< (LENGTH |ns|) 2) 'NIL) + ('T (ZEROP (|SPADfirst| |ns|))))) + (GO G191))) + (SEQ (EXIT (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL + (CONS (STRCONC (|getShellEntry| $ 37) + (|SYMBOL;istring| + (LENGTH (QVELT |sc| 4)) $)) + (PROGN + (LETT #0# NIL |SYMBOL;syprefix|) + (SEQ (LETT |n| NIL |SYMBOL;syprefix|) + (LETT #1# (NREVERSE |ns|) + |SYMBOL;syprefix|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |n| (CAR #1#) + |SYMBOL;syprefix|) + NIL)) + (GO G191))) + (SEQ (EXIT + (LETT #0# + (CONS (|SYMBOL;istring| |n| $) + #0#) + |SYMBOL;syprefix|))) + (LETT #1# (CDR #1#) + |SYMBOL;syprefix|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#))))) + (|getShellEntry| $ 79))))))) + +(DEFUN |SYMBOL;syscripts| (|sc| $) + (PROG (|all|) + (RETURN + (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) + (LETT |all| + (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 80)) + |SYMBOL;syscripts|) + (LETT |all| + (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 80)) + |SYMBOL;syscripts|) + (LETT |all| + (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 80)) + |SYMBOL;syscripts|) + (EXIT (SPADCALL |all| (QVELT |sc| 4) (|getShellEntry| $ 80))))))) + +(DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) + (PROG (|sc|) + (RETURN + (SEQ (LETT |sc| (VECTOR NIL NIL NIL NIL NIL) + |SYMBOL;script;$L$;22|) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (COND + ((NULL (NULL |ls|)) + (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) + (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SPADCALL |sy| |sc| (|getShellEntry| $ 82))))))) + +(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $) + (COND + ((SPADCALL |sy| (|getShellEntry| $ 22)) + (|error| "Cannot add scripts to a scripted symbol")) + ('T + (CONS (SPADCALL + (SPADCALL + (STRCONC (|SYMBOL;syprefix| |sc| $) + (SPADCALL + (SPADCALL |sy| (|getShellEntry| $ 83)) + (|getShellEntry| $ 84))) + (|getShellEntry| $ 48)) + (|getShellEntry| $ 53)) + (|SYMBOL;syscripts| |sc| $))))) + +(DEFUN |SYMBOL;string;$S;24| (|e| $) + (COND + ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (PNAME |e|)) + ('T (|error| "Cannot form string from non-atomic symbols.")))) + +(DEFUN |SYMBOL;latex;$S;25| (|e| $) + (PROG (|ss| |lo| |sc| |s|) + (RETURN + (SEQ (LETT |s| (PNAME (SPADCALL |e| (|getShellEntry| $ 83))) + |SYMBOL;latex;$S;25|) + (COND + ((< 1 (QCSIZE |s|)) + (COND + ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 85)) + (SPADCALL "\\" (|getShellEntry| $ 40)) + (|getShellEntry| $ 86)) + (LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")) + |SYMBOL;latex;$S;25|))))) + (COND + ((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (EXIT |s|))) + (LETT |ss| (SPADCALL |e| (|getShellEntry| $ 87)) + |SYMBOL;latex;$S;25|) + (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |s| |sc|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 1) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |s| |sc|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 2) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |sc| |s|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 3) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |sc| |s|) + |SYMBOL;latex;$S;25|))))) + (LETT |lo| (QVELT |ss| 4) |SYMBOL;latex;$S;25|) + (COND + ((NULL (NULL |lo|)) + (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lo|) + (|getShellEntry| $ 88))) + (GO G191))) + (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 89))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (EXIT (COND + ((NULL (NULL |lo|)) + (LETT |sc| (STRCONC |sc| ", ") + |SYMBOL;latex;$S;25|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |sc| (STRCONC |sc| "} \\right)") + |SYMBOL;latex;$S;25|) + (EXIT (LETT |s| (STRCONC |s| |sc|) + |SYMBOL;latex;$S;25|))))) + (EXIT |s|))))) + +(DEFUN |SYMBOL;anyRadix| (|n| |s| $) + (PROG (|qr| |ns| #0=#:G1500) + (RETURN + (SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) + (EXIT (SEQ G190 NIL + (SEQ (LETT |qr| + (DIVIDE2 |n| (QCSIZE |s|)) + |SYMBOL;anyRadix|) + (LETT |n| (QCAR |qr|) + |SYMBOL;anyRadix|) + (LETT |ns| + (SPADCALL + (SPADCALL |s| + (+ (QCDR |qr|) + (SPADCALL |s| + (|getShellEntry| $ 91))) + (|getShellEntry| $ 85)) + |ns| (|getShellEntry| $ 92)) + |SYMBOL;anyRadix|) + (EXIT + (COND + ((ZEROP |n|) + (PROGN + (LETT #0# |ns| + |SYMBOL;anyRadix|) + (GO #0#)))))) + NIL (GO G190) G191 (EXIT NIL))))) + #0# (EXIT #0#))))) + +(DEFUN |SYMBOL;new;$;27| ($) + (PROG (|sym|) + (RETURN + (SEQ (LETT |sym| + (|SYMBOL;anyRadix| + (SPADCALL (|getShellEntry| $ 9) + (|getShellEntry| $ 93)) + (|getShellEntry| $ 19) $) + |SYMBOL;new;$;27|) + (SPADCALL (|getShellEntry| $ 9) + (+ (SPADCALL (|getShellEntry| $ 9) + (|getShellEntry| $ 93)) + 1) + (|getShellEntry| $ 94)) + (EXIT (SPADCALL (STRCONC "%" |sym|) (|getShellEntry| $ 48))))))) + +(DEFUN |SYMBOL;new;2$;28| (|x| $) + (PROG (|u| |n| |xx|) + (RETURN + (SEQ (LETT |n| + (SEQ (LETT |u| + (SPADCALL |x| (|getShellEntry| $ 12) + (|getShellEntry| $ 97)) + |SYMBOL;new;2$;28|) + (EXIT (COND + ((QEQCAR |u| 1) 0) + ('T (+ (QCDR |u|) 1))))) + |SYMBOL;new;2$;28|) + (SPADCALL (|getShellEntry| $ 12) |x| |n| + (|getShellEntry| $ 98)) + (LETT |xx| + (COND + ((NULL (SPADCALL |x| (|getShellEntry| $ 22))) + (SPADCALL |x| (|getShellEntry| $ 84))) + ('T + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 83)) + (|getShellEntry| $ 84)))) + |SYMBOL;new;2$;28|) + (LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|) + (LETT |xx| + (COND + ((NULL (< (SPADCALL + (SPADCALL |xx| + (SPADCALL |xx| + (|getShellEntry| $ 99)) + (|getShellEntry| $ 85)) + (|getShellEntry| $ 18) + (|getShellEntry| $ 100)) + (SPADCALL (|getShellEntry| $ 18) + (|getShellEntry| $ 91)))) + (STRCONC |xx| + (|SYMBOL;anyRadix| |n| + (|getShellEntry| $ 20) $))) + ('T + (STRCONC |xx| + (|SYMBOL;anyRadix| |n| + (|getShellEntry| $ 18) $)))) + |SYMBOL;new;2$;28|) + (COND + ((NULL (SPADCALL |x| (|getShellEntry| $ 22))) + (EXIT (SPADCALL |xx| (|getShellEntry| $ 48))))) + (EXIT (SPADCALL (SPADCALL |xx| (|getShellEntry| $ 48)) + (SPADCALL |x| (|getShellEntry| $ 87)) + (|getShellEntry| $ 82))))))) + +(DEFUN |SYMBOL;resetNew;V;29| ($) + (PROG (|k| #0=#:G1523) + (RETURN + (SEQ (SPADCALL (|getShellEntry| $ 9) 0 (|getShellEntry| $ 94)) + (SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|) + (LETT #0# + (SPADCALL (|getShellEntry| $ 12) + (|getShellEntry| $ 103)) + |SYMBOL;resetNew;V;29|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |k| (CAR #0#) |SYMBOL;resetNew;V;29|) + NIL)) + (GO G191))) + (SEQ (EXIT (SPADCALL |k| (|getShellEntry| $ 12) + (|getShellEntry| $ 104)))) + (LETT #0# (CDR #0#) |SYMBOL;resetNew;V;29|) (GO G190) + G191 (EXIT NIL)) + (EXIT (SPADCALL (|getShellEntry| $ 105))))))) + +(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) + (SPADCALL (ATOM |sy|) (|getShellEntry| $ 88))) + +(DEFUN |SYMBOL;name;2$;31| (|sy| $) + (PROG (|str| |i| #0=#:G1530 #1=#:G1529 #2=#:G1527) + (RETURN + (SEQ (EXIT (COND + ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) |sy|) + ('T + (SEQ (LETT |str| + (SPADCALL + (SPADCALL + (SPADCALL |sy| + (|getShellEntry| $ 107)) + (|getShellEntry| $ 108)) + (|getShellEntry| $ 84)) + |SYMBOL;name;2$;31|) + (SEQ (EXIT (SEQ + (LETT |i| + (+ (|getShellEntry| $ 38) 1) + |SYMBOL;name;2$;31|) + (LETT #0# (QCSIZE |str|) + |SYMBOL;name;2$;31|) + G190 + (COND ((> |i| #0#) (GO G191))) + (SEQ + (EXIT + (COND + ((NULL + (SPADCALL + (SPADCALL |str| |i| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 109))) + (PROGN + (LETT #2# + (PROGN + (LETT #1# + (SPADCALL + (SPADCALL |str| + (SPADCALL |i| + (QCSIZE |str|) + (|getShellEntry| $ + 111)) + (|getShellEntry| $ + 112)) + (|getShellEntry| $ 48)) + |SYMBOL;name;2$;31|) + (GO #1#)) + |SYMBOL;name;2$;31|) + (GO #2#)))))) + (LETT |i| (+ |i| 1) + |SYMBOL;name;2$;31|) + (GO G190) G191 (EXIT NIL))) + #2# (EXIT #2#)) + (EXIT (|error| "Improper scripted symbol")))))) + #1# (EXIT #1#))))) + +(DEFUN |SYMBOL;scripts;$R;32| (|sy| $) + (PROG (|lscripts| |str| |nstr| |j| #0=#:G1533 |nscripts| |m| |n| + #1=#:G1542 |i| #2=#:G1543 |a| #3=#:G1544 |allscripts|) + (RETURN + (SEQ (COND + ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) + (VECTOR NIL NIL NIL NIL NIL)) + ('T + (SEQ (LETT |nscripts| (LIST 0 0 0 0 0) + |SYMBOL;scripts;$R;32|) + (LETT |lscripts| (LIST NIL NIL NIL NIL NIL) + |SYMBOL;scripts;$R;32|) + (LETT |str| + (SPADCALL + (SPADCALL + (SPADCALL |sy| + (|getShellEntry| $ 107)) + (|getShellEntry| $ 108)) + (|getShellEntry| $ 84)) + |SYMBOL;scripts;$R;32|) + (LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|) + (LETT |m| + (SPADCALL |nscripts| (|getShellEntry| $ 114)) + |SYMBOL;scripts;$R;32|) + (SEQ (LETT |j| (+ (|getShellEntry| $ 38) 1) + |SYMBOL;scripts;$R;32|) + (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 + (COND + ((OR (> |j| |nstr|) + (NULL (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 109)))) + (GO G191))) + (SEQ (EXIT (SPADCALL |nscripts| |i| + (PROG1 + (LETT #0# + (- + (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 42)) + (|getShellEntry| $ 43)) + |SYMBOL;scripts;$R;32|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 115)))) + (LETT |i| + (PROG1 (+ |i| 1) + (LETT |j| (+ |j| 1) + |SYMBOL;scripts;$R;32|)) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 (EXIT NIL)) + (LETT |nscripts| + (SPADCALL (CDR |nscripts|) + (|SPADfirst| |nscripts|) + (|getShellEntry| $ 116)) + |SYMBOL;scripts;$R;32|) + (LETT |allscripts| + (SPADCALL + (SPADCALL |sy| (|getShellEntry| $ 107)) + (|getShellEntry| $ 117)) + |SYMBOL;scripts;$R;32|) + (LETT |m| + (SPADCALL |lscripts| (|getShellEntry| $ 118)) + |SYMBOL;scripts;$R;32|) + (SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|) + (LETT #1# |nscripts| |SYMBOL;scripts;$R;32|) + (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |n| (CAR #1#) + |SYMBOL;scripts;$R;32|) + NIL)) + (GO G191))) + (SEQ (EXIT (COND + ((< + (SPADCALL |allscripts| + (|getShellEntry| $ 119)) + |n|) + (|error| + "Improper script count in symbol")) + ('T + (SEQ + (SPADCALL |lscripts| |i| + (PROGN + (LETT #2# NIL + |SYMBOL;scripts;$R;32|) + (SEQ + (LETT |a| NIL + |SYMBOL;scripts;$R;32|) + (LETT #3# + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 120)) + |SYMBOL;scripts;$R;32|) + G190 + (COND + ((OR (ATOM #3#) + (PROGN + (LETT |a| (CAR #3#) + |SYMBOL;scripts;$R;32|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #2# + (CONS + (SPADCALL |a| + (|getShellEntry| $ 53)) + #2#) + |SYMBOL;scripts;$R;32|))) + (LETT #3# (CDR #3#) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 + (EXIT (NREVERSE0 #2#)))) + (|getShellEntry| $ 121)) + (EXIT + (LETT |allscripts| + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 122)) + |SYMBOL;scripts;$R;32|))))))) + (LETT |i| + (PROG1 (+ |i| 1) + (LETT #1# (CDR #1#) + |SYMBOL;scripts;$R;32|)) + |SYMBOL;scripts;$R;32|) + (GO G190) G191 (EXIT NIL)) + (EXIT (VECTOR (SPADCALL |lscripts| |m| + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 1) + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 2) + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 3) + (|getShellEntry| $ 123)) + (SPADCALL |lscripts| (+ |m| 4) + (|getShellEntry| $ 123))))))))))) + +(DEFUN |SYMBOL;istring| (|n| $) + (COND + ((< 9 |n|) (|error| "Can have at most 9 scripts of each kind")) + ('T (ELT (|getShellEntry| $ 17) (+ |n| 0))))) + +(DEFUN |SYMBOL;list;$L;34| (|sy| $) + (COND + ((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) + (|error| "Cannot convert a symbol to a list if it is not subscripted")) + ('T |sy|))) + +(DEFUN |SYMBOL;sample;$;35| ($) + (SPADCALL "aSymbol" (|getShellEntry| $ 48))) + +(DEFUN |Symbol| () + (PROG () + (RETURN + (PROG (#0=#:G1551) + (RETURN + (COND + ((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|) + (|CDRwithIncrement| (CDAR #0#))) + ('T + (UNWIND-PROTECT + (PROG1 (CDDAR (HPUT |$ConstructorCache| '|Symbol| + (LIST + (CONS NIL (CONS 1 (|Symbol;|)))))) + (LETT #0# T |Symbol|)) + (COND ((NOT #0#) (HREM |$ConstructorCache| '|Symbol|))))))))))) + +(DEFUN |Symbol;| () + (PROG (|dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$| '(|Symbol|) . #0=(|Symbol|)) + (LETT $ (|newShell| 126) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|haddProp| |$ConstructorCache| '|Symbol| NIL (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 9 (SPADCALL 0 (|getShellEntry| $ 8))) + (|setShellEntry| $ 12 (SPADCALL (|getShellEntry| $ 11))) + (|setShellEntry| $ 17 + (SPADCALL (LIST "0" "1" "2" "3" "4" "5" "6" "7" "8" "9") + (|getShellEntry| $ 16))) + (|setShellEntry| $ 18 "0123456789") + (|setShellEntry| $ 19 "ABCDEFGHIJKLMNOPQRSTUVWXYZ") + (|setShellEntry| $ 20 "abcdefghijklmnopqrstuvwxyz") + (|setShellEntry| $ 37 "*") + (|setShellEntry| $ 38 (QCSIZE (|getShellEntry| $ 37))) + (|setShellEntry| $ 43 + (SPADCALL (SPADCALL "0" (|getShellEntry| $ 40)) + (|getShellEntry| $ 42))) + $)))) + +(MAKEPROP '|Symbol| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|Integer|) (|Reference| 6) + (0 . |ref|) '|count| (|AssociationList| $$ 6) + (5 . |empty|) '|xcount| (|String|) (|List| 13) + (|PrimitiveArray| 13) (9 . |construct|) '|istrings| + '|nums| 'ALPHAS '|alphas| (|Boolean|) + |SYMBOL;scripted?;$B;30| (|Void|) (|Symbol|) + (|OpenMathDevice|) (14 . |OMputVariable|) + (|OpenMathEncoding|) (20 . |OMencodingXML|) + (24 . |OMopenString|) (30 . |OMputObject|) + (35 . |OMputEndObject|) (40 . |OMclose|) + |SYMBOL;OMwrite;$S;2| |SYMBOL;OMwrite;$BS;3| + |SYMBOL;OMwrite;Omd$V;4| |SYMBOL;OMwrite;Omd$BV;5| '|hd| + '|lhd| (|Character|) (45 . |char|) (|NonNegativeInteger|) + (50 . |ord|) '|ord0| (|InputForm|) (55 . |convert|) + |SYMBOL;convert;$If;6| |SYMBOL;convert;$S;7| + |SYMBOL;coerce;S$;8| |SYMBOL;=;2$B;9| |SYMBOL;<;2$B;10| + (|OutputForm|) (60 . |outputForm|) |SYMBOL;coerce;$Of;11| + (|List| 51) (|List| 54) |SYMBOL;script;$L$;22| + |SYMBOL;subscript;$L$;12| |SYMBOL;elt;$L$;13| + |SYMBOL;superscript;$L$;14| |SYMBOL;argscript;$L$;15| + (|PatternMatchResult| 6 24) (|Pattern| 6) + (|PatternMatchSymbol| 6) (65 . |patternMatch|) + (|PatternMatchResult| 6 $) |SYMBOL;patternMatch;$P2Pmr;16| + (|Float|) (|PatternMatchResult| 67 24) (|Pattern| 67) + (|PatternMatchSymbol| 67) (72 . |patternMatch|) + (|PatternMatchResult| 67 $) + |SYMBOL;patternMatch;$P2Pmr;17| (79 . |coerce|) + |SYMBOL;convert;$P;18| (84 . |coerce|) + |SYMBOL;convert;$P;19| (|List| $) (89 . |concat|) + (94 . |concat|) + (|Record| (|:| |sub| 54) (|:| |sup| 54) (|:| |presup| 54) + (|:| |presub| 54) (|:| |args| 54)) + |SYMBOL;script;$R$;23| |SYMBOL;name;2$;31| + |SYMBOL;string;$S;24| (100 . |elt|) (106 . ~=) + |SYMBOL;scripts;$R;32| (112 . |not|) (117 . |latex|) + |SYMBOL;latex;$S;25| (122 . |minIndex|) (127 . |concat|) + (133 . |elt|) (138 . |setelt|) |SYMBOL;new;$;27| + (|Union| 6 '"failed") (144 . |search|) (150 . |setelt|) + (157 . |maxIndex|) (162 . |position|) |SYMBOL;new;2$;28| + (|List| $$) (168 . |keys|) (173 . |remove!|) + (179 . |void|) |SYMBOL;resetNew;V;29| |SYMBOL;list;$L;34| + (183 . |first|) (188 . |digit?|) (|UniversalSegment| 6) + (193 . SEGMENT) (199 . |elt|) (|List| 41) + (205 . |minIndex|) (210 . |setelt|) (217 . |concat|) + (223 . |rest|) (228 . |minIndex|) (233 . |#|) + (238 . |first|) (244 . |setelt|) (251 . |rest|) + (257 . |elt|) + (CONS IDENTITY + (FUNCALL (|dispatchFunction| |SYMBOL;sample;$;35|) + $)) + (|SingleInteger|)) + '#(~= 263 |superscript| 269 |subscript| 275 |string| 281 + |scripts| 286 |scripted?| 291 |script| 296 |sample| 308 + |resetNew| 312 |patternMatch| 316 |new| 330 |name| 339 + |min| 344 |max| 350 |list| 356 |latex| 361 |hash| 366 + |elt| 371 |convert| 377 |coerce| 397 |argscript| 407 + |OMwrite| 413 >= 437 > 443 = 449 <= 455 < 461) + 'NIL + (CONS (|makeByteWordVec2| 1 '(0 0 0 0 0 0 0 0 0 0 0)) + (CONS '#(|OrderedSet&| NIL NIL |SetCategory&| + |BasicType&| NIL NIL NIL NIL NIL NIL) + (CONS '#((|OrderedSet|) (|PatternMatchable| 67) + (|PatternMatchable| 6) (|SetCategory|) + (|BasicType|) (|ConvertibleTo| 69) + (|ConvertibleTo| 62) + (|ConvertibleTo| 24) (|OpenMath|) + (|ConvertibleTo| 44) (|CoercibleTo| 51)) + (|makeByteWordVec2| 125 + '(1 7 0 6 8 0 10 0 11 1 15 0 14 16 2 25 + 23 0 24 26 0 27 0 28 2 25 0 13 27 29 + 1 25 23 0 30 1 25 23 0 31 1 25 23 0 + 32 1 39 0 13 40 1 39 41 0 42 1 44 0 + 24 45 1 51 0 24 52 3 63 61 24 62 61 + 64 3 70 68 24 69 68 71 1 69 0 24 74 1 + 62 0 24 76 1 13 0 78 79 2 54 0 0 0 80 + 2 13 39 0 6 85 2 39 21 0 0 86 1 21 0 + 0 88 1 51 13 0 89 1 13 6 0 91 2 13 0 + 39 0 92 1 7 6 0 93 2 7 6 0 6 94 2 10 + 96 2 0 97 3 10 6 0 2 6 98 1 13 6 0 99 + 2 13 6 39 0 100 1 10 102 0 103 2 10 + 96 2 0 104 0 23 0 105 1 102 2 0 108 1 + 39 21 0 109 2 110 0 6 6 111 2 13 0 0 + 110 112 1 113 6 0 114 3 113 41 0 6 41 + 115 2 113 0 0 41 116 1 102 0 0 117 1 + 55 6 0 118 1 102 41 0 119 2 102 0 0 + 41 120 3 55 54 0 6 54 121 2 102 0 0 + 41 122 2 55 54 0 6 123 2 0 21 0 0 1 2 + 0 0 0 54 59 2 0 0 0 54 57 1 0 13 0 84 + 1 0 81 0 87 1 0 21 0 22 2 0 0 0 55 56 + 2 0 0 0 81 82 0 0 0 124 0 0 23 106 3 + 0 65 0 62 65 66 3 0 72 0 69 72 73 1 0 + 0 0 101 0 0 0 95 1 0 0 0 83 2 0 0 0 0 + 1 2 0 0 0 0 1 1 0 78 0 107 1 0 13 0 + 90 1 0 125 0 1 2 0 0 0 54 58 1 0 62 0 + 77 1 0 69 0 75 1 0 24 0 47 1 0 44 0 + 46 1 0 0 13 48 1 0 51 0 53 2 0 0 0 54 + 60 3 0 23 25 0 21 36 2 0 13 0 21 34 2 + 0 23 25 0 35 1 0 13 0 33 2 0 21 0 0 1 + 2 0 21 0 0 1 2 0 21 0 0 49 2 0 21 0 0 + 1 2 0 21 0 0 50))))) + '|lookupComplete|)) + +(MAKEPROP '|Symbol| 'NILADIC T) diff --git a/src/algebra/strap/TSETCAT-.lsp b/src/algebra/strap/TSETCAT-.lsp new file mode 100644 index 00000000..2b979ff7 --- /dev/null +++ b/src/algebra/strap/TSETCAT-.lsp @@ -0,0 +1,1031 @@ + +(/VERSIONCHECK 2) + +(DEFUN |TSETCAT-;=;2SB;1| (|ts| |us| $) + (PROG (#0=#:G1451 #1=#:G1457) + (RETURN + (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) + (SPADCALL |us| (|getShellEntry| $ 12))) + ((OR (SPADCALL |us| (|getShellEntry| $ 12)) + (NULL (SPADCALL + (PROG2 (LETT #0# + (SPADCALL |ts| + (|getShellEntry| $ 14)) + |TSETCAT-;=;2SB;1|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + (PROG2 (LETT #0# + (SPADCALL |us| + (|getShellEntry| $ 14)) + |TSETCAT-;=;2SB;1|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + (|getShellEntry| $ 15)))) + 'NIL) + ('T + (SPADCALL + (PROG2 (LETT #1# (SPADCALL |ts| (|getShellEntry| $ 17)) + |TSETCAT-;=;2SB;1|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) (|getShellEntry| $ 6) #1#)) + (PROG2 (LETT #1# (SPADCALL |us| (|getShellEntry| $ 17)) + |TSETCAT-;=;2SB;1|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) (|getShellEntry| $ 6) #1#)) + (|getShellEntry| $ 18))))))) + +(DEFUN |TSETCAT-;infRittWu?;2SB;2| (|ts| |us| $) + (PROG (|p| #0=#:G1464 |q| |v|) + (RETURN + (SEQ (COND + ((SPADCALL |us| (|getShellEntry| $ 12)) + (SPADCALL (SPADCALL |ts| (|getShellEntry| $ 12)) + (|getShellEntry| $ 20))) + ((SPADCALL |ts| (|getShellEntry| $ 12)) 'NIL) + ('T + (SEQ (LETT |p| + (PROG2 (LETT #0# + (SPADCALL |ts| + (|getShellEntry| $ 21)) + |TSETCAT-;infRittWu?;2SB;2|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + |TSETCAT-;infRittWu?;2SB;2|) + (LETT |q| + (PROG2 (LETT #0# + (SPADCALL |us| + (|getShellEntry| $ 21)) + |TSETCAT-;infRittWu?;2SB;2|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + |TSETCAT-;infRittWu?;2SB;2|) + (EXIT (COND + ((SPADCALL |p| |q| (|getShellEntry| $ 22)) + 'T) + ((SPADCALL |p| |q| (|getShellEntry| $ 23)) + 'NIL) + ('T + (SEQ (LETT |v| + (SPADCALL |p| + (|getShellEntry| $ 24)) + |TSETCAT-;infRittWu?;2SB;2|) + (EXIT (SPADCALL + (SPADCALL |ts| |v| + (|getShellEntry| $ 25)) + (SPADCALL |us| |v| + (|getShellEntry| $ 25)) + (|getShellEntry| $ 26)))))))))))))) + +(DEFUN |TSETCAT-;reduced?;PSMB;3| (|p| |ts| |redOp?| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;reduced?;PSMB;3|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL |p| (|SPADfirst| |lp|) |redOp?|)))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;reduced?;PSMB;3|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NULL |lp|)))))) + +(DEFUN |TSETCAT-;basicSet;LMU;4| (|ps| |redOp?| $) + (PROG (|b| |bs| |p| |ts|) + (RETURN + (SEQ (LETT |ps| (SPADCALL (ELT $ 32) |ps| (|getShellEntry| $ 34)) + |TSETCAT-;basicSet;LMU;4|) + (EXIT (COND + ((SPADCALL (ELT $ 35) |ps| (|getShellEntry| $ 36)) + (CONS 1 "failed")) + ('T + (SEQ (LETT |ps| + (SPADCALL (ELT $ 22) |ps| + (|getShellEntry| $ 37)) + |TSETCAT-;basicSet;LMU;4|) + (LETT |bs| (SPADCALL (|getShellEntry| $ 38)) + |TSETCAT-;basicSet;LMU;4|) + (LETT |ts| NIL |TSETCAT-;basicSet;LMU;4|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |ps|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |b| (|SPADfirst| |ps|) + |TSETCAT-;basicSet;LMU;4|) + (LETT |bs| + (SPADCALL |bs| |b| + (|getShellEntry| $ 39)) + |TSETCAT-;basicSet;LMU;4|) + (LETT |ps| (CDR |ps|) + |TSETCAT-;basicSet;LMU;4|) + (EXIT + (SEQ G190 + (COND + ((NULL + (COND + ((NULL |ps|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (LETT |p| + (|SPADfirst| |ps|) + |TSETCAT-;basicSet;LMU;4|) + |bs| |redOp?| + (|getShellEntry| $ 40)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ + (LETT |ts| (CONS |p| |ts|) + |TSETCAT-;basicSet;LMU;4|) + (EXIT + (LETT |ps| (CDR |ps|) + |TSETCAT-;basicSet;LMU;4|))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS 0 (CONS |bs| |ts|))))))))))) + +(DEFUN |TSETCAT-;basicSet;LMMU;5| (|ps| |pred?| |redOp?| $) + (PROG (|bps| |b| |bs| |p| |gps| |ts|) + (RETURN + (SEQ (LETT |ps| (SPADCALL (ELT $ 32) |ps| (|getShellEntry| $ 34)) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT (COND + ((SPADCALL (ELT $ 35) |ps| (|getShellEntry| $ 36)) + (CONS 1 "failed")) + ('T + (SEQ (LETT |gps| NIL |TSETCAT-;basicSet;LMMU;5|) + (LETT |bps| NIL |TSETCAT-;basicSet;LMMU;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |ps|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |ps|) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |ps| (CDR |ps|) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT + (COND + ((SPADCALL |p| |pred?|) + (LETT |gps| (CONS |p| |gps|) + |TSETCAT-;basicSet;LMMU;5|)) + ('T + (LETT |bps| (CONS |p| |bps|) + |TSETCAT-;basicSet;LMMU;5|))))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |gps| + (SPADCALL (ELT $ 22) |gps| + (|getShellEntry| $ 37)) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |bs| (SPADCALL (|getShellEntry| $ 38)) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |ts| NIL |TSETCAT-;basicSet;LMMU;5|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |gps|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |b| (|SPADfirst| |gps|) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |bs| + (SPADCALL |bs| |b| + (|getShellEntry| $ 39)) + |TSETCAT-;basicSet;LMMU;5|) + (LETT |gps| (CDR |gps|) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT + (SEQ G190 + (COND + ((NULL + (COND + ((NULL |gps|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (LETT |p| + (|SPADfirst| |gps|) + |TSETCAT-;basicSet;LMMU;5|) + |bs| |redOp?| + (|getShellEntry| $ 40)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ + (LETT |ts| (CONS |p| |ts|) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT + (LETT |gps| (CDR |gps|) + |TSETCAT-;basicSet;LMMU;5|))) + NIL (GO G190) G191 (EXIT NIL)))) + NIL (GO G190) G191 (EXIT NIL)) + (LETT |ts| + (SPADCALL (ELT $ 22) + (SPADCALL |ts| |bps| + (|getShellEntry| $ 44)) + (|getShellEntry| $ 37)) + |TSETCAT-;basicSet;LMMU;5|) + (EXIT (CONS 0 (CONS |bs| |ts|))))))))))) + +(DEFUN |TSETCAT-;initials;SL;6| (|ts| $) + (PROG (|p| |ip| |lip| |lp|) + (RETURN + (SEQ (LETT |lip| NIL |TSETCAT-;initials;SL;6|) + (EXIT (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) |lip|) + ('T + (SEQ (LETT |lp| + (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;initials;SL;6|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;initials;SL;6|) + (COND + ((NULL + (SPADCALL + (LETT |ip| + (SPADCALL |p| + (|getShellEntry| $ 46)) + |TSETCAT-;initials;SL;6|) + (|getShellEntry| $ 35))) + (LETT |lip| + (CONS + (SPADCALL |ip| + (|getShellEntry| $ 47)) + |lip|) + |TSETCAT-;initials;SL;6|))) + (EXIT + (LETT |lp| (CDR |lp|) + |TSETCAT-;initials;SL;6|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lip| (|getShellEntry| $ 48))))))))))) + +(DEFUN |TSETCAT-;degree;SNni;7| (|ts| $) + (PROG (|lp| |d|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) 0) + ('T + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;degree;SNni;7|) + (LETT |d| + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 51)) + |TSETCAT-;degree;SNni;7|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (NULL + (LETT |lp| (CDR |lp|) + |TSETCAT-;degree;SNni;7|)) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (EXIT (LETT |d| + (* |d| + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 51))) + |TSETCAT-;degree;SNni;7|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|)))))))) + +(DEFUN |TSETCAT-;quasiComponent;SR;8| (|ts| $) + (CONS (SPADCALL |ts| (|getShellEntry| $ 29)) + (SPADCALL |ts| (|getShellEntry| $ 53)))) + +(DEFUN |TSETCAT-;normalized?;PSB;9| (|p| |ts| $) + (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 57))) + +(DEFUN |TSETCAT-;stronglyReduced?;PSB;10| (|p| |ts| $) + (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 59))) + +(DEFUN |TSETCAT-;headReduced?;PSB;11| (|p| |ts| $) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 61)) |ts| + (|getShellEntry| $ 62))) + +(DEFUN |TSETCAT-;initiallyReduced?;PSB;12| (|p| |ts| $) + (PROG (|lp| |red|) + (RETURN + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;initiallyReduced?;PSB;12|) + (LETT |red| 'T |TSETCAT-;initiallyReduced?;PSB;12|) + (SEQ G190 + (COND + ((NULL (COND + ((OR (NULL |lp|) + (SPADCALL |p| (|getShellEntry| $ 35))) + 'NIL) + ('T |red|))) + (GO G191))) + (SEQ (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 24)) + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 64))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;initiallyReduced?;PSB;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((NULL (NULL |lp|)) + (COND + ((SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + (SPADCALL |p| + (|getShellEntry| $ 24)) + (|getShellEntry| $ 65)) + (COND + ((SPADCALL |p| (|SPADfirst| |lp|) + (|getShellEntry| $ 66)) + (SEQ + (LETT |lp| (CDR |lp|) + |TSETCAT-;initiallyReduced?;PSB;12|) + (EXIT + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 46)) + |TSETCAT-;initiallyReduced?;PSB;12|)))) + ('T + (LETT |red| 'NIL + |TSETCAT-;initiallyReduced?;PSB;12|)))) + ('T + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 46)) + |TSETCAT-;initiallyReduced?;PSB;12|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |red|))))) + +(DEFUN |TSETCAT-;reduce;PSMMP;13| (|p| |ts| |redOp| |redOp?| $) + (PROG (|ts0| #0=#:G1539 |reductor| #1=#:G1542) + (RETURN + (SEQ (COND + ((OR (SPADCALL |ts| (|getShellEntry| $ 12)) + (SPADCALL |p| (|getShellEntry| $ 35))) + |p|) + ('T + (SEQ (LETT |ts0| |ts| |TSETCAT-;reduce;PSMMP;13|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |ts| + (|getShellEntry| $ 12)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 35)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ (LETT |reductor| + (PROG2 + (LETT #0# + (SPADCALL |ts| + (|getShellEntry| $ 14)) + |TSETCAT-;reduce;PSMMP;13|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + |TSETCAT-;reduce;PSMMP;13|) + (LETT |ts| + (PROG2 + (LETT #1# + (SPADCALL |ts| + (|getShellEntry| $ 17)) + |TSETCAT-;reduce;PSMMP;13|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) + (|getShellEntry| $ 6) #1#)) + |TSETCAT-;reduce;PSMMP;13|) + (EXIT (COND + ((NULL + (SPADCALL |p| |reductor| + |redOp?|)) + (SEQ + (LETT |p| + (SPADCALL |p| |reductor| + |redOp|) + |TSETCAT-;reduce;PSMMP;13|) + (EXIT + (LETT |ts| |ts0| + |TSETCAT-;reduce;PSMMP;13|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |p|)))))))) + +(DEFUN |TSETCAT-;rewriteSetWithReduction;LSMML;14| + (|lp| |ts| |redOp| |redOp?| $) + (PROG (|p| |rs|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 70)) |lp|) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 32) |lp| + (|getShellEntry| $ 34)) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (EXIT (COND + ((NULL |lp|) |lp|) + ((SPADCALL (ELT $ 35) |lp| + (|getShellEntry| $ 36)) + (LIST (|spadConstant| $ 71))) + ('T + (SEQ (LETT |rs| NIL + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (SEQ G190 + (COND + ((NULL + (SPADCALL (NULL |lp|) + (|getShellEntry| $ 20))) + (GO G191))) + (SEQ + (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (LETT |lp| (CDR |lp|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (LETT |p| + (SPADCALL + (SPADCALL |p| |ts| |redOp| + |redOp?| + (|getShellEntry| $ 72)) + (|getShellEntry| $ 47)) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (EXIT + (COND + ((NULL + (SPADCALL |p| + (|getShellEntry| $ 32))) + (COND + ((SPADCALL |p| + (|getShellEntry| $ 35)) + (SEQ + (LETT |lp| NIL + |TSETCAT-;rewriteSetWithReduction;LSMML;14|) + (EXIT + (LETT |rs| + (LIST + (|spadConstant| $ 71)) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|)))) + ('T + (LETT |rs| + (CONS |p| |rs|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14|))))))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |rs| + (|getShellEntry| $ 48)))))))))))))) + +(DEFUN |TSETCAT-;stronglyReduce;PSP;15| (|p| |ts| $) + (SPADCALL |p| |ts| (ELT $ 74) (ELT $ 66) (|getShellEntry| $ 72))) + +(DEFUN |TSETCAT-;headReduce;PSP;16| (|p| |ts| $) + (SPADCALL |p| |ts| (ELT $ 76) (ELT $ 77) (|getShellEntry| $ 72))) + +(DEFUN |TSETCAT-;initiallyReduce;PSP;17| (|p| |ts| $) + (SPADCALL |p| |ts| (ELT $ 79) (ELT $ 80) (|getShellEntry| $ 72))) + +(DEFUN |TSETCAT-;removeZero;PSP;18| (|p| |ts| $) + (PROG (|v| |tsv-| #0=#:G1565 #1=#:G1574 |q|) + (RETURN + (SEQ (EXIT (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 35)) + (SPADCALL |ts| (|getShellEntry| $ 12))) + |p|) + ('T + (SEQ (LETT |v| + (SPADCALL |p| (|getShellEntry| $ 24)) + |TSETCAT-;removeZero;PSP;18|) + (LETT |tsv-| + (SPADCALL |ts| |v| + (|getShellEntry| $ 82)) + |TSETCAT-;removeZero;PSP;18|) + (COND + ((SPADCALL |v| |ts| (|getShellEntry| $ 83)) + (SEQ (LETT |q| + (SPADCALL |p| + (PROG2 + (LETT #0# + (SPADCALL |ts| |v| + (|getShellEntry| $ 84)) + |TSETCAT-;removeZero;PSP;18|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 10) #0#)) + (|getShellEntry| $ 74)) + |TSETCAT-;removeZero;PSP;18|) + (EXIT (COND + ((SPADCALL |q| + (|getShellEntry| $ 32)) + (PROGN + (LETT #1# |q| + |TSETCAT-;removeZero;PSP;18|) + (GO #1#))) + ((SPADCALL + (SPADCALL |q| |tsv-| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 32)) + (PROGN + (LETT #1# + (|spadConstant| $ 86) + |TSETCAT-;removeZero;PSP;18|) + (GO #1#)))))))) + (EXIT (COND + ((SPADCALL |tsv-| + (|getShellEntry| $ 12)) + |p|) + ('T + (SEQ (LETT |q| (|spadConstant| $ 86) + |TSETCAT-;removeZero;PSP;18|) + (SEQ G190 + (COND + ((NULL + (SPADCALL + (SPADCALL |p| |v| + (|getShellEntry| $ 87)) + (|getShellEntry| $ 89))) + (GO G191))) + (SEQ + (LETT |q| + (SPADCALL + (SPADCALL + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 46)) + |tsv-| + (|getShellEntry| $ 85)) + (SPADCALL |p| + (|getShellEntry| $ 90)) + (|getShellEntry| $ 91)) + |q| (|getShellEntry| $ 92)) + |TSETCAT-;removeZero;PSP;18|) + (EXIT + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 93)) + |TSETCAT-;removeZero;PSP;18|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT + (SPADCALL |q| + (SPADCALL |p| |tsv-| + (|getShellEntry| $ 85)) + (|getShellEntry| $ 92))))))))))) + #1# (EXIT #1#))))) + +(DEFUN |TSETCAT-;reduceByQuasiMonic;PSP;19| (|p| |ts| $) + (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 35)) + (SPADCALL |ts| (|getShellEntry| $ 12))) + |p|) + ('T + (QVELT (SPADCALL |p| (SPADCALL |ts| (|getShellEntry| $ 95)) + (|getShellEntry| $ 97)) + 1)))) + +(DEFUN |TSETCAT-;autoReduced?;SMB;20| (|ts| |redOp?| $) + (PROG (|p| |lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) 'T) + ('T + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;autoReduced?;SMB;20|) + (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;autoReduced?;SMB;20|) + (LETT |lp| (CDR |lp|) + |TSETCAT-;autoReduced?;SMB;20|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T (SPADCALL |p| |lp| |redOp?|)))) + (GO G191))) + (SEQ (LETT |p| (|SPADfirst| |lp|) + |TSETCAT-;autoReduced?;SMB;20|) + (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;autoReduced?;SMB;20|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NULL |lp|))))))))) + +(DEFUN |TSETCAT-;stronglyReduced?;SB;21| (|ts| $) + (SPADCALL |ts| (ELT $ 59) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;normalized?;SB;22| (|ts| $) + (SPADCALL |ts| (ELT $ 57) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;headReduced?;SB;23| (|ts| $) + (SPADCALL |ts| (ELT $ 104) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;initiallyReduced?;SB;24| (|ts| $) + (SPADCALL |ts| (ELT $ 106) (|getShellEntry| $ 101))) + +(DEFUN |TSETCAT-;mvar;SV;25| (|ts| $) + (PROG (#0=#:G1593) + (RETURN + (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) + (|error| "Error from TSETCAT in mvar : #1 is empty")) + ('T + (SPADCALL + (PROG2 (LETT #0# (SPADCALL |ts| (|getShellEntry| $ 14)) + |TSETCAT-;mvar;SV;25|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 10) + #0#)) + (|getShellEntry| $ 24))))))) + +(DEFUN |TSETCAT-;first;SU;26| (|ts| $) + (PROG (|lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;first;SU;26|) + (EXIT (CONS 0 (|SPADfirst| |lp|)))))))))) + +(DEFUN |TSETCAT-;last;SU;27| (|ts| $) + (PROG (|lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 22) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;last;SU;27|) + (EXIT (CONS 0 (|SPADfirst| |lp|)))))))))) + +(DEFUN |TSETCAT-;rest;SU;28| (|ts| $) + (PROG (|lp|) + (RETURN + (SEQ (COND + ((SPADCALL |ts| (|getShellEntry| $ 12)) (CONS 1 "failed")) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;rest;SU;28|) + (EXIT (CONS 0 + (SPADCALL (CDR |lp|) + (|getShellEntry| $ 111))))))))))) + +(DEFUN |TSETCAT-;coerce;SL;29| (|ts| $) + (SPADCALL (ELT $ 23) (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37))) + +(DEFUN |TSETCAT-;algebraicVariables;SL;30| (|ts| $) + (PROG (#0=#:G1618 |p| #1=#:G1619) + (RETURN + (SEQ (PROGN + (LETT #0# NIL |TSETCAT-;algebraicVariables;SL;30|) + (SEQ (LETT |p| NIL |TSETCAT-;algebraicVariables;SL;30|) + (LETT #1# (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;algebraicVariables;SL;30|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |p| (CAR #1#) + |TSETCAT-;algebraicVariables;SL;30|) + NIL)) + (GO G191))) + (SEQ (EXIT (LETT #0# + (CONS + (SPADCALL |p| + (|getShellEntry| $ 24)) + #0#) + |TSETCAT-;algebraicVariables;SL;30|))) + (LETT #1# (CDR #1#) + |TSETCAT-;algebraicVariables;SL;30|) + (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) + +(DEFUN |TSETCAT-;algebraic?;VSB;31| (|v| |ts| $) + (SPADCALL |v| (SPADCALL |ts| (|getShellEntry| $ 116)) + (|getShellEntry| $ 117))) + +(DEFUN |TSETCAT-;select;SVU;32| (|ts| |v| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;select;SVU;32|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL |v| + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 65)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;select;SVU;32|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((NULL |lp|) (CONS 1 "failed")) + ('T (CONS 0 (|SPADfirst| |lp|))))))))) + +(DEFUN |TSETCAT-;collectQuasiMonic;2S;33| (|ts| $) + (PROG (|newlp| |lp|) + (RETURN + (SEQ (LETT |lp| (SPADCALL |ts| (|getShellEntry| $ 29)) + |TSETCAT-;collectQuasiMonic;2S;33|) + (LETT |newlp| NIL |TSETCAT-;collectQuasiMonic;2S;33|) + (SEQ G190 + (COND + ((NULL (SPADCALL (NULL |lp|) (|getShellEntry| $ 20))) + (GO G191))) + (SEQ (COND + ((SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 46)) + (|getShellEntry| $ 35)) + (LETT |newlp| (CONS (|SPADfirst| |lp|) |newlp|) + |TSETCAT-;collectQuasiMonic;2S;33|))) + (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;collectQuasiMonic;2S;33|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |newlp| (|getShellEntry| $ 111))))))) + +(DEFUN |TSETCAT-;collectUnder;SVS;34| (|ts| |v| $) + (PROG (|lp|) + (RETURN + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;collectUnder;SVS;34|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp|) 'NIL) + ('T + (SPADCALL + (SPADCALL + (SPADCALL (|SPADfirst| |lp|) + (|getShellEntry| $ 24)) + |v| (|getShellEntry| $ 64)) + (|getShellEntry| $ 20))))) + (GO G191))) + (SEQ (EXIT (LETT |lp| (CDR |lp|) + |TSETCAT-;collectUnder;SVS;34|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |lp| (|getShellEntry| $ 111))))))) + +(DEFUN |TSETCAT-;collectUpper;SVS;35| (|ts| |v| $) + (PROG (|lp2| |lp1|) + (RETURN + (SEQ (LETT |lp1| + (SPADCALL (ELT $ 23) + (SPADCALL |ts| (|getShellEntry| $ 29)) + (|getShellEntry| $ 37)) + |TSETCAT-;collectUpper;SVS;35|) + (LETT |lp2| NIL |TSETCAT-;collectUpper;SVS;35|) + (SEQ G190 + (COND + ((NULL (COND + ((NULL |lp1|) 'NIL) + ('T + (SPADCALL |v| + (SPADCALL (|SPADfirst| |lp1|) + (|getShellEntry| $ 24)) + (|getShellEntry| $ 64))))) + (GO G191))) + (SEQ (LETT |lp2| (CONS (|SPADfirst| |lp1|) |lp2|) + |TSETCAT-;collectUpper;SVS;35|) + (EXIT (LETT |lp1| (CDR |lp1|) + |TSETCAT-;collectUpper;SVS;35|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL (REVERSE |lp2|) (|getShellEntry| $ 111))))))) + +(DEFUN |TSETCAT-;construct;LS;36| (|lp| $) + (PROG (|rif|) + (RETURN + (SEQ (LETT |rif| (SPADCALL |lp| (|getShellEntry| $ 123)) + |TSETCAT-;construct;LS;36|) + (EXIT (COND + ((QEQCAR |rif| 0) (QCDR |rif|)) + ('T + (|error| "in construct : LP -> $ from TSETCAT : bad arg")))))))) + +(DEFUN |TSETCAT-;retractIfCan;LU;37| (|lp| $) + (PROG (|rif|) + (RETURN + (SEQ (COND + ((NULL |lp|) (CONS 0 (SPADCALL (|getShellEntry| $ 38)))) + ('T + (SEQ (LETT |lp| + (SPADCALL (ELT $ 23) |lp| + (|getShellEntry| $ 37)) + |TSETCAT-;retractIfCan;LU;37|) + (LETT |rif| + (SPADCALL (CDR |lp|) (|getShellEntry| $ 123)) + |TSETCAT-;retractIfCan;LU;37|) + (EXIT (COND + ((QEQCAR |rif| 0) + (SPADCALL (QCDR |rif|) (|SPADfirst| |lp|) + (|getShellEntry| $ 125))) + ('T + (|error| "in retractIfCan : LP -> ... from TSETCAT : bad arg"))))))))))) + +(DEFUN |TSETCAT-;extend;SPS;38| (|ts| |p| $) + (PROG (|eif|) + (RETURN + (SEQ (LETT |eif| (SPADCALL |ts| |p| (|getShellEntry| $ 125)) + |TSETCAT-;extend;SPS;38|) + (EXIT (COND + ((QEQCAR |eif| 0) (QCDR |eif|)) + ('T + (|error| "in extend : ($,P) -> $ from TSETCAT : bad ars")))))))) + +(DEFUN |TSETCAT-;coHeight;SNni;39| (|ts| $) + (PROG (|n| |m| #0=#:G1659) + (RETURN + (SEQ (LETT |n| (SPADCALL (|getShellEntry| $ 128)) + |TSETCAT-;coHeight;SNni;39|) + (LETT |m| (LENGTH (SPADCALL |ts| (|getShellEntry| $ 29))) + |TSETCAT-;coHeight;SNni;39|) + (EXIT (PROG2 (LETT #0# + (SPADCALL |n| |m| + (|getShellEntry| $ 129)) + |TSETCAT-;coHeight;SNni;39|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|NonNegativeInteger|) + #0#))))))) + +(DEFUN |TriangularSetCategory&| (|#1| |#2| |#3| |#4| |#5|) + (PROG (|dv$1| |dv$2| |dv$3| |dv$4| |dv$5| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|TriangularSetCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$3| (|devaluate| |#3|) . #0#) + (LETT |dv$4| (|devaluate| |#4|) . #0#) + (LETT |dv$5| (|devaluate| |#5|) . #0#) + (LETT |dv$| + (LIST '|TriangularSetCategory&| |dv$1| |dv$2| |dv$3| + |dv$4| |dv$5|) . #0#) + (LETT $ (|newShell| 132) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#4| '(|Finite|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (|setShellEntry| $ 8 |#3|) + (|setShellEntry| $ 9 |#4|) + (|setShellEntry| $ 10 |#5|) + (COND + ((|testBitVector| |pv$| 1) + (|setShellEntry| $ 130 + (CONS (|dispatchFunction| |TSETCAT-;coHeight;SNni;39|) + $)))) + $)))) + +(MAKEPROP '|TriangularSetCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|local| |#3|) (|local| |#4|) (|local| |#5|) (|Boolean|) + (0 . |empty?|) (|Union| 10 '"failed") (5 . |first|) + (10 . =) (|Union| $ '"failed") (16 . |rest|) (21 . =) + |TSETCAT-;=;2SB;1| (27 . |not|) (32 . |last|) + (37 . |infRittWu?|) (43 . |supRittWu?|) (49 . |mvar|) + (54 . |collectUpper|) (60 . |infRittWu?|) + |TSETCAT-;infRittWu?;2SB;2| (|List| 10) (66 . |members|) + (|Mapping| 11 10 10) |TSETCAT-;reduced?;PSMB;3| + (71 . |zero?|) (|Mapping| 11 10) (76 . |remove|) + (82 . |ground?|) (87 . |any?|) (93 . |sort|) + (99 . |empty|) (103 . |extend|) (109 . |reduced?|) + (|Record| (|:| |bas| $) (|:| |top| 28)) + (|Union| 41 '"failed") |TSETCAT-;basicSet;LMU;4| + (116 . |concat|) |TSETCAT-;basicSet;LMMU;5| (122 . |init|) + (127 . |primPartElseUnitCanonical|) + (132 . |removeDuplicates|) |TSETCAT-;initials;SL;6| + (|NonNegativeInteger|) (137 . |mdeg|) + |TSETCAT-;degree;SNni;7| (142 . |initials|) + (|Record| (|:| |close| 28) (|:| |open| 28)) + |TSETCAT-;quasiComponent;SR;8| (|List| $) + (147 . |normalized?|) |TSETCAT-;normalized?;PSB;9| + (153 . |reduced?|) |TSETCAT-;stronglyReduced?;PSB;10| + (159 . |head|) (164 . |stronglyReduced?|) + |TSETCAT-;headReduced?;PSB;11| (170 . <) (176 . =) + (182 . |reduced?|) |TSETCAT-;initiallyReduced?;PSB;12| + (|Mapping| 10 10 10) |TSETCAT-;reduce;PSMMP;13| + (188 . |trivialIdeal?|) (193 . |One|) (197 . |reduce|) + |TSETCAT-;rewriteSetWithReduction;LSMML;14| + (205 . |lazyPrem|) |TSETCAT-;stronglyReduce;PSP;15| + (211 . |headReduce|) (217 . |headReduced?|) + |TSETCAT-;headReduce;PSP;16| (223 . |initiallyReduce|) + (229 . |initiallyReduced?|) + |TSETCAT-;initiallyReduce;PSP;17| (235 . |collectUnder|) + (241 . |algebraic?|) (247 . |select|) (253 . |removeZero|) + (259 . |Zero|) (263 . |degree|) (|Integer|) + (269 . |positive?|) (274 . |mainMonomial|) (279 . *) + (285 . +) (291 . |tail|) |TSETCAT-;removeZero;PSP;18| + (296 . |collectQuasiMonic|) + (|Record| (|:| |rnum| 7) (|:| |polnum| 10) (|:| |den| 7)) + (301 . |remainder|) |TSETCAT-;reduceByQuasiMonic;PSP;19| + (|Mapping| 11 10 28) |TSETCAT-;autoReduced?;SMB;20| + (307 . |autoReduced?|) |TSETCAT-;stronglyReduced?;SB;21| + |TSETCAT-;normalized?;SB;22| (313 . |headReduced?|) + |TSETCAT-;headReduced?;SB;23| (319 . |initiallyReduced?|) + |TSETCAT-;initiallyReduced?;SB;24| |TSETCAT-;mvar;SV;25| + |TSETCAT-;first;SU;26| |TSETCAT-;last;SU;27| + (325 . |construct|) |TSETCAT-;rest;SU;28| + |TSETCAT-;coerce;SL;29| (|List| 9) + |TSETCAT-;algebraicVariables;SL;30| + (330 . |algebraicVariables|) (335 . |member?|) + |TSETCAT-;algebraic?;VSB;31| |TSETCAT-;select;SVU;32| + |TSETCAT-;collectQuasiMonic;2S;33| + |TSETCAT-;collectUnder;SVS;34| + |TSETCAT-;collectUpper;SVS;35| (341 . |retractIfCan|) + |TSETCAT-;construct;LS;36| (346 . |extendIfCan|) + |TSETCAT-;retractIfCan;LU;37| |TSETCAT-;extend;SPS;38| + (352 . |size|) (356 . |subtractIfCan|) (362 . |coHeight|) + (|OutputForm|)) + '#(|stronglyReduced?| 367 |stronglyReduce| 378 |select| 384 + |rewriteSetWithReduction| 390 |retractIfCan| 398 |rest| + 403 |removeZero| 408 |reduced?| 414 |reduceByQuasiMonic| + 421 |reduce| 427 |quasiComponent| 435 |normalized?| 440 + |mvar| 451 |last| 456 |initials| 461 |initiallyReduced?| + 466 |initiallyReduce| 477 |infRittWu?| 483 |headReduced?| + 489 |headReduce| 500 |first| 506 |extend| 511 |degree| 517 + |construct| 522 |collectUpper| 527 |collectUnder| 533 + |collectQuasiMonic| 539 |coerce| 544 |coHeight| 549 + |basicSet| 554 |autoReduced?| 567 |algebraicVariables| 573 + |algebraic?| 578 = 584) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 130 + '(1 6 11 0 12 1 6 13 0 14 2 10 11 0 0 + 15 1 6 16 0 17 2 6 11 0 0 18 1 11 0 0 + 20 1 6 13 0 21 2 10 11 0 0 22 2 10 11 + 0 0 23 1 10 9 0 24 2 6 0 0 9 25 2 6 + 11 0 0 26 1 6 28 0 29 1 10 11 0 32 2 + 28 0 33 0 34 1 10 11 0 35 2 28 11 33 + 0 36 2 28 0 30 0 37 0 6 0 38 2 6 0 0 + 10 39 3 6 11 10 0 30 40 2 28 0 0 0 44 + 1 10 0 0 46 1 10 0 0 47 1 28 0 0 48 1 + 10 50 0 51 1 6 28 0 53 2 10 11 0 56 + 57 2 10 11 0 56 59 1 10 0 0 61 2 6 11 + 10 0 62 2 9 11 0 0 64 2 9 11 0 0 65 2 + 10 11 0 0 66 1 6 11 0 70 0 10 0 71 4 + 6 10 10 0 68 30 72 2 10 0 0 0 74 2 10 + 0 0 0 76 2 10 11 0 0 77 2 10 0 0 0 79 + 2 10 11 0 0 80 2 6 0 0 9 82 2 6 11 9 + 0 83 2 6 13 0 9 84 2 6 10 10 0 85 0 + 10 0 86 2 10 50 0 9 87 1 88 11 0 89 1 + 10 0 0 90 2 10 0 0 0 91 2 10 0 0 0 92 + 1 10 0 0 93 1 6 0 0 95 2 6 96 10 0 97 + 2 6 11 0 99 101 2 10 11 0 56 104 2 10 + 11 0 56 106 1 6 0 28 111 1 6 114 0 + 116 2 114 11 9 0 117 1 6 16 28 123 2 + 6 16 0 10 125 0 9 50 128 2 50 16 0 0 + 129 1 0 50 0 130 1 0 11 0 102 2 0 11 + 10 0 60 2 0 10 10 0 75 2 0 13 0 9 119 + 4 0 28 28 0 68 30 73 1 0 16 28 126 1 + 0 16 0 112 2 0 10 10 0 94 3 0 11 10 0 + 30 31 2 0 10 10 0 98 4 0 10 10 0 68 + 30 69 1 0 54 0 55 1 0 11 0 103 2 0 11 + 10 0 58 1 0 9 0 108 1 0 13 0 110 1 0 + 28 0 49 1 0 11 0 107 2 0 11 10 0 67 2 + 0 10 10 0 81 2 0 11 0 0 27 1 0 11 0 + 105 2 0 11 10 0 63 2 0 10 10 0 78 1 0 + 13 0 109 2 0 0 0 10 127 1 0 50 0 52 1 + 0 0 28 124 2 0 0 0 9 122 2 0 0 0 9 + 121 1 0 0 0 120 1 0 28 0 113 1 0 50 0 + 130 3 0 42 28 33 30 45 2 0 42 28 30 + 43 2 0 11 0 99 100 1 0 114 0 115 2 0 + 11 9 0 118 2 0 11 0 0 19))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/TSETCAT.lsp b/src/algebra/strap/TSETCAT.lsp new file mode 100644 index 00000000..8304c820 --- /dev/null +++ b/src/algebra/strap/TSETCAT.lsp @@ -0,0 +1,200 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |TriangularSetCategory;CAT| 'NIL) + +(DEFPARAMETER |TriangularSetCategory;AL| 'NIL) + +(DEFUN |TriangularSetCategory| (&REST #0=#:G1439 &AUX #1=#:G1437) + (DSETQ #1# #0#) + (LET (#2=#:G1438) + (COND + ((SETQ #2# + (|assoc| (|devaluateList| #1#) |TriangularSetCategory;AL|)) + (CDR #2#)) + (T (SETQ |TriangularSetCategory;AL| + (|cons5| (CONS (|devaluateList| #1#) + (SETQ #2# + (APPLY #'|TriangularSetCategory;| + #1#))) + |TriangularSetCategory;AL|)) + #2#)))) + +(DEFUN |TriangularSetCategory;| (|t#1| |t#2| |t#3| |t#4|) + (PROG (#0=#:G1436) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1| |t#2| |t#3| |t#4|) + (LIST (|devaluate| |t#1|) + (|devaluate| |t#2|) + (|devaluate| |t#3|) + (|devaluate| |t#4|))) + (COND + (|TriangularSetCategory;CAT|) + ('T + (LETT |TriangularSetCategory;CAT| + (|Join| (|PolynomialSetCategory| '|t#1| + '|t#2| '|t#3| '|t#4|) + (|mkCategory| '|domain| + '(((|infRittWu?| + ((|Boolean|) $ $)) + T) + ((|basicSet| + ((|Union| + (|Record| (|:| |bas| $) + (|:| |top| + (|List| |t#4|))) + "failed") + (|List| |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|basicSet| + ((|Union| + (|Record| (|:| |bas| $) + (|:| |top| + (|List| |t#4|))) + "failed") + (|List| |t#4|) + (|Mapping| (|Boolean|) + |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|initials| + ((|List| |t#4|) $)) + T) + ((|degree| + ((|NonNegativeInteger|) $)) + T) + ((|quasiComponent| + ((|Record| + (|:| |close| + (|List| |t#4|)) + (|:| |open| + (|List| |t#4|))) + $)) + T) + ((|normalized?| + ((|Boolean|) |t#4| $)) + T) + ((|normalized?| + ((|Boolean|) $)) + T) + ((|reduced?| + ((|Boolean|) |t#4| $ + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|stronglyReduced?| + ((|Boolean|) |t#4| $)) + T) + ((|headReduced?| + ((|Boolean|) |t#4| $)) + T) + ((|initiallyReduced?| + ((|Boolean|) |t#4| $)) + T) + ((|autoReduced?| + ((|Boolean|) $ + (|Mapping| (|Boolean|) + |t#4| (|List| |t#4|)))) + T) + ((|stronglyReduced?| + ((|Boolean|) $)) + T) + ((|headReduced?| + ((|Boolean|) $)) + T) + ((|initiallyReduced?| + ((|Boolean|) $)) + T) + ((|reduce| + (|t#4| |t#4| $ + (|Mapping| |t#4| |t#4| + |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|rewriteSetWithReduction| + ((|List| |t#4|) + (|List| |t#4|) $ + (|Mapping| |t#4| |t#4| + |t#4|) + (|Mapping| (|Boolean|) + |t#4| |t#4|))) + T) + ((|stronglyReduce| + (|t#4| |t#4| $)) + T) + ((|headReduce| + (|t#4| |t#4| $)) + T) + ((|initiallyReduce| + (|t#4| |t#4| $)) + T) + ((|removeZero| + (|t#4| |t#4| $)) + T) + ((|collectQuasiMonic| ($ $)) + T) + ((|reduceByQuasiMonic| + (|t#4| |t#4| $)) + T) + ((|zeroSetSplit| + ((|List| $) + (|List| |t#4|))) + T) + ((|zeroSetSplitIntoTriangularSystems| + ((|List| + (|Record| + (|:| |close| $) + (|:| |open| + (|List| |t#4|)))) + (|List| |t#4|))) + T) + ((|first| + ((|Union| |t#4| "failed") + $)) + T) + ((|last| + ((|Union| |t#4| "failed") + $)) + T) + ((|rest| + ((|Union| $ "failed") $)) + T) + ((|algebraicVariables| + ((|List| |t#3|) $)) + T) + ((|algebraic?| + ((|Boolean|) |t#3| $)) + T) + ((|select| + ((|Union| |t#4| "failed") + $ |t#3|)) + T) + ((|extendIfCan| + ((|Union| $ "failed") $ + |t#4|)) + T) + ((|extend| ($ $ |t#4|)) T) + ((|coHeight| + ((|NonNegativeInteger|) $)) + (|has| |t#3| (|Finite|)))) + '((|finiteAggregate| T) + (|shallowlyMutable| T)) + '((|NonNegativeInteger|) + (|Boolean|) (|List| |t#3|) + (|List| + (|Record| (|:| |close| $) + (|:| |open| + (|List| |t#4|)))) + (|List| |t#4|) (|List| $)) + NIL)) + . #1=(|TriangularSetCategory|))))) . #1#) + (SETELT #0# 0 + (LIST '|TriangularSetCategory| (|devaluate| |t#1|) + (|devaluate| |t#2|) (|devaluate| |t#3|) + (|devaluate| |t#4|))))))) diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp new file mode 100644 index 00000000..eb1afd12 --- /dev/null +++ b/src/algebra/strap/UFD-.lsp @@ -0,0 +1,83 @@ + +(/VERSIONCHECK 2) + +(DEFUN |UFD-;squareFreePart;2S;1| (|x| $) + (PROG (|s| |f| #0=#:G1403 #1=#:G1401 #2=#:G1399 #3=#:G1400) + (RETURN + (SEQ (SPADCALL + (SPADCALL + (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8)) + |UFD-;squareFreePart;2S;1|) + (|getShellEntry| $ 10)) + (PROGN + (LETT #3# NIL |UFD-;squareFreePart;2S;1|) + (SEQ (LETT |f| NIL |UFD-;squareFreePart;2S;1|) + (LETT #0# (SPADCALL |s| (|getShellEntry| $ 14)) + |UFD-;squareFreePart;2S;1|) + G190 + (COND + ((OR (ATOM #0#) + (PROGN + (LETT |f| (CAR #0#) + |UFD-;squareFreePart;2S;1|) + NIL)) + (GO G191))) + (SEQ (EXIT (PROGN + (LETT #1# (QCAR |f|) + |UFD-;squareFreePart;2S;1|) + (COND + (#3# + (LETT #2# + (SPADCALL #2# #1# + (|getShellEntry| $ 15)) + |UFD-;squareFreePart;2S;1|)) + ('T + (PROGN + (LETT #2# #1# + |UFD-;squareFreePart;2S;1|) + (LETT #3# 'T + |UFD-;squareFreePart;2S;1|))))))) + (LETT #0# (CDR #0#) |UFD-;squareFreePart;2S;1|) + (GO G190) G191 (EXIT NIL)) + (COND (#3# #2#) ('T (|spadConstant| $ 16)))) + (|getShellEntry| $ 15)))))) + +(DEFUN |UFD-;prime?;SB;2| (|x| $) + (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) + (|getShellEntry| $ 22))) + 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| 25) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + $)))) + +(MAKEPROP '|UniqueFactorizationDomain&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|Factored| $) + (0 . |squareFree|) (|Factored| 6) (5 . |unit|) (|Integer|) + (|Record| (|:| |factor| 6) (|:| |exponent| 11)) + (|List| 12) (10 . |factors|) (15 . *) (21 . |One|) + |UFD-;squareFreePart;2S;1| (25 . |factor|) + (|Union| '"nil" '"sqfr" '"irred" '"prime") + (|Record| (|:| |flg| 19) (|:| |fctr| 6) (|:| |xpnt| 11)) + (|List| 20) (30 . |factorList|) (|Boolean|) + |UFD-;prime?;SB;2|) + '#(|squareFreePart| 35 |prime?| 40) 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 24 + '(1 6 7 0 8 1 9 6 0 10 1 9 13 0 14 2 6 + 0 0 0 15 0 6 0 16 1 6 7 0 18 1 9 21 0 + 22 1 0 0 0 17 1 0 23 0 24))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/UFD.lsp b/src/algebra/strap/UFD.lsp new file mode 100644 index 00000000..ee4b7a18 --- /dev/null +++ b/src/algebra/strap/UFD.lsp @@ -0,0 +1,27 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL) + +(DEFUN |UniqueFactorizationDomain| () + (LET (#:G1387) + (COND + (|UniqueFactorizationDomain;AL|) + (T (SETQ |UniqueFactorizationDomain;AL| + (|UniqueFactorizationDomain;|)))))) + +(DEFUN |UniqueFactorizationDomain;| () + (PROG (#0=#:G1385) + (RETURN + (PROG1 (LETT #0# + (|Join| (|GcdDomain|) + (|mkCategory| '|domain| + '(((|prime?| ((|Boolean|) $)) T) + ((|squareFree| ((|Factored| $) $)) T) + ((|squareFreePart| ($ $)) T) + ((|factor| ((|Factored| $) $)) T)) + NIL '((|Factored| $) (|Boolean|)) NIL)) + |UniqueFactorizationDomain|) + (SETELT #0# 0 '(|UniqueFactorizationDomain|)))))) + +(MAKEPROP '|UniqueFactorizationDomain| 'NILADIC T) diff --git a/src/algebra/strap/ULSCAT.lsp b/src/algebra/strap/ULSCAT.lsp new file mode 100644 index 00000000..94ef7e99 --- /dev/null +++ b/src/algebra/strap/ULSCAT.lsp @@ -0,0 +1,113 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UnivariateLaurentSeriesCategory;CAT| 'NIL) + +(DEFPARAMETER |UnivariateLaurentSeriesCategory;AL| 'NIL) + +(DEFUN |UnivariateLaurentSeriesCategory| (#0=#:G1388) + (LET (#1=#:G1389) + (COND + ((SETQ #1# + (|assoc| (|devaluate| #0#) + |UnivariateLaurentSeriesCategory;AL|)) + (CDR #1#)) + (T (SETQ |UnivariateLaurentSeriesCategory;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# + (|UnivariateLaurentSeriesCategory;| + #0#))) + |UnivariateLaurentSeriesCategory;AL|)) + #1#)))) + +(DEFUN |UnivariateLaurentSeriesCategory;| (|t#1|) + (PROG (#0=#:G1387) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (|sublisV| + (PAIR '(#1=#:G1386) (LIST '(|Integer|))) + (COND + (|UnivariateLaurentSeriesCategory;CAT|) + ('T + (LETT |UnivariateLaurentSeriesCategory;CAT| + (|Join| + (|UnivariatePowerSeriesCategory| + '|t#1| '#1#) + (|mkCategory| '|domain| + '(((|series| + ($ + (|Stream| + (|Record| + (|:| |k| (|Integer|)) + (|:| |c| |t#1|))))) + T) + ((|multiplyCoefficients| + ($ + (|Mapping| |t#1| + (|Integer|)) + $)) + T) + ((|rationalFunction| + ((|Fraction| + (|Polynomial| |t#1|)) + $ (|Integer|))) + (|has| |t#1| + (|IntegralDomain|))) + ((|rationalFunction| + ((|Fraction| + (|Polynomial| |t#1|)) + $ (|Integer|) (|Integer|))) + (|has| |t#1| + (|IntegralDomain|))) + ((|integrate| ($ $)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|integrate| ($ $ (|Symbol|))) + (AND + (|has| |t#1| + (SIGNATURE |variables| + ((|List| (|Symbol|)) |t#1|))) + (|has| |t#1| + (SIGNATURE |integrate| + (|t#1| |t#1| (|Symbol|)))) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + ((|integrate| ($ $ (|Symbol|))) + (AND + (|has| |t#1| + (|AlgebraicallyClosedFunctionSpace| + (|Integer|))) + (|has| |t#1| + (|PrimitiveFunctionCategory|)) + (|has| |t#1| + (|TranscendentalFunctionCategory|)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))))) + '(((|RadicalCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|TranscendentalFunctionCategory|) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|))))) + ((|Field|) + (|has| |t#1| (|Field|)))) + '((|Symbol|) + (|Fraction| + (|Polynomial| |t#1|)) + (|Integer|) + (|Stream| + (|Record| + (|:| |k| (|Integer|)) + (|:| |c| |t#1|)))) + NIL)) + . #2=(|UnivariateLaurentSeriesCategory|)))))) . #2#) + (SETELT #0# 0 + (LIST '|UnivariateLaurentSeriesCategory| + (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/UPOLYC-.lsp b/src/algebra/strap/UPOLYC-.lsp new file mode 100644 index 00000000..ff1ac0da --- /dev/null +++ b/src/algebra/strap/UPOLYC-.lsp @@ -0,0 +1,1231 @@ + +(/VERSIONCHECK 2) + +(DEFUN |UPOLYC-;variables;SL;1| (|p| $) + (COND + ((OR (SPADCALL |p| (|getShellEntry| $ 9)) + (ZEROP (SPADCALL |p| (|getShellEntry| $ 11)))) + NIL) + ('T (LIST (SPADCALL (|getShellEntry| $ 13)))))) + +(DEFUN |UPOLYC-;degree;SSaosNni;2| (|p| |v| $) + (SPADCALL |p| (|getShellEntry| $ 11))) + +(DEFUN |UPOLYC-;totalDegree;SLNni;3| (|p| |lv| $) + (COND ((NULL |lv|) 0) ('T (SPADCALL |p| (|getShellEntry| $ 17))))) + +(DEFUN |UPOLYC-;degree;SLL;4| (|p| |lv| $) + (COND + ((NULL |lv|) NIL) + ('T (LIST (SPADCALL |p| (|getShellEntry| $ 11)))))) + +(DEFUN |UPOLYC-;eval;SLLS;5| (|p| |lv| |lq| $) + (COND + ((NULL |lv|) |p|) + ((NULL (NULL (CDR |lv|))) + (|error| "can only eval a univariate polynomial once")) + ('T + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |lq|) + (|getShellEntry| $ 21))))) + +(DEFUN |UPOLYC-;eval;SSaos2S;6| (|p| |v| |q| $) + (SPADCALL |p| |q| (|getShellEntry| $ 24))) + +(DEFUN |UPOLYC-;eval;SLLS;7| (|p| |lv| |lr| $) + (COND + ((NULL |lv|) |p|) + ((NULL (NULL (CDR |lv|))) + (|error| "can only eval a univariate polynomial once")) + ('T + (SPADCALL |p| (|SPADfirst| |lv|) (|SPADfirst| |lr|) + (|getShellEntry| $ 26))))) + +(DEFUN |UPOLYC-;eval;SSaosRS;8| (|p| |v| |r| $) + (SPADCALL (SPADCALL |p| |r| (|getShellEntry| $ 29)) + (|getShellEntry| $ 30))) + +(DEFUN |UPOLYC-;eval;SLS;9| (|p| |le| $) + (COND + ((NULL |le|) |p|) + ((NULL (NULL (CDR |le|))) + (|error| "can only eval a univariate polynomial once")) + ('T + (COND + ((QEQCAR (SPADCALL + (SPADCALL (|SPADfirst| |le|) + (|getShellEntry| $ 33)) + (|getShellEntry| $ 35)) + 1) + |p|) + ('T + (SPADCALL |p| + (SPADCALL (|SPADfirst| |le|) (|getShellEntry| $ 36)) + (|getShellEntry| $ 24))))))) + +(DEFUN |UPOLYC-;mainVariable;SU;10| (|p| $) + (COND + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) (CONS 1 "failed")) + ('T (CONS 0 (SPADCALL (|getShellEntry| $ 13)))))) + +(DEFUN |UPOLYC-;minimumDegree;SSaosNni;11| (|p| |v| $) + (SPADCALL |p| (|getShellEntry| $ 41))) + +(DEFUN |UPOLYC-;minimumDegree;SLL;12| (|p| |lv| $) + (COND + ((NULL |lv|) NIL) + ('T (LIST (SPADCALL |p| (|getShellEntry| $ 41)))))) + +(DEFUN |UPOLYC-;monomial;SSaosNniS;13| (|p| |v| |n| $) + (SPADCALL (CONS #'|UPOLYC-;monomial;SSaosNniS;13!0| (VECTOR $ |n|)) + |p| (|getShellEntry| $ 46))) + +(DEFUN |UPOLYC-;monomial;SSaosNniS;13!0| (|#1| $$) + (SPADCALL |#1| (|getShellEntry| $$ 1) + (|getShellEntry| (|getShellEntry| $$ 0) 44))) + +(DEFUN |UPOLYC-;coerce;SaosS;14| (|v| $) + (SPADCALL (|spadConstant| $ 49) 1 (|getShellEntry| $ 50))) + +(DEFUN |UPOLYC-;makeSUP;SSup;15| (|p| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) (|spadConstant| $ 53)) + ('T + (SPADCALL + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 54)) + (SPADCALL |p| (|getShellEntry| $ 11)) + (|getShellEntry| $ 55)) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 56)) + (|getShellEntry| $ 57)) + (|getShellEntry| $ 58))))) + +(DEFUN |UPOLYC-;unmakeSUP;SupS;16| (|sp| $) + (COND + ((SPADCALL |sp| (|getShellEntry| $ 60)) (|spadConstant| $ 61)) + ('T + (SPADCALL + (SPADCALL (SPADCALL |sp| (|getShellEntry| $ 62)) + (SPADCALL |sp| (|getShellEntry| $ 63)) + (|getShellEntry| $ 50)) + (SPADCALL (SPADCALL |sp| (|getShellEntry| $ 64)) + (|getShellEntry| $ 65)) + (|getShellEntry| $ 66))))) + +(DEFUN |UPOLYC-;karatsubaDivide;SNniR;17| (|p| |n| $) + (SPADCALL |p| + (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) + (|getShellEntry| $ 69))) + +(DEFUN |UPOLYC-;shiftRight;SNniS;18| (|p| |n| $) + (QCAR (SPADCALL |p| + (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) + (|getShellEntry| $ 69)))) + +(DEFUN |UPOLYC-;shiftLeft;SNniS;19| (|p| |n| $) + (SPADCALL |p| + (SPADCALL (|spadConstant| $ 49) |n| (|getShellEntry| $ 50)) + (|getShellEntry| $ 72))) + +(DEFUN |UPOLYC-;solveLinearPolynomialEquation;LSupU;20| (|lpp| |pp| $) + (SPADCALL |lpp| |pp| (|getShellEntry| $ 78))) + +(DEFUN |UPOLYC-;factorPolynomial;SupF;21| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 84))) + +(DEFUN |UPOLYC-;factorSquareFreePolynomial;SupF;22| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 87))) + +(DEFUN |UPOLYC-;factor;SF;23| (|p| $) + (PROG (|ansR| #0=#:G1516 |w| #1=#:G1517) + (RETURN + (SEQ (COND + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) + (SEQ (LETT |ansR| + (SPADCALL + (SPADCALL |p| (|getShellEntry| $ 54)) + (|getShellEntry| $ 90)) + |UPOLYC-;factor;SF;23|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansR| + (|getShellEntry| $ 92)) + (|getShellEntry| $ 30)) + (PROGN + (LETT #0# NIL |UPOLYC-;factor;SF;23|) + (SEQ (LETT |w| NIL + |UPOLYC-;factor;SF;23|) + (LETT #1# + (SPADCALL |ansR| + (|getShellEntry| $ 97)) + |UPOLYC-;factor;SF;23|) + G190 + (COND + ((OR (ATOM #1#) + (PROGN + (LETT |w| (CAR #1#) + |UPOLYC-;factor;SF;23|) + NIL)) + (GO G191))) + (SEQ + (EXIT + (LETT #0# + (CONS + (VECTOR (QVELT |w| 0) + (SPADCALL (QVELT |w| 1) + (|getShellEntry| $ 30)) + (QVELT |w| 2)) + #0#) + |UPOLYC-;factor;SF;23|))) + (LETT #1# (CDR #1#) + |UPOLYC-;factor;SF;23|) + (GO G190) G191 + (EXIT (NREVERSE0 #0#)))) + (|getShellEntry| $ 101))))) + ('T + (SPADCALL (ELT $ 65) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 57)) + (|getShellEntry| $ 102)) + (|getShellEntry| $ 106)))))))) + +(DEFUN |UPOLYC-;vectorise;SNniV;24| (|p| |n| $) + (PROG (|v| |m| |i| #0=#:G1522 #1=#:G1518) + (RETURN + (SEQ (LETT |m| + (SPADCALL + (LETT |v| + (SPADCALL |n| (|spadConstant| $ 108) + (|getShellEntry| $ 110)) + |UPOLYC-;vectorise;SNniV;24|) + (|getShellEntry| $ 111)) + |UPOLYC-;vectorise;SNniV;24|) + (SEQ (LETT |i| (SPADCALL |v| (|getShellEntry| $ 111)) + |UPOLYC-;vectorise;SNniV;24|) + (LETT #0# (QVSIZE |v|) |UPOLYC-;vectorise;SNniV;24|) + G190 (COND ((> |i| #0#) (GO G191))) + (SEQ (EXIT (SPADCALL |v| |i| + (SPADCALL |p| + (PROG1 + (LETT #1# (- |i| |m|) + |UPOLYC-;vectorise;SNniV;24|) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) + #1#)) + (|getShellEntry| $ 112)) + (|getShellEntry| $ 113)))) + (LETT |i| (+ |i| 1) |UPOLYC-;vectorise;SNniV;24|) + (GO G190) G191 (EXIT NIL)) + (EXIT |v|))))) + +(DEFUN |UPOLYC-;retract;SR;25| (|p| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) (|spadConstant| $ 108)) + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) + (SPADCALL |p| (|getShellEntry| $ 54))) + ('T (|error| "Polynomial is not of degree 0")))) + +(DEFUN |UPOLYC-;retractIfCan;SU;26| (|p| $) + (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) + (CONS 0 (|spadConstant| $ 108))) + ((ZEROP (SPADCALL |p| (|getShellEntry| $ 11))) + (CONS 0 (SPADCALL |p| (|getShellEntry| $ 54)))) + ('T (CONS 1 "failed")))) + +(DEFUN |UPOLYC-;init;S;27| ($) + (SPADCALL (|spadConstant| $ 118) (|getShellEntry| $ 30))) + +(DEFUN |UPOLYC-;nextItemInner| (|n| $) + (PROG (|nn| |n1| |n2| #0=#:G1543 |n3|) + (RETURN + (SEQ (COND + ((SPADCALL |n| (|getShellEntry| $ 9)) + (CONS 0 + (SPADCALL + (PROG2 (LETT #0# + (SPADCALL (|spadConstant| $ 108) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 7) #0#)) + (|getShellEntry| $ 30)))) + ((ZEROP (SPADCALL |n| (|getShellEntry| $ 11))) + (SEQ (LETT |nn| + (SPADCALL + (SPADCALL |n| (|getShellEntry| $ 54)) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (EXIT (COND + ((QEQCAR |nn| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |nn|) + (|getShellEntry| $ 30)))))))) + ('T + (SEQ (LETT |n1| (SPADCALL |n| (|getShellEntry| $ 56)) + |UPOLYC-;nextItemInner|) + (LETT |n2| (|UPOLYC-;nextItemInner| |n1| $) + |UPOLYC-;nextItemInner|) + (EXIT (COND + ((QEQCAR |n2| 0) + (CONS 0 + (SPADCALL + (SPADCALL + (SPADCALL |n| + (|getShellEntry| $ 54)) + (SPADCALL |n| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 50)) + (QCDR |n2|) + (|getShellEntry| $ 66)))) + ((< (+ 1 + (SPADCALL |n1| + (|getShellEntry| $ 11))) + (SPADCALL |n| (|getShellEntry| $ 11))) + (CONS 0 + (SPADCALL + (SPADCALL + (SPADCALL |n| + (|getShellEntry| $ 54)) + (SPADCALL |n| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 50)) + (SPADCALL + (PROG2 + (LETT #0# + (SPADCALL + (|spadConstant| $ 118) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 7) #0#)) + (+ 1 + (SPADCALL |n1| + (|getShellEntry| $ 11))) + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)))) + ('T + (SEQ (LETT |n3| + (SPADCALL + (SPADCALL |n| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItemInner|) + (EXIT (COND + ((QEQCAR |n3| 1) + (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |n3|) + (SPADCALL |n| + (|getShellEntry| $ 11)) + (|getShellEntry| $ 50))))))))))))))))) + +(DEFUN |UPOLYC-;nextItem;SU;29| (|n| $) + (PROG (|n1| #0=#:G1556) + (RETURN + (SEQ (LETT |n1| (|UPOLYC-;nextItemInner| |n| $) + |UPOLYC-;nextItem;SU;29|) + (EXIT (COND + ((QEQCAR |n1| 1) + (CONS 0 + (SPADCALL + (PROG2 (LETT #0# + (SPADCALL (|spadConstant| $ 118) + (|getShellEntry| $ 121)) + |UPOLYC-;nextItem;SU;29|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 7) #0#)) + (+ 1 + (SPADCALL |n| (|getShellEntry| $ 11))) + (|getShellEntry| $ 50)))) + ('T |n1|))))))) + +(DEFUN |UPOLYC-;content;SSaosS;30| (|p| |v| $) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 124)) + (|getShellEntry| $ 30))) + +(DEFUN |UPOLYC-;primeFactor| (|p| |q| $) + (PROG (#0=#:G1562 |p1|) + (RETURN + (SEQ (LETT |p1| + (PROG2 (LETT #0# + (SPADCALL |p| + (SPADCALL |p| |q| + (|getShellEntry| $ 126)) + (|getShellEntry| $ 127)) + |UPOLYC-;primeFactor|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) (|getShellEntry| $ 6) + #0#)) + |UPOLYC-;primeFactor|) + (EXIT (COND + ((SPADCALL |p1| |p| (|getShellEntry| $ 128)) |p|) + ('T (|UPOLYC-;primeFactor| |p1| |q| $)))))))) + +(DEFUN |UPOLYC-;separate;2SR;32| (|p| |q| $) + (PROG (|a| #0=#:G1568) + (RETURN + (SEQ (LETT |a| (|UPOLYC-;primeFactor| |p| |q| $) + |UPOLYC-;separate;2SR;32|) + (EXIT (CONS |a| + (PROG2 (LETT #0# + (SPADCALL |p| |a| + (|getShellEntry| $ 127)) + |UPOLYC-;separate;2SR;32|) + (QCDR #0#) + (|check-union| (QEQCAR #0# 0) + (|getShellEntry| $ 6) #0#)))))))) + +(DEFUN |UPOLYC-;differentiate;SM2S;33| (|x| |deriv| |x'| $) + (PROG (|dg| |lc| #0=#:G1573 |d|) + (RETURN + (SEQ (LETT |d| (|spadConstant| $ 61) + |UPOLYC-;differentiate;SM2S;33|) + (SEQ G190 + (COND + ((NULL (< 0 + (LETT |dg| + (SPADCALL |x| (|getShellEntry| $ 11)) + |UPOLYC-;differentiate;SM2S;33|))) + (GO G191))) + (SEQ (LETT |lc| (SPADCALL |x| (|getShellEntry| $ 54)) + |UPOLYC-;differentiate;SM2S;33|) + (LETT |d| + (SPADCALL + (SPADCALL |d| + (SPADCALL |x'| + (SPADCALL + (SPADCALL |dg| |lc| + (|getShellEntry| $ 132)) + (PROG1 + (LETT #0# (- |dg| 1) + |UPOLYC-;differentiate;SM2S;33|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 50)) + (|getShellEntry| $ 72)) + (|getShellEntry| $ 66)) + (SPADCALL (SPADCALL |lc| |deriv|) |dg| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + |UPOLYC-;differentiate;SM2S;33|) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 56)) + |UPOLYC-;differentiate;SM2S;33|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |d| + (SPADCALL + (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 54)) + |deriv|) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 66))))))) + +(DEFUN |UPOLYC-;ncdiff| (|n| |x'| $) + (PROG (#0=#:G1591 |n1|) + (RETURN + (COND + ((ZEROP |n|) (|spadConstant| $ 61)) + ((ZEROP (LETT |n1| + (PROG1 (LETT #0# (- |n| 1) |UPOLYC-;ncdiff|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |UPOLYC-;ncdiff|)) + |x'|) + ('T + (SPADCALL + (SPADCALL |x'| + (SPADCALL (|spadConstant| $ 49) |n1| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 72)) + (SPADCALL + (SPADCALL (|spadConstant| $ 49) 1 + (|getShellEntry| $ 50)) + (|UPOLYC-;ncdiff| |n1| |x'| $) (|getShellEntry| $ 72)) + (|getShellEntry| $ 66))))))) + +(DEFUN |UPOLYC-;differentiate;SM2S;35| (|x| |deriv| |x'| $) + (PROG (|dg| |lc| |d|) + (RETURN + (SEQ (LETT |d| (|spadConstant| $ 61) + |UPOLYC-;differentiate;SM2S;35|) + (SEQ G190 + (COND + ((NULL (< 0 + (LETT |dg| + (SPADCALL |x| (|getShellEntry| $ 11)) + |UPOLYC-;differentiate;SM2S;35|))) + (GO G191))) + (SEQ (LETT |lc| (SPADCALL |x| (|getShellEntry| $ 54)) + |UPOLYC-;differentiate;SM2S;35|) + (LETT |d| + (SPADCALL + (SPADCALL |d| + (SPADCALL (SPADCALL |lc| |deriv|) + |dg| (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + (SPADCALL |lc| + (|UPOLYC-;ncdiff| |dg| |x'| $) + (|getShellEntry| $ 135)) + (|getShellEntry| $ 66)) + |UPOLYC-;differentiate;SM2S;35|) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 56)) + |UPOLYC-;differentiate;SM2S;35|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |d| + (SPADCALL + (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 54)) + |deriv|) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 66))))))) + +(DEFUN |UPOLYC-;differentiate;SMS;36| (|x| |deriv| $) + (SPADCALL |x| |deriv| (|spadConstant| $ 48) (|getShellEntry| $ 136))) + +(DEFUN |UPOLYC-;differentiate;2S;37| (|x| $) + (PROG (|dg| #0=#:G1600 |d|) + (RETURN + (SEQ (LETT |d| (|spadConstant| $ 61) + |UPOLYC-;differentiate;2S;37|) + (SEQ G190 + (COND + ((NULL (< 0 + (LETT |dg| + (SPADCALL |x| (|getShellEntry| $ 11)) + |UPOLYC-;differentiate;2S;37|))) + (GO G191))) + (SEQ (LETT |d| + (SPADCALL |d| + (SPADCALL + (SPADCALL |dg| + (SPADCALL |x| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 132)) + (PROG1 + (LETT #0# (- |dg| 1) + |UPOLYC-;differentiate;2S;37|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + |UPOLYC-;differentiate;2S;37|) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 56)) + |UPOLYC-;differentiate;2S;37|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |d|))))) + +(DEFUN |UPOLYC-;differentiate;SSaosS;38| (|x| |v| $) + (SPADCALL |x| (|getShellEntry| $ 139))) + +(DEFUN |UPOLYC-;elt;3F;39| (|g| |f| $) + (SPADCALL + (SPADCALL (SPADCALL |g| (|getShellEntry| $ 142)) |f| + (|getShellEntry| $ 144)) + (SPADCALL (SPADCALL |g| (|getShellEntry| $ 145)) |f| + (|getShellEntry| $ 144)) + (|getShellEntry| $ 146))) + +(DEFUN |UPOLYC-;pseudoQuotient;3S;40| (|p| |q| $) + (PROG (|n| #0=#:G1646 #1=#:G1648) + (RETURN + (SEQ (LETT |n| + (+ (- (SPADCALL |p| (|getShellEntry| $ 11)) + (SPADCALL |q| (|getShellEntry| $ 11))) + 1) + |UPOLYC-;pseudoQuotient;3S;40|) + (EXIT (COND + ((< |n| 1) (|spadConstant| $ 61)) + ('T + (PROG2 (LETT #1# + (SPADCALL + (SPADCALL + (SPADCALL + (SPADCALL + (SPADCALL |q| + (|getShellEntry| $ 54)) + (PROG1 + (LETT #0# |n| + |UPOLYC-;pseudoQuotient;3S;40|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 148)) + |p| (|getShellEntry| $ 135)) + (SPADCALL |p| |q| + (|getShellEntry| $ 149)) + (|getShellEntry| $ 150)) + |q| (|getShellEntry| $ 127)) + |UPOLYC-;pseudoQuotient;3S;40|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) + (|getShellEntry| $ 6) #1#))))))))) + +(DEFUN |UPOLYC-;pseudoDivide;2SR;41| (|p| |q| $) + (PROG (|n| |prem| #0=#:G1654 |lc| #1=#:G1656) + (RETURN + (SEQ (LETT |n| + (+ (- (SPADCALL |p| (|getShellEntry| $ 11)) + (SPADCALL |q| (|getShellEntry| $ 11))) + 1) + |UPOLYC-;pseudoDivide;2SR;41|) + (EXIT (COND + ((< |n| 1) + (VECTOR (|spadConstant| $ 49) (|spadConstant| $ 61) + |p|)) + ('T + (SEQ (LETT |prem| + (SPADCALL |p| |q| + (|getShellEntry| $ 149)) + |UPOLYC-;pseudoDivide;2SR;41|) + (LETT |lc| + (SPADCALL + (SPADCALL |q| + (|getShellEntry| $ 54)) + (PROG1 + (LETT #0# |n| + |UPOLYC-;pseudoDivide;2SR;41|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 148)) + |UPOLYC-;pseudoDivide;2SR;41|) + (EXIT (VECTOR |lc| + (PROG2 + (LETT #1# + (SPADCALL + (SPADCALL + (SPADCALL |lc| |p| + (|getShellEntry| $ 135)) + |prem| + (|getShellEntry| $ 150)) + |q| (|getShellEntry| $ 127)) + |UPOLYC-;pseudoDivide;2SR;41|) + (QCDR #1#) + (|check-union| (QEQCAR #1# 0) + (|getShellEntry| $ 6) #1#)) + |prem|)))))))))) + +(DEFUN |UPOLYC-;composite;FSU;42| (|f| |q| $) + (PROG (|n| |d|) + (RETURN + (SEQ (LETT |n| + (SPADCALL (SPADCALL |f| (|getShellEntry| $ 142)) |q| + (|getShellEntry| $ 154)) + |UPOLYC-;composite;FSU;42|) + (EXIT (COND + ((QEQCAR |n| 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |d| + (SPADCALL + (SPADCALL |f| + (|getShellEntry| $ 145)) + |q| (|getShellEntry| $ 154)) + |UPOLYC-;composite;FSU;42|) + (EXIT (COND + ((QEQCAR |d| 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (QCDR |n|) (QCDR |d|) + (|getShellEntry| $ 155)))))))))))))) + +(DEFUN |UPOLYC-;composite;2SU;43| (|p| |q| $) + (PROG (|cqr| |v| |u| |w| #0=#:G1682) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 158)) (CONS 0 |p|)) + ('T + (SEQ (EXIT (SEQ (LETT |cqr| + (SPADCALL |p| |q| + (|getShellEntry| $ 159)) + |UPOLYC-;composite;2SU;43|) + (COND + ((SPADCALL (QVELT |cqr| 2) + (|getShellEntry| $ 158)) + (SEQ (LETT |v| + (SPADCALL (QVELT |cqr| 2) + (QVELT |cqr| 0) + (|getShellEntry| $ 160)) + |UPOLYC-;composite;2SU;43|) + (EXIT + (COND + ((QEQCAR |v| 0) + (SEQ + (LETT |u| + (SPADCALL (QVELT |cqr| 1) + |q| + (|getShellEntry| $ 154)) + |UPOLYC-;composite;2SU;43|) + (EXIT + (COND + ((QEQCAR |u| 0) + (SEQ + (LETT |w| + (SPADCALL (QCDR |u|) + (QVELT |cqr| 0) + (|getShellEntry| $ + 160)) + |UPOLYC-;composite;2SU;43|) + (EXIT + (COND + ((QEQCAR |w| 0) + (PROGN + (LETT #0# + (CONS 0 + (SPADCALL + (QCDR |v|) + (SPADCALL + (SPADCALL + (|spadConstant| + $ 49) + 1 + (|getShellEntry| + $ 50)) + (QCDR |w|) + (|getShellEntry| + $ 72)) + (|getShellEntry| + $ 66))) + |UPOLYC-;composite;2SU;43|) + (GO #0#)))))))))))))))) + (EXIT (CONS 1 "failed")))) + #0# (EXIT #0#)))))))) + +(DEFUN |UPOLYC-;elt;S2F;44| (|p| |f| $) + (PROG (|n| #0=#:G1688 |ans|) + (RETURN + (SEQ (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) + (|spadConstant| $ 162)) + ('T + (SEQ (LETT |ans| + (SPADCALL + (SPADCALL + (SPADCALL |p| (|getShellEntry| $ 54)) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 163)) + |UPOLYC-;elt;S2F;44|) + (LETT |n| (SPADCALL |p| (|getShellEntry| $ 11)) + |UPOLYC-;elt;S2F;44|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL + (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 56)) + |UPOLYC-;elt;S2F;44|) + (|getShellEntry| $ 9)) + (|getShellEntry| $ 164))) + (GO G191))) + (SEQ (EXIT (LETT |ans| + (SPADCALL + (SPADCALL |ans| + (SPADCALL |f| + (PROG1 + (LETT #0# + (- |n| + (LETT |n| + (SPADCALL |p| + (|getShellEntry| $ 11)) + |UPOLYC-;elt;S2F;44|)) + |UPOLYC-;elt;S2F;44|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 165)) + (|getShellEntry| $ 166)) + (SPADCALL + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 30)) + (|getShellEntry| $ 163)) + (|getShellEntry| $ 167)) + |UPOLYC-;elt;S2F;44|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((ZEROP |n|) |ans|) + ('T + (SPADCALL |ans| + (SPADCALL |f| |n| + (|getShellEntry| $ 168)) + (|getShellEntry| $ 166)))))))))))) + +(DEFUN |UPOLYC-;order;2SNni;45| (|p| |q| $) + (PROG (|u| #0=#:G1702 |ans|) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |p| (|getShellEntry| $ 9)) + (|error| "order: arguments must be nonzero")) + ((< (SPADCALL |q| (|getShellEntry| $ 11)) 1) + (|error| "order: place must be non-trivial")) + ('T + (SEQ (LETT |ans| 0 |UPOLYC-;order;2SNni;45|) + (EXIT (SEQ G190 NIL + (SEQ + (LETT |u| + (SPADCALL |p| |q| + (|getShellEntry| $ 127)) + |UPOLYC-;order;2SNni;45|) + (EXIT + (COND + ((QEQCAR |u| 1) + (PROGN + (LETT #0# |ans| + |UPOLYC-;order;2SNni;45|) + (GO #0#))) + ('T + (SEQ + (LETT |p| (QCDR |u|) + |UPOLYC-;order;2SNni;45|) + (EXIT + (LETT |ans| (+ |ans| 1) + |UPOLYC-;order;2SNni;45|))))))) + NIL (GO G190) G191 (EXIT NIL))))))) + #0# (EXIT #0#))))) + +(DEFUN |UPOLYC-;squareFree;SF;46| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 172))) + +(DEFUN |UPOLYC-;squareFreePart;2S;47| (|p| $) + (SPADCALL |p| (|getShellEntry| $ 174))) + +(DEFUN |UPOLYC-;gcdPolynomial;3Sup;48| (|pp| |qq| $) + (COND + ((SPADCALL |pp| (|getShellEntry| $ 176)) + (SPADCALL |qq| (|getShellEntry| $ 177))) + ((SPADCALL |qq| (|getShellEntry| $ 176)) + (SPADCALL |pp| (|getShellEntry| $ 177))) + ('T + (SPADCALL + (SPADCALL + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 178)) + (SPADCALL |qq| (|getShellEntry| $ 178)) + (|getShellEntry| $ 126)) + (SPADCALL + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 179)) + (SPADCALL |qq| (|getShellEntry| $ 179)) + (|getShellEntry| $ 180)) + (|getShellEntry| $ 179)) + (|getShellEntry| $ 181)) + (|getShellEntry| $ 177))))) + +(DEFUN |UPOLYC-;squareFreePolynomial;SupF;49| (|pp| $) + (SPADCALL |pp| (|getShellEntry| $ 184))) + +(DEFUN |UPOLYC-;elt;F2R;50| (|f| |r| $) + (SPADCALL + (SPADCALL (SPADCALL |f| (|getShellEntry| $ 142)) |r| + (|getShellEntry| $ 29)) + (SPADCALL (SPADCALL |f| (|getShellEntry| $ 145)) |r| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 186))) + +(DEFUN |UPOLYC-;euclideanSize;SNni;51| (|x| $) + (COND + ((SPADCALL |x| (|getShellEntry| $ 9)) + (|error| "euclideanSize called on 0 in Univariate Polynomial")) + ('T (SPADCALL |x| (|getShellEntry| $ 11))))) + +(DEFUN |UPOLYC-;divide;2SR;52| (|x| |y| $) + (PROG (|lc| |f| #0=#:G1714 |n| |quot|) + (RETURN + (SEQ (COND + ((SPADCALL |y| (|getShellEntry| $ 9)) + (|error| "division by 0 in Univariate Polynomials")) + ('T + (SEQ (LETT |quot| (|spadConstant| $ 61) + |UPOLYC-;divide;2SR;52|) + (LETT |lc| + (SPADCALL + (SPADCALL |y| (|getShellEntry| $ 54)) + (|getShellEntry| $ 189)) + |UPOLYC-;divide;2SR;52|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |x| + (|getShellEntry| $ 9)) + 'NIL) + ('T + (SPADCALL + (< + (SPADCALL |x| + (|getShellEntry| $ 11)) + (SPADCALL |y| + (|getShellEntry| $ 11))) + (|getShellEntry| $ 164))))) + (GO G191))) + (SEQ (LETT |f| + (SPADCALL |lc| + (SPADCALL |x| + (|getShellEntry| $ 54)) + (|getShellEntry| $ 190)) + |UPOLYC-;divide;2SR;52|) + (LETT |n| + (PROG1 + (LETT #0# + (- + (SPADCALL |x| + (|getShellEntry| $ 11)) + (SPADCALL |y| + (|getShellEntry| $ 11))) + |UPOLYC-;divide;2SR;52|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |UPOLYC-;divide;2SR;52|) + (LETT |quot| + (SPADCALL |quot| + (SPADCALL |f| |n| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 66)) + |UPOLYC-;divide;2SR;52|) + (EXIT (LETT |x| + (SPADCALL |x| + (SPADCALL + (SPADCALL |f| |n| + (|getShellEntry| $ 50)) + |y| (|getShellEntry| $ 72)) + (|getShellEntry| $ 150)) + |UPOLYC-;divide;2SR;52|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (CONS |quot| |x|))))))))) + +(DEFUN |UPOLYC-;integrate;2S;53| (|p| $) + (PROG (|l| |d| |ans|) + (RETURN + (SEQ (LETT |ans| (|spadConstant| $ 61) |UPOLYC-;integrate;2S;53|) + (SEQ G190 + (COND + ((NULL (SPADCALL |p| (|spadConstant| $ 61) + (|getShellEntry| $ 192))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |p| (|getShellEntry| $ 54)) + |UPOLYC-;integrate;2S;53|) + (LETT |d| + (+ 1 (SPADCALL |p| (|getShellEntry| $ 11))) + |UPOLYC-;integrate;2S;53|) + (LETT |ans| + (SPADCALL |ans| + (SPADCALL + (SPADCALL + (SPADCALL |d| + (|getShellEntry| $ 194)) + (|getShellEntry| $ 195)) + (SPADCALL |l| |d| + (|getShellEntry| $ 50)) + (|getShellEntry| $ 196)) + (|getShellEntry| $ 66)) + |UPOLYC-;integrate;2S;53|) + (EXIT (LETT |p| + (SPADCALL |p| (|getShellEntry| $ 56)) + |UPOLYC-;integrate;2S;53|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |ans|))))) + +(DEFUN |UnivariatePolynomialCategory&| (|#1| |#2|) + (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) + (RETURN + (PROGN + (LETT |dv$1| (|devaluate| |#1|) + . #0=(|UnivariatePolynomialCategory&|)) + (LETT |dv$2| (|devaluate| |#2|) . #0#) + (LETT |dv$| + (LIST '|UnivariatePolynomialCategory&| |dv$1| |dv$2|) . #0#) + (LETT $ (|newShell| 203) . #0#) + (|setShellEntry| $ 0 |dv$|) + (|setShellEntry| $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasCategory| |#2| + '(|Algebra| (|Fraction| (|Integer|)))) + (|HasCategory| |#2| '(|Field|)) + (|HasCategory| |#2| '(|GcdDomain|)) + (|HasCategory| |#2| '(|IntegralDomain|)) + (|HasCategory| |#2| '(|CommutativeRing|)) + (|HasCategory| |#2| '(|StepThrough|)))) . #0#)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (|setShellEntry| $ 7 |#2|) + (COND + ((|HasCategory| |#2| '(|PolynomialFactorizationExplicit|)) + (PROGN + (|setShellEntry| $ 82 + (CONS (|dispatchFunction| + |UPOLYC-;solveLinearPolynomialEquation;LSupU;20|) + $)) + (|setShellEntry| $ 86 + (CONS (|dispatchFunction| + |UPOLYC-;factorPolynomial;SupF;21|) + $)) + (|setShellEntry| $ 88 + (CONS (|dispatchFunction| + |UPOLYC-;factorSquareFreePolynomial;SupF;22|) + $)) + (|setShellEntry| $ 107 + (CONS (|dispatchFunction| |UPOLYC-;factor;SF;23|) $))))) + (COND + ((|testBitVector| |pv$| 6) + (PROGN + (|setShellEntry| $ 119 + (CONS (|dispatchFunction| |UPOLYC-;init;S;27|) $)) + NIL + (|setShellEntry| $ 123 + (CONS (|dispatchFunction| |UPOLYC-;nextItem;SU;29|) $))))) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (|setShellEntry| $ 125 + (CONS (|dispatchFunction| |UPOLYC-;content;SSaosS;30|) + $)) + NIL + (|setShellEntry| $ 130 + (CONS (|dispatchFunction| |UPOLYC-;separate;2SR;32|) + $))))) + (COND + ((|testBitVector| |pv$| 5) + (|setShellEntry| $ 134 + (CONS (|dispatchFunction| + |UPOLYC-;differentiate;SM2S;33|) + $))) + ('T + (PROGN + (|setShellEntry| $ 134 + (CONS (|dispatchFunction| + |UPOLYC-;differentiate;SM2S;35|) + $))))) + (COND + ((|testBitVector| |pv$| 4) + (PROGN + (|setShellEntry| $ 147 + (CONS (|dispatchFunction| |UPOLYC-;elt;3F;39|) $)) + (|setShellEntry| $ 151 + (CONS (|dispatchFunction| + |UPOLYC-;pseudoQuotient;3S;40|) + $)) + (|setShellEntry| $ 153 + (CONS (|dispatchFunction| + |UPOLYC-;pseudoDivide;2SR;41|) + $)) + (|setShellEntry| $ 157 + (CONS (|dispatchFunction| |UPOLYC-;composite;FSU;42|) + $)) + (|setShellEntry| $ 161 + (CONS (|dispatchFunction| |UPOLYC-;composite;2SU;43|) + $)) + (|setShellEntry| $ 169 + (CONS (|dispatchFunction| |UPOLYC-;elt;S2F;44|) $)) + (|setShellEntry| $ 170 + (CONS (|dispatchFunction| |UPOLYC-;order;2SNni;45|) $))))) + (COND + ((|testBitVector| |pv$| 3) + (PROGN + (|setShellEntry| $ 173 + (CONS (|dispatchFunction| |UPOLYC-;squareFree;SF;46|) + $)) + (|setShellEntry| $ 175 + (CONS (|dispatchFunction| + |UPOLYC-;squareFreePart;2S;47|) + $))))) + (COND + ((|HasCategory| |#2| '(|PolynomialFactorizationExplicit|)) + (PROGN + (|setShellEntry| $ 182 + (CONS (|dispatchFunction| + |UPOLYC-;gcdPolynomial;3Sup;48|) + $)) + (|setShellEntry| $ 185 + (CONS (|dispatchFunction| + |UPOLYC-;squareFreePolynomial;SupF;49|) + $))))) + (COND + ((|testBitVector| |pv$| 2) + (PROGN + (|setShellEntry| $ 187 + (CONS (|dispatchFunction| |UPOLYC-;elt;F2R;50|) $)) + (|setShellEntry| $ 188 + (CONS (|dispatchFunction| + |UPOLYC-;euclideanSize;SNni;51|) + $)) + (|setShellEntry| $ 191 + (CONS (|dispatchFunction| |UPOLYC-;divide;2SR;52|) $))))) + (COND + ((|testBitVector| |pv$| 1) + (|setShellEntry| $ 197 + (CONS (|dispatchFunction| |UPOLYC-;integrate;2S;53|) $)))) + $)))) + +(MAKEPROP '|UnivariatePolynomialCategory&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (|Boolean|) (0 . |zero?|) (|NonNegativeInteger|) + (5 . |degree|) (|SingletonAsOrderedSet|) (10 . |create|) + (|List| 12) |UPOLYC-;variables;SL;1| + |UPOLYC-;degree;SSaosNni;2| (14 . |totalDegree|) + |UPOLYC-;totalDegree;SLNni;3| (|List| 10) + |UPOLYC-;degree;SLL;4| (19 . |eval|) (|List| $) + |UPOLYC-;eval;SLLS;5| (26 . |elt|) + |UPOLYC-;eval;SSaos2S;6| (32 . |eval|) (|List| 7) + |UPOLYC-;eval;SLLS;7| (39 . |elt|) (45 . |coerce|) + |UPOLYC-;eval;SSaosRS;8| (|Equation| 6) (50 . |lhs|) + (|Union| 12 '"failed") (55 . |mainVariable|) (60 . |rhs|) + (|Equation| $) (|List| 37) |UPOLYC-;eval;SLS;9| + |UPOLYC-;mainVariable;SU;10| (65 . |minimumDegree|) + |UPOLYC-;minimumDegree;SSaosNni;11| + |UPOLYC-;minimumDegree;SLL;12| (70 . +) (|Mapping| 10 10) + (76 . |mapExponents|) |UPOLYC-;monomial;SSaosNniS;13| + (82 . |One|) (86 . |One|) (90 . |monomial|) + |UPOLYC-;coerce;SaosS;14| (|SparseUnivariatePolynomial| 7) + (96 . |Zero|) (100 . |leadingCoefficient|) + (105 . |monomial|) (111 . |reductum|) (116 . |makeSUP|) + (121 . +) |UPOLYC-;makeSUP;SSup;15| (127 . |zero?|) + (132 . |Zero|) (136 . |leadingCoefficient|) + (141 . |degree|) (146 . |reductum|) (151 . |unmakeSUP|) + (156 . +) |UPOLYC-;unmakeSUP;SupS;16| + (|Record| (|:| |quotient| $) (|:| |remainder| $)) + (162 . |monicDivide|) |UPOLYC-;karatsubaDivide;SNniR;17| + |UPOLYC-;shiftRight;SNniS;18| (168 . *) + |UPOLYC-;shiftLeft;SNniS;19| + (|SparseUnivariatePolynomial| 6) (|List| 74) + (|Union| 75 '"failed") + (|PolynomialFactorizationByRecursionUnivariate| 7 6) + (174 . |solveLinearPolynomialEquationByRecursion|) + (|SparseUnivariatePolynomial| $) (|List| 79) + (|Union| 80 '"failed") + (180 . |solveLinearPolynomialEquation|) (|Factored| 74) + (186 . |factorByRecursion|) (|Factored| 79) + (191 . |factorPolynomial|) + (196 . |factorSquareFreeByRecursion|) + (201 . |factorSquareFreePolynomial|) (|Factored| $) + (206 . |factor|) (|Factored| 7) (211 . |unit|) + (|Union| '"nil" '"sqfr" '"irred" '"prime") (|Integer|) + (|Record| (|:| |flg| 93) (|:| |fctr| 7) (|:| |xpnt| 94)) + (|List| 95) (216 . |factorList|) + (|Record| (|:| |flg| 93) (|:| |fctr| 6) (|:| |xpnt| 94)) + (|List| 98) (|Factored| 6) (221 . |makeFR|) + (227 . |factorPolynomial|) (|Mapping| 6 52) + (|Factored| 52) (|FactoredFunctions2| 52 6) (232 . |map|) + (238 . |factor|) (243 . |Zero|) (|Vector| 7) (247 . |new|) + (253 . |minIndex|) (258 . |coefficient|) + (264 . |qsetelt!|) |UPOLYC-;vectorise;SNniV;24| + |UPOLYC-;retract;SR;25| (|Union| 7 '"failed") + |UPOLYC-;retractIfCan;SU;26| (271 . |init|) (275 . |init|) + (|Union| $ '"failed") (279 . |nextItem|) (284 . |One|) + (288 . |nextItem|) (293 . |content|) (298 . |content|) + (304 . |gcd|) (310 . |exquo|) (316 . =) + (|Record| (|:| |primePart| $) (|:| |commonPart| $)) + (322 . |separate|) (328 . |Zero|) (332 . *) + (|Mapping| 7 7) (338 . |differentiate|) (345 . *) + (351 . |differentiate|) |UPOLYC-;differentiate;SMS;36| + |UPOLYC-;differentiate;2S;37| (358 . |differentiate|) + |UPOLYC-;differentiate;SSaosS;38| (|Fraction| 6) + (363 . |numer|) (|Fraction| $) (368 . |elt|) + (374 . |denom|) (379 . /) (385 . |elt|) (391 . **) + (397 . |pseudoRemainder|) (403 . -) + (409 . |pseudoQuotient|) + (|Record| (|:| |coef| 7) (|:| |quotient| $) + (|:| |remainder| $)) + (415 . |pseudoDivide|) (421 . |composite|) (427 . /) + (|Union| 143 '"failed") (433 . |composite|) + (439 . |ground?|) (444 . |pseudoDivide|) (450 . |exquo|) + (456 . |composite|) (462 . |Zero|) (466 . |coerce|) + (471 . |not|) (476 . **) (482 . *) (488 . +) (494 . **) + (500 . |elt|) (506 . |order|) + (|UnivariatePolynomialSquareFree| 7 6) + (512 . |squareFree|) (517 . |squareFree|) + (522 . |squareFreePart|) (527 . |squareFreePart|) + (532 . |zero?|) (537 . |unitCanonical|) (542 . |content|) + (547 . |primitivePart|) (552 . |subResultantGcd|) + (558 . *) (564 . |gcdPolynomial|) + (|UnivariatePolynomialSquareFree| 6 74) + (570 . |squareFree|) (575 . |squareFreePolynomial|) + (580 . /) (586 . |elt|) (592 . |euclideanSize|) + (597 . |inv|) (602 . *) (608 . |divide|) (614 . ~=) + (|Fraction| 94) (620 . |coerce|) (625 . |inv|) (630 . *) + (636 . |integrate|) (|Symbol|) (|List| 198) + (|Union| 94 '"failed") (|Union| 193 '"failed") + (|OutputForm|)) + '#(|vectorise| 641 |variables| 647 |unmakeSUP| 652 + |totalDegree| 657 |squareFreePolynomial| 663 + |squareFreePart| 668 |squareFree| 673 + |solveLinearPolynomialEquation| 678 |shiftRight| 684 + |shiftLeft| 690 |separate| 696 |retractIfCan| 702 + |retract| 707 |pseudoQuotient| 712 |pseudoDivide| 718 + |order| 724 |nextItem| 730 |monomial| 735 |minimumDegree| + 742 |makeSUP| 754 |mainVariable| 759 |karatsubaDivide| 764 + |integrate| 770 |init| 775 |gcdPolynomial| 779 + |factorSquareFreePolynomial| 785 |factorPolynomial| 790 + |factor| 795 |eval| 800 |euclideanSize| 834 |elt| 839 + |divide| 857 |differentiate| 863 |degree| 887 |content| + 899 |composite| 905 |coerce| 917) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 197 + '(1 6 8 0 9 1 6 10 0 11 0 12 0 13 1 6 + 10 0 17 3 6 0 0 12 0 21 2 6 0 0 0 24 + 3 6 0 0 12 7 26 2 6 7 0 7 29 1 6 0 7 + 30 1 32 6 0 33 1 6 34 0 35 1 32 6 0 + 36 1 6 10 0 41 2 10 0 0 0 44 2 6 0 45 + 0 46 0 6 0 48 0 7 0 49 2 6 0 7 10 50 + 0 52 0 53 1 6 7 0 54 2 52 0 7 10 55 1 + 6 0 0 56 1 6 52 0 57 2 52 0 0 0 58 1 + 52 8 0 60 0 6 0 61 1 52 7 0 62 1 52 + 10 0 63 1 52 0 0 64 1 6 0 52 65 2 6 0 + 0 0 66 2 6 68 0 0 69 2 6 0 0 0 72 2 + 77 76 75 74 78 2 0 81 80 79 82 1 77 + 83 74 84 1 0 85 79 86 1 77 83 74 87 1 + 0 85 79 88 1 7 89 0 90 1 91 7 0 92 1 + 91 96 0 97 2 100 0 6 99 101 1 7 85 79 + 102 2 105 100 103 104 106 1 0 89 0 + 107 0 7 0 108 2 109 0 10 7 110 1 109 + 94 0 111 2 6 7 0 10 112 3 109 7 0 94 + 7 113 0 7 0 118 0 0 0 119 1 7 120 0 + 121 0 74 0 122 1 0 120 0 123 1 6 7 0 + 124 2 0 0 0 12 125 2 6 0 0 0 126 2 6 + 120 0 0 127 2 6 8 0 0 128 2 0 129 0 0 + 130 0 74 0 131 2 7 0 10 0 132 3 0 0 0 + 133 0 134 2 6 0 7 0 135 3 6 0 0 133 0 + 136 1 6 0 0 139 1 141 6 0 142 2 6 143 + 0 143 144 1 141 6 0 145 2 141 0 0 0 + 146 2 0 143 143 143 147 2 7 0 0 10 + 148 2 6 0 0 0 149 2 6 0 0 0 150 2 0 0 + 0 0 151 2 0 152 0 0 153 2 6 120 0 0 + 154 2 141 0 6 6 155 2 0 156 143 0 157 + 1 6 8 0 158 2 6 152 0 0 159 2 6 120 0 + 7 160 2 0 120 0 0 161 0 141 0 162 1 + 141 0 6 163 1 8 0 0 164 2 141 0 0 94 + 165 2 141 0 0 0 166 2 141 0 0 0 167 2 + 141 0 0 10 168 2 0 143 0 143 169 2 0 + 10 0 0 170 1 171 100 6 172 1 0 89 0 + 173 1 171 6 6 174 1 0 0 0 175 1 74 8 + 0 176 1 74 0 0 177 1 74 6 0 178 1 74 + 0 0 179 2 74 0 0 0 180 2 74 0 6 0 181 + 2 0 79 79 79 182 1 183 83 74 184 1 0 + 85 79 185 2 7 0 0 0 186 2 0 7 143 7 + 187 1 0 10 0 188 1 7 0 0 189 2 7 0 0 + 0 190 2 0 68 0 0 191 2 6 8 0 0 192 1 + 193 0 94 194 1 193 0 0 195 2 6 0 193 + 0 196 1 0 0 0 197 2 0 109 0 10 114 1 + 0 14 0 15 1 0 0 52 67 2 0 10 0 14 18 + 1 0 85 79 185 1 0 0 0 175 1 0 89 0 + 173 2 0 81 80 79 82 2 0 0 0 10 71 2 0 + 0 0 10 73 2 0 129 0 0 130 1 0 116 0 + 117 1 0 7 0 115 2 0 0 0 0 151 2 0 152 + 0 0 153 2 0 10 0 0 170 1 0 120 0 123 + 3 0 0 0 12 10 47 2 0 19 0 14 43 2 0 + 10 0 12 42 1 0 52 0 59 1 0 34 0 40 2 + 0 68 0 10 70 1 0 0 0 197 0 0 0 119 2 + 0 79 79 79 182 1 0 85 79 88 1 0 85 79 + 86 1 0 89 0 107 3 0 0 0 12 0 25 3 0 0 + 0 14 22 23 3 0 0 0 14 27 28 3 0 0 0 + 12 7 31 2 0 0 0 38 39 1 0 10 0 188 2 + 0 143 0 143 169 2 0 7 143 7 187 2 0 + 143 143 143 147 2 0 68 0 0 191 3 0 0 + 0 133 0 134 2 0 0 0 133 137 1 0 0 0 + 138 2 0 0 0 12 140 2 0 10 0 12 16 2 0 + 19 0 14 20 2 0 0 0 12 125 2 0 120 0 0 + 161 2 0 156 143 0 157 1 0 0 12 51))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/UPOLYC.lsp b/src/algebra/strap/UPOLYC.lsp new file mode 100644 index 00000000..895e13e4 --- /dev/null +++ b/src/algebra/strap/UPOLYC.lsp @@ -0,0 +1,158 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UnivariatePolynomialCategory;CAT| 'NIL) + +(DEFPARAMETER |UnivariatePolynomialCategory;AL| 'NIL) + +(DEFUN |UnivariatePolynomialCategory| (#0=#:G1424) + (LET (#1=#:G1425) + (COND + ((SETQ #1# + (|assoc| (|devaluate| #0#) + |UnivariatePolynomialCategory;AL|)) + (CDR #1#)) + (T (SETQ |UnivariatePolynomialCategory;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# + (|UnivariatePolynomialCategory;| + #0#))) + |UnivariatePolynomialCategory;AL|)) + #1#)))) + +(DEFUN |UnivariatePolynomialCategory;| (|t#1|) + (PROG (#0=#:G1423) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (|sublisV| + (PAIR '(#1=#:G1421 #2=#:G1422) + (LIST '(|NonNegativeInteger|) + '(|SingletonAsOrderedSet|))) + (COND + (|UnivariatePolynomialCategory;CAT|) + ('T + (LETT |UnivariatePolynomialCategory;CAT| + (|Join| + (|PolynomialCategory| '|t#1| '#1# + '#2#) + (|Eltable| '|t#1| '|t#1|) + (|Eltable| '$ '$) + (|DifferentialRing|) + (|DifferentialExtension| '|t#1|) + (|mkCategory| '|domain| + '(((|vectorise| + ((|Vector| |t#1|) $ + (|NonNegativeInteger|))) + T) + ((|makeSUP| + ((|SparseUnivariatePolynomial| + |t#1|) + $)) + T) + ((|unmakeSUP| + ($ + (|SparseUnivariatePolynomial| + |t#1|))) + T) + ((|multiplyExponents| + ($ $ (|NonNegativeInteger|))) + T) + ((|divideExponents| + ((|Union| $ "failed") $ + (|NonNegativeInteger|))) + T) + ((|monicDivide| + ((|Record| (|:| |quotient| $) + (|:| |remainder| $)) + $ $)) + T) + ((|karatsubaDivide| + ((|Record| (|:| |quotient| $) + (|:| |remainder| $)) + $ (|NonNegativeInteger|))) + T) + ((|shiftRight| + ($ $ (|NonNegativeInteger|))) + T) + ((|shiftLeft| + ($ $ (|NonNegativeInteger|))) + T) + ((|pseudoRemainder| ($ $ $)) T) + ((|differentiate| + ($ $ (|Mapping| |t#1| |t#1|) + $)) + T) + ((|discriminant| (|t#1| $)) + (|has| |t#1| + (|CommutativeRing|))) + ((|resultant| (|t#1| $ $)) + (|has| |t#1| + (|CommutativeRing|))) + ((|elt| + ((|Fraction| $) + (|Fraction| $) + (|Fraction| $))) + (|has| |t#1| + (|IntegralDomain|))) + ((|order| + ((|NonNegativeInteger|) $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|subResultantGcd| ($ $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|composite| + ((|Union| $ "failed") $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|composite| + ((|Union| (|Fraction| $) + "failed") + (|Fraction| $) $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|pseudoQuotient| ($ $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|pseudoDivide| + ((|Record| (|:| |coef| |t#1|) + (|:| |quotient| $) + (|:| |remainder| $)) + $ $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|separate| + ((|Record| + (|:| |primePart| $) + (|:| |commonPart| $)) + $ $)) + (|has| |t#1| (|GcdDomain|))) + ((|elt| + (|t#1| (|Fraction| $) |t#1|)) + (|has| |t#1| (|Field|))) + ((|integrate| ($ $)) + (|has| |t#1| + (|Algebra| + (|Fraction| (|Integer|)))))) + '(((|StepThrough|) + (|has| |t#1| (|StepThrough|))) + ((|Eltable| (|Fraction| $) + (|Fraction| $)) + (|has| |t#1| + (|IntegralDomain|))) + ((|EuclideanDomain|) + (|has| |t#1| (|Field|))) + (|additiveValuation| + (|has| |t#1| (|Field|)))) + '((|Fraction| $) + (|NonNegativeInteger|) + (|SparseUnivariatePolynomial| + |t#1|) + (|Vector| |t#1|)) + NIL)) + . #3=(|UnivariatePolynomialCategory|)))))) . #3#) + (SETELT #0# 0 + (LIST '|UnivariatePolynomialCategory| + (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp new file mode 100644 index 00000000..06ae51f1 --- /dev/null +++ b/src/algebra/strap/URAGG-.lsp @@ -0,0 +1,612 @@ + +(/VERSIONCHECK 2) + +(DEFUN |URAGG-;elt;AfirstS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) + +(DEFUN |URAGG-;elt;AlastS;2| (|x| T1 $) (SPADCALL |x| (QREFELT $ 11))) + +(DEFUN |URAGG-;elt;ArestA;3| (|x| T2 $) (SPADCALL |x| (QREFELT $ 14))) + +(DEFUN |URAGG-;second;AS;4| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 8))) + +(DEFUN |URAGG-;third;AS;5| (|x| $) + (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 14)) + (QREFELT $ 8))) + +(DEFUN |URAGG-;cyclic?;AB;6| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 20)) 'NIL) + ('T + (SPADCALL (SPADCALL (|URAGG-;findCycle| |x| $) (QREFELT $ 20)) + (QREFELT $ 21))))) + +(DEFUN |URAGG-;last;AS;7| (|x| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 23)) (QREFELT $ 8))) + +(DEFUN |URAGG-;nodes;AL;8| (|x| $) + (PROG (|l|) + (RETURN + (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) + (SEQ G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;nodes;AL;8|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (NREVERSE |l|)))))) + +(DEFUN |URAGG-;children;AL;9| (|x| $) + (PROG (|l|) + (RETURN + (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 20)) |l|) + ('T (CONS (SPADCALL |x| (QREFELT $ 14)) |l|)))))))) + +(DEFUN |URAGG-;leaf?;AB;10| (|x| $) (SPADCALL |x| (QREFELT $ 20))) + +(DEFUN |URAGG-;value;AS;11| (|x| $) + (COND + ((SPADCALL |x| (QREFELT $ 20)) (|error| "value of empty object")) + ('T (SPADCALL |x| (QREFELT $ 8))))) + +(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) + (PROG (|i|) + (RETURN + (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) + (SEQ G190 + (COND + ((NULL (COND + ((< 0 |i|) + (SPADCALL (SPADCALL |l| (QREFELT $ 20)) + (QREFELT $ 21))) + ('T 'NIL))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) + |URAGG-;less?;ANniB;12|) + (EXIT (LETT |i| (- |i| 1) |URAGG-;less?;ANniB;12|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (< 0 |i|)))))) + +(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) + (PROG (|i|) + (RETURN + (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) + (SEQ G190 + (COND + ((NULL (COND + ((< 0 |i|) + (SPADCALL (SPADCALL |l| (QREFELT $ 20)) + (QREFELT $ 21))) + ('T 'NIL))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) + |URAGG-;more?;ANniB;13|) + (EXIT (LETT |i| (- |i| 1) |URAGG-;more?;ANniB;13|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((ZEROP |i|) + (SPADCALL (SPADCALL |l| (QREFELT $ 20)) + (QREFELT $ 21))) + ('T 'NIL))))))) + +(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) + (PROG (|i|) + (RETURN + (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) + (SEQ G190 + (COND + ((NULL (COND + ((SPADCALL |l| (QREFELT $ 20)) 'NIL) + ('T (< 0 |i|)))) + (GO G191))) + (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) + |URAGG-;size?;ANniB;14|) + (EXIT (LETT |i| (- |i| 1) |URAGG-;size?;ANniB;14|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |l| (QREFELT $ 20)) (ZEROP |i|)) + ('T 'NIL))))))) + +(DEFUN |URAGG-;#;ANni;15| (|x| $) + (PROG (|k|) + (RETURN + (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 + (COND + ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (EXIT (|error| "cyclic list")))))) + (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;#;ANni;15|))) + (LETT |k| (QSADD1 |k|) |URAGG-;#;ANni;15|) (GO G190) + G191 (EXIT NIL)) + (EXIT |k|))))) + +(DEFUN |URAGG-;tail;2A;16| (|x| $) + (PROG (|k| |y|) + (RETURN + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 20)) (|error| "empty list")) + ('T + (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;tail;2A;16|) + (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (EXIT (|error| "cyclic list")))))) + (EXIT (LETT |y| + (SPADCALL + (LETT |x| |y| |URAGG-;tail;2A;16|) + (QREFELT $ 14)) + |URAGG-;tail;2A;16|))) + (LETT |k| (QSADD1 |k|) |URAGG-;tail;2A;16|) + (GO G190) G191 (EXIT NIL)) + (EXIT |x|)))))))) + +(DEFUN |URAGG-;findCycle| (|x| $) + (PROG (#0=#:G1475 |y|) + (RETURN + (SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;findCycle|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (COND + ((SPADCALL |x| |y| (QREFELT $ 37)) + (PROGN + (LETT #0# |x| |URAGG-;findCycle|) + (GO #0#)))) + (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;findCycle|) + (LETT |y| (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;findCycle|) + (COND + ((SPADCALL |y| (QREFELT $ 20)) + (PROGN + (LETT #0# |y| |URAGG-;findCycle|) + (GO #0#)))) + (COND + ((SPADCALL |x| |y| (QREFELT $ 37)) + (PROGN + (LETT #0# |y| |URAGG-;findCycle|) + (GO #0#)))) + (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;findCycle|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|))) + #0# (EXIT #0#))))) + +(DEFUN |URAGG-;cycleTail;2A;18| (|x| $) + (PROG (|y| |z|) + (RETURN + (SEQ (COND + ((SPADCALL + (LETT |y| + (LETT |x| (SPADCALL |x| (QREFELT $ 38)) + |URAGG-;cycleTail;2A;18|) + |URAGG-;cycleTail;2A;18|) + (QREFELT $ 20)) + |x|) + ('T + (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleTail;2A;18|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |x| |z| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) + (EXIT (LETT |z| + (SPADCALL |z| (QREFELT $ 14)) + |URAGG-;cycleTail;2A;18|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |y|)))))))) + +(DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) + (PROG (|l| |z| |k| |y|) + (RETURN + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 20)) |x|) + ((SPADCALL + (LETT |y| (|URAGG-;findCycle| |x| $) + |URAGG-;cycleEntry;2A;19|) + (QREFELT $ 20)) + |y|) + ('T + (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|) + (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |y| |z| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (EXIT (LETT |z| + (SPADCALL |z| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|))) + (LETT |l| (QSADD1 |l|) + |URAGG-;cycleEntry;2A;19|) + (GO G190) G191 (EXIT NIL)) + (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) + (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 + (COND ((QSGREATERP |k| |l|) (GO G191))) + (SEQ (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|))) + (LETT |k| (QSADD1 |k|) + |URAGG-;cycleEntry;2A;19|) + (GO G190) G191 (EXIT NIL)) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |x| |y| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|) + (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleEntry;2A;19|))) + NIL (GO G190) G191 (EXIT NIL)) + (EXIT |x|)))))))) + +(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) + (PROG (|k| |y|) + (RETURN + (SEQ (COND + ((OR (SPADCALL |x| (QREFELT $ 20)) + (SPADCALL + (LETT |x| (|URAGG-;findCycle| |x| $) + |URAGG-;cycleLength;ANni;20|) + (QREFELT $ 20))) + 0) + ('T + (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleLength;ANni;20|) + (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |x| |y| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (EXIT (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;cycleLength;ANni;20|))) + (LETT |k| (QSADD1 |k|) + |URAGG-;cycleLength;ANni;20|) + (GO G190) G191 (EXIT NIL)) + (EXIT |k|)))))))) + +(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) + (PROG (|i|) + (RETURN + (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 + (COND ((QSGREATERP |i| |n|) (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |x| (QREFELT $ 20)) + (|error| "Index out of range")) + ('T + (LETT |x| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;rest;ANniA;21|))))) + (LETT |i| (QSADD1 |i|) |URAGG-;rest;ANniA;21|) + (GO G190) G191 (EXIT NIL)) + (EXIT |x|))))) + +(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) + (PROG (|m| #0=#:G1498) + (RETURN + (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 43)) + |URAGG-;last;ANniA;22|) + (EXIT (COND + ((< |m| |n|) (|error| "index out of range")) + ('T + (SPADCALL + (SPADCALL |x| + (PROG1 (LETT #0# (- |m| |n|) + |URAGG-;last;ANniA;22|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 44)) + (QREFELT $ 45))))))))) + +(DEFUN |URAGG-;=;2AB;23| (|x| |y| $) + (PROG (|k| #0=#:G1508) + (RETURN + (SEQ (EXIT (COND + ((SPADCALL |x| |y| (QREFELT $ 37)) 'T) + ('T + (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 + (COND + ((NULL (COND + ((SPADCALL |x| (QREFELT $ 20)) + 'NIL) + ('T + (SPADCALL + (SPADCALL |y| + (QREFELT $ 20)) + (QREFELT $ 21))))) + (GO G191))) + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (QREFELT $ 34)) + (EXIT (|error| "cyclic list")))))) + (COND + ((NULL + (SPADCALL + (SPADCALL |x| (QREFELT $ 8)) + (SPADCALL |y| (QREFELT $ 8)) + (QREFELT $ 47))) + (EXIT + (PROGN + (LETT #0# 'NIL + |URAGG-;=;2AB;23|) + (GO #0#))))) + (LETT |x| + (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;=;2AB;23|) + (EXIT + (LETT |y| + (SPADCALL |y| (QREFELT $ 14)) + |URAGG-;=;2AB;23|))) + (LETT |k| (QSADD1 |k|) |URAGG-;=;2AB;23|) + (GO G190) G191 (EXIT NIL)) + (EXIT (COND + ((SPADCALL |x| (QREFELT $ 20)) + (SPADCALL |y| (QREFELT $ 20))) + ('T 'NIL))))))) + #0# (EXIT #0#))))) + +(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) + (PROG (|k| #0=#:G1513) + (RETURN + (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 + (COND + ((NULL (SPADCALL + (SPADCALL |v| (QREFELT $ 20)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (EXIT (COND + ((SPADCALL |u| |v| + (QREFELT $ 49)) + (PROGN + (LETT #0# 'T + |URAGG-;node?;2AB;24|) + (GO #0#))) + ('T + (SEQ + (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |v| + (QREFELT $ 34)) + (EXIT + (|error| + "cyclic list")))))) + (EXIT + (LETT |v| + (SPADCALL |v| + (QREFELT $ 14)) + |URAGG-;node?;2AB;24|))))))) + (LETT |k| (QSADD1 |k|) + |URAGG-;node?;2AB;24|) + (GO G190) G191 (EXIT NIL)) + (EXIT (SPADCALL |u| |v| (QREFELT $ 49))))) + #0# (EXIT #0#))))) + +(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) + (SPADCALL |x| |a| (QREFELT $ 51))) + +(DEFUN |URAGG-;setelt;Alast2S;26| (|x| T4 |a| $) + (SPADCALL |x| |a| (QREFELT $ 53))) + +(DEFUN |URAGG-;setelt;Arest2A;27| (|x| T5 |a| $) + (SPADCALL |x| |a| (QREFELT $ 55))) + +(DEFUN |URAGG-;concat;3A;28| (|x| |y| $) + (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| (QREFELT $ 57))) + +(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $) + (SEQ (COND + ((SPADCALL |x| (QREFELT $ 20)) + (|error| "setlast: empty list")) + ('T + (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 23)) |s| + (QREFELT $ 51)) + (EXIT |s|)))))) + +(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) + (COND + ((EQL (LENGTH |lv|) 1) + (SPADCALL |u| (|SPADfirst| |lv|) (QREFELT $ 55))) + ('T (|error| "wrong number of children specified")))) + +(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) + (SPADCALL |u| |s| (QREFELT $ 51))) + +(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $) + (PROG (#0=#:G1524 |q|) + (RETURN + (SEQ (COND + ((< |n| 1) (|error| "index out of range")) + ('T + (SEQ (LETT |p| + (SPADCALL |p| + (PROG1 (LETT #0# (- |n| 1) + |URAGG-;split!;AIA;32|) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (QREFELT $ 44)) + |URAGG-;split!;AIA;32|) + (LETT |q| (SPADCALL |p| (QREFELT $ 14)) + |URAGG-;split!;AIA;32|) + (SPADCALL |p| (SPADCALL (QREFELT $ 62)) + (QREFELT $ 55)) + (EXIT |q|)))))))) + +(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) + (PROG (|y| |z|) + (RETURN + (SEQ (COND + ((OR (SPADCALL + (LETT |y| (SPADCALL |x| (QREFELT $ 38)) + |URAGG-;cycleSplit!;2A;33|) + (QREFELT $ 20)) + (SPADCALL |x| |y| (QREFELT $ 37))) + |y|) + ('T + (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) + |URAGG-;cycleSplit!;2A;33|) + (SEQ G190 + (COND + ((NULL (SPADCALL + (SPADCALL |z| |y| (QREFELT $ 37)) + (QREFELT $ 21))) + (GO G191))) + (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) + (EXIT (LETT |z| + (SPADCALL |z| (QREFELT $ 14)) + |URAGG-;cycleSplit!;2A;33|))) + NIL (GO G190) G191 (EXIT NIL)) + (SPADCALL |x| (SPADCALL (QREFELT $ 62)) + (QREFELT $ 55)) + (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 $ (GETREFV 67) . #0#) + (QSETREFV $ 0 |dv$|) + (QSETREFV $ 3 + (LETT |pv$| + (|buildPredVector| 0 0 + (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) + (|stuffDomainSlots| $) + (QSETREFV $ 6 |#1|) + (QSETREFV $ 7 |#2|) + (COND + ((|HasAttribute| |#1| '|finiteAggregate|) + (QSETREFV $ 46 + (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $)))) + (COND + ((|HasCategory| |#2| '(|SetCategory|)) + (PROGN + (QSETREFV $ 48 + (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $)) + (QSETREFV $ 50 + (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $))))) + (COND + ((|testBitVector| |pv$| 1) + (PROGN + (QSETREFV $ 52 + (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) + $)) + (QSETREFV $ 54 + (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) + $)) + (QSETREFV $ 56 + (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) + $)) + (QSETREFV $ 58 + (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $)) + (QSETREFV $ 59 + (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) + (QSETREFV $ 60 + (CONS (|dispatchFunction| + |URAGG-;setchildren!;ALA;30|) + $)) + (QSETREFV $ 61 + (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) + $)) + (QSETREFV $ 64 + (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $)) + (QSETREFV $ 65 + (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) + $))))) + $)))) + +(MAKEPROP '|UnaryRecursiveAggregate&| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) + (0 . |first|) '"first" |URAGG-;elt;AfirstS;1| (5 . |last|) + '"last" |URAGG-;elt;AlastS;2| (10 . |rest|) '"rest" + |URAGG-;elt;ArestA;3| |URAGG-;second;AS;4| + |URAGG-;third;AS;5| (|Boolean|) (15 . |empty?|) + (20 . |not|) |URAGG-;cyclic?;AB;6| (25 . |tail|) + |URAGG-;last;AS;7| (|List| $) |URAGG-;nodes;AL;8| + |URAGG-;children;AL;9| |URAGG-;leaf?;AB;10| + |URAGG-;value;AS;11| (|NonNegativeInteger|) + |URAGG-;less?;ANniB;12| |URAGG-;more?;ANniB;13| + |URAGG-;size?;ANniB;14| (30 . |cyclic?|) + |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (35 . |eq?|) + (41 . |cycleEntry|) |URAGG-;cycleTail;2A;18| + |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| + |URAGG-;rest;ANniA;21| (46 . |#|) (51 . |rest|) + (57 . |copy|) (62 . |last|) (68 . =) (74 . =) (80 . =) + (86 . |node?|) (92 . |setfirst!|) (98 . |setelt|) + (105 . |setlast!|) (111 . |setelt|) (118 . |setrest!|) + (124 . |setelt|) (131 . |concat!|) (137 . |concat|) + (143 . |setlast!|) (149 . |setchildren!|) + (155 . |setvalue!|) (161 . |empty|) (|Integer|) + (165 . |split!|) (171 . |cycleSplit!|) '"value") + '#(|value| 176 |third| 181 |tail| 186 |split!| 191 |size?| + 197 |setvalue!| 203 |setlast!| 209 |setelt| 215 + |setchildren!| 236 |second| 242 |rest| 247 |nodes| 253 + |node?| 258 |more?| 264 |less?| 270 |leaf?| 276 |last| 281 + |elt| 292 |cyclic?| 310 |cycleTail| 315 |cycleSplit!| 320 + |cycleLength| 325 |cycleEntry| 330 |concat| 335 |children| + 341 = 346 |#| 352) + 'NIL + (CONS (|makeByteWordVec2| 1 'NIL) + (CONS '#() + (CONS '#() + (|makeByteWordVec2| 65 + '(1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 + 19 0 20 1 19 0 0 21 1 6 0 0 23 1 6 19 + 0 34 2 6 19 0 0 37 1 6 0 0 38 1 6 30 + 0 43 2 6 0 0 30 44 1 6 0 0 45 2 0 0 0 + 30 46 2 7 19 0 0 47 2 0 19 0 0 48 2 6 + 19 0 0 49 2 0 19 0 0 50 2 6 7 0 7 51 + 3 0 7 0 9 7 52 2 6 7 0 7 53 3 0 7 0 + 12 7 54 2 6 0 0 0 55 3 0 0 0 15 0 56 + 2 6 0 0 0 57 2 0 0 0 0 58 2 0 7 0 7 + 59 2 0 0 0 25 60 2 0 7 0 7 61 0 6 0 + 62 2 0 0 0 63 64 1 0 0 0 65 1 0 7 0 + 29 1 0 7 0 18 1 0 0 0 36 2 0 0 0 63 + 64 2 0 19 0 30 33 2 0 7 0 7 61 2 0 7 + 0 7 59 3 0 7 0 12 7 54 3 0 0 0 15 0 + 56 3 0 7 0 9 7 52 2 0 0 0 25 60 1 0 7 + 0 17 2 0 0 0 30 42 1 0 25 0 26 2 0 19 + 0 0 50 2 0 19 0 30 32 2 0 19 0 30 31 + 1 0 19 0 28 2 0 0 0 30 46 1 0 7 0 24 + 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 + 10 1 0 19 0 22 1 0 0 0 39 1 0 0 0 65 + 1 0 30 0 41 1 0 0 0 40 2 0 0 0 0 58 1 + 0 25 0 27 2 0 19 0 0 48 1 0 30 0 35))))) + '|lookupComplete|)) diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp new file mode 100644 index 00000000..e6d16cf0 --- /dev/null +++ b/src/algebra/strap/URAGG.lsp @@ -0,0 +1,113 @@ + +(/VERSIONCHECK 2) + +(DEFPARAMETER |UnaryRecursiveAggregate;CAT| 'NIL) + +(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL) + +(DEFUN |UnaryRecursiveAggregate| (#0=#:G1426) + (LET (#1=#:G1427) + (COND + ((SETQ #1# + (|assoc| (|devaluate| #0#) |UnaryRecursiveAggregate;AL|)) + (CDR #1#)) + (T (SETQ |UnaryRecursiveAggregate;AL| + (|cons5| (CONS (|devaluate| #0#) + (SETQ #1# + (|UnaryRecursiveAggregate;| #0#))) + |UnaryRecursiveAggregate;AL|)) + #1#)))) + +(DEFUN |UnaryRecursiveAggregate;| (|t#1|) + (PROG (#0=#:G1425) + (RETURN + (PROG1 (LETT #0# + (|sublisV| + (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) + (COND + (|UnaryRecursiveAggregate;CAT|) + ('T + (LETT |UnaryRecursiveAggregate;CAT| + (|Join| (|RecursiveAggregate| '|t#1|) + (|mkCategory| '|domain| + '(((|concat| ($ $ $)) T) + ((|concat| ($ |t#1| $)) T) + ((|first| (|t#1| $)) T) + ((|elt| (|t#1| $ "first")) + T) + ((|first| + ($ $ + (|NonNegativeInteger|))) + T) + ((|rest| ($ $)) T) + ((|elt| ($ $ "rest")) T) + ((|rest| + ($ $ + (|NonNegativeInteger|))) + T) + ((|last| (|t#1| $)) T) + ((|elt| (|t#1| $ "last")) T) + ((|last| + ($ $ + (|NonNegativeInteger|))) + T) + ((|tail| ($ $)) T) + ((|second| (|t#1| $)) T) + ((|third| (|t#1| $)) T) + ((|cycleEntry| ($ $)) T) + ((|cycleLength| + ((|NonNegativeInteger|) $)) + T) + ((|cycleTail| ($ $)) T) + ((|concat!| ($ $ $)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|concat!| ($ $ |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|cycleSplit!| ($ $)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setfirst!| + (|t#1| $ |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setelt| + (|t#1| $ "first" |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setrest!| ($ $ $)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setelt| ($ $ "rest" $)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setlast!| + (|t#1| $ |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|setelt| + (|t#1| $ "last" |t#1|)) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|))) + ((|split!| + ($ $ (|Integer|))) + (|has| $ + (ATTRIBUTE + |shallowlyMutable|)))) + NIL + '((|Integer|) + (|NonNegativeInteger|)) + NIL)) + . #1=(|UnaryRecursiveAggregate|))))) . #1#) + (SETELT #0# 0 + (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|))))))) diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp new file mode 100644 index 00000000..7de3d0c1 --- /dev/null +++ b/src/algebra/strap/VECTOR.lsp @@ -0,0 +1,133 @@ + +(/VERSIONCHECK 2) + +(DEFUN |VECTOR;vector;L$;1| (|l| $) + (SPADCALL |l| (|getShellEntry| $ 8))) + +(DEFUN |VECTOR;convert;$If;2| (|x| $) + (SPADCALL + (LIST (SPADCALL (SPADCALL "vector" (|getShellEntry| $ 12)) + (|getShellEntry| $ 14)) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 15)) + (|getShellEntry| $ 16))) + (|getShellEntry| $ 18))) + +(DEFUN |Vector| (#0=#:G1402) + (PROG () + (RETURN + (PROG (#1=#:G1403) + (RETURN + (COND + ((LETT #1# + (|lassocShiftWithFunction| (LIST (|devaluate| #0#)) + (HGET |$ConstructorCache| '|Vector|) + '|domainEqualList|) + |Vector|) + (|CDRwithIncrement| #1#)) + ('T + (UNWIND-PROTECT + (PROG1 (|Vector;| #0#) (LETT #1# T |Vector|)) + (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|))) + (AND (|HasCategory| |#1| '(|SetCategory|)) + (|HasCategory| |#1| + (LIST '|Evalable| + (|devaluate| |#1|)))) + (|HasCategory| |#1| + '(|CoercibleTo| (|OutputForm|))))) . #0#)) + (|haddProp| |$ConstructorCache| '|Vector| (LIST |dv$1|) + (CONS 1 $)) + (|stuffDomainSlots| $) + (|setShellEntry| $ 6 |#1|) + (COND + ((|testBitVector| |pv$| 3) + (|setShellEntry| $ 19 + (CONS (|dispatchFunction| |VECTOR;convert;$If;2|) $)))) + $)))) + +(MAKEPROP '|Vector| '|infovec| + (LIST '#(NIL NIL NIL NIL NIL (|IndexedVector| 6 (NRTEVAL 1)) + (|local| |#1|) (|List| 6) (0 . |construct|) + |VECTOR;vector;L$;1| (|String|) (|Symbol|) (5 . |coerce|) + (|InputForm|) (10 . |convert|) (15 . |parts|) + (20 . |convert|) (|List| $) (25 . |convert|) + (30 . |convert|) (|Mapping| 6 6 6) (|Boolean|) + (|NonNegativeInteger|) (|Equation| 6) (|List| 23) + (|Integer|) (|Mapping| 21 6) (|Mapping| 21 6 6) + (|UniversalSegment| 25) (|Void|) (|Mapping| 6 6) + (|OutputForm|) (|Matrix| 6) (|SingleInteger|) + (|Union| 6 '"failed") (|List| 25)) + '#(|vector| 35 |parts| 40 |convert| 45 |construct| 50) + '((|shallowlyMutable| . 0) (|finiteAggregate| . 0)) + (CONS (|makeByteWordVec2| 5 + '(0 0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4)) + (CONS '#(|VectorCategory&| + |OneDimensionalArrayAggregate&| + |FiniteLinearAggregate&| |LinearAggregate&| + |IndexedAggregate&| |Collection&| + |HomogeneousAggregate&| |OrderedSet&| + |Aggregate&| |EltableAggregate&| |Evalable&| + |SetCategory&| NIL NIL |InnerEvalable&| NIL + NIL |BasicType&|) + (CONS '#((|VectorCategory| 6) + (|OneDimensionalArrayAggregate| 6) + (|FiniteLinearAggregate| 6) + (|LinearAggregate| 6) + (|IndexedAggregate| 25 6) + (|Collection| 6) + (|HomogeneousAggregate| 6) + (|OrderedSet|) (|Aggregate|) + (|EltableAggregate| 25 6) (|Evalable| 6) + (|SetCategory|) (|Type|) + (|Eltable| 25 6) (|InnerEvalable| 6 6) + (|CoercibleTo| 31) (|ConvertibleTo| 13) + (|BasicType|)) + (|makeByteWordVec2| 19 + '(1 0 0 7 8 1 11 0 10 12 1 13 0 11 14 1 + 0 7 0 15 1 7 13 0 16 1 13 0 17 18 1 0 + 13 0 19 1 0 0 7 9 1 0 7 0 15 1 3 13 0 + 19 1 0 0 7 8))))) + '|lookupIncomplete|)) |