diff options
| author | dos-reis <gdr@axiomatics.org> | 2011-02-07 02:43:13 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2011-02-07 02:43:13 +0000 |
| commit | 64800be179812d1ff863cc629bcc6b21a0c7f8ac (patch) | |
| tree | 58c035aec699d3a0b633e751835df24510510765 /src/algebra/strap/GCDDOM-.lsp | |
| parent | 351022a3ec02f6e131d54f3a5bcb27a8dfffbcb0 (diff) | |
| download | open-axiom-64800be179812d1ff863cc629bcc6b21a0c7f8ac.tar.gz | |
* interp/g-opt.boot (groupVariableDefinitions): Look into clauses
of conditional too.
Diffstat (limited to 'src/algebra/strap/GCDDOM-.lsp')
| -rw-r--r-- | src/algebra/strap/GCDDOM-.lsp | 252 |
1 files changed, 127 insertions, 125 deletions
diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp index 46927a01..a2e1e688 100644 --- a/src/algebra/strap/GCDDOM-.lsp +++ b/src/algebra/strap/GCDDOM-.lsp @@ -14,22 +14,17 @@ |GCDDOM-;gcdPolynomial;3Sup;4|)) (DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $) - (PROG (LCM) - (RETURN - (COND - ((OR (SPADCALL |y| (|spadConstant| $ 7) (|getShellEntry| $ 9)) - (SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9))) - (|spadConstant| $ 7)) - (T (SEQ (LETT LCM - (SPADCALL |y| - (SPADCALL |x| |y| (|getShellEntry| $ 10)) - (|getShellEntry| $ 12)) - |GCDDOM-;lcm;3S;1|) - (EXIT (COND - ((ZEROP (CAR LCM)) - (SPADCALL |x| (CDR LCM) - (|getShellEntry| $ 13))) - (T (|error| "bad gcd in lcm computation")))))))))) + (COND + ((OR (SPADCALL |y| (|spadConstant| $ 7) (|getShellEntry| $ 9)) + (SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9))) + (|spadConstant| $ 7)) + (T (LET ((LCM (SPADCALL |y| + (SPADCALL |x| |y| (|getShellEntry| $ 10)) + (|getShellEntry| $ 12)))) + (COND + ((ZEROP (CAR LCM)) + (SPADCALL |x| (CDR LCM) (|getShellEntry| $ 13))) + (T (|error| "bad gcd in lcm computation"))))))) (DEFUN |GCDDOM-;lcm;LS;2| (|l| $) (SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7) @@ -40,123 +35,130 @@ (|getShellEntry| $ 19))) (DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) - (PROG (|c1| |c2| |e2| |e1| |p|) + (PROG (|e2| |e1| |p|) (RETURN (COND ((SPADCALL |p1| (|getShellEntry| $ 24)) (SPADCALL |p2| (|getShellEntry| $ 25))) ((SPADCALL |p2| (|getShellEntry| $ 24)) (SPADCALL |p1| (|getShellEntry| $ 25))) - (T (SEQ (LETT |c1| (SPADCALL |p1| (|getShellEntry| $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c2| (SPADCALL |p2| (|getShellEntry| $ 26)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (SETQ |p1| - (LET ((#0=#:G1393 - (SPADCALL |p1| |c1| + (T (LET ((|c1| (SPADCALL |p1| (|getShellEntry| $ 26))) + (|c2| (SPADCALL |p2| (|getShellEntry| $ 26)))) + (SEQ (SETQ |p1| + (LET ((#0=#:G1393 + (SPADCALL |p1| |c1| + (|getShellEntry| $ 27)))) + (|check-union| (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (SVREF $ 6)) + #0#) + (CDR #0#))) + (SETQ |p2| + (LET ((#0# (SPADCALL |p2| |c2| (|getShellEntry| $ 27)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| (SVREF $ 6)) - #0#) - (CDR #0#))) - (SETQ |p2| - (LET ((#0# (SPADCALL |p2| |c2| - (|getShellEntry| $ 27)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| (SVREF $ 6)) - #0#) - (CDR #0#))) - (SEQ (LETT |e1| (SPADCALL |p1| (|getShellEntry| $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((PLUSP |e1|) - (SETQ |p1| - (LET - ((#0# - (SPADCALL |p1| - (SPADCALL (|spadConstant| $ 16) - |e1| (|getShellEntry| $ 34)) - (|getShellEntry| $ 35)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#))))))) - (SEQ (LETT |e2| (SPADCALL |p2| (|getShellEntry| $ 29)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((PLUSP |e2|) - (SETQ |p2| - (LET - ((#0# - (SPADCALL |p2| - (SPADCALL (|spadConstant| $ 16) - |e2| (|getShellEntry| $ 34)) - (|getShellEntry| $ 35)))) - (|check-union| (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#))))))) - (LETT |e1| (MIN |e1| |e2|) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (SETQ |c1| (SPADCALL |c1| |c2| (|getShellEntry| $ 10))) - (SETQ |p1| - (COND - ((OR (ZEROP (SPADCALL |p1| - (|getShellEntry| $ 37))) - (ZEROP (SPADCALL |p2| - (|getShellEntry| $ 37)))) - (SPADCALL |c1| 0 (|getShellEntry| $ 34))) - (T (SEQ (LETT |p| - (SPADCALL |p1| |p2| - (|getShellEntry| $ 39)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (EXIT (COND - ((ZEROP - (SPADCALL |p| - (|getShellEntry| $ 37))) - (SPADCALL |c1| 0 - (|getShellEntry| $ 34))) - (T - (SEQ - (SETQ |c2| - (SPADCALL - (SPADCALL |p1| - (|getShellEntry| $ 40)) - (SPADCALL |p2| - (|getShellEntry| $ 40)) - (|getShellEntry| $ 10))) - (EXIT - (SPADCALL - (SPADCALL |c1| + (|check-union| (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (SVREF $ 6)) + #0#) + (CDR #0#))) + (SEQ (LETT |e1| + (SPADCALL |p1| (|getShellEntry| $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((PLUSP |e1|) + (SETQ |p1| + (LET + ((#0# + (SPADCALL |p1| + (SPADCALL + (|spadConstant| $ 16) |e1| + (|getShellEntry| $ 34)) + (|getShellEntry| $ 35)))) + (|check-union| + (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (SVREF $ 6)) + #0#) + (CDR #0#))))))) + (SEQ (LETT |e2| + (SPADCALL |p2| (|getShellEntry| $ 29)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((PLUSP |e2|) + (SETQ |p2| + (LET + ((#0# + (SPADCALL |p2| + (SPADCALL + (|spadConstant| $ 16) |e2| + (|getShellEntry| $ 34)) + (|getShellEntry| $ 35)))) + (|check-union| + (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (SVREF $ 6)) + #0#) + (CDR #0#))))))) + (LETT |e1| (MIN |e1| |e2|) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (SETQ |c1| + (SPADCALL |c1| |c2| (|getShellEntry| $ 10))) + (SETQ |p1| + (COND + ((OR (ZEROP (SPADCALL |p1| + (|getShellEntry| $ 37))) + (ZEROP (SPADCALL |p2| + (|getShellEntry| $ 37)))) + (SPADCALL |c1| 0 (|getShellEntry| $ 34))) + (T (SEQ (LETT |p| + (SPADCALL |p1| |p2| + (|getShellEntry| $ 39)) + |GCDDOM-;gcdPolynomial;3Sup;4|) + (EXIT (COND + ((ZEROP + (SPADCALL |p| + (|getShellEntry| $ 37))) + (SPADCALL |c1| 0 + (|getShellEntry| $ 34))) + (T + (SEQ + (SETQ |c2| + (SPADCALL + (SPADCALL |p1| + (|getShellEntry| $ 40)) + (SPADCALL |p2| + (|getShellEntry| $ 40)) + (|getShellEntry| $ 10))) + (EXIT (SPADCALL - (LET - ((#0# - (SPADCALL - (SPADCALL |c2| |p| - (|getShellEntry| $ - 41)) - (SPADCALL |p| - (|getShellEntry| $ - 40)) - (|getShellEntry| $ - 27)))) - (|check-union| - (ZEROP (CAR #0#)) - (|SparseUnivariatePolynomial| - (SVREF $ 6)) - #0#) - (CDR #0#)) - (|getShellEntry| $ 42)) - (|getShellEntry| $ 41)) - (|getShellEntry| $ 25))))))))))) - (EXIT (COND - ((ZEROP |e1|) |p1|) - (T (SPADCALL - (SPADCALL (|spadConstant| $ 16) |e1| - (|getShellEntry| $ 34)) - |p1| (|getShellEntry| $ 44))))))))))) + (SPADCALL |c1| + (SPADCALL + (LET + ((#0# + (SPADCALL + (SPADCALL |c2| |p| + (|getShellEntry| $ + 41)) + (SPADCALL |p| + (|getShellEntry| $ + 40)) + (|getShellEntry| $ + 27)))) + (|check-union| + (ZEROP (CAR #0#)) + (|SparseUnivariatePolynomial| + (SVREF $ 6)) + #0#) + (CDR #0#)) + (|getShellEntry| $ 42)) + (|getShellEntry| $ 41)) + (|getShellEntry| $ 25))))))))))) + (EXIT (COND + ((ZEROP |e1|) |p1|) + (T (SPADCALL + (SPADCALL (|spadConstant| $ 16) |e1| + (|getShellEntry| $ 34)) + |p1| (|getShellEntry| $ 44)))))))))))) (DEFUN |GcdDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) |