diff options
author | dos-reis <gdr@axiomatics.org> | 2010-07-22 16:15:30 +0000 |
---|---|---|
committer | dos-reis <gdr@axiomatics.org> | 2010-07-22 16:15:30 +0000 |
commit | 510c2f70ce377d60eed221e46294767f7f548f5d (patch) | |
tree | db7b49602660346425298790df1ffcb9ad5f7c26 /src/algebra | |
parent | c1da0d2561b27741a6feb73336b0712f5ddc7e97 (diff) | |
download | open-axiom-510c2f70ce377d60eed221e46294767f7f548f5d.tar.gz |
* interp/g-opt.boot (simplifyVMForm): New.
(optRetract): Simplify the predicate when possible.
(optNot): New transformer.
(optAnd): Likewise.
(optOr): Likewise.
(optIlt): Likewise.
(optIle): Likewise.
(optIgt): Likewise.
(optIge): Likewise.
Diffstat (limited to 'src/algebra')
-rw-r--r-- | src/algebra/strap/ABELGRP-.lsp | 2 | ||||
-rw-r--r-- | src/algebra/strap/CHAR.lsp | 8 | ||||
-rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 17 | ||||
-rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 3 | ||||
-rw-r--r-- | src/algebra/strap/FPS-.lsp | 4 | ||||
-rw-r--r-- | src/algebra/strap/GCDDOM-.lsp | 4 | ||||
-rw-r--r-- | src/algebra/strap/ILIST.lsp | 4 | ||||
-rw-r--r-- | src/algebra/strap/INS-.lsp | 4 | ||||
-rw-r--r-- | src/algebra/strap/INT.lsp | 21 | ||||
-rw-r--r-- | src/algebra/strap/ISTRING.lsp | 46 | ||||
-rw-r--r-- | src/algebra/strap/LNAGG-.lsp | 2 | ||||
-rw-r--r-- | src/algebra/strap/LSAGG-.lsp | 20 | ||||
-rw-r--r-- | src/algebra/strap/NNI.lsp | 5 | ||||
-rw-r--r-- | src/algebra/strap/OUTFORM.lsp | 10 | ||||
-rw-r--r-- | src/algebra/strap/PI.lsp | 2 | ||||
-rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 8 | ||||
-rw-r--r-- | src/algebra/strap/SINT.lsp | 14 | ||||
-rw-r--r-- | src/algebra/strap/STAGG-.lsp | 25 | ||||
-rw-r--r-- | src/algebra/strap/SYMBOL.lsp | 22 | ||||
-rw-r--r-- | src/algebra/strap/URAGG-.lsp | 14 |
20 files changed, 132 insertions, 103 deletions
diff --git a/src/algebra/strap/ABELGRP-.lsp b/src/algebra/strap/ABELGRP-.lsp index 47493f92..d436441d 100644 --- a/src/algebra/strap/ABELGRP-.lsp +++ b/src/algebra/strap/ABELGRP-.lsp @@ -27,7 +27,7 @@ (DEFUN |ABELGRP-;*;I2S;4| (|n| |x| $) (COND ((ZEROP |n|) (|spadConstant| $ 19)) - ((< 0 |n|) (SPADCALL |n| |x| (|getShellEntry| $ 24))) + ((PLUSP |n|) (SPADCALL |n| |x| (|getShellEntry| $ 24))) ('T (SPADCALL (- |n|) (SPADCALL |x| (|getShellEntry| $ 7)) (|getShellEntry| $ 24))))) diff --git a/src/algebra/strap/CHAR.lsp b/src/algebra/strap/CHAR.lsp index ed6ac052..869562e9 100644 --- a/src/algebra/strap/CHAR.lsp +++ b/src/algebra/strap/CHAR.lsp @@ -123,13 +123,13 @@ (DEFUN |CHAR;size;Nni;6| ($) (DECLARE (IGNORE $)) 256) (DEFUN |CHAR;index;Pi$;7| (|n| $) - (CODE-CHAR - (LET ((#0=#:G1405 (- |n| 1))) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)))) + (CODE-CHAR (LET ((#0=#:G1405 (- |n| 1))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)))) (DEFUN |CHAR;lookup;$Pi;8| (|c| $) (LET ((#0=#:G1407 (+ 1 (CHAR-CODE |c|)))) - (|check-subtype| (< 0 #0#) '(|PositiveInteger|) #0#))) + (|check-subtype| (PLUSP #0#) '(|PositiveInteger|) #0#))) (DEFUN |CHAR;char;Nni$;9| (|n| $) (DECLARE (IGNORE $)) diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 596307d8..6f32c302 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -446,8 +446,8 @@ (|DFLOAT;log2;2$;40| (FLOAT 2 |$DoubleFloatMaximum|) $) (|getShellEntry| $ 32))))) - (|check-subtype| (AND (>= #0# 0) (< 0 #0#)) '(|PositiveInteger|) - #0#))))) + (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#)) + '(|PositiveInteger|) #0#))))) (DEFUN |DFLOAT;max;$;11| ($) (DECLARE (IGNORE $)) @@ -636,14 +636,16 @@ (DEFUN |DFLOAT;retract;$F;80| (|x| $) (|DFLOAT;rationalApproximation;$2NniF;87| |x| (LET ((#0=#:G1506 (- 53 1))) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) + #0#)) 2 $)) (DEFUN |DFLOAT;retractIfCan;$U;81| (|x| $) (CONS 0 (|DFLOAT;rationalApproximation;$2NniF;87| |x| (LET ((#0=#:G1514 (- 53 1))) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) 2 $))) (DEFUN |DFLOAT;retract;$I;82| (|x| $) @@ -706,18 +708,19 @@ (SEQ |#G109| (LETT BASE 2 |DFLOAT;rationalApproximation;$2NniF;87|) (EXIT (COND - ((>= |ex| 0) + ((NOT (MINUSP |ex|)) (SPADCALL (* |nu| (EXPT BASE - (|check-subtype| (>= |ex| 0) + (|check-subtype| (NOT (MINUSP |ex|)) '(|NonNegativeInteger|) |ex|))) (|getShellEntry| $ 134))) ('T (SEQ (LETT |de| (EXPT BASE (LET ((#0=#:G1542 (- |ex|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#))) |DFLOAT;rationalApproximation;$2NniF;87|) (EXIT (COND diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 9ad8712c..1c17371d 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -104,7 +104,8 @@ (T (SEQ (LETT |e| (SPADCALL (|check-subtype| - (AND (>= |i| 0) (< 0 |i|)) + (AND (NOT (MINUSP |i|)) + (PLUSP |i|)) '(|PositiveInteger|) |i|) (|getShellEntry| $ 14)) |FFIELDC-;createPrimitiveElement;S;8|) diff --git a/src/algebra/strap/FPS-.lsp b/src/algebra/strap/FPS-.lsp index 562d295c..cee87448 100644 --- a/src/algebra/strap/FPS-.lsp +++ b/src/algebra/strap/FPS-.lsp @@ -19,8 +19,8 @@ (- (SPADCALL (|getShellEntry| $ 14)) 1) (|getShellEntry| $ 16)) 13301)))) - (|check-subtype| (AND (>= #0# 0) (< 0 #0#)) '(|PositiveInteger|) - #0#))) + (|check-subtype| (AND (NOT (MINUSP #0#)) (PLUSP #0#)) + '(|PositiveInteger|) #0#))) (DEFUN |FloatingPointSystem&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp index 92b58126..ff12789d 100644 --- a/src/algebra/strap/GCDDOM-.lsp +++ b/src/algebra/strap/GCDDOM-.lsp @@ -76,7 +76,7 @@ (SPADCALL |p1| (|getShellEntry| $ 29)) |GCDDOM-;gcdPolynomial;3Sup;4|) (EXIT (COND - ((< 0 |e1|) + ((PLUSP |e1|) (SETQ |p1| (LET ((#0# @@ -95,7 +95,7 @@ (SPADCALL |p2| (|getShellEntry| $ 29)) |GCDDOM-;gcdPolynomial;3Sup;4|) (EXIT (COND - ((< 0 |e2|) + ((PLUSP |e2|) (SETQ |p2| (LET ((#0# diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 8ba9493f..b9fcc572 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -387,7 +387,7 @@ (SEQ (SETQ |p| (|ILIST;rest;$Nni$;19| |p| (LET ((#0=#:G1506 (- |n| 1))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) $)) (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|) @@ -407,7 +407,7 @@ ('T (SEQ (LETT |l| (LET ((#0=#:G1511 (QUOTIENT2 |n| 2))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) |ILIST;mergeSort|) (LETT |q| (|ILIST;split!;$I$;29| |p| |l| $) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp index 794d4374..6df95b2e 100644 --- a/src/algebra/strap/INS-.lsp +++ b/src/algebra/strap/INS-.lsp @@ -125,10 +125,10 @@ (|error| "euclideanSize called on zero")) ((SPADCALL |x| (|spadConstant| $ 10) (|getShellEntry| $ 28)) (LET ((#0=#:G1426 (- (SPADCALL |x| (|getShellEntry| $ 30))))) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#))) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#))) ('T (LET ((#1=#:G1427 (SPADCALL |x| (|getShellEntry| $ 30)))) - (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#))))) + (|check-subtype| (NOT (MINUSP #1#)) '(|NonNegativeInteger|) #1#))))) (DEFUN |INS-;convert;SF;10| (|x| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index c489ab5c..28fee72a 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -148,17 +148,19 @@ (DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) |INT;>;2$B;36|)) -(PUT '|INT;>;2$B;36| '|SPADreplace| '|%igt|) +(PUT '|INT;>;2$B;36| '|SPADreplace| '(XLAM (|x| |y|) (|%ilt| |y| |x|))) (DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) |INT;<=;2$B;37|)) -(PUT '|INT;<=;2$B;37| '|SPADreplace| '|%ile|) +(PUT '|INT;<=;2$B;37| '|SPADreplace| + '(XLAM (|x| |y|) (|%not| (|%ilt| |y| |x|)))) (DECLAIM (FTYPE (FUNCTION (|%Integer| |%Integer| |%Shell|) |%Boolean|) |INT;>=;2$B;38|)) -(PUT '|INT;>=;2$B;38| '|SPADreplace| '|%ige|) +(PUT '|INT;>=;2$B;38| '|SPADreplace| + '(XLAM (|x| |y|) (|%not| (|%ilt| |x| |y|)))) (DECLAIM (FTYPE (FUNCTION (|%Integer| |%Shell|) |%Integer|) |INT;-;2$;39|)) @@ -338,7 +340,8 @@ (INTEGER-LENGTH |a|)) (DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) - (LET ((|c| (+ |a| |b|))) (COND ((>= |c| |p|) (- |c| |p|)) ('T |c|)))) + (LET ((|c| (+ |a| |b|))) + (COND ((NOT (< |c| |p|)) (- |c| |p|)) ('T |c|)))) (DEFUN |INT;submod;4$;21| (|a| |b| |p| $) (LET ((|c| (- |a| |b|))) (COND ((MINUSP |c|) (+ |c| |p|)) ('T |c|)))) @@ -392,9 +395,13 @@ (DEFUN |INT;>;2$B;36| (|x| |y| $) (DECLARE (IGNORE $)) (< |y| |x|)) -(DEFUN |INT;<=;2$B;37| (|x| |y| $) (DECLARE (IGNORE $)) (<= |x| |y|)) +(DEFUN |INT;<=;2$B;37| (|x| |y| $) + (DECLARE (IGNORE $)) + (NOT (< |y| |x|))) -(DEFUN |INT;>=;2$B;38| (|x| |y| $) (DECLARE (IGNORE $)) (>= |x| |y|)) +(DEFUN |INT;>=;2$B;38| (|x| |y| $) + (DECLARE (IGNORE $)) + (NOT (< |x| |y|))) (DEFUN |INT;-;2$;39| (|x| $) (DECLARE (IGNORE $)) (- |x|)) @@ -491,7 +498,7 @@ (DEFUN |Integer| () (DECLARE (SPECIAL |$ConstructorCache|)) - (PROG (#0=#:G1525) + (PROG (#0=#:G1527) (RETURN (COND ((SETQ #0# (HGET |$ConstructorCache| '|Integer|)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 55b813f7..e8a3de19 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -191,13 +191,14 @@ (- (SPADCALL |s| (|getShellEntry| $ 47)) (|getShellEntry| $ 6)))))) (SEQ (COND - ((OR (OR (MINUSP |l|) (>= |h| |m|)) (< |h| (- |l| 1))) + ((OR (OR (MINUSP |l|) (NOT (< |h| |m|))) + (< |h| (- |l| 1))) (EXIT (|error| "index out of range")))) (LETT |r| (MAKE-FULL-CVEC (LET ((#0=#:G1444 (+ (- |m| (+ (- |h| |l|) 1)) |n|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|spadConstant| $ 53)) |ISTRING;replace;$Us2$;15|) @@ -264,7 +265,7 @@ (EXIT (COND ((MINUSP |startpos|) (|error| "index out of bounds")) - ((>= |startpos| (QCSIZE |t|)) + ((NOT (< |startpos| (QCSIZE |t|))) (- (|getShellEntry| $ 6) 1)) ('T (SEQ (LETT |r| (STRPOS |s| |t| |startpos| NIL) @@ -278,7 +279,7 @@ (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) (EXIT (COND ((MINUSP |startpos|) (|error| "index out of bounds")) - ((>= |startpos| (QCSIZE |t|)) + ((NOT (< |startpos| (QCSIZE |t|))) (- (|getShellEntry| $ 6) 1)) ('T (SEQ (LET ((|r| |startpos|) @@ -298,7 +299,7 @@ (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) (EXIT (COND ((MINUSP |startpos|) (|error| "index out of bounds")) - ((>= |startpos| (QCSIZE |t|)) + ((NOT (< |startpos| (QCSIZE |t|))) (- (|getShellEntry| $ 6) 1)) ('T (SEQ (LET ((|r| |startpos|) @@ -344,11 +345,11 @@ ((NOT (COND ((< |n| |i|) NIL) ('T - (>= (LETT |j| - (|ISTRING;position;C$2I;19| |c| |s| - |i| $) - |ISTRING;split;$CL;22|) - (|getShellEntry| $ 6))))) + (NOT (< (LETT |j| + (|ISTRING;position;C$2I;19| |c| + |s| |i| $) + |ISTRING;split;$CL;22|) + (|getShellEntry| $ 6)))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL @@ -400,11 +401,11 @@ ((NOT (COND ((< |n| |i|) NIL) ('T - (>= (LETT |j| - (|ISTRING;position;Cc$2I;20| |cc| - |s| |i| $) - |ISTRING;split;$CcL;23|) - (|getShellEntry| $ 6))))) + (NOT (< (LETT |j| + (|ISTRING;position;Cc$2I;20| + |cc| |s| |i| $) + |ISTRING;split;$CcL;23|) + (|getShellEntry| $ 6)))))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL @@ -471,7 +472,7 @@ (SEQ (LOOP (COND ((NOT (COND - ((>= |j| (|getShellEntry| $ 6)) + ((NOT (< |j| (|getShellEntry| $ 6))) (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| (|getShellEntry| $ 69))) ('T NIL))) @@ -487,7 +488,7 @@ (SEQ (LOOP (COND ((NOT (COND - ((>= |j| (|getShellEntry| $ 6)) + ((NOT (< |j| (|getShellEntry| $ 6))) (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| (|getShellEntry| $ 65))) ('T NIL))) @@ -553,7 +554,7 @@ (- (SPADCALL |s| (|getShellEntry| $ 47)) (|getShellEntry| $ 6)))))) (SEQ (COND - ((OR (MINUSP |l|) (>= |h| (QCSIZE |s|))) + ((OR (MINUSP |l|) (NOT (< |h| (QCSIZE |s|)))) (EXIT (|error| "index out of bound")))) (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1))))))) @@ -577,7 +578,7 @@ |pattern| $) |ISTRING;match?;2$CB;34|) $))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) |ISTRING;match?;2$CB;34|) (EXIT (COND @@ -599,7 +600,7 @@ (|ISTRING;position;C$2I;19| |dontcare| |pattern| (+ |p| 1) $))) - (|check-subtype| (>= #1# 0) + (|check-subtype| (NOT (MINUSP #1#)) '(|NonNegativeInteger|) #1#)) |ISTRING;match?;2$CB;34|) (LOOP @@ -619,7 +620,8 @@ ((#2=#:G1527 (|ISTRING;position;2$2I;18| |s| |target| |i| $))) - (|check-subtype| (>= #2# 0) + (|check-subtype| + (NOT (MINUSP #2#)) '(|NonNegativeInteger|) #2#))) (EXIT (COND @@ -640,7 +642,7 @@ |dontcare| |pattern| (+ |q| 1) $))) (|check-subtype| - (>= #3# 0) + (NOT (MINUSP #3#)) '(|NonNegativeInteger|) #3#)))))))))))) (COND diff --git a/src/algebra/strap/LNAGG-.lsp b/src/algebra/strap/LNAGG-.lsp index 71915a22..e0bd3c89 100644 --- a/src/algebra/strap/LNAGG-.lsp +++ b/src/algebra/strap/LNAGG-.lsp @@ -32,7 +32,7 @@ (DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) (COND - ((>= |i| (SPADCALL |a| (|getShellEntry| $ 9))) + ((NOT (< |i| (SPADCALL |a| (|getShellEntry| $ 9)))) (NOT (< (SPADCALL |a| (|getShellEntry| $ 10)) |i|))) ('T NIL))) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index a2d94892..eac3d76a 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -223,7 +223,7 @@ (SEQ (LETT |y| (SPADCALL |x| (LET ((#0=#:G1467 (- (- |i| 1) |m|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39)) |LSAGG-;insert!;SAIA;7|) @@ -244,7 +244,7 @@ (SEQ (LETT |y| (SPADCALL |x| (LET ((#0=#:G1471 (- (- |i| 1) |m|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39)) |LSAGG-;insert!;2AIA;8|) @@ -307,7 +307,7 @@ (SEQ (LETT |y| (SPADCALL |x| (LET ((#0=#:G1483 (- (- |i| 1) |m|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39)) |LSAGG-;delete!;AIA;10|) @@ -334,7 +334,7 @@ ((EQL |l| |m|) (SPADCALL |x| (LET ((#0=#:G1489 (- (+ |h| 1) |m|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39))) ('T @@ -342,7 +342,8 @@ (SPADCALL |x| (LET ((#1=#:G1490 (- (- |l| 1) |m|))) - (|check-subtype| (>= #1# 0) + (|check-subtype| + (NOT (MINUSP #1#)) '(|NonNegativeInteger|) #1#)) (|getShellEntry| $ 39)) |LSAGG-;delete!;AUsA;11|) @@ -350,7 +351,8 @@ (SPADCALL |t| (LET ((#2=#:G1491 (+ (- |h| |l|) 2))) - (|check-subtype| (>= #2# 0) + (|check-subtype| + (NOT (MINUSP #2#)) '(|NonNegativeInteger|) #2#)) (|getShellEntry| $ 39)) (|getShellEntry| $ 27)) @@ -405,7 +407,7 @@ ('T (SEQ (LETT |l| (LET ((#0=#:G1511 (QUOTIENT2 |n| 2))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) |LSAGG-;mergeSort|) (LETT |q| @@ -567,7 +569,7 @@ (SEQ (LETT |z| (SPADCALL |y| (LET ((#0=#:G1552 (- |s| |m|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39)) |LSAGG-;copyInto!;2AIA;22|) @@ -598,7 +600,7 @@ (SEQ (SETQ |x| (SPADCALL |x| (LET ((#0=#:G1559 (- |s| |m|))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39))) (LETT |k| |s| |LSAGG-;position;SA2I;23|) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp index 4347bb34..dbe1dda2 100644 --- a/src/algebra/strap/NNI.lsp +++ b/src/algebra/strap/NNI.lsp @@ -2,7 +2,7 @@ (/VERSIONCHECK 2) (|noteSubDomainInfo| '|NonNegativeInteger| '(|Integer|) - '(|%ige| |#1| 0)) + '(|%not| (|%ilt| |#1| 0))) (DECLAIM (FTYPE (FUNCTION ((|%IntegerSection| 0) (|%IntegerSection| 0) @@ -36,7 +36,8 @@ ((MINUSP |c|) (CONS 1 "failed")) ('T (CONS 0 - (|check-subtype| (>= |c| 0) '(|NonNegativeInteger|) |c|)))))) + (|check-subtype| (NOT (MINUSP |c|)) + '(|NonNegativeInteger|) |c|)))))) (DEFUN |NonNegativeInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 64660b88..6bfe294e 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -616,20 +616,20 @@ (DEFUN |OUTFORM;vspace;I$;28| (|n| $) (COND - ((< 0 |n|) + ((PLUSP |n|) (|OUTFORM;vconcat;3$;50| " " (|OUTFORM;vspace;I$;28| (- |n| 1) $) $)) ('T (|OUTFORM;empty;$;73| $)))) (DEFUN |OUTFORM;hspace;I$;29| (|n| $) (COND - ((< 0 |n|) (|fillerSpaces| |n|)) + ((PLUSP |n|) (|fillerSpaces| |n|)) ('T (|OUTFORM;empty;$;73| $)))) (DEFUN |OUTFORM;rspace;2I$;30| (|n| |m| $) (SEQ (COND - ((< 0 |n|) - (COND ((NOT (< 0 |m|)) (EXIT (|OUTFORM;empty;$;73| $))))) + ((PLUSP |n|) + (COND ((NOT (PLUSP |m|)) (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) $) $)))) @@ -937,7 +937,7 @@ ('T (SEQ (LETT |r| (SPADCALL - (|check-subtype| (< 0 |nn|) + (|check-subtype| (PLUSP |nn|) '(|PositiveInteger|) |nn|) (|getShellEntry| $ 137)) |OUTFORM;differentiate;$Nni$;97|) diff --git a/src/algebra/strap/PI.lsp b/src/algebra/strap/PI.lsp index 3ed76477..4f7ecd8d 100644 --- a/src/algebra/strap/PI.lsp +++ b/src/algebra/strap/PI.lsp @@ -2,7 +2,7 @@ (/VERSIONCHECK 2) (|noteSubDomainInfo| '|PositiveInteger| '(|NonNegativeInteger|) - '(|%igt| |#1| 0)) + '(|%ilt| 0 |#1|)) (DEFUN |PositiveInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 9426e0ee..ca0cad36 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -752,7 +752,9 @@ ((#10=#:G1612 (CDR |nd|))) (|check-subtype| - (>= #10# 0) + (NOT + (MINUSP + #10#)) '(|NonNegativeInteger|) #10#)))))) #9#))))) @@ -936,7 +938,7 @@ |POLYCAT-;charthRootlv|) (LOOP (COND - ((NOT (< 0 |d|)) (RETURN NIL)) + ((NOT (PLUSP |d|)) (RETURN NIL)) (T (SEQ (LETT |dd| (SPADCALL |d| |ch| (|getShellEntry| $ 173)) @@ -981,7 +983,7 @@ ((#0=#:G1640 (CDR |dd|))) (|check-subtype| - (>= #0# 0) + (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index d37ff34e..d5afc6c2 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -118,12 +118,14 @@ (DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) |SINT;<=;2$B;28|)) -(PUT '|SINT;<=;2$B;28| '|SPADreplace| '|%ile|) +(PUT '|SINT;<=;2$B;28| '|SPADreplace| + '(XLAM (|x| |y|) (|%not| (|%ilt| |y| |x|)))) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Short| |%Shell|) |%Boolean|) |SINT;>=;2$B;29|)) -(PUT '|SINT;>=;2$B;29| '|SPADreplace| '|%ige|) +(PUT '|SINT;>=;2$B;29| '|SPADreplace| + '(XLAM (|x| |y|) (|%not| (|%ilt| |x| |y|)))) (DECLAIM (FTYPE (FUNCTION (|%Short| |%Shell|) |%Short|) |SINT;inc;2$;30|)) @@ -389,9 +391,13 @@ (DECLARE (IGNORE $)) (QSGREATERP |x| |y|)) -(DEFUN |SINT;<=;2$B;28| (|x| |y| $) (DECLARE (IGNORE $)) (<= |x| |y|)) +(DEFUN |SINT;<=;2$B;28| (|x| |y| $) + (DECLARE (IGNORE $)) + (NOT (< |y| |x|))) -(DEFUN |SINT;>=;2$B;29| (|x| |y| $) (DECLARE (IGNORE $)) (>= |x| |y|)) +(DEFUN |SINT;>=;2$B;29| (|x| |y| $) + (DECLARE (IGNORE $)) + (NOT (< |x| |y|))) (DEFUN |SINT;inc;2$;30| (|x| $) (DECLARE (IGNORE $)) (QSADD1 |x|)) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 53991265..cdcf96d8 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -78,7 +78,7 @@ (SPADCALL (SETQ |x| (SPADCALL |x| - (|check-subtype| (>= |i| 0) + (|check-subtype| (NOT (MINUSP |i|)) '(|NonNegativeInteger|) |i|) (|getShellEntry| $ 25))) (|getShellEntry| $ 18))) @@ -93,11 +93,12 @@ (COND ((MINUSP |l|) (|error| "index out of range")) ((NOT (SPADCALL |i| (|getShellEntry| $ 29))) - (SPADCALL (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (|getShellEntry| $ 30))) + (SPADCALL + (SPADCALL |x| + (|check-subtype| (NOT (MINUSP |l|)) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (|getShellEntry| $ 30))) ('T (SEQ (LETT |h| (- (SPADCALL |i| (|getShellEntry| $ 31)) @@ -108,11 +109,11 @@ ('T (SPADCALL (SPADCALL |x| - (|check-subtype| (>= |l| 0) + (|check-subtype| (NOT (MINUSP |l|)) '(|NonNegativeInteger|) |l|) (|getShellEntry| $ 25)) (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 35)))))))))))) @@ -160,7 +161,7 @@ (SPADCALL (SETQ |x| (SPADCALL |x| - (|check-subtype| (>= |i| 0) + (|check-subtype| (NOT (MINUSP |i|)) '(|NonNegativeInteger|) |i|) (|getShellEntry| $ 25))) (|getShellEntry| $ 18))) @@ -187,7 +188,8 @@ ('T (SEQ (LETT |y| (SPADCALL |x| - (|check-subtype| (>= |l| 0) + (|check-subtype| + (NOT (MINUSP |l|)) '(|NonNegativeInteger|) |l|) (|getShellEntry| $ 25)) |STAGG-;setelt;AUs2S;12|) @@ -195,7 +197,8 @@ (SPADCALL |y| (LET ((#0=#:G1443 (+ (- |h| |l|) 1))) - (|check-subtype| (>= #0# 0) + (|check-subtype| + (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 25)) |STAGG-;setelt;AUs2S;12|) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index 0c928c37..190f733b 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -200,7 +200,8 @@ (SEQ (LOOP (COND ((NOT (COND - ((>= (LENGTH |ns|) 2) (ZEROP (|SPADfirst| |ns|))) + ((NOT (< (LENGTH |ns|) 2)) + (ZEROP (|SPADfirst| |ns|))) ('T NIL))) (RETURN NIL)) (T (SETQ |ns| (CDR |ns|))))) @@ -440,14 +441,15 @@ (SETQ |xx| (STRCONC "%" |xx|)) (SETQ |xx| (COND - ((>= (SPADCALL - (SPADCALL |xx| - (SPADCALL |xx| (|getShellEntry| $ 128)) - (|getShellEntry| $ 106)) - (|getShellEntry| $ 19) - (|getShellEntry| $ 129)) - (SPADCALL (|getShellEntry| $ 19) - (|getShellEntry| $ 117))) + ((NOT (< (SPADCALL + (SPADCALL |xx| + (SPADCALL |xx| + (|getShellEntry| $ 128)) + (|getShellEntry| $ 106)) + (|getShellEntry| $ 19) + (|getShellEntry| $ 129)) + (SPADCALL (|getShellEntry| $ 19) + (|getShellEntry| $ 117)))) (STRCONC |xx| (|SYMBOL;anyRadix| |n| (|getShellEntry| $ 21) $))) @@ -546,7 +548,7 @@ (|getShellEntry| $ 106)) (|getShellEntry| $ 44)) (|getShellEntry| $ 45)))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 148)))) (SETQ |i| (+ |i| 1)) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index a9dab43a..fb03bf3a 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -168,20 +168,20 @@ (SEQ (LOOP (COND ((NOT (COND - ((< 0 |i|) + ((PLUSP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) ('T NIL))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (< 0 |i|))))) + (EXIT (PLUSP |i|))))) (DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) (LET ((|i| |n|)) (SEQ (LOOP (COND ((NOT (COND - ((< 0 |i|) + ((PLUSP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) ('T NIL))) (RETURN NIL)) @@ -198,7 +198,7 @@ (COND ((NOT (COND ((SPADCALL |l| (|getShellEntry| $ 20)) NIL) - ('T (< 0 |i|)))) + ('T (PLUSP |i|)))) (RETURN NIL)) (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) (EXIT (SETQ |i| (- |i| 1))))))) @@ -381,8 +381,8 @@ (SPADCALL (SPADCALL |x| (LET ((#0=#:G1502 (- |m| |n|))) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) - #0#)) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 62)) (|getShellEntry| $ 63)))))) @@ -491,7 +491,7 @@ (SEQ (SETQ |p| (SPADCALL |p| (LET ((#0=#:G1528 (- |n| 1))) - (|check-subtype| (>= #0# 0) + (|check-subtype| (NOT (MINUSP #0#)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 62))) (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14)) |