From 024f4b2055594e528ec98e733bd50684b2366db0 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Thu, 22 Jul 2010 21:44:34 +0000 Subject: * interp/g-util.boot (expandIeq): New expander for %ieq. * interp/g-opt.boot (optIeq): New. (optIadd): Likewise. (optIsub): Likewise. (optImul): Likewise. (optIneg): Likewise. (lispize): Remove. --- src/algebra/strap/DFLOAT.lsp | 2 +- src/algebra/strap/FFIELDC-.lsp | 5 ++--- src/algebra/strap/GCDDOM-.lsp | 27 ++++++++++++--------------- src/algebra/strap/INT.lsp | 2 +- src/algebra/strap/ISTRING.lsp | 2 +- src/algebra/strap/POLYCAT-.lsp | 12 ++++++------ src/algebra/strap/RNS-.lsp | 2 +- 7 files changed, 24 insertions(+), 28 deletions(-) (limited to 'src/algebra/strap') diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 6f32c302..8f162868 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -763,7 +763,7 @@ (+ (* |q| |q1|) |q0|) |DFLOAT;rationalApproximation;$2NniF;87|) (COND - ((OR (EQL |r| 0) + ((OR (ZEROP |r|) (< (SPADCALL |tol| (ABS diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 1c17371d..12fb4f77 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -298,10 +298,9 @@ |FFIELDC-;discreteLog;SNni;11|) (EXIT (COND - ((EQL + ((ZEROP (CAR - |rho|) - 0) + |rho|)) (SEQ (SETQ |found| diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp index ff12789d..34e0980e 100644 --- a/src/algebra/strap/GCDDOM-.lsp +++ b/src/algebra/strap/GCDDOM-.lsp @@ -29,7 +29,7 @@ (|getShellEntry| $ 12)) |GCDDOM-;lcm;3S;1|) (EXIT (COND - ((EQL (CAR LCM) 0) + ((ZEROP (CAR LCM)) (SPADCALL |x| (CDR LCM) (|getShellEntry| $ 13))) ('T (|error| "bad gcd in lcm computation"))))))))))) @@ -59,7 +59,7 @@ (LET ((#0=#:G1418 (SPADCALL |p1| |c1| (|getShellEntry| $ 27)))) - (|check-union| (EQL (CAR #0#) 0) + (|check-union| (ZEROP (CAR #0#)) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) @@ -67,7 +67,7 @@ (SETQ |p2| (LET ((#0# (SPADCALL |p2| |c2| (|getShellEntry| $ 27)))) - (|check-union| (EQL (CAR #0#) 0) + (|check-union| (ZEROP (CAR #0#)) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) @@ -86,7 +86,7 @@ (|getShellEntry| $ 34)) (|getShellEntry| $ 35)))) (|check-union| - (EQL (CAR #0#) 0) + (ZEROP (CAR #0#)) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) @@ -105,7 +105,7 @@ (|getShellEntry| $ 34)) (|getShellEntry| $ 35)))) (|check-union| - (EQL (CAR #0#) 0) + (ZEROP (CAR #0#)) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) @@ -116,12 +116,10 @@ (SPADCALL |c1| |c2| (|getShellEntry| $ 10))) (SETQ |p1| (COND - ((OR (EQL (SPADCALL |p1| - (|getShellEntry| $ 37)) - 0) - (EQL (SPADCALL |p2| - (|getShellEntry| $ 37)) - 0)) + ((OR (ZEROP (SPADCALL |p1| + (|getShellEntry| $ 37))) + (ZEROP (SPADCALL |p2| + (|getShellEntry| $ 37)))) (SPADCALL |c1| 0 (|getShellEntry| $ 34))) ('T (SEQ (LETT |p| @@ -129,10 +127,9 @@ (|getShellEntry| $ 39)) |GCDDOM-;gcdPolynomial;3Sup;4|) (EXIT (COND - ((EQL + ((ZEROP (SPADCALL |p| - (|getShellEntry| $ 37)) - 0) + (|getShellEntry| $ 37))) (SPADCALL |c1| 0 (|getShellEntry| $ 34))) ('T @@ -160,7 +157,7 @@ (|getShellEntry| $ 27)))) (|check-union| - (EQL (CAR #0#) 0) + (ZEROP (CAR #0#)) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 28fee72a..c294d8df 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -476,7 +476,7 @@ (SPADCALL |pp| (|getShellEntry| $ 108)) (|getShellEntry| $ 112)))) - (|check-union| (EQL (CAR #0#) 0) $ #0#) + (|check-union| (ZEROP (CAR #0#)) $ #0#) (CDR #0#)) (|getShellEntry| $ 114)) (|getShellEntry| $ 118)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index e8a3de19..e1760a16 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -134,7 +134,7 @@ (DEFUN |ISTRING;empty;$;2| ($) (MAKE-FULL-CVEC 0)) -(DEFUN |ISTRING;empty?;$B;3| (|s| $) (EQL (QCSIZE |s|) 0)) +(DEFUN |ISTRING;empty?;$B;3| (|s| $) (ZEROP (QCSIZE |s|))) (DEFUN |ISTRING;#;$Nni;4| (|s| $) (DECLARE (IGNORE $)) (QCSIZE |s|)) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index ca0cad36..30873d70 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -308,7 +308,7 @@ (DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) (LET ((|q| (LET ((#0=#:G1478 (SPADCALL |p| (|getShellEntry| $ 53)))) - (|check-union| (EQL (CAR #0#) 0) (|getShellEntry| $ 9) + (|check-union| (ZEROP (CAR #0#)) (|getShellEntry| $ 9) #0#) (CDR #0#)))) (COND @@ -324,7 +324,7 @@ (SPADCALL |p| (|getShellEntry| $ 53)) |POLYCAT-;retractIfCan;SU;10|) (EXIT (COND - ((EQL (CAR |q|) 0) + ((ZEROP (CAR |q|)) (COND ((SPADCALL (SPADCALL (CDR |q|) @@ -362,7 +362,7 @@ (LET ((#0=#:G1492 (SPADCALL |p| (|getShellEntry| $ 53)))) - (|check-union| (EQL (CAR #0#) 0) + (|check-union| (ZEROP (CAR #0#)) (|getShellEntry| $ 9) #0#) (CDR #0#)) (|getShellEntry| $ 59)) @@ -400,7 +400,7 @@ ((#0=#:G1500 (SPADCALL |p| (|getShellEntry| $ 53)))) - (|check-union| (EQL (CAR #0#) 0) + (|check-union| (ZEROP (CAR #0#)) (|getShellEntry| $ 9) #0#) (CDR #0#)) |POLYCAT-;totalDegree;SLNni;14|) @@ -1055,7 +1055,7 @@ (SPADCALL |p| (SPADCALL |p| (|getShellEntry| $ 206)) (|getShellEntry| $ 207)))) - (|check-union| (EQL (CAR #0#) 0) (|getShellEntry| $ 6) + (|check-union| (ZEROP (CAR #0#)) (|getShellEntry| $ 6) #0#) (CDR #0#)) (|getShellEntry| $ 209)) @@ -1067,7 +1067,7 @@ (SPADCALL |p| (SPADCALL |p| |v| (|getShellEntry| $ 211)) (|getShellEntry| $ 212)))) - (|check-union| (EQL (CAR #0#) 0) (|getShellEntry| $ 6) + (|check-union| (ZEROP (CAR #0#)) (|getShellEntry| $ 6) #0#) (CDR #0#)) (|getShellEntry| $ 209)) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp index 18ebf104..e7be74cf 100644 --- a/src/algebra/strap/RNS-.lsp +++ b/src/algebra/strap/RNS-.lsp @@ -110,7 +110,7 @@ (SEQ (LETT |r| (SPADCALL |p| (|getShellEntry| $ 51)) |RNS-;patternMatch;SP2Pmr;10|) (EXIT (COND - ((EQL (CAR |r|) 0) + ((ZEROP (CAR |r|)) (COND ((SPADCALL (SPADCALL |x| -- cgit v1.2.3