aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/DFLOAT.lsp7
-rw-r--r--src/algebra/strap/INT.lsp7
-rw-r--r--src/algebra/strap/ISTRING.lsp7
-rw-r--r--src/algebra/strap/OUTFORM.lsp52
-rw-r--r--src/algebra/strap/SINT.lsp18
5 files changed, 64 insertions, 27 deletions
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 9795065f..61278b24 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -93,6 +93,9 @@
|%Boolean|)
|DFLOAT;<=;2$B;22|))
+(PUT '|DFLOAT;<=;2$B;22| '|SPADreplace|
+ '(XLAM (|x| |y|) (NOT (> |x| |y|))))
+
(DECLAIM (FTYPE (FUNCTION (|%DoubleFloat| |%DoubleFloat| |%Shell|)
|%Boolean|)
|DFLOAT;>=;2$B;23|))
@@ -504,7 +507,9 @@
(DEFUN |DFLOAT;>;2$B;21| (|x| |y| $) (DECLARE (IGNORE $)) (> |x| |y|))
-(DEFUN |DFLOAT;<=;2$B;22| (|x| |y| $) (NOT (> |x| |y|)))
+(DEFUN |DFLOAT;<=;2$B;22| (|x| |y| $)
+ (DECLARE (IGNORE $))
+ (NOT (> |x| |y|)))
(DEFUN |DFLOAT;>=;2$B;23| (|x| |y| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index 39bb22ff..8640f50b 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -160,6 +160,9 @@
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|)
|INT;<=;2$B;37|))
+(PUT '|INT;<=;2$B;37| '|SPADreplace|
+ '(XLAM (|x| |y|) (NOT (> |x| |y|))))
+
(DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|)
|INT;>=;2$B;38|))
@@ -411,7 +414,9 @@
(DEFUN |INT;>;2$B;36| (|x| |y| $) (DECLARE (IGNORE $)) (> |x| |y|))
-(DEFUN |INT;<=;2$B;37| (|x| |y| $) (NOT (> |x| |y|)))
+(DEFUN |INT;<=;2$B;37| (|x| |y| $)
+ (DECLARE (IGNORE $))
+ (NOT (> |x| |y|)))
(DEFUN |INT;>=;2$B;38| (|x| |y| $) (DECLARE (IGNORE $)) (>= |x| |y|))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 70450c5b..24cf2826 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -9,9 +9,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |ISTRING;empty;$;2|))
-(PUT '|ISTRING;empty;$;2| '|SPADreplace|
- '(XLAM NIL (MAKE-FULL-CVEC 0)))
-
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
|ISTRING;empty?;$B;3|))
@@ -135,9 +132,7 @@
(DECLARE (IGNORE $))
(MAKE-FULL-CVEC |n| |c|))
-(DEFUN |ISTRING;empty;$;2| ($)
- (DECLARE (IGNORE $))
- (MAKE-FULL-CVEC 0))
+(DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0))
(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index fca0ec38..2d765749 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -355,8 +355,6 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) |%Thing|) |OUTFORM;empty;$;73|))
-(PUT '|OUTFORM;empty;$;73| '|SPADreplace| '(XLAM NIL (LIST 'NOTHING)))
-
(DECLAIM (FTYPE (FUNCTION (|%Thing| |%Shell|) |%Boolean|)
|OUTFORM;infix?;$B;74|))
@@ -518,6 +516,15 @@
(PUT '|OUTFORM;int;4$;106| '|SPADreplace|
'(XLAM (|a| |b| |c|) (LIST 'INTSIGN |b| |c| |a|)))
+(PUT '|OUTFORM;postfix;3$;79| '|SPADreplace|
+ '(XLAM (|a| |b|) (LIST 'CONCAT |b| |a|)))
+
+(PUT '|OUTFORM;dot;2$;83| '|SPADreplace|
+ '(XLAM (|a|) (LIST 'SUPERSUB |a| " " '|.|)))
+
+(PUT '|OUTFORM;prime;2$;84| '|SPADreplace|
+ '(XLAM (|a|) (LIST 'SUPERSUB |a| " " '|,|)))
+
(DEFUN |OUTFORM;doubleFloatFormat;2S;1| (|s| $)
(PROG (|ss|)
(RETURN
@@ -539,7 +546,7 @@
(DEFUN |OUTFORM;message;S$;7| (|s| $)
(COND
- ((SPADCALL |s| (|getShellEntry| $ 12)) (LIST 'NOTHING))
+ ((SPADCALL |s| (|getShellEntry| $ 12)) (|OUTFORM;empty;$;73| $))
('T |s|)))
(DEFUN |OUTFORM;messagePrint;SV;8| (|s| $)
@@ -615,15 +622,18 @@
((> |n| 0)
(|OUTFORM;vconcat;3$;50| " " (|OUTFORM;vspace;I$;28| (- |n| 1) $)
$))
- ('T (LIST 'NOTHING))))
+ ('T (|OUTFORM;empty;$;73| $))))
(DEFUN |OUTFORM;hspace;I$;29| (|n| $)
- (COND ((> |n| 0) (|fillerSpaces| |n|)) ('T (LIST 'NOTHING))))
+ (COND
+ ((> |n| 0) (|fillerSpaces| |n|))
+ ('T (|OUTFORM;empty;$;73| $))))
(DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $)
(SEQ (COND
- ((> |n| 0) (COND ((NOT (> |m| 0)) (EXIT (LIST 'NOTHING)))))
- ('T (EXIT (LIST 'NOTHING))))
+ ((> |n| 0)
+ (COND ((NOT (> |m| 0)) (EXIT (|OUTFORM;empty;$;73| $)))))
+ ('T (EXIT (|OUTFORM;empty;$;73| $))))
(EXIT (|OUTFORM;vconcat;3$;50| (|OUTFORM;hspace;I$;29| |n| $)
(|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $))))
@@ -734,7 +744,7 @@
(DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $)
(SEQ (COND
((ODDP (LENGTH |l|))
- (LETT |l| (APPEND |l| (LIST (LIST 'NOTHING)))
+ (LETT |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $)))
|OUTFORM;supersub;$L$;47|)))
(EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|)))))
@@ -836,7 +846,7 @@
(DECLARE (IGNORE $))
(LIST 'BINOMIAL |a| |b|))
-(DEFUN |OUTFORM;empty;$;73| ($) (DECLARE (IGNORE $)) (LIST 'NOTHING))
+(DEFUN |OUTFORM;empty;$;73| ($) (LIST 'NOTHING))
(DEFUN |OUTFORM;infix?;$B;74| (|a| $)
(PROG (#0=#:G1495 |e|)
@@ -866,7 +876,7 @@
(DEFUN |OUTFORM;infix;$L$;77| (|a| |l| $)
(COND
- ((NULL |l|) (LIST 'NOTHING))
+ ((NULL |l|) (|OUTFORM;empty;$;73| $))
((NULL (CDR |l|)) (SPADCALL |l| (|getShellEntry| $ 78)))
((|OUTFORM;infix?;$B;74| |a| $) (CONS |a| |l|))
('T
@@ -880,7 +890,9 @@
((|OUTFORM;infix?;$B;74| |a| $) (LIST |a| |b| |c|))
('T (|OUTFORM;hconcat;L$;49| (LIST |b| |a| |c|) $))))
-(DEFUN |OUTFORM;postfix;3$;79| (|a| |b| $) (LIST 'CONCAT |b| |a|))
+(DEFUN |OUTFORM;postfix;3$;79| (|a| |b| $)
+ (DECLARE (IGNORE $))
+ (LIST 'CONCAT |b| |a|))
(DEFUN |OUTFORM;string;2$;80| (|a| $)
(DECLARE (IGNORE $))
@@ -894,9 +906,13 @@
(DECLARE (IGNORE $))
(LIST 'OVERBAR |a|))
-(DEFUN |OUTFORM;dot;2$;83| (|a| $) (LIST 'SUPERSUB |a| " " '|.|))
+(DEFUN |OUTFORM;dot;2$;83| (|a| $)
+ (DECLARE (IGNORE $))
+ (LIST 'SUPERSUB |a| " " '|.|))
-(DEFUN |OUTFORM;prime;2$;84| (|a| $) (LIST 'SUPERSUB |a| " " '|,|))
+(DEFUN |OUTFORM;prime;2$;84| (|a| $)
+ (DECLARE (IGNORE $))
+ (LIST 'SUPERSUB |a| " " '|,|))
(DEFUN |OUTFORM;dot;$Nni$;85| (|a| |nn| $)
(PROG (|s|)
@@ -975,7 +991,8 @@
(EXIT (|OUTFORM;super;3$;43| |a| (LIST 'PAREN |s|)
$)))))))))
-(DEFUN |OUTFORM;sum;2$;98| (|a| $) (LIST 'SIGMA (LIST 'NOTHING) |a|))
+(DEFUN |OUTFORM;sum;2$;98| (|a| $)
+ (LIST 'SIGMA (|OUTFORM;empty;$;73| $) |a|))
(DEFUN |OUTFORM;sum;3$;99| (|a| |b| $)
(DECLARE (IGNORE $))
@@ -985,7 +1002,8 @@
(DECLARE (IGNORE $))
(LIST 'SIGMA2 |b| |c| |a|))
-(DEFUN |OUTFORM;prod;2$;101| (|a| $) (LIST 'PI (LIST 'NOTHING) |a|))
+(DEFUN |OUTFORM;prod;2$;101| (|a| $)
+ (LIST 'PI (|OUTFORM;empty;$;73| $) |a|))
(DEFUN |OUTFORM;prod;3$;102| (|a| |b| $)
(DECLARE (IGNORE $))
@@ -996,10 +1014,10 @@
(LIST 'PI2 |b| |c| |a|))
(DEFUN |OUTFORM;int;2$;104| (|a| $)
- (LIST 'INTSIGN (LIST 'NOTHING) (LIST 'NOTHING) |a|))
+ (LIST 'INTSIGN (|OUTFORM;empty;$;73| $) (|OUTFORM;empty;$;73| $) |a|))
(DEFUN |OUTFORM;int;3$;105| (|a| |b| $)
- (LIST 'INTSIGN |b| (LIST 'NOTHING) |a|))
+ (LIST 'INTSIGN |b| (|OUTFORM;empty;$;73| $) |a|))
(DEFUN |OUTFORM;int;4$;106| (|a| |b| |c| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index 6f567c8e..840a7fcf 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -112,6 +112,9 @@
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|)
|SINT;<=;2$B;26|))
+(PUT '|SINT;<=;2$B;26| '|SPADreplace|
+ '(XLAM (|x| |y|) (NOT (> |x| |y|))))
+
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|)
|SINT;>=;2$B;27|))
@@ -239,12 +242,18 @@
(DECLAIM (FTYPE (FUNCTION (|%Shell|) (|%IntegerSection| 0))
|SINT;size;Nni;52|))
+(PUT '|SINT;size;Nni;52| '|SPADreplace|
+ '(XLAM NIL (+ (- |$ShortMaximum| |$ShortMinimum|) 1)))
+
(DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 1) |%Shell|) |%Short|)
|SINT;index;Pi$;53|))
(DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) (|%IntegerSection| 1))
|SINT;lookup;$Pi;54|))
+(PUT '|SINT;lookup;$Pi;54| '|SPADreplace|
+ '(XLAM (|x|) (+ (- |x| |$ShortMinimum|) 1)))
+
(DECLAIM (FTYPE (FUNCTION (|%Thing| (|%Vector| *) |%Shell|) |%Pair|)
|SINT;reducedSystem;MVR;55|))
@@ -375,7 +384,9 @@
(DECLARE (IGNORE $))
(QSGREATERP |x| |y|))
-(DEFUN |SINT;<=;2$B;26| (|x| |y| $) (NOT (> |x| |y|)))
+(DEFUN |SINT;<=;2$B;26| (|x| |y| $)
+ (DECLARE (IGNORE $))
+ (NOT (> |x| |y|)))
(DEFUN |SINT;>=;2$B;27| (|x| |y| $) (DECLARE (IGNORE $)) (>= |x| |y|))
@@ -458,6 +469,7 @@
(QSMINUSP |x|))
(DEFUN |SINT;size;Nni;52| ($)
+ (DECLARE (IGNORE $))
(+ (- |$ShortMaximum| |$ShortMinimum|) 1))
(DEFUN |SINT;index;Pi$;53| (|i| $)
@@ -467,7 +479,9 @@
|SINT;index;Pi$;53|)
(|check-subtype| (SMINTP #0#) '(|SingleInteger|) #0#)))))
-(DEFUN |SINT;lookup;$Pi;54| (|x| $) (+ (- |x| |$ShortMinimum|) 1))
+(DEFUN |SINT;lookup;$Pi;54| (|x| $)
+ (DECLARE (IGNORE $))
+ (+ (- |x| |$ShortMinimum|) 1))
(DEFUN |SINT;reducedSystem;MVR;55| (|m| |v| $)
(DECLARE (IGNORE $))
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-13 09:11:08 +0000