diff options
Diffstat (limited to 'src/algebra')
-rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 7 | ||||
-rw-r--r-- | src/algebra/strap/INT.lsp | 7 | ||||
-rw-r--r-- | src/algebra/strap/ISTRING.lsp | 7 | ||||
-rw-r--r-- | src/algebra/strap/OUTFORM.lsp | 52 | ||||
-rw-r--r-- | src/algebra/strap/SINT.lsp | 18 |
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 $)) |