aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/CLAGG-.lsp201
-rw-r--r--src/algebra/strap/EUCDOM-.lsp124
-rw-r--r--src/algebra/strap/FFIELDC-.lsp59
-rw-r--r--src/algebra/strap/HOAGG-.lsp233
-rw-r--r--src/algebra/strap/ISTRING.lsp45
-rw-r--r--src/algebra/strap/POLYCAT-.lsp296
-rw-r--r--src/algebra/strap/UFD-.lsp52
7 files changed, 414 insertions, 596 deletions
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp
index 6d50e7cb..eb404d15 100644
--- a/src/algebra/strap/CLAGG-.lsp
+++ b/src/algebra/strap/CLAGG-.lsp
@@ -45,123 +45,90 @@
(LENGTH (SPADCALL |c| (|getShellEntry| $ 9))))
(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $)
- (PROG (|x| #0=#:G1429 #1=#:G1403 #2=#:G1401 #3=#:G1402)
- (RETURN
- (SEQ (PROGN
- (LETT #3# NIL |CLAGG-;count;MANni;2|)
- (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|)
- (LETT #0# (SPADCALL |c| (|getShellEntry| $ 9))
- |CLAGG-;count;MANni;2|)
- G190
- (COND
- ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL))
- (GO G191)))
- (COND
- ((SPADCALL |x| |f|)
- (PROGN
- (LETT #1# 1 |CLAGG-;count;MANni;2|)
- (COND
- (#3# (LETT #2# (+ #2# #1#)
- |CLAGG-;count;MANni;2|))
- ('T
- (PROGN
- (LETT #2# #1# |CLAGG-;count;MANni;2|)
- (LETT #3# 'T |CLAGG-;count;MANni;2|)))))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T 0)))))))
+ (LET ((#0=#:G1402 NIL) (#1=#:G1403 T)
+ (#2=#:G1429 (SPADCALL |c| (|getShellEntry| $ 9))))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#))))
+ (T (LET ((|x| (CAR #2#)))
+ (AND (SPADCALL |x| |f|)
+ (LET ((#3=#:G1401 1))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0# (+ #0# #3#))))
+ (SETQ #1# NIL))))))
+ (SETQ #2# (CDR #2#)))))
(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $)
- (PROG (|x| #0=#:G1430 #1=#:G1408 #2=#:G1406 #3=#:G1407)
- (RETURN
- (SEQ (PROGN
- (LETT #3# NIL |CLAGG-;any?;MAB;3|)
- (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|)
- (LETT #0# (SPADCALL |c| (|getShellEntry| $ 9))
- |CLAGG-;any?;MAB;3|)
- G190
- (COND
- ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #1# (SPADCALL |x| |f|) |CLAGG-;any?;MAB;3|)
- (COND
- (#3# (LETT #2# (COND (#2# T) ('T #1#))
- |CLAGG-;any?;MAB;3|))
- ('T
- (PROGN
- (LETT #2# #1# |CLAGG-;any?;MAB;3|)
- (LETT #3# 'T |CLAGG-;any?;MAB;3|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T NIL)))))))
+ (LET ((#0=#:G1407 NIL) (#1=#:G1408 T)
+ (#2=#:G1430 (SPADCALL |c| (|getShellEntry| $ 9))))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# NIL) (T #0#))))
+ (T (LET ((|x| (CAR #2#)))
+ (LET ((#3=#:G1406 (SPADCALL |x| |f|)))
+ (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#)))))
(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $)
- (PROG (|x| #0=#:G1431 #1=#:G1412 #2=#:G1410 #3=#:G1411)
- (RETURN
- (SEQ (PROGN
- (LETT #3# NIL |CLAGG-;every?;MAB;4|)
- (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|)
- (LETT #0# (SPADCALL |c| (|getShellEntry| $ 9))
- |CLAGG-;every?;MAB;4|)
- G190
- (COND
- ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #1# (SPADCALL |x| |f|) |CLAGG-;every?;MAB;4|)
- (COND
- (#3# (LETT #2# (COND (#2# #1#) ('T NIL))
- |CLAGG-;every?;MAB;4|))
- ('T
- (PROGN
- (LETT #2# #1# |CLAGG-;every?;MAB;4|)
- (LETT #3# 'T |CLAGG-;every?;MAB;4|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T T)))))))
+ (LET ((#0=#:G1411 NIL) (#1=#:G1412 T)
+ (#2=#:G1431 (SPADCALL |c| (|getShellEntry| $ 9))))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# T) (T #0#))))
+ (T (LET ((|x| (CAR #2#)))
+ (LET ((#3=#:G1410 (SPADCALL |x| |f|)))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0# (AND #0# #3#))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#)))))
(DEFUN |CLAGG-;find;MAU;5| (|f| |c| $)
(SPADCALL |f| (SPADCALL |c| (|getShellEntry| $ 9))
- (|getShellEntry| $ 24)))
+ (|getShellEntry| $ 26)))
(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $)
(SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9))
- (|getShellEntry| $ 27)))
+ (|getShellEntry| $ 29)))
(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $)
(SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) |s|
- (|getShellEntry| $ 29)))
+ (|getShellEntry| $ 31)))
(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $)
(SPADCALL (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9))
- (|getShellEntry| $ 31))
- (|getShellEntry| $ 32)))
+ (|getShellEntry| $ 33))
+ (|getShellEntry| $ 34)))
(DEFUN |CLAGG-;select;M2A;9| (|f| |x| $)
(SPADCALL (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9))
- (|getShellEntry| $ 34))
- (|getShellEntry| $ 32)))
+ (|getShellEntry| $ 36))
+ (|getShellEntry| $ 34)))
(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $)
(SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x|
- (|getShellEntry| $ 37)))
+ (|getShellEntry| $ 39)))
(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$)
(SPADCALL |#1| (|getShellEntry| $$ 1)
- (|getShellEntry| (|getShellEntry| $$ 0) 36)))
+ (|getShellEntry| (|getShellEntry| $$ 0) 38)))
(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $)
(SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) |s1| |s2|
- (|getShellEntry| $ 39)))
+ (|getShellEntry| $ 41)))
(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $)
(SPADCALL
(SPADCALL (SPADCALL |x| (|getShellEntry| $ 9))
- (|getShellEntry| $ 41))
- (|getShellEntry| $ 32)))
+ (|getShellEntry| $ 43))
+ (|getShellEntry| $ 34)))
(DEFUN |Collection&| (|#1| |#2|)
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
(|dv$| (LIST '|Collection&| |dv$1| |dv$2|))
- ($ (|newShell| 43))
+ ($ (|newShell| 45))
(|pv$| (|buildPredVector| 0 0
(LIST (|HasCategory| |#2|
(LIST '|ConvertibleTo| '(|InputForm|)))
@@ -181,26 +148,26 @@
(CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $))
(|setShellEntry| $ 21
(CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $))
- (|setShellEntry| $ 22
+ (|setShellEntry| $ 24
(CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $))
- (|setShellEntry| $ 25
+ (|setShellEntry| $ 27
(CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $))
- (|setShellEntry| $ 28
- (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $))
(|setShellEntry| $ 30
+ (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $))
+ (|setShellEntry| $ 32
(CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $))
- (|setShellEntry| $ 33
- (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $))
(|setShellEntry| $ 35
+ (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $))
+ (|setShellEntry| $ 37
(CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $))
(COND
((|testBitVector| |pv$| 2)
(PROGN
- (|setShellEntry| $ 38
- (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) $))
(|setShellEntry| $ 40
- (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) $))
+ (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) $))
(|setShellEntry| $ 42
+ (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) $))
+ (|setShellEntry| $ 44
(CONS (|dispatchFunction|
|CLAGG-;removeDuplicates;2A;12|)
$))))))))
@@ -210,37 +177,37 @@
(LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
(|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|)
(10 . |#|) (15 . |One|) (19 . +) (25 . |Zero|) (|Boolean|)
- (|Mapping| 16 7) (29 . |count|) (35 . |true|)
- (39 . |false|) (43 . |any?|) (49 . |every?|)
- (|Union| 7 '"failed") (55 . |find|) (61 . |find|)
- (|Mapping| 7 7 7) (67 . |reduce|) (73 . |reduce|)
- (79 . |reduce|) (86 . |reduce|) (93 . |remove|)
- (99 . |construct|) (104 . |remove|) (110 . |select|)
- (116 . |select|) (122 . =) (128 . |remove|)
- (134 . |remove|) (140 . |reduce|) (148 . |reduce|)
- (156 . |removeDuplicates|) (161 . |removeDuplicates|))
- '#(|select| 166 |removeDuplicates| 172 |remove| 177 |reduce|
- 189 |find| 210 |every?| 216 |count| 222 |any?| 228 |#|
- 234)
+ (|Mapping| 16 7) (29 . |count|) (35 . |or|) (41 . |false|)
+ (45 . |any?|) (51 . |and|) (57 . |true|) (61 . |every?|)
+ (|Union| 7 '"failed") (67 . |find|) (73 . |find|)
+ (|Mapping| 7 7 7) (79 . |reduce|) (85 . |reduce|)
+ (91 . |reduce|) (98 . |reduce|) (105 . |remove|)
+ (111 . |construct|) (116 . |remove|) (122 . |select|)
+ (128 . |select|) (134 . =) (140 . |remove|)
+ (146 . |remove|) (152 . |reduce|) (160 . |reduce|)
+ (168 . |removeDuplicates|) (173 . |removeDuplicates|))
+ '#(|select| 178 |removeDuplicates| 184 |remove| 189 |reduce|
+ 201 |find| 222 |every?| 228 |count| 234 |any?| 240 |#|
+ 246)
'NIL
(CONS (|makeByteWordVec2| 1 'NIL)
(CONS '#()
(CONS '#()
- (|makeByteWordVec2| 42
+ (|makeByteWordVec2| 44
'(1 6 8 0 9 1 8 10 0 11 1 0 10 0 12 0
10 0 13 2 10 0 0 0 14 0 10 0 15 2 0
- 10 17 0 18 0 16 0 19 0 16 0 20 2 0 16
- 17 0 21 2 0 16 17 0 22 2 8 23 17 0 24
- 2 0 23 17 0 25 2 8 7 26 0 27 2 0 7 26
- 0 28 3 8 7 26 0 7 29 3 0 7 26 0 7 30
- 2 8 0 17 0 31 1 6 0 8 32 2 0 0 17 0
- 33 2 8 0 17 0 34 2 0 0 17 0 35 2 7 16
- 0 0 36 2 6 0 17 0 37 2 0 0 7 0 38 4 8
- 7 26 0 7 7 39 4 0 7 26 0 7 7 40 1 8 0
- 0 41 1 0 0 0 42 2 0 0 17 0 35 1 0 0 0
- 42 2 0 0 7 0 38 2 0 0 17 0 33 4 0 7
- 26 0 7 7 40 3 0 7 26 0 7 30 2 0 7 26
- 0 28 2 0 23 17 0 25 2 0 16 17 0 22 2
- 0 10 17 0 18 2 0 16 17 0 21 1 0 10 0
- 12)))))
+ 10 17 0 18 2 16 0 0 0 19 0 16 0 20 2
+ 0 16 17 0 21 2 16 0 0 0 22 0 16 0 23
+ 2 0 16 17 0 24 2 8 25 17 0 26 2 0 25
+ 17 0 27 2 8 7 28 0 29 2 0 7 28 0 30 3
+ 8 7 28 0 7 31 3 0 7 28 0 7 32 2 8 0
+ 17 0 33 1 6 0 8 34 2 0 0 17 0 35 2 8
+ 0 17 0 36 2 0 0 17 0 37 2 7 16 0 0 38
+ 2 6 0 17 0 39 2 0 0 7 0 40 4 8 7 28 0
+ 7 7 41 4 0 7 28 0 7 7 42 1 8 0 0 43 1
+ 0 0 0 44 2 0 0 17 0 37 1 0 0 0 44 2 0
+ 0 7 0 40 2 0 0 17 0 35 4 0 7 28 0 7 7
+ 42 3 0 7 28 0 7 32 2 0 7 28 0 30 2 0
+ 25 17 0 27 2 0 16 17 0 24 2 0 10 17 0
+ 18 2 0 16 17 0 21 1 0 10 0 12)))))
'|lookupComplete|))
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index 00c35bba..6af1eb73 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -311,9 +311,7 @@
(SETQ #2# (CDR #2#)))))))))))))))
(DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $)
- (PROG (|n| |l1| |l2| #0=#:G1397 #1=#:G1524 #2=#:G1505 #3=#:G1503
- #4=#:G1504 #5=#:G1398 #6=#:G1525 #7=#:G1508 #8=#:G1506
- #9=#:G1507 |u| |v1| |v2|)
+ (PROG (|n| |l1| |l2| |u| |v1| |v2|)
(RETURN
(SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|)
(EXIT (COND
@@ -330,80 +328,52 @@
|EUCDOM-;multiEuclidean;LSU;11|)
(LETT |u|
(SPADCALL
- (PROGN
- (LETT #4# NIL
- |EUCDOM-;multiEuclidean;LSU;11|)
- (SEQ
- (LETT #0# NIL
- |EUCDOM-;multiEuclidean;LSU;11|)
- (LETT #1# |l1|
- |EUCDOM-;multiEuclidean;LSU;11|)
- G190
- (COND
- ((OR (ATOM #1#)
- (PROGN
- (SETQ #0# (CAR #1#))
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (PROGN
- (LETT #2# #0#
- |EUCDOM-;multiEuclidean;LSU;11|)
- (COND
- (#4#
- (LETT #3#
- (SPADCALL #3# #2#
- (|getShellEntry| $ 29))
- |EUCDOM-;multiEuclidean;LSU;11|))
- ('T
- (PROGN
- (LETT #3# #2#
- |EUCDOM-;multiEuclidean;LSU;11|)
- (LETT #4# 'T
- |EUCDOM-;multiEuclidean;LSU;11|)))))))
- (SETQ #1# (CDR #1#)) (GO G190)
- G191 (EXIT NIL))
- (COND
- (#4# #3#)
- ('T (|spadConstant| $ 30))))
- (PROGN
- (LETT #9# NIL
- |EUCDOM-;multiEuclidean;LSU;11|)
- (SEQ
- (LETT #5# NIL
- |EUCDOM-;multiEuclidean;LSU;11|)
- (LETT #6# |l2|
- |EUCDOM-;multiEuclidean;LSU;11|)
- G190
- (COND
- ((OR (ATOM #6#)
- (PROGN
- (SETQ #5# (CAR #6#))
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (PROGN
- (LETT #7# #5#
- |EUCDOM-;multiEuclidean;LSU;11|)
- (COND
- (#9#
- (LETT #8#
- (SPADCALL #8# #7#
- (|getShellEntry| $ 29))
- |EUCDOM-;multiEuclidean;LSU;11|))
- ('T
- (PROGN
- (LETT #8# #7#
- |EUCDOM-;multiEuclidean;LSU;11|)
- (LETT #9# 'T
- |EUCDOM-;multiEuclidean;LSU;11|)))))))
- (SETQ #6# (CDR #6#)) (GO G190)
- G191 (EXIT NIL))
- (COND
- (#9# #8#)
- ('T (|spadConstant| $ 30))))
+ (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
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index ca71780b..2f429a7e 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -473,7 +473,7 @@
(SPADCALL |f| (|getShellEntry| $ 98)))
(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $)
- (PROG (|flist| |u| #0=#:G1520 #1=#:G1509 #2=#:G1507 #3=#:G1508)
+ (PROG (|flist|)
(RETURN
(SEQ (COND
((SPADCALL |f| (|spadConstant| $ 99)
@@ -486,42 +486,29 @@
(EXIT (SPADCALL
(SPADCALL (CAR |flist|)
(|getShellEntry| $ 106))
- (PROGN
- (LETT #3# NIL
- |FFIELDC-;factorSquareFreePolynomial|)
- (SEQ (LETT |u| NIL
- |FFIELDC-;factorSquareFreePolynomial|)
- (LETT #0# (CDR |flist|)
- |FFIELDC-;factorSquareFreePolynomial|)
- G190
- (COND
- ((OR (ATOM #0#)
- (PROGN
- (SETQ |u| (CAR #0#))
- NIL))
- (GO G191)))
- (PROGN
- (LETT #1#
- (SPADCALL (CAR |u|) (CDR |u|)
- (|getShellEntry| $ 107))
- |FFIELDC-;factorSquareFreePolynomial|)
+ (LET ((#0=#:G1508 NIL) (#1=#:G1509 T)
+ (#2=#:G1520 (CDR |flist|)))
+ (LOOP
+ (COND
+ ((ATOM #2#)
+ (RETURN
(COND
- (#3#
- (LETT #2#
- (SPADCALL #2# #1#
- (|getShellEntry| $ 108))
- |FFIELDC-;factorSquareFreePolynomial|))
- ('T
- (PROGN
- (LETT #2# #1#
- |FFIELDC-;factorSquareFreePolynomial|)
- (LETT #3# 'T
- |FFIELDC-;factorSquareFreePolynomial|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191
- (EXIT NIL))
- (COND
- (#3# #2#)
- ('T (|spadConstant| $ 109))))
+ (#1# (|spadConstant| $ 109))
+ (T #0#))))
+ (T
+ (LET ((|u| (CAR #2#)))
+ (LET
+ ((#3=#:G1507
+ (SPADCALL (CAR |u|) (CDR |u|)
+ (|getShellEntry| $ 107))))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T
+ (SETQ #0#
+ (SPADCALL #0# #3#
+ (|getShellEntry| $ 108)))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#))))
(|getShellEntry| $ 110))))))))))
(DEFUN |FFIELDC-;gcdPolynomial;3Sup;16| (|f| |g| $)
diff --git a/src/algebra/strap/HOAGG-.lsp b/src/algebra/strap/HOAGG-.lsp
index a3159838..22fc5a79 100644
--- a/src/algebra/strap/HOAGG-.lsp
+++ b/src/algebra/strap/HOAGG-.lsp
@@ -45,134 +45,85 @@
(LENGTH (SPADCALL |c| (|getShellEntry| $ 15))))
(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $)
- (PROG (|x| #0=#:G1428 #1=#:G1406 #2=#:G1404 #3=#:G1405)
- (RETURN
- (SEQ (PROGN
- (LETT #3# NIL |HOAGG-;any?;MAB;3|)
- (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|)
- (LETT #0# (SPADCALL |c| (|getShellEntry| $ 15))
- |HOAGG-;any?;MAB;3|)
- G190
- (COND
- ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #1# (SPADCALL |x| |f|) |HOAGG-;any?;MAB;3|)
- (COND
- (#3# (LETT #2# (COND (#2# T) ('T #1#))
- |HOAGG-;any?;MAB;3|))
- ('T
- (PROGN
- (LETT #2# #1# |HOAGG-;any?;MAB;3|)
- (LETT #3# 'T |HOAGG-;any?;MAB;3|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T NIL)))))))
+ (LET ((#0=#:G1405 NIL) (#1=#:G1406 T)
+ (#2=#:G1428 (SPADCALL |c| (|getShellEntry| $ 15))))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# NIL) (T #0#))))
+ (T (LET ((|x| (CAR #2#)))
+ (LET ((#3=#:G1404 (SPADCALL |x| |f|)))
+ (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#)))))
(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $)
- (PROG (|x| #0=#:G1429 #1=#:G1411 #2=#:G1409 #3=#:G1410)
- (RETURN
- (SEQ (PROGN
- (LETT #3# NIL |HOAGG-;every?;MAB;4|)
- (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|)
- (LETT #0# (SPADCALL |c| (|getShellEntry| $ 15))
- |HOAGG-;every?;MAB;4|)
- G190
- (COND
- ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #1# (SPADCALL |x| |f|) |HOAGG-;every?;MAB;4|)
- (COND
- (#3# (LETT #2# (COND (#2# #1#) ('T NIL))
- |HOAGG-;every?;MAB;4|))
- ('T
- (PROGN
- (LETT #2# #1# |HOAGG-;every?;MAB;4|)
- (LETT #3# 'T |HOAGG-;every?;MAB;4|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T T)))))))
+ (LET ((#0=#:G1410 NIL) (#1=#:G1411 T)
+ (#2=#:G1429 (SPADCALL |c| (|getShellEntry| $ 15))))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# T) (T #0#))))
+ (T (LET ((|x| (CAR #2#)))
+ (LET ((#3=#:G1409 (SPADCALL |x| |f|)))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0# (AND #0# #3#))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#)))))
(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $)
- (PROG (|x| #0=#:G1430 #1=#:G1415 #2=#:G1413 #3=#:G1414)
- (RETURN
- (SEQ (PROGN
- (LETT #3# NIL |HOAGG-;count;MANni;5|)
- (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|)
- (LETT #0# (SPADCALL |c| (|getShellEntry| $ 15))
- |HOAGG-;count;MANni;5|)
- G190
- (COND
- ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL))
- (GO G191)))
- (COND
- ((SPADCALL |x| |f|)
- (PROGN
- (LETT #1# 1 |HOAGG-;count;MANni;5|)
- (COND
- (#3# (LETT #2# (+ #2# #1#)
- |HOAGG-;count;MANni;5|))
- ('T
- (PROGN
- (LETT #2# #1# |HOAGG-;count;MANni;5|)
- (LETT #3# 'T |HOAGG-;count;MANni;5|)))))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T 0)))))))
+ (LET ((#0=#:G1414 NIL) (#1=#:G1415 T)
+ (#2=#:G1430 (SPADCALL |c| (|getShellEntry| $ 15))))
+ (LOOP
+ (COND
+ ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#))))
+ (T (LET ((|x| (CAR #2#)))
+ (AND (SPADCALL |x| |f|)
+ (LET ((#3=#:G1413 1))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0# (+ #0# #3#))))
+ (SETQ #1# NIL))))))
+ (SETQ #2# (CDR #2#)))))
(DEFUN |HOAGG-;members;AL;6| (|x| $)
(SPADCALL |x| (|getShellEntry| $ 15)))
(DEFUN |HOAGG-;count;SANni;7| (|s| |x| $)
(SPADCALL (CONS #'|HOAGG-;count;SANni;7!0| (VECTOR $ |s|)) |x|
- (|getShellEntry| $ 31)))
+ (|getShellEntry| $ 33)))
(DEFUN |HOAGG-;count;SANni;7!0| (|#1| $$)
(SPADCALL (|getShellEntry| $$ 1) |#1|
- (|getShellEntry| (|getShellEntry| $$ 0) 30)))
+ (|getShellEntry| (|getShellEntry| $$ 0) 32)))
(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| $)
(SPADCALL (CONS #'|HOAGG-;member?;SAB;8!0| (VECTOR $ |e|)) |c|
- (|getShellEntry| $ 33)))
+ (|getShellEntry| $ 35)))
(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| $$)
(SPADCALL (|getShellEntry| $$ 1) |#1|
- (|getShellEntry| (|getShellEntry| $$ 0) 30)))
+ (|getShellEntry| (|getShellEntry| $$ 0) 32)))
(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $)
- (PROG (|b| #0=#:G1432 |a| #1=#:G1431 #2=#:G1422 #3=#:G1420
- #4=#:G1421)
- (RETURN
- (SEQ (COND
- ((SPADCALL |x| (SPADCALL |y| (|getShellEntry| $ 35))
- (|getShellEntry| $ 36))
- (PROGN
- (LETT #4# NIL |HOAGG-;=;2AB;9|)
- (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|)
- (LETT #0# (SPADCALL |y| (|getShellEntry| $ 15))
- |HOAGG-;=;2AB;9|)
- (LETT |a| NIL |HOAGG-;=;2AB;9|)
- (LETT #1# (SPADCALL |x| (|getShellEntry| $ 15))
- |HOAGG-;=;2AB;9|)
- G190
- (COND
- ((OR (ATOM #1#) (PROGN (SETQ |a| (CAR #1#)) NIL)
- (ATOM #0#)
- (PROGN (SETQ |b| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #2#
- (SPADCALL |a| |b| (|getShellEntry| $ 30))
- |HOAGG-;=;2AB;9|)
- (COND
- (#4# (LETT #3# (COND (#3# #2#) ('T NIL))
- |HOAGG-;=;2AB;9|))
- ('T
- (PROGN
- (LETT #3# #2# |HOAGG-;=;2AB;9|)
- (LETT #4# 'T |HOAGG-;=;2AB;9|)))))
- (SETQ #1# (PROG1 (CDR #1#) (SETQ #0# (CDR #0#))))
- (GO G190) G191 (EXIT NIL))
- (COND (#4# #3#) ('T T))))
- ('T NIL))))))
+ (COND
+ ((SPADCALL |x| (SPADCALL |y| (|getShellEntry| $ 37))
+ (|getShellEntry| $ 38))
+ (LET ((#0=#:G1421 NIL) (#1=#:G1422 T)
+ (#2=#:G1431 (SPADCALL |x| (|getShellEntry| $ 15)))
+ (#3=#:G1432 (SPADCALL |y| (|getShellEntry| $ 15))))
+ (LOOP
+ (COND
+ ((OR (ATOM #2#) (ATOM #3#)) (RETURN (COND (#1# T) (T #0#))))
+ (T (LET ((|a| (CAR #2#)) (|b| (CAR #3#)))
+ (LET ((#4=#:G1420
+ (SPADCALL |a| |b| (|getShellEntry| $ 32))))
+ (COND
+ (#1# (SETQ #0# #4#))
+ (T (SETQ #0# (AND #0# #4#))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#))
+ (SETQ #3# (CDR #3#)))))
+ ('T NIL)))
(DEFUN |HOAGG-;coerce;AOf;10| (|x| $)
(SPADCALL
@@ -184,16 +135,16 @@
((ATOM #0#) (RETURN (NREVERSE #1#)))
(T (LET ((|a| (CAR #0#)))
(SETQ #1#
- (CONS (SPADCALL |a| (|getShellEntry| $ 39))
+ (CONS (SPADCALL |a| (|getShellEntry| $ 41))
#1#)))))
(SETQ #0# (CDR #0#))))
- (|getShellEntry| $ 41))
- (|getShellEntry| $ 42)))
+ (|getShellEntry| $ 43))
+ (|getShellEntry| $ 44)))
(DEFUN |HomogeneousAggregate&| (|#1| |#2|)
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
(|dv$| (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|))
- ($ (|newShell| 44))
+ ($ (|newShell| 46))
(|pv$| (|buildPredVector| 0 0
(LIST (|HasAttribute| |#1| '|finiteAggregate|)
(|HasAttribute| |#1| '|shallowlyMutable|)
@@ -218,24 +169,24 @@
(CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $))
(|setShellEntry| $ 23
(CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $))
- (|setShellEntry| $ 24
+ (|setShellEntry| $ 26
(CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $))
- (|setShellEntry| $ 28
+ (|setShellEntry| $ 30
(CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $))
- (|setShellEntry| $ 29
+ (|setShellEntry| $ 31
(CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $))
(COND
((|testBitVector| |pv$| 4)
(PROGN
- (|setShellEntry| $ 32
- (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) $))
(|setShellEntry| $ 34
+ (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) $))
+ (|setShellEntry| $ 36
(CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) $))
- (|setShellEntry| $ 37
+ (|setShellEntry| $ 39
(CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $)))))
(COND
((|testBitVector| |pv$| 5)
- (|setShellEntry| $ 43
+ (|setShellEntry| $ 45
(CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) $)))))))
$))
@@ -244,33 +195,33 @@
(|Equation| 7) (|List| 8) (0 . |eval|) (|Mapping| 7 7)
(6 . |map|) (12 . |eval|) (|List| 7) (18 . |parts|)
(|NonNegativeInteger|) (23 . |#|) (28 . |#|) (|Boolean|)
- (33 . |true|) (37 . |false|) (|Mapping| 19 7)
- (41 . |any?|) (47 . |every?|) (53 . |One|) (57 . +)
- (63 . |Zero|) (67 . |count|) (73 . |members|) (78 . =)
- (84 . |count|) (90 . |count|) (96 . |any?|)
- (102 . |member?|) (108 . |#|) (113 . |size?|) (119 . =)
- (|OutputForm|) (125 . |coerce|) (|List| $)
- (130 . |commaSeparate|) (135 . |bracket|)
- (140 . |coerce|))
- '#(|members| 145 |member?| 150 |every?| 156 |eval| 162
- |count| 168 |coerce| 180 |any?| 185 = 191 |#| 197)
+ (33 . |or|) (39 . |false|) (|Mapping| 19 7) (43 . |any?|)
+ (49 . |and|) (55 . |true|) (59 . |every?|) (65 . |One|)
+ (69 . +) (75 . |Zero|) (79 . |count|) (85 . |members|)
+ (90 . =) (96 . |count|) (102 . |count|) (108 . |any?|)
+ (114 . |member?|) (120 . |#|) (125 . |size?|) (131 . =)
+ (|OutputForm|) (137 . |coerce|) (|List| $)
+ (142 . |commaSeparate|) (147 . |bracket|)
+ (152 . |coerce|))
+ '#(|members| 157 |member?| 162 |every?| 168 |eval| 174
+ |count| 180 |coerce| 192 |any?| 197 = 203 |#| 209)
'NIL
(CONS (|makeByteWordVec2| 1 'NIL)
(CONS '#()
(CONS '#()
- (|makeByteWordVec2| 43
+ (|makeByteWordVec2| 45
'(2 7 0 0 9 10 2 6 0 11 0 12 2 0 0 0 9
13 1 6 14 0 15 1 14 16 0 17 1 0 16 0
- 18 0 19 0 20 0 19 0 21 2 0 19 22 0 23
- 2 0 19 22 0 24 0 16 0 25 2 16 0 0 0
- 26 0 16 0 27 2 0 16 22 0 28 1 0 14 0
- 29 2 7 19 0 0 30 2 6 16 22 0 31 2 0
- 16 7 0 32 2 6 19 22 0 33 2 0 19 7 0
- 34 1 6 16 0 35 2 6 19 0 16 36 2 0 19
- 0 0 37 1 7 38 0 39 1 38 0 40 41 1 38
- 0 0 42 1 0 38 0 43 1 0 14 0 29 2 0 19
- 7 0 34 2 0 19 22 0 24 2 0 0 0 9 13 2
- 0 16 7 0 32 2 0 16 22 0 28 1 0 38 0
- 43 2 0 19 22 0 23 2 0 19 0 0 37 1 0
- 16 0 18)))))
+ 18 2 19 0 0 0 20 0 19 0 21 2 0 19 22
+ 0 23 2 19 0 0 0 24 0 19 0 25 2 0 19
+ 22 0 26 0 16 0 27 2 16 0 0 0 28 0 16
+ 0 29 2 0 16 22 0 30 1 0 14 0 31 2 7
+ 19 0 0 32 2 6 16 22 0 33 2 0 16 7 0
+ 34 2 6 19 22 0 35 2 0 19 7 0 36 1 6
+ 16 0 37 2 6 19 0 16 38 2 0 19 0 0 39
+ 1 7 40 0 41 1 40 0 42 43 1 40 0 0 44
+ 1 0 40 0 45 1 0 14 0 31 2 0 19 7 0 36
+ 2 0 19 22 0 26 2 0 0 0 9 13 2 0 16 7
+ 0 34 2 0 16 22 0 30 1 0 40 0 45 2 0
+ 19 22 0 23 2 0 19 0 0 39 1 0 16 0 18)))))
'|lookupComplete|))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 4cd0567f..23b54d95 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -544,47 +544,34 @@
$))))))
(DEFUN |ISTRING;concat;L$;28| (|l| $)
- (PROG (#0=#:G1540 #1=#:G1495 #2=#:G1493 #3=#:G1494 |t| |s| #4=#:G1541
- |i|)
+ (PROG (|t| |s| #0=#:G1541 |i|)
(RETURN
(SEQ (LETT |t|
(MAKE-FULL-CVEC
- (PROGN
- (LETT #3# NIL |ISTRING;concat;L$;28|)
- (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|)
- (LETT #0# |l| |ISTRING;concat;L$;28|) G190
- (COND
- ((OR (ATOM #0#)
- (PROGN (SETQ |s| (CAR #0#)) NIL))
- (GO G191)))
- (SEQ (EXIT (PROGN
- (LETT #1# (QCSIZE |s|)
- |ISTRING;concat;L$;28|)
- (COND
- (#3#
- (LETT #2# (+ #2# #1#)
- |ISTRING;concat;L$;28|))
- ('T
- (PROGN
- (LETT #2# #1#
- |ISTRING;concat;L$;28|)
- (LETT #3# 'T
- |ISTRING;concat;L$;28|)))))))
- (SETQ #0# (CDR #0#)) (GO G190) G191
- (EXIT NIL))
- (COND (#3# #2#) ('T 0)))
+ (LET ((#1=#:G1494 NIL) (#2=#:G1495 T)
+ (#3=#:G1540 |l|))
+ (LOOP
+ (COND
+ ((ATOM #3#) (RETURN (COND (#2# 0) (T #1#))))
+ (T (LET ((|s| (CAR #3#)))
+ (LET ((#4=#:G1493 (QCSIZE |s|)))
+ (COND
+ (#2# (SETQ #1# #4#))
+ (T (SETQ #1# (+ #1# #4#))))
+ (SETQ #2# NIL)))))
+ (SETQ #3# (CDR #3#))))
(|spadConstant| $ 53))
|ISTRING;concat;L$;28|)
(LETT |i| (|getShellEntry| $ 6) |ISTRING;concat;L$;28|)
(SEQ (LETT |s| NIL |ISTRING;concat;L$;28|)
- (LETT #4# |l| |ISTRING;concat;L$;28|) G190
+ (LETT #0# |l| |ISTRING;concat;L$;28|) G190
(COND
- ((OR (ATOM #4#) (PROGN (SETQ |s| (CAR #4#)) NIL))
+ ((OR (ATOM #0#) (PROGN (SETQ |s| (CAR #0#)) NIL))
(GO G191)))
(SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $)
(EXIT (LETT |i| (+ |i| (QCSIZE |s|))
|ISTRING;concat;L$;28|)))
- (SETQ #4# (CDR #4#)) (GO G190) G191 (EXIT NIL))
+ (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
(EXIT |t|)))))
(DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $)
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index a5482945..5bc36a75 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -732,78 +732,64 @@
(|getShellEntry| $ 159)))))))))))
(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $)
- (PROG (#0=#:G1610 #1=#:G1730 #2=#:G1731 #3=#:G1605 #4=#:G1603
- #5=#:G1604 |nd| |ll| |ch| |l| #6=#:G1722 |u| #7=#:G1723
- #8=#:G1583 #9=#:G1581 #10=#:G1582 |mons| |m| #11=#:G1724
- |vars| |degs| |deg1| |redmons| |llR| |monslist| |ans| |i|)
+ (PROG (#0=#:G1610 #1=#:G1730 |nd| |ll| |ch| |l| #2=#:G1722 |mons| |m|
+ #3=#:G1724 |vars| |degs| |deg1| |redmons| |llR| |monslist|
+ |ans| |i|)
(RETURN
(SEQ (LETT |ll|
(SPADCALL (SPADCALL |mat| (|getShellEntry| $ 166))
(|getShellEntry| $ 114))
|POLYCAT-;conditionP;MU;27|)
(LETT |llR|
- (LET ((#12=#:G1721 (|SPADfirst| |ll|))
- (#13=#:G1720 NIL))
+ (LET ((#4=#:G1721 (|SPADfirst| |ll|))
+ (#5=#:G1720 NIL))
(LOOP
(COND
- ((ATOM #12#) (RETURN (NREVERSE #13#)))
- (T (LET ((|z| (CAR #12#)))
- (SETQ #13# (CONS NIL #13#)))))
- (SETQ #12# (CDR #12#))))
+ ((ATOM #4#) (RETURN (NREVERSE #5#)))
+ (T (LET ((|z| (CAR #4#)))
+ (SETQ #5# (CONS NIL #5#)))))
+ (SETQ #4# (CDR #4#))))
|POLYCAT-;conditionP;MU;27|)
(LETT |monslist| NIL |POLYCAT-;conditionP;MU;27|)
(LETT |ch| (|spadConstant| $ 169)
|POLYCAT-;conditionP;MU;27|)
(SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|)
- (LETT #6# |ll| |POLYCAT-;conditionP;MU;27|) G190
+ (LETT #2# |ll| |POLYCAT-;conditionP;MU;27|) G190
(COND
- ((OR (ATOM #6#) (PROGN (SETQ |l| (CAR #6#)) NIL))
+ ((OR (ATOM #2#) (PROGN (SETQ |l| (CAR #2#)) NIL))
(GO G191)))
(SEQ (LETT |mons|
- (PROGN
- (LETT #10# NIL
- |POLYCAT-;conditionP;MU;27|)
- (SEQ (LETT |u| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #7# |l|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #7#)
- (PROGN (SETQ |u| (CAR #7#)) NIL))
- (GO G191)))
- (SEQ (EXIT
- (PROGN
- (LETT #8#
- (SPADCALL |u|
- (|getShellEntry| $ 98))
- |POLYCAT-;conditionP;MU;27|)
- (COND
- (#10#
- (LETT #9#
- (SPADCALL #9# #8#
- (|getShellEntry| $ 170))
- |POLYCAT-;conditionP;MU;27|))
- ('T
- (PROGN
- (LETT #9# #8#
- |POLYCAT-;conditionP;MU;27|)
- (LETT #10# 'T
- |POLYCAT-;conditionP;MU;27|)))))))
- (SETQ #7# (CDR #7#)) (GO G190) G191
- (EXIT NIL))
- (COND
- (#10# #9#)
- ('T (|IdentityError| '|setUnion|))))
+ (LET ((#6=#:G1582 NIL) (#7=#:G1583 T)
+ (#8=#:G1723 |l|))
+ (LOOP
+ (COND
+ ((ATOM #8#)
+ (RETURN
+ (COND
+ (#7#
+ (|IdentityError| '|setUnion|))
+ (T #6#))))
+ (T (LET ((|u| (CAR #8#)))
+ (LET
+ ((#9=#:G1581
+ (SPADCALL |u|
+ (|getShellEntry| $ 98))))
+ (COND
+ (#7# (SETQ #6# #9#))
+ (T
+ (SETQ #6#
+ (SPADCALL #6# #9#
+ (|getShellEntry| $ 170)))))
+ (SETQ #7# NIL)))))
+ (SETQ #8# (CDR #8#))))
|POLYCAT-;conditionP;MU;27|)
(LETT |redmons| NIL |POLYCAT-;conditionP;MU;27|)
(SEQ (LETT |m| NIL |POLYCAT-;conditionP;MU;27|)
- (LETT #11# |mons|
- |POLYCAT-;conditionP;MU;27|)
+ (LETT #3# |mons| |POLYCAT-;conditionP;MU;27|)
G190
(COND
- ((OR (ATOM #11#)
- (PROGN (SETQ |m| (CAR #11#)) NIL))
+ ((OR (ATOM #3#)
+ (PROGN (SETQ |m| (CAR #3#)) NIL))
(GO G191)))
(SEQ (LETT |vars|
(SPADCALL |m|
@@ -815,15 +801,15 @@
|POLYCAT-;conditionP;MU;27|)
(LETT |deg1|
(LET
- ((#14=#:G1726 |degs|)
- (#15=#:G1725 NIL))
+ ((#10=#:G1726 |degs|)
+ (#11=#:G1725 NIL))
(LOOP
(COND
- ((ATOM #14#)
- (RETURN (NREVERSE #15#)))
+ ((ATOM #10#)
+ (RETURN (NREVERSE #11#)))
(T
- (LET ((|d| (CAR #14#)))
- (SETQ #15#
+ (LET ((|d| (CAR #10#)))
+ (SETQ #11#
(CONS
(SEQ
(LETT |nd|
@@ -840,14 +826,14 @@
"failed")))
('T
(LET
- ((#16=#:G1612
+ ((#12=#:G1612
(CDR |nd|)))
(|check-subtype|
- (>= #16# 0)
+ (>= #12# 0)
'(|NonNegativeInteger|)
- #16#))))))
- #15#)))))
- (SETQ #14# (CDR #14#))))
+ #12#))))))
+ #11#)))))
+ (SETQ #10# (CDR #10#))))
|POLYCAT-;conditionP;MU;27|)
(LETT |redmons|
(CONS
@@ -858,19 +844,19 @@
|POLYCAT-;conditionP;MU;27|)
(EXIT (LETT |llR|
(LET
- ((#17=#:G1728 |l|)
- (#18=#:G1729 |llR|)
- (#19=#:G1727 NIL))
+ ((#13=#:G1728 |l|)
+ (#14=#:G1729 |llR|)
+ (#15=#:G1727 NIL))
(LOOP
(COND
- ((OR (ATOM #17#)
- (ATOM #18#))
- (RETURN (NREVERSE #19#)))
+ ((OR (ATOM #13#)
+ (ATOM #14#))
+ (RETURN (NREVERSE #15#)))
(T
(LET
- ((|u| (CAR #17#))
- (|v| (CAR #18#)))
- (SETQ #19#
+ ((|u| (CAR #13#))
+ (|v| (CAR #14#)))
+ (SETQ #15#
(CONS
(CONS
(SPADCALL
@@ -881,15 +867,15 @@
(|getShellEntry| $
175))
|v|)
- #19#)))))
- (SETQ #17# (CDR #17#))
- (SETQ #18# (CDR #18#))))
+ #15#)))))
+ (SETQ #13# (CDR #13#))
+ (SETQ #14# (CDR #14#))))
|POLYCAT-;conditionP;MU;27|)))
- (SETQ #11# (CDR #11#)) (GO G190) G191
+ (SETQ #3# (CDR #3#)) (GO G190) G191
(EXIT NIL))
(EXIT (LETT |monslist| (CONS |redmons| |monslist|)
|POLYCAT-;conditionP;MU;27|)))
- (SETQ #6# (CDR #6#)) (GO G190) G191 (EXIT NIL))
+ (SETQ #2# (CDR #2#)) (GO G190) G191 (EXIT NIL))
(LETT |ans|
(SPADCALL
(SPADCALL (SPADCALL |llR| (|getShellEntry| $ 111))
@@ -902,7 +888,7 @@
(SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|)
(EXIT (CONS 0
(LET
- ((#20=#:G1611
+ ((#16=#:G1611
(|makeSimpleArray|
(|getVMType|
(|getShellEntry| $ 6))
@@ -923,67 +909,56 @@
(GO G191)))
(SEQ
(EXIT
- (|setSimpleArrayEntry| #20#
+ (|setSimpleArrayEntry| #16#
#0#
- (PROGN
- (LETT #5# NIL
- |POLYCAT-;conditionP;MU;27|)
- (SEQ
- (LETT |m| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #2# |mons|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #2#)
- (PROGN
- (SETQ |m|
- (CAR #2#))
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (PROGN
- (LETT #3#
- (SPADCALL |m|
- (SPADCALL
- (SPADCALL
- (CDR |ans|)
- (LETT |i|
- (+ |i| 1)
- |POLYCAT-;conditionP;MU;27|)
- (|getShellEntry|
- $ 181))
- (|getShellEntry| $
- 51))
- (|getShellEntry| $
- 182))
- |POLYCAT-;conditionP;MU;27|)
- (COND
- (#5#
- (LETT #4#
- (SPADCALL #4# #3#
- (|getShellEntry|
- $ 183))
- |POLYCAT-;conditionP;MU;27|))
- ('T
- (PROGN
- (LETT #4# #3#
- |POLYCAT-;conditionP;MU;27|)
- (LETT #5# 'T
- |POLYCAT-;conditionP;MU;27|)))))))
- (SETQ #2# (CDR #2#))
- (GO G190) G191
- (EXIT NIL))
- (COND
- (#5# #4#)
- ('T
- (|spadConstant| $ 27)))))))
+ (LET
+ ((#17=#:G1604 NIL)
+ (#18=#:G1605 T)
+ (#19=#:G1731 |mons|))
+ (LOOP
+ (COND
+ ((ATOM #19#)
+ (RETURN
+ (COND
+ (#18#
+ (|spadConstant|
+ $ 27))
+ (T #17#))))
+ (T
+ (LET
+ ((|m| (CAR #19#)))
+ (LET
+ ((#20=#:G1603
+ (SPADCALL |m|
+ (SPADCALL
+ (SPADCALL
+ (CDR |ans|)
+ (LETT |i|
+ (+ |i| 1)
+ |POLYCAT-;conditionP;MU;27|)
+ (|getShellEntry|
+ $ 181))
+ (|getShellEntry|
+ $ 51))
+ (|getShellEntry|
+ $ 182))))
+ (COND
+ (#18#
+ (SETQ #17#
+ #20#))
+ (T
+ (SETQ #17#
+ (SPADCALL
+ #17# #20#
+ (|getShellEntry|
+ $ 183)))))
+ (SETQ #18# NIL)))))
+ (SETQ #19# (CDR #19#)))))))
(SETQ #1#
(PROG1 (CDR #1#)
(SETQ #0# (QSADD1 #0#))))
(GO G190) G191 (EXIT NIL))
- #20#)))))))))))
+ #16#)))))))))))
(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $)
(PROG (|vars| |ans| |ch|)
@@ -1126,40 +1101,29 @@
(SPADCALL |p| (|getShellEntry| $ 197)))
(DEFUN |POLYCAT-;squareFreePart;2S;34| (|p| $)
- (PROG (|s| |f| #0=#:G1732 #1=#:G1654 #2=#:G1652 #3=#:G1653)
+ (PROG (|s|)
(RETURN
- (SEQ (SPADCALL
- (SPADCALL
- (LETT |s| (SPADCALL |p| (|getShellEntry| $ 198))
- |POLYCAT-;squareFreePart;2S;34|)
- (|getShellEntry| $ 199))
- (PROGN
- (LETT #3# NIL |POLYCAT-;squareFreePart;2S;34|)
- (SEQ (LETT |f| NIL |POLYCAT-;squareFreePart;2S;34|)
- (LETT #0# (SPADCALL |s| (|getShellEntry| $ 202))
- |POLYCAT-;squareFreePart;2S;34|)
- G190
- (COND
- ((OR (ATOM #0#)
- (PROGN (SETQ |f| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #1# (CAR |f|)
- |POLYCAT-;squareFreePart;2S;34|)
- (COND
- (#3# (LETT #2#
- (SPADCALL #2# #1#
- (|getShellEntry| $ 182))
- |POLYCAT-;squareFreePart;2S;34|))
- ('T
- (PROGN
- (LETT #2# #1#
- |POLYCAT-;squareFreePart;2S;34|)
- (LETT #3# 'T
- |POLYCAT-;squareFreePart;2S;34|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T (|spadConstant| $ 43))))
- (|getShellEntry| $ 182))))))
+ (SPADCALL
+ (SPADCALL
+ (LETT |s| (SPADCALL |p| (|getShellEntry| $ 198))
+ |POLYCAT-;squareFreePart;2S;34|)
+ (|getShellEntry| $ 199))
+ (LET ((#0=#:G1653 NIL) (#1=#:G1654 T)
+ (#2=#:G1732 (SPADCALL |s| (|getShellEntry| $ 202))))
+ (LOOP
+ (COND
+ ((ATOM #2#)
+ (RETURN (COND (#1# (|spadConstant| $ 43)) (T #0#))))
+ (T (LET ((|f| (CAR #2#)))
+ (LET ((#3=#:G1652 (CAR |f|)))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0#
+ (SPADCALL #0# #3#
+ (|getShellEntry| $ 182)))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#))))
+ (|getShellEntry| $ 182)))))
(DEFUN |POLYCAT-;content;SVarSetS;35| (|p| |v| $)
(SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 59))
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp
index 02114011..741e93a8 100644
--- a/src/algebra/strap/UFD-.lsp
+++ b/src/algebra/strap/UFD-.lsp
@@ -8,37 +8,29 @@
|UFD-;prime?;SB;2|))
(DEFUN |UFD-;squareFreePart;2S;1| (|x| $)
- (PROG (|s| |f| #0=#:G1419 #1=#:G1406 #2=#:G1404 #3=#:G1405)
+ (PROG (|s|)
(RETURN
- (SEQ (SPADCALL
- (SPADCALL
- (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8))
- |UFD-;squareFreePart;2S;1|)
- (|getShellEntry| $ 10))
- (PROGN
- (LETT #3# NIL |UFD-;squareFreePart;2S;1|)
- (SEQ (LETT |f| NIL |UFD-;squareFreePart;2S;1|)
- (LETT #0# (SPADCALL |s| (|getShellEntry| $ 14))
- |UFD-;squareFreePart;2S;1|)
- G190
- (COND
- ((OR (ATOM #0#)
- (PROGN (SETQ |f| (CAR #0#)) NIL))
- (GO G191)))
- (PROGN
- (LETT #1# (CAR |f|) |UFD-;squareFreePart;2S;1|)
- (COND
- (#3# (LETT #2#
- (SPADCALL #2# #1#
- (|getShellEntry| $ 15))
- |UFD-;squareFreePart;2S;1|))
- ('T
- (PROGN
- (LETT #2# #1# |UFD-;squareFreePart;2S;1|)
- (LETT #3# 'T |UFD-;squareFreePart;2S;1|)))))
- (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))
- (COND (#3# #2#) ('T (|spadConstant| $ 16))))
- (|getShellEntry| $ 15))))))
+ (SPADCALL
+ (SPADCALL
+ (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8))
+ |UFD-;squareFreePart;2S;1|)
+ (|getShellEntry| $ 10))
+ (LET ((#0=#:G1405 NIL) (#1=#:G1406 T)
+ (#2=#:G1419 (SPADCALL |s| (|getShellEntry| $ 14))))
+ (LOOP
+ (COND
+ ((ATOM #2#)
+ (RETURN (COND (#1# (|spadConstant| $ 16)) (T #0#))))
+ (T (LET ((|f| (CAR #2#)))
+ (LET ((#3=#:G1404 (CAR |f|)))
+ (COND
+ (#1# (SETQ #0# #3#))
+ (T (SETQ #0#
+ (SPADCALL #0# #3#
+ (|getShellEntry| $ 15)))))
+ (SETQ #1# NIL)))))
+ (SETQ #2# (CDR #2#))))
+ (|getShellEntry| $ 15)))))
(DEFUN |UFD-;prime?;SB;2| (|x| $)
(EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-10 07:00:18 +0000