aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-02-07 02:43:13 +0000
committerdos-reis <gdr@axiomatics.org>2011-02-07 02:43:13 +0000
commit64800be179812d1ff863cc629bcc6b21a0c7f8ac (patch)
tree58c035aec699d3a0b633e751835df24510510765 /src/algebra
parent351022a3ec02f6e131d54f3a5bcb27a8dfffbcb0 (diff)
downloadopen-axiom-64800be179812d1ff863cc629bcc6b21a0c7f8ac.tar.gz
* interp/g-opt.boot (groupVariableDefinitions): Look into clauses
of conditional too.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/DFLOAT.lsp117
-rw-r--r--src/algebra/strap/EUCDOM-.lsp204
-rw-r--r--src/algebra/strap/FFIELDC-.lsp469
-rw-r--r--src/algebra/strap/GCDDOM-.lsp252
-rw-r--r--src/algebra/strap/ILIST.lsp26
-rw-r--r--src/algebra/strap/LSAGG-.lsp42
-rw-r--r--src/algebra/strap/OUTFORM.lsp23
-rw-r--r--src/algebra/strap/POLYCAT-.lsp215
-rw-r--r--src/algebra/strap/RNS-.lsp32
-rw-r--r--src/algebra/strap/SYMBOL.lsp216
-rw-r--r--src/algebra/strap/URAGG-.lsp73
11 files changed, 778 insertions, 891 deletions
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index f8825345..77282ff7 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -686,22 +686,18 @@
(|DFLOAT;rationalApproximation;$2NniF;86| |x| |d| 10 $))
(DEFUN |DFLOAT;atan;3$;78| (|x| |y| $)
- (PROG (|theta|)
- (RETURN
- (COND
- ((ZEROP |x|)
- (COND
- ((PLUSP |y|) (/ (COERCE PI '|%DoubleFloat|) 2))
- ((MINUSP |y|) (- (/ (COERCE PI '|%DoubleFloat|) 2)))
- (T 0.0)))
- (T (SEQ (LETT |theta| (ATAN (ABS (/ |y| |x|)))
- |DFLOAT;atan;3$;78|)
- (COND
- ((MINUSP |x|)
- (SETQ |theta|
- (- (COERCE PI '|%DoubleFloat|) |theta|))))
- (COND ((MINUSP |y|) (SETQ |theta| (- |theta|))))
- (EXIT |theta|)))))))
+ (COND
+ ((ZEROP |x|)
+ (COND
+ ((PLUSP |y|) (/ (COERCE PI '|%DoubleFloat|) 2))
+ ((MINUSP |y|) (- (/ (COERCE PI '|%DoubleFloat|) 2)))
+ (T 0.0)))
+ (T (LET ((|theta| (ATAN (ABS (/ |y| |x|)))))
+ (SEQ (COND
+ ((MINUSP |x|)
+ (SETQ |theta| (- (COERCE PI '|%DoubleFloat|) |theta|))))
+ (COND ((MINUSP |y|) (SETQ |theta| (- |theta|))))
+ (EXIT |theta|))))))
(DEFUN |DFLOAT;retract;$F;79| (|x| $)
(|DFLOAT;rationalApproximation;$2NniF;86| |x|
@@ -745,25 +741,25 @@
(DEFUN |DFLOAT;abs;2$;84| (|x| $) (DECLARE (IGNORE $)) (ABS |x|))
(DEFUN |DFLOAT;manexp| (|x| $)
- (PROG (|s| |me| |two53|)
+ (PROG (|me| |two53|)
(RETURN
(COND
((ZEROP |x|) (CONS 0 0))
- (T (SEQ (LETT |s| (|DFLOAT;sign;$I;83| |x| $) |DFLOAT;manexp|)
- (SETQ |x| (ABS |x|))
- (COND
- ((< |$DoubleFloatMaximum| |x|)
- (RETURN-FROM |DFLOAT;manexp|
- (CONS (+ (* |s|
- (|DFLOAT;mantissa;$I;6|
- |$DoubleFloatMaximum| $))
- 1)
- (|DFLOAT;exponent;$I;7|
- |$DoubleFloatMaximum| $)))))
- (LETT |me| (MANEXP |x|) |DFLOAT;manexp|)
- (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|)
- (EXIT (CONS (* |s| (TRUNCATE (* |two53| (CAR |me|))))
- (- (CDR |me|) 53)))))))))
+ (T (LET ((|s| (|DFLOAT;sign;$I;83| |x| $)))
+ (SEQ (SETQ |x| (ABS |x|))
+ (COND
+ ((< |$DoubleFloatMaximum| |x|)
+ (RETURN-FROM |DFLOAT;manexp|
+ (CONS (+ (* |s|
+ (|DFLOAT;mantissa;$I;6|
+ |$DoubleFloatMaximum| $))
+ 1)
+ (|DFLOAT;exponent;$I;7|
+ |$DoubleFloatMaximum| $)))))
+ (LETT |me| (MANEXP |x|) |DFLOAT;manexp|)
+ (LETT |two53| (EXPT 2 53) |DFLOAT;manexp|)
+ (EXIT (CONS (* |s| (TRUNCATE (* |two53| (CAR |me|))))
+ (- (CDR |me|) 53))))))))))
(DEFUN |DFLOAT;rationalApproximation;$2NniF;86| (|f| |d| |b| $)
(PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G106| |q| |r|
@@ -867,38 +863,33 @@
(SETQ |t| |#G112|)))))))))))))))))))))
(DEFUN |DFLOAT;**;$F$;87| (|x| |r| $)
- (PROG (|n| |d|)
- (RETURN
- (COND
- ((ZEROP |x|)
+ (COND
+ ((ZEROP |x|)
+ (COND
+ ((SPADCALL |r| (|getShellEntry| $ 145))
+ (|error| "0**0 is undefined"))
+ ((SPADCALL |r| (|getShellEntry| $ 146))
+ (|error| "division by 0"))
+ (T 0.0)))
+ ((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0)) 1.0)
+ ((SPADCALL |r| (|getShellEntry| $ 147)) |x|)
+ (T (LET ((|n| (SPADCALL |r| (|getShellEntry| $ 148)))
+ (|d| (SPADCALL |r| (|getShellEntry| $ 149))))
(COND
- ((SPADCALL |r| (|getShellEntry| $ 145))
- (|error| "0**0 is undefined"))
- ((SPADCALL |r| (|getShellEntry| $ 146))
- (|error| "division by 0"))
- (T 0.0)))
- ((OR (SPADCALL |r| (|getShellEntry| $ 145)) (= |x| 1.0)) 1.0)
- ((SPADCALL |r| (|getShellEntry| $ 147)) |x|)
- (T (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 148))
- |DFLOAT;**;$F$;87|)
- (LETT |d| (SPADCALL |r| (|getShellEntry| $ 149))
- |DFLOAT;**;$F$;87|)
- (EXIT (COND
- ((MINUSP |x|)
- (COND
- ((ODDP |d|)
- (COND
- ((ODDP |n|)
- (RETURN-FROM |DFLOAT;**;$F$;87|
- (- (|DFLOAT;**;$F$;87| (- |x|) |r| $))))
- (T (RETURN-FROM |DFLOAT;**;$F$;87|
- (|DFLOAT;**;$F$;87| (- |x|) |r| $)))))
- (T (|error| "negative root"))))
- ((EQL |d| 2) (EXPT (C-TO-R (SQRT |x|)) |n|))
- (T (C-TO-R (EXPT |x|
- (/
- (FLOAT |n| |$DoubleFloatMaximum|)
- (FLOAT |d| |$DoubleFloatMaximum|)))))))))))))
+ ((MINUSP |x|)
+ (COND
+ ((ODDP |d|)
+ (COND
+ ((ODDP |n|)
+ (RETURN-FROM |DFLOAT;**;$F$;87|
+ (- (|DFLOAT;**;$F$;87| (- |x|) |r| $))))
+ (T (RETURN-FROM |DFLOAT;**;$F$;87|
+ (|DFLOAT;**;$F$;87| (- |x|) |r| $)))))
+ (T (|error| "negative root"))))
+ ((EQL |d| 2) (EXPT (C-TO-R (SQRT |x|)) |n|))
+ (T (C-TO-R (EXPT |x|
+ (/ (FLOAT |n| |$DoubleFloatMaximum|)
+ (FLOAT |d| |$DoubleFloatMaximum|))))))))))
(DEFUN |DoubleFloat| ()
(DECLARE (SPECIAL |$ConstructorCache|))
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|)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index c4fb644f..36320aa1 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -118,240 +118,214 @@
(EXIT |e|))))))
(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $)
- (PROG (|explist| |q| |equalone|)
- (RETURN
- (COND
- ((SPADCALL |a| (|getShellEntry| $ 16)) NIL)
- (T (SEQ (LETT |explist| (SPADCALL (|getShellEntry| $ 56))
- |FFIELDC-;primitive?;SB;9|)
- (LETT |q| (- (SPADCALL (|getShellEntry| $ 40)) 1)
- |FFIELDC-;primitive?;SB;9|)
- (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|)
- (LET ((#0=#:G1488 |explist|) (|exp| NIL))
- (LOOP
- (COND
- ((OR (ATOM #0#)
- (PROGN (SETQ |exp| (CAR #0#)) NIL)
- (NOT (NOT |equalone|)))
- (RETURN NIL))
- (T (SETQ |equalone|
- (SPADCALL
- (SPADCALL |a|
- (TRUNCATE |q| (CAR |exp|))
- (|getShellEntry| $ 58))
- (|getShellEntry| $ 59)))))
- (SETQ #0# (CDR #0#))))
- (EXIT (NOT |equalone|))))))))
+ (COND
+ ((SPADCALL |a| (|getShellEntry| $ 16)) NIL)
+ (T (LET ((|explist| (SPADCALL (|getShellEntry| $ 56)))
+ (|q| (- (SPADCALL (|getShellEntry| $ 40)) 1))
+ (|equalone| NIL))
+ (SEQ (LET ((#0=#:G1488 |explist|) (|exp| NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM #0#) (PROGN (SETQ |exp| (CAR #0#)) NIL)
+ (NOT (NOT |equalone|)))
+ (RETURN NIL))
+ (T (SETQ |equalone|
+ (SPADCALL
+ (SPADCALL |a|
+ (TRUNCATE |q| (CAR |exp|))
+ (|getShellEntry| $ 58))
+ (|getShellEntry| $ 59)))))
+ (SETQ #0# (CDR #0#))))
+ (EXIT (NOT |equalone|)))))))
(DEFUN |FFIELDC-;order;SPi;10| (|e| $)
- (PROG (|primeDivisor| |a| |goon| |ord| |lof|)
+ (PROG (|primeDivisor| |a| |goon|)
(RETURN
(COND
((SPADCALL |e| (|spadConstant| $ 7) (|getShellEntry| $ 63))
(|error| "order(0) is not defined "))
- (T (SEQ (LETT |ord| (- (SPADCALL (|getShellEntry| $ 40)) 1)
- |FFIELDC-;order;SPi;10|)
- (LETT |lof| (SPADCALL (|getShellEntry| $ 56))
- |FFIELDC-;order;SPi;10|)
- (LET ((#0=#:G1489 |lof|))
- (LOOP
- (COND
- ((ATOM #0#) (RETURN NIL))
- (T (LET ((|rec| (CAR #0#)))
- (SEQ (LETT |a|
- (TRUNCATE |ord|
- (LETT |primeDivisor| (CAR |rec|)
- |FFIELDC-;order;SPi;10|))
- |FFIELDC-;order;SPi;10|)
- (LETT |goon|
- (SPADCALL
- (SPADCALL |e| |a|
- (|getShellEntry| $ 58))
- (|getShellEntry| $ 59))
- |FFIELDC-;order;SPi;10|)
- (LET ((|j| 0)
- (#1=#:G1490 (- (CDR |rec|) 2)))
- (LOOP
- (COND
- ((OR (> |j| #1#) (NOT |goon|))
- (RETURN NIL))
- (T
- (SEQ (SETQ |ord| |a|)
- (SETQ |a|
- (TRUNCATE |ord|
- |primeDivisor|))
- (EXIT
- (SETQ |goon|
- (SPADCALL
- (SPADCALL |e| |a|
- (|getShellEntry| $ 58))
- (|getShellEntry| $ 59)))))))
- (SETQ |j| (+ |j| 1))))
- (EXIT (COND (|goon| (SETQ |ord| |a|))))))))
- (SETQ #0# (CDR #0#))))
- (EXIT |ord|)))))))
+ (T (LET ((|ord| (- (SPADCALL (|getShellEntry| $ 40)) 1))
+ (|lof| (SPADCALL (|getShellEntry| $ 56))))
+ (SEQ (LET ((#0=#:G1489 |lof|))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN NIL))
+ (T (LET ((|rec| (CAR #0#)))
+ (SEQ (LETT |a|
+ (TRUNCATE |ord|
+ (LETT |primeDivisor|
+ (CAR |rec|)
+ |FFIELDC-;order;SPi;10|))
+ |FFIELDC-;order;SPi;10|)
+ (LETT |goon|
+ (SPADCALL
+ (SPADCALL |e| |a|
+ (|getShellEntry| $ 58))
+ (|getShellEntry| $ 59))
+ |FFIELDC-;order;SPi;10|)
+ (LET ((|j| 0)
+ (#1=#:G1490 (- (CDR |rec|) 2)))
+ (LOOP
+ (COND
+ ((OR (> |j| #1#) (NOT |goon|))
+ (RETURN NIL))
+ (T
+ (SEQ (SETQ |ord| |a|)
+ (SETQ |a|
+ (TRUNCATE |ord|
+ |primeDivisor|))
+ (EXIT
+ (SETQ |goon|
+ (SPADCALL
+ (SPADCALL |e| |a|
+ (|getShellEntry| $ 58))
+ (|getShellEntry| $ 59)))))))
+ (SETQ |j| (+ |j| 1))))
+ (EXIT (COND
+ (|goon| (SETQ |ord| |a|))))))))
+ (SETQ #0# (CDR #0#))))
+ (EXIT |ord|))))))))
(DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $)
- (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |faclist|
- |a| |gen| |disclog| |mult| |groupord| |exp|)
+ (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |disclog|
+ |mult| |groupord| |exp|)
(RETURN
(COND
((SPADCALL |b| (|getShellEntry| $ 16))
(|error| "discreteLog: logarithm of zero"))
- (T (SEQ (LETT |faclist| (SPADCALL (|getShellEntry| $ 56))
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |a| |b| |FFIELDC-;discreteLog;SNni;11|)
- (LETT |gen| (SPADCALL (|getShellEntry| $ 65))
- |FFIELDC-;discreteLog;SNni;11|)
- (EXIT (COND
- ((SPADCALL |b| |gen| (|getShellEntry| $ 63)) 1)
- (T (SEQ (LETT |disclog| 0
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |mult| 1
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |groupord|
- (-
- (SPADCALL
- (|getShellEntry| $ 40))
- 1)
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |exp| |groupord|
- |FFIELDC-;discreteLog;SNni;11|)
- (LET ((#0=#:G1491 |faclist|))
- (LOOP
- (COND
- ((ATOM #0#) (RETURN NIL))
- (T
- (LET ((|f| (CAR #0#)))
- (SEQ
- (LETT |fac| (CAR |f|)
- |FFIELDC-;discreteLog;SNni;11|)
- (EXIT
- (LET
- ((|t| 0)
- (#1=#:G1492
- (- (CDR |f|) 1)))
- (LOOP
- (COND
- ((> |t| #1#)
- (RETURN NIL))
- (T
- (SEQ
- (SETQ |exp|
- (TRUNCATE |exp|
- |fac|))
- (LETT |exptable|
- (SPADCALL |fac|
- (|getShellEntry| $
- 67))
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |n|
- (SPADCALL
- |exptable|
- (|getShellEntry| $
- 68))
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |c|
- (SPADCALL |a| |exp|
- (|getShellEntry| $
- 58))
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |end|
- (TRUNCATE
- (- |fac| 1) |n|)
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |found| NIL
- |FFIELDC-;discreteLog;SNni;11|)
- (LETT |disc1| 0
- |FFIELDC-;discreteLog;SNni;11|)
- (LET ((|i| 0))
- (LOOP
- (COND
- ((OR
- (> |i|
- |end|)
- (NOT
- (NOT
- |found|)))
- (RETURN NIL))
- (T
- (SEQ
- (LETT |rho|
- (SPADCALL
- (SPADCALL
- |c|
- (|getShellEntry|
- $ 11))
- |exptable|
- (|getShellEntry|
- $ 71))
- |FFIELDC-;discreteLog;SNni;11|)
- (EXIT
- (COND
- ((ZEROP
- (CAR
- |rho|))
- (SEQ
- (SETQ
- |found|
- T)
- (EXIT
- (SETQ
- |disc1|
- (*
- (+
- (*
- |n|
- |i|)
- (CDR
- |rho|))
- |mult|)))))
- (T
- (SETQ
- |c|
- (SPADCALL
- |c|
- (SPADCALL
- |gen|
- (*
- (TRUNCATE
- |groupord|
- |fac|)
- (-
- |n|))
- (|getShellEntry|
- $
- 58))
- (|getShellEntry|
- $ 77)))))))))
- (SETQ |i|
- (+ |i| 1))))
- (EXIT
+ (T (LET ((|faclist| (SPADCALL (|getShellEntry| $ 56)))
+ (|a| |b|) (|gen| (SPADCALL (|getShellEntry| $ 65))))
+ (COND
+ ((SPADCALL |b| |gen| (|getShellEntry| $ 63)) 1)
+ (T (SEQ (LETT |disclog| 0
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |mult| 1 |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |groupord|
+ (- (SPADCALL (|getShellEntry| $ 40)) 1)
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |exp| |groupord|
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LET ((#0=#:G1491 |faclist|))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN NIL))
+ (T (LET ((|f| (CAR #0#)))
+ (SEQ (LETT |fac| (CAR |f|)
+ |FFIELDC-;discreteLog;SNni;11|)
+ (EXIT
+ (LET
+ ((|t| 0)
+ (#1=#:G1492 (- (CDR |f|) 1)))
+ (LOOP
+ (COND
+ ((> |t| #1#)
+ (RETURN NIL))
+ (T
+ (SEQ
+ (SETQ |exp|
+ (TRUNCATE |exp| |fac|))
+ (LETT |exptable|
+ (SPADCALL |fac|
+ (|getShellEntry| $
+ 67))
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |n|
+ (SPADCALL |exptable|
+ (|getShellEntry| $
+ 68))
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |c|
+ (SPADCALL |a| |exp|
+ (|getShellEntry| $
+ 58))
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |end|
+ (TRUNCATE (- |fac| 1)
+ |n|)
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |found| NIL
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LETT |disc1| 0
+ |FFIELDC-;discreteLog;SNni;11|)
+ (LET ((|i| 0))
+ (LOOP
(COND
- (|found|
+ ((OR
+ (> |i| |end|)
+ (NOT
+ (NOT |found|)))
+ (RETURN NIL))
+ (T
(SEQ
- (SETQ |mult|
- (* |mult|
- |fac|))
- (SETQ |disclog|
- (+ |disclog|
- |disc1|))
- (EXIT
- (SETQ |a|
- (SPADCALL |a|
- (SPADCALL
- |gen|
- (- |disc1|)
- (|getShellEntry|
- $ 58))
+ (LETT |rho|
+ (SPADCALL
+ (SPADCALL |c|
(|getShellEntry|
- $ 77))))))
- (T
- (|error|
- "discreteLog: ?? discrete logarithm")))))))
- (SETQ |t| (+ |t| 1)))))))))
- (SETQ #0# (CDR #0#))))
- (EXIT |disclog|)))))))))))
+ $ 11))
+ |exptable|
+ (|getShellEntry|
+ $ 71))
+ |FFIELDC-;discreteLog;SNni;11|)
+ (EXIT
+ (COND
+ ((ZEROP
+ (CAR
+ |rho|))
+ (SEQ
+ (SETQ
+ |found|
+ T)
+ (EXIT
+ (SETQ
+ |disc1|
+ (*
+ (+
+ (* |n|
+ |i|)
+ (CDR
+ |rho|))
+ |mult|)))))
+ (T
+ (SETQ |c|
+ (SPADCALL
+ |c|
+ (SPADCALL
+ |gen|
+ (*
+ (TRUNCATE
+ |groupord|
+ |fac|)
+ (- |n|))
+ (|getShellEntry|
+ $ 58))
+ (|getShellEntry|
+ $ 77)))))))))
+ (SETQ |i|
+ (+ |i| 1))))
+ (EXIT
+ (COND
+ (|found|
+ (SEQ
+ (SETQ |mult|
+ (* |mult| |fac|))
+ (SETQ |disclog|
+ (+ |disclog|
+ |disc1|))
+ (EXIT
+ (SETQ |a|
+ (SPADCALL |a|
+ (SPADCALL |gen|
+ (- |disc1|)
+ (|getShellEntry|
+ $ 58))
+ (|getShellEntry|
+ $ 77))))))
+ (T
+ (|error|
+ "discreteLog: ?? discrete logarithm")))))))
+ (SETQ |t| (+ |t| 1)))))))))
+ (SETQ #0# (CDR #0#))))
+ (EXIT |disclog|))))))))))
(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $)
(PROG (|rhoHelp| |rho| |fac| |primroot| |groupord| |faclist| |a|
@@ -456,39 +430,30 @@
(SPADCALL |f| (|getShellEntry| $ 98)))
(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $)
- (PROG (|flist|)
- (RETURN
- (COND
- ((SPADCALL |f| (|spadConstant| $ 99) (|getShellEntry| $ 100))
- (|spadConstant| $ 101))
- (T (SEQ (LETT |flist| (SPADCALL |f| T (|getShellEntry| $ 105))
- |FFIELDC-;factorSquareFreePolynomial|)
- (EXIT (SPADCALL
- (SPADCALL (CAR |flist|)
- (|getShellEntry| $ 106))
- (LET ((#0=#:G1483 NIL) (#1=#:G1484 T)
- (#2=#:G1495 (CDR |flist|)))
- (LOOP
- (COND
- ((ATOM #2#)
- (RETURN
- (COND
- (#1# (|spadConstant| $ 109))
- (T #0#))))
- (T (LET ((|u| (CAR #2#)))
- (LET
- ((#3=#:G1482
- (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)))))))))
+ (COND
+ ((SPADCALL |f| (|spadConstant| $ 99) (|getShellEntry| $ 100))
+ (|spadConstant| $ 101))
+ (T (LET ((|flist| (SPADCALL |f| T (|getShellEntry| $ 105))))
+ (SPADCALL (SPADCALL (CAR |flist|) (|getShellEntry| $ 106))
+ (LET ((#0=#:G1483 NIL) (#1=#:G1484 T)
+ (#2=#:G1495 (CDR |flist|)))
+ (LOOP
+ (COND
+ ((ATOM #2#)
+ (RETURN
+ (COND (#1# (|spadConstant| $ 109)) (T #0#))))
+ (T (LET ((|u| (CAR #2#)))
+ (LET ((#3=#:G1482
+ (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| $)
(SPADCALL |f| |g| (|getShellEntry| $ 112)))
diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp
index 46927a01..a2e1e688 100644
--- a/src/algebra/strap/GCDDOM-.lsp
+++ b/src/algebra/strap/GCDDOM-.lsp
@@ -14,22 +14,17 @@
|GCDDOM-;gcdPolynomial;3Sup;4|))
(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $)
- (PROG (LCM)
- (RETURN
- (COND
- ((OR (SPADCALL |y| (|spadConstant| $ 7) (|getShellEntry| $ 9))
- (SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9)))
- (|spadConstant| $ 7))
- (T (SEQ (LETT LCM
- (SPADCALL |y|
- (SPADCALL |x| |y| (|getShellEntry| $ 10))
- (|getShellEntry| $ 12))
- |GCDDOM-;lcm;3S;1|)
- (EXIT (COND
- ((ZEROP (CAR LCM))
- (SPADCALL |x| (CDR LCM)
- (|getShellEntry| $ 13)))
- (T (|error| "bad gcd in lcm computation"))))))))))
+ (COND
+ ((OR (SPADCALL |y| (|spadConstant| $ 7) (|getShellEntry| $ 9))
+ (SPADCALL |x| (|spadConstant| $ 7) (|getShellEntry| $ 9)))
+ (|spadConstant| $ 7))
+ (T (LET ((LCM (SPADCALL |y|
+ (SPADCALL |x| |y| (|getShellEntry| $ 10))
+ (|getShellEntry| $ 12))))
+ (COND
+ ((ZEROP (CAR LCM))
+ (SPADCALL |x| (CDR LCM) (|getShellEntry| $ 13)))
+ (T (|error| "bad gcd in lcm computation")))))))
(DEFUN |GCDDOM-;lcm;LS;2| (|l| $)
(SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7)
@@ -40,123 +35,130 @@
(|getShellEntry| $ 19)))
(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $)
- (PROG (|c1| |c2| |e2| |e1| |p|)
+ (PROG (|e2| |e1| |p|)
(RETURN
(COND
((SPADCALL |p1| (|getShellEntry| $ 24))
(SPADCALL |p2| (|getShellEntry| $ 25)))
((SPADCALL |p2| (|getShellEntry| $ 24))
(SPADCALL |p1| (|getShellEntry| $ 25)))
- (T (SEQ (LETT |c1| (SPADCALL |p1| (|getShellEntry| $ 26))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (LETT |c2| (SPADCALL |p2| (|getShellEntry| $ 26))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (SETQ |p1|
- (LET ((#0=#:G1393
- (SPADCALL |p1| |c1|
+ (T (LET ((|c1| (SPADCALL |p1| (|getShellEntry| $ 26)))
+ (|c2| (SPADCALL |p2| (|getShellEntry| $ 26))))
+ (SEQ (SETQ |p1|
+ (LET ((#0=#:G1393
+ (SPADCALL |p1| |c1|
+ (|getShellEntry| $ 27))))
+ (|check-union| (ZEROP (CAR #0#))
+ (|SparseUnivariatePolynomial|
+ (SVREF $ 6))
+ #0#)
+ (CDR #0#)))
+ (SETQ |p2|
+ (LET ((#0# (SPADCALL |p2| |c2|
(|getShellEntry| $ 27))))
- (|check-union| (ZEROP (CAR #0#))
- (|SparseUnivariatePolynomial| (SVREF $ 6))
- #0#)
- (CDR #0#)))
- (SETQ |p2|
- (LET ((#0# (SPADCALL |p2| |c2|
- (|getShellEntry| $ 27))))
- (|check-union| (ZEROP (CAR #0#))
- (|SparseUnivariatePolynomial| (SVREF $ 6))
- #0#)
- (CDR #0#)))
- (SEQ (LETT |e1| (SPADCALL |p1| (|getShellEntry| $ 29))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (EXIT (COND
- ((PLUSP |e1|)
- (SETQ |p1|
- (LET
- ((#0#
- (SPADCALL |p1|
- (SPADCALL (|spadConstant| $ 16)
- |e1| (|getShellEntry| $ 34))
- (|getShellEntry| $ 35))))
- (|check-union| (ZEROP (CAR #0#))
- (|SparseUnivariatePolynomial|
- (SVREF $ 6))
- #0#)
- (CDR #0#)))))))
- (SEQ (LETT |e2| (SPADCALL |p2| (|getShellEntry| $ 29))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (EXIT (COND
- ((PLUSP |e2|)
- (SETQ |p2|
- (LET
- ((#0#
- (SPADCALL |p2|
- (SPADCALL (|spadConstant| $ 16)
- |e2| (|getShellEntry| $ 34))
- (|getShellEntry| $ 35))))
- (|check-union| (ZEROP (CAR #0#))
- (|SparseUnivariatePolynomial|
- (SVREF $ 6))
- #0#)
- (CDR #0#)))))))
- (LETT |e1| (MIN |e1| |e2|)
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (SETQ |c1| (SPADCALL |c1| |c2| (|getShellEntry| $ 10)))
- (SETQ |p1|
- (COND
- ((OR (ZEROP (SPADCALL |p1|
- (|getShellEntry| $ 37)))
- (ZEROP (SPADCALL |p2|
- (|getShellEntry| $ 37))))
- (SPADCALL |c1| 0 (|getShellEntry| $ 34)))
- (T (SEQ (LETT |p|
- (SPADCALL |p1| |p2|
- (|getShellEntry| $ 39))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (EXIT (COND
- ((ZEROP
- (SPADCALL |p|
- (|getShellEntry| $ 37)))
- (SPADCALL |c1| 0
- (|getShellEntry| $ 34)))
- (T
- (SEQ
- (SETQ |c2|
- (SPADCALL
- (SPADCALL |p1|
- (|getShellEntry| $ 40))
- (SPADCALL |p2|
- (|getShellEntry| $ 40))
- (|getShellEntry| $ 10)))
- (EXIT
- (SPADCALL
- (SPADCALL |c1|
+ (|check-union| (ZEROP (CAR #0#))
+ (|SparseUnivariatePolynomial|
+ (SVREF $ 6))
+ #0#)
+ (CDR #0#)))
+ (SEQ (LETT |e1|
+ (SPADCALL |p1| (|getShellEntry| $ 29))
+ |GCDDOM-;gcdPolynomial;3Sup;4|)
+ (EXIT (COND
+ ((PLUSP |e1|)
+ (SETQ |p1|
+ (LET
+ ((#0#
+ (SPADCALL |p1|
+ (SPADCALL
+ (|spadConstant| $ 16) |e1|
+ (|getShellEntry| $ 34))
+ (|getShellEntry| $ 35))))
+ (|check-union|
+ (ZEROP (CAR #0#))
+ (|SparseUnivariatePolynomial|
+ (SVREF $ 6))
+ #0#)
+ (CDR #0#)))))))
+ (SEQ (LETT |e2|
+ (SPADCALL |p2| (|getShellEntry| $ 29))
+ |GCDDOM-;gcdPolynomial;3Sup;4|)
+ (EXIT (COND
+ ((PLUSP |e2|)
+ (SETQ |p2|
+ (LET
+ ((#0#
+ (SPADCALL |p2|
+ (SPADCALL
+ (|spadConstant| $ 16) |e2|
+ (|getShellEntry| $ 34))
+ (|getShellEntry| $ 35))))
+ (|check-union|
+ (ZEROP (CAR #0#))
+ (|SparseUnivariatePolynomial|
+ (SVREF $ 6))
+ #0#)
+ (CDR #0#)))))))
+ (LETT |e1| (MIN |e1| |e2|)
+ |GCDDOM-;gcdPolynomial;3Sup;4|)
+ (SETQ |c1|
+ (SPADCALL |c1| |c2| (|getShellEntry| $ 10)))
+ (SETQ |p1|
+ (COND
+ ((OR (ZEROP (SPADCALL |p1|
+ (|getShellEntry| $ 37)))
+ (ZEROP (SPADCALL |p2|
+ (|getShellEntry| $ 37))))
+ (SPADCALL |c1| 0 (|getShellEntry| $ 34)))
+ (T (SEQ (LETT |p|
+ (SPADCALL |p1| |p2|
+ (|getShellEntry| $ 39))
+ |GCDDOM-;gcdPolynomial;3Sup;4|)
+ (EXIT (COND
+ ((ZEROP
+ (SPADCALL |p|
+ (|getShellEntry| $ 37)))
+ (SPADCALL |c1| 0
+ (|getShellEntry| $ 34)))
+ (T
+ (SEQ
+ (SETQ |c2|
+ (SPADCALL
+ (SPADCALL |p1|
+ (|getShellEntry| $ 40))
+ (SPADCALL |p2|
+ (|getShellEntry| $ 40))
+ (|getShellEntry| $ 10)))
+ (EXIT
(SPADCALL
- (LET
- ((#0#
- (SPADCALL
- (SPADCALL |c2| |p|
- (|getShellEntry| $
- 41))
- (SPADCALL |p|
- (|getShellEntry| $
- 40))
- (|getShellEntry| $
- 27))))
- (|check-union|
- (ZEROP (CAR #0#))
- (|SparseUnivariatePolynomial|
- (SVREF $ 6))
- #0#)
- (CDR #0#))
- (|getShellEntry| $ 42))
- (|getShellEntry| $ 41))
- (|getShellEntry| $ 25)))))))))))
- (EXIT (COND
- ((ZEROP |e1|) |p1|)
- (T (SPADCALL
- (SPADCALL (|spadConstant| $ 16) |e1|
- (|getShellEntry| $ 34))
- |p1| (|getShellEntry| $ 44)))))))))))
+ (SPADCALL |c1|
+ (SPADCALL
+ (LET
+ ((#0#
+ (SPADCALL
+ (SPADCALL |c2| |p|
+ (|getShellEntry| $
+ 41))
+ (SPADCALL |p|
+ (|getShellEntry| $
+ 40))
+ (|getShellEntry| $
+ 27))))
+ (|check-union|
+ (ZEROP (CAR #0#))
+ (|SparseUnivariatePolynomial|
+ (SVREF $ 6))
+ #0#)
+ (CDR #0#))
+ (|getShellEntry| $ 42))
+ (|getShellEntry| $ 41))
+ (|getShellEntry| $ 25)))))))))))
+ (EXIT (COND
+ ((ZEROP |e1|) |p1|)
+ (T (SPADCALL
+ (SPADCALL (|spadConstant| $ 16) |e1|
+ (|getShellEntry| $ 34))
+ |p1| (|getShellEntry| $ 44))))))))))))
(DEFUN |GcdDomain&| (|#1|)
(LET* ((|dv$1| (|devaluate| |#1|))
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index f374f71d..16862cb2 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -292,20 +292,18 @@
(EXIT NIL)))
(DEFUN |ILIST;concat!;3$;25| (|x| |y| $)
- (PROG (|z|)
- (RETURN
- (COND
- ((NULL |x|)
- (COND
- ((NULL |y|) |x|)
- (T (SEQ (PUSH (|SPADfirst| |y|) |x|) (RPLACD |x| (CDR |y|))
- (EXIT |x|)))))
- (T (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|)
- (LOOP
- (COND
- ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL))
- (T (SETQ |z| (CDR |z|)))))
- (RPLACD |z| |y|) (EXIT |x|)))))))
+ (COND
+ ((NULL |x|)
+ (COND
+ ((NULL |y|) |x|)
+ (T (SEQ (PUSH (|SPADfirst| |y|) |x|) (RPLACD |x| (CDR |y|))
+ (EXIT |x|)))))
+ (T (LET ((|z| |x|))
+ (SEQ (LOOP
+ (COND
+ ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL))
+ (T (SETQ |z| (CDR |z|)))))
+ (RPLACD |z| |y|) (EXIT |x|))))))
(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $)
(PROG (|pp| |f| |pr|)
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index 51633f6e..97fd89c1 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -411,29 +411,25 @@
(|getShellEntry| $ 23)))))))))))
(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $)
- (PROG (|p|)
- (RETURN
- (COND
- ((SPADCALL |l| (|getShellEntry| $ 16)) T)
- (T (SEQ (LETT |p| (SPADCALL |l| (|getShellEntry| $ 17))
- |LSAGG-;sorted?;MAB;15|)
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16))))
- (RETURN NIL))
- (T (SEQ (COND
- ((NOT (SPADCALL
- (SPADCALL |l|
- (|getShellEntry| $ 18))
- (SPADCALL |p|
- (|getShellEntry| $ 18))
- |f|))
- (RETURN-FROM |LSAGG-;sorted?;MAB;15|
- NIL)))
- (EXIT (SETQ |p|
- (SPADCALL (SETQ |l| |p|)
- (|getShellEntry| $ 17))))))))
- (EXIT T)))))))
+ (COND
+ ((SPADCALL |l| (|getShellEntry| $ 16)) T)
+ (T (LET ((|p| (SPADCALL |l| (|getShellEntry| $ 17))))
+ (SEQ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16))))
+ (RETURN NIL))
+ (T (SEQ (COND
+ ((NOT (SPADCALL
+ (SPADCALL |l|
+ (|getShellEntry| $ 18))
+ (SPADCALL |p|
+ (|getShellEntry| $ 18))
+ |f|))
+ (RETURN-FROM |LSAGG-;sorted?;MAB;15| NIL)))
+ (EXIT (SETQ |p|
+ (SPADCALL (SETQ |l| |p|)
+ (|getShellEntry| $ 17))))))))
+ (EXIT T))))))
(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $)
(LET ((|r| |i|))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index e1e58863..48fa6b0d 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -942,20 +942,15 @@
(LIST 'RARROW |a| |b|))
(DEFUN |OUTFORM;differentiate;$Nni$;97| (|a| |nn| $)
- (PROG (|r| |s|)
- (RETURN
- (COND
- ((ZEROP |nn|) |a|)
- ((< |nn| 4) (|OUTFORM;prime;$Nni$;86| |a| |nn| $))
- (T (SEQ (LETT |r|
- (SPADCALL
- (|check-subtype| (PLUSP |nn|)
- '(|PositiveInteger|) |nn|)
- (|getShellEntry| $ 137))
- |OUTFORM;differentiate;$Nni$;97|)
- (LETT |s| (SPADCALL |r| (|getShellEntry| $ 138))
- |OUTFORM;differentiate;$Nni$;97|)
- (EXIT (|OUTFORM;super;3$;43| |a| (LIST 'PAREN |s|) $))))))))
+ (COND
+ ((ZEROP |nn|) |a|)
+ ((< |nn| 4) (|OUTFORM;prime;$Nni$;86| |a| |nn| $))
+ (T (LET* ((|r| (SPADCALL
+ (|check-subtype| (PLUSP |nn|)
+ '(|PositiveInteger|) |nn|)
+ (|getShellEntry| $ 137)))
+ (|s| (SPADCALL |r| (|getShellEntry| $ 138))))
+ (|OUTFORM;super;3$;43| |a| (LIST 'PAREN |s|) $)))))
(DEFUN |OUTFORM;sum;2$;98| (|a| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index 0025e21f..d689f438 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -343,39 +343,34 @@
(SETQ #0# (CDR #0#)))))
(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $)
- (PROG (|u| |d|)
- (RETURN
- (COND
- ((SPADCALL |p| (|getShellEntry| $ 78)) 0)
- (T (SEQ (LETT |u|
- (SPADCALL |p|
- (LET ((#0=#:G1467
- (SPADCALL |p|
- (|getShellEntry| $ 53))))
- (|check-union| (ZEROP (CAR #0#))
- (SVREF $ 9) #0#)
- (CDR #0#))
- (|getShellEntry| $ 59))
- |POLYCAT-;totalDegree;SNni;13|)
- (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|)
- (LOOP
- (COND
- ((NOT (SPADCALL |u| (|spadConstant| $ 80)
- (|getShellEntry| $ 81)))
- (RETURN NIL))
- (T (SEQ (SETQ |d|
- (MAX |d|
- (+
- (SPADCALL |u|
- (|getShellEntry| $ 82))
- (SPADCALL
- (SPADCALL |u|
- (|getShellEntry| $ 83))
- (|getShellEntry| $ 84)))))
- (EXIT (SETQ |u|
- (SPADCALL |u|
- (|getShellEntry| $ 87))))))))
- (EXIT |d|)))))))
+ (COND
+ ((SPADCALL |p| (|getShellEntry| $ 78)) 0)
+ (T (LET ((|u| (SPADCALL |p|
+ (LET ((#0=#:G1467
+ (SPADCALL |p| (|getShellEntry| $ 53))))
+ (|check-union| (ZEROP (CAR #0#)) (SVREF $ 9)
+ #0#)
+ (CDR #0#))
+ (|getShellEntry| $ 59)))
+ (|d| 0))
+ (SEQ (LOOP
+ (COND
+ ((NOT (SPADCALL |u| (|spadConstant| $ 80)
+ (|getShellEntry| $ 81)))
+ (RETURN NIL))
+ (T (SEQ (SETQ |d|
+ (MAX |d|
+ (+
+ (SPADCALL |u|
+ (|getShellEntry| $ 82))
+ (SPADCALL
+ (SPADCALL |u|
+ (|getShellEntry| $ 83))
+ (|getShellEntry| $ 84)))))
+ (EXIT (SETQ |u|
+ (SPADCALL |u|
+ (|getShellEntry| $ 87))))))))
+ (EXIT |d|))))))
(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $)
(PROG (|v| |u| |d| |w|)
@@ -891,88 +886,84 @@
(EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| $)))))))))
(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $)
- (PROG (|v| |d| |ans| |dd| |cp| |ansx|)
+ (PROG (|d| |ans| |dd| |cp| |ansx|)
(RETURN
(COND
((NULL |vars|)
- (SEQ (LETT |ans|
- (SPADCALL (SPADCALL |p| (|getShellEntry| $ 175))
- (|getShellEntry| $ 185))
- |POLYCAT-;charthRootlv|)
- (EXIT (COND
- ((EQL (CAR |ans|) 1) (CONS 1 "failed"))
- (T (CONS 0
- (SPADCALL (CDR |ans|)
- (|getShellEntry| $ 51))))))))
- (T (SEQ (LETT |v| (|SPADfirst| |vars|) |POLYCAT-;charthRootlv|)
- (SETQ |vars| (CDR |vars|))
- (LETT |d| (SPADCALL |p| |v| (|getShellEntry| $ 46))
- |POLYCAT-;charthRootlv|)
- (LETT |ans| (|spadConstant| $ 27)
- |POLYCAT-;charthRootlv|)
- (LOOP
- (COND
- ((NOT (PLUSP |d|)) (RETURN NIL))
- (T (SEQ (LETT |dd|
- (SPADCALL |d| |ch|
- (|getShellEntry| $ 173))
- |POLYCAT-;charthRootlv|)
- (EXIT (COND
- ((EQL (CAR |dd|) 1)
- (RETURN-FROM
- |POLYCAT-;charthRootlv|
- (CONS 1 "failed")))
- (T
- (SEQ
- (LETT |cp|
- (SPADCALL |p| |v| |d|
- (|getShellEntry| $ 188))
- |POLYCAT-;charthRootlv|)
- (SETQ |p|
- (SPADCALL |p|
- (SPADCALL |cp| |v| |d|
- (|getShellEntry| $ 47))
- (|getShellEntry| $ 189)))
- (LETT |ansx|
- (|POLYCAT-;charthRootlv| |cp|
- |vars| |ch| $)
- |POLYCAT-;charthRootlv|)
- (EXIT
- (COND
- ((EQL (CAR |ansx|) 1)
- (RETURN-FROM
- |POLYCAT-;charthRootlv|
- (CONS 1 "failed")))
- (T
- (SEQ
- (SETQ |d|
- (SPADCALL |p| |v|
- (|getShellEntry| $ 46)))
- (EXIT
- (SETQ |ans|
- (SPADCALL |ans|
- (SPADCALL (CDR |ansx|)
- |v|
- (LET
- ((#0=#:G1615
- (CDR |dd|)))
- (|check-subtype|
- (NOT (MINUSP #0#))
- '(|NonNegativeInteger|)
- #0#))
- (|getShellEntry| $ 47))
- (|getShellEntry| $ 183))))))))))))))))
- (LETT |ansx|
- (|POLYCAT-;charthRootlv| |p| |vars| |ch| $)
- |POLYCAT-;charthRootlv|)
- (EXIT (COND
- ((EQL (CAR |ansx|) 1)
- (RETURN-FROM |POLYCAT-;charthRootlv|
- (CONS 1 "failed")))
- (T (RETURN-FROM |POLYCAT-;charthRootlv|
- (CONS 0
- (SPADCALL |ans| (CDR |ansx|)
- (|getShellEntry| $ 183)))))))))))))
+ (LET ((|ans| (SPADCALL (SPADCALL |p| (|getShellEntry| $ 175))
+ (|getShellEntry| $ 185))))
+ (COND
+ ((EQL (CAR |ans|) 1) (CONS 1 "failed"))
+ (T (CONS 0 (SPADCALL (CDR |ans|) (|getShellEntry| $ 51)))))))
+ (T (LET ((|v| (|SPADfirst| |vars|)))
+ (SEQ (SETQ |vars| (CDR |vars|))
+ (LETT |d| (SPADCALL |p| |v| (|getShellEntry| $ 46))
+ |POLYCAT-;charthRootlv|)
+ (LETT |ans| (|spadConstant| $ 27)
+ |POLYCAT-;charthRootlv|)
+ (LOOP
+ (COND
+ ((NOT (PLUSP |d|)) (RETURN NIL))
+ (T (SEQ (LETT |dd|
+ (SPADCALL |d| |ch|
+ (|getShellEntry| $ 173))
+ |POLYCAT-;charthRootlv|)
+ (EXIT (COND
+ ((EQL (CAR |dd|) 1)
+ (RETURN-FROM
+ |POLYCAT-;charthRootlv|
+ (CONS 1 "failed")))
+ (T
+ (SEQ
+ (LETT |cp|
+ (SPADCALL |p| |v| |d|
+ (|getShellEntry| $ 188))
+ |POLYCAT-;charthRootlv|)
+ (SETQ |p|
+ (SPADCALL |p|
+ (SPADCALL |cp| |v| |d|
+ (|getShellEntry| $ 47))
+ (|getShellEntry| $ 189)))
+ (LETT |ansx|
+ (|POLYCAT-;charthRootlv| |cp|
+ |vars| |ch| $)
+ |POLYCAT-;charthRootlv|)
+ (EXIT
+ (COND
+ ((EQL (CAR |ansx|) 1)
+ (RETURN-FROM
+ |POLYCAT-;charthRootlv|
+ (CONS 1 "failed")))
+ (T
+ (SEQ
+ (SETQ |d|
+ (SPADCALL |p| |v|
+ (|getShellEntry| $ 46)))
+ (EXIT
+ (SETQ |ans|
+ (SPADCALL |ans|
+ (SPADCALL (CDR |ansx|)
+ |v|
+ (LET
+ ((#0=#:G1615
+ (CDR |dd|)))
+ (|check-subtype|
+ (NOT (MINUSP #0#))
+ '(|NonNegativeInteger|)
+ #0#))
+ (|getShellEntry| $ 47))
+ (|getShellEntry| $ 183))))))))))))))))
+ (LETT |ansx|
+ (|POLYCAT-;charthRootlv| |p| |vars| |ch| $)
+ |POLYCAT-;charthRootlv|)
+ (EXIT (COND
+ ((EQL (CAR |ansx|) 1)
+ (RETURN-FROM |POLYCAT-;charthRootlv|
+ (CONS 1 "failed")))
+ (T (RETURN-FROM |POLYCAT-;charthRootlv|
+ (CONS 0
+ (SPADCALL |ans| (CDR |ansx|)
+ (|getShellEntry| $ 183))))))))))))))
(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $)
(LET ((|result|
diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp
index 3989a430..0365a7f3 100644
--- a/src/algebra/strap/RNS-.lsp
+++ b/src/algebra/strap/RNS-.lsp
@@ -100,24 +100,20 @@
(T |x1|))))
(DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $)
- (PROG (|r|)
- (RETURN
- (COND
- ((SPADCALL |p| (|getShellEntry| $ 46))
- (SPADCALL |p| |x| |l| (|getShellEntry| $ 48)))
- ((SPADCALL |p| (|getShellEntry| $ 49))
- (SEQ (LETT |r| (SPADCALL |p| (|getShellEntry| $ 51))
- |RNS-;patternMatch;SP2Pmr;10|)
- (EXIT (COND
- ((ZEROP (CAR |r|))
- (COND
- ((SPADCALL
- (SPADCALL |x| (|getShellEntry| $ 33))
- (CDR |r|) (|getShellEntry| $ 52))
- |l|)
- (T (SPADCALL (|getShellEntry| $ 53)))))
- (T (SPADCALL (|getShellEntry| $ 53)))))))
- (T (SPADCALL (|getShellEntry| $ 53)))))))
+ (COND
+ ((SPADCALL |p| (|getShellEntry| $ 46))
+ (SPADCALL |p| |x| |l| (|getShellEntry| $ 48)))
+ ((SPADCALL |p| (|getShellEntry| $ 49))
+ (LET ((|r| (SPADCALL |p| (|getShellEntry| $ 51))))
+ (COND
+ ((ZEROP (CAR |r|))
+ (COND
+ ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 33)) (CDR |r|)
+ (|getShellEntry| $ 52))
+ |l|)
+ (T (SPADCALL (|getShellEntry| $ 53)))))
+ (T (SPADCALL (|getShellEntry| $ 53))))))
+ (T (SPADCALL (|getShellEntry| $ 53)))))
(DEFUN |RealNumberSystem&| (|#1|)
(LET* ((|dv$1| (|devaluate| |#1|))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 787305a0..dc8a964e 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -471,127 +471,119 @@
(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) (NOT (ATOM |sy|)))
(DEFUN |SYMBOL;name;2$;31| (|sy| $)
- (PROG (|str|)
- (RETURN
- (COND
- ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
- (T (SEQ (LETT |str|
- (|SYMBOL;string;$S;24|
- (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
- (|getShellEntry| $ 137))
- $)
- |SYMBOL;name;2$;31|)
- (LET ((|i| (+ (SVREF $ 41) 1))
- (#0=#:G1526 (LENGTH |str|)))
- (LOOP
- (COND
- ((> |i| #0#) (RETURN NIL))
- (T (COND
- ((NOT (SPADCALL
- (SPADCALL |str| |i|
- (|getShellEntry| $ 106))
- (|getShellEntry| $ 139)))
- (RETURN-FROM |SYMBOL;name;2$;31|
- (|SYMBOL;coerce;S$;8|
- (SPADCALL |str|
- (SPADCALL |i| (LENGTH |str|)
- (|getShellEntry| $ 141))
- (|getShellEntry| $ 142))
- $))))))
- (SETQ |i| (+ |i| 1))))
- (EXIT (|error| "Improper scripted symbol"))))))))
+ (COND
+ ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
+ (T (LET ((|str| (|SYMBOL;string;$S;24|
+ (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
+ (|getShellEntry| $ 137))
+ $)))
+ (SEQ (LET ((|i| (+ (SVREF $ 41) 1))
+ (#0=#:G1526 (LENGTH |str|)))
+ (LOOP
+ (COND
+ ((> |i| #0#) (RETURN NIL))
+ (T (COND
+ ((NOT (SPADCALL
+ (SPADCALL |str| |i|
+ (|getShellEntry| $ 106))
+ (|getShellEntry| $ 139)))
+ (RETURN-FROM |SYMBOL;name;2$;31|
+ (|SYMBOL;coerce;S$;8|
+ (SPADCALL |str|
+ (SPADCALL |i| (LENGTH |str|)
+ (|getShellEntry| $ 141))
+ (|getShellEntry| $ 142))
+ $))))))
+ (SETQ |i| (+ |i| 1))))
+ (EXIT (|error| "Improper scripted symbol")))))))
(DEFUN |SYMBOL;scripts;$R;32| (|sy| $)
- (PROG (|nscripts| |lscripts| |str| |nstr| |m| |allscripts|)
+ (PROG (|allscripts|)
(RETURN
(COND
((NOT (|SYMBOL;scripted?;$B;30| |sy| $))
(VECTOR NIL NIL NIL NIL NIL))
- (T (SEQ (LETT |nscripts| '(0 0 0 0 0) |SYMBOL;scripts;$R;32|)
- (LETT |lscripts| (LIST NIL NIL NIL NIL NIL)
- |SYMBOL;scripts;$R;32|)
- (LETT |str|
- (|SYMBOL;string;$S;24|
- (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
- (|getShellEntry| $ 137))
- $)
- |SYMBOL;scripts;$R;32|)
- (LETT |nstr| (LENGTH |str|) |SYMBOL;scripts;$R;32|)
- (LETT |m| (SPADCALL |nscripts| (|getShellEntry| $ 144))
- |SYMBOL;scripts;$R;32|)
- (LET ((|i| |m|) (|j| (+ (SVREF $ 41) 1)))
- (LOOP
- (COND
- ((OR (> |j| |nstr|)
- (NOT (SPADCALL
- (SPADCALL |str| |j|
- (|getShellEntry| $ 106))
- (|getShellEntry| $ 139))))
- (RETURN NIL))
- (T (SPADCALL |nscripts| |i|
- (LET ((#0=#:G1517
- (-
- (SPADCALL
+ (T (LET* ((|nscripts| '(0 0 0 0 0))
+ (|lscripts| (LIST NIL NIL NIL NIL NIL))
+ (|str| (|SYMBOL;string;$S;24|
+ (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
+ (|getShellEntry| $ 137))
+ $))
+ (|nstr| (LENGTH |str|))
+ (|m| (SPADCALL |nscripts| (|getShellEntry| $ 144))))
+ (SEQ (LET ((|i| |m|) (|j| (+ (SVREF $ 41) 1)))
+ (LOOP
+ (COND
+ ((OR (> |j| |nstr|)
+ (NOT (SPADCALL
(SPADCALL |str| |j|
(|getShellEntry| $ 106))
- (|getShellEntry| $ 44))
- (SVREF $ 45))))
- (|check-subtype| (NOT (MINUSP #0#))
- '(|NonNegativeInteger|) #0#))
- (|getShellEntry| $ 148))))
- (SETQ |i| (+ |i| 1))
- (SETQ |j| (+ |j| 1))))
- (SETQ |nscripts|
- (SPADCALL (CDR |nscripts|)
- (|SPADfirst| |nscripts|)
- (|getShellEntry| $ 151)))
- (LETT |allscripts| (CDR (|SYMBOL;list;$L;34| |sy| $))
- |SYMBOL;scripts;$R;32|)
- (SETQ |m|
- (SPADCALL |lscripts| (|getShellEntry| $ 153)))
- (LET ((|i| |m|) (#1=#:G1527 |nscripts|))
- (LOOP
- (COND
- ((ATOM #1#) (RETURN NIL))
- (T (LET ((|n| (CAR #1#)))
- (COND
- ((< (LIST-LENGTH |allscripts|) |n|)
- (|error| "Improper script count in symbol"))
- (T (SEQ (SPADCALL |lscripts| |i|
- (LET
- ((#2=#:G1529
+ (|getShellEntry| $ 139))))
+ (RETURN NIL))
+ (T (SPADCALL |nscripts| |i|
+ (LET ((#0=#:G1517
+ (-
+ (SPADCALL
+ (SPADCALL |str| |j|
+ (|getShellEntry| $ 106))
+ (|getShellEntry| $ 44))
+ (SVREF $ 45))))
+ (|check-subtype| (NOT (MINUSP #0#))
+ '(|NonNegativeInteger|) #0#))
+ (|getShellEntry| $ 148))))
+ (SETQ |i| (+ |i| 1))
+ (SETQ |j| (+ |j| 1))))
+ (SETQ |nscripts|
+ (SPADCALL (CDR |nscripts|)
+ (|SPADfirst| |nscripts|)
+ (|getShellEntry| $ 151)))
+ (LETT |allscripts| (CDR (|SYMBOL;list;$L;34| |sy| $))
+ |SYMBOL;scripts;$R;32|)
+ (SETQ |m|
+ (SPADCALL |lscripts| (|getShellEntry| $ 153)))
+ (LET ((|i| |m|) (#1=#:G1527 |nscripts|))
+ (LOOP
+ (COND
+ ((ATOM #1#) (RETURN NIL))
+ (T (LET ((|n| (CAR #1#)))
+ (COND
+ ((< (LIST-LENGTH |allscripts|) |n|)
+ (|error| "Improper script count in symbol"))
+ (T (SEQ (SPADCALL |lscripts| |i|
+ (LET
+ ((#2=#:G1529
+ (SPADCALL |allscripts| |n|
+ (|getShellEntry| $ 156)))
+ (#3=#:G1528 NIL))
+ (LOOP
+ (COND
+ ((ATOM #2#)
+ (RETURN (NREVERSE #3#)))
+ (T
+ (LET ((|a| (CAR #2#)))
+ (SETQ #3#
+ (CONS
+ (|SYMBOL;coerce;$Of;11|
+ |a| $)
+ #3#)))))
+ (SETQ #2# (CDR #2#))))
+ (|getShellEntry| $ 157))
+ (EXIT
+ (SETQ |allscripts|
(SPADCALL |allscripts| |n|
- (|getShellEntry| $ 156)))
- (#3=#:G1528 NIL))
- (LOOP
- (COND
- ((ATOM #2#)
- (RETURN (NREVERSE #3#)))
- (T
- (LET ((|a| (CAR #2#)))
- (SETQ #3#
- (CONS
- (|SYMBOL;coerce;$Of;11|
- |a| $)
- #3#)))))
- (SETQ #2# (CDR #2#))))
- (|getShellEntry| $ 157))
- (EXIT
- (SETQ |allscripts|
- (SPADCALL |allscripts| |n|
- (|getShellEntry| $ 158))))))))))
- (SETQ |i| (+ |i| 1))
- (SETQ #1# (CDR #1#))))
- (EXIT (VECTOR (SPADCALL |lscripts| |m|
- (|getShellEntry| $ 159))
- (SPADCALL |lscripts| (+ |m| 1)
- (|getShellEntry| $ 159))
- (SPADCALL |lscripts| (+ |m| 2)
- (|getShellEntry| $ 159))
- (SPADCALL |lscripts| (+ |m| 3)
- (|getShellEntry| $ 159))
- (SPADCALL |lscripts| (+ |m| 4)
- (|getShellEntry| $ 159))))))))))
+ (|getShellEntry| $ 158))))))))))
+ (SETQ |i| (+ |i| 1))
+ (SETQ #1# (CDR #1#))))
+ (EXIT (VECTOR (SPADCALL |lscripts| |m|
+ (|getShellEntry| $ 159))
+ (SPADCALL |lscripts| (+ |m| 1)
+ (|getShellEntry| $ 159))
+ (SPADCALL |lscripts| (+ |m| 2)
+ (|getShellEntry| $ 159))
+ (SPADCALL |lscripts| (+ |m| 3)
+ (|getShellEntry| $ 159))
+ (SPADCALL |lscripts| (+ |m| 4)
+ (|getShellEntry| $ 159)))))))))))
(DEFUN |SYMBOL;istring| (|n| $)
(COND
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 7c1983a0..c883d258 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -222,28 +222,24 @@
(EXIT |k|))))
(DEFUN |URAGG-;tail;2A;16| (|x| $)
- (PROG (|y|)
- (RETURN
- (COND
- ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "empty list"))
- (T (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14))
- |URAGG-;tail;2A;16|)
- (LET ((|k| 0))
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 20))))
- (RETURN NIL))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |x|
- (|getShellEntry| $ 48))
- (EXIT (|error| "cyclic list"))))))
- (EXIT (SETQ |y|
- (SPADCALL (SETQ |x| |y|)
- (|getShellEntry| $ 14)))))))
- (SETQ |k| (+ |k| 1))))
- (EXIT |x|)))))))
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "empty list"))
+ (T (LET ((|y| (SPADCALL |x| (|getShellEntry| $ 14))))
+ (SEQ (LET ((|k| 0))
+ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 20))))
+ (RETURN NIL))
+ (T (SEQ (COND
+ ((EQL |k| 1000)
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 48))
+ (EXIT (|error| "cyclic list"))))))
+ (EXIT (SETQ |y|
+ (SPADCALL (SETQ |x| |y|)
+ (|getShellEntry| $ 14)))))))
+ (SETQ |k| (+ |k| 1))))
+ (EXIT |x|))))))
(DEFUN |URAGG-;findCycle| (|x| $)
(LET ((|y| (SPADCALL |x| (|getShellEntry| $ 14))))
@@ -330,25 +326,20 @@
(EXIT |x|)))))))
(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $)
- (PROG (|y| |k|)
- (RETURN
- (COND
- ((OR (SPADCALL |x| (|getShellEntry| $ 20))
- (SPADCALL (SETQ |x| (|URAGG-;findCycle| |x| $))
- (|getShellEntry| $ 20)))
- 0)
- (T (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14))
- |URAGG-;cycleLength;ANni;20|)
- (LETT |k| 1 |URAGG-;cycleLength;ANni;20|)
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |x| |y|
- (|getShellEntry| $ 54))))
- (RETURN NIL))
- (T (SEQ (SETQ |y|
- (SPADCALL |y| (|getShellEntry| $ 14)))
- (EXIT (SETQ |k| (+ |k| 1)))))))
- (EXIT |k|)))))))
+ (COND
+ ((OR (SPADCALL |x| (|getShellEntry| $ 20))
+ (SPADCALL (SETQ |x| (|URAGG-;findCycle| |x| $))
+ (|getShellEntry| $ 20)))
+ 0)
+ (T (LET ((|y| (SPADCALL |x| (|getShellEntry| $ 14))) (|k| 1))
+ (SEQ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |x| |y| (|getShellEntry| $ 54))))
+ (RETURN NIL))
+ (T (SEQ (SETQ |y|
+ (SPADCALL |y| (|getShellEntry| $ 14)))
+ (EXIT (SETQ |k| (+ |k| 1)))))))
+ (EXIT |k|))))))
(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $)
(SEQ (LET ((|i| 1))
generated by cgit v1.2.3 (git 2.39.1) at 2024-07-05 05:11:39 +0000