diff options
Diffstat (limited to 'src/algebra/strap/EUCDOM-.lsp')
| -rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 92 |
1 files changed, 47 insertions, 45 deletions
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 1cd2b434..ba98d42c 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -53,6 +53,8 @@ (PROG (|qr|) (RETURN (SEQ (COND + ((SPADCALL |x| (|getShellEntry| $ 8)) + (CONS 0 (|spadConstant| $ 16))) ((SPADCALL |y| (|getShellEntry| $ 8)) (CONS 1 "failed")) ('T (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 13)) @@ -66,9 +68,9 @@ (DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) (PROG (|#G13| |#G14|) (RETURN - (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 18)) + (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 19)) |EUCDOM-;gcd;3S;5|) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 18)) + (LETT |y| (SPADCALL |y| (|getShellEntry| $ 19)) |EUCDOM-;gcd;3S;5|) (SEQ G190 (COND @@ -77,12 +79,12 @@ (SEQ (PROGN (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) (LETT |#G14| - (SPADCALL |x| |y| (|getShellEntry| $ 19)) + (SPADCALL |x| |y| (|getShellEntry| $ 20)) |EUCDOM-;gcd;3S;5|) (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|)) (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 18)) + (SPADCALL |y| (|getShellEntry| $ 19)) |EUCDOM-;gcd;3S;5|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) @@ -92,7 +94,7 @@ (RETURN (SEQ (PROGN (LETT |#G16| - (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 22)) + (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 23)) |EUCDOM-;unitNormalizeIdealElt|) (LETT |u| (QVELT |#G16| 0) |EUCDOM-;unitNormalizeIdealElt|) @@ -102,12 +104,12 @@ |EUCDOM-;unitNormalizeIdealElt|) |#G16|) (EXIT (COND - ((SPADCALL |a| (|getShellEntry| $ 23)) |s|) + ((SPADCALL |a| (|getShellEntry| $ 24)) |s|) ('T (VECTOR (SPADCALL |a| (QVELT |s| 0) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (SPADCALL |a| (QVELT |s| 1) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) |c|)))))))) (DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) @@ -115,14 +117,14 @@ (RETURN (SEQ (LETT |s1| (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 25) - (|spadConstant| $ 26) |x|) + (VECTOR (|spadConstant| $ 26) + (|spadConstant| $ 16) |x|) $) |EUCDOM-;extendedEuclidean;2SR;7|) (LETT |s2| (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 26) - (|spadConstant| $ 25) |y|) + (VECTOR (|spadConstant| $ 16) + (|spadConstant| $ 26) |y|) $) |EUCDOM-;extendedEuclidean;2SR;7|) (EXIT (COND @@ -145,12 +147,12 @@ (SPADCALL (QVELT |s1| 0) (SPADCALL (QCAR |qr|) (QVELT |s2| 0) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (|getShellEntry| $ 27)) (SPADCALL (QVELT |s1| 1) (SPADCALL (QCAR |qr|) (QVELT |s2| 1) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (|getShellEntry| $ 27)) (QCDR |qr|)) |EUCDOM-;extendedEuclidean;2SR;7|) @@ -176,7 +178,7 @@ (QSETVELT |s1| 1 (SPADCALL (QVELT |s1| 1) (SPADCALL (QCAR |qr|) |x| - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (|getShellEntry| $ 29))) (EXIT (LETT |s1| @@ -191,7 +193,7 @@ (SEQ (COND ((SPADCALL |z| (|getShellEntry| $ 8)) (CONS 0 - (CONS (|spadConstant| $ 26) (|spadConstant| $ 26)))) + (CONS (|spadConstant| $ 16) (|spadConstant| $ 16)))) ('T (SEQ (LETT |s| (SPADCALL |x| |y| (|getShellEntry| $ 32)) |EUCDOM-;extendedEuclidean;3SU;8|) @@ -205,16 +207,16 @@ (CONS 0 (CONS (SPADCALL (QVELT |s| 0) (QCDR |w|) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (SPADCALL (QVELT |s| 1) (QCDR |w|) - (|getShellEntry| $ 24))))) + (|getShellEntry| $ 25))))) ('T (SEQ (LETT |qr| (SPADCALL (SPADCALL (QVELT |s| 0) (QCDR |w|) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) |y| (|getShellEntry| $ 13)) |EUCDOM-;extendedEuclidean;3SU;8|) (EXIT (CONS 0 @@ -222,13 +224,13 @@ (SPADCALL (SPADCALL (QVELT |s| 1) (QCDR |w|) - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (SPADCALL (QCAR |qr|) |x| - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) (|getShellEntry| $ 29)))))))))))))))) (DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $) - (PROG (|uca| |v| |u| #0=#:G1517 |vv| #1=#:G1518) + (PROG (|uca| |v| |u| #0=#:G1519 |vv| #1=#:G1520) (RETURN (SEQ (COND ((SPADCALL |l| NIL (|getShellEntry| $ 38)) @@ -236,7 +238,7 @@ ((SPADCALL (CDR |l|) NIL (|getShellEntry| $ 38)) (SEQ (LETT |uca| (SPADCALL (|SPADfirst| |l|) - (|getShellEntry| $ 22)) + (|getShellEntry| $ 23)) |EUCDOM-;principalIdeal;LR;9|) (EXIT (CONS (LIST (QVELT |uca| 0)) (QVELT |uca| 1))))) ((SPADCALL (CDR (CDR |l|)) NIL (|getShellEntry| $ 38)) @@ -278,7 +280,7 @@ (CONS (SPADCALL (QVELT |u| 1) |vv| - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) #0#) |EUCDOM-;principalIdeal;LR;9|))) (LETT #1# (CDR #1#) @@ -288,10 +290,10 @@ (QVELT |u| 2)))))))))) (DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $) - (PROG (#0=#:G1519 #1=#:G1520 |pid| |q| #2=#:G1521 |v| #3=#:G1522) + (PROG (#0=#:G1521 #1=#:G1522 |pid| |q| #2=#:G1523 |v| #3=#:G1524) (RETURN (SEQ (COND - ((SPADCALL |z| (|spadConstant| $ 26) + ((SPADCALL |z| (|spadConstant| $ 16) (|getShellEntry| $ 44)) (CONS 0 (PROGN @@ -310,7 +312,7 @@ NIL)) (GO G191))) (SEQ (EXIT (LETT #0# - (CONS (|spadConstant| $ 26) #0#) + (CONS (|spadConstant| $ 16) #0#) |EUCDOM-;expressIdealMember;LSU;10|))) (LETT #1# (CDR #1#) |EUCDOM-;expressIdealMember;LSU;10|) @@ -347,7 +349,7 @@ (LETT #2# (CONS (SPADCALL (QCDR |q|) |v| - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) #2#) |EUCDOM-;expressIdealMember;LSU;10|))) (LETT #3# (CDR #3#) @@ -356,9 +358,9 @@ (EXIT (NREVERSE0 #2#))))))))))))))) (DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) - (PROG (|n| |l1| |l2| #0=#:G1398 #1=#:G1523 #2=#:G1504 #3=#:G1502 - #4=#:G1503 #5=#:G1399 #6=#:G1524 #7=#:G1507 #8=#:G1505 - #9=#:G1506 |u| |v1| |v2|) + (PROG (|n| |l1| |l2| #0=#:G1398 #1=#:G1525 #2=#:G1506 #3=#:G1504 + #4=#:G1505 #5=#:G1399 #6=#:G1526 #7=#:G1509 #8=#:G1507 + #9=#:G1508 |u| |v1| |v2|) (RETURN (SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) (EXIT (COND @@ -400,7 +402,7 @@ (#4# (LETT #3# (SPADCALL #3# #2# - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) |EUCDOM-;multiEuclidean;LSU;11|)) ('T (PROGN @@ -413,7 +415,7 @@ (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) - ('T (|spadConstant| $ 25)))) + ('T (|spadConstant| $ 26)))) (PROGN (LETT #9# NIL |EUCDOM-;multiEuclidean;LSU;11|) @@ -439,7 +441,7 @@ (#9# (LETT #8# (SPADCALL #8# #7# - (|getShellEntry| $ 24)) + (|getShellEntry| $ 25)) |EUCDOM-;multiEuclidean;LSU;11|)) ('T (PROGN @@ -452,7 +454,7 @@ (GO G190) G191 (EXIT NIL)) (COND (#9# #8#) - ('T (|spadConstant| $ 25)))) + ('T (|spadConstant| $ 26)))) |z| (|getShellEntry| $ 50)) |EUCDOM-;multiEuclidean;LSU;11|) (EXIT (COND @@ -505,12 +507,12 @@ |EUCDOM-;sizeLess?;2SB;1| (|Record| (|:| |quotient| $) (|:| |remainder| $)) (10 . |divide|) |EUCDOM-;quo;3S;2| |EUCDOM-;rem;3S;3| - (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| - (16 . |unitCanonical|) (21 . |rem|) |EUCDOM-;gcd;3S;5| + (16 . |Zero|) (|Union| $ '"failed") |EUCDOM-;exquo;2SU;4| + (20 . |unitCanonical|) (25 . |rem|) |EUCDOM-;gcd;3S;5| (|Record| (|:| |unit| $) (|:| |canonical| $) (|:| |associate| $)) - (27 . |unitNormal|) (32 . |one?|) (37 . *) (43 . |One|) - (47 . |Zero|) (51 . -) (57 . |sizeLess?|) (63 . +) + (31 . |unitNormal|) (36 . |one?|) (41 . *) (47 . |One|) + (51 . -) (57 . |sizeLess?|) (63 . +) (|Record| (|:| |coef1| $) (|:| |coef2| $) (|:| |generator| $)) |EUCDOM-;extendedEuclidean;2SR;7| @@ -533,16 +535,16 @@ (CONS '#() (CONS '#() (|makeByteWordVec2| 53 - '(1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 1 - 6 0 0 18 2 6 0 0 0 19 1 6 21 0 22 1 6 - 7 0 23 2 6 0 0 0 24 0 6 0 25 0 6 0 26 + '(1 6 7 0 8 1 6 9 0 10 2 6 12 0 0 13 0 + 6 0 16 1 6 0 0 19 2 6 0 0 0 20 1 6 22 + 0 23 1 6 7 0 24 2 6 0 0 0 25 0 6 0 26 2 6 0 0 0 27 2 6 7 0 0 28 2 6 0 0 0 - 29 2 6 30 0 0 32 2 6 16 0 0 33 2 37 7 + 29 2 6 30 0 0 32 2 6 17 0 0 33 2 37 7 0 0 38 1 37 6 0 39 1 6 41 40 42 2 6 7 0 0 44 1 37 0 0 47 2 37 0 0 48 49 3 6 35 0 0 0 50 2 6 45 40 0 51 2 37 0 0 0 52 2 0 7 0 0 11 2 0 0 0 0 15 2 0 0 0 0 14 1 0 41 40 43 2 0 45 40 0 53 2 0 - 0 0 0 20 3 0 35 0 0 0 36 2 0 30 0 0 - 31 2 0 16 0 0 17 2 0 45 40 0 46))))) + 0 0 0 21 3 0 35 0 0 0 36 2 0 30 0 0 + 31 2 0 17 0 0 18 2 0 45 40 0 46))))) '|lookupComplete|)) |