aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/ABELGRP-.lsp13
-rw-r--r--src/algebra/strap/ABELGRP.lsp14
-rw-r--r--src/algebra/strap/ABELMON-.lsp13
-rw-r--r--src/algebra/strap/ABELMON.lsp14
-rw-r--r--src/algebra/strap/ABELSG-.lsp4
-rw-r--r--src/algebra/strap/ABELSG.lsp14
-rw-r--r--src/algebra/strap/ALAGG.lsp36
-rw-r--r--src/algebra/strap/BOOLEAN.lsp86
-rw-r--r--src/algebra/strap/CABMON.lsp16
-rw-r--r--src/algebra/strap/CHAR.lsp116
-rw-r--r--src/algebra/strap/CLAGG-.lsp46
-rw-r--r--src/algebra/strap/CLAGG.lsp24
-rw-r--r--src/algebra/strap/COMRING.lsp14
-rw-r--r--src/algebra/strap/DFLOAT.lsp550
-rw-r--r--src/algebra/strap/DIFRING-.lsp11
-rw-r--r--src/algebra/strap/DIFRING.lsp14
-rw-r--r--src/algebra/strap/DIVRING-.lsp6
-rw-r--r--src/algebra/strap/DIVRING.lsp16
-rw-r--r--src/algebra/strap/ENTIRER.lsp14
-rw-r--r--src/algebra/strap/ES-.lsp172
-rw-r--r--src/algebra/strap/ES.lsp16
-rw-r--r--src/algebra/strap/EUCDOM-.lsp44
-rw-r--r--src/algebra/strap/EUCDOM.lsp14
-rw-r--r--src/algebra/strap/FFIELDC-.lsp61
-rw-r--r--src/algebra/strap/FFIELDC.lsp14
-rw-r--r--src/algebra/strap/FPS-.lsp8
-rw-r--r--src/algebra/strap/FPS.lsp14
-rw-r--r--src/algebra/strap/GCDDOM-.lsp14
-rw-r--r--src/algebra/strap/GCDDOM.lsp10
-rw-r--r--src/algebra/strap/HOAGG-.lsp42
-rw-r--r--src/algebra/strap/HOAGG.lsp24
-rw-r--r--src/algebra/strap/ILIST.lsp188
-rw-r--r--src/algebra/strap/INS-.lsp100
-rw-r--r--src/algebra/strap/INS.lsp18
-rw-r--r--src/algebra/strap/INT.lsp331
-rw-r--r--src/algebra/strap/INTDOM-.lsp18
-rw-r--r--src/algebra/strap/INTDOM.lsp14
-rw-r--r--src/algebra/strap/ISTRING.lsp337
-rw-r--r--src/algebra/strap/LIST.lsp51
-rw-r--r--src/algebra/strap/LNAGG-.lsp21
-rw-r--r--src/algebra/strap/LNAGG.lsp26
-rw-r--r--src/algebra/strap/LSAGG-.lsp105
-rw-r--r--src/algebra/strap/LSAGG.lsp24
-rw-r--r--src/algebra/strap/MONOID-.lsp12
-rw-r--r--src/algebra/strap/MONOID.lsp9
-rw-r--r--src/algebra/strap/MTSCAT.lsp40
-rw-r--r--src/algebra/strap/NNI.lsp20
-rw-r--r--src/algebra/strap/OINTDOM.lsp14
-rw-r--r--src/algebra/strap/ORDRING-.lsp12
-rw-r--r--src/algebra/strap/ORDRING.lsp14
-rw-r--r--src/algebra/strap/OUTFORM.lsp659
-rw-r--r--src/algebra/strap/PI.lsp2
-rw-r--r--src/algebra/strap/POLYCAT-.lsp192
-rw-r--r--src/algebra/strap/POLYCAT.lsp30
-rw-r--r--src/algebra/strap/PRIMARR.lsp60
-rw-r--r--src/algebra/strap/PSETCAT-.lsp86
-rw-r--r--src/algebra/strap/PSETCAT.lsp34
-rw-r--r--src/algebra/strap/QFCAT-.lsp81
-rw-r--r--src/algebra/strap/QFCAT.lsp26
-rw-r--r--src/algebra/strap/RCAGG-.lsp10
-rw-r--r--src/algebra/strap/RCAGG.lsp24
-rw-r--r--src/algebra/strap/REF.lsp31
-rw-r--r--src/algebra/strap/RING-.lsp3
-rw-r--r--src/algebra/strap/RING.lsp8
-rw-r--r--src/algebra/strap/RNG.lsp8
-rw-r--r--src/algebra/strap/RNS-.lsp31
-rw-r--r--src/algebra/strap/RNS.lsp18
-rw-r--r--src/algebra/strap/SETAGG-.lsp12
-rw-r--r--src/algebra/strap/SETAGG.lsp24
-rw-r--r--src/algebra/strap/SETCAT-.lsp8
-rw-r--r--src/algebra/strap/SETCAT.lsp16
-rw-r--r--src/algebra/strap/SINT.lsp325
-rw-r--r--src/algebra/strap/STAGG-.lsp52
-rw-r--r--src/algebra/strap/STAGG.lsp24
-rw-r--r--src/algebra/strap/SYMBOL.lsp204
-rw-r--r--src/algebra/strap/TSETCAT-.lsp135
-rw-r--r--src/algebra/strap/TSETCAT.lsp32
-rw-r--r--src/algebra/strap/UFD-.lsp8
-rw-r--r--src/algebra/strap/UFD.lsp16
-rw-r--r--src/algebra/strap/ULSCAT.lsp34
-rw-r--r--src/algebra/strap/UPOLYC-.lsp177
-rw-r--r--src/algebra/strap/UPOLYC.lsp34
-rw-r--r--src/algebra/strap/URAGG-.lsp117
-rw-r--r--src/algebra/strap/URAGG.lsp28
-rw-r--r--src/algebra/strap/VECTOR.lsp10
85 files changed, 4062 insertions, 1305 deletions
diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp
index 04d5e41c..2fdeec9b 100644
--- a/src/algebra/strap/ABELGRP-.lsp
+++ b/src/algebra/strap/ABELGRP-.lsp
@@ -1,6 +1,19 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ABELGRP-;-;3S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |ABELGRP-;subtractIfCan;2SU;2|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|)
+ |%Thing|)
+ |ABELGRP-;*;Nni2S;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Thing| |%Shell|) |%Thing|)
+ |ABELGRP-;*;I2S;4|))
+
(DEFUN |ABELGRP-;-;3S;1| (|x| |y| $)
(SPADCALL |x| (SPADCALL |y| (|getShellEntry| $ 7))
(|getShellEntry| $ 8)))
diff --git a/src/algebra/strap/ABELGRP.lsp b/src/algebra/strap/ABELGRP.lsp
index c1c07bac..dd8da1ef 100644
--- a/src/algebra/strap/ABELGRP.lsp
+++ b/src/algebra/strap/ABELGRP.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |AbelianGroup;AL| 'NIL)
-(DEFUN |AbelianGroup| ()
- (LET (#:G1397)
- (COND
- (|AbelianGroup;AL|)
- (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|))))))
-
(DEFUN |AbelianGroup;| ()
- (PROG (#0=#:G1395)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|Join| (|CancellationAbelianMonoid|)
@@ -21,6 +15,12 @@
|AbelianGroup|)
(SETELT #0# 0 '(|AbelianGroup|))))))
+(DEFUN |AbelianGroup| ()
+ (LET ()
+ (COND
+ (|AbelianGroup;AL|)
+ (T (SETQ |AbelianGroup;AL| (|AbelianGroup;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|AbelianGroup| '|isCategory| T
(|addModemap| '|AbelianGroup| '(|AbelianGroup|)
diff --git a/src/algebra/strap/ABELMON-.lsp b/src/algebra/strap/ABELMON-.lsp
index 82017e64..1c1cdd43 100644
--- a/src/algebra/strap/ABELMON-.lsp
+++ b/src/algebra/strap/ABELMON-.lsp
@@ -1,6 +1,19 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ABELMON-;zero?;SB;1|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Thing| |%Shell|)
+ |%Thing|)
+ |ABELMON-;*;Pi2S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |ABELMON-;sample;S;3|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|)
+ |%Thing|)
+ |ABELMON-;*;Nni2S;4|))
+
(DEFUN |ABELMON-;zero?;SB;1| (|x| $)
(SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/ABELMON.lsp b/src/algebra/strap/ABELMON.lsp
index e13a5932..f0eaa266 100644
--- a/src/algebra/strap/ABELMON.lsp
+++ b/src/algebra/strap/ABELMON.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |AbelianMonoid;AL| 'NIL)
-(DEFUN |AbelianMonoid| ()
- (LET (#:G1397)
- (COND
- (|AbelianMonoid;AL|)
- (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|))))))
-
(DEFUN |AbelianMonoid;| ()
- (PROG (#0=#:G1395)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|Join| (|AbelianSemiGroup|)
@@ -25,6 +19,12 @@
|AbelianMonoid|)
(SETELT #0# 0 '(|AbelianMonoid|))))))
+(DEFUN |AbelianMonoid| ()
+ (LET ()
+ (COND
+ (|AbelianMonoid;AL|)
+ (T (SETQ |AbelianMonoid;AL| (|AbelianMonoid;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|AbelianMonoid| '|isCategory| T
(|addModemap| '|AbelianMonoid| '(|AbelianMonoid|)
diff --git a/src/algebra/strap/ABELSG-.lsp b/src/algebra/strap/ABELSG-.lsp
index 4f99c6ad..a248d398 100644
--- a/src/algebra/strap/ABELSG-.lsp
+++ b/src/algebra/strap/ABELSG-.lsp
@@ -1,6 +1,10 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Thing| |%Shell|)
+ |%Thing|)
+ |ABELSG-;*;Pi2S;1|))
+
(DEFUN |ABELSG-;*;Pi2S;1| (|n| |x| $)
(SPADCALL |n| |x| (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/ABELSG.lsp b/src/algebra/strap/ABELSG.lsp
index 04305129..7c2a2a7d 100644
--- a/src/algebra/strap/ABELSG.lsp
+++ b/src/algebra/strap/ABELSG.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |AbelianSemiGroup;AL| 'NIL)
-(DEFUN |AbelianSemiGroup| ()
- (LET (#:G1396)
- (COND
- (|AbelianSemiGroup;AL|)
- (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|))))))
-
(DEFUN |AbelianSemiGroup;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|SetCategory|)
@@ -21,6 +15,12 @@
|AbelianSemiGroup|)
(SETELT #0# 0 '(|AbelianSemiGroup|))))))
+(DEFUN |AbelianSemiGroup| ()
+ (LET ()
+ (COND
+ (|AbelianSemiGroup;AL|)
+ (T (SETQ |AbelianSemiGroup;AL| (|AbelianSemiGroup;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|AbelianSemiGroup| '|isCategory| T
(|addModemap| '|AbelianSemiGroup| '(|AbelianSemiGroup|)
diff --git a/src/algebra/strap/ALAGG.lsp b/src/algebra/strap/ALAGG.lsp
index e0bdfbf1..16c80bd0 100644
--- a/src/algebra/strap/ALAGG.lsp
+++ b/src/algebra/strap/ALAGG.lsp
@@ -5,24 +5,8 @@
(DEFPARAMETER |AssociationListAggregate;AL| 'NIL)
-(DEFUN |AssociationListAggregate| (&REST #0=#:G1399 &AUX #1=#:G1397)
- (DSETQ #1# #0#)
- (LET (#2=#:G1398)
- (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=#:G1396)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -30,7 +14,7 @@
(LIST (|devaluate| |t#1|)
(|devaluate| |t#2|)))
(|sublisV|
- (PAIR '(#1=#:G1395)
+ (PAIR '(#1=#:G1398)
(LIST '(|Record| (|:| |key| |t#1|)
(|:| |entry| |t#2|))))
(COND
@@ -54,6 +38,22 @@
(LIST '|AssociationListAggregate| (|devaluate| |t#1|)
(|devaluate| |t#2|)))))))
+(DEFUN |AssociationListAggregate| (&REST #0=#:G1402 &AUX #1=#:G1400)
+ (DSETQ #1# #0#)
+ (LET (#2=#:G1401)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|AssociationListAggregate| '|isCategory| T
(|addModemap| '|AssociationListAggregate|
diff --git a/src/algebra/strap/BOOLEAN.lsp b/src/algebra/strap/BOOLEAN.lsp
index 39b700a3..565c4386 100644
--- a/src/algebra/strap/BOOLEAN.lsp
+++ b/src/algebra/strap/BOOLEAN.lsp
@@ -1,18 +1,90 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;test;2$;1|))
+
(PUT '|BOOLEAN;test;2$;1| '|SPADreplace| '(XLAM (|a|) |a|))
-(DEFUN |BOOLEAN;test;2$;1| (|a| $) |a|)
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;nt|))
-(DEFUN |BOOLEAN;nt| (|b| $) (COND (|b| 'NIL) ('T 'T)))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Boolean|) |BOOLEAN;true;$;3|))
(PUT '|BOOLEAN;true;$;3| '|SPADreplace| '(XLAM NIL 'T))
-(DEFUN |BOOLEAN;true;$;3| ($) 'T)
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Boolean|) |BOOLEAN;false;$;4|))
(PUT '|BOOLEAN;false;$;4| '|SPADreplace| '(XLAM NIL NIL))
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;not;2$;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;~;2$;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;and;3$;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;/\\;3$;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;or;3$;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;\\/;3$;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;xor;3$;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;nor;3$;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;nand;3$;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;=;3$;14|))
+
+(PUT '|BOOLEAN;=;3$;14| '|SPADreplace| 'EQ)
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;implies;3$;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;equiv;3$;16|))
+
+(PUT '|BOOLEAN;equiv;3$;16| '|SPADreplace| 'EQ)
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Boolean| |%Shell|) |%Boolean|)
+ |BOOLEAN;<;3$;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
+ |BOOLEAN;size;Nni;18|))
+
+(PUT '|BOOLEAN;size;Nni;18| '|SPADreplace| '(XLAM NIL 2))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Boolean|)
+ |BOOLEAN;index;Pi$;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) (|%IntegerSection| 1))
+ |BOOLEAN;lookup;$Pi;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Boolean|) |BOOLEAN;random;$;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Thing|)
+ |BOOLEAN;convert;$If;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Boolean| |%Shell|) |%Thing|)
+ |BOOLEAN;coerce;$Of;23|))
+
+(DEFUN |BOOLEAN;test;2$;1| (|a| $) |a|)
+
+(DEFUN |BOOLEAN;nt| (|b| $) (COND (|b| 'NIL) ('T 'T)))
+
+(DEFUN |BOOLEAN;true;$;3| ($) 'T)
+
(DEFUN |BOOLEAN;false;$;4| ($) NIL)
(DEFUN |BOOLEAN;not;2$;5| (|b| $) (COND (|b| 'NIL) ('T 'T)))
@@ -36,21 +108,15 @@
(DEFUN |BOOLEAN;nand;3$;13| (|a| |b| $)
(COND (|a| (|BOOLEAN;nt| |b| $)) ('T 'T)))
-(PUT '|BOOLEAN;=;3$;14| '|SPADreplace| 'EQ)
-
(DEFUN |BOOLEAN;=;3$;14| (|a| |b| $) (EQ |a| |b|))
(DEFUN |BOOLEAN;implies;3$;15| (|a| |b| $) (COND (|a| |b|) ('T 'T)))
-(PUT '|BOOLEAN;equiv;3$;16| '|SPADreplace| 'EQ)
-
(DEFUN |BOOLEAN;equiv;3$;16| (|a| |b| $) (EQ |a| |b|))
(DEFUN |BOOLEAN;<;3$;17| (|a| |b| $)
(COND (|b| (|BOOLEAN;nt| |a| $)) ('T 'NIL)))
-(PUT '|BOOLEAN;size;Nni;18| '|SPADreplace| '(XLAM NIL 2))
-
(DEFUN |BOOLEAN;size;Nni;18| ($) 2)
(DEFUN |BOOLEAN;index;Pi$;19| (|i| $)
@@ -77,7 +143,7 @@
(DEFUN |Boolean| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1422)
+ (PROG (#0=#:G1425)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Boolean|) |Boolean|)
diff --git a/src/algebra/strap/CABMON.lsp b/src/algebra/strap/CABMON.lsp
index 0d547bd5..a95397c0 100644
--- a/src/algebra/strap/CABMON.lsp
+++ b/src/algebra/strap/CABMON.lsp
@@ -3,15 +3,8 @@
(DEFPARAMETER |CancellationAbelianMonoid;AL| 'NIL)
-(DEFUN |CancellationAbelianMonoid| ()
- (LET (#:G1396)
- (COND
- (|CancellationAbelianMonoid;AL|)
- (T (SETQ |CancellationAbelianMonoid;AL|
- (|CancellationAbelianMonoid;|))))))
-
(DEFUN |CancellationAbelianMonoid;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|AbelianMonoid|)
@@ -23,6 +16,13 @@
|CancellationAbelianMonoid|)
(SETELT #0# 0 '(|CancellationAbelianMonoid|))))))
+(DEFUN |CancellationAbelianMonoid| ()
+ (LET ()
+ (COND
+ (|CancellationAbelianMonoid;AL|)
+ (T (SETQ |CancellationAbelianMonoid;AL|
+ (|CancellationAbelianMonoid;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|CancellationAbelianMonoid| '|isCategory| T
(|addModemap| '|CancellationAbelianMonoid|
diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp
index e96dad54..870dae1c 100644
--- a/src/algebra/strap/CHAR.lsp
+++ b/src/algebra/strap/CHAR.lsp
@@ -1,59 +1,121 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
+ |CHAR;=;2$B;1|))
+
(PUT '|CHAR;=;2$B;1| '|SPADreplace| 'CHAR=)
-(DEFUN |CHAR;=;2$B;1| (|a| |b| $) (CHAR= |a| |b|))
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Char| |%Shell|) |%Boolean|)
+ |CHAR;<;2$B;2|))
(PUT '|CHAR;<;2$B;2| '|SPADreplace| 'CHAR<)
-(DEFUN |CHAR;<;2$B;2| (|a| |b| $) (CHAR< |a| |b|))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
+ |CHAR;size;Nni;3|))
(PUT '|CHAR;size;Nni;3| '|SPADreplace| '(XLAM NIL 256))
-(DEFUN |CHAR;size;Nni;3| ($) 256)
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Char|)
+ |CHAR;index;Pi$;4|))
-(DEFUN |CHAR;index;Pi$;4| (|n| $)
- (PROG (#0=#:G1398)
- (RETURN
- (SPADCALL
- (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;4|)
- (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
- (|getShellEntry| $ 11)))))
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 1))
+ |CHAR;lookup;$Pi;5|))
-(DEFUN |CHAR;lookup;$Pi;5| (|c| $)
- (PROG (#0=#:G1400)
- (RETURN
- (PROG1 (LETT #0# (+ 1 (SPADCALL |c| (|getShellEntry| $ 14)))
- |CHAR;lookup;$Pi;5|)
- (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))))
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Shell|) |%Char|)
+ |CHAR;char;Nni$;6|))
(PUT '|CHAR;char;Nni$;6| '|SPADreplace| 'CODE-CHAR)
-(DEFUN |CHAR;char;Nni$;6| (|n| $) (CODE-CHAR |n|))
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) (|%IntegerSection| 0))
+ |CHAR;ord;$Nni;7|))
(PUT '|CHAR;ord;$Nni;7| '|SPADreplace| 'CHAR-CODE)
-(DEFUN |CHAR;ord;$Nni;7| (|c| $) (CHAR-CODE |c|))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;random;$;8|))
-(DEFUN |CHAR;random;$;8| ($)
- (SPADCALL (RANDOM (SPADCALL (|getShellEntry| $ 10)))
- (|getShellEntry| $ 11)))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;space;$;9|))
(PUT '|CHAR;space;$;9| '|SPADreplace| '(XLAM NIL (CHAR " " 0)))
-(DEFUN |CHAR;space;$;9| ($) (CHAR " " 0))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;quote;$;10|))
(PUT '|CHAR;quote;$;10| '|SPADreplace| '(XLAM NIL (CHAR "\" " 0)))
-(DEFUN |CHAR;quote;$;10| ($) (CHAR "\" " 0))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Char|) |CHAR;escape;$;11|))
(PUT '|CHAR;escape;$;11| '|SPADreplace| '(XLAM NIL (CHAR "_ " 0)))
-(DEFUN |CHAR;escape;$;11| ($) (CHAR "_ " 0))
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Thing|)
+ |CHAR;coerce;$Of;12|))
(PUT '|CHAR;coerce;$Of;12| '|SPADreplace| '(XLAM (|c|) |c|))
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|)
+ |CHAR;digit?;$B;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|)
+ |CHAR;hexDigit?;$B;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|)
+ |CHAR;upperCase?;$B;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|)
+ |CHAR;lowerCase?;$B;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|)
+ |CHAR;alphabetic?;$B;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Boolean|)
+ |CHAR;alphanumeric?;$B;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%String|)
+ |CHAR;latex;$S;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Char|)
+ |CHAR;char;S$;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|)
+ |CHAR;upperCase;2$;21|))
+
+(PUT '|CHAR;upperCase;2$;21| '|SPADreplace| 'CHAR-UPCASE)
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Shell|) |%Char|)
+ |CHAR;lowerCase;2$;22|))
+
+(PUT '|CHAR;lowerCase;2$;22| '|SPADreplace| 'CHAR-DOWNCASE)
+
+(DEFUN |CHAR;=;2$B;1| (|a| |b| $) (CHAR= |a| |b|))
+
+(DEFUN |CHAR;<;2$B;2| (|a| |b| $) (CHAR< |a| |b|))
+
+(DEFUN |CHAR;size;Nni;3| ($) 256)
+
+(DEFUN |CHAR;index;Pi$;4| (|n| $)
+ (PROG (#0=#:G1401)
+ (RETURN
+ (CODE-CHAR
+ (PROG1 (LETT #0# (- |n| 1) |CHAR;index;Pi$;4|)
+ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))))))
+
+(DEFUN |CHAR;lookup;$Pi;5| (|c| $)
+ (PROG (#0=#:G1403)
+ (RETURN
+ (PROG1 (LETT #0# (+ 1 (CHAR-CODE |c|)) |CHAR;lookup;$Pi;5|)
+ (|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))))
+
+(DEFUN |CHAR;char;Nni$;6| (|n| $) (CODE-CHAR |n|))
+
+(DEFUN |CHAR;ord;$Nni;7| (|c| $) (CHAR-CODE |c|))
+
+(DEFUN |CHAR;random;$;8| ($) (CODE-CHAR (RANDOM 256)))
+
+(DEFUN |CHAR;space;$;9| ($) (CHAR " " 0))
+
+(DEFUN |CHAR;quote;$;10| ($) (CHAR "\" " 0))
+
+(DEFUN |CHAR;escape;$;11| ($) (CHAR "_ " 0))
+
(DEFUN |CHAR;coerce;$Of;12| (|c| $) |c|)
(DEFUN |CHAR;digit?;$B;13| (|c| $)
@@ -84,18 +146,14 @@
(|getShellEntry| $ 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=#:G1421)
+ (PROG (#0=#:G1424)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Character|)
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index 8664a956..4b61a7db 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -1,11 +1,51 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |CLAGG-;#;ANni;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|)
+ (|%IntegerSection| 0))
+ |CLAGG-;count;MANni;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |CLAGG-;any?;MAB;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |CLAGG-;every?;MAB;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |CLAGG-;find;MAU;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |CLAGG-;reduce;MAS;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |CLAGG-;reduce;MA2S;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |CLAGG-;remove;M2A;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |CLAGG-;select;M2A;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |CLAGG-;remove;S2A;10|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |CLAGG-;reduce;MA3S;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |CLAGG-;removeDuplicates;2A;12|))
+
(DEFUN |CLAGG-;#;ANni;1| (|c| $)
(LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $)
- (PROG (|x| #0=#:G1403 #1=#:G1400 #2=#:G1398 #3=#:G1399)
+ (PROG (|x| #0=#:G1429 #1=#:G1403 #2=#:G1401 #3=#:G1402)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |CLAGG-;count;MANni;2|)
@@ -38,7 +78,7 @@
(COND (#3# #2#) ('T 0)))))))
(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $)
- (PROG (|x| #0=#:G1408 #1=#:G1406 #2=#:G1404 #3=#:G1405)
+ (PROG (|x| #0=#:G1430 #1=#:G1408 #2=#:G1406 #3=#:G1407)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |CLAGG-;any?;MAB;3|)
@@ -68,7 +108,7 @@
(COND (#3# #2#) ('T 'NIL)))))))
(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $)
- (PROG (|x| #0=#:G1413 #1=#:G1411 #2=#:G1409 #3=#:G1410)
+ (PROG (|x| #0=#:G1431 #1=#:G1412 #2=#:G1410 #3=#:G1411)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |CLAGG-;every?;MAB;4|)
diff --git a/src/algebra/strap/CLAGG.lsp b/src/algebra/strap/CLAGG.lsp
index 1866f458..6ec49d46 100644
--- a/src/algebra/strap/CLAGG.lsp
+++ b/src/algebra/strap/CLAGG.lsp
@@ -5,19 +5,8 @@
(DEFPARAMETER |Collection;AL| 'NIL)
-(DEFUN |Collection| (#0=#:G1395)
- (LET (#1=#:G1396)
- (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=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -103,6 +92,17 @@
. #1=(|Collection|))))) . #1#)
(SETELT #0# 0 (LIST '|Collection| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|Collection| '|isCategory| T
(|addModemap| '|Collection| '(|Collection| |#1|)
diff --git a/src/algebra/strap/COMRING.lsp b/src/algebra/strap/COMRING.lsp
index f0fb429e..6bf0118a 100644
--- a/src/algebra/strap/COMRING.lsp
+++ b/src/algebra/strap/COMRING.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |CommutativeRing;AL| 'NIL)
-(DEFUN |CommutativeRing| ()
- (LET (#:G1396)
- (COND
- (|CommutativeRing;AL|)
- (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|))))))
-
(DEFUN |CommutativeRing;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Ring|) (|BiModule| '$ '$)
@@ -19,6 +13,12 @@
|CommutativeRing|)
(SETELT #0# 0 '(|CommutativeRing|))))))
+(DEFUN |CommutativeRing| ()
+ (LET ()
+ (COND
+ (|CommutativeRing;AL|)
+ (T (SETQ |CommutativeRing;AL| (|CommutativeRing;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|CommutativeRing| '|isCategory| T
(|addModemap| '|CommutativeRing| '(|CommutativeRing|)
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index bc21825f..27f8aade 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -1,6 +1,376 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%String|)
+ |DFLOAT;OMwrite;$S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Boolean| |%Shell|)
+ |%String|)
+ |DFLOAT;OMwrite;$BS;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%DoubleFloat| |%Shell|) |%Void|)
+ |DFLOAT;OMwrite;Omd$V;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%DoubleFloat| |%Boolean| |%Shell|)
+ |%Void|)
+ |DFLOAT;OMwrite;Omd$BV;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;checkComplex|))
+
+(PUT '|DFLOAT;checkComplex| '|SPADreplace| 'C-TO-R)
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
+ |DFLOAT;base;Pi;6|))
+
+(PUT '|DFLOAT;base;Pi;6| '|SPADreplace| '(XLAM NIL (FLOAT-RADIX 0.0)))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
+ |DFLOAT;mantissa;$I;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
+ |DFLOAT;exponent;$I;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
+ |DFLOAT;precision;Pi;9|))
+
+(PUT '|DFLOAT;precision;Pi;9| '|SPADreplace|
+ '(XLAM NIL (FLOAT-DIGITS 0.0)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
+ |DFLOAT;bits;Pi;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;max;$;11|))
+
+(PUT '|DFLOAT;max;$;11| '|SPADreplace|
+ '(XLAM NIL |$DoubleFloatMaximum|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;min;$;12|))
+
+(PUT '|DFLOAT;min;$;12| '|SPADreplace|
+ '(XLAM NIL |$DoubleFloatMinimum|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
+ |DFLOAT;order;$I;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|)
+ |DFLOAT;Zero;$;14|))
+
+(PUT '|DFLOAT;Zero;$;14| '|SPADreplace|
+ '(XLAM NIL (FLOAT 0 |$DoubleFloatMaximum|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;One;$;15|))
+
+(PUT '|DFLOAT;One;$;15| '|SPADreplace|
+ '(XLAM NIL (FLOAT 1 |$DoubleFloatMaximum|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|)
+ |DFLOAT;exp1;$;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%DoubleFloat|) |DFLOAT;pi;$;17|))
+
+(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '(XLAM NIL PI))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
+ |DFLOAT;coerce;$Of;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
+ |DFLOAT;convert;$If;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%Boolean|)
+ |DFLOAT;<;2$B;20|))
+
+(PUT '|DFLOAT;<;2$B;20| '|SPADreplace| '<)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;-;2$;21|))
+
+(PUT '|DFLOAT;-;2$;21| '|SPADreplace| '-)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;+;3$;22|))
+
+(PUT '|DFLOAT;+;3$;22| '|SPADreplace| '+)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;-;3$;23|))
+
+(PUT '|DFLOAT;-;3$;23| '|SPADreplace| '-)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;*;3$;24|))
+
+(PUT '|DFLOAT;*;3$;24| '|SPADreplace| '*)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;*;I2$;25|))
+
+(PUT '|DFLOAT;*;I2$;25| '|SPADreplace| '*)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;max;3$;26|))
+
+(PUT '|DFLOAT;max;3$;26| '|SPADreplace| 'MAX)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;min;3$;27|))
+
+(PUT '|DFLOAT;min;3$;27| '|SPADreplace| 'MIN)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%Boolean|)
+ |DFLOAT;=;2$B;28|))
+
+(PUT '|DFLOAT;=;2$B;28| '|SPADreplace| '=)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Integer| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;/;$I$;29|))
+
+(PUT '|DFLOAT;/;$I$;29| '|SPADreplace| '/)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;sqrt;2$;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;log10;2$;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Integer| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;**;$I$;32|))
+
+(PUT '|DFLOAT;**;$I$;32| '|SPADreplace| 'EXPT)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;**;3$;33|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;coerce;I$;34|))
+
+(PUT '|DFLOAT;coerce;I$;34| '|SPADreplace|
+ '(XLAM (|i|) (FLOAT |i| |$DoubleFloatMaximum|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;exp;2$;35|))
+
+(PUT '|DFLOAT;exp;2$;35| '|SPADreplace| 'EXP)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;log;2$;36|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;log2;2$;37|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;sin;2$;38|))
+
+(PUT '|DFLOAT;sin;2$;38| '|SPADreplace| 'SIN)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;cos;2$;39|))
+
+(PUT '|DFLOAT;cos;2$;39| '|SPADreplace| 'COS)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;tan;2$;40|))
+
+(PUT '|DFLOAT;tan;2$;40| '|SPADreplace| 'TAN)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;cot;2$;41|))
+
+(PUT '|DFLOAT;cot;2$;41| '|SPADreplace| 'COT)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;sec;2$;42|))
+
+(PUT '|DFLOAT;sec;2$;42| '|SPADreplace| 'SEC)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;csc;2$;43|))
+
+(PUT '|DFLOAT;csc;2$;43| '|SPADreplace| 'CSC)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;asin;2$;44|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;acos;2$;45|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;atan;2$;46|))
+
+(PUT '|DFLOAT;atan;2$;46| '|SPADreplace| 'ATAN)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;acsc;2$;47|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;acot;2$;48|))
+
+(PUT '|DFLOAT;acot;2$;48| '|SPADreplace| 'ACOT)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;asec;2$;49|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;sinh;2$;50|))
+
+(PUT '|DFLOAT;sinh;2$;50| '|SPADreplace| 'SINH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;cosh;2$;51|))
+
+(PUT '|DFLOAT;cosh;2$;51| '|SPADreplace| 'COSH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;tanh;2$;52|))
+
+(PUT '|DFLOAT;tanh;2$;52| '|SPADreplace| 'TANH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;csch;2$;53|))
+
+(PUT '|DFLOAT;csch;2$;53| '|SPADreplace| 'CSCH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;coth;2$;54|))
+
+(PUT '|DFLOAT;coth;2$;54| '|SPADreplace| 'COTH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;sech;2$;55|))
+
+(PUT '|DFLOAT;sech;2$;55| '|SPADreplace| 'SECH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;asinh;2$;56|))
+
+(PUT '|DFLOAT;asinh;2$;56| '|SPADreplace| 'ASINH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;acosh;2$;57|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;atanh;2$;58|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;acsch;2$;59|))
+
+(PUT '|DFLOAT;acsch;2$;59| '|SPADreplace| 'ACSCH)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;acoth;2$;60|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;asech;2$;61|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;/;3$;62|))
+
+(PUT '|DFLOAT;/;3$;62| '|SPADreplace| '/)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|)
+ |DFLOAT;negative?;$B;63|))
+
+(PUT '|DFLOAT;negative?;$B;63| '|SPADreplace| 'MINUSP)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Boolean|)
+ |DFLOAT;zero?;$B;64|))
+
+(PUT '|DFLOAT;zero?;$B;64| '|SPADreplace| 'ZEROP)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Short|)
+ |DFLOAT;hash;$Si;65|))
+
+(PUT '|DFLOAT;hash;$Si;65| '|SPADreplace| 'HASHEQ)
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|)
+ |DFLOAT;recip;$U;66|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;differentiate;2$;67|))
+
+(PUT '|DFLOAT;differentiate;2$;67| '|SPADreplace| '(XLAM (|x|) 0.0))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;Gamma;2$;68|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;Beta;3$;69|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
+ |DFLOAT;wholePart;$I;70|))
+
+(PUT '|DFLOAT;wholePart;$I;70| '|SPADreplace| 'FIX)
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Integer| |%Integer| (|%IntegerSection| 1)
+ |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;float;2IPi$;71|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;convert;2$;72|))
+
+(PUT '|DFLOAT;convert;2$;72| '|SPADreplace| '(XLAM (|x|) |x|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
+ |DFLOAT;convert;$F;73|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%DoubleFloat| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |DFLOAT;rationalApproximation;$NniF;74|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;atan;3$;75|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
+ |DFLOAT;retract;$F;76|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|)
+ |DFLOAT;retractIfCan;$U;77|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
+ |DFLOAT;retract;$I;78|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|)
+ |DFLOAT;retractIfCan;$U;79|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Integer|)
+ |DFLOAT;sign;$I;80|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%DoubleFloat|)
+ |DFLOAT;abs;2$;81|))
+
+(PUT '|DFLOAT;abs;2$;81| '|SPADreplace|
+ '(XLAM (|x|) (FLOAT-SIGN 1.0 |x|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Pair|)
+ |DFLOAT;manexp|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%DoubleFloat| (|%IntegerSection| 0)
+ (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |DFLOAT;rationalApproximation;$2NniF;83|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Thing| |%Shell|)
+ |%DoubleFloat|)
+ |DFLOAT;**;$F$;84|))
+
(DEFUN |DFLOAT;OMwrite;$S;1| (|x| $)
(PROG (|sp| |dev| |s|)
(RETURN
@@ -46,21 +416,14 @@
(EXIT (COND
(|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 15)))))))
-(PUT '|DFLOAT;checkComplex| '|SPADreplace| 'C-TO-R)
-
(DEFUN |DFLOAT;checkComplex| (|x| $) (C-TO-R |x|))
-(PUT '|DFLOAT;base;Pi;6| '|SPADreplace| '(XLAM NIL (FLOAT-RADIX 0.0)))
-
(DEFUN |DFLOAT;base;Pi;6| ($) (FLOAT-RADIX 0.0))
(DEFUN |DFLOAT;mantissa;$I;7| (|x| $) (QCAR (|DFLOAT;manexp| |x| $)))
(DEFUN |DFLOAT;exponent;$I;8| (|x| $) (QCDR (|DFLOAT;manexp| |x| $)))
-(PUT '|DFLOAT;precision;Pi;9| '|SPADreplace|
- '(XLAM NIL (FLOAT-DIGITS 0.0)))
-
(DEFUN |DFLOAT;precision;Pi;9| ($) (FLOAT-DIGITS 0.0))
(DEFUN |DFLOAT;bits;Pi;10| ($)
@@ -72,43 +435,29 @@
('T
(PROG1 (LETT #0#
(FIX (SPADCALL (FLOAT-DIGITS 0.0)
- (SPADCALL
+ (|DFLOAT;log2;2$;37|
(FLOAT (FLOAT-RADIX 0.0)
|$DoubleFloatMaximum|)
- (|getShellEntry| $ 28))
+ $)
(|getShellEntry| $ 29)))
|DFLOAT;bits;Pi;10|)
(|check-subtype| (> #0# 0) '(|PositiveInteger|) #0#)))))))
-(PUT '|DFLOAT;max;$;11| '|SPADreplace|
- '(XLAM NIL |$DoubleFloatMaximum|))
-
(DEFUN |DFLOAT;max;$;11| ($) |$DoubleFloatMaximum|)
-(PUT '|DFLOAT;min;$;12| '|SPADreplace|
- '(XLAM NIL |$DoubleFloatMinimum|))
-
(DEFUN |DFLOAT;min;$;12| ($) |$DoubleFloatMinimum|)
(DEFUN |DFLOAT;order;$I;13| (|a| $)
- (- (+ (FLOAT-DIGITS 0.0) (SPADCALL |a| (|getShellEntry| $ 26))) 1))
-
-(PUT '|DFLOAT;Zero;$;14| '|SPADreplace|
- '(XLAM NIL (FLOAT 0 |$DoubleFloatMaximum|)))
+ (- (+ (FLOAT-DIGITS 0.0) (|DFLOAT;exponent;$I;8| |a| $)) 1))
(DEFUN |DFLOAT;Zero;$;14| ($) (FLOAT 0 |$DoubleFloatMaximum|))
-(PUT '|DFLOAT;One;$;15| '|SPADreplace|
- '(XLAM NIL (FLOAT 1 |$DoubleFloatMaximum|)))
-
(DEFUN |DFLOAT;One;$;15| ($) (FLOAT 1 |$DoubleFloatMaximum|))
(DEFUN |DFLOAT;exp1;$;16| ($)
(/ (FLOAT 534625820200 |$DoubleFloatMaximum|)
(FLOAT 196677847971 |$DoubleFloatMaximum|)))
-(PUT '|DFLOAT;pi;$;17| '|SPADreplace| '(XLAM NIL PI))
-
(DEFUN |DFLOAT;pi;$;17| ($) PI)
(DEFUN |DFLOAT;coerce;$Of;18| (|x| $)
@@ -117,183 +466,102 @@
(DEFUN |DFLOAT;convert;$If;19| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 42)))
-(PUT '|DFLOAT;<;2$B;20| '|SPADreplace| '<)
-
(DEFUN |DFLOAT;<;2$B;20| (|x| |y| $) (< |x| |y|))
-(PUT '|DFLOAT;-;2$;21| '|SPADreplace| '-)
-
(DEFUN |DFLOAT;-;2$;21| (|x| $) (- |x|))
-(PUT '|DFLOAT;+;3$;22| '|SPADreplace| '+)
-
(DEFUN |DFLOAT;+;3$;22| (|x| |y| $) (+ |x| |y|))
-(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;*;I2$;25| '|SPADreplace| '*)
-
(DEFUN |DFLOAT;*;I2$;25| (|i| |x| $) (* |i| |x|))
-(PUT '|DFLOAT;max;3$;26| '|SPADreplace| 'MAX)
-
(DEFUN |DFLOAT;max;3$;26| (|x| |y| $) (MAX |x| |y|))
-(PUT '|DFLOAT;min;3$;27| '|SPADreplace| 'MIN)
-
(DEFUN |DFLOAT;min;3$;27| (|x| |y| $) (MIN |x| |y|))
-(PUT '|DFLOAT;=;2$B;28| '|SPADreplace| '=)
-
(DEFUN |DFLOAT;=;2$B;28| (|x| |y| $) (= |x| |y|))
-(PUT '|DFLOAT;/;$I$;29| '|SPADreplace| '/)
-
(DEFUN |DFLOAT;/;$I$;29| (|x| |i| $) (/ |x| |i|))
-(DEFUN |DFLOAT;sqrt;2$;30| (|x| $)
- (|DFLOAT;checkComplex| (SQRT |x|) $))
+(DEFUN |DFLOAT;sqrt;2$;30| (|x| $) (C-TO-R (SQRT |x|)))
-(DEFUN |DFLOAT;log10;2$;31| (|x| $)
- (|DFLOAT;checkComplex| (|log| |x|) $))
-
-(PUT '|DFLOAT;**;$I$;32| '|SPADreplace| 'EXPT)
+(DEFUN |DFLOAT;log10;2$;31| (|x| $) (C-TO-R (|log| |x|)))
(DEFUN |DFLOAT;**;$I$;32| (|x| |i| $) (EXPT |x| |i|))
-(DEFUN |DFLOAT;**;3$;33| (|x| |y| $)
- (|DFLOAT;checkComplex| (EXPT |x| |y|) $))
-
-(PUT '|DFLOAT;coerce;I$;34| '|SPADreplace|
- '(XLAM (|i|) (FLOAT |i| |$DoubleFloatMaximum|)))
+(DEFUN |DFLOAT;**;3$;33| (|x| |y| $) (C-TO-R (EXPT |x| |y|)))
(DEFUN |DFLOAT;coerce;I$;34| (|i| $)
(FLOAT |i| |$DoubleFloatMaximum|))
-(PUT '|DFLOAT;exp;2$;35| '|SPADreplace| 'EXP)
-
(DEFUN |DFLOAT;exp;2$;35| (|x| $) (EXP |x|))
-(DEFUN |DFLOAT;log;2$;36| (|x| $) (|DFLOAT;checkComplex| (LN |x|) $))
+(DEFUN |DFLOAT;log;2$;36| (|x| $) (C-TO-R (LN |x|)))
-(DEFUN |DFLOAT;log2;2$;37| (|x| $)
- (|DFLOAT;checkComplex| (LOG2 |x|) $))
-
-(PUT '|DFLOAT;sin;2$;38| '|SPADreplace| 'SIN)
+(DEFUN |DFLOAT;log2;2$;37| (|x| $) (C-TO-R (LOG2 |x|)))
(DEFUN |DFLOAT;sin;2$;38| (|x| $) (SIN |x|))
-(PUT '|DFLOAT;cos;2$;39| '|SPADreplace| 'COS)
-
(DEFUN |DFLOAT;cos;2$;39| (|x| $) (COS |x|))
-(PUT '|DFLOAT;tan;2$;40| '|SPADreplace| 'TAN)
-
(DEFUN |DFLOAT;tan;2$;40| (|x| $) (TAN |x|))
-(PUT '|DFLOAT;cot;2$;41| '|SPADreplace| 'COT)
-
(DEFUN |DFLOAT;cot;2$;41| (|x| $) (COT |x|))
-(PUT '|DFLOAT;sec;2$;42| '|SPADreplace| 'SEC)
-
(DEFUN |DFLOAT;sec;2$;42| (|x| $) (SEC |x|))
-(PUT '|DFLOAT;csc;2$;43| '|SPADreplace| 'CSC)
-
(DEFUN |DFLOAT;csc;2$;43| (|x| $) (CSC |x|))
-(DEFUN |DFLOAT;asin;2$;44| (|x| $)
- (|DFLOAT;checkComplex| (ASIN |x|) $))
-
-(DEFUN |DFLOAT;acos;2$;45| (|x| $)
- (|DFLOAT;checkComplex| (ACOS |x|) $))
+(DEFUN |DFLOAT;asin;2$;44| (|x| $) (C-TO-R (ASIN |x|)))
-(PUT '|DFLOAT;atan;2$;46| '|SPADreplace| 'ATAN)
+(DEFUN |DFLOAT;acos;2$;45| (|x| $) (C-TO-R (ACOS |x|)))
(DEFUN |DFLOAT;atan;2$;46| (|x| $) (ATAN |x|))
-(DEFUN |DFLOAT;acsc;2$;47| (|x| $)
- (|DFLOAT;checkComplex| (ACSC |x|) $))
-
-(PUT '|DFLOAT;acot;2$;48| '|SPADreplace| 'ACOT)
+(DEFUN |DFLOAT;acsc;2$;47| (|x| $) (C-TO-R (ACSC |x|)))
(DEFUN |DFLOAT;acot;2$;48| (|x| $) (ACOT |x|))
-(DEFUN |DFLOAT;asec;2$;49| (|x| $)
- (|DFLOAT;checkComplex| (ASEC |x|) $))
-
-(PUT '|DFLOAT;sinh;2$;50| '|SPADreplace| 'SINH)
+(DEFUN |DFLOAT;asec;2$;49| (|x| $) (C-TO-R (ASEC |x|)))
(DEFUN |DFLOAT;sinh;2$;50| (|x| $) (SINH |x|))
-(PUT '|DFLOAT;cosh;2$;51| '|SPADreplace| 'COSH)
-
(DEFUN |DFLOAT;cosh;2$;51| (|x| $) (COSH |x|))
-(PUT '|DFLOAT;tanh;2$;52| '|SPADreplace| 'TANH)
-
(DEFUN |DFLOAT;tanh;2$;52| (|x| $) (TANH |x|))
-(PUT '|DFLOAT;csch;2$;53| '|SPADreplace| 'CSCH)
-
(DEFUN |DFLOAT;csch;2$;53| (|x| $) (CSCH |x|))
-(PUT '|DFLOAT;coth;2$;54| '|SPADreplace| 'COTH)
-
(DEFUN |DFLOAT;coth;2$;54| (|x| $) (COTH |x|))
-(PUT '|DFLOAT;sech;2$;55| '|SPADreplace| 'SECH)
-
(DEFUN |DFLOAT;sech;2$;55| (|x| $) (SECH |x|))
-(PUT '|DFLOAT;asinh;2$;56| '|SPADreplace| 'ASINH)
-
(DEFUN |DFLOAT;asinh;2$;56| (|x| $) (ASINH |x|))
-(DEFUN |DFLOAT;acosh;2$;57| (|x| $)
- (|DFLOAT;checkComplex| (ACOSH |x|) $))
+(DEFUN |DFLOAT;acosh;2$;57| (|x| $) (C-TO-R (ACOSH |x|)))
-(DEFUN |DFLOAT;atanh;2$;58| (|x| $)
- (|DFLOAT;checkComplex| (ATANH |x|) $))
-
-(PUT '|DFLOAT;acsch;2$;59| '|SPADreplace| 'ACSCH)
+(DEFUN |DFLOAT;atanh;2$;58| (|x| $) (C-TO-R (ATANH |x|)))
(DEFUN |DFLOAT;acsch;2$;59| (|x| $) (ACSCH |x|))
-(DEFUN |DFLOAT;acoth;2$;60| (|x| $)
- (|DFLOAT;checkComplex| (ACOTH |x|) $))
+(DEFUN |DFLOAT;acoth;2$;60| (|x| $) (C-TO-R (ACOTH |x|)))
-(DEFUN |DFLOAT;asech;2$;61| (|x| $)
- (|DFLOAT;checkComplex| (ASECH |x|) $))
-
-(PUT '|DFLOAT;/;3$;62| '|SPADreplace| '/)
+(DEFUN |DFLOAT;asech;2$;61| (|x| $) (C-TO-R (ASECH |x|)))
(DEFUN |DFLOAT;/;3$;62| (|x| |y| $) (/ |x| |y|))
-(PUT '|DFLOAT;negative?;$B;63| '|SPADreplace| 'MINUSP)
-
(DEFUN |DFLOAT;negative?;$B;63| (|x| $) (MINUSP |x|))
-(PUT '|DFLOAT;zero?;$B;64| '|SPADreplace| 'ZEROP)
-
(DEFUN |DFLOAT;zero?;$B;64| (|x| $) (ZEROP |x|))
-(PUT '|DFLOAT;hash;$Si;65| '|SPADreplace| 'HASHEQ)
-
(DEFUN |DFLOAT;hash;$Si;65| (|x| $) (HASHEQ |x|))
(DEFUN |DFLOAT;recip;$U;66| (|x| $)
(COND ((ZEROP |x|) (CONS 1 "failed")) ('T (CONS 0 (/ 1.0 |x|)))))
-(PUT '|DFLOAT;differentiate;2$;67| '|SPADreplace| '(XLAM (|x|) 0.0))
-
(DEFUN |DFLOAT;differentiate;2$;67| (|x| $) 0.0)
(DEFUN |DFLOAT;Gamma;2$;68| (|x| $)
@@ -302,22 +570,18 @@
(DEFUN |DFLOAT;Beta;3$;69| (|x| |y| $)
(SPADCALL |x| |y| (|getShellEntry| $ 96)))
-(PUT '|DFLOAT;wholePart;$I;70| '|SPADreplace| 'FIX)
-
(DEFUN |DFLOAT;wholePart;$I;70| (|x| $) (FIX |x|))
(DEFUN |DFLOAT;float;2IPi$;71| (|ma| |ex| |b| $)
(* |ma| (EXPT (FLOAT |b| |$DoubleFloatMaximum|) |ex|)))
-(PUT '|DFLOAT;convert;2$;72| '|SPADreplace| '(XLAM (|x|) |x|))
-
(DEFUN |DFLOAT;convert;2$;72| (|x| $) |x|)
(DEFUN |DFLOAT;convert;$F;73| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 102)))
(DEFUN |DFLOAT;rationalApproximation;$NniF;74| (|x| |d| $)
- (SPADCALL |x| |d| 10 (|getShellEntry| $ 106)))
+ (|DFLOAT;rationalApproximation;$2NniF;83| |x| |d| 10 $))
(DEFUN |DFLOAT;atan;3$;75| (|x| |y| $)
(PROG (|theta|)
@@ -342,22 +606,22 @@
(DEFUN |DFLOAT;retract;$F;76| (|x| $)
(PROG (#0=#:G1497)
(RETURN
- (SPADCALL |x|
+ (|DFLOAT;rationalApproximation;$2NniF;83| |x|
(PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1)
|DFLOAT;retract;$F;76|)
(|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))
- (FLOAT-RADIX 0.0) (|getShellEntry| $ 106)))))
+ (FLOAT-RADIX 0.0) $))))
(DEFUN |DFLOAT;retractIfCan;$U;77| (|x| $)
(PROG (#0=#:G1502)
(RETURN
(CONS 0
- (SPADCALL |x|
+ (|DFLOAT;rationalApproximation;$2NniF;83| |x|
(PROG1 (LETT #0# (- (FLOAT-DIGITS 0.0) 1)
|DFLOAT;retractIfCan;$U;77|)
(|check-subtype| (>= #0# 0) '(|NonNegativeInteger|)
#0#))
- (FLOAT-RADIX 0.0) (|getShellEntry| $ 106))))))
+ (FLOAT-RADIX 0.0) $)))))
(DEFUN |DFLOAT;retract;$I;78| (|x| $)
(PROG (|n|)
@@ -377,10 +641,7 @@
('T (CONS 1 "failed"))))))))
(DEFUN |DFLOAT;sign;$I;80| (|x| $)
- (SPADCALL (FLOAT-SIGN |x| 1.0) (|getShellEntry| $ 112)))
-
-(PUT '|DFLOAT;abs;2$;81| '|SPADreplace|
- '(XLAM (|x|) (FLOAT-SIGN 1.0 |x|)))
+ (|DFLOAT;retract;$I;78| (FLOAT-SIGN |x| 1.0) $))
(DEFUN |DFLOAT;abs;2$;81| (|x| $) (FLOAT-SIGN 1.0 |x|))
@@ -390,8 +651,7 @@
(SEQ (EXIT (COND
((ZEROP |x|) (CONS 0 0))
('T
- (SEQ (LETT |s|
- (SPADCALL |x| (|getShellEntry| $ 115))
+ (SEQ (LETT |s| (|DFLOAT;sign;$I;80| |x| $)
|DFLOAT;manexp|)
(LETT |x| (FLOAT-SIGN 1.0 |x|)
|DFLOAT;manexp|)
@@ -402,11 +662,11 @@
(CONS
(+
(* |s|
- (SPADCALL |$DoubleFloatMaximum|
- (|getShellEntry| $ 25)))
+ (|DFLOAT;mantissa;$I;7|
+ |$DoubleFloatMaximum| $))
1)
- (SPADCALL |$DoubleFloatMaximum|
- (|getShellEntry| $ 26)))
+ (|DFLOAT;exponent;$I;8|
+ |$DoubleFloatMaximum| $))
|DFLOAT;manexp|)
(GO #0#))))
(LETT |me| (MANEXP |x|) |DFLOAT;manexp|)
@@ -580,31 +840,29 @@
(PROGN
(LETT #0#
(-
- (SPADCALL (- |x|) |r|
- (|getShellEntry| $ 128)))
+ (|DFLOAT;**;$F$;84|
+ (- |x|) |r| $))
|DFLOAT;**;$F$;84|)
(GO #0#)))
('T
(PROGN
(LETT #0#
- (SPADCALL (- |x|) |r|
- (|getShellEntry| $ 128))
+ (|DFLOAT;**;$F$;84|
+ (- |x|) |r| $)
|DFLOAT;**;$F$;84|)
(GO #0#)))))
('T (|error| "negative root"))))
((EQL |d| 2)
- (EXPT
- (SPADCALL |x|
- (|getShellEntry| $ 54))
+ (EXPT (|DFLOAT;sqrt;2$;30| |x| $)
|n|))
('T
- (SPADCALL |x|
+ (|DFLOAT;**;3$;33| |x|
(/
(FLOAT |n|
|$DoubleFloatMaximum|)
(FLOAT |d|
|$DoubleFloatMaximum|))
- (|getShellEntry| $ 57)))))))))))
+ $))))))))))
#0# (EXIT #0#)))))
(DEFUN |DoubleFloat| ()
diff --git a/src/algebra/strap/DIFRING-.lsp b/src/algebra/strap/DIFRING-.lsp
index 8f7e8ff9..0c2afaf6 100644
--- a/src/algebra/strap/DIFRING-.lsp
+++ b/src/algebra/strap/DIFRING-.lsp
@@ -1,6 +1,17 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |DIFRING-;D;2S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |DIFRING-;differentiate;SNniS;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |DIFRING-;D;SNniS;3|))
+
(DEFUN |DIFRING-;D;2S;1| (|r| $) (SPADCALL |r| (|getShellEntry| $ 7)))
(DEFUN |DIFRING-;differentiate;SNniS;2| (|r| |n| $)
diff --git a/src/algebra/strap/DIFRING.lsp b/src/algebra/strap/DIFRING.lsp
index 621d91b3..63e3b4fd 100644
--- a/src/algebra/strap/DIFRING.lsp
+++ b/src/algebra/strap/DIFRING.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |DifferentialRing;AL| 'NIL)
-(DEFUN |DifferentialRing| ()
- (LET (#:G1396)
- (COND
- (|DifferentialRing;AL|)
- (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|))))))
-
(DEFUN |DifferentialRing;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Ring|)
@@ -25,6 +19,12 @@
|DifferentialRing|)
(SETELT #0# 0 '(|DifferentialRing|))))))
+(DEFUN |DifferentialRing| ()
+ (LET ()
+ (COND
+ (|DifferentialRing;AL|)
+ (T (SETQ |DifferentialRing;AL| (|DifferentialRing;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|DifferentialRing| '|isCategory| T
(|addModemap| '|DifferentialRing| '(|DifferentialRing|)
diff --git a/src/algebra/strap/DIVRING-.lsp b/src/algebra/strap/DIVRING-.lsp
index 21f2fc94..b8b219ec 100644
--- a/src/algebra/strap/DIVRING-.lsp
+++ b/src/algebra/strap/DIVRING-.lsp
@@ -1,6 +1,12 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |DIVRING-;**;SIS;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |DIVRING-;*;F2S;2|))
+
(DEFUN |DIVRING-;**;SIS;1| (|x| |n| $)
(COND
((ZEROP |n|) (|spadConstant| $ 7))
diff --git a/src/algebra/strap/DIVRING.lsp b/src/algebra/strap/DIVRING.lsp
index dbe30695..e72ef347 100644
--- a/src/algebra/strap/DIVRING.lsp
+++ b/src/algebra/strap/DIVRING.lsp
@@ -3,18 +3,12 @@
(DEFPARAMETER |DivisionRing;AL| 'NIL)
-(DEFUN |DivisionRing| ()
- (LET (#:G1399)
- (COND
- (|DivisionRing;AL|)
- (T (SETQ |DivisionRing;AL| (|DivisionRing;|))))))
-
(DEFUN |DivisionRing;| ()
- (PROG (#0=#:G1397)
+ (PROG (#0=#:G1400)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1396)
+ (PAIR '(#1=#:G1399)
(LIST '(|Fraction| (|Integer|))))
(|Join| (|EntireRing|) (|Algebra| '#1#)
(|mkCategory| '|domain|
@@ -24,6 +18,12 @@
|DivisionRing|)
(SETELT #0# 0 '(|DivisionRing|))))))
+(DEFUN |DivisionRing| ()
+ (LET ()
+ (COND
+ (|DivisionRing;AL|)
+ (T (SETQ |DivisionRing;AL| (|DivisionRing;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|DivisionRing| '|isCategory| T
(|addModemap| '|DivisionRing| '(|DivisionRing|)
diff --git a/src/algebra/strap/ENTIRER.lsp b/src/algebra/strap/ENTIRER.lsp
index 50101a98..9b89cfc9 100644
--- a/src/algebra/strap/ENTIRER.lsp
+++ b/src/algebra/strap/ENTIRER.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |EntireRing;AL| 'NIL)
-(DEFUN |EntireRing| ()
- (LET (#:G1396)
- (COND
- (|EntireRing;AL|)
- (T (SETQ |EntireRing;AL| (|EntireRing;|))))))
-
(DEFUN |EntireRing;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Ring|) (|BiModule| '$ '$)
@@ -19,6 +13,12 @@
|EntireRing|)
(SETELT #0# 0 '(|EntireRing|))))))
+(DEFUN |EntireRing| ()
+ (LET ()
+ (COND
+ (|EntireRing;AL|)
+ (T (SETQ |EntireRing;AL| (|EntireRing;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|EntireRing| '|isCategory| T
(|addModemap| '|EntireRing| '(|EntireRing|)
diff --git a/src/algebra/strap/ES-.lsp b/src/algebra/strap/ES-.lsp
index 975f0090..15d5ab4d 100644
--- a/src/algebra/strap/ES-.lsp
+++ b/src/algebra/strap/ES-.lsp
@@ -1,6 +1,146 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|) |ES-;box;2S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ES-;paren;2S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ES-;belong?;BoB;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|) |ES-;listk|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |ES-;tower;SL;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) |ES-;allk|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |ES-;operators;SL;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |ES-;height;SNni;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ES-;freeOf?;SSB;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ES-;distribute;2S;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) |ES-;box;LS;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |ES-;paren;LS;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ES-;freeOf?;2SB;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ES-;kernel;Bo2S;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ES-;elt;Bo2S;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ES-;elt;Bo3S;16|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ES-;elt;Bo4S;17|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| |%Thing| |%Thing| |%Thing|
+ |%Shell|)
+ |%Thing|)
+ |ES-;elt;Bo5S;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ES-;eval;SSMS;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ES-;eval;SBoMS;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ES-;eval;SSMS;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ES-;eval;SBoMS;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ES-;subst;SES;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |ES-;eval;SLLS;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |ES-;eval;SLLS;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |ES-;eval;SLLS;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ES-;map;MKS;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ES-;operator;2Bo;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |ES-;mainKernel;SU;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ES-;allKernels|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |ES-;kernel;BoLS;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |ES-;okkernel|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |ES-;elt;BoLS;33|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ES-;retract;SK;34|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |ES-;retractIfCan;SU;35|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ES-;is?;SSB;36|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ES-;is?;SBoB;37|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Thing|)
+ |ES-;unwrap|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ES-;distribute;3S;39|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |ES-;eval;SLS;40|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |ES-;subst;SLS;41|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Pair|) |ES-;mkKerLists|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ES-;even?;SB;43|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ES-;odd?;SB;44|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ES-;intpred?|))
+
(DEFUN |ES-;box;2S;1| (|x| $)
(SPADCALL (LIST |x|) (|getShellEntry| $ 16)))
@@ -19,7 +159,7 @@
(SPADCALL (|ES-;listk| |f| $) (|getShellEntry| $ 27)))
(DEFUN |ES-;allk| (|l| $)
- (PROG (#0=#:G1421 |f| #1=#:G1422)
+ (PROG (#0=#:G1578 |f| #1=#:G1579)
(RETURN
(SEQ (SPADCALL (ELT $ 32)
(PROGN
@@ -42,7 +182,7 @@
(|getShellEntry| $ 35))))))
(DEFUN |ES-;operators;SL;7| (|f| $)
- (PROG (#0=#:G1425 |k| #1=#:G1426)
+ (PROG (#0=#:G1580 |k| #1=#:G1581)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |ES-;operators;SL;7|)
@@ -65,7 +205,7 @@
G191 (EXIT (NREVERSE0 #0#))))))))
(DEFUN |ES-;height;SNni;8| (|f| $)
- (PROG (#0=#:G1431 |k| #1=#:G1432)
+ (PROG (#0=#:G1582 |k| #1=#:G1583)
(RETURN
(SEQ (SPADCALL (ELT $ 42)
(PROGN
@@ -91,7 +231,7 @@
0 (|getShellEntry| $ 45))))))
(DEFUN |ES-;freeOf?;SSB;9| (|x| |s| $)
- (PROG (#0=#:G1436 |k| #1=#:G1437)
+ (PROG (#0=#:G1584 |k| #1=#:G1585)
(RETURN
(SEQ (SPADCALL
(SPADCALL |s|
@@ -120,7 +260,7 @@
(|getShellEntry| $ 50))))))
(DEFUN |ES-;distribute;2S;10| (|x| $)
- (PROG (#0=#:G1440 |k| #1=#:G1441)
+ (PROG (#0=#:G1586 |k| #1=#:G1587)
(RETURN
(SEQ (|ES-;unwrap|
(PROGN
@@ -202,7 +342,7 @@
(SPADCALL |x| (LIST |e|) (|getShellEntry| $ 80)))
(DEFUN |ES-;eval;SLLS;24| (|x| |ls| |lf| $)
- (PROG (#0=#:G1461 |f| #1=#:G1462)
+ (PROG (#0=#:G1588 |f| #1=#:G1589)
(RETURN
(SEQ (SPADCALL |x| |ls|
(PROGN
@@ -230,7 +370,7 @@
(|getShellEntry| $$ 0)))
(DEFUN |ES-;eval;SLLS;25| (|x| |ls| |lf| $)
- (PROG (#0=#:G1465 |f| #1=#:G1466)
+ (PROG (#0=#:G1590 |f| #1=#:G1591)
(RETURN
(SEQ (SPADCALL |x| |ls|
(PROGN
@@ -258,7 +398,7 @@
(|getShellEntry| $$ 0)))
(DEFUN |ES-;eval;SLLS;26| (|x| |ls| |lf| $)
- (PROG (#0=#:G1470 |s| #1=#:G1471)
+ (PROG (#0=#:G1592 |s| #1=#:G1593)
(RETURN
(SEQ (SPADCALL |x|
(PROGN
@@ -282,7 +422,7 @@
|lf| (|getShellEntry| $ 68))))))
(DEFUN |ES-;map;MKS;27| (|fn| |k| $)
- (PROG (#0=#:G1486 |x| #1=#:G1487 |l|)
+ (PROG (#0=#:G1594 |x| #1=#:G1595 |l|)
(RETURN
(SEQ (COND
((SPADCALL
@@ -327,7 +467,7 @@
('T (|error| "Unknown operator"))))
(DEFUN |ES-;mainKernel;SU;29| (|x| $)
- (PROG (|l| |kk| #0=#:G1503 |n| |k|)
+ (PROG (|l| |kk| #0=#:G1596 |n| |k|)
(RETURN
(SEQ (COND
((NULL (LETT |l| (SPADCALL |x| (|getShellEntry| $ 39))
@@ -367,7 +507,7 @@
(EXIT (CONS 0 |k|)))))))))
(DEFUN |ES-;allKernels| (|f| $)
- (PROG (|l| |k| #0=#:G1516 |u| |s0| |n| |arg| |t| |s|)
+ (PROG (|l| |k| #0=#:G1597 |u| |s0| |n| |arg| |t| |s|)
(RETURN
(SEQ (LETT |s|
(SPADCALL
@@ -441,7 +581,7 @@
('T (|ES-;okkernel| |op| |args| $))))
(DEFUN |ES-;okkernel| (|op| |l| $)
- (PROG (#0=#:G1523 |f| #1=#:G1524)
+ (PROG (#0=#:G1598 |f| #1=#:G1599)
(RETURN
(SEQ (SPADCALL
(SPADCALL |op| |l|
@@ -472,7 +612,7 @@
(|getShellEntry| $ 88))))))
(DEFUN |ES-;elt;BoLS;33| (|op| |args| $)
- (PROG (|u| #0=#:G1540 |v|)
+ (PROG (|u| #0=#:G1521 |v|)
(RETURN
(SEQ (EXIT (COND
((NULL (SPADCALL |op| (|getShellEntry| $ 99)))
@@ -552,7 +692,7 @@
(SPADCALL (QCDR |k|) |op| (|getShellEntry| $ 52)))))))))
(DEFUN |ES-;unwrap| (|l| |x| $)
- (PROG (|k| #0=#:G1567)
+ (PROG (|k| #0=#:G1600)
(RETURN
(SEQ (SEQ (LETT |k| NIL |ES-;unwrap|)
(LETT #0# (NREVERSE |l|) |ES-;unwrap|) G190
@@ -572,7 +712,7 @@
(EXIT |x|)))))
(DEFUN |ES-;distribute;3S;39| (|x| |y| $)
- (PROG (|ky| #0=#:G1572 |k| #1=#:G1573)
+ (PROG (|ky| #0=#:G1601 |k| #1=#:G1602)
(RETURN
(SEQ (LETT |ky| (SPADCALL |y| (|getShellEntry| $ 57))
|ES-;distribute;3S;39|)
@@ -624,7 +764,7 @@
(|getShellEntry| $ 122)))))))
(DEFUN |ES-;mkKerLists| (|leq| $)
- (PROG (|eq| #0=#:G1590 |k| |lk| |lv|)
+ (PROG (|eq| #0=#:G1603 |k| |lk| |lv|)
(RETURN
(SEQ (LETT |lk| NIL |ES-;mkKerLists|)
(LETT |lv| NIL |ES-;mkKerLists|)
diff --git a/src/algebra/strap/ES.lsp b/src/algebra/strap/ES.lsp
index 2e5d6f51..757ce9e6 100644
--- a/src/algebra/strap/ES.lsp
+++ b/src/algebra/strap/ES.lsp
@@ -3,18 +3,12 @@
(DEFPARAMETER |ExpressionSpace;AL| 'NIL)
-(DEFUN |ExpressionSpace| ()
- (LET (#:G1411)
- (COND
- (|ExpressionSpace;AL|)
- (T (SETQ |ExpressionSpace;AL| (|ExpressionSpace;|))))))
-
(DEFUN |ExpressionSpace;| ()
- (PROG (#0=#:G1409)
+ (PROG (#0=#:G1412)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1407 #2=#:G1408)
+ (PAIR '(#1=#:G1410 #2=#:G1411)
(LIST '(|Kernel| $) '(|Kernel| $)))
(|Join| (|OrderedSet|) (|RetractableTo| '#1#)
(|InnerEvalable| '#2# '$)
@@ -152,6 +146,12 @@
|ExpressionSpace|)
(SETELT #0# 0 '(|ExpressionSpace|))))))
+(DEFUN |ExpressionSpace| ()
+ (LET ()
+ (COND
+ (|ExpressionSpace;AL|)
+ (T (SETQ |ExpressionSpace;AL| (|ExpressionSpace;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|ExpressionSpace| '|isCategory| T
(|addModemap| '|ExpressionSpace| '(|ExpressionSpace|)
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index e6bb8358..f354c167 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -1,6 +1,40 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |EUCDOM-;sizeLess?;2SB;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |EUCDOM-;quo;3S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |EUCDOM-;rem;3S;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |EUCDOM-;exquo;2SU;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |EUCDOM-;gcd;3S;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell| |%Shell|) |%Shell|)
+ |EUCDOM-;unitNormalizeIdealElt|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Shell|)
+ |EUCDOM-;extendedEuclidean;2SR;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Pair|)
+ |EUCDOM-;extendedEuclidean;3SU;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Pair|)
+ |EUCDOM-;principalIdeal;LR;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
+ |EUCDOM-;expressIdealMember;LSU;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
+ |EUCDOM-;multiEuclidean;LSU;11|))
+
(DEFUN |EUCDOM-;sizeLess?;2SB;1| (|x| |y| $)
(COND
((SPADCALL |y| (|getShellEntry| $ 8)) 'NIL)
@@ -198,7 +232,7 @@
(|getShellEntry| $ 30))))))))))))))))
(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $)
- (PROG (|uca| |v| |u| #0=#:G1480 |vv| #1=#:G1481)
+ (PROG (|uca| |v| |u| #0=#:G1515 |vv| #1=#:G1516)
(RETURN
(SEQ (COND
((SPADCALL |l| NIL (|getShellEntry| $ 39))
@@ -258,7 +292,7 @@
(QVELT |u| 2))))))))))
(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $)
- (PROG (#0=#:G1496 #1=#:G1497 |pid| |q| #2=#:G1498 |v| #3=#:G1499)
+ (PROG (#0=#:G1517 #1=#:G1518 |pid| |q| #2=#:G1519 |v| #3=#:G1520)
(RETURN
(SEQ (COND
((SPADCALL |z| (|spadConstant| $ 27)
@@ -326,9 +360,9 @@
(EXIT (NREVERSE0 #2#)))))))))))))))
(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $)
- (PROG (|n| |l1| |l2| #0=#:G1394 #1=#:G1518 #2=#:G1505 #3=#:G1503
- #4=#:G1504 #5=#:G1395 #6=#:G1519 #7=#:G1508 #8=#:G1506
- #9=#:G1507 |u| |v1| |v2|)
+ (PROG (|n| |l1| |l2| #0=#:G1397 #1=#:G1521 #2=#:G1502 #3=#:G1500
+ #4=#:G1501 #5=#:G1398 #6=#:G1522 #7=#:G1505 #8=#:G1503
+ #9=#:G1504 |u| |v1| |v2|)
(RETURN
(SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|)
(EXIT (COND
diff --git a/src/algebra/strap/EUCDOM.lsp b/src/algebra/strap/EUCDOM.lsp
index 2597fe0b..7c101f7e 100644
--- a/src/algebra/strap/EUCDOM.lsp
+++ b/src/algebra/strap/EUCDOM.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |EuclideanDomain;AL| 'NIL)
-(DEFUN |EuclideanDomain| ()
- (LET (#:G1411)
- (COND
- (|EuclideanDomain;AL|)
- (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|))))))
-
(DEFUN |EuclideanDomain;| ()
- (PROG (#0=#:G1409)
+ (PROG (#0=#:G1412)
(RETURN
(PROG1 (LETT #0#
(|Join| (|PrincipalIdealDomain|)
@@ -50,6 +44,12 @@
|EuclideanDomain|)
(SETELT #0# 0 '(|EuclideanDomain|))))))
+(DEFUN |EuclideanDomain| ()
+ (LET ()
+ (COND
+ (|EuclideanDomain;AL|)
+ (T (SETQ |EuclideanDomain;AL| (|EuclideanDomain;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|EuclideanDomain| '|isCategory| T
(|addModemap| '|EuclideanDomain| '(|EuclideanDomain|)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index 50b093bb..d0a70454 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -1,6 +1,53 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;differentiate;2S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |FFIELDC-;init;S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |FFIELDC-;nextItem;SU;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;order;SOpc;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |FFIELDC-;conditionP;MU;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;charthRoot;2S;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |FFIELDC-;charthRoot;SU;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|)
+ |FFIELDC-;createPrimitiveElement;S;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |FFIELDC-;primitive?;SB;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 1))
+ |FFIELDC-;order;SPi;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |FFIELDC-;discreteLog;SNni;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |FFIELDC-;discreteLog;2SU;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;squareFreePolynomial|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;factorPolynomial|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;factorSquareFreePolynomial|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |FFIELDC-;gcdPolynomial;3Sup;16|))
+
(DEFUN |FFIELDC-;differentiate;2S;1| (|x| $) (|spadConstant| $ 7))
(DEFUN |FFIELDC-;init;S;2| ($) (|spadConstant| $ 7))
@@ -41,7 +88,7 @@
(CONS 0 (SPADCALL |x| (|getShellEntry| $ 28))))
(DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($)
- (PROG (|sm1| |start| |i| #0=#:G1443 |e| |found|)
+ (PROG (|sm1| |start| |i| #0=#:G1446 |e| |found|)
(RETURN
(SEQ (LETT |sm1| (- (SPADCALL (|getShellEntry| $ 39)) 1)
|FFIELDC-;createPrimitiveElement;S;8|)
@@ -78,7 +125,7 @@
(EXIT |e|)))))
(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $)
- (PROG (|explist| |q| |exp| #0=#:G1455 |equalone|)
+ (PROG (|explist| |q| |exp| #0=#:G1514 |equalone|)
(RETURN
(SEQ (COND
((SPADCALL |a| (|getShellEntry| $ 14)) 'NIL)
@@ -112,7 +159,7 @@
(EXIT (SPADCALL |equalone| (|getShellEntry| $ 43))))))))))
(DEFUN |FFIELDC-;order;SPi;10| (|e| $)
- (PROG (|lof| |rec| #0=#:G1463 |primeDivisor| |j| #1=#:G1464 |a|
+ (PROG (|lof| |rec| #0=#:G1515 |primeDivisor| |j| #1=#:G1516 |a|
|goon| |ord|)
(RETURN
(SEQ (COND
@@ -179,7 +226,7 @@
(EXIT |ord|))))))))
(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $)
- (PROG (|faclist| |gen| |groupord| |f| #0=#:G1484 |fac| |t| #1=#:G1485
+ (PROG (|faclist| |gen| |groupord| |f| #0=#:G1517 |fac| |t| #1=#:G1518
|exp| |exptable| |n| |end| |i| |rho| |found| |disc1| |c|
|mult| |disclog| |a|)
(RETURN
@@ -332,8 +379,8 @@
(EXIT |disclog|))))))))))))
(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $)
- (PROG (|groupord| |faclist| |f| #0=#:G1503 |fac| |primroot| |t|
- #1=#:G1504 |exp| |rhoHelp| #2=#:G1502 |rho| |disclog|
+ (PROG (|groupord| |faclist| |f| #0=#:G1519 |fac| |primroot| |t|
+ #1=#:G1520 |exp| |rhoHelp| #2=#:G1500 |rho| |disclog|
|mult| |a|)
(RETURN
(SEQ (EXIT (COND
@@ -461,7 +508,7 @@
(SPADCALL |f| (|getShellEntry| $ 77)))
(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $)
- (PROG (|flist| |u| #0=#:G1517 #1=#:G1514 #2=#:G1512 #3=#:G1513)
+ (PROG (|flist| |u| #0=#:G1521 #1=#:G1510 #2=#:G1508 #3=#:G1509)
(RETURN
(SEQ (COND
((SPADCALL |f| (|spadConstant| $ 78)
diff --git a/src/algebra/strap/FFIELDC.lsp b/src/algebra/strap/FFIELDC.lsp
index dce56f05..4bc08870 100644
--- a/src/algebra/strap/FFIELDC.lsp
+++ b/src/algebra/strap/FFIELDC.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |FiniteFieldCategory;AL| 'NIL)
-(DEFUN |FiniteFieldCategory| ()
- (LET (#:G1404)
- (COND
- (|FiniteFieldCategory;AL|)
- (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|))))))
-
(DEFUN |FiniteFieldCategory;| ()
- (PROG (#0=#:G1402)
+ (PROG (#0=#:G1405)
(RETURN
(PROG1 (LETT #0#
(|Join| (|FieldOfPrimeCharacteristic|) (|Finite|)
@@ -57,6 +51,12 @@
|FiniteFieldCategory|)
(SETELT #0# 0 '(|FiniteFieldCategory|))))))
+(DEFUN |FiniteFieldCategory| ()
+ (LET ()
+ (COND
+ (|FiniteFieldCategory;AL|)
+ (T (SETQ |FiniteFieldCategory;AL| (|FiniteFieldCategory;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|FiniteFieldCategory| '|isCategory| T
(|addModemap| '|FiniteFieldCategory|
diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp
index 1ec37dce..312a0bbc 100644
--- a/src/algebra/strap/FPS-.lsp
+++ b/src/algebra/strap/FPS-.lsp
@@ -1,12 +1,18 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Thing|)
+ |FPS-;float;2IS;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 1))
+ |FPS-;digits;Pi;2|))
+
(DEFUN |FPS-;float;2IS;1| (|ma| |ex| $)
(SPADCALL |ma| |ex| (SPADCALL (|getShellEntry| $ 8))
(|getShellEntry| $ 10)))
(DEFUN |FPS-;digits;Pi;2| ($)
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1401)
(RETURN
(PROG1 (LETT #0#
(MAX 1
diff --git a/src/algebra/strap/FPS.lsp b/src/algebra/strap/FPS.lsp
index a2329d35..f3935aa4 100644
--- a/src/algebra/strap/FPS.lsp
+++ b/src/algebra/strap/FPS.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |FloatingPointSystem;AL| 'NIL)
-(DEFUN |FloatingPointSystem| ()
- (LET (#:G1396)
- (COND
- (|FloatingPointSystem;AL|)
- (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|))))))
-
(DEFUN |FloatingPointSystem;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|RealNumberSystem|)
@@ -78,6 +72,12 @@
|FloatingPointSystem|)
(SETELT #0# 0 '(|FloatingPointSystem|))))))
+(DEFUN |FloatingPointSystem| ()
+ (LET ()
+ (COND
+ (|FloatingPointSystem;AL|)
+ (T (SETQ |FloatingPointSystem;AL| (|FloatingPointSystem;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|FloatingPointSystem| '|isCategory| T
(|addModemap| '|FloatingPointSystem|
diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp
index 8d0c8ea7..8e9a0e77 100644
--- a/src/algebra/strap/GCDDOM-.lsp
+++ b/src/algebra/strap/GCDDOM-.lsp
@@ -1,6 +1,18 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |GCDDOM-;lcm;3S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |GCDDOM-;lcm;LS;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |GCDDOM-;gcd;LS;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |GCDDOM-;gcdPolynomial;3Sup;4|))
+
(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $)
(PROG (LCM)
(RETURN
@@ -31,7 +43,7 @@
(|getShellEntry| $ 19)))
(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $)
- (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1415)
+ (PROG (|e2| |e1| |c1| |p| |c2| #0=#:G1418)
(RETURN
(SEQ (COND
((SPADCALL |p1| (|getShellEntry| $ 24))
diff --git a/src/algebra/strap/GCDDOM.lsp b/src/algebra/strap/GCDDOM.lsp
index a7f120d3..313add96 100644
--- a/src/algebra/strap/GCDDOM.lsp
+++ b/src/algebra/strap/GCDDOM.lsp
@@ -3,12 +3,8 @@
(DEFPARAMETER |GcdDomain;AL| 'NIL)
-(DEFUN |GcdDomain| ()
- (LET (#:G1402)
- (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|))))))
-
(DEFUN |GcdDomain;| ()
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1403)
(RETURN
(PROG1 (LETT #0#
(|Join| (|IntegralDomain|)
@@ -29,6 +25,10 @@
|GcdDomain|)
(SETELT #0# 0 '(|GcdDomain|))))))
+(DEFUN |GcdDomain| ()
+ (LET ()
+ (COND (|GcdDomain;AL|) (T (SETQ |GcdDomain;AL| (|GcdDomain;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|GcdDomain| '|isCategory| T
(|addModemap| '|GcdDomain| '(|GcdDomain|) '((|Category|))
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index 93a5923b..21abe57d 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -1,6 +1,38 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |HOAGG-;eval;ALA;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |HOAGG-;#;ANni;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |HOAGG-;any?;MAB;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |HOAGG-;every?;MAB;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|)
+ (|%IntegerSection| 0))
+ |HOAGG-;count;MANni;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |HOAGG-;members;AL;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|)
+ (|%IntegerSection| 0))
+ |HOAGG-;count;SANni;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |HOAGG-;member?;SAB;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |HOAGG-;=;2AB;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |HOAGG-;coerce;AOf;10|))
+
(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| $)
(SPADCALL (CONS #'|HOAGG-;eval;ALA;1!0| (VECTOR $ |l|)) |u|
(|getShellEntry| $ 12)))
@@ -13,7 +45,7 @@
(LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $)
- (PROG (|x| #0=#:G1406 #1=#:G1403 #2=#:G1401 #3=#:G1402)
+ (PROG (|x| #0=#:G1428 #1=#:G1406 #2=#:G1404 #3=#:G1405)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |HOAGG-;any?;MAB;3|)
@@ -43,7 +75,7 @@
(COND (#3# #2#) ('T 'NIL)))))))
(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $)
- (PROG (|x| #0=#:G1411 #1=#:G1409 #2=#:G1407 #3=#:G1408)
+ (PROG (|x| #0=#:G1429 #1=#:G1411 #2=#:G1409 #3=#:G1410)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |HOAGG-;every?;MAB;4|)
@@ -74,7 +106,7 @@
(COND (#3# #2#) ('T 'T)))))))
(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $)
- (PROG (|x| #0=#:G1416 #1=#:G1414 #2=#:G1412 #3=#:G1413)
+ (PROG (|x| #0=#:G1430 #1=#:G1415 #2=#:G1413 #3=#:G1414)
(RETURN
(SEQ (PROGN
(LETT #3# NIL |HOAGG-;count;MANni;5|)
@@ -126,7 +158,7 @@
(|getShellEntry| (|getShellEntry| $$ 0) 24)))
(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $)
- (PROG (|b| #0=#:G1426 |a| #1=#:G1425 #2=#:G1422 #3=#:G1420
+ (PROG (|b| #0=#:G1432 |a| #1=#:G1431 #2=#:G1422 #3=#:G1420
#4=#:G1421)
(RETURN
(SEQ (COND
@@ -174,7 +206,7 @@
('T 'NIL))))))
(DEFUN |HOAGG-;coerce;AOf;10| (|x| $)
- (PROG (#0=#:G1430 |a| #1=#:G1431)
+ (PROG (#0=#:G1433 |a| #1=#:G1434)
(RETURN
(SEQ (SPADCALL
(SPADCALL
diff --git a/src/algebra/strap/HOAGG.lsp b/src/algebra/strap/HOAGG.lsp
index e3473740..baccec79 100644
--- a/src/algebra/strap/HOAGG.lsp
+++ b/src/algebra/strap/HOAGG.lsp
@@ -5,19 +5,8 @@
(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL)
-(DEFUN |HomogeneousAggregate| (#0=#:G1396)
- (LET (#1=#:G1397)
- (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=#:G1395)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -111,6 +100,17 @@
(SETELT #0# 0
(LIST '|HomogeneousAggregate| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|HomogeneousAggregate| '|isCategory| T
(|addModemap| '|HomogeneousAggregate|
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 404c69e7..d5ba9b3a 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -1,42 +1,144 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |ILIST;#;$Nni;1|))
+
(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH)
-(DEFUN |ILIST;#;$Nni;1| (|x| $) (LENGTH |x|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;concat;S2$;2|))
(PUT '|ILIST;concat;S2$;2| '|SPADreplace| 'CONS)
-(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) (CONS |s| |x|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ILIST;eq?;2$B;3|))
(PUT '|ILIST;eq?;2$B;3| '|SPADreplace| 'EQ)
-(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) (EQ |x| |y|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;first;$S;4|))
(PUT '|ILIST;first;$S;4| '|SPADreplace| '|SPADfirst|)
-(DEFUN |ILIST;first;$S;4| (|x| $) (|SPADfirst| |x|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;elt;$firstS;5|))
(PUT '|ILIST;elt;$firstS;5| '|SPADreplace|
'(XLAM (|x| "first") (|SPADfirst| |x|)))
-(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) (|SPADfirst| |x|))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |ILIST;empty;$;6|))
(PUT '|ILIST;empty;$;6| '|SPADreplace| '(XLAM NIL NIL))
-(DEFUN |ILIST;empty;$;6| ($) NIL)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ILIST;empty?;$B;7|))
(PUT '|ILIST;empty?;$B;7| '|SPADreplace| 'NULL)
-(DEFUN |ILIST;empty?;$B;7| (|x| $) (NULL |x|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;rest;2$;8|))
(PUT '|ILIST;rest;2$;8| '|SPADreplace| 'CDR)
-(DEFUN |ILIST;rest;2$;8| (|x| $) (CDR |x|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;elt;$rest$;9|))
(PUT '|ILIST;elt;$rest$;9| '|SPADreplace|
'(XLAM (|x| "rest") (CDR |x|)))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;setfirst!;$2S;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ILIST;setelt;$first2S;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;setrest!;3$;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ILIST;setelt;$rest2$;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |ILIST;construct;L$;14|))
+
+(PUT '|ILIST;construct;L$;14| '|SPADreplace| '(XLAM (|l|) |l|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |ILIST;parts;$L;15|))
+
+(PUT '|ILIST;parts;$L;15| '|SPADreplace| '(XLAM (|s|) |s|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;reverse!;2$;16|))
+
+(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;reverse;2$;17|))
+
+(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |ILIST;minIndex;$I;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |ILIST;rest;$Nni$;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;copy;2$;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;coerce;$Of;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ILIST;=;2$B;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
+ |ILIST;latex;$S;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ILIST;member?;S$B;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;concat!;3$;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ILIST;removeDuplicates!;2$;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ILIST;sort!;M2$;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ILIST;merge!;M3$;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |ILIST;split!;$I$;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |ILIST;mergeSort|))
+
+(DEFUN |ILIST;#;$Nni;1| (|x| $) (LENGTH |x|))
+
+(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) (CONS |s| |x|))
+
+(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) (EQ |x| |y|))
+
+(DEFUN |ILIST;first;$S;4| (|x| $) (|SPADfirst| |x|))
+
+(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) (|SPADfirst| |x|))
+
+(DEFUN |ILIST;empty;$;6| ($) NIL)
+
+(DEFUN |ILIST;empty?;$B;7| (|x| $) (NULL |x|))
+
+(DEFUN |ILIST;rest;2$;8| (|x| $) (CDR |x|))
+
(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (CDR |x|))
(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $)
@@ -63,20 +165,12 @@
(|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| $) (|getShellEntry| $ 7))
@@ -96,8 +190,7 @@
(DEFUN |ILIST;copy;2$;20| (|x| $)
(PROG (|i| |y|)
(RETURN
- (SEQ (LETT |y| (SPADCALL (|getShellEntry| $ 16))
- |ILIST;copy;2$;20|)
+ (SEQ (LETT |y| NIL |ILIST;copy;2$;20|)
(SEQ (LETT |i| 0 |ILIST;copy;2$;20|) G190
(COND
((NULL (SPADCALL (NULL |x|) (|getShellEntry| $ 33)))
@@ -122,15 +215,11 @@
|ILIST;coerce;$Of;21|)
(SEQ G190 (COND ((NULL (NEQ |x| |s|)) (GO G191)))
(SEQ (LETT |y|
- (CONS (SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 13))
+ (CONS (SPADCALL (|SPADfirst| |x|)
(|getShellEntry| $ 38))
|y|)
|ILIST;coerce;$Of;21|)
- (EXIT (LETT |x|
- (SPADCALL |x| (|getShellEntry| $ 18))
- |ILIST;coerce;$Of;21|)))
+ (EXIT (LETT |x| (CDR |x|) |ILIST;coerce;$Of;21|)))
NIL (GO G190) G191 (EXIT NIL))
(LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|)
(EXIT (COND
@@ -139,28 +228,19 @@
('T
(SEQ (LETT |z|
(SPADCALL
- (SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 13))
+ (SPADCALL (|SPADfirst| |x|)
(|getShellEntry| $ 38))
(|getShellEntry| $ 42))
|ILIST;coerce;$Of;21|)
(SEQ G190
(COND
- ((NULL (NEQ |s|
- (SPADCALL |x|
- (|getShellEntry| $ 18))))
- (GO G191)))
- (SEQ (LETT |x|
- (SPADCALL |x|
- (|getShellEntry| $ 18))
+ ((NULL (NEQ |s| (CDR |x|))) (GO G191)))
+ (SEQ (LETT |x| (CDR |x|)
|ILIST;coerce;$Of;21|)
(EXIT
(LETT |z|
(CONS
- (SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 13))
+ (SPADCALL (|SPADfirst| |x|)
(|getShellEntry| $ 38))
|z|)
|ILIST;coerce;$Of;21|)))
@@ -175,7 +255,7 @@
(|getShellEntry| $ 40)))))))))))
(DEFUN |ILIST;=;2$B;22| (|x| |y| $)
- (PROG (#0=#:G1466)
+ (PROG (#0=#:G1469)
(RETURN
(SEQ (EXIT (COND
((EQ |x| |y|) 'T)
@@ -231,7 +311,7 @@
(EXIT (STRCONC |s| " \\right]"))))))
(DEFUN |ILIST;member?;S$B;24| (|s| |x| $)
- (PROG (#0=#:G1474)
+ (PROG (#0=#:G1477)
(RETURN
(SEQ (EXIT (SEQ (SEQ G190
(COND
@@ -260,10 +340,8 @@
(COND
((NULL |y|) |x|)
('T
- (SEQ (PUSH (SPADCALL |y| (|getShellEntry| $ 13)) |x|)
- (QRPLACD |x|
- (SPADCALL |y| (|getShellEntry| $ 18)))
- (EXIT |x|)))))
+ (SEQ (PUSH (|SPADfirst| |y|) |x|)
+ (QRPLACD |x| (CDR |y|)) (EXIT |x|)))))
('T
(SEQ (LETT |z| |x| |ILIST;concat!;3$;25|)
(SEQ G190
@@ -311,7 +389,7 @@
(EXIT |l|)))))
(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $)
- (|ILIST;mergeSort| |f| |l| (SPADCALL |l| (|getShellEntry| $ 9)) $))
+ (|ILIST;mergeSort| |f| |l| (LENGTH |l|) $))
(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $)
(PROG (|r| |t|)
@@ -363,24 +441,24 @@
(EXIT |r|))))))))
(DEFUN |ILIST;split!;$I$;29| (|p| |n| $)
- (PROG (#0=#:G1503 |q|)
+ (PROG (#0=#:G1506 |q|)
(RETURN
(SEQ (COND
((< |n| 1) (|error| "index out of range"))
('T
(SEQ (LETT |p|
- (SPADCALL |p|
+ (|ILIST;rest;$Nni$;19| |p|
(PROG1 (LETT #0# (- |n| 1)
|ILIST;split!;$I$;29|)
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
- (|getShellEntry| $ 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=#:G1507 |l| |q|)
+ (PROG (#0=#:G1510 |l| |q|)
(RETURN
(SEQ (COND
((EQL |n| 2)
@@ -389,8 +467,7 @@
(SPADCALL (SPADCALL |p| (|getShellEntry| $ 18))
(|getShellEntry| $ 13))
(SPADCALL |p| (|getShellEntry| $ 13)) |f|)
- (LETT |p| (SPADCALL |p| (|getShellEntry| $ 28))
- |ILIST;mergeSort|)))))
+ (LETT |p| (NREVERSE |p|) |ILIST;mergeSort|)))))
(EXIT (COND
((< |n| 3) |p|)
('T
@@ -400,9 +477,7 @@
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
|ILIST;mergeSort|)
- (LETT |q|
- (SPADCALL |p| |l|
- (|getShellEntry| $ 59))
+ (LETT |q| (|ILIST;split!;$I$;29| |p| |l| $)
|ILIST;mergeSort|)
(LETT |p| (|ILIST;mergeSort| |f| |p| |l| $)
|ILIST;mergeSort|)
@@ -410,14 +485,13 @@
(|ILIST;mergeSort| |f| |q| (- |n| |l|)
$)
|ILIST;mergeSort|)
- (EXIT (SPADCALL |f| |p| |q|
- (|getShellEntry| $ 58)))))))))))
+ (EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $))))))))))
-(DEFUN |IndexedList| (&REST #0=#:G1519 &AUX #1=#:G1517)
+(DEFUN |IndexedList| (&REST #0=#:G1522 &AUX #1=#:G1520)
(DSETQ #1# #0#)
(PROG ()
(RETURN
- (PROG (#2=#:G1518)
+ (PROG (#2=#:G1521)
(RETURN
(COND
((LETT #2#
diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp
index 1d3cdcca..7feb7cf5 100644
--- a/src/algebra/strap/INS-.lsp
+++ b/src/algebra/strap/INS-.lsp
@@ -1,8 +1,100 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
+ |INS-;characteristic;Nni;1|))
+
(PUT '|INS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;differentiate;2S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |INS-;even?;SB;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |INS-;positive?;SB;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;copy;2S;5|))
+
+(PUT '|INS-;copy;2S;5| '|SPADreplace| '(XLAM (|x|) |x|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |INS-;bit?;2SB;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;mask;2S;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |INS-;rational?;SB;8|))
+
+(PUT '|INS-;rational?;SB;8| '|SPADreplace| '(XLAM (|x|) 'T))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |INS-;euclideanSize;SNni;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;convert;SF;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%DoubleFloat|)
+ |INS-;convert;SDf;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;convert;SIf;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |INS-;retract;SI;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;convert;SP;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;factor;SF;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;squareFree;SF;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |INS-;prime?;SB;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;factorial;2S;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |INS-;binomial;3S;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |INS-;permutation;3S;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |INS-;retractIfCan;SU;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |INS-;init;S;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |INS-;nextItem;SU;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |INS-;patternMatch;SP2Pmr;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INS-;rational;SF;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |INS-;rationalIfCan;SU;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |INS-;symmetricRemainder;3S;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |INS-;invmod;3S;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |INS-;powmod;4S;29|))
+
(DEFUN |INS-;characteristic;Nni;1| ($) 0)
(DEFUN |INS-;differentiate;2S;2| (|x| $) (|spadConstant| $ 9))
@@ -14,8 +106,6 @@
(DEFUN |INS-;positive?;SB;4| (|x| $)
(SPADCALL (|spadConstant| $ 9) |x| (|getShellEntry| $ 15)))
-(PUT '|INS-;copy;2S;5| '|SPADreplace| '(XLAM (|x|) |x|))
-
(DEFUN |INS-;copy;2S;5| (|x| $) |x|)
(DEFUN |INS-;bit?;2SB;6| (|x| |i| $)
@@ -28,12 +118,10 @@
(SPADCALL (SPADCALL (|spadConstant| $ 21) |n| (|getShellEntry| $ 19))
(|getShellEntry| $ 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=#:G1421 #1=#:G1422)
+ (PROG (#0=#:G1424 #1=#:G1425)
(RETURN
(COND
((SPADCALL |x| (|spadConstant| $ 9) (|getShellEntry| $ 25))
@@ -194,7 +282,7 @@
('T (|error| "inverse does not exist"))))))))
(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $)
- (PROG (|y| #0=#:G1479 |z|)
+ (PROG (|y| #0=#:G1482 |z|)
(RETURN
(SEQ (EXIT (SEQ (COND
((SPADCALL |x| (|getShellEntry| $ 80))
diff --git a/src/algebra/strap/INS.lsp b/src/algebra/strap/INS.lsp
index 5759f408..af5969d3 100644
--- a/src/algebra/strap/INS.lsp
+++ b/src/algebra/strap/INS.lsp
@@ -3,19 +3,13 @@
(DEFPARAMETER |IntegerNumberSystem;AL| 'NIL)
-(DEFUN |IntegerNumberSystem| ()
- (LET (#:G1412)
- (COND
- (|IntegerNumberSystem;AL|)
- (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|))))))
-
(DEFUN |IntegerNumberSystem;| ()
- (PROG (#0=#:G1410)
+ (PROG (#0=#:G1413)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1404 #2=#:G1405 #3=#:G1406
- #4=#:G1407 #5=#:G1408 #6=#:G1409)
+ (PAIR '(#1=#:G1407 #2=#:G1408 #3=#:G1409
+ #4=#:G1410 #5=#:G1411 #6=#:G1412)
(LIST '(|Integer|) '(|Integer|)
'(|Integer|) '(|InputForm|)
'(|Pattern| (|Integer|))
@@ -71,6 +65,12 @@
|IntegerNumberSystem|)
(SETELT #0# 0 '(|IntegerNumberSystem|))))))
+(DEFUN |IntegerNumberSystem| ()
+ (LET ()
+ (COND
+ (|IntegerNumberSystem;AL|)
+ (T (SETQ |IntegerNumberSystem;AL| (|IntegerNumberSystem;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|IntegerNumberSystem| '|isCategory| T
(|addModemap| '|IntegerNumberSystem|
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index afb2e425..b8caedc7 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -1,6 +1,254 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Void|)
+ |INT;writeOMInt|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|)
+ |INT;OMwrite;$S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Boolean| |%Shell|) |%String|)
+ |INT;OMwrite;$BS;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Void|)
+ |INT;OMwrite;Omd$V;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Boolean| |%Shell|)
+ |%Void|)
+ |INT;OMwrite;Omd$BV;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|)
+ |INT;zero?;$B;6|))
+
+(PUT '|INT;zero?;$B;6| '|SPADreplace| 'ZEROP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|)
+ |INT;one?;$B;7|))
+
+(PUT '|INT;one?;$B;7| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;Zero;$;8|))
+
+(PUT '|INT;Zero;$;8| '|SPADreplace| '(XLAM NIL 0))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;One;$;9|))
+
+(PUT '|INT;One;$;9| '|SPADreplace| '(XLAM NIL 1))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;base;$;10|))
+
+(PUT '|INT;base;$;10| '|SPADreplace| '(XLAM NIL 2))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;copy;2$;11|))
+
+(PUT '|INT;copy;2$;11| '|SPADreplace| '(XLAM (|x|) |x|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;inc;2$;12|))
+
+(PUT '|INT;inc;2$;12| '|SPADreplace| '(XLAM (|x|) (+ |x| 1)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;dec;2$;13|))
+
+(PUT '|INT;dec;2$;13| '|SPADreplace| '(XLAM (|x|) (- |x| 1)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Short|)
+ |INT;hash;$Si;14|))
+
+(PUT '|INT;hash;$Si;14| '|SPADreplace| 'SXHASH)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|)
+ |INT;negative?;$B;15|))
+
+(PUT '|INT;negative?;$B;15| '|SPADreplace| 'MINUSP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |INT;coerce;$Of;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;coerce;2$;17|))
+
+(PUT '|INT;coerce;2$;17| '|SPADreplace| '(XLAM (|m|) |m|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;convert;2$;18|))
+
+(PUT '|INT;convert;2$;18| '|SPADreplace| '(XLAM (|x|) |x|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;length;2$;19|))
+
+(PUT '|INT;length;2$;19| '|SPADreplace| 'INTEGER-LENGTH)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Integer| |%Shell|)
+ |%Integer|)
+ |INT;addmod;4$;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Integer| |%Shell|)
+ |%Integer|)
+ |INT;submod;4$;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Integer| |%Shell|)
+ |%Integer|)
+ |INT;mulmod;4$;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |INT;convert;$F;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%DoubleFloat|)
+ |INT;convert;$Df;24|))
+
+(PUT '|INT;convert;$Df;24| '|SPADreplace|
+ '(XLAM (|x|) (FLOAT |x| |$DoubleFloatMaximum|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |INT;convert;$If;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|)
+ |INT;convert;$S;26|))
+
+(PUT '|INT;convert;$S;26| '|SPADreplace| 'STRINGIMAGE)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|)
+ |INT;latex;$S;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;positiveRemainder;3$;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INT;reducedSystem;2M;29|))
+
+(PUT '|INT;reducedSystem;2M;29| '|SPADreplace| '(XLAM (|m|) |m|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|)
+ |INT;reducedSystem;MVR;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;abs;2$;31|))
+
+(PUT '|INT;abs;2$;31| '|SPADreplace| 'ABS)
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |INT;random;$;32|))
+
+(PUT '|INT;random;$;32| '|SPADreplace| '|random|)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;random;2$;33|))
+
+(PUT '|INT;random;2$;33| '|SPADreplace| 'RANDOM)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|)
+ |INT;=;2$B;34|))
+
+(PUT '|INT;=;2$B;34| '|SPADreplace| 'EQL)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|)
+ |INT;<;2$B;35|))
+
+(PUT '|INT;<;2$B;35| '|SPADreplace| '<)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;-;2$;36|))
+
+(PUT '|INT;-;2$;36| '|SPADreplace| '-)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;+;3$;37|))
+
+(PUT '|INT;+;3$;37| '|SPADreplace| '+)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;-;3$;38|))
+
+(PUT '|INT;-;3$;38| '|SPADreplace| '-)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;*;3$;39|))
+
+(PUT '|INT;*;3$;39| '|SPADreplace| '*)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;*;3$;40|))
+
+(PUT '|INT;*;3$;40| '|SPADreplace| '*)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| (|%IntegerSection| 0) |%Shell|)
+ |%Integer|)
+ |INT;**;$Nni$;41|))
+
+(PUT '|INT;**;$Nni$;41| '|SPADreplace| 'EXPT)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Boolean|)
+ |INT;odd?;$B;42|))
+
+(PUT '|INT;odd?;$B;42| '|SPADreplace| 'ODDP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;max;3$;43|))
+
+(PUT '|INT;max;3$;43| '|SPADreplace| 'MAX)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;min;3$;44|))
+
+(PUT '|INT;min;3$;44| '|SPADreplace| 'MIN)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Pair|)
+ |INT;divide;2$R;45|))
+
+(PUT '|INT;divide;2$R;45| '|SPADreplace| 'DIVIDE2)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;quo;3$;46|))
+
+(PUT '|INT;quo;3$;46| '|SPADreplace| 'QUOTIENT2)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;rem;3$;47|))
+
+(PUT '|INT;rem;3$;47| '|SPADreplace| 'REMAINDER2)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;shift;3$;48|))
+
+(PUT '|INT;shift;3$;48| '|SPADreplace| 'ASH)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Pair|)
+ |INT;exquo;2$U;49|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Pair|)
+ |INT;recip;$U;50|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Integer|)
+ |INT;gcd;3$;51|))
+
+(PUT '|INT;gcd;3$;51| '|SPADreplace| 'GCD)
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Shell|)
+ |INT;unitNormal;$R;52|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|)
+ |INT;unitCanonical;2$;53|))
+
+(PUT '|INT;unitCanonical;2$;53| '|SPADreplace| 'ABS)
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
+ |INT;solveLinearPolynomialEquation|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INT;squareFreePolynomial|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INT;factorPolynomial|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INT;factorSquareFreePolynomial|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |INT;gcdPolynomial;3Sup;58|))
+
(DEFUN |INT;writeOMInt| (|dev| |x| $)
(SEQ (COND
((< |x| 0)
@@ -54,63 +302,37 @@
(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;$Si;14| '|SPADreplace| 'SXHASH)
-
(DEFUN |INT;hash;$Si;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| $ 37)))
-(PUT '|INT;coerce;2$;17| '|SPADreplace| '(XLAM (|m|) |m|))
-
(DEFUN |INT;coerce;2$;17| (|m| $) |m|)
-(PUT '|INT;convert;2$;18| '|SPADreplace| '(XLAM (|x|) |x|))
-
(DEFUN |INT;convert;2$;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=#:G1429)
+ (PROG (|c| #0=#:G1432)
(RETURN
(SEQ (EXIT (SEQ (SEQ (LETT |c| (+ |a| |b|) |INT;addmod;4$;20|)
(EXIT (COND
@@ -134,16 +356,11 @@
(DEFUN |INT;convert;$F;23| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 46)))
-(PUT '|INT;convert;$Df;24| '|SPADreplace|
- '(XLAM (|x|) (FLOAT |x| |$DoubleFloatMaximum|)))
-
(DEFUN |INT;convert;$Df;24| (|x| $) (FLOAT |x| |$DoubleFloatMaximum|))
(DEFUN |INT;convert;$If;25| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 51)))
-(PUT '|INT;convert;$S;26| '|SPADreplace| 'STRINGIMAGE)
-
(DEFUN |INT;convert;$S;26| (|x| $) (STRINGIMAGE |x|))
(DEFUN |INT;latex;$S;27| (|x| $)
@@ -162,82 +379,44 @@
(COND ((MINUSP |b|) (- |r| |b|)) ('T (+ |r| |b|))))
('T |r|)))))
-(PUT '|INT;reducedSystem;2M;29| '|SPADreplace| '(XLAM (|m|) |m|))
-
(DEFUN |INT;reducedSystem;2M;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;*;3$;40| '|SPADreplace| '*)
-
(DEFUN |INT;*;3$;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| $)
@@ -251,15 +430,11 @@
((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| $)
@@ -269,7 +444,7 @@
(SPADCALL |p| (|getShellEntry| $ 98)))
(DEFUN |INT;factorPolynomial| (|p| $)
- (PROG (|pp| #0=#:G1500)
+ (PROG (|pp| #0=#:G1503)
(RETURN
(SEQ (LETT |pp| (SPADCALL |p| (|getShellEntry| $ 99))
|INT;factorPolynomial|)
@@ -282,12 +457,12 @@
(SPADCALL (CONS #'|INT;factorPolynomial!0| $)
(SPADCALL
(PROG2 (LETT #0#
- (SPADCALL
+ (|INT;exquo;2$U;49|
(SPADCALL |p|
(|getShellEntry| $ 100))
(SPADCALL |pp|
(|getShellEntry| $ 100))
- (|getShellEntry| $ 84))
+ $)
|INT;factorPolynomial|)
(QCDR #0#)
(|check-union| (QEQCAR #0# 0) $ #0#))
@@ -312,7 +487,7 @@
(DEFUN |Integer| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1525)
+ (PROG (#0=#:G1528)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Integer|) |Integer|)
diff --git a/src/algebra/strap/INTDOM-.lsp b/src/algebra/strap/INTDOM-.lsp
index b275668b..a8b6e221 100644
--- a/src/algebra/strap/INTDOM-.lsp
+++ b/src/algebra/strap/INTDOM-.lsp
@@ -1,6 +1,24 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Shell|)
+ |INTDOM-;unitNormal;SR;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |INTDOM-;unitCanonical;2S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |INTDOM-;recip;SU;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |INTDOM-;unit?;SB;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |INTDOM-;associates?;2SB;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |INTDOM-;associates?;2SB;6|))
+
(DEFUN |INTDOM-;unitNormal;SR;1| (|x| $)
(VECTOR (|spadConstant| $ 7) |x| (|spadConstant| $ 7)))
diff --git a/src/algebra/strap/INTDOM.lsp b/src/algebra/strap/INTDOM.lsp
index ea971300..fc558f82 100644
--- a/src/algebra/strap/INTDOM.lsp
+++ b/src/algebra/strap/INTDOM.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |IntegralDomain;AL| 'NIL)
-(DEFUN |IntegralDomain| ()
- (LET (#:G1402)
- (COND
- (|IntegralDomain;AL|)
- (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|))))))
-
(DEFUN |IntegralDomain;| ()
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1403)
(RETURN
(PROG1 (LETT #0#
(|Join| (|CommutativeRing|) (|Algebra| '$)
@@ -31,6 +25,12 @@
|IntegralDomain|)
(SETELT #0# 0 '(|IntegralDomain|))))))
+(DEFUN |IntegralDomain| ()
+ (LET ()
+ (COND
+ (|IntegralDomain;AL|)
+ (T (SETQ |IntegralDomain;AL| (|IntegralDomain;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|IntegralDomain| '|isCategory| T
(|addModemap| '|IntegralDomain| '(|IntegralDomain|)
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index f2072d86..e02a4ec3 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -1,49 +1,158 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Char| |%Shell|)
+ |%Thing|)
+ |ISTRING;new;NniC$;1|))
+
(PUT '|ISTRING;new;NniC$;1| '|SPADreplace| 'MAKE-FULL-CVEC)
-(DEFUN |ISTRING;new;NniC$;1| (|n| |c| $) (MAKE-FULL-CVEC |n| |c|))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |ISTRING;empty;$;2|))
(PUT '|ISTRING;empty;$;2| '|SPADreplace|
'(XLAM NIL (MAKE-FULL-CVEC 0)))
-(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ISTRING;empty?;$B;3|))
-(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |ISTRING;#;$Nni;4|))
(PUT '|ISTRING;#;$Nni;4| '|SPADreplace| 'QCSIZE)
-(DEFUN |ISTRING;#;$Nni;4| (|s| $) (QCSIZE |s|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ISTRING;=;2$B;5|))
(PUT '|ISTRING;=;2$B;5| '|SPADreplace| 'EQUAL)
-(DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (EQUAL |s| |t|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ISTRING;<;2$B;6|))
(PUT '|ISTRING;<;2$B;6| '|SPADreplace|
'(XLAM (|s| |t|) (CGREATERP |t| |s|)))
-(DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (CGREATERP |t| |s|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ISTRING;concat;3$;7|))
(PUT '|ISTRING;concat;3$;7| '|SPADreplace| 'STRCONC)
-(DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (STRCONC |s| |t|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ISTRING;copy;2$;8|))
(PUT '|ISTRING;copy;2$;8| '|SPADreplace| 'COPY-SEQ)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |ISTRING;insert;2$I$;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ISTRING;coerce;$Of;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |ISTRING;minIndex;$I;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ISTRING;upperCase!;2$;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ISTRING;lowerCase!;2$;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
+ |ISTRING;latex;$S;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |ISTRING;replace;$Us2$;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Char| |%Shell|)
+ |%Char|)
+ |ISTRING;setelt;$I2C;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Boolean|)
+ |ISTRING;substring?;2$IB;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Integer|)
+ |ISTRING;position;2$2I;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Char| |%Thing| |%Integer| |%Shell|)
+ |%Integer|)
+ |ISTRING;position;C$2I;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Integer|)
+ |ISTRING;position;Cc$2I;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |ISTRING;suffix?;2$B;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Char| |%Shell|) |%List|)
+ |ISTRING;split;$CL;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%List|)
+ |ISTRING;split;$CcL;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Char| |%Shell|) |%Thing|)
+ |ISTRING;leftTrim;$C$;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ISTRING;leftTrim;$Cc$;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Char| |%Shell|) |%Thing|)
+ |ISTRING;rightTrim;$C$;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ISTRING;rightTrim;$Cc$;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |ISTRING;concat;L$;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |ISTRING;copyInto!;2$I$;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Char|)
+ |ISTRING;elt;$IC;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |ISTRING;elt;$Us$;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |ISTRING;hash;$I;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|)
+ (|%IntegerSection| 0))
+ |ISTRING;match;2$CNni;33|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Char| |%Shell|)
+ |%Boolean|)
+ |ISTRING;match?;2$CB;34|))
+
+(DEFUN |ISTRING;new;NniC$;1| (|n| |c| $) (MAKE-FULL-CVEC |n| |c|))
+
+(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0))
+
+(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0))
+
+(DEFUN |ISTRING;#;$Nni;4| (|s| $) (QCSIZE |s|))
+
+(DEFUN |ISTRING;=;2$B;5| (|s| |t| $) (EQUAL |s| |t|))
+
+(DEFUN |ISTRING;<;2$B;6| (|s| |t| $) (CGREATERP |t| |s|))
+
+(DEFUN |ISTRING;concat;3$;7| (|s| |t| $) (STRCONC |s| |t|))
+
(DEFUN |ISTRING;copy;2$;8| (|s| $) (COPY-SEQ |s|))
(DEFUN |ISTRING;insert;2$I$;9| (|s| |t| |i| $)
- (SPADCALL
- (SPADCALL
- (SPADCALL |s|
- (SPADCALL (|getShellEntry| $ 6) (- |i| 1)
- (|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
- |t| (|getShellEntry| $ 16))
- (SPADCALL |s| (SPADCALL |i| (|getShellEntry| $ 22))
- (|getShellEntry| $ 21))
- (|getShellEntry| $ 16)))
+ (STRCONC (STRCONC (|ISTRING;elt;$Us$;31| |s|
+ (SPADCALL (|getShellEntry| $ 6) (- |i| 1)
+ (|getShellEntry| $ 20))
+ $)
+ |t|)
+ (|ISTRING;elt;$Us$;31| |s|
+ (SPADCALL |i| (|getShellEntry| $ 22)) $)))
(DEFUN |ISTRING;coerce;$Of;10| (|s| $)
(SPADCALL |s| (|getShellEntry| $ 26)))
@@ -60,17 +169,15 @@
(STRCONC "\\mbox{``" (STRCONC |s| "''}")))
(DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $)
- (PROG (|l| |m| |n| |h| #0=#:G1434 |r| #1=#:G1440 #2=#:G1441 |i|
- #3=#:G1442 |k|)
+ (PROG (|l| |m| |n| |h| #0=#:G1437 |r| #1=#:G1534 #2=#:G1535 |i|
+ #3=#:G1536 |k|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |sg| (|getShellEntry| $ 39))
(|getShellEntry| $ 6))
|ISTRING;replace;$Us2$;15|)
- (LETT |m| (SPADCALL |s| (|getShellEntry| $ 13))
- |ISTRING;replace;$Us2$;15|)
- (LETT |n| (SPADCALL |t| (|getShellEntry| $ 13))
- |ISTRING;replace;$Us2$;15|)
+ (LETT |m| (QCSIZE |s|) |ISTRING;replace;$Us2$;15|)
+ (LETT |n| (QCSIZE |t|) |ISTRING;replace;$Us2$;15|)
(LETT |h|
(COND
((SPADCALL |sg| (|getShellEntry| $ 40))
@@ -84,13 +191,12 @@
((OR (OR (< |l| 0) (NULL (< |h| |m|))) (< |h| (- |l| 1)))
(EXIT (|error| "index out of range"))))
(LETT |r|
- (SPADCALL
+ (MAKE-FULL-CVEC
(PROG1 (LETT #0# (+ (- |m| (+ (- |h| |l|) 1)) |n|)
|ISTRING;replace;$Us2$;15|)
(|check-subtype| (>= #0# 0)
'(|NonNegativeInteger|) #0#))
- (SPADCALL (|getShellEntry| $ 43))
- (|getShellEntry| $ 9))
+ (SPADCALL (|getShellEntry| $ 43)))
|ISTRING;replace;$Us2$;15|)
(SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|)
(LETT #1# (- |l| 1) |ISTRING;replace;$Us2$;15|)
@@ -136,7 +242,7 @@
(EXIT |c|))))))
(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
- (PROG (|np| |nw| |iw| |ip| #0=#:G1452 #1=#:G1451 #2=#:G1447)
+ (PROG (|np| |nw| |iw| |ip| #0=#:G1537 #1=#:G1451 #2=#:G1447)
(RETURN
(SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|)
|ISTRING;substring?;2$IB;17|)
@@ -205,7 +311,7 @@
('T (+ |r| (|getShellEntry| $ 6)))))))))))))
(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $)
- (PROG (|r| #0=#:G1463 #1=#:G1462)
+ (PROG (|r| #0=#:G1538 #1=#:G1461)
(RETURN
(SEQ (EXIT (SEQ (LETT |startpos|
(- |startpos| (|getShellEntry| $ 6))
@@ -241,7 +347,7 @@
#1# (EXIT #1#)))))
(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $)
- (PROG (|r| #0=#:G1470 #1=#:G1469)
+ (PROG (|r| #0=#:G1539 #1=#:G1467)
(RETURN
(SEQ (EXIT (SEQ (LETT |startpos|
(- |startpos| (|getShellEntry| $ 6))
@@ -287,9 +393,8 @@
(EXIT (COND
((< |n| |m|) 'NIL)
('T
- (SPADCALL |s| |t|
- (- (+ (|getShellEntry| $ 6) |n|) |m|)
- (|getShellEntry| $ 46)))))))))
+ (|ISTRING;substring?;2$IB;17| |s| |t|
+ (- (+ (|getShellEntry| $ 6) |n|) |m|) $))))))))
(DEFUN |ISTRING;split;$CL;22| (|s| |c| $)
(PROG (|n| |j| |i| |l|)
@@ -300,9 +405,7 @@
G190
(COND
((OR (> |i| |n|)
- (NULL (SPADCALL
- (SPADCALL |s| |i|
- (|getShellEntry| $ 52))
+ (NULL (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $)
|c| (|getShellEntry| $ 53))))
(GO G191)))
(SEQ (EXIT 0))
@@ -317,18 +420,18 @@
('T
(SPADCALL
(< (LETT |j|
- (SPADCALL |c| |s| |i|
- (|getShellEntry| $ 48))
+ (|ISTRING;position;C$2I;19| |c| |s|
+ |i| $)
|ISTRING;split;$CL;22|)
(|getShellEntry| $ 6))
(|getShellEntry| $ 56)))))
(GO G191)))
(SEQ (LETT |l|
(SPADCALL
- (SPADCALL |s|
+ (|ISTRING;elt;$Us$;31| |s|
(SPADCALL |i| (- |j| 1)
(|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
+ $)
|l| (|getShellEntry| $ 57))
|ISTRING;split;$CL;22|)
(EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CL;22|)
@@ -337,8 +440,7 @@
((OR (> |i| |n|)
(NULL
(SPADCALL
- (SPADCALL |s| |i|
- (|getShellEntry| $ 52))
+ (|ISTRING;elt;$IC;30| |s| |i| $)
|c| (|getShellEntry| $ 53))))
(GO G191)))
(SEQ (EXIT 0))
@@ -350,9 +452,9 @@
((NULL (< |n| |i|))
(LETT |l|
(SPADCALL
- (SPADCALL |s|
+ (|ISTRING;elt;$Us$;31| |s|
(SPADCALL |i| |n| (|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
+ $)
|l| (|getShellEntry| $ 57))
|ISTRING;split;$CL;22|)))
(EXIT (SPADCALL |l| (|getShellEntry| $ 58)))))))
@@ -367,9 +469,7 @@
G190
(COND
((OR (> |i| |n|)
- (NULL (SPADCALL
- (SPADCALL |s| |i|
- (|getShellEntry| $ 52))
+ (NULL (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $)
|cc| (|getShellEntry| $ 49))))
(GO G191)))
(SEQ (EXIT 0))
@@ -384,18 +484,18 @@
('T
(SPADCALL
(< (LETT |j|
- (SPADCALL |cc| |s| |i|
- (|getShellEntry| $ 50))
+ (|ISTRING;position;Cc$2I;20| |cc|
+ |s| |i| $)
|ISTRING;split;$CcL;23|)
(|getShellEntry| $ 6))
(|getShellEntry| $ 56)))))
(GO G191)))
(SEQ (LETT |l|
(SPADCALL
- (SPADCALL |s|
+ (|ISTRING;elt;$Us$;31| |s|
(SPADCALL |i| (- |j| 1)
(|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
+ $)
|l| (|getShellEntry| $ 57))
|ISTRING;split;$CcL;23|)
(EXIT (SEQ (LETT |i| |j| |ISTRING;split;$CcL;23|)
@@ -404,8 +504,7 @@
((OR (> |i| |n|)
(NULL
(SPADCALL
- (SPADCALL |s| |i|
- (|getShellEntry| $ 52))
+ (|ISTRING;elt;$IC;30| |s| |i| $)
|cc| (|getShellEntry| $ 49))))
(GO G191)))
(SEQ (EXIT 0))
@@ -417,9 +516,9 @@
((NULL (< |n| |i|))
(LETT |l|
(SPADCALL
- (SPADCALL |s|
+ (|ISTRING;elt;$Us$;31| |s|
(SPADCALL |i| |n| (|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
+ $)
|l| (|getShellEntry| $ 57))
|ISTRING;split;$CcL;23|)))
(EXIT (SPADCALL |l| (|getShellEntry| $ 58)))))))
@@ -434,17 +533,14 @@
G190
(COND
((OR (> |i| |n|)
- (NULL (SPADCALL
- (SPADCALL |s| |i|
- (|getShellEntry| $ 52))
+ (NULL (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $)
|c| (|getShellEntry| $ 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| (|getShellEntry| $ 20))
- (|getShellEntry| $ 21)))))))
+ (EXIT (|ISTRING;elt;$Us$;31| |s|
+ (SPADCALL |i| |n| (|getShellEntry| $ 20)) $))))))
(DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $)
(PROG (|n| |i|)
@@ -456,20 +552,17 @@
G190
(COND
((OR (> |i| |n|)
- (NULL (SPADCALL
- (SPADCALL |s| |i|
- (|getShellEntry| $ 52))
+ (NULL (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $)
|cc| (|getShellEntry| $ 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| (|getShellEntry| $ 20))
- (|getShellEntry| $ 21)))))))
+ (EXIT (|ISTRING;elt;$Us$;31| |s|
+ (SPADCALL |i| |n| (|getShellEntry| $ 20)) $))))))
(DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $)
- (PROG (|j| #0=#:G1494)
+ (PROG (|j| #0=#:G1540)
(RETURN
(SEQ (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 42))
|ISTRING;rightTrim;$C$;26|)
@@ -478,21 +571,19 @@
G190
(COND
((OR (< |j| #0#)
- (NULL (SPADCALL
- (SPADCALL |s| |j|
- (|getShellEntry| $ 52))
+ (NULL (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $)
|c| (|getShellEntry| $ 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| (|getShellEntry| $ 28))
- |j| (|getShellEntry| $ 20))
- (|getShellEntry| $ 21)))))))
+ (EXIT (|ISTRING;elt;$Us$;31| |s|
+ (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j|
+ (|getShellEntry| $ 20))
+ $))))))
(DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $)
- (PROG (|j| #0=#:G1498)
+ (PROG (|j| #0=#:G1541)
(RETURN
(SEQ (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 42))
|ISTRING;rightTrim;$Cc$;27|)
@@ -501,25 +592,23 @@
G190
(COND
((OR (< |j| #0#)
- (NULL (SPADCALL
- (SPADCALL |s| |j|
- (|getShellEntry| $ 52))
+ (NULL (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $)
|cc| (|getShellEntry| $ 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| (|getShellEntry| $ 28))
- |j| (|getShellEntry| $ 20))
- (|getShellEntry| $ 21)))))))
+ (EXIT (|ISTRING;elt;$Us$;31| |s|
+ (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j|
+ (|getShellEntry| $ 20))
+ $))))))
(DEFUN |ISTRING;concat;L$;28| (|l| $)
- (PROG (#0=#:G1506 #1=#:G1501 #2=#:G1499 #3=#:G1500 |t| |s| #4=#:G1507
+ (PROG (#0=#:G1542 #1=#:G1496 #2=#:G1494 #3=#:G1495 |t| |s| #4=#:G1543
|i|)
(RETURN
(SEQ (LETT |t|
- (SPADCALL
+ (MAKE-FULL-CVEC
(PROGN
(LETT #3# NIL |ISTRING;concat;L$;28|)
(SEQ (LETT |s| NIL |ISTRING;concat;L$;28|)
@@ -532,9 +621,7 @@
NIL))
(GO G191)))
(SEQ (EXIT (PROGN
- (LETT #1#
- (SPADCALL |s|
- (|getShellEntry| $ 13))
+ (LETT #1# (QCSIZE |s|)
|ISTRING;concat;L$;28|)
(COND
(#3#
@@ -549,8 +636,7 @@
(LETT #0# (CDR #0#) |ISTRING;concat;L$;28|)
(GO G190) G191 (EXIT NIL))
(COND (#3# #2#) ('T 0)))
- (SPADCALL (|getShellEntry| $ 43))
- (|getShellEntry| $ 9))
+ (SPADCALL (|getShellEntry| $ 43)))
|ISTRING;concat;L$;28|)
(LETT |i| (|getShellEntry| $ 6) |ISTRING;concat;L$;28|)
(SEQ (LETT |s| NIL |ISTRING;concat;L$;28|)
@@ -561,11 +647,8 @@
(LETT |s| (CAR #4#) |ISTRING;concat;L$;28|)
NIL))
(GO G191)))
- (SEQ (SPADCALL |t| |s| |i| (|getShellEntry| $ 66))
- (EXIT (LETT |i|
- (+ |i|
- (SPADCALL |s|
- (|getShellEntry| $ 13)))
+ (SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $)
+ (EXIT (LETT |i| (+ |i| (QCSIZE |s|))
|ISTRING;concat;L$;28|)))
(LETT #4# (CDR #4#) |ISTRING;concat;L$;28|) (GO G190)
G191 (EXIT NIL))
@@ -574,10 +657,8 @@
(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $)
(PROG (|m| |n|)
(RETURN
- (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 13))
- |ISTRING;copyInto!;2$I$;29|)
- (LETT |n| (SPADCALL |y| (|getShellEntry| $ 13))
- |ISTRING;copyInto!;2$I$;29|)
+ (SEQ (LETT |m| (QCSIZE |x|) |ISTRING;copyInto!;2$I$;29|)
+ (LETT |n| (QCSIZE |y|) |ISTRING;copyInto!;2$I$;29|)
(LETT |s| (- |s| (|getShellEntry| $ 6))
|ISTRING;copyInto!;2$I$;29|)
(COND
@@ -622,52 +703,52 @@
((ZEROP |n|) 0)
((EQL |n| 1)
(SPADCALL
- (SPADCALL |s| (|getShellEntry| $ 6)
- (|getShellEntry| $ 52))
+ (|ISTRING;elt;$IC;30| |s| (|getShellEntry| $ 6)
+ $)
(|getShellEntry| $ 68)))
('T
(* (* (SPADCALL
- (SPADCALL |s| (|getShellEntry| $ 6)
- (|getShellEntry| $ 52))
+ (|ISTRING;elt;$IC;30| |s|
+ (|getShellEntry| $ 6) $)
(|getShellEntry| $ 68))
(SPADCALL
- (SPADCALL |s|
+ (|ISTRING;elt;$IC;30| |s|
(- (+ (|getShellEntry| $ 6) |n|) 1)
- (|getShellEntry| $ 52))
+ $)
(|getShellEntry| $ 68)))
(SPADCALL
- (SPADCALL |s|
+ (|ISTRING;elt;$IC;30| |s|
(+ (|getShellEntry| $ 6)
(QUOTIENT2 |n| 2))
- (|getShellEntry| $ 52))
+ $)
(|getShellEntry| $ 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=#:G1521 #1=#:G1524 |s| #2=#:G1525 #3=#:G1534 |i|
- |p| #4=#:G1526 |q|)
+ (PROG (|n| |m| #0=#:G1514 #1=#:G1517 |s| #2=#:G1518 #3=#:G1527 |i|
+ |p| #4=#:G1519 |q|)
(RETURN
(SEQ (EXIT (SEQ (LETT |n|
(SPADCALL |pattern| (|getShellEntry| $ 42))
|ISTRING;match?;2$CB;34|)
(LETT |p|
(PROG1 (LETT #0#
- (SPADCALL |dontcare| |pattern|
+ (|ISTRING;position;C$2I;19|
+ |dontcare| |pattern|
(LETT |m|
- (SPADCALL |pattern|
- (|getShellEntry| $ 28))
+ (|ISTRING;minIndex;$I;11|
+ |pattern| $)
|ISTRING;match?;2$CB;34|)
- (|getShellEntry| $ 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|
- (|getShellEntry| $ 14)))
+ (EQUAL |pattern| |target|))
('T
(SEQ (COND
((SPADCALL |p| |m|
@@ -687,9 +768,9 @@
(LETT |q|
(PROG1
(LETT #1#
- (SPADCALL |dontcare| |pattern|
- (+ |p| 1)
- (|getShellEntry| $ 48))
+ (|ISTRING;position;C$2I;19|
+ |dontcare| |pattern| (+ |p| 1)
+ $)
|ISTRING;match?;2$CB;34|)
(|check-subtype| (>= #1# 0)
'(|NonNegativeInteger|) #1#))
@@ -702,16 +783,16 @@
(GO G191)))
(SEQ
(LETT |s|
- (SPADCALL |pattern|
+ (|ISTRING;elt;$Us$;31| |pattern|
(SPADCALL (+ |p| 1) (- |q| 1)
(|getShellEntry| $ 20))
- (|getShellEntry| $ 21))
+ $)
|ISTRING;match?;2$CB;34|)
(LETT |i|
(PROG1
(LETT #2#
- (SPADCALL |s| |target| |i|
- (|getShellEntry| $ 47))
+ (|ISTRING;position;2$2I;18|
+ |s| |target| |i| $)
|ISTRING;match?;2$CB;34|)
(|check-subtype| (>= #2# 0)
'(|NonNegativeInteger|) #2#))
@@ -726,9 +807,7 @@
('T
(SEQ
(LETT |i|
- (+ |i|
- (SPADCALL |s|
- (|getShellEntry| $ 13)))
+ (+ |i| (QCSIZE |s|))
|ISTRING;match?;2$CB;34|)
(LETT |p| |q|
|ISTRING;match?;2$CB;34|)
@@ -736,9 +815,9 @@
(LETT |q|
(PROG1
(LETT #4#
- (SPADCALL |dontcare|
- |pattern| (+ |q| 1)
- (|getShellEntry| $ 48))
+ (|ISTRING;position;C$2I;19|
+ |dontcare| |pattern|
+ (+ |q| 1) $)
|ISTRING;match?;2$CB;34|)
(|check-subtype|
(>= #4# 0)
@@ -762,10 +841,10 @@
(EXIT 'T)))))))
#3# (EXIT #3#)))))
-(DEFUN |IndexedString| (#0=#:G1541)
+(DEFUN |IndexedString| (#0=#:G1544)
(PROG ()
(RETURN
- (PROG (#1=#:G1542)
+ (PROG (#1=#:G1545)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp
index 2cb74e75..97621b74 100644
--- a/src/algebra/strap/LIST.lsp
+++ b/src/algebra/strap/LIST.lsp
@@ -1,20 +1,59 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%List|) |LIST;nil;$;1|))
+
(PUT '|LIST;nil;$;1| '|SPADreplace| '(XLAM NIL NIL))
-(DEFUN |LIST;nil;$;1| ($) NIL)
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Boolean|)
+ |LIST;null;$B;2|))
(PUT '|LIST;null;$B;2| '|SPADreplace| 'NULL)
-(DEFUN |LIST;null;$B;2| (|l| $) (NULL |l|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|)
+ |LIST;cons;S2$;3|))
(PUT '|LIST;cons;S2$;3| '|SPADreplace| 'CONS)
-(DEFUN |LIST;cons;S2$;3| (|s| |l| $) (CONS |s| |l|))
+(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|)
+ |LIST;append;3$;4|))
(PUT '|LIST;append;3$;4| '|SPADreplace| 'APPEND)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Void|)
+ |LIST;writeOMList|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%String|)
+ |LIST;OMwrite;$S;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Boolean| |%Shell|) |%String|)
+ |LIST;OMwrite;$BS;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Void|)
+ |LIST;OMwrite;Omd$V;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Boolean| |%Shell|)
+ |%Void|)
+ |LIST;OMwrite;Omd$BV;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|)
+ |LIST;setUnion;3$;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|)
+ |LIST;setIntersection;3$;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%List|)
+ |LIST;setDifference;3$;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |LIST;convert;$If;13|))
+
+(DEFUN |LIST;nil;$;1| ($) NIL)
+
+(DEFUN |LIST;null;$B;2| (|l| $) (NULL |l|))
+
+(DEFUN |LIST;cons;S2$;3| (|s| |l| $) (CONS |s| |l|))
+
(DEFUN |LIST;append;3$;4| (|l| |t| $) (APPEND |l| |t|))
(DEFUN |LIST;writeOMList| (|dev| |x| $)
@@ -121,7 +160,7 @@
(EXIT |lu|)))))
(DEFUN |LIST;convert;$If;13| (|x| $)
- (PROG (#0=#:G1437 |a| #1=#:G1438)
+ (PROG (#0=#:G1447 |a| #1=#:G1448)
(RETURN
(SEQ (SPADCALL
(CONS (SPADCALL
@@ -148,10 +187,10 @@
(GO G190) G191 (EXIT (NREVERSE0 #0#)))))
(|getShellEntry| $ 44))))))
-(DEFUN |List| (#0=#:G1446)
+(DEFUN |List| (#0=#:G1449)
(PROG ()
(RETURN
- (PROG (#1=#:G1447)
+ (PROG (#1=#:G1450)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp
index 865a3523..8fb55dad 100644
--- a/src/algebra/strap/LNAGG-.lsp
+++ b/src/algebra/strap/LNAGG-.lsp
@@ -1,8 +1,27 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |LNAGG-;indices;AL;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Thing| |%Shell|) |%Boolean|)
+ |LNAGG-;index?;IAB;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LNAGG-;concat;ASA;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LNAGG-;concat;S2A;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |LNAGG-;insert;SAIA;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |LNAGG-;maxIndex;AI;6|))
+
(DEFUN |LNAGG-;indices;AL;1| (|a| $)
- (PROG (#0=#:G1401 |i| #1=#:G1402)
+ (PROG (#0=#:G1410 |i| #1=#:G1411)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |LNAGG-;indices;AL;1|)
diff --git a/src/algebra/strap/LNAGG.lsp b/src/algebra/strap/LNAGG.lsp
index 7eab4ad6..98805faf 100644
--- a/src/algebra/strap/LNAGG.lsp
+++ b/src/algebra/strap/LNAGG.lsp
@@ -5,25 +5,14 @@
(DEFPARAMETER |LinearAggregate;AL| 'NIL)
-(DEFUN |LinearAggregate| (#0=#:G1397)
- (LET (#1=#:G1398)
- (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=#:G1396)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
(PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
(|sublisV|
- (PAIR '(#1=#:G1395) (LIST '(|Integer|)))
+ (PAIR '(#1=#:G1398) (LIST '(|Integer|)))
(COND
(|LinearAggregate;CAT|)
('T
@@ -80,6 +69,17 @@
. #2=(|LinearAggregate|)))))) . #2#)
(SETELT #0# 0 (LIST '|LinearAggregate| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|LinearAggregate| '|isCategory| T
(|addModemap| '|LinearAggregate| '(|LinearAggregate| |#1|)
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index 98528759..4823fd5b 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -1,6 +1,93 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;sort!;M2A;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;list;SA;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;reduce;MAS;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |LSAGG-;merge;M3A;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;select!;M2A;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |LSAGG-;merge!;M3A;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |LSAGG-;insert!;SAIA;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |LSAGG-;insert!;2AIA;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;remove!;M2A;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |LSAGG-;delete!;AIA;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;delete!;AUsA;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |LSAGG-;find;MAU;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Integer|)
+ |LSAGG-;position;MAI;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |LSAGG-;mergeSort|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |LSAGG-;sorted?;MAB;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |LSAGG-;reduce;MA2S;16|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |LSAGG-;reduce;MA3S;17|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|)
+ |%Thing|)
+ |LSAGG-;new;NniSA;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |LSAGG-;map;M3A;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;reverse!;2A;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;copy;2A;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Thing|)
+ |LSAGG-;copyInto!;2AIA;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Integer| |%Shell|)
+ |%Integer|)
+ |LSAGG-;position;SA2I;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |LSAGG-;removeDuplicates!;2A;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |LSAGG-;<;2AB;25|))
+
(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| $)
(|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (|getShellEntry| $ 9)) $))
@@ -155,7 +242,7 @@
(EXIT |r|))))))))
(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $)
- (PROG (|m| #0=#:G1461 |y| |z|)
+ (PROG (|m| #0=#:G1464 |y| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 32))
|LSAGG-;insert!;SAIA;7|)
@@ -182,7 +269,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $)
- (PROG (|m| #0=#:G1465 |y| |z|)
+ (PROG (|m| #0=#:G1468 |y| |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 32))
|LSAGG-;insert!;2AIA;8|)
@@ -262,7 +349,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $)
- (PROG (|m| #0=#:G1477 |y|)
+ (PROG (|m| #0=#:G1480 |y|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 32))
|LSAGG-;delete!;AIA;10|)
@@ -286,7 +373,7 @@
(EXIT |x|)))))))))
(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $)
- (PROG (|l| |m| |h| #0=#:G1482 #1=#:G1483 |t| #2=#:G1484)
+ (PROG (|l| |m| |h| #0=#:G1485 #1=#:G1486 |t| #2=#:G1487)
(RETURN
(SEQ (LETT |l| (SPADCALL |i| (|getShellEntry| $ 40))
|LSAGG-;delete!;AUsA;11|)
@@ -383,7 +470,7 @@
('T |k|)))))))
(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $)
- (PROG (#0=#:G1504 |l| |q|)
+ (PROG (#0=#:G1507 |l| |q|)
(RETURN
(SEQ (COND
((EQL |n| 2)
@@ -417,7 +504,7 @@
(|getShellEntry| $ 23)))))))))))
(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $)
- (PROG (#0=#:G1513 |p|)
+ (PROG (#0=#:G1516 |p|)
(RETURN
(SEQ (EXIT (COND
((SPADCALL |l| (|getShellEntry| $ 16)) 'T)
@@ -606,7 +693,7 @@
(EXIT (SPADCALL |y| (|getShellEntry| $ 48)))))))
(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $)
- (PROG (|m| #0=#:G1542 |z|)
+ (PROG (|m| #0=#:G1545 |z|)
(RETURN
(SEQ (LETT |m| (SPADCALL |y| (|getShellEntry| $ 32))
|LSAGG-;copyInto!;2AIA;22|)
@@ -651,7 +738,7 @@
(EXIT |y|)))))))))
(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $)
- (PROG (|m| #0=#:G1549 |k|)
+ (PROG (|m| #0=#:G1552 |k|)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 32))
|LSAGG-;position;SA2I;23|)
@@ -729,7 +816,7 @@
(|getShellEntry| $ 62))))))
(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $)
- (PROG (#0=#:G1563)
+ (PROG (#0=#:G1566)
(RETURN
(SEQ (EXIT (SEQ (SEQ G190
(COND
diff --git a/src/algebra/strap/LSAGG.lsp b/src/algebra/strap/LSAGG.lsp
index 4729107b..924ec233 100644
--- a/src/algebra/strap/LSAGG.lsp
+++ b/src/algebra/strap/LSAGG.lsp
@@ -5,19 +5,8 @@
(DEFPARAMETER |ListAggregate;AL| 'NIL)
-(DEFUN |ListAggregate| (#0=#:G1428)
- (LET (#1=#:G1429)
- (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=#:G1427)
+ (PROG (#0=#:G1430)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -37,6 +26,17 @@
. #1=(|ListAggregate|))))) . #1#)
(SETELT #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|ListAggregate| '|isCategory| T
(|addModemap| '|ListAggregate| '(|ListAggregate| |#1|)
diff --git a/src/algebra/strap/MONOID-.lsp b/src/algebra/strap/MONOID-.lsp
index 399e1f43..6673562a 100644
--- a/src/algebra/strap/MONOID-.lsp
+++ b/src/algebra/strap/MONOID-.lsp
@@ -1,6 +1,18 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |MONOID-;one?;SB;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |MONOID-;sample;S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |MONOID-;recip;SU;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |MONOID-;**;SNniS;4|))
+
(DEFUN |MONOID-;one?;SB;1| (|x| $)
(SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/MONOID.lsp b/src/algebra/strap/MONOID.lsp
index 47ce4776..43b52fd0 100644
--- a/src/algebra/strap/MONOID.lsp
+++ b/src/algebra/strap/MONOID.lsp
@@ -3,12 +3,8 @@
(DEFPARAMETER |Monoid;AL| 'NIL)
-(DEFUN |Monoid| ()
- (LET (#:G1397)
- (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|))))))
-
(DEFUN |Monoid;| ()
- (PROG (#0=#:G1395)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|Join| (|SemiGroup|)
@@ -24,6 +20,9 @@
|Monoid|)
(SETELT #0# 0 '(|Monoid|))))))
+(DEFUN |Monoid| ()
+ (LET () (COND (|Monoid;AL|) (T (SETQ |Monoid;AL| (|Monoid;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|Monoid| '|isCategory| T
(|addModemap| '|Monoid| '(|Monoid|) '((|Category|)) T
diff --git a/src/algebra/strap/MTSCAT.lsp b/src/algebra/strap/MTSCAT.lsp
index 39e41d1a..ecc72ee2 100644
--- a/src/algebra/strap/MTSCAT.lsp
+++ b/src/algebra/strap/MTSCAT.lsp
@@ -5,26 +5,8 @@
(DEFPARAMETER |MultivariateTaylorSeriesCategory;AL| 'NIL)
-(DEFUN |MultivariateTaylorSeriesCategory|
- (&REST #0=#:G1399 &AUX #1=#:G1397)
- (DSETQ #1# #0#)
- (LET (#2=#:G1398)
- (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=#:G1396)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -32,7 +14,7 @@
(LIST (|devaluate| |t#1|)
(|devaluate| |t#2|)))
(|sublisV|
- (PAIR '(#1=#:G1395)
+ (PAIR '(#1=#:G1398)
(LIST '(|IndexedExponents| |t#2|)))
(COND
(|MultivariateTaylorSeriesCategory;CAT|)
@@ -106,6 +88,24 @@
(LIST '|MultivariateTaylorSeriesCategory|
(|devaluate| |t#1|) (|devaluate| |t#2|)))))))
+(DEFUN |MultivariateTaylorSeriesCategory|
+ (&REST #0=#:G1402 &AUX #1=#:G1400)
+ (DSETQ #1# #0#)
+ (LET (#2=#:G1401)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|MultivariateTaylorSeriesCategory| '|isCategory| T
(|addModemap| '|MultivariateTaylorSeriesCategory|
diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp
index 35a0c86b..3628c587 100644
--- a/src/algebra/strap/NNI.lsp
+++ b/src/algebra/strap/NNI.lsp
@@ -11,12 +11,28 @@
|$CategoryFrame|)))
|$CategoryFrame|)))
+(DECLAIM (FTYPE (FUNCTION
+ ((|%IntegerSection| 0) (|%IntegerSection| 0)
+ |%Shell|)
+ (|%IntegerSection| 0))
+ |NNI;sup;3$;1|))
+
(PUT '|NNI;sup;3$;1| '|SPADreplace| 'MAX)
-(DEFUN |NNI;sup;3$;1| (|x| |y| $) (MAX |x| |y|))
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Integer| |%Shell|)
+ (|%IntegerSection| 0))
+ |NNI;shift;$I$;2|))
(PUT '|NNI;shift;$I$;2| '|SPADreplace| 'ASH)
+(DECLAIM (FTYPE (FUNCTION
+ ((|%IntegerSection| 0) (|%IntegerSection| 0)
+ |%Shell|)
+ |%Pair|)
+ |NNI;subtractIfCan;2$U;3|))
+
+(DEFUN |NNI;sup;3$;1| (|x| |y| $) (MAX |x| |y|))
+
(DEFUN |NNI;shift;$I$;2| (|x| |n| $) (ASH |x| |n|))
(DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| $)
@@ -30,7 +46,7 @@
(DEFUN |NonNegativeInteger| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1406)
+ (PROG (#0=#:G1409)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|NonNegativeInteger|)
diff --git a/src/algebra/strap/OINTDOM.lsp b/src/algebra/strap/OINTDOM.lsp
index d449414c..c68598c8 100644
--- a/src/algebra/strap/OINTDOM.lsp
+++ b/src/algebra/strap/OINTDOM.lsp
@@ -3,19 +3,19 @@
(DEFPARAMETER |OrderedIntegralDomain;AL| 'NIL)
-(DEFUN |OrderedIntegralDomain| ()
- (LET (#:G1396)
- (COND
- (|OrderedIntegralDomain;AL|)
- (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|))))))
-
(DEFUN |OrderedIntegralDomain;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0# (|Join| (|IntegralDomain|) (|OrderedRing|))
|OrderedIntegralDomain|)
(SETELT #0# 0 '(|OrderedIntegralDomain|))))))
+(DEFUN |OrderedIntegralDomain| ()
+ (LET ()
+ (COND
+ (|OrderedIntegralDomain;AL|)
+ (T (SETQ |OrderedIntegralDomain;AL| (|OrderedIntegralDomain;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|OrderedIntegralDomain| '|isCategory| T
(|addModemap| '|OrderedIntegralDomain|
diff --git a/src/algebra/strap/ORDRING-.lsp b/src/algebra/strap/ORDRING-.lsp
index 63b2eb23..9b433619 100644
--- a/src/algebra/strap/ORDRING-.lsp
+++ b/src/algebra/strap/ORDRING-.lsp
@@ -1,6 +1,18 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ORDRING-;positive?;SB;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |ORDRING-;negative?;SB;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |ORDRING-;sign;SI;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |ORDRING-;abs;2S;4|))
+
(DEFUN |ORDRING-;positive?;SB;1| (|x| $)
(SPADCALL (|spadConstant| $ 7) |x| (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/ORDRING.lsp b/src/algebra/strap/ORDRING.lsp
index 341a4bc7..a15e19b1 100644
--- a/src/algebra/strap/ORDRING.lsp
+++ b/src/algebra/strap/ORDRING.lsp
@@ -3,14 +3,8 @@
(DEFPARAMETER |OrderedRing;AL| 'NIL)
-(DEFUN |OrderedRing| ()
- (LET (#:G1402)
- (COND
- (|OrderedRing;AL|)
- (T (SETQ |OrderedRing;AL| (|OrderedRing;|))))))
-
(DEFUN |OrderedRing;| ()
- (PROG (#0=#:G1400)
+ (PROG (#0=#:G1403)
(RETURN
(PROG1 (LETT #0#
(|Join| (|OrderedAbelianGroup|) (|Ring|) (|Monoid|)
@@ -23,6 +17,12 @@
|OrderedRing|)
(SETELT #0# 0 '(|OrderedRing|))))))
+(DEFUN |OrderedRing| ()
+ (LET ()
+ (COND
+ (|OrderedRing;AL|)
+ (T (SETQ |OrderedRing;AL| (|OrderedRing;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|OrderedRing| '|isCategory| T
(|addModemap| '|OrderedRing| '(|OrderedRing|)
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 3986749a..41f4b5ef 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -1,60 +1,393 @@
(/VERSIONCHECK 2)
-(DEFUN |OUTFORM;doubleFloatFormat;2S;1| (|s| $)
- (PROG (|ss|)
- (RETURN
- (SEQ (LETT |ss| (|getShellEntry| $ 6)
- |OUTFORM;doubleFloatFormat;2S;1|)
- (SETELT $ 6 |s|) (EXIT |ss|)))))
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%String|)
+ |OUTFORM;doubleFloatFormat;2S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|)
+ |OUTFORM;sform|))
(PUT '|OUTFORM;sform| '|SPADreplace| '(XLAM (|s|) |s|))
-(DEFUN |OUTFORM;sform| (|s| $) |s|)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;eform|))
(PUT '|OUTFORM;eform| '|SPADreplace| '(XLAM (|e|) |e|))
-(DEFUN |OUTFORM;eform| (|e| $) |e|)
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;iform|))
(PUT '|OUTFORM;iform| '|SPADreplace| '(XLAM (|i|) |i|))
-(DEFUN |OUTFORM;iform| (|i| $) |i|)
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|) |OUTFORM;bless|))
(PUT '|OUTFORM;bless| '|SPADreplace| '(XLAM (|x|) |x|))
-(DEFUN |OUTFORM;bless| (|x| $) |x|)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Void|)
+ |OUTFORM;print;$V;6|))
(PUT '|OUTFORM;print;$V;6| '|SPADreplace| '|mathprint|)
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|)
+ |OUTFORM;message;S$;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Void|)
+ |OUTFORM;messagePrint;SV;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |OUTFORM;=;2$B;9|))
+
+(PUT '|OUTFORM;=;2$B;9| '|SPADreplace| 'EQUAL)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;=;3$;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;coerce;2$;11|))
+
+(PUT '|OUTFORM;coerce;2$;11| '|SPADreplace| '(XLAM (|a|) |a|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;outputForm;I$;12|))
+
+(PUT '|OUTFORM;outputForm;I$;12| '|SPADreplace| '(XLAM (|n|) |n|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;outputForm;S$;13|))
+
+(PUT '|OUTFORM;outputForm;S$;13| '|SPADreplace| '(XLAM (|e|) |e|))
+
+(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%Shell|) |%Thing|)
+ |OUTFORM;outputForm;Df$;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|)
+ |OUTFORM;outputForm;S$;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |OUTFORM;width;$I;16|))
+
+(PUT '|OUTFORM;width;$I;16| '|SPADreplace| '|outformWidth|)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |OUTFORM;height;$I;17|))
+
+(PUT '|OUTFORM;height;$I;17| '|SPADreplace| '|height|)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |OUTFORM;subHeight;$I;18|))
+
+(PUT '|OUTFORM;subHeight;$I;18| '|SPADreplace| '|subspan|)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |OUTFORM;superHeight;$I;19|))
+
+(PUT '|OUTFORM;superHeight;$I;19| '|SPADreplace| '|superspan|)
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |OUTFORM;height;I;20|))
+
+(PUT '|OUTFORM;height;I;20| '|SPADreplace| '(XLAM NIL 20))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Integer|) |OUTFORM;width;I;21|))
+
+(PUT '|OUTFORM;width;I;21| '|SPADreplace| '(XLAM NIL 66))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;center;$I$;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;left;$I$;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;right;$I$;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;center;2$;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;left;2$;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;right;2$;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;vspace;I$;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;hspace;I$;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Thing|)
+ |OUTFORM;rspace;2I$;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;matrix;L$;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;pile;L$;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;commaSeparate;L$;33|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;semicolonSeparate;L$;34|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;blankSeparate;L$;35|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;brace;2$;36|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;brace;L$;37|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;bracket;2$;38|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;bracket;L$;39|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;paren;2$;40|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;paren;L$;41|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;sub;3$;42|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;super;3$;43|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;presub;3$;44|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;presuper;3$;45|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |OUTFORM;scripts;$L$;46|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |OUTFORM;supersub;$L$;47|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;hconcat;3$;48|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;hconcat;L$;49|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;vconcat;3$;50|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |OUTFORM;vconcat;L$;51|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;~=;3$;52|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;<;3$;53|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;>;3$;54|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;<=;3$;55|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;>=;3$;56|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;+;3$;57|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;-;3$;58|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;-;2$;59|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;*;3$;60|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;/;3$;61|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;**;3$;62|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;div;3$;63|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;rem;3$;64|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;quo;3$;65|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;exquo;3$;66|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;and;3$;67|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;or;3$;68|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;not;2$;69|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;SEGMENT;3$;70|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;SEGMENT;2$;71|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;binomial;3$;72|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |OUTFORM;empty;$;73|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |OUTFORM;infix?;$B;74|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |OUTFORM;elt;$L$;75|))
+
+(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| 'CONS)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |OUTFORM;prefix;$L$;76|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |OUTFORM;infix;$L$;77|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |OUTFORM;infix;4$;78|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;postfix;3$;79|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;string;2$;80|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;quote;2$;81|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;overbar;2$;82|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;dot;2$;83|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;prime;2$;84|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |OUTFORM;dot;$Nni$;85|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |OUTFORM;prime;$Nni$;86|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;overlabel;3$;87|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;box;2$;88|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;zag;3$;89|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;root;2$;90|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;root;3$;91|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;over;3$;92|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;slash;3$;93|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;assign;3$;94|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;label;3$;95|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;rarrow;3$;96|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |OUTFORM;differentiate;$Nni$;97|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;sum;2$;98|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;sum;3$;99|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |OUTFORM;sum;4$;100|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;prod;2$;101|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;prod;3$;102|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |OUTFORM;prod;4$;103|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;int;2$;104|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |OUTFORM;int;3$;105|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |OUTFORM;int;4$;106|))
+
+(DEFUN |OUTFORM;doubleFloatFormat;2S;1| (|s| $)
+ (PROG (|ss|)
+ (RETURN
+ (SEQ (LETT |ss| (|getShellEntry| $ 6)
+ |OUTFORM;doubleFloatFormat;2S;1|)
+ (SETELT $ 6 |s|) (EXIT |ss|)))))
+
+(DEFUN |OUTFORM;sform| (|s| $) |s|)
+
+(DEFUN |OUTFORM;eform| (|e| $) |e|)
+
+(DEFUN |OUTFORM;iform| (|i| $) |i|)
+
+(DEFUN |OUTFORM;bless| (|x| $) |x|)
+
(DEFUN |OUTFORM;print;$V;6| (|x| $) (|mathprint| |x|))
(DEFUN |OUTFORM;message;S$;7| (|s| $)
(COND
- ((SPADCALL |s| (|getShellEntry| $ 12))
- (SPADCALL (|getShellEntry| $ 13)))
+ ((SPADCALL |s| (|getShellEntry| $ 12)) (|OUTFORM;empty;$;73| $))
('T |s|)))
(DEFUN |OUTFORM;messagePrint;SV;8| (|s| $)
- (SPADCALL (SPADCALL |s| (|getShellEntry| $ 14))
- (|getShellEntry| $ 10)))
-
-(PUT '|OUTFORM;=;2$B;9| '|SPADreplace| 'EQUAL)
+ (|mathprint| (|OUTFORM;message;S$;7| |s| $)))
(DEFUN |OUTFORM;=;2$B;9| (|a| |b| $) (EQUAL |a| |b|))
(DEFUN |OUTFORM;=;3$;10| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "=" $) |a| |b|) $))
-
-(PUT '|OUTFORM;coerce;2$;11| '|SPADreplace| '(XLAM (|a|) |a|))
+ (|OUTFORM;bless| (LIST "=" |a| |b|) $))
(DEFUN |OUTFORM;coerce;2$;11| (|a| $) |a|)
-(PUT '|OUTFORM;outputForm;I$;12| '|SPADreplace| '(XLAM (|n|) |n|))
-
(DEFUN |OUTFORM;outputForm;I$;12| (|n| $) |n|)
-(PUT '|OUTFORM;outputForm;S$;13| '|SPADreplace| '(XLAM (|e|) |e|))
-
(DEFUN |OUTFORM;outputForm;S$;13| (|e| $) |e|)
(DEFUN |OUTFORM;outputForm;Df$;14| (|f| $)
@@ -68,84 +401,61 @@
(|getShellEntry| $ 29))
$))
-(PUT '|OUTFORM;width;$I;16| '|SPADreplace| '|outformWidth|)
-
(DEFUN |OUTFORM;width;$I;16| (|a| $) (|outformWidth| |a|))
-(PUT '|OUTFORM;height;$I;17| '|SPADreplace| '|height|)
-
(DEFUN |OUTFORM;height;$I;17| (|a| $) (|height| |a|))
-(PUT '|OUTFORM;subHeight;$I;18| '|SPADreplace| '|subspan|)
-
(DEFUN |OUTFORM;subHeight;$I;18| (|a| $) (|subspan| |a|))
-(PUT '|OUTFORM;superHeight;$I;19| '|SPADreplace| '|superspan|)
-
(DEFUN |OUTFORM;superHeight;$I;19| (|a| $) (|superspan| |a|))
-(PUT '|OUTFORM;height;I;20| '|SPADreplace| '(XLAM NIL 20))
-
(DEFUN |OUTFORM;height;I;20| ($) 20)
-(PUT '|OUTFORM;width;I;21| '|SPADreplace| '(XLAM NIL 66))
-
(DEFUN |OUTFORM;width;I;21| ($) 66)
(DEFUN |OUTFORM;center;$I$;22| (|a| |w| $)
- (SPADCALL
- (SPADCALL
- (QUOTIENT2 (- |w| (SPADCALL |a| (|getShellEntry| $ 31))) 2)
- (|getShellEntry| $ 37))
- |a| (|getShellEntry| $ 38)))
+ (|OUTFORM;hconcat;3$;48|
+ (|OUTFORM;hspace;I$;29|
+ (QUOTIENT2 (- |w| (|outformWidth| |a|)) 2) $)
+ |a| $))
(DEFUN |OUTFORM;left;$I$;23| (|a| |w| $)
- (SPADCALL |a|
- (SPADCALL (- |w| (SPADCALL |a| (|getShellEntry| $ 31)))
- (|getShellEntry| $ 37))
- (|getShellEntry| $ 38)))
+ (|OUTFORM;hconcat;3$;48| |a|
+ (|OUTFORM;hspace;I$;29| (- |w| (|outformWidth| |a|)) $) $))
(DEFUN |OUTFORM;right;$I$;24| (|a| |w| $)
- (SPADCALL
- (SPADCALL (- |w| (SPADCALL |a| (|getShellEntry| $ 31)))
- (|getShellEntry| $ 37))
- |a| (|getShellEntry| $ 38)))
+ (|OUTFORM;hconcat;3$;48|
+ (|OUTFORM;hspace;I$;29| (- |w| (|outformWidth| |a|)) $) |a| $))
(DEFUN |OUTFORM;center;2$;25| (|a| $)
- (SPADCALL |a| (SPADCALL (|getShellEntry| $ 36))
- (|getShellEntry| $ 39)))
+ (|OUTFORM;center;$I$;22| |a| 66 $))
-(DEFUN |OUTFORM;left;2$;26| (|a| $)
- (SPADCALL |a| (SPADCALL (|getShellEntry| $ 36))
- (|getShellEntry| $ 40)))
+(DEFUN |OUTFORM;left;2$;26| (|a| $) (|OUTFORM;left;$I$;23| |a| 66 $))
(DEFUN |OUTFORM;right;2$;27| (|a| $)
- (SPADCALL |a| (SPADCALL (|getShellEntry| $ 36))
- (|getShellEntry| $ 41)))
+ (|OUTFORM;right;$I$;24| |a| 66 $))
(DEFUN |OUTFORM;vspace;I$;28| (|n| $)
(COND
- ((EQL |n| 0) (SPADCALL (|getShellEntry| $ 13)))
+ ((EQL |n| 0) (|OUTFORM;empty;$;73| $))
('T
- (SPADCALL (|OUTFORM;sform| " " $)
- (SPADCALL (- |n| 1) (|getShellEntry| $ 45))
- (|getShellEntry| $ 46)))))
+ (|OUTFORM;vconcat;3$;50| " " (|OUTFORM;vspace;I$;28| (- |n| 1) $)
+ $))))
(DEFUN |OUTFORM;hspace;I$;29| (|n| $)
(COND
- ((EQL |n| 0) (SPADCALL (|getShellEntry| $ 13)))
+ ((EQL |n| 0) (|OUTFORM;empty;$;73| $))
('T (|OUTFORM;sform| (|fillerSpaces| |n|) $))))
(DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $)
(COND
- ((OR (EQL |n| 0) (EQL |m| 0)) (SPADCALL (|getShellEntry| $ 13)))
+ ((OR (EQL |n| 0) (EQL |m| 0)) (|OUTFORM;empty;$;73| $))
('T
- (SPADCALL (SPADCALL |n| (|getShellEntry| $ 37))
- (SPADCALL |n| (- |m| 1) (|getShellEntry| $ 47))
- (|getShellEntry| $ 46)))))
+ (|OUTFORM;vconcat;3$;50| (|OUTFORM;hspace;I$;29| |n| $)
+ (|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $))))
(DEFUN |OUTFORM;matrix;L$;31| (|ll| $)
- (PROG (#0=#:G1445 |l| #1=#:G1446 |lv|)
+ (PROG (#0=#:G1614 |l| #1=#:G1615 |lv|)
(RETURN
(SEQ (LETT |lv|
(|OUTFORM;bless|
@@ -167,22 +477,18 @@
(GO G190) G191 (EXIT (NREVERSE0 #0#))))
$)
|OUTFORM;matrix;L$;31|)
- (EXIT (CONS (|OUTFORM;eform| 'MATRIX $) (LIST2VEC |lv|)))))))
+ (EXIT (CONS 'MATRIX (LIST2VEC |lv|)))))))
-(DEFUN |OUTFORM;pile;L$;32| (|l| $)
- (CONS (|OUTFORM;eform| 'SC $) |l|))
+(DEFUN |OUTFORM;pile;L$;32| (|l| $) (CONS 'SC |l|))
-(DEFUN |OUTFORM;commaSeparate;L$;33| (|l| $)
- (CONS (|OUTFORM;eform| 'AGGLST $) |l|))
+(DEFUN |OUTFORM;commaSeparate;L$;33| (|l| $) (CONS 'AGGLST |l|))
-(DEFUN |OUTFORM;semicolonSeparate;L$;34| (|l| $)
- (CONS (|OUTFORM;eform| 'AGGSET $) |l|))
+(DEFUN |OUTFORM;semicolonSeparate;L$;34| (|l| $) (CONS 'AGGSET |l|))
(DEFUN |OUTFORM;blankSeparate;L$;35| (|l| $)
- (PROG (|c| |u| #0=#:G1454 |l1|)
+ (PROG (|c| |u| #0=#:G1616 |l1|)
(RETURN
- (SEQ (LETT |c| (|OUTFORM;eform| 'CONCATB $)
- |OUTFORM;blankSeparate;L$;35|)
+ (SEQ (LETT |c| 'CONCATB |OUTFORM;blankSeparate;L$;35|)
(LETT |l1| NIL |OUTFORM;blankSeparate;L$;35|)
(SEQ (LETT |u| NIL |OUTFORM;blankSeparate;L$;35|)
(LETT #0# (SPADCALL |l| (|getShellEntry| $ 55))
@@ -209,145 +515,128 @@
(EXIT (CONS |c| |l1|))))))
(DEFUN |OUTFORM;brace;2$;36| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'BRACE $) |a|) $))
+ (|OUTFORM;bless| (LIST 'BRACE |a|) $))
(DEFUN |OUTFORM;brace;L$;37| (|l| $)
- (SPADCALL (SPADCALL |l| (|getShellEntry| $ 52))
- (|getShellEntry| $ 58)))
+ (|OUTFORM;brace;2$;36| (|OUTFORM;commaSeparate;L$;33| |l| $) $))
(DEFUN |OUTFORM;bracket;2$;38| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'BRACKET $) |a|) $))
+ (|OUTFORM;bless| (LIST 'BRACKET |a|) $))
(DEFUN |OUTFORM;bracket;L$;39| (|l| $)
- (SPADCALL (SPADCALL |l| (|getShellEntry| $ 52))
- (|getShellEntry| $ 60)))
+ (|OUTFORM;bracket;2$;38| (|OUTFORM;commaSeparate;L$;33| |l| $) $))
(DEFUN |OUTFORM;paren;2$;40| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'PAREN $) |a|) $))
+ (|OUTFORM;bless| (LIST 'PAREN |a|) $))
(DEFUN |OUTFORM;paren;L$;41| (|l| $)
- (SPADCALL (SPADCALL |l| (|getShellEntry| $ 52))
- (|getShellEntry| $ 62)))
+ (|OUTFORM;paren;2$;40| (|OUTFORM;commaSeparate;L$;33| |l| $) $))
(DEFUN |OUTFORM;sub;3$;42| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'SUB $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'SUB |a| |b|) $))
(DEFUN |OUTFORM;super;3$;43| (|a| |b| $)
- (|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $)
- |b|)
- $))
+ (|OUTFORM;bless| (LIST 'SUPERSUB |a| " " |b|) $))
(DEFUN |OUTFORM;presub;3$;44| (|a| |b| $)
- (|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $)
- (|OUTFORM;sform| " " $) (|OUTFORM;sform| " " $) |b|)
- $))
+ (|OUTFORM;bless| (LIST 'SUPERSUB |a| " " " " " " |b|) $))
(DEFUN |OUTFORM;presuper;3$;45| (|a| |b| $)
- (|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'SUPERSUB $) |a| (|OUTFORM;sform| " " $)
- (|OUTFORM;sform| " " $) |b|)
- $))
+ (|OUTFORM;bless| (LIST 'SUPERSUB |a| " " " " |b|) $))
(DEFUN |OUTFORM;scripts;$L$;46| (|a| |l| $)
(COND
((SPADCALL |l| (|getShellEntry| $ 68)) |a|)
((SPADCALL (SPADCALL |l| (|getShellEntry| $ 69))
(|getShellEntry| $ 68))
- (SPADCALL |a| (SPADCALL |l| (|getShellEntry| $ 70))
- (|getShellEntry| $ 64)))
- ('T (CONS (|OUTFORM;eform| 'SUPERSUB $) (CONS |a| |l|)))))
+ (|OUTFORM;sub;3$;42| |a| (SPADCALL |l| (|getShellEntry| $ 70)) $))
+ ('T (CONS 'SUPERSUB (CONS |a| |l|)))))
(DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $)
(SEQ (COND
((ODDP (SPADCALL |l| (|getShellEntry| $ 73)))
(LETT |l|
- (SPADCALL |l| (LIST (SPADCALL (|getShellEntry| $ 13)))
+ (SPADCALL |l| (LIST (|OUTFORM;empty;$;73| $))
(|getShellEntry| $ 56))
|OUTFORM;supersub;$L$;47|)))
- (EXIT (CONS (|OUTFORM;eform| 'ALTSUPERSUB $) (CONS |a| |l|)))))
+ (EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|)))))
(DEFUN |OUTFORM;hconcat;3$;48| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'CONCAT $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'CONCAT |a| |b|) $))
-(DEFUN |OUTFORM;hconcat;L$;49| (|l| $)
- (CONS (|OUTFORM;eform| 'CONCAT $) |l|))
+(DEFUN |OUTFORM;hconcat;L$;49| (|l| $) (CONS 'CONCAT |l|))
(DEFUN |OUTFORM;vconcat;3$;50| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'VCONCAT $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'VCONCAT |a| |b|) $))
-(DEFUN |OUTFORM;vconcat;L$;51| (|l| $)
- (CONS (|OUTFORM;eform| 'VCONCAT $) |l|))
+(DEFUN |OUTFORM;vconcat;L$;51| (|l| $) (CONS 'VCONCAT |l|))
(DEFUN |OUTFORM;~=;3$;52| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "~=" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "~=" |a| |b|) $))
(DEFUN |OUTFORM;<;3$;53| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "<" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "<" |a| |b|) $))
(DEFUN |OUTFORM;>;3$;54| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| ">" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST ">" |a| |b|) $))
(DEFUN |OUTFORM;<=;3$;55| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "<=" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "<=" |a| |b|) $))
(DEFUN |OUTFORM;>=;3$;56| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| ">=" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST ">=" |a| |b|) $))
(DEFUN |OUTFORM;+;3$;57| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "+" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "+" |a| |b|) $))
(DEFUN |OUTFORM;-;3$;58| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "-" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "-" |a| |b|) $))
-(DEFUN |OUTFORM;-;2$;59| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "-" $) |a|) $))
+(DEFUN |OUTFORM;-;2$;59| (|a| $) (|OUTFORM;bless| (LIST "-" |a|) $))
(DEFUN |OUTFORM;*;3$;60| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "*" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "*" |a| |b|) $))
(DEFUN |OUTFORM;/;3$;61| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "/" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "/" |a| |b|) $))
(DEFUN |OUTFORM;**;3$;62| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "**" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "**" |a| |b|) $))
(DEFUN |OUTFORM;div;3$;63| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "div" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "div" |a| |b|) $))
(DEFUN |OUTFORM;rem;3$;64| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "rem" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "rem" |a| |b|) $))
(DEFUN |OUTFORM;quo;3$;65| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "quo" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "quo" |a| |b|) $))
(DEFUN |OUTFORM;exquo;3$;66| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "exquo" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "exquo" |a| |b|) $))
(DEFUN |OUTFORM;and;3$;67| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "and" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "and" |a| |b|) $))
(DEFUN |OUTFORM;or;3$;68| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "or" $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST "or" |a| |b|) $))
(DEFUN |OUTFORM;not;2$;69| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;sform| "not" $) |a|) $))
+ (|OUTFORM;bless| (LIST "not" |a|) $))
(DEFUN |OUTFORM;SEGMENT;3$;70| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'SEGMENT $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'SEGMENT |a| |b|) $))
(DEFUN |OUTFORM;SEGMENT;2$;71| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'SEGMENT $) |a|) $))
+ (|OUTFORM;bless| (LIST 'SEGMENT |a|) $))
(DEFUN |OUTFORM;binomial;3$;72| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'BINOMIAL $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'BINOMIAL |a| |b|) $))
-(DEFUN |OUTFORM;empty;$;73| ($)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'NOTHING $)) $))
+(DEFUN |OUTFORM;empty;$;73| ($) (|OUTFORM;bless| (LIST 'NOTHING) $))
(DEFUN |OUTFORM;infix?;$B;74| (|a| $)
- (PROG (#0=#:G1499 |e|)
+ (PROG (#0=#:G1544 |e|)
(RETURN
(SEQ (EXIT (SEQ (LETT |e|
(COND
@@ -361,57 +650,53 @@
(EXIT (COND ((GET |e| 'INFIXOP) 'T) ('T 'NIL)))))
#0# (EXIT #0#)))))
-(PUT '|OUTFORM;elt;$L$;75| '|SPADreplace| 'CONS)
-
(DEFUN |OUTFORM;elt;$L$;75| (|a| |l| $) (CONS |a| |l|))
(DEFUN |OUTFORM;prefix;$L$;76| (|a| |l| $)
(COND
((NULL (SPADCALL |a| (|getShellEntry| $ 98))) (CONS |a| |l|))
('T
- (SPADCALL |a|
- (SPADCALL (SPADCALL |l| (|getShellEntry| $ 52))
- (|getShellEntry| $ 62))
- (|getShellEntry| $ 38)))))
+ (|OUTFORM;hconcat;3$;48| |a|
+ (|OUTFORM;paren;2$;40| (|OUTFORM;commaSeparate;L$;33| |l| $)
+ $)
+ $))))
(DEFUN |OUTFORM;infix;$L$;77| (|a| |l| $)
(COND
- ((SPADCALL |l| (|getShellEntry| $ 68))
- (SPADCALL (|getShellEntry| $ 13)))
+ ((SPADCALL |l| (|getShellEntry| $ 68)) (|OUTFORM;empty;$;73| $))
((SPADCALL (SPADCALL |l| (|getShellEntry| $ 69))
(|getShellEntry| $ 68))
(SPADCALL |l| (|getShellEntry| $ 70)))
((SPADCALL |a| (|getShellEntry| $ 98)) (CONS |a| |l|))
('T
- (SPADCALL
+ (|OUTFORM;hconcat;L$;49|
(LIST (SPADCALL |l| (|getShellEntry| $ 70)) |a|
- (SPADCALL |a| (SPADCALL |l| (|getShellEntry| $ 69))
- (|getShellEntry| $ 101)))
- (|getShellEntry| $ 75)))))
+ (|OUTFORM;infix;$L$;77| |a|
+ (SPADCALL |l| (|getShellEntry| $ 69)) $))
+ $))))
(DEFUN |OUTFORM;infix;4$;78| (|a| |b| |c| $)
(COND
((SPADCALL |a| (|getShellEntry| $ 98))
(|OUTFORM;bless| (LIST |a| |b| |c|) $))
- ('T (SPADCALL (LIST |b| |a| |c|) (|getShellEntry| $ 75)))))
+ ('T (|OUTFORM;hconcat;L$;49| (LIST |b| |a| |c|) $))))
(DEFUN |OUTFORM;postfix;3$;79| (|a| |b| $)
- (SPADCALL |b| |a| (|getShellEntry| $ 38)))
+ (|OUTFORM;hconcat;3$;48| |b| |a| $))
(DEFUN |OUTFORM;string;2$;80| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'STRING $) |a|) $))
+ (|OUTFORM;bless| (LIST 'STRING |a|) $))
(DEFUN |OUTFORM;quote;2$;81| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'QUOTE $) |a|) $))
+ (|OUTFORM;bless| (LIST 'QUOTE |a|) $))
(DEFUN |OUTFORM;overbar;2$;82| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'OVERBAR $) |a|) $))
+ (|OUTFORM;bless| (LIST 'OVERBAR |a|) $))
-(DEFUN |OUTFORM;dot;2$;83| (|a| $)
- (SPADCALL |a| (|OUTFORM;sform| "." $) (|getShellEntry| $ 65)))
+(DEFUN |OUTFORM;dot;2$;83| (|a| $) (|OUTFORM;super;3$;43| |a| "." $))
(DEFUN |OUTFORM;prime;2$;84| (|a| $)
- (SPADCALL |a| (|OUTFORM;sform| "," $) (|getShellEntry| $ 65)))
+ (|OUTFORM;super;3$;43| |a| "," $))
(DEFUN |OUTFORM;dot;$Nni$;85| (|a| |nn| $)
(PROG (|s|)
@@ -420,8 +705,7 @@
(MAKE-FULL-CVEC |nn|
(SPADCALL "." (|getShellEntry| $ 109)))
|OUTFORM;dot;$Nni$;85|)
- (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $)
- (|getShellEntry| $ 65)))))))
+ (EXIT (|OUTFORM;super;3$;43| |a| |s| $))))))
(DEFUN |OUTFORM;prime;$Nni$;86| (|a| |nn| $)
(PROG (|s|)
@@ -430,45 +714,44 @@
(MAKE-FULL-CVEC |nn|
(SPADCALL "," (|getShellEntry| $ 109)))
|OUTFORM;prime;$Nni$;86|)
- (EXIT (SPADCALL |a| (|OUTFORM;sform| |s| $)
- (|getShellEntry| $ 65)))))))
+ (EXIT (|OUTFORM;super;3$;43| |a| |s| $))))))
(DEFUN |OUTFORM;overlabel;3$;87| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'OVERLABEL $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'OVERLABEL |a| |b|) $))
(DEFUN |OUTFORM;box;2$;88| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'BOX $) |a|) $))
+ (|OUTFORM;bless| (LIST 'BOX |a|) $))
(DEFUN |OUTFORM;zag;3$;89| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'ZAG $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'ZAG |a| |b|) $))
(DEFUN |OUTFORM;root;2$;90| (|a| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'ROOT $) |a|) $))
+ (|OUTFORM;bless| (LIST 'ROOT |a|) $))
(DEFUN |OUTFORM;root;3$;91| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'ROOT $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'ROOT |a| |b|) $))
(DEFUN |OUTFORM;over;3$;92| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'OVER $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'OVER |a| |b|) $))
(DEFUN |OUTFORM;slash;3$;93| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'SLASH $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'SLASH |a| |b|) $))
(DEFUN |OUTFORM;assign;3$;94| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'LET $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'LET |a| |b|) $))
(DEFUN |OUTFORM;label;3$;95| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'EQUATNUM $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'EQUATNUM |a| |b|) $))
(DEFUN |OUTFORM;rarrow;3$;96| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'TAG $) |a| |b|) $))
+ (|OUTFORM;bless| (LIST 'TAG |a| |b|) $))
(DEFUN |OUTFORM;differentiate;$Nni$;97| (|a| |nn| $)
- (PROG (#0=#:G1529 |r| |s|)
+ (PROG (#0=#:G1591 |r| |s|)
(RETURN
(SEQ (COND
((ZEROP |nn|) |a|)
- ((< |nn| 4) (SPADCALL |a| |nn| (|getShellEntry| $ 111)))
+ ((< |nn| 4) (|OUTFORM;prime;$Nni$;86| |a| |nn| $))
('T
(SEQ (LETT |r|
(SPADCALL
@@ -480,55 +763,43 @@
|OUTFORM;differentiate;$Nni$;97|)
(LETT |s| (SPADCALL |r| (|getShellEntry| $ 125))
|OUTFORM;differentiate;$Nni$;97|)
- (EXIT (SPADCALL |a|
- (SPADCALL (|OUTFORM;sform| |s| $)
- (|getShellEntry| $ 62))
- (|getShellEntry| $ 65))))))))))
+ (EXIT (|OUTFORM;super;3$;43| |a|
+ (|OUTFORM;paren;2$;40| |s| $) $)))))))))
(DEFUN |OUTFORM;sum;2$;98| (|a| $)
- (|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'SIGMA $)
- (SPADCALL (|getShellEntry| $ 13)) |a|)
- $))
+ (|OUTFORM;bless| (LIST 'SIGMA (|OUTFORM;empty;$;73| $) |a|) $))
(DEFUN |OUTFORM;sum;3$;99| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'SIGMA $) |b| |a|) $))
+ (|OUTFORM;bless| (LIST 'SIGMA |b| |a|) $))
(DEFUN |OUTFORM;sum;4$;100| (|a| |b| |c| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'SIGMA2 $) |b| |c| |a|) $))
+ (|OUTFORM;bless| (LIST 'SIGMA2 |b| |c| |a|) $))
(DEFUN |OUTFORM;prod;2$;101| (|a| $)
- (|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'PI $) (SPADCALL (|getShellEntry| $ 13))
- |a|)
- $))
+ (|OUTFORM;bless| (LIST 'PI (|OUTFORM;empty;$;73| $) |a|) $))
(DEFUN |OUTFORM;prod;3$;102| (|a| |b| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'PI $) |b| |a|) $))
+ (|OUTFORM;bless| (LIST 'PI |b| |a|) $))
(DEFUN |OUTFORM;prod;4$;103| (|a| |b| |c| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'PI2 $) |b| |c| |a|) $))
+ (|OUTFORM;bless| (LIST 'PI2 |b| |c| |a|) $))
(DEFUN |OUTFORM;int;2$;104| (|a| $)
(|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'INTSIGN $)
- (SPADCALL (|getShellEntry| $ 13))
- (SPADCALL (|getShellEntry| $ 13)) |a|)
+ (LIST 'INTSIGN (|OUTFORM;empty;$;73| $) (|OUTFORM;empty;$;73| $)
+ |a|)
$))
(DEFUN |OUTFORM;int;3$;105| (|a| |b| $)
- (|OUTFORM;bless|
- (LIST (|OUTFORM;eform| 'INTSIGN $) |b|
- (SPADCALL (|getShellEntry| $ 13)) |a|)
- $))
+ (|OUTFORM;bless| (LIST 'INTSIGN |b| (|OUTFORM;empty;$;73| $) |a|) $))
(DEFUN |OUTFORM;int;4$;106| (|a| |b| |c| $)
- (|OUTFORM;bless| (LIST (|OUTFORM;eform| 'INTSIGN $) |b| |c| |a|) $))
+ (|OUTFORM;bless| (LIST 'INTSIGN |b| |c| |a|) $))
(DEFUN |OutputForm| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1543)
+ (PROG (#0=#:G1618)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|OutputForm|)
diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp
index 719811d5..3503efb1 100644
--- a/src/algebra/strap/PI.lsp
+++ b/src/algebra/strap/PI.lsp
@@ -14,7 +14,7 @@
(DEFUN |PositiveInteger| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1398)
+ (PROG (#0=#:G1401)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|PositiveInteger|)
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index f9b376c2..c33191ee 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -1,9 +1,149 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |POLYCAT-;eval;SLS;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |POLYCAT-;monomials;SL;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;isPlus;SU;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;isTimes;SU;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;isExpt;SU;5|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |POLYCAT-;coefficient;SVarSetNniS;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |POLYCAT-;coefficient;SLLS;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |POLYCAT-;monomial;SLLS;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;retract;SVarSet;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;retractIfCan;SU;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;mkPrim|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |POLYCAT-;primitiveMonomials;SL;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |POLYCAT-;totalDegree;SNni;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|)
+ (|%IntegerSection| 0))
+ |POLYCAT-;totalDegree;SLNni;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |POLYCAT-;resultant;2SVarSetS;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;discriminant;SVarSetS;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
+ |POLYCAT-;allMonoms|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%List| (|%IntegerSection| 0) |%Shell|)
+ (|%Vector| *))
+ |POLYCAT-;P2R|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%List| |%Shell|) |%Thing|)
+ |POLYCAT-;eq2R|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;reducedSystem;MM;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|)
+ |POLYCAT-;reducedSystem;MVR;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;gcdPolynomial;3Sup;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;solveLinearPolynomialEquation;LSupU;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;factorPolynomial;SupF;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;factorSquareFreePolynomial;SupF;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;factor;SF;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;conditionP;MU;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |POLYCAT-;charthRoot;SU;28|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%List| (|%IntegerSection| 0) |%Shell|)
+ |%Pair|)
+ |POLYCAT-;charthRootlv|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Pair|)
+ |POLYCAT-;monicDivide;2SVarSetR;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;squareFree;SF;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;squareFree;SF;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;squareFree;SF;33|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;squareFreePart;2S;34|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;content;SVarSetS;35|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;primitivePart;2S;36|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;primitivePart;SVarSetS;37|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |POLYCAT-;<;2SB;38|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |POLYCAT-;patternMatch;SP2Pmr;39|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |POLYCAT-;patternMatch;SP2Pmr;40|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;convert;SP;41|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;convert;SP;42|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |POLYCAT-;convert;SIf;43|))
+
(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $)
- (PROG (#0=#:G1429 #1=#:G1423 #2=#:G1430 #3=#:G1431 |lvar| #4=#:G1432
- |e| #5=#:G1433)
+ (PROG (#0=#:G1686 #1=#:G1426 #2=#:G1687 #3=#:G1688 |lvar| #4=#:G1689
+ |e| #5=#:G1690)
(RETURN
(SEQ (COND
((NULL |l|) |p|)
@@ -121,7 +261,7 @@
('T (CONS 0 |l|))))))
(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $)
- (PROG (|lv| #0=#:G1455 |v| #1=#:G1456 |l| |r|)
+ (PROG (|lv| #0=#:G1691 |v| #1=#:G1692 |l| |r|)
(RETURN
(SEQ (COND
((OR (NULL (LETT |lv|
@@ -222,7 +362,7 @@
(CDR |lv|) (CDR |ln|) (|getShellEntry| $ 56)))))
(DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $)
- (PROG (#0=#:G1481 |q|)
+ (PROG (#0=#:G1477 |q|)
(RETURN
(SEQ (LETT |q|
(PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 43))
@@ -238,7 +378,7 @@
('T (|error| "Polynomial is not a single variable"))))))))
(DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $)
- (PROG (|q| #0=#:G1489)
+ (PROG (|q| #0=#:G1485)
(RETURN
(SEQ (EXIT (SEQ (SEQ (LETT |q|
(SPADCALL |p| (|getShellEntry| $ 43))
@@ -262,7 +402,7 @@
(|getShellEntry| $ 62)))
(DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $)
- (PROG (#0=#:G1494 |q| #1=#:G1495)
+ (PROG (#0=#:G1693 |q| #1=#:G1694)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |POLYCAT-;primitiveMonomials;SL;12|)
@@ -285,7 +425,7 @@
(GO G190) G191 (EXIT (NREVERSE0 #0#))))))))
(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $)
- (PROG (#0=#:G1497 |d| |u|)
+ (PROG (#0=#:G1491 |d| |u|)
(RETURN
(SEQ (COND
((SPADCALL |p| (|getShellEntry| $ 64)) 0)
@@ -325,7 +465,7 @@
(EXIT |d|))))))))
(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $)
- (PROG (#0=#:G1505 |v| |w| |d| |u|)
+ (PROG (#0=#:G1499 |v| |w| |d| |u|)
(RETURN
(SEQ (COND
((SPADCALL |p| (|getShellEntry| $ 64)) 0)
@@ -382,7 +522,7 @@
(|getShellEntry| $ 77)))
(DEFUN |POLYCAT-;allMonoms| (|l| $)
- (PROG (#0=#:G1517 |p| #1=#:G1518)
+ (PROG (#0=#:G1695 |p| #1=#:G1696)
(RETURN
(SEQ (SPADCALL
(SPADCALL
@@ -409,7 +549,7 @@
(|getShellEntry| $ 82))))))
(DEFUN |POLYCAT-;P2R| (|p| |b| |n| $)
- (PROG (|w| |bj| #0=#:G1523 |i| #1=#:G1522)
+ (PROG (|w| |bj| #0=#:G1698 |i| #1=#:G1697)
(RETURN
(SEQ (LETT |w|
(SPADCALL |n| (|spadConstant| $ 23)
@@ -438,7 +578,7 @@
(EXIT |w|)))))
(DEFUN |POLYCAT-;eq2R| (|l| |b| $)
- (PROG (#0=#:G1527 |bj| #1=#:G1528 #2=#:G1529 |p| #3=#:G1530)
+ (PROG (#0=#:G1699 |bj| #1=#:G1700 #2=#:G1701 |p| #3=#:G1702)
(RETURN
(SEQ (SPADCALL
(PROGN
@@ -488,7 +628,7 @@
(|getShellEntry| $ 92))))))
(DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $)
- (PROG (#0=#:G1539 |r| #1=#:G1540 |b| #2=#:G1541 |bj| #3=#:G1542 |d|
+ (PROG (#0=#:G1703 |r| #1=#:G1704 |b| #2=#:G1705 |bj| #3=#:G1706 |d|
|mm| |l|)
(RETURN
(SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95))
@@ -565,7 +705,7 @@
(EXIT |mm|)))))
(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $)
- (PROG (#0=#:G1551 |s| #1=#:G1552 |b| #2=#:G1553 |bj| #3=#:G1554 |d|
+ (PROG (#0=#:G1707 |s| #1=#:G1708 |b| #2=#:G1709 |bj| #3=#:G1710 |d|
|n| |mm| |w| |l| |r|)
(RETURN
(SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95))
@@ -672,8 +812,8 @@
(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)
+ (PROG (|v| |ansR| #0=#:G1711 |w| #1=#:G1712 |up| |ansSUP| #2=#:G1713
+ |ww| #3=#:G1714)
(RETURN
(SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 43))
|POLYCAT-;factor;SF;26|)
@@ -772,13 +912,13 @@
(|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)
+ (PROG (|ll| #0=#:G1715 |z| #1=#:G1716 |ch| |l| #2=#:G1717 #3=#:G1718
+ #4=#:G1580 #5=#:G1578 #6=#:G1579 #7=#:G1719 |vars| |degs|
+ #8=#:G1720 |d| #9=#:G1721 |nd| #10=#:G1607 #11=#:G1587
+ |deg1| |redmons| #12=#:G1722 |v| #13=#:G1724 |u|
+ #14=#:G1723 |llR| |monslist| |ans| #15=#:G1725
+ #16=#:G1726 |mons| #17=#:G1727 |m| #18=#:G1728 |i|
+ #19=#:G1603 #20=#:G1601 #21=#:G1602)
(RETURN
(SEQ (EXIT (SEQ (LETT |ll|
(SPADCALL
@@ -1141,7 +1281,7 @@
$))))))))))
(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $)
- (PROG (|v| |dd| |cp| |d| #0=#:G1668 |ans| |ansx| #1=#:G1675)
+ (PROG (|v| |dd| |cp| |d| #0=#:G1628 |ans| |ansx| #1=#:G1635)
(RETURN
(SEQ (EXIT (COND
((NULL |vars|)
@@ -1270,7 +1410,7 @@
(SPADCALL |p| (|getShellEntry| $ 167)))
(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $)
- (PROG (|s| |f| #0=#:G1691 #1=#:G1689 #2=#:G1687 #3=#:G1688)
+ (PROG (|s| |f| #0=#:G1729 #1=#:G1649 #2=#:G1647 #3=#:G1648)
(RETURN
(SEQ (SPADCALL
(SPADCALL
@@ -1316,7 +1456,7 @@
(|getShellEntry| $ 174)))
(DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $)
- (PROG (#0=#:G1694)
+ (PROG (#0=#:G1653)
(RETURN
(QVELT (SPADCALL
(PROG2 (LETT #0#
@@ -1332,7 +1472,7 @@
1))))
(DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $)
- (PROG (#0=#:G1700)
+ (PROG (#0=#:G1659)
(RETURN
(QVELT (SPADCALL
(PROG2 (LETT #0#
diff --git a/src/algebra/strap/POLYCAT.lsp b/src/algebra/strap/POLYCAT.lsp
index 1f53dc2e..69b15a81 100644
--- a/src/algebra/strap/POLYCAT.lsp
+++ b/src/algebra/strap/POLYCAT.lsp
@@ -5,22 +5,8 @@
(DEFPARAMETER |PolynomialCategory;AL| 'NIL)
-(DEFUN |PolynomialCategory| (&REST #0=#:G1415 &AUX #1=#:G1413)
- (DSETQ #1# #0#)
- (LET (#2=#:G1414)
- (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=#:G1412)
+ (PROG (#0=#:G1415)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -237,6 +223,20 @@
(LIST '|PolynomialCategory| (|devaluate| |t#1|)
(|devaluate| |t#2|) (|devaluate| |t#3|)))))))
+(DEFUN |PolynomialCategory| (&REST #0=#:G1418 &AUX #1=#:G1416)
+ (DSETQ #1# #0#)
+ (LET (#2=#:G1417)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|PolynomialCategory| '|isCategory| T
(|addModemap| '|PolynomialCategory|
diff --git a/src/algebra/strap/PRIMARR.lsp b/src/algebra/strap/PRIMARR.lsp
index 03f749e2..09b02a6b 100644
--- a/src/algebra/strap/PRIMARR.lsp
+++ b/src/algebra/strap/PRIMARR.lsp
@@ -1,12 +1,56 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION ((|%SimpleArray| *) |%Shell|)
+ (|%IntegerSection| 0))
+ |PRIMARR;#;$Nni;1|))
+
(PUT '|PRIMARR;#;$Nni;1| '|SPADreplace| '|sizeOfSimpleArray|)
-(DEFUN |PRIMARR;#;$Nni;1| (|x| $) (|sizeOfSimpleArray| |x|))
+(DECLAIM (FTYPE (FUNCTION ((|%SimpleArray| *) |%Shell|) |%Integer|)
+ |PRIMARR;minIndex;$I;2|))
(PUT '|PRIMARR;minIndex;$I;2| '|SPADreplace| '(XLAM (|x|) 0))
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%SimpleArray| *))
+ |PRIMARR;empty;$;3|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|)
+ (|%SimpleArray| *))
+ |PRIMARR;new;NniS$;4|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%SimpleArray| *) |%Integer| |%Shell|)
+ |%Thing|)
+ |PRIMARR;qelt;$IS;5|))
+
+(PUT '|PRIMARR;qelt;$IS;5| '|SPADreplace| '|getSimpleArrayEntry|)
+
+(DECLAIM (FTYPE (FUNCTION ((|%SimpleArray| *) |%Integer| |%Shell|)
+ |%Thing|)
+ |PRIMARR;elt;$IS;6|))
+
+(PUT '|PRIMARR;elt;$IS;6| '|SPADreplace| '|getSimpleArrayEntry|)
+
+(DECLAIM (FTYPE (FUNCTION
+ ((|%SimpleArray| *) |%Integer| |%Thing| |%Shell|)
+ |%Thing|)
+ |PRIMARR;qsetelt!;$I2S;7|))
+
+(PUT '|PRIMARR;qsetelt!;$I2S;7| '|SPADreplace| '|setSimpleArrayEntry|)
+
+(DECLAIM (FTYPE (FUNCTION
+ ((|%SimpleArray| *) |%Integer| |%Thing| |%Shell|)
+ |%Thing|)
+ |PRIMARR;setelt;$I2S;8|))
+
+(PUT '|PRIMARR;setelt;$I2S;8| '|SPADreplace| '|setSimpleArrayEntry|)
+
+(DECLAIM (FTYPE (FUNCTION ((|%SimpleArray| *) |%Thing| |%Shell|)
+ (|%SimpleArray| *))
+ |PRIMARR;fill!;$S$;9|))
+
+(DEFUN |PRIMARR;#;$Nni;1| (|x| $) (|sizeOfSimpleArray| |x|))
+
(DEFUN |PRIMARR;minIndex;$I;2| (|x| $) 0)
(DEFUN |PRIMARR;empty;$;3| ($)
@@ -15,28 +59,20 @@
(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=#:G1405)
+ (PROG (|i| #0=#:G1415)
(RETURN
(SEQ (SEQ (LETT |i| 0 |PRIMARR;fill!;$S$;9|)
(LETT #0# (|maxIndexOfSimpleArray| |x|)
@@ -47,10 +83,10 @@
G191 (EXIT NIL))
(EXIT |x|)))))
-(DEFUN |PrimitiveArray| (#0=#:G1413)
+(DEFUN |PrimitiveArray| (#0=#:G1416)
(PROG ()
(RETURN
- (PROG (#1=#:G1414)
+ (PROG (#1=#:G1417)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/PSETCAT-.lsp b/src/algebra/strap/PSETCAT-.lsp
index ea50f238..f0aa0b4c 100644
--- a/src/algebra/strap/PSETCAT-.lsp
+++ b/src/algebra/strap/PSETCAT-.lsp
@@ -1,6 +1,84 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |PSETCAT-;elements|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
+ |PSETCAT-;variables1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%List|)
+ |PSETCAT-;variables2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |PSETCAT-;variables;SL;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |PSETCAT-;mainVariables;SL;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;mainVariable?;VarSetSB;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |PSETCAT-;collectUnder;SVarSetS;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |PSETCAT-;collectUpper;SVarSetS;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |PSETCAT-;collect;SVarSetS;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Shell|)
+ |PSETCAT-;sort;SVarSetR;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;=;2SB;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;localInf?|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Boolean|)
+ |PSETCAT-;localTriangular?|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;triangular?;SB;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;trivialIdeal?;SB;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;roughUnitIdeal?;SB;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;relativelyPrimeLeadingMonomials?|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;roughBase?;SB;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;roughSubIdeal?;2SB;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |PSETCAT-;roughEqualIdeals?;2SB;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |PSETCAT-;exactQuo|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |PSETCAT-;headRemainder;PSR;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Shell|) |%Pair|)
+ |PSETCAT-;makeIrreducible!|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Shell|)
+ |PSETCAT-;remainder;PSR;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%List|)
+ |PSETCAT-;rewriteIdealWithHeadRemainder;LSL;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%List|)
+ |PSETCAT-;rewriteIdealWithRemainder;LSL;26|))
+
(DEFUN |PSETCAT-;elements| (|ps| $)
(PROG (|lp|)
(RETURN
@@ -8,7 +86,7 @@
|PSETCAT-;elements|))))
(DEFUN |PSETCAT-;variables1| (|lp| $)
- (PROG (#0=#:G1437 |p| #1=#:G1438 |lvars|)
+ (PROG (#0=#:G1558 |p| #1=#:G1559 |lvars|)
(RETURN
(SEQ (LETT |lvars|
(PROGN
@@ -41,7 +119,7 @@
(SPADCALL |#2| |#1| (|getShellEntry| $ 16)))
(DEFUN |PSETCAT-;variables2| (|lp| $)
- (PROG (#0=#:G1442 |p| #1=#:G1443 |lvars|)
+ (PROG (#0=#:G1560 |p| #1=#:G1561 |lvars|)
(RETURN
(SEQ (LETT |lvars|
(PROGN
@@ -220,7 +298,7 @@
(SPADCALL |ws| (|getShellEntry| $ 31))))))))
(DEFUN |PSETCAT-;=;2SB;11| (|ps1| |ps2| $)
- (PROG (#0=#:G1477 #1=#:G1478 #2=#:G1479 |p| #3=#:G1480)
+ (PROG (#0=#:G1562 #1=#:G1563 #2=#:G1564 |p| #3=#:G1565)
(RETURN
(SEQ (SPADCALL
(SPADCALL
@@ -399,7 +477,7 @@
('T 'NIL)))
(DEFUN |PSETCAT-;exactQuo| (|r| |s| $)
- (PROG (#0=#:G1512)
+ (PROG (#0=#:G1507)
(RETURN
(COND
((|HasCategory| (|getShellEntry| $ 7) '(|EuclideanDomain|))
diff --git a/src/algebra/strap/PSETCAT.lsp b/src/algebra/strap/PSETCAT.lsp
index ee7ff2fe..e5b90b16 100644
--- a/src/algebra/strap/PSETCAT.lsp
+++ b/src/algebra/strap/PSETCAT.lsp
@@ -5,23 +5,8 @@
(DEFPARAMETER |PolynomialSetCategory;AL| 'NIL)
-(DEFUN |PolynomialSetCategory| (&REST #0=#:G1431 &AUX #1=#:G1429)
- (DSETQ #1# #0#)
- (LET (#2=#:G1430)
- (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=#:G1428)
+ (PROG (#0=#:G1431)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -31,7 +16,7 @@
(|devaluate| |t#3|)
(|devaluate| |t#4|)))
(|sublisV|
- (PAIR '(#1=#:G1427) (LIST '(|List| |t#4|)))
+ (PAIR '(#1=#:G1430) (LIST '(|List| |t#4|)))
(COND
(|PolynomialSetCategory;CAT|)
('T
@@ -122,6 +107,21 @@
(|devaluate| |t#2|) (|devaluate| |t#3|)
(|devaluate| |t#4|)))))))
+(DEFUN |PolynomialSetCategory| (&REST #0=#:G1434 &AUX #1=#:G1432)
+ (DSETQ #1# #0#)
+ (LET (#2=#:G1433)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|PolynomialSetCategory| '|isCategory| T
(|addModemap| '|PolynomialSetCategory|
diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp
index 3ef776d0..00304cb1 100644
--- a/src/algebra/strap/QFCAT-.lsp
+++ b/src/algebra/strap/QFCAT-.lsp
@@ -1,6 +1,87 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;numerator;2A;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;denominator;2A;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |QFCAT-;init;A;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |QFCAT-;nextItem;AU;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;map;M2A;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;reducedSystem;MM;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
+ |QFCAT-;characteristic;Nni;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;differentiate;AMA;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;convert;AIf;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;convert;AF;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%DoubleFloat|)
+ |QFCAT-;convert;ADf;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |QFCAT-;<;2AB;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |QFCAT-;<;2AB;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |QFCAT-;<;2AB;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;fractionPart;2A;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;coerce;SA;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;retract;AS;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |QFCAT-;retractIfCan;AU;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;convert;AP;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |QFCAT-;patternMatch;AP2Pmr;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;convert;AP;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |QFCAT-;patternMatch;AP2Pmr;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |QFCAT-;coerce;FA;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Integer|)
+ |QFCAT-;retract;AI;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |QFCAT-;retractIfCan;AU;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |QFCAT-;random;A;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|)
+ |QFCAT-;reducedSystem;MVR;27|))
+
(DEFUN |QFCAT-;numerator;2A;1| (|x| $)
(SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/QFCAT.lsp b/src/algebra/strap/QFCAT.lsp
index 2ba4a22d..be400de3 100644
--- a/src/algebra/strap/QFCAT.lsp
+++ b/src/algebra/strap/QFCAT.lsp
@@ -5,20 +5,8 @@
(DEFPARAMETER |QuotientFieldCategory;AL| 'NIL)
-(DEFUN |QuotientFieldCategory| (#0=#:G1397)
- (LET (#1=#:G1398)
- (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=#:G1396)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -104,6 +92,18 @@
(SETELT #0# 0
(LIST '|QuotientFieldCategory| (|devaluate| |t#1|)))))))
+(DEFUN |QuotientFieldCategory| (#0=#:G1400)
+ (LET (#1=#:G1401)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|QuotientFieldCategory| '|isCategory| T
(|addModemap| '|QuotientFieldCategory|
diff --git a/src/algebra/strap/RCAGG-.lsp b/src/algebra/strap/RCAGG-.lsp
index 0546ebc4..599cc1a2 100644
--- a/src/algebra/strap/RCAGG-.lsp
+++ b/src/algebra/strap/RCAGG-.lsp
@@ -1,6 +1,16 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |RCAGG-;elt;AvalueS;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |RCAGG-;setelt;Avalue2S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |RCAGG-;child?;2AB;3|))
+
(DEFUN |RCAGG-;elt;AvalueS;1| (|x| T0 $)
(SPADCALL |x| (|getShellEntry| $ 8)))
diff --git a/src/algebra/strap/RCAGG.lsp b/src/algebra/strap/RCAGG.lsp
index e60f3c4e..c03c9f27 100644
--- a/src/algebra/strap/RCAGG.lsp
+++ b/src/algebra/strap/RCAGG.lsp
@@ -5,19 +5,8 @@
(DEFPARAMETER |RecursiveAggregate;AL| 'NIL)
-(DEFUN |RecursiveAggregate| (#0=#:G1395)
- (LET (#1=#:G1396)
- (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=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -73,6 +62,17 @@
. #1=(|RecursiveAggregate|))))) . #1#)
(SETELT #0# 0 (LIST '|RecursiveAggregate| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|RecursiveAggregate| '|isCategory| T
(|addModemap| '|RecursiveAggregate|
diff --git a/src/algebra/strap/REF.lsp b/src/algebra/strap/REF.lsp
index ae5ee5c3..8076a969 100644
--- a/src/algebra/strap/REF.lsp
+++ b/src/algebra/strap/REF.lsp
@@ -1,23 +1,42 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Pair| |%Shell|) |%Boolean|)
+ |REF;=;2$B;1|))
+
(PUT '|REF;=;2$B;1| '|SPADreplace| 'EQ)
-(DEFUN |REF;=;2$B;1| (|p| |q| $) (EQ |p| |q|))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|) |REF;ref;S$;2|))
(PUT '|REF;ref;S$;2| '|SPADreplace| 'LIST)
-(DEFUN |REF;ref;S$;2| (|v| $) (LIST |v|))
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Shell|) |%Thing|) |REF;elt;$S;3|))
(PUT '|REF;elt;$S;3| '|SPADreplace| 'QCAR)
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Thing| |%Shell|) |%Thing|)
+ |REF;setelt;$2S;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Shell|) |%Thing|)
+ |REF;deref;$S;5|))
+
+(PUT '|REF;deref;$S;5| '|SPADreplace| 'QCAR)
+
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Thing| |%Shell|) |%Thing|)
+ |REF;setref;$2S;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Pair| |%Shell|) |%Thing|)
+ |REF;coerce;$Of;7|))
+
+(DEFUN |REF;=;2$B;1| (|p| |q| $) (EQ |p| |q|))
+
+(DEFUN |REF;ref;S$;2| (|v| $) (LIST |v|))
+
(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| $)
@@ -28,10 +47,10 @@
(LIST (SPADCALL (QCAR |p|) (|getShellEntry| $ 18)))
(|getShellEntry| $ 20)))
-(DEFUN |Reference| (#0=#:G1403)
+(DEFUN |Reference| (#0=#:G1406)
(PROG ()
(RETURN
- (PROG (#1=#:G1404)
+ (PROG (#1=#:G1407)
(RETURN
(COND
((LETT #1#
diff --git a/src/algebra/strap/RING-.lsp b/src/algebra/strap/RING-.lsp
index dee3b20e..3ce200ae 100644
--- a/src/algebra/strap/RING-.lsp
+++ b/src/algebra/strap/RING-.lsp
@@ -1,6 +1,9 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Thing|)
+ |RING-;coerce;IS;1|))
+
(DEFUN |RING-;coerce;IS;1| (|n| $)
(SPADCALL |n| (|spadConstant| $ 7) (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/RING.lsp b/src/algebra/strap/RING.lsp
index de80c4c5..016a3ee0 100644
--- a/src/algebra/strap/RING.lsp
+++ b/src/algebra/strap/RING.lsp
@@ -3,11 +3,8 @@
(DEFPARAMETER |Ring;AL| 'NIL)
-(DEFUN |Ring| ()
- (LET (#:G1396) (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|))))))
-
(DEFUN |Ring;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|Rng|) (|Monoid|) (|LeftModule| '$)
@@ -22,6 +19,9 @@
|Ring|)
(SETELT #0# 0 '(|Ring|))))))
+(DEFUN |Ring| ()
+ (LET () (COND (|Ring;AL|) (T (SETQ |Ring;AL| (|Ring;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|Ring| '|isCategory| T
(|addModemap| '|Ring| '(|Ring|) '((|Category|)) T '|Ring|
diff --git a/src/algebra/strap/RNG.lsp b/src/algebra/strap/RNG.lsp
index b5b61715..6a2f53a5 100644
--- a/src/algebra/strap/RNG.lsp
+++ b/src/algebra/strap/RNG.lsp
@@ -3,15 +3,15 @@
(DEFPARAMETER |Rng;AL| 'NIL)
-(DEFUN |Rng| ()
- (LET (#:G1396) (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|))))))
-
(DEFUN |Rng;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0# (|Join| (|AbelianGroup|) (|SemiGroup|)) |Rng|)
(SETELT #0# 0 '(|Rng|))))))
+(DEFUN |Rng| ()
+ (LET () (COND (|Rng;AL|) (T (SETQ |Rng;AL| (|Rng;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|Rng| '|isCategory| T
(|addModemap| '|Rng| '(|Rng|) '((|Category|)) T '|Rng|
diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp
index 693f7a64..09bc6d11 100644
--- a/src/algebra/strap/RNS-.lsp
+++ b/src/algebra/strap/RNS-.lsp
@@ -1,8 +1,39 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
+ |RNS-;characteristic;Nni;1|))
+
(PUT '|RNS-;characteristic;Nni;1| '|SPADreplace| '(XLAM NIL 0))
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;fractionPart;2S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;truncate;2S;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;round;2S;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;norm;2S;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;coerce;FS;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;convert;SP;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;floor;2S;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |RNS-;ceiling;2S;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |RNS-;patternMatch;SP2Pmr;10|))
+
(DEFUN |RNS-;characteristic;Nni;1| ($) 0)
(DEFUN |RNS-;fractionPart;2S;2| (|x| $)
diff --git a/src/algebra/strap/RNS.lsp b/src/algebra/strap/RNS.lsp
index 6132cdab..2ece00ea 100644
--- a/src/algebra/strap/RNS.lsp
+++ b/src/algebra/strap/RNS.lsp
@@ -3,19 +3,13 @@
(DEFPARAMETER |RealNumberSystem;AL| 'NIL)
-(DEFUN |RealNumberSystem| ()
- (LET (#:G1405)
- (COND
- (|RealNumberSystem;AL|)
- (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|))))))
-
(DEFUN |RealNumberSystem;| ()
- (PROG (#0=#:G1403)
+ (PROG (#0=#:G1406)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1399 #2=#:G1400 #3=#:G1401
- #4=#:G1402)
+ (PAIR '(#1=#:G1402 #2=#:G1403 #3=#:G1404
+ #4=#:G1405)
(LIST '(|Integer|)
'(|Fraction| (|Integer|))
'(|Pattern| (|Float|)) '(|Float|)))
@@ -39,6 +33,12 @@
|RealNumberSystem|)
(SETELT #0# 0 '(|RealNumberSystem|))))))
+(DEFUN |RealNumberSystem| ()
+ (LET ()
+ (COND
+ (|RealNumberSystem;AL|)
+ (T (SETQ |RealNumberSystem;AL| (|RealNumberSystem;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|RealNumberSystem| '|isCategory| T
(|addModemap| '|RealNumberSystem| '(|RealNumberSystem|)
diff --git a/src/algebra/strap/SETAGG-.lsp b/src/algebra/strap/SETAGG-.lsp
index 99884fa8..103e4819 100644
--- a/src/algebra/strap/SETAGG-.lsp
+++ b/src/algebra/strap/SETAGG-.lsp
@@ -1,6 +1,18 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |SETAGG-;symmetricDifference;3A;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |SETAGG-;union;ASA;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |SETAGG-;union;S2A;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |SETAGG-;difference;ASA;4|))
+
(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| $)
(SPADCALL (SPADCALL |x| |y| (|getShellEntry| $ 8))
(SPADCALL |y| |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9)))
diff --git a/src/algebra/strap/SETAGG.lsp b/src/algebra/strap/SETAGG.lsp
index f3f7586e..37a253ed 100644
--- a/src/algebra/strap/SETAGG.lsp
+++ b/src/algebra/strap/SETAGG.lsp
@@ -5,19 +5,8 @@
(DEFPARAMETER |SetAggregate;AL| 'NIL)
-(DEFUN |SetAggregate| (#0=#:G1395)
- (LET (#1=#:G1396)
- (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=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -57,6 +46,17 @@
. #1=(|SetAggregate|))))) . #1#)
(SETELT #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|)))))))
+(DEFUN |SetAggregate| (#0=#:G1398)
+ (LET (#1=#:G1399)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|SetAggregate| '|isCategory| T
(|addModemap| '|SetAggregate| '(|SetAggregate| |#1|)
diff --git a/src/algebra/strap/SETCAT-.lsp b/src/algebra/strap/SETCAT-.lsp
index 57bf43e1..b7ec1f9d 100644
--- a/src/algebra/strap/SETCAT-.lsp
+++ b/src/algebra/strap/SETCAT-.lsp
@@ -1,13 +1,19 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Short|)
+ |SETCAT-;hash;SSi;1|))
+
(PUT '|SETCAT-;hash;SSi;1| '|SPADreplace| '(XLAM (|s|) 0))
-(DEFUN |SETCAT-;hash;SSi;1| (|s| $) 0)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
+ |SETCAT-;latex;SS;2|))
(PUT '|SETCAT-;latex;SS;2| '|SPADreplace|
'(XLAM (|s|) "\\mbox{\\bf Unimplemented}"))
+(DEFUN |SETCAT-;hash;SSi;1| (|s| $) 0)
+
(DEFUN |SETCAT-;latex;SS;2| (|s| $) "\\mbox{\\bf Unimplemented}")
(DEFUN |SetCategory&| (|#1|)
diff --git a/src/algebra/strap/SETCAT.lsp b/src/algebra/strap/SETCAT.lsp
index 3f239b87..2ea735a4 100644
--- a/src/algebra/strap/SETCAT.lsp
+++ b/src/algebra/strap/SETCAT.lsp
@@ -3,18 +3,12 @@
(DEFPARAMETER |SetCategory;AL| 'NIL)
-(DEFUN |SetCategory| ()
- (LET (#:G1397)
- (COND
- (|SetCategory;AL|)
- (T (SETQ |SetCategory;AL| (|SetCategory;|))))))
-
(DEFUN |SetCategory;| ()
- (PROG (#0=#:G1395)
+ (PROG (#0=#:G1398)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
- (PAIR '(#1=#:G1394) (LIST '(|OutputForm|)))
+ (PAIR '(#1=#:G1397) (LIST '(|OutputForm|)))
(|Join| (|BasicType|) (|CoercibleTo| '#1#)
(|mkCategory| '|domain|
'(((|hash| ((|SingleInteger|) $)) T)
@@ -24,6 +18,12 @@
|SetCategory|)
(SETELT #0# 0 '(|SetCategory|))))))
+(DEFUN |SetCategory| ()
+ (LET ()
+ (COND
+ (|SetCategory;AL|)
+ (T (SETQ |SetCategory;AL| (|SetCategory;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|SetCategory| '|isCategory| T
(|addModemap| '|SetCategory| '(|SetCategory|)
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index eb926f3d..83bfe0ac 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -1,6 +1,247 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Short| |%Shell|) |%Void|)
+ |SINT;writeOMSingleInt|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%String|)
+ |SINT;OMwrite;$S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Boolean| |%Shell|) |%String|)
+ |SINT;OMwrite;$BS;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Short| |%Shell|) |%Void|)
+ |SINT;OMwrite;Omd$V;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Short| |%Boolean| |%Shell|)
+ |%Void|)
+ |SINT;OMwrite;Omd$BV;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SINT;reducedSystem;MM;6|))
+
+(PUT '|SINT;reducedSystem;MM;6| '|SPADreplace| '(XLAM (|m|) |m|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Thing|)
+ |SINT;coerce;$Of;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Integer|)
+ |SINT;convert;$I;8|))
+
+(PUT '|SINT;convert;$I;8| '|SPADreplace| '(XLAM (|x|) |x|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Short| |%Shell|) |%Short|)
+ |SINT;*;I2$;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;Zero;$;10|))
+
+(PUT '|SINT;Zero;$;10| '|SPADreplace| '(XLAM NIL 0))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;One;$;11|))
+
+(PUT '|SINT;One;$;11| '|SPADreplace| '(XLAM NIL 1))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;base;$;12|))
+
+(PUT '|SINT;base;$;12| '|SPADreplace| '(XLAM NIL 2))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;max;$;13|))
+
+(PUT '|SINT;max;$;13| '|SPADreplace| '(XLAM NIL |$ShortMaximum|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;min;$;14|))
+
+(PUT '|SINT;min;$;14| '|SPADreplace| '(XLAM NIL |$ShortMinimum|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|)
+ |SINT;=;2$B;15|))
+
+(PUT '|SINT;=;2$B;15| '|SPADreplace| 'EQL)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;~;2$;16|))
+
+(PUT '|SINT;~;2$;16| '|SPADreplace| 'LOGNOT)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;not;2$;17|))
+
+(PUT '|SINT;not;2$;17| '|SPADreplace| 'LOGNOT)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;/\\;3$;18|))
+
+(PUT '|SINT;/\\;3$;18| '|SPADreplace| 'LOGAND)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;\\/;3$;19|))
+
+(PUT '|SINT;\\/;3$;19| '|SPADreplace| 'LOGIOR)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;Not;2$;20|))
+
+(PUT '|SINT;Not;2$;20| '|SPADreplace| 'LOGNOT)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;And;3$;21|))
+
+(PUT '|SINT;And;3$;21| '|SPADreplace| 'LOGAND)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;Or;3$;22|))
+
+(PUT '|SINT;Or;3$;22| '|SPADreplace| 'LOGIOR)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;xor;3$;23|))
+
+(PUT '|SINT;xor;3$;23| '|SPADreplace| 'LOGXOR)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|)
+ |SINT;<;2$B;24|))
+
+(PUT '|SINT;<;2$B;24| '|SPADreplace| 'QSLESSP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;inc;2$;25|))
+
+(PUT '|SINT;inc;2$;25| '|SPADreplace| 'QSADD1)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;dec;2$;26|))
+
+(PUT '|SINT;dec;2$;26| '|SPADreplace| 'QSSUB1)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;-;2$;27|))
+
+(PUT '|SINT;-;2$;27| '|SPADreplace| 'QSMINUS)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;+;3$;28|))
+
+(PUT '|SINT;+;3$;28| '|SPADreplace| 'QSPLUS)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;-;3$;29|))
+
+(PUT '|SINT;-;3$;29| '|SPADreplace| 'QSDIFFERENCE)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;*;3$;30|))
+
+(PUT '|SINT;*;3$;30| '|SPADreplace| 'QSTIMES)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| (|%IntegerSection| 0) |%Shell|)
+ |%Short|)
+ |SINT;**;$Nni$;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;quo;3$;32|))
+
+(PUT '|SINT;quo;3$;32| '|SPADreplace| 'QSQUOTIENT)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;rem;3$;33|))
+
+(PUT '|SINT;rem;3$;33| '|SPADreplace| 'QSREMAINDER)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Pair|)
+ |SINT;divide;2$R;34|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;gcd;3$;35|))
+
+(PUT '|SINT;gcd;3$;35| '|SPADreplace| 'GCD)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;abs;2$;36|))
+
+(PUT '|SINT;abs;2$;36| '|SPADreplace| 'QSABSVAL)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|)
+ |SINT;odd?;$B;37|))
+
+(PUT '|SINT;odd?;$B;37| '|SPADreplace| 'QSODDP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|)
+ |SINT;zero?;$B;38|))
+
+(PUT '|SINT;zero?;$B;38| '|SPADreplace| 'QSZEROP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|)
+ |SINT;one?;$B;39|))
+
+(PUT '|SINT;one?;$B;39| '|SPADreplace| '(XLAM (|x|) (EQL |x| 1)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;max;3$;40|))
+
+(PUT '|SINT;max;3$;40| '|SPADreplace| 'QSMAX)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;min;3$;41|))
+
+(PUT '|SINT;min;3$;41| '|SPADreplace| 'QSMIN)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;hash;2$;42|))
+
+(PUT '|SINT;hash;2$;42| '|SPADreplace| 'HASHEQ)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;length;2$;43|))
+
+(PUT '|SINT;length;2$;43| '|SPADreplace| 'INTEGER-LENGTH)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;shift;3$;44|))
+
+(PUT '|SINT;shift;3$;44| '|SPADreplace| 'QSLEFTSHIFT)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Short| |%Shell|)
+ |%Short|)
+ |SINT;mulmod;4$;45|))
+
+(PUT '|SINT;mulmod;4$;45| '|SPADreplace| 'QSMULTMOD)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Short| |%Shell|)
+ |%Short|)
+ |SINT;addmod;4$;46|))
+
+(PUT '|SINT;addmod;4$;46| '|SPADreplace| 'QSADDMOD)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Short| |%Shell|)
+ |%Short|)
+ |SINT;submod;4$;47|))
+
+(PUT '|SINT;submod;4$;47| '|SPADreplace| 'QSDIFMOD)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Boolean|)
+ |SINT;negative?;$B;48|))
+
+(PUT '|SINT;negative?;$B;48| '|SPADreplace| 'QSMINUSP)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|)
+ |SINT;reducedSystem;MVR;49|))
+
+(PUT '|SINT;reducedSystem;MVR;49| '|SPADreplace| 'CONS)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Short|)
+ |SINT;positiveRemainder;3$;50|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Short|)
+ |SINT;coerce;I$;51|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Short|) |SINT;random;$;52|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|)
+ |SINT;random;2$;53|))
+
+(PUT '|SINT;random;2$;53| '|SPADreplace| 'RANDOM)
+
+(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Shell|)
+ |SINT;unitNormal;$R;54|))
+
(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $)
(SEQ (COND
((QSLESSP |x| 0)
@@ -54,176 +295,96 @@
(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 |$ShortMaximum|))
-
(DEFUN |SINT;max;$;13| ($) |$ShortMaximum|)
-(PUT '|SINT;min;$;14| '|SPADreplace| '(XLAM NIL |$ShortMinimum|))
-
(DEFUN |SINT;min;$;14| ($) |$ShortMinimum|)
-(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| $)
@@ -250,8 +411,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| $)
@@ -262,7 +421,7 @@
(DEFUN |SingleInteger| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1488)
+ (PROG (#0=#:G1491)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|SingleInteger|)
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index b157d076..58ab78db 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -1,6 +1,48 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |STAGG-;explicitlyFinite?;AB;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |STAGG-;possiblyInfinite?;AB;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |STAGG-;first;ANniA;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |STAGG-;c2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |STAGG-;elt;AIS;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |STAGG-;elt;AUsA;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |STAGG-;concat;3A;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |STAGG-;concat;LA;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |STAGG-;map!;M2A;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |STAGG-;fill!;ASA;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Thing| |%Shell|)
+ |%Thing|)
+ |STAGG-;setelt;AI2S;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |STAGG-;setelt;AUs2S;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |STAGG-;concat!;3A;13|))
+
(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| $)
(SPADCALL (SPADCALL |x| (|getShellEntry| $ 9))
(|getShellEntry| $ 10)))
@@ -9,7 +51,7 @@
(SPADCALL |x| (|getShellEntry| $ 9)))
(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $)
- (PROG (#0=#:G1408 |i|)
+ (PROG (#0=#:G1452 |i|)
(RETURN
(SEQ (SPADCALL
(PROGN
@@ -37,7 +79,7 @@
('T (SPADCALL |x| (|getShellEntry| $ 19)))))
(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $)
- (PROG (#0=#:G1411)
+ (PROG (#0=#:G1413)
(RETURN
(SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))
|STAGG-;elt;AIS;5|)
@@ -57,7 +99,7 @@
(EXIT (SPADCALL |x| (|getShellEntry| $ 19)))))))
(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $)
- (PROG (|l| #0=#:G1415 |h| #1=#:G1417 #2=#:G1418)
+ (PROG (|l| #0=#:G1417 |h| #1=#:G1419 #2=#:G1420)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |i| (|getShellEntry| $ 25))
@@ -147,7 +189,7 @@
(EXIT |x|)))))
(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $)
- (PROG (#0=#:G1434)
+ (PROG (#0=#:G1436)
(RETURN
(SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))
|STAGG-;setelt;AI2S;11|)
@@ -167,7 +209,7 @@
(EXIT (SPADCALL |x| |s| (|getShellEntry| $ 37)))))))
(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $)
- (PROG (|l| |h| #0=#:G1439 #1=#:G1440 |z| |y|)
+ (PROG (|l| |h| #0=#:G1441 #1=#:G1442 |z| |y|)
(RETURN
(SEQ (LETT |l|
(- (SPADCALL |i| (|getShellEntry| $ 25))
diff --git a/src/algebra/strap/STAGG.lsp b/src/algebra/strap/STAGG.lsp
index 9da57f50..01d3f13a 100644
--- a/src/algebra/strap/STAGG.lsp
+++ b/src/algebra/strap/STAGG.lsp
@@ -5,19 +5,8 @@
(DEFPARAMETER |StreamAggregate;AL| 'NIL)
-(DEFUN |StreamAggregate| (#0=#:G1402)
- (LET (#1=#:G1403)
- (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=#:G1401)
+ (PROG (#0=#:G1404)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -40,6 +29,17 @@
. #1=(|StreamAggregate|))))) . #1#)
(SETELT #0# 0 (LIST '|StreamAggregate| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|StreamAggregate| '|isCategory| T
(|addModemap| '|StreamAggregate| '(|StreamAggregate| |#1|)
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index e2da054c..b6475da9 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -1,6 +1,118 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Void|)
+ |SYMBOL;writeOMSym|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
+ |SYMBOL;OMwrite;$S;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Boolean| |%Shell|) |%String|)
+ |SYMBOL;OMwrite;$BS;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Void|)
+ |SYMBOL;OMwrite;Omd$V;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Boolean| |%Shell|)
+ |%Void|)
+ |SYMBOL;OMwrite;Omd$BV;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;convert;$If;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;convert;2$;7|))
+
+(PUT '|SYMBOL;convert;2$;7| '|SPADreplace| '(XLAM (|s|) |s|))
+
+(DECLAIM (FTYPE (FUNCTION (|%String| |%Shell|) |%Thing|)
+ |SYMBOL;coerce;S$;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |SYMBOL;=;2$B;9|))
+
+(PUT '|SYMBOL;=;2$B;9| '|SPADreplace| 'EQUAL)
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |SYMBOL;<;2$B;10|))
+
+(PUT '|SYMBOL;<;2$B;10| '|SPADreplace|
+ '(XLAM (|x| |y|) (GGREATERP |y| |x|)))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;coerce;$Of;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |SYMBOL;subscript;$L$;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |SYMBOL;elt;$L$;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |SYMBOL;superscript;$L$;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |SYMBOL;argscript;$L$;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |SYMBOL;patternMatch;$P2Pmr;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |SYMBOL;patternMatch;$P2Pmr;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;convert;$P;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;convert;$P;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell| |%Shell|) |%String|)
+ |SYMBOL;syprefix|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell| |%Shell|) |%List|)
+ |SYMBOL;syscripts|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |SYMBOL;script;$L$;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell| |%Shell|) |%Thing|)
+ |SYMBOL;script;$R$;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
+ |SYMBOL;string;$S;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%String|)
+ |SYMBOL;latex;$S;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%String| |%Shell|) |%String|)
+ |SYMBOL;anyRadix|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |SYMBOL;new;$;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;new;2$;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Void|) |SYMBOL;resetNew;V;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |SYMBOL;scripted?;$B;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |SYMBOL;name;2$;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Shell|)
+ |SYMBOL;scripts;$R;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%String|)
+ |SYMBOL;istring|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |SYMBOL;list;$L;34|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |SYMBOL;sample;$;35|))
+
(DEFUN |SYMBOL;writeOMSym| (|dev| |x| $)
(COND
((SPADCALL |x| (|getShellEntry| $ 22))
@@ -55,35 +167,28 @@
(DEFUN |SYMBOL;convert;$If;6| (|s| $)
(SPADCALL |s| (|getShellEntry| $ 45)))
-(PUT '|SYMBOL;convert;2$;7| '|SPADreplace| '(XLAM (|s|) |s|))
-
(DEFUN |SYMBOL;convert;2$;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)))
+ (|SYMBOL;script;$L$;22| |sy| (LIST |lx| NIL NIL NIL NIL) $))
(DEFUN |SYMBOL;elt;$L$;13| (|sy| |lx| $)
- (SPADCALL |sy| |lx| (|getShellEntry| $ 57)))
+ (|SYMBOL;subscript;$L$;12| |sy| |lx| $))
(DEFUN |SYMBOL;superscript;$L$;14| (|sy| |lx| $)
- (SPADCALL |sy| (LIST NIL |lx| NIL NIL NIL) (|getShellEntry| $ 56)))
+ (|SYMBOL;script;$L$;22| |sy| (LIST NIL |lx| NIL NIL NIL) $))
(DEFUN |SYMBOL;argscript;$L$;15| (|sy| |lx| $)
- (SPADCALL |sy| (LIST NIL NIL NIL NIL |lx|) (|getShellEntry| $ 56)))
+ (|SYMBOL;script;$L$;22| |sy| (LIST NIL NIL NIL NIL |lx|) $))
(DEFUN |SYMBOL;patternMatch;$P2Pmr;16| (|x| |p| |l| $)
(SPADCALL |x| |p| |l| (|getShellEntry| $ 64)))
@@ -98,7 +203,7 @@
(SPADCALL |x| (|getShellEntry| $ 76)))
(DEFUN |SYMBOL;syprefix| (|sc| $)
- (PROG (|ns| #0=#:G1451 |n| #1=#:G1452)
+ (PROG (|ns| #0=#:G1548 |n| #1=#:G1549)
(RETURN
(SEQ (LETT |ns|
(LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2))
@@ -180,21 +285,20 @@
((NULL (NULL |ls|))
(SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|))
(EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|)))))
- (EXIT (SPADCALL |sy| |sc| (|getShellEntry| $ 82)))))))
+ (EXIT (|SYMBOL;script;$R$;23| |sy| |sc| $))))))
(DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $)
(COND
((SPADCALL |sy| (|getShellEntry| $ 22))
(|error| "Cannot add scripts to a scripted symbol"))
('T
- (CONS (SPADCALL
- (SPADCALL
+ (CONS (|SYMBOL;coerce;$Of;11|
+ (|SYMBOL;coerce;S$;8|
(STRCONC (|SYMBOL;syprefix| |sc| $)
- (SPADCALL
- (SPADCALL |sy| (|getShellEntry| $ 83))
- (|getShellEntry| $ 84)))
- (|getShellEntry| $ 48))
- (|getShellEntry| $ 53))
+ (|SYMBOL;string;$S;24|
+ (|SYMBOL;name;2$;31| |sy| $) $))
+ $)
+ $)
(|SYMBOL;syscripts| |sc| $)))))
(DEFUN |SYMBOL;string;$S;24| (|e| $)
@@ -205,7 +309,7 @@
(DEFUN |SYMBOL;latex;$S;25| (|e| $)
(PROG (|ss| |lo| |sc| |s|)
(RETURN
- (SEQ (LETT |s| (PNAME (SPADCALL |e| (|getShellEntry| $ 83)))
+ (SEQ (LETT |s| (PNAME (|SYMBOL;name;2$;31| |e| $))
|SYMBOL;latex;$S;25|)
(COND
((< 1 (QCSIZE |s|))
@@ -217,7 +321,7 @@
|SYMBOL;latex;$S;25|)))))
(COND
((NULL (SPADCALL |e| (|getShellEntry| $ 22))) (EXIT |s|)))
- (LETT |ss| (SPADCALL |e| (|getShellEntry| $ 87))
+ (LETT |ss| (|SYMBOL;scripts;$R;32| |e| $)
|SYMBOL;latex;$S;25|)
(LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|)
(COND
@@ -343,7 +447,7 @@
(EXIT |s|)))))
(DEFUN |SYMBOL;anyRadix| (|n| |s| $)
- (PROG (|qr| |ns| #0=#:G1502)
+ (PROG (|qr| |ns| #0=#:G1503)
(RETURN
(SEQ (EXIT (SEQ (LETT |ns| "" |SYMBOL;anyRadix|)
(EXIT (SEQ G190 NIL
@@ -385,7 +489,7 @@
(|getShellEntry| $ 93))
1)
(|getShellEntry| $ 94))
- (EXIT (SPADCALL (STRCONC "%" |sym|) (|getShellEntry| $ 48)))))))
+ (EXIT (|SYMBOL;coerce;S$;8| (STRCONC "%" |sym|) $))))))
(DEFUN |SYMBOL;new;2$;28| (|x| $)
(PROG (|u| |n| |xx|)
@@ -404,10 +508,10 @@
(LETT |xx|
(COND
((NULL (SPADCALL |x| (|getShellEntry| $ 22)))
- (SPADCALL |x| (|getShellEntry| $ 84)))
+ (|SYMBOL;string;$S;24| |x| $))
('T
- (SPADCALL (SPADCALL |x| (|getShellEntry| $ 83))
- (|getShellEntry| $ 84))))
+ (|SYMBOL;string;$S;24| (|SYMBOL;name;2$;31| |x| $)
+ $)))
|SYMBOL;new;2$;28|)
(LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|)
(LETT |xx|
@@ -431,13 +535,12 @@
|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)))))))
+ (EXIT (|SYMBOL;coerce;S$;8| |xx| $))))
+ (EXIT (|SYMBOL;script;$R$;23| (|SYMBOL;coerce;S$;8| |xx| $)
+ (|SYMBOL;scripts;$R;32| |x| $) $))))))
(DEFUN |SYMBOL;resetNew;V;29| ($)
- (PROG (|k| #0=#:G1525)
+ (PROG (|k| #0=#:G1550)
(RETURN
(SEQ (SPADCALL (|getShellEntry| $ 9) 0 (|getShellEntry| $ 94))
(SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|)
@@ -462,18 +565,17 @@
(SPADCALL (ATOM |sy|) (|getShellEntry| $ 88)))
(DEFUN |SYMBOL;name;2$;31| (|sy| $)
- (PROG (|str| |i| #0=#:G1532 #1=#:G1531 #2=#:G1529)
+ (PROG (|str| |i| #0=#:G1551 #1=#:G1531 #2=#:G1529)
(RETURN
(SEQ (EXIT (COND
((NULL (SPADCALL |sy| (|getShellEntry| $ 22))) |sy|)
('T
(SEQ (LETT |str|
- (SPADCALL
+ (|SYMBOL;string;$S;24|
(SPADCALL
- (SPADCALL |sy|
- (|getShellEntry| $ 107))
+ (|SYMBOL;list;$L;34| |sy| $)
(|getShellEntry| $ 108))
- (|getShellEntry| $ 84))
+ $)
|SYMBOL;name;2$;31|)
(SEQ (EXIT (SEQ
(LETT |i|
@@ -495,7 +597,7 @@
(LETT #2#
(PROGN
(LETT #1#
- (SPADCALL
+ (|SYMBOL;coerce;S$;8|
(SPADCALL |str|
(SPADCALL |i|
(QCSIZE |str|)
@@ -503,7 +605,7 @@
111))
(|getShellEntry| $
112))
- (|getShellEntry| $ 48))
+ $)
|SYMBOL;name;2$;31|)
(GO #1#))
|SYMBOL;name;2$;31|)
@@ -516,8 +618,8 @@
#1# (EXIT #1#)))))
(DEFUN |SYMBOL;scripts;$R;32| (|sy| $)
- (PROG (|lscripts| |str| |nstr| |j| #0=#:G1535 |nscripts| |m| |n|
- #1=#:G1544 |i| #2=#:G1545 |a| #3=#:G1546 |allscripts|)
+ (PROG (|lscripts| |str| |nstr| |j| #0=#:G1534 |nscripts| |m| |n|
+ #1=#:G1552 |i| #2=#:G1553 |a| #3=#:G1554 |allscripts|)
(RETURN
(SEQ (COND
((NULL (SPADCALL |sy| (|getShellEntry| $ 22)))
@@ -528,12 +630,10 @@
(LETT |lscripts| (LIST NIL NIL NIL NIL NIL)
|SYMBOL;scripts;$R;32|)
(LETT |str|
- (SPADCALL
- (SPADCALL
- (SPADCALL |sy|
- (|getShellEntry| $ 107))
+ (|SYMBOL;string;$S;24|
+ (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
(|getShellEntry| $ 108))
- (|getShellEntry| $ 84))
+ $)
|SYMBOL;scripts;$R;32|)
(LETT |nstr| (QCSIZE |str|) |SYMBOL;scripts;$R;32|)
(LETT |m|
@@ -574,8 +674,7 @@
(|getShellEntry| $ 116))
|SYMBOL;scripts;$R;32|)
(LETT |allscripts|
- (SPADCALL
- (SPADCALL |sy| (|getShellEntry| $ 107))
+ (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
(|getShellEntry| $ 117))
|SYMBOL;scripts;$R;32|)
(LETT |m|
@@ -623,8 +722,8 @@
(EXIT
(LETT #2#
(CONS
- (SPADCALL |a|
- (|getShellEntry| $ 53))
+ (|SYMBOL;coerce;$Of;11|
+ |a| $)
#2#)
|SYMBOL;scripts;$R;32|)))
(LETT #3# (CDR #3#)
@@ -665,13 +764,12 @@
(|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;sample;$;35| ($) (|SYMBOL;coerce;S$;8| "aSymbol" $))
(DEFUN |Symbol| ()
(PROG ()
(RETURN
- (PROG (#0=#:G1553)
+ (PROG (#0=#:G1556)
(RETURN
(COND
((LETT #0# (HGET |$ConstructorCache| '|Symbol|) |Symbol|)
diff --git a/src/algebra/strap/TSETCAT-.lsp b/src/algebra/strap/TSETCAT-.lsp
index dcd1eca4..da0e9e85 100644
--- a/src/algebra/strap/TSETCAT-.lsp
+++ b/src/algebra/strap/TSETCAT-.lsp
@@ -1,8 +1,129 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;=;2SB;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;infRittWu?;2SB;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Boolean|)
+ |TSETCAT-;reduced?;PSMB;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;basicSet;LMU;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;basicSet;LMMU;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |TSETCAT-;initials;SL;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |TSETCAT-;degree;SNni;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;quasiComponent;SR;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;normalized?;PSB;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;stronglyReduced?;PSB;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;headReduced?;PSB;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;initiallyReduced?;PSB;12|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |TSETCAT-;reduce;PSMMP;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Thing| |%Thing| |%Shell|)
+ |%List|)
+ |TSETCAT-;rewriteSetWithReduction;LSMML;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;stronglyReduce;PSP;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;headReduce;PSP;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;initiallyReduce;PSP;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;removeZero;PSP;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;reduceByQuasiMonic;PSP;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;autoReduced?;SMB;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;stronglyReduced?;SB;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;normalized?;SB;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;headReduced?;SB;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;initiallyReduced?;SB;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;mvar;SV;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;first;SU;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;last;SU;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;rest;SU;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |TSETCAT-;coerce;SL;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |TSETCAT-;algebraicVariables;SL;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |TSETCAT-;algebraic?;VSB;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |TSETCAT-;select;SVU;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;collectQuasiMonic;2S;33|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;collectUnder;SVS;34|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;collectUpper;SVS;35|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Thing|)
+ |TSETCAT-;construct;LS;36|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) |%Pair|)
+ |TSETCAT-;retractIfCan;LU;37|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |TSETCAT-;extend;SPS;38|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |TSETCAT-;coHeight;SNni;39|))
+
(DEFUN |TSETCAT-;=;2SB;1| (|ts| |us| $)
- (PROG (#0=#:G1453 #1=#:G1459)
+ (PROG (#0=#:G1456 #1=#:G1462)
(RETURN
(COND
((SPADCALL |ts| (|getShellEntry| $ 12))
@@ -38,7 +159,7 @@
(|getShellEntry| $ 18)))))))
(DEFUN |TSETCAT-;infRittWu?;2SB;2| (|ts| |us| $)
- (PROG (|p| #0=#:G1466 |q| |v|)
+ (PROG (|p| #0=#:G1469 |q| |v|)
(RETURN
(SEQ (COND
((SPADCALL |us| (|getShellEntry| $ 12))
@@ -376,7 +497,7 @@
(EXIT |red|)))))
(DEFUN |TSETCAT-;reduce;PSMMP;13| (|p| |ts| |redOp| |redOp?| $)
- (PROG (|ts0| #0=#:G1541 |reductor| #1=#:G1544)
+ (PROG (|ts0| #0=#:G1544 |reductor| #1=#:G1547)
(RETURN
(SEQ (COND
((OR (SPADCALL |ts| (|getShellEntry| $ 12))
@@ -502,7 +623,7 @@
(SPADCALL |p| |ts| (ELT $ 79) (ELT $ 80) (|getShellEntry| $ 72)))
(DEFUN |TSETCAT-;removeZero;PSP;18| (|p| |ts| $)
- (PROG (|v| |tsv-| #0=#:G1567 #1=#:G1576 |q|)
+ (PROG (|v| |tsv-| #0=#:G1570 #1=#:G1579 |q|)
(RETURN
(SEQ (EXIT (COND
((OR (SPADCALL |p| (|getShellEntry| $ 35))
@@ -636,7 +757,7 @@
(SPADCALL |ts| (ELT $ 106) (|getShellEntry| $ 101)))
(DEFUN |TSETCAT-;mvar;SV;25| (|ts| $)
- (PROG (#0=#:G1595)
+ (PROG (#0=#:G1598)
(RETURN
(COND
((SPADCALL |ts| (|getShellEntry| $ 12))
@@ -696,7 +817,7 @@
(|getShellEntry| $ 37)))
(DEFUN |TSETCAT-;algebraicVariables;SL;30| (|ts| $)
- (PROG (#0=#:G1620 |p| #1=#:G1621)
+ (PROG (#0=#:G1666 |p| #1=#:G1667)
(RETURN
(SEQ (PROGN
(LETT #0# NIL |TSETCAT-;algebraicVariables;SL;30|)
@@ -866,7 +987,7 @@
(|error| "in extend : ($,P) -> $ from TSETCAT : bad ars"))))))))
(DEFUN |TSETCAT-;coHeight;SNni;39| (|ts| $)
- (PROG (|n| |m| #0=#:G1661)
+ (PROG (|n| |m| #0=#:G1662)
(RETURN
(SEQ (LETT |n| (SPADCALL (|getShellEntry| $ 128))
|TSETCAT-;coHeight;SNni;39|)
diff --git a/src/algebra/strap/TSETCAT.lsp b/src/algebra/strap/TSETCAT.lsp
index a99c4402..12fb6a33 100644
--- a/src/algebra/strap/TSETCAT.lsp
+++ b/src/algebra/strap/TSETCAT.lsp
@@ -5,23 +5,8 @@
(DEFPARAMETER |TriangularSetCategory;AL| 'NIL)
-(DEFUN |TriangularSetCategory| (&REST #0=#:G1448 &AUX #1=#:G1446)
- (DSETQ #1# #0#)
- (LET (#2=#:G1447)
- (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=#:G1445)
+ (PROG (#0=#:G1448)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -199,6 +184,21 @@
(|devaluate| |t#2|) (|devaluate| |t#3|)
(|devaluate| |t#4|)))))))
+(DEFUN |TriangularSetCategory| (&REST #0=#:G1451 &AUX #1=#:G1449)
+ (DSETQ #1# #0#)
+ (LET (#2=#:G1450)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|TriangularSetCategory| '|isCategory| T
(|addModemap| '|TriangularSetCategory|
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp
index 26e633da..1b71367c 100644
--- a/src/algebra/strap/UFD-.lsp
+++ b/src/algebra/strap/UFD-.lsp
@@ -1,8 +1,14 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UFD-;squareFreePart;2S;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |UFD-;prime?;SB;2|))
+
(DEFUN |UFD-;squareFreePart;2S;1| (|x| $)
- (PROG (|s| |f| #0=#:G1405 #1=#:G1403 #2=#:G1401 #3=#:G1402)
+ (PROG (|s| |f| #0=#:G1419 #1=#:G1406 #2=#:G1404 #3=#:G1405)
(RETURN
(SEQ (SPADCALL
(SPADCALL
diff --git a/src/algebra/strap/UFD.lsp b/src/algebra/strap/UFD.lsp
index ca8cedeb..f92b4bf5 100644
--- a/src/algebra/strap/UFD.lsp
+++ b/src/algebra/strap/UFD.lsp
@@ -3,15 +3,8 @@
(DEFPARAMETER |UniqueFactorizationDomain;AL| 'NIL)
-(DEFUN |UniqueFactorizationDomain| ()
- (LET (#:G1396)
- (COND
- (|UniqueFactorizationDomain;AL|)
- (T (SETQ |UniqueFactorizationDomain;AL|
- (|UniqueFactorizationDomain;|))))))
-
(DEFUN |UniqueFactorizationDomain;| ()
- (PROG (#0=#:G1394)
+ (PROG (#0=#:G1397)
(RETURN
(PROG1 (LETT #0#
(|Join| (|GcdDomain|)
@@ -24,6 +17,13 @@
|UniqueFactorizationDomain|)
(SETELT #0# 0 '(|UniqueFactorizationDomain|))))))
+(DEFUN |UniqueFactorizationDomain| ()
+ (LET ()
+ (COND
+ (|UniqueFactorizationDomain;AL|)
+ (T (SETQ |UniqueFactorizationDomain;AL|
+ (|UniqueFactorizationDomain;|))))))
+
(SETQ |$CategoryFrame|
(|put| '|UniqueFactorizationDomain| '|isCategory| T
(|addModemap| '|UniqueFactorizationDomain|
diff --git a/src/algebra/strap/ULSCAT.lsp b/src/algebra/strap/ULSCAT.lsp
index 5992b652..e87c6157 100644
--- a/src/algebra/strap/ULSCAT.lsp
+++ b/src/algebra/strap/ULSCAT.lsp
@@ -5,29 +5,14 @@
(DEFPARAMETER |UnivariateLaurentSeriesCategory;AL| 'NIL)
-(DEFUN |UnivariateLaurentSeriesCategory| (#0=#:G1397)
- (LET (#1=#:G1398)
- (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=#:G1396)
+ (PROG (#0=#:G1399)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
(PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
(|sublisV|
- (PAIR '(#1=#:G1395) (LIST '(|Integer|)))
+ (PAIR '(#1=#:G1398) (LIST '(|Integer|)))
(COND
(|UnivariateLaurentSeriesCategory;CAT|)
('T
@@ -112,6 +97,21 @@
(LIST '|UnivariateLaurentSeriesCategory|
(|devaluate| |t#1|)))))))
+(DEFUN |UnivariateLaurentSeriesCategory| (#0=#:G1400)
+ (LET (#1=#:G1401)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|UnivariateLaurentSeriesCategory| '|isCategory| T
(|addModemap| '|UnivariateLaurentSeriesCategory|
diff --git a/src/algebra/strap/UPOLYC-.lsp b/src/algebra/strap/UPOLYC-.lsp
index c6c77d4b..ceef39e9 100644
--- a/src/algebra/strap/UPOLYC-.lsp
+++ b/src/algebra/strap/UPOLYC-.lsp
@@ -1,6 +1,179 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |UPOLYC-;variables;SL;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|)
+ (|%IntegerSection| 0))
+ |UPOLYC-;degree;SSaosNni;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|)
+ (|%IntegerSection| 0))
+ |UPOLYC-;totalDegree;SLNni;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|)
+ |UPOLYC-;degree;SLL;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |UPOLYC-;eval;SLLS;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |UPOLYC-;eval;SSaos2S;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%List| |%Shell|) |%Thing|)
+ |UPOLYC-;eval;SLLS;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |UPOLYC-;eval;SSaosRS;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |UPOLYC-;eval;SLS;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;mainVariable;SU;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|)
+ (|%IntegerSection| 0))
+ |UPOLYC-;minimumDegree;SSaosNni;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%List|)
+ |UPOLYC-;minimumDegree;SLL;12|))
+
+(DECLAIM (FTYPE (FUNCTION
+ (|%Thing| |%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |UPOLYC-;monomial;SSaosNniS;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;coerce;SaosS;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;makeSUP;SSup;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;unmakeSUP;SupS;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Pair|)
+ |UPOLYC-;karatsubaDivide;SNniR;17|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |UPOLYC-;shiftRight;SNniS;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |UPOLYC-;shiftLeft;SNniS;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;solveLinearPolynomialEquation;LSupU;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;factorPolynomial;SupF;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;factorSquareFreePolynomial;SupF;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;factor;SF;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ (|%Vector| *))
+ |UPOLYC-;vectorise;SNniV;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;retract;SR;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;retractIfCan;SU;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |UPOLYC-;init;S;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;nextItemInner|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;nextItem;SU;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;content;SSaosS;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;primeFactor|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;separate;2SR;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |UPOLYC-;differentiate;SM2S;33|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) |%Thing| |%Shell|)
+ |%Thing|)
+ |UPOLYC-;ncdiff|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |UPOLYC-;differentiate;SM2S;35|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;differentiate;SMS;36|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;differentiate;2S;37|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;differentiate;SSaosS;38|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;elt;3F;39|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;pseudoQuotient;3S;40|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Shell|)
+ |UPOLYC-;pseudoDivide;2SR;41|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;composite;FSU;42|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;composite;2SU;43|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;elt;S2F;44|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|)
+ (|%IntegerSection| 0))
+ |UPOLYC-;order;2SNni;45|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;squareFree;SF;46|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;squareFreePart;2S;47|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;gcdPolynomial;3Sup;48|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;squareFreePolynomial;SupF;49|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;elt;F2R;50|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |UPOLYC-;euclideanSize;SNni;51|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Pair|)
+ |UPOLYC-;divide;2SR;52|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |UPOLYC-;integrate;2S;53|))
+
(DEFUN |UPOLYC-;variables;SL;1| (|p| $)
(COND
((OR (SPADCALL |p| (|getShellEntry| $ 9))
@@ -135,7 +308,7 @@
(SPADCALL |pp| (|getShellEntry| $ 87)))
(DEFUN |UPOLYC-;factor;SF;23| (|p| $)
- (PROG (|ansR| #0=#:G1518 |w| #1=#:G1519)
+ (PROG (|ansR| #0=#:G1732 |w| #1=#:G1733)
(RETURN
(SEQ (COND
((ZEROP (SPADCALL |p| (|getShellEntry| $ 11)))
@@ -187,7 +360,7 @@
(|getShellEntry| $ 106))))))))
(DEFUN |UPOLYC-;vectorise;SNniV;24| (|p| |n| $)
- (PROG (|v| |m| |i| #0=#:G1524 #1=#:G1520)
+ (PROG (|v| |m| |i| #0=#:G1734 #1=#:G1521)
(RETURN
(SEQ (LETT |m|
(SPADCALL
diff --git a/src/algebra/strap/UPOLYC.lsp b/src/algebra/strap/UPOLYC.lsp
index 358e514f..a84a5c3a 100644
--- a/src/algebra/strap/UPOLYC.lsp
+++ b/src/algebra/strap/UPOLYC.lsp
@@ -5,29 +5,14 @@
(DEFPARAMETER |UnivariatePolynomialCategory;AL| 'NIL)
-(DEFUN |UnivariatePolynomialCategory| (#0=#:G1433)
- (LET (#1=#:G1434)
- (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=#:G1432)
+ (PROG (#0=#:G1435)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
(PAIR '(|t#1|) (LIST (|devaluate| |t#1|)))
(|sublisV|
- (PAIR '(#1=#:G1430 #2=#:G1431)
+ (PAIR '(#1=#:G1433 #2=#:G1434)
(LIST '(|NonNegativeInteger|)
'(|SingletonAsOrderedSet|)))
(COND
@@ -157,6 +142,21 @@
(LIST '|UnivariatePolynomialCategory|
(|devaluate| |t#1|)))))))
+(DEFUN |UnivariatePolynomialCategory| (#0=#:G1436)
+ (LET (#1=#:G1437)
+ (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#))))
+
(SETQ |$CategoryFrame|
(|put| '|UnivariatePolynomialCategory| '|isCategory| T
(|addModemap| '|UnivariatePolynomialCategory|
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 66fba802..9fb56330 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -1,6 +1,113 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |URAGG-;elt;AfirstS;1|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |URAGG-;elt;AlastS;2|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |URAGG-;elt;ArestA;3|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;second;AS;4|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;third;AS;5|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |URAGG-;cyclic?;AB;6|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;last;AS;7|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |URAGG-;nodes;AL;8|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%List|)
+ |URAGG-;children;AL;9|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
+ |URAGG-;leaf?;AB;10|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;value;AS;11|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Boolean|)
+ |URAGG-;less?;ANniB;12|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Boolean|)
+ |URAGG-;more?;ANniB;13|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Boolean|)
+ |URAGG-;size?;ANniB;14|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |URAGG-;#;ANni;15|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;tail;2A;16|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;findCycle|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;cycleTail;2A;18|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;cycleEntry;2A;19|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) (|%IntegerSection| 0))
+ |URAGG-;cycleLength;ANni;20|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |URAGG-;rest;ANniA;21|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%IntegerSection| 0) |%Shell|)
+ |%Thing|)
+ |URAGG-;last;ANniA;22|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |URAGG-;=;2AB;23|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Boolean|)
+ |URAGG-;node?;2AB;24|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |URAGG-;setelt;Afirst2S;25|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |URAGG-;setelt;Alast2S;26|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Thing| |%Shell|)
+ |%Thing|)
+ |URAGG-;setelt;Arest2A;27|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |URAGG-;concat;3A;28|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |URAGG-;setlast!;A2S;29|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%List| |%Shell|) |%Thing|)
+ |URAGG-;setchildren!;ALA;30|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Thing| |%Shell|) |%Thing|)
+ |URAGG-;setvalue!;A2S;31|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Integer| |%Shell|) |%Thing|)
+ |URAGG-;split!;AIA;32|))
+
+(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Thing|)
+ |URAGG-;cycleSplit!;2A;33|))
+
(DEFUN |URAGG-;elt;AfirstS;1| (|x| T0 $)
(SPADCALL |x| (|getShellEntry| $ 8)))
@@ -180,7 +287,7 @@
(EXIT |x|))))))))
(DEFUN |URAGG-;findCycle| (|x| $)
- (PROG (#0=#:G1472 |y|)
+ (PROG (#0=#:G1475 |y|)
(RETURN
(SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14))
|URAGG-;findCycle|)
@@ -356,7 +463,7 @@
(EXIT |x|)))))
(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $)
- (PROG (|m| #0=#:G1495)
+ (PROG (|m| #0=#:G1498)
(RETURN
(SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 43))
|URAGG-;last;ANniA;22|)
@@ -373,7 +480,7 @@
(|getShellEntry| $ 45)))))))))
(DEFUN |URAGG-;=;2AB;23| (|x| |y| $)
- (PROG (|k| #0=#:G1505)
+ (PROG (|k| #0=#:G1508)
(RETURN
(SEQ (EXIT (COND
((SPADCALL |x| |y| (|getShellEntry| $ 37)) 'T)
@@ -428,7 +535,7 @@
#0# (EXIT #0#)))))
(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $)
- (PROG (|k| #0=#:G1510)
+ (PROG (|k| #0=#:G1513)
(RETURN
(SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190
(COND
@@ -497,7 +604,7 @@
(SPADCALL |u| |s| (|getShellEntry| $ 51)))
(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $)
- (PROG (#0=#:G1521 |q|)
+ (PROG (#0=#:G1524 |q|)
(RETURN
(SEQ (COND
((< |n| 1) (|error| "index out of range"))
diff --git a/src/algebra/strap/URAGG.lsp b/src/algebra/strap/URAGG.lsp
index 6ead382f..9cd5bea8 100644
--- a/src/algebra/strap/URAGG.lsp
+++ b/src/algebra/strap/URAGG.lsp
@@ -5,21 +5,8 @@
(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL)
-(DEFUN |UnaryRecursiveAggregate| (#0=#:G1423)
- (LET (#1=#:G1424)
- (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=#:G1422)
+ (PROG (#0=#:G1425)
(RETURN
(PROG1 (LETT #0#
(|sublisV|
@@ -112,6 +99,19 @@
(SETELT #0# 0
(LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|)))))))
+(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#))))
+
(SETQ |$CategoryFrame|
(|put| '|UnaryRecursiveAggregate| '|isCategory| T
(|addModemap| '|UnaryRecursiveAggregate|
diff --git a/src/algebra/strap/VECTOR.lsp b/src/algebra/strap/VECTOR.lsp
index ecbc5ece..3fb2fb67 100644
--- a/src/algebra/strap/VECTOR.lsp
+++ b/src/algebra/strap/VECTOR.lsp
@@ -1,6 +1,12 @@
(/VERSIONCHECK 2)
+(DECLAIM (FTYPE (FUNCTION (|%List| |%Shell|) (|%Vector| *))
+ |VECTOR;vector;L$;1|))
+
+(DECLAIM (FTYPE (FUNCTION ((|%Vector| *) |%Shell|) |%Thing|)
+ |VECTOR;convert;$If;2|))
+
(DEFUN |VECTOR;vector;L$;1| (|l| $)
(SPADCALL |l| (|getShellEntry| $ 8)))
@@ -12,10 +18,10 @@
(|getShellEntry| $ 16)))
(|getShellEntry| $ 18)))
-(DEFUN |Vector| (#0=#:G1404)
+(DEFUN |Vector| (#0=#:G1407)
(PROG ()
(RETURN
- (PROG (#1=#:G1405)
+ (PROG (#1=#:G1408)
(RETURN
(COND
((LETT #1#