diff options
Diffstat (limited to 'src/algebra/strap/POLYCAT-.lsp')
| -rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 61 |
1 files changed, 33 insertions, 28 deletions
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index b14697e2..9f42bd88 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -142,8 +142,8 @@ |POLYCAT-;convert;SIf;43|)) (DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) - (PROG (#0=#:G1688 #1=#:G1426 #2=#:G1689 #3=#:G1690 |lvar| #4=#:G1691 - |e| #5=#:G1692) + (PROG (#0=#:G1689 #1=#:G1427 #2=#:G1690 #3=#:G1691 |lvar| #4=#:G1692 + |e| #5=#:G1693) (RETURN (SEQ (COND ((NULL |l|) |p|) @@ -261,7 +261,7 @@ ('T (CONS 0 |l|)))))) (DEFUN |POLYCAT-;isTimes;SU;4| (|p| $) - (PROG (|lv| #0=#:G1693 |v| #1=#:G1694 |l| |r|) + (PROG (|lv| #0=#:G1694 |v| #1=#:G1695 |l| |r|) (RETURN (SEQ (COND ((OR (NULL (LETT |lv| @@ -362,7 +362,7 @@ (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 56))))) (DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) - (PROG (#0=#:G1477 |q|) + (PROG (#0=#:G1478 |q|) (RETURN (SEQ (LETT |q| (PROG2 (LETT #0# (SPADCALL |p| (|getShellEntry| $ 43)) @@ -378,7 +378,7 @@ ('T (|error| "Polynomial is not a single variable")))))))) (DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) - (PROG (|q| #0=#:G1485) + (PROG (|q| #0=#:G1486) (RETURN (SEQ (EXIT (SEQ (SEQ (LETT |q| (SPADCALL |p| (|getShellEntry| $ 43)) @@ -402,7 +402,7 @@ (|getShellEntry| $ 62))) (DEFUN |POLYCAT-;primitiveMonomials;SL;12| (|p| $) - (PROG (#0=#:G1695 |q| #1=#:G1696) + (PROG (#0=#:G1696 |q| #1=#:G1697) (RETURN (SEQ (PROGN (LETT #0# NIL |POLYCAT-;primitiveMonomials;SL;12|) @@ -425,7 +425,7 @@ (GO G190) G191 (EXIT (NREVERSE0 #0#)))))))) (DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) - (PROG (#0=#:G1491 |d| |u|) + (PROG (#0=#:G1492 |d| |u|) (RETURN (SEQ (COND ((SPADCALL |p| (|getShellEntry| $ 64)) 0) @@ -465,7 +465,7 @@ (EXIT |d|)))))))) (DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) - (PROG (#0=#:G1499 |v| |w| |d| |u|) + (PROG (#0=#:G1500 |v| |w| |d| |u|) (RETURN (SEQ (COND ((SPADCALL |p| (|getShellEntry| $ 64)) 0) @@ -522,7 +522,7 @@ (|getShellEntry| $ 77))) (DEFUN |POLYCAT-;allMonoms| (|l| $) - (PROG (#0=#:G1697 |p| #1=#:G1698) + (PROG (#0=#:G1698 |p| #1=#:G1699) (RETURN (SEQ (SPADCALL (SPADCALL @@ -549,7 +549,7 @@ (|getShellEntry| $ 82)))))) (DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) - (PROG (|w| |bj| #0=#:G1700 |i| #1=#:G1699) + (PROG (|w| |bj| #0=#:G1701 |i| #1=#:G1700) (RETURN (SEQ (LETT |w| (SPADCALL |n| (|spadConstant| $ 23) @@ -578,7 +578,7 @@ (EXIT |w|))))) (DEFUN |POLYCAT-;eq2R| (|l| |b| $) - (PROG (#0=#:G1701 |bj| #1=#:G1702 #2=#:G1703 |p| #3=#:G1704) + (PROG (#0=#:G1702 |bj| #1=#:G1703 #2=#:G1704 |p| #3=#:G1705) (RETURN (SEQ (SPADCALL (PROGN @@ -628,7 +628,7 @@ (|getShellEntry| $ 92)))))) (DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) - (PROG (#0=#:G1705 |r| #1=#:G1706 |b| #2=#:G1707 |bj| #3=#:G1708 |d| + (PROG (#0=#:G1706 |r| #1=#:G1707 |b| #2=#:G1708 |bj| #3=#:G1709 |d| |mm| |l|) (RETURN (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) @@ -702,7 +702,7 @@ (EXIT |mm|))))) (DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) - (PROG (#0=#:G1709 |s| #1=#:G1710 |b| #2=#:G1711 |bj| #3=#:G1712 |d| + (PROG (#0=#:G1710 |s| #1=#:G1711 |b| #2=#:G1712 |bj| #3=#:G1713 |d| |n| |mm| |w| |l| |r|) (RETURN (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 95)) @@ -806,8 +806,8 @@ (SPADCALL |pp| (|getShellEntry| $ 120))) (DEFUN |POLYCAT-;factor;SF;26| (|p| $) - (PROG (|v| |ansR| #0=#:G1713 |w| #1=#:G1714 |up| |ansSUP| #2=#:G1715 - |ww| #3=#:G1716) + (PROG (|v| |ansR| #0=#:G1714 |w| #1=#:G1715 |up| |ansSUP| #2=#:G1716 + |ww| #3=#:G1717) (RETURN (SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 43)) |POLYCAT-;factor;SF;26|) @@ -906,13 +906,13 @@ (|getShellEntry| $ 133))))))))))) (DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) - (PROG (|ll| #0=#:G1717 |z| #1=#:G1718 |ch| |l| #2=#:G1719 #3=#:G1720 - #4=#:G1582 #5=#:G1580 #6=#:G1581 #7=#:G1721 |vars| |degs| - #8=#:G1722 |d| #9=#:G1723 |nd| #10=#:G1609 #11=#:G1589 - |deg1| |redmons| #12=#:G1724 |v| #13=#:G1726 |u| - #14=#:G1725 |llR| |monslist| |ans| #15=#:G1727 - #16=#:G1728 |mons| #17=#:G1729 |m| #18=#:G1730 |i| - #19=#:G1605 #20=#:G1603 #21=#:G1604) + (PROG (|ll| #0=#:G1718 |z| #1=#:G1719 |ch| |l| #2=#:G1720 #3=#:G1721 + #4=#:G1583 #5=#:G1581 #6=#:G1582 #7=#:G1722 |vars| |degs| + #8=#:G1723 |d| #9=#:G1724 |nd| #10=#:G1610 #11=#:G1590 + |deg1| |redmons| #12=#:G1725 |v| #13=#:G1727 |u| + #14=#:G1726 |llR| |monslist| |ans| #15=#:G1728 + #16=#:G1729 |mons| #17=#:G1730 |m| #18=#:G1731 |i| + #19=#:G1606 #20=#:G1604 #21=#:G1605) (RETURN (SEQ (EXIT (SEQ (LETT |ll| (SPADCALL @@ -1068,7 +1068,10 @@ (QCDR |nd|) |POLYCAT-;conditionP;MU;27|) (|check-subtype| - (>= #11# 0) + (COND + ((< #11# 0) + 'NIL) + ('T 'T)) '(|NonNegativeInteger|) #11#)))))) #8#) @@ -1275,7 +1278,7 @@ $)))))))))) (DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) - (PROG (|v| |dd| |cp| |d| #0=#:G1630 |ans| |ansx| #1=#:G1637) + (PROG (|v| |dd| |cp| |d| #0=#:G1631 |ans| |ansx| #1=#:G1638) (RETURN (SEQ (EXIT (COND ((NULL |vars|) @@ -1353,7 +1356,9 @@ (LETT #0# (QCDR |dd|) |POLYCAT-;charthRootlv|) (|check-subtype| - (>= #0# 0) + (COND + ((< #0# 0) 'NIL) + ('T 'T)) '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 38)) @@ -1404,7 +1409,7 @@ (SPADCALL |p| (|getShellEntry| $ 166))) (DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $) - (PROG (|s| |f| #0=#:G1731 #1=#:G1651 #2=#:G1649 #3=#:G1650) + (PROG (|s| |f| #0=#:G1732 #1=#:G1652 #2=#:G1650 #3=#:G1651) (RETURN (SEQ (SPADCALL (SPADCALL @@ -1450,7 +1455,7 @@ (|getShellEntry| $ 173))) (DEFUN |POLYCAT-;primitivePart;2S;36| (|p| $) - (PROG (#0=#:G1655) + (PROG (#0=#:G1656) (RETURN (QVELT (SPADCALL (PROG2 (LETT #0# @@ -1466,7 +1471,7 @@ 1)))) (DEFUN |POLYCAT-;primitivePart;SVarSetS;37| (|p| |v| $) - (PROG (#0=#:G1661) + (PROG (#0=#:G1662) (RETURN (QVELT (SPADCALL (PROG2 (LETT #0# |