diff options
Diffstat (limited to 'src/algebra/strap/EUCDOM-.lsp')
-rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 438 |
1 files changed, 219 insertions, 219 deletions
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 8e091370..9a28b2bf 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -39,9 +39,8 @@ (COND ((SPADCALL |y| (|getShellEntry| $ 8)) NIL) ((SPADCALL |x| (|getShellEntry| $ 8)) T) - ('T - (< (SPADCALL |x| (|getShellEntry| $ 12)) - (SPADCALL |y| (|getShellEntry| $ 12)))))) + (T (< (SPADCALL |x| (|getShellEntry| $ 12)) + (SPADCALL |y| (|getShellEntry| $ 12)))))) (DEFUN |EUCDOM-;quo;3S;2| (|x| |y| $) (CAR (SPADCALL |x| |y| (|getShellEntry| $ 16)))) @@ -56,13 +55,14 @@ ((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"))))))))))) + (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"))))))))))) (DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) (PROG (|#G13| |#G14|) @@ -90,12 +90,11 @@ (SEQ |#G16| (EXIT (COND ((SPADCALL |a| (|getShellEntry| $ 28)) |s|) - ('T - (VECTOR (SPADCALL |a| (QVELT |s| 0) - (|getShellEntry| $ 29)) - (SPADCALL |a| (QVELT |s| 1) - (|getShellEntry| $ 29)) - |c|))))))) + (T (VECTOR (SPADCALL |a| (QVELT |s| 0) + (|getShellEntry| $ 29)) + (SPADCALL |a| (QVELT |s| 1) + (|getShellEntry| $ 29)) + |c|))))))) (DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) (PROG (|s3| |qr|) @@ -111,53 +110,54 @@ (COND ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) - ('T - (SEQ (LOOP - (COND - ((NOT (NOT (SPADCALL (QVELT |s2| 2) - (|getShellEntry| $ 8)))) - (RETURN NIL)) - (T (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 2) - (QVELT |s2| 2) - (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s3| - (VECTOR (SPADCALL (QVELT |s1| 0) - (SPADCALL (CAR |qr|) - (QVELT |s2| 0) - (|getShellEntry| $ 29)) - (|getShellEntry| $ 31)) - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) - (QVELT |s2| 1) - (|getShellEntry| $ 29)) - (|getShellEntry| $ 31)) - (CDR |qr|)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (SETQ |s1| |s2|) - (EXIT (SETQ |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $))))))) - (COND - ((NOT (SPADCALL (QVELT |s1| 0) (|getShellEntry| $ 8))) - (COND - ((NOT (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 32))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 0) |y| + (T (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL (QVELT |s2| 2) + (|getShellEntry| $ 8)))) + (RETURN NIL)) + (T (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 2) + (QVELT |s2| 2) (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (QSETVELT |s1| 0 (CDR |qr|)) - (QSETVELT |s1| 1 - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) |x| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 33))) - (EXIT (SETQ |s1| - (|EUCDOM-;unitNormalizeIdealElt| - |s1| $)))))))) - (EXIT |s1|)))))))) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s3| + (VECTOR + (SPADCALL (QVELT |s1| 0) + (SPADCALL (CAR |qr|) + (QVELT |s2| 0) + (|getShellEntry| $ 29)) + (|getShellEntry| $ 31)) + (SPADCALL (QVELT |s1| 1) + (SPADCALL (CAR |qr|) + (QVELT |s2| 1) + (|getShellEntry| $ 29)) + (|getShellEntry| $ 31)) + (CDR |qr|)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (SETQ |s1| |s2|) + (EXIT (SETQ |s2| + (|EUCDOM-;unitNormalizeIdealElt| + |s3| $))))))) + (COND + ((NOT (SPADCALL (QVELT |s1| 0) + (|getShellEntry| $ 8))) + (COND + ((NOT (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 32))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 16)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (QSETVELT |s1| 0 (CDR |qr|)) + (QSETVELT |s1| 1 + (SPADCALL (QVELT |s1| 1) + (SPADCALL (CAR |qr|) |x| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 33))) + (EXIT (SETQ |s1| + (|EUCDOM-;unitNormalizeIdealElt| + |s1| $)))))))) + (EXIT |s1|)))))))) (DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) (PROG (|s| |w| |qr|) @@ -166,40 +166,39 @@ ((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| (QVELT |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 (QVELT |s| 0) - (CDR |w|) - (|getShellEntry| $ 29)) - (SPADCALL (QVELT |s| 1) - (CDR |w|) - (|getShellEntry| $ 29))))) - ('T - (SEQ (LETT |qr| - (SPADCALL - (SPADCALL (QVELT |s| 0) - (CDR |w|) - (|getShellEntry| $ 29)) - |y| (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;3SU;8|) - (EXIT (CONS 0 - (CONS (CDR |qr|) - (SPADCALL - (SPADCALL (QVELT |s| 1) - (CDR |w|) - (|getShellEntry| $ 29)) - (SPADCALL (CAR |qr|) |x| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 33)))))))))))))))) + (T (SEQ (LETT |s| + (SPADCALL |x| |y| (|getShellEntry| $ 36)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (LETT |w| + (SPADCALL |z| (QVELT |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 (QVELT |s| 0) (CDR |w|) + (|getShellEntry| $ 29)) + (SPADCALL (QVELT |s| 1) (CDR |w|) + (|getShellEntry| $ 29))))) + (T (SEQ (LETT |qr| + (SPADCALL + (SPADCALL (QVELT |s| 0) + (CDR |w|) + (|getShellEntry| $ 29)) + |y| (|getShellEntry| $ 16)) + |EUCDOM-;extendedEuclidean;3SU;8|) + (EXIT + (CONS 0 + (CONS (CDR |qr|) + (SPADCALL + (SPADCALL (QVELT |s| 1) + (CDR |w|) + (|getShellEntry| $ 29)) + (SPADCALL (CAR |qr|) |x| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 33)))))))))))))))) (DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) (PROG (|uca| |v| |u|) @@ -221,32 +220,32 @@ |EUCDOM-;principalIdeal;LR;9|) (EXIT (CONS (LIST (QVELT |u| 0) (QVELT |u| 1)) (QVELT |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 (QVELT |u| 0) - (LET - ((#0=#:G1519 (CAR |v|)) - (#1=#:G1518 NIL)) - (LOOP - (COND - ((ATOM #0#) - (RETURN (NREVERSE #1#))) - (T - (LET ((|vv| (CAR #0#))) - (SETQ #1# - (CONS - (SPADCALL (QVELT |u| 1) - |vv| - (|getShellEntry| $ 29)) - #1#))))) - (SETQ #0# (CDR #0#))))) - (QVELT |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 (QVELT |u| 0) + (LET + ((#0=#:G1519 (CAR |v|)) + (#1=#:G1518 NIL)) + (LOOP + (COND + ((ATOM #0#) + (RETURN (NREVERSE #1#))) + (T + (LET ((|vv| (CAR #0#))) + (SETQ #1# + (CONS + (SPADCALL + (QVELT |u| 1) |vv| + (|getShellEntry| $ + 29)) + #1#))))) + (SETQ #0# (CDR #0#))))) + (QVELT |u| 2)))))))))) (DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) (PROG (|pid| |q|) @@ -263,31 +262,32 @@ (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=#:G1523 (CAR |pid|)) + (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=#:G1523 (CAR |pid|)) (#3=#:G1522 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#))))))))))))))) + (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|) @@ -296,80 +296,80 @@ (COND ((ZEROP |n|) (|error| "empty list passed to multiEuclidean")) ((EQL |n| 1) (CONS 0 (LIST |z|))) - ('T - (SEQ (LETT |l1| (SPADCALL |l| (|getShellEntry| $ 58)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |l2| - (SPADCALL |l1| (QUOTIENT2 |n| 2) - (|getShellEntry| $ 61)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |u| - (SPADCALL - (LET ((#0=#:G1504 NIL) (#1=#:G1505 T) - (#2=#:G1524 |l1|)) - (LOOP - (COND - ((ATOM #2#) - (RETURN - (COND - (#1# (|spadConstant| $ 30)) - (T #0#)))) - (T (LET ((#3=#:G1397 (CAR #2#))) - (LET ((#4=#:G1503 #3#)) - (COND - (#1# (SETQ #0# #4#)) - (T - (SETQ #0# - (SPADCALL #0# #4# - (|getShellEntry| $ 29))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (LET ((#5=#:G1507 NIL) (#6=#:G1508 T) - (#7=#:G1525 |l2|)) - (LOOP - (COND - ((ATOM #7#) - (RETURN - (COND - (#6# (|spadConstant| $ 30)) - (T #5#)))) - (T (LET ((#8=#:G1398 (CAR #7#))) - (LET ((#9=#:G1506 #8#)) - (COND - (#6# (SETQ #5# #9#)) - (T - (SETQ #5# - (SPADCALL #5# #9# - (|getShellEntry| $ 29))))) - (SETQ #6# NIL))))) - (SETQ #7# (CDR #7#)))) - |z| (|getShellEntry| $ 62)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |u|) 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |v1| - (SPADCALL |l1| (CDR (CDR |u|)) - (|getShellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |v1|) 1) - (CONS 1 "failed")) - ('T - (SEQ - (LETT |v2| - (SPADCALL |l2| (CAR (CDR |u|)) - (|getShellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT + (T (SEQ (LETT |l1| (SPADCALL |l| (|getShellEntry| $ 58)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |l2| + (SPADCALL |l1| (QUOTIENT2 |n| 2) + (|getShellEntry| $ 61)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |u| + (SPADCALL + (LET ((#0=#:G1504 NIL) (#1=#:G1505 T) + (#2=#:G1524 |l1|)) + (LOOP + (COND + ((ATOM #2#) + (RETURN + (COND + (#1# (|spadConstant| $ 30)) + (T #0#)))) + (T (LET ((#3=#:G1397 (CAR #2#))) + (LET ((#4=#:G1503 #3#)) (COND - ((EQL (CAR |v2|) 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (CDR |v1|) - (CDR |v2|) - (|getShellEntry| $ 64))))))))))))))))))))) + (#1# (SETQ #0# #4#)) + (T + (SETQ #0# + (SPADCALL #0# #4# + (|getShellEntry| $ 29))))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (LET ((#5=#:G1507 NIL) (#6=#:G1508 T) + (#7=#:G1525 |l2|)) + (LOOP + (COND + ((ATOM #7#) + (RETURN + (COND + (#6# (|spadConstant| $ 30)) + (T #5#)))) + (T (LET ((#8=#:G1398 (CAR #7#))) + (LET ((#9=#:G1506 #8#)) + (COND + (#6# (SETQ #5# #9#)) + (T + (SETQ #5# + (SPADCALL #5# #9# + (|getShellEntry| $ 29))))) + (SETQ #6# NIL))))) + (SETQ #7# (CDR #7#)))) + |z| (|getShellEntry| $ 62)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((EQL (CAR |u|) 1) (CONS 1 "failed")) + (T (SEQ (LETT |v1| + (SPADCALL |l1| (CDR (CDR |u|)) + (|getShellEntry| $ 63)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((EQL (CAR |v1|) 1) + (CONS 1 "failed")) + (T + (SEQ + (LETT |v2| + (SPADCALL |l2| + (CAR (CDR |u|)) + (|getShellEntry| $ 63)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((EQL (CAR |v2|) 1) + (CONS 1 "failed")) + (T + (CONS 0 + (SPADCALL (CDR |v1|) + (CDR |v2|) + (|getShellEntry| $ + 64))))))))))))))))))))) (DEFUN |EuclideanDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) |