aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap/EUCDOM-.lsp
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap/EUCDOM-.lsp')
-rw-r--r--src/algebra/strap/EUCDOM-.lsp204
1 files changed, 87 insertions, 117 deletions
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index f391c801..33f3078c 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -49,18 +49,15 @@
(CDR (SPADCALL |x| |y| (|getShellEntry| $ 16))))
(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $)
- (PROG (|qr|)
- (RETURN
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 8))
- (CONS 0 (|spadConstant| $ 19)))
- ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed"))
- (T (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 16))
- |EUCDOM-;exquo;2SU;4|)
- (EXIT (COND
- ((SPADCALL (CDR |qr|) (|getShellEntry| $ 8))
- (CONS 0 (CAR |qr|)))
- (T (CONS 1 "failed"))))))))))
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 8))
+ (CONS 0 (|spadConstant| $ 19)))
+ ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed"))
+ (T (LET ((|qr| (SPADCALL |x| |y| (|getShellEntry| $ 16))))
+ (COND
+ ((SPADCALL (CDR |qr|) (|getShellEntry| $ 8))
+ (CONS 0 (CAR |qr|)))
+ (T (CONS 1 "failed")))))))
(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $)
(PROG (|#G13| |#G14|)
@@ -158,120 +155,93 @@
(EXIT |s1|))))))))
(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $)
- (PROG (|s| |w| |qr|)
+ (PROG (|qr|)
(RETURN
(COND
((SPADCALL |z| (|getShellEntry| $ 8))
(CONS 0 (CONS (|spadConstant| $ 19) (|spadConstant| $ 19))))
- (T (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 36))
- |EUCDOM-;extendedEuclidean;3SU;8|)
- (LETT |w|
- (SPADCALL |z| (SVREF |s| 2)
- (|getShellEntry| $ 37))
- |EUCDOM-;extendedEuclidean;3SU;8|)
- (EXIT (COND
- ((EQL (CAR |w|) 1) (CONS 1 "failed"))
- ((SPADCALL |y| (|getShellEntry| $ 8))
- (CONS 0
- (CONS (SPADCALL (SVREF |s| 0) (CDR |w|)
- (|getShellEntry| $ 29))
+ (T (LET* ((|s| (SPADCALL |x| |y| (|getShellEntry| $ 36)))
+ (|w| (SPADCALL |z| (SVREF |s| 2)
+ (|getShellEntry| $ 37))))
+ (COND
+ ((EQL (CAR |w|) 1) (CONS 1 "failed"))
+ ((SPADCALL |y| (|getShellEntry| $ 8))
+ (CONS 0
+ (CONS (SPADCALL (SVREF |s| 0) (CDR |w|)
+ (|getShellEntry| $ 29))
+ (SPADCALL (SVREF |s| 1) (CDR |w|)
+ (|getShellEntry| $ 29)))))
+ (T (SEQ (LETT |qr|
+ (SPADCALL
+ (SPADCALL (SVREF |s| 0) (CDR |w|)
+ (|getShellEntry| $ 29))
+ |y| (|getShellEntry| $ 16))
+ |EUCDOM-;extendedEuclidean;3SU;8|)
+ (EXIT (CONS 0
+ (CONS (CDR |qr|)
+ (SPADCALL
(SPADCALL (SVREF |s| 1) (CDR |w|)
- (|getShellEntry| $ 29)))))
- (T (SEQ (LETT |qr|
- (SPADCALL
- (SPADCALL (SVREF |s| 0)
- (CDR |w|)
- (|getShellEntry| $ 29))
- |y| (|getShellEntry| $ 16))
- |EUCDOM-;extendedEuclidean;3SU;8|)
- (EXIT (CONS 0
- (CONS (CDR |qr|)
- (SPADCALL
- (SPADCALL (SVREF |s| 1)
- (CDR |w|)
- (|getShellEntry| $ 29))
- (SPADCALL (CAR |qr|) |x|
- (|getShellEntry| $ 29))
- (|getShellEntry| $ 33)))))))))))))))
+ (|getShellEntry| $ 29))
+ (SPADCALL (CAR |qr|) |x|
+ (|getShellEntry| $ 29))
+ (|getShellEntry| $ 33))))))))))))))
(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $)
- (PROG (|uca| |v| |u|)
- (RETURN
- (COND
- ((SPADCALL |l| NIL (|getShellEntry| $ 42))
- (|error| "empty list passed to principalIdeal"))
- ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 42))
- (SEQ (LETT |uca|
- (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 27))
- |EUCDOM-;principalIdeal;LR;9|)
- (EXIT (CONS (LIST (SVREF |uca| 0)) (SVREF |uca| 1)))))
- ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 42))
- (SEQ (LETT |u|
- (SPADCALL (|SPADfirst| |l|)
- (SPADCALL |l| (|getShellEntry| $ 45))
- (|getShellEntry| $ 36))
- |EUCDOM-;principalIdeal;LR;9|)
- (EXIT (CONS (LIST (SVREF |u| 0) (SVREF |u| 1))
- (SVREF |u| 2)))))
- (T (SEQ (LETT |v| (SPADCALL (CDR |l|) (|getShellEntry| $ 48))
- |EUCDOM-;principalIdeal;LR;9|)
- (LETT |u|
- (SPADCALL (|SPADfirst| |l|) (CDR |v|)
- (|getShellEntry| $ 36))
- |EUCDOM-;principalIdeal;LR;9|)
- (EXIT (CONS (CONS (SVREF |u| 0)
- (LET ((#0=#:G1494 (CAR |v|))
- (#1=#:G1493 NIL))
- (LOOP
- (COND
- ((ATOM #0#)
- (RETURN (NREVERSE #1#)))
- (T
- (LET ((|vv| (CAR #0#)))
- (SETQ #1#
- (CONS
- (SPADCALL (SVREF |u| 1)
- |vv|
- (|getShellEntry| $ 29))
- #1#)))))
- (SETQ #0# (CDR #0#)))))
- (SVREF |u| 2)))))))))
+ (COND
+ ((SPADCALL |l| NIL (|getShellEntry| $ 42))
+ (|error| "empty list passed to principalIdeal"))
+ ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 42))
+ (LET ((|uca| (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 27))))
+ (CONS (LIST (SVREF |uca| 0)) (SVREF |uca| 1))))
+ ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 42))
+ (LET ((|u| (SPADCALL (|SPADfirst| |l|)
+ (SPADCALL |l| (|getShellEntry| $ 45))
+ (|getShellEntry| $ 36))))
+ (CONS (LIST (SVREF |u| 0) (SVREF |u| 1)) (SVREF |u| 2))))
+ (T (LET* ((|v| (SPADCALL (CDR |l|) (|getShellEntry| $ 48)))
+ (|u| (SPADCALL (|SPADfirst| |l|) (CDR |v|)
+ (|getShellEntry| $ 36))))
+ (CONS (CONS (SVREF |u| 0)
+ (LET ((#0=#:G1494 (CAR |v|)) (#1=#:G1493 NIL))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN (NREVERSE #1#)))
+ (T (LET ((|vv| (CAR #0#)))
+ (SETQ #1#
+ (CONS
+ (SPADCALL (SVREF |u| 1) |vv|
+ (|getShellEntry| $ 29))
+ #1#)))))
+ (SETQ #0# (CDR #0#)))))
+ (SVREF |u| 2))))))
(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $)
- (PROG (|pid| |q|)
- (RETURN
- (COND
- ((SPADCALL |z| (|spadConstant| $ 19) (|getShellEntry| $ 51))
- (CONS 0
- (LET ((#0=#:G1496 |l|) (#1=#:G1495 NIL))
- (LOOP
- (COND
- ((ATOM #0#) (RETURN (NREVERSE #1#)))
- (T (LET ((|v| (CAR #0#)))
- (SETQ #1# (CONS (|spadConstant| $ 19) #1#)))))
- (SETQ #0# (CDR #0#))))))
- (T (SEQ (LETT |pid| (SPADCALL |l| (|getShellEntry| $ 48))
- |EUCDOM-;expressIdealMember;LSU;10|)
- (LETT |q|
- (SPADCALL |z| (CDR |pid|) (|getShellEntry| $ 37))
- |EUCDOM-;expressIdealMember;LSU;10|)
- (EXIT (COND
- ((EQL (CAR |q|) 1) (CONS 1 "failed"))
- (T (CONS 0
- (LET ((#2=#:G1498 (CAR |pid|))
- (#3=#:G1497 NIL))
- (LOOP
- (COND
- ((ATOM #2#)
- (RETURN (NREVERSE #3#)))
- (T
- (LET ((|v| (CAR #2#)))
- (SETQ #3#
- (CONS
- (SPADCALL (CDR |q|) |v|
- (|getShellEntry| $ 29))
- #3#)))))
- (SETQ #2# (CDR #2#))))))))))))))
+ (COND
+ ((SPADCALL |z| (|spadConstant| $ 19) (|getShellEntry| $ 51))
+ (CONS 0
+ (LET ((#0=#:G1496 |l|) (#1=#:G1495 NIL))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN (NREVERSE #1#)))
+ (T (LET ((|v| (CAR #0#)))
+ (SETQ #1# (CONS (|spadConstant| $ 19) #1#)))))
+ (SETQ #0# (CDR #0#))))))
+ (T (LET* ((|pid| (SPADCALL |l| (|getShellEntry| $ 48)))
+ (|q| (SPADCALL |z| (CDR |pid|) (|getShellEntry| $ 37))))
+ (COND
+ ((EQL (CAR |q|) 1) (CONS 1 "failed"))
+ (T (CONS 0
+ (LET ((#2=#:G1498 (CAR |pid|)) (#3=#:G1497 NIL))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (NREVERSE #3#)))
+ (T (LET ((|v| (CAR #2#)))
+ (SETQ #3#
+ (CONS
+ (SPADCALL (CDR |q|) |v|
+ (|getShellEntry| $ 29))
+ #3#)))))
+ (SETQ #2# (CDR #2#)))))))))))
(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $)
(PROG (|l1| |l2| |u| |v1| |v2|)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-04 01:38:39 +0000