diff options
| author | dos-reis <gdr@axiomatics.org> | 2008-10-11 21:16:28 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2008-10-11 21:16:28 +0000 |
| commit | 5687e549faf2a00133c91dd21b48d876e0e2c449 (patch) | |
| tree | 81c27b56ba305a55c7aba8442ff36f7333096050 /src/algebra | |
| parent | 567d3bbfc92aad2305987e3d6adedcb92615d5d5 (diff) | |
| download | open-axiom-5687e549faf2a00133c91dd21b48d876e0e2c449.tar.gz | |
Update algebra bootstrap cache.
Diffstat (limited to 'src/algebra')
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# |