aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap/GCDDOM-.lsp
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap/GCDDOM-.lsp')
-rw-r--r--src/algebra/strap/GCDDOM-.lsp252
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|))
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 01:36:42 +0000