aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/strap
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2011-02-07 00:39:58 +0000
committerdos-reis <gdr@axiomatics.org>2011-02-07 00:39:58 +0000
commit351022a3ec02f6e131d54f3a5bcb27a8dfffbcb0 (patch)
tree0b137b74a6663d6875e7f6d8862833f782032bd4 /src/algebra/strap
parent2eef476c721ed93b1acaaf1a77e20b5b7c73ed4f (diff)
downloadopen-axiom-351022a3ec02f6e131d54f3a5bcb27a8dfffbcb0.tar.gz
* interp/c-util.boot (matchingEXIT): New.
(simplifySEQ): Use it.
Diffstat (limited to 'src/algebra/strap')
-rw-r--r--src/algebra/strap/DFLOAT.lsp130
-rw-r--r--src/algebra/strap/EUCDOM-.lsp212
-rw-r--r--src/algebra/strap/FFIELDC-.lsp667
-rw-r--r--src/algebra/strap/GCDDOM-.lsp139
-rw-r--r--src/algebra/strap/ILIST.lsp156
-rw-r--r--src/algebra/strap/INT.lsp16
-rw-r--r--src/algebra/strap/ISTRING.lsp10
-rw-r--r--src/algebra/strap/LSAGG-.lsp177
-rw-r--r--src/algebra/strap/OUTFORM.lsp25
-rw-r--r--src/algebra/strap/POLYCAT-.lsp420
-rw-r--r--src/algebra/strap/RNS-.lsp33
-rw-r--r--src/algebra/strap/SINT.lsp15
-rw-r--r--src/algebra/strap/STAGG-.lsp10
-rw-r--r--src/algebra/strap/SYMBOL.lsp234
-rw-r--r--src/algebra/strap/URAGG-.lsp333
15 files changed, 1222 insertions, 1355 deletions
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 3b21f1ba..f8825345 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -688,20 +688,20 @@
(DEFUN |DFLOAT;atan;3$;78| (|x| |y| $)
(PROG (|theta|)
(RETURN
- (SEQ (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 (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|)))))))
(DEFUN |DFLOAT;retract;$F;79| (|x| $)
(|DFLOAT;rationalApproximation;$2NniF;86| |x|
@@ -747,25 +747,23 @@
(DEFUN |DFLOAT;manexp| (|x| $)
(PROG (|s| |me| |two53|)
(RETURN
- (SEQ (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|
+ (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))))))))))
+ 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|
@@ -871,44 +869,36 @@
(DEFUN |DFLOAT;**;$F$;87| (|x| |r| $)
(PROG (|n| |d|)
(RETURN
- (SEQ (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 (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|))))))))))))))
+ (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 (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|)))))))))))))
(DEFUN |DoubleFloat| ()
(DECLARE (SPECIAL |$ConstructorCache|))
diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp
index d9375a0c..f391c801 100644
--- a/src/algebra/strap/EUCDOM-.lsp
+++ b/src/algebra/strap/EUCDOM-.lsp
@@ -51,18 +51,16 @@
(DEFUN |EUCDOM-;exquo;2SU;4| (|x| |y| $)
(PROG (|qr|)
(RETURN
- (SEQ (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 (SEQ (LETT |qr| (SPADCALL |x| |y| (|getShellEntry| $ 16))
+ |EUCDOM-;exquo;2SU;4|)
+ (EXIT (COND
+ ((SPADCALL (CDR |qr|) (|getShellEntry| $ 8))
+ (CONS 0 (CAR |qr|)))
+ (T (CONS 1 "failed"))))))))))
(DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $)
(PROG (|#G13| |#G14|)
@@ -162,35 +160,31 @@
(DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $)
(PROG (|s| |w| |qr|)
(RETURN
- (SEQ (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|)
+ (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))
(SPADCALL (SVREF |s| 1) (CDR |w|)
(|getShellEntry| $ 29)))))
- (T (SEQ (LETT |qr|
+ (T (SEQ (LETT |qr|
(SPADCALL
(SPADCALL (SVREF |s| 0)
(CDR |w|)
(|getShellEntry| $ 29))
|y| (|getShellEntry| $ 16))
|EUCDOM-;extendedEuclidean;3SU;8|)
- (EXIT
- (CONS 0
+ (EXIT (CONS 0
(CONS (CDR |qr|)
(SPADCALL
(SPADCALL (SVREF |s| 1)
@@ -198,96 +192,86 @@
(|getShellEntry| $ 29))
(SPADCALL (CAR |qr|) |x|
(|getShellEntry| $ 29))
- (|getShellEntry| $ 33))))))))))))))))
+ (|getShellEntry| $ 33)))))))))))))))
(DEFUN |EUCDOM-;principalIdeal;LR;9| (|l| $)
(PROG (|uca| |v| |u|)
(RETURN
- (SEQ (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))
+ (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)))))))))
(DEFUN |EUCDOM-;expressIdealMember;LSU;10| (|l| |z| $)
(PROG (|pid| |q|)
(RETURN
- (SEQ (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 (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#))))))))))))))
(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 ff4359c7..c4fb644f 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -120,363 +120,334 @@
(DEFUN |FFIELDC-;primitive?;SB;9| (|a| $)
(PROG (|explist| |q| |equalone|)
(RETURN
- (SEQ (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 (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|))))))))
(DEFUN |FFIELDC-;order;SPi;10| (|e| $)
(PROG (|primeDivisor| |a| |goon| |ord| |lof|)
(RETURN
- (SEQ (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|
+ (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|
+ (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|))))))))
+ (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|)
(RETURN
- (SEQ (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
+ (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
+ (LETT |mult| 1
|FFIELDC-;discreteLog;SNni;11|)
- (LETT |groupord|
+ (LETT |groupord|
(-
(SPADCALL
(|getShellEntry| $ 40))
1)
|FFIELDC-;discreteLog;SNni;11|)
- (LETT |exp| |groupord|
+ (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
+ (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
- ((OR
- (> |i|
- |end|)
- (NOT
- (NOT
- |found|)))
- (RETURN
- NIL))
- (T
+ ((ZEROP
+ (CAR
+ |rho|))
(SEQ
- (LETT
- |rho|
+ (SETQ
+ |found|
+ T)
+ (EXIT
+ (SETQ
+ |disc1|
+ (*
+ (+
+ (*
+ |n|
+ |i|)
+ (CDR
+ |rho|))
+ |mult|)))))
+ (T
+ (SETQ
+ |c|
+ (SPADCALL
+ |c|
(SPADCALL
- (SPADCALL
- |c|
- (|getShellEntry|
- $
- 11))
- |exptable|
+ |gen|
+ (*
+ (TRUNCATE
+ |groupord|
+ |fac|)
+ (-
+ |n|))
(|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|)
+ 58))
(|getShellEntry|
- $ 58))
- (|getShellEntry|
- $ 77))))))
- (T
- (|error|
- "discreteLog: ?? discrete logarithm")))))))
- (SETQ |t|
- (+ |t| 1)))))))))
- (SETQ #0# (CDR #0#))))
- (EXIT |disclog|))))))))))))
+ $ 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|
|disclog| |mult| |exp|)
(RETURN
- (SEQ (COND
- ((SPADCALL |b| (|getShellEntry| $ 16))
- (SEQ (SPADCALL "discreteLog: logarithm of zero"
- (|getShellEntry| $ 83))
- (EXIT (CONS 1 "failed"))))
- ((SPADCALL |logbase| (|getShellEntry| $ 16))
- (SEQ (SPADCALL "discreteLog: logarithm to base zero"
- (|getShellEntry| $ 83))
- (EXIT (CONS 1 "failed"))))
- ((SPADCALL |b| |logbase| (|getShellEntry| $ 63))
- (CONS 0 1))
- (T (COND
- ((NOT (ZEROP (REM (LETT |groupord|
+ (COND
+ ((SPADCALL |b| (|getShellEntry| $ 16))
+ (SEQ (SPADCALL "discreteLog: logarithm of zero"
+ (|getShellEntry| $ 83))
+ (EXIT (CONS 1 "failed"))))
+ ((SPADCALL |logbase| (|getShellEntry| $ 16))
+ (SEQ (SPADCALL "discreteLog: logarithm to base zero"
+ (|getShellEntry| $ 83))
+ (EXIT (CONS 1 "failed"))))
+ ((SPADCALL |b| |logbase| (|getShellEntry| $ 63)) (CONS 0 1))
+ (T (COND
+ ((NOT (ZEROP (REM (LETT |groupord|
(SPADCALL |logbase|
(|getShellEntry| $ 19))
|FFIELDC-;discreteLog;2SU;12|)
- (SPADCALL |b|
- (|getShellEntry| $ 19)))))
- (SEQ (SPADCALL
- "discreteLog: second argument not in cyclic group generated by first argument"
- (|getShellEntry| $ 83))
- (EXIT (CONS 1 "failed"))))
- (T (SEQ (LETT |faclist|
- (SPADCALL
- (SPADCALL |groupord|
- (|getShellEntry| $ 87))
- (|getShellEntry| $ 89))
- |FFIELDC-;discreteLog;2SU;12|)
- (LETT |a| |b| |FFIELDC-;discreteLog;2SU;12|)
- (LETT |disclog| 0
- |FFIELDC-;discreteLog;2SU;12|)
- (LETT |mult| 1 |FFIELDC-;discreteLog;2SU;12|)
- (LETT |exp| |groupord|
- |FFIELDC-;discreteLog;2SU;12|)
- (LET ((#0=#:G1493 |faclist|))
- (LOOP
- (COND
- ((ATOM #0#) (RETURN NIL))
- (T (LET ((|f| (CAR #0#)))
- (SEQ
- (LETT |fac| (CAR |f|)
- |FFIELDC-;discreteLog;2SU;12|)
- (LETT |primroot|
- (SPADCALL |logbase|
- (TRUNCATE |groupord| |fac|)
- (|getShellEntry| $ 58))
- |FFIELDC-;discreteLog;2SU;12|)
- (EXIT
- (LET
- ((|t| 0)
- (#1=#:G1494 (- (CDR |f|) 1)))
- (LOOP
- (COND
- ((> |t| #1#) (RETURN NIL))
- (T
- (SEQ
- (SETQ |exp|
- (TRUNCATE |exp| |fac|))
- (LETT |rhoHelp|
- (SPADCALL |primroot|
- (SPADCALL |a| |exp|
- (|getShellEntry| $
- 58))
- |fac|
- (|getShellEntry| $ 91))
- |FFIELDC-;discreteLog;2SU;12|)
- (EXIT
- (COND
- ((EQL (CAR |rhoHelp|)
- 1)
- (RETURN-FROM
- |FFIELDC-;discreteLog;2SU;12|
- (CONS 1 "failed")))
- (T
- (SEQ
- (LETT |rho|
- (* (CDR |rhoHelp|)
- |mult|)
- |FFIELDC-;discreteLog;2SU;12|)
- (SETQ |disclog|
- (+ |disclog|
- |rho|))
- (SETQ |mult|
- (* |mult| |fac|))
- (EXIT
- (SETQ |a|
- (SPADCALL |a|
- (SPADCALL
- |logbase|
- (- |rho|)
- (|getShellEntry|
- $ 58))
+ (SPADCALL |b| (|getShellEntry| $ 19)))))
+ (SEQ (SPADCALL
+ "discreteLog: second argument not in cyclic group generated by first argument"
+ (|getShellEntry| $ 83))
+ (EXIT (CONS 1 "failed"))))
+ (T (SEQ (LETT |faclist|
+ (SPADCALL
+ (SPADCALL |groupord|
+ (|getShellEntry| $ 87))
+ (|getShellEntry| $ 89))
+ |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |a| |b| |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |disclog| 0 |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |mult| 1 |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |exp| |groupord|
+ |FFIELDC-;discreteLog;2SU;12|)
+ (LET ((#0=#:G1493 |faclist|))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN NIL))
+ (T (LET ((|f| (CAR #0#)))
+ (SEQ (LETT |fac| (CAR |f|)
+ |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |primroot|
+ (SPADCALL |logbase|
+ (TRUNCATE |groupord| |fac|)
+ (|getShellEntry| $ 58))
+ |FFIELDC-;discreteLog;2SU;12|)
+ (EXIT
+ (LET
+ ((|t| 0)
+ (#1=#:G1494 (- (CDR |f|) 1)))
+ (LOOP
+ (COND
+ ((> |t| #1#) (RETURN NIL))
+ (T
+ (SEQ
+ (SETQ |exp|
+ (TRUNCATE |exp| |fac|))
+ (LETT |rhoHelp|
+ (SPADCALL |primroot|
+ (SPADCALL |a| |exp|
+ (|getShellEntry| $ 58))
+ |fac|
+ (|getShellEntry| $ 91))
+ |FFIELDC-;discreteLog;2SU;12|)
+ (EXIT
+ (COND
+ ((EQL (CAR |rhoHelp|)
+ 1)
+ (RETURN-FROM
+ |FFIELDC-;discreteLog;2SU;12|
+ (CONS 1 "failed")))
+ (T
+ (SEQ
+ (LETT |rho|
+ (* (CDR |rhoHelp|)
+ |mult|)
+ |FFIELDC-;discreteLog;2SU;12|)
+ (SETQ |disclog|
+ (+ |disclog| |rho|))
+ (SETQ |mult|
+ (* |mult| |fac|))
+ (EXIT
+ (SETQ |a|
+ (SPADCALL |a|
+ (SPADCALL
+ |logbase|
+ (- |rho|)
(|getShellEntry|
- $ 77)))))))))))
- (SETQ |t| (+ |t| 1)))))))))
- (SETQ #0# (CDR #0#))))
- (EXIT (CONS 0 |disclog|)))))))))))
+ $ 58))
+ (|getShellEntry|
+ $ 77)))))))))))
+ (SETQ |t| (+ |t| 1)))))))))
+ (SETQ #0# (CDR #0#))))
+ (EXIT (CONS 0 |disclog|))))))))))
(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $)
(SPADCALL |f| (|getShellEntry| $ 96)))
@@ -487,41 +458,37 @@
(DEFUN |FFIELDC-;factorSquareFreePolynomial| (|f| $)
(PROG (|flist|)
(RETURN
- (SEQ (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
+ ((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
- ((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))))))))))
+ (#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 b8e1a81d..46927a01 100644
--- a/src/algebra/strap/GCDDOM-.lsp
+++ b/src/algebra/strap/GCDDOM-.lsp
@@ -16,23 +16,20 @@
(DEFUN |GCDDOM-;lcm;3S;1| (|x| |y| $)
(PROG (LCM)
(RETURN
- (SEQ (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 (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"))))))))))
(DEFUN |GCDDOM-;lcm;LS;2| (|l| $)
(SPADCALL (ELT $ 15) |l| (|spadConstant| $ 16) (|spadConstant| $ 7)
@@ -45,38 +42,35 @@
(DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $)
(PROG (|c1| |c2| |e2| |e1| |p|)
(RETURN
- (SEQ (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))
+ (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|
+ (|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|)
- (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#)))
- (SEQ (LETT |e1|
- (SPADCALL |p1| (|getShellEntry| $ 29))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (EXIT (COND
- ((PLUSP |e1|)
- (SETQ |p1|
+ (EXIT (COND
+ ((PLUSP |e1|)
+ (SETQ |p1|
(LET
((#0#
(SPADCALL |p1|
@@ -88,12 +82,11 @@
(SVREF $ 6))
#0#)
(CDR #0#)))))))
- (SEQ (LETT |e2|
- (SPADCALL |p2| (|getShellEntry| $ 29))
- |GCDDOM-;gcdPolynomial;3Sup;4|)
- (EXIT (COND
- ((PLUSP |e2|)
- (SETQ |p2|
+ (SEQ (LETT |e2| (SPADCALL |p2| (|getShellEntry| $ 29))
+ |GCDDOM-;gcdPolynomial;3Sup;4|)
+ (EXIT (COND
+ ((PLUSP |e2|)
+ (SETQ |p2|
(LET
((#0#
(SPADCALL |p2|
@@ -105,23 +98,21 @@
(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|
+ (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
+ (EXIT (COND
((ZEROP
(SPADCALL |p|
(|getShellEntry| $ 37)))
@@ -160,12 +151,12 @@
(|getShellEntry| $ 42))
(|getShellEntry| $ 41))
(|getShellEntry| $ 25)))))))))))
- (EXIT (COND
- ((ZEROP |e1|) |p1|)
- (T (SPADCALL
- (SPADCALL (|spadConstant| $ 16)
- |e1| (|getShellEntry| $ 34))
- |p1| (|getShellEntry| $ 44))))))))))))
+ (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 27411076..f374f71d 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -150,24 +150,24 @@
(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (DECLARE (IGNORE $)) (CDR |x|))
(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $)
- (SEQ (COND
- ((NULL |x|) (|error| "Cannot update an empty list"))
- (T (SEQ (RPLACA |x| |s|) (EXIT |s|))))))
+ (COND
+ ((NULL |x|) (|error| "Cannot update an empty list"))
+ (T (SEQ (RPLACA |x| |s|) (EXIT |s|)))))
(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $)
- (SEQ (COND
- ((NULL |x|) (|error| "Cannot update an empty list"))
- (T (SEQ (RPLACA |x| |s|) (EXIT |s|))))))
+ (COND
+ ((NULL |x|) (|error| "Cannot update an empty list"))
+ (T (SEQ (RPLACA |x| |s|) (EXIT |s|)))))
(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $)
- (SEQ (COND
- ((NULL |x|) (|error| "Cannot update an empty list"))
- (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|)))))))
+ (COND
+ ((NULL |x|) (|error| "Cannot update an empty list"))
+ (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|))))))
(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $)
- (SEQ (COND
- ((NULL |x|) (|error| "Cannot update an empty list"))
- (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|)))))))
+ (COND
+ ((NULL |x|) (|error| "Cannot update an empty list"))
+ (T (SEQ (RPLACD |x| |y|) (EXIT (CDR |x|))))))
(DEFUN |ILIST;construct;L$;14| (|l| $) (DECLARE (IGNORE $)) |l|)
@@ -252,21 +252,19 @@
(|getShellEntry| $ 45))))))))))))
(DEFUN |ILIST;=;2$B;22| (|x| |y| $)
- (SEQ (COND
- ((EQ |x| |y|) T)
- (T (SEQ (LOOP
- (COND
- ((NOT (COND
- ((NULL |x|) NIL)
- (T (NOT (NULL |y|)))))
- (RETURN NIL))
- (T (COND
- ((SPADCALL (CAR |x|) (CAR |y|)
- (|getShellEntry| $ 53))
- (RETURN-FROM |ILIST;=;2$B;22| NIL))
- (T (SEQ (SETQ |x| (CDR |x|))
- (EXIT (SETQ |y| (CDR |y|)))))))))
- (EXIT (COND ((NULL |x|) (NULL |y|)) (T NIL))))))))
+ (COND
+ ((EQ |x| |y|) T)
+ (T (SEQ (LOOP
+ (COND
+ ((NOT (COND ((NULL |x|) NIL) (T (NOT (NULL |y|)))))
+ (RETURN NIL))
+ (T (COND
+ ((SPADCALL (CAR |x|) (CAR |y|)
+ (|getShellEntry| $ 53))
+ (RETURN-FROM |ILIST;=;2$B;22| NIL))
+ (T (SEQ (SETQ |x| (CDR |x|))
+ (EXIT (SETQ |y| (CDR |y|)))))))))
+ (EXIT (COND ((NULL |x|) (NULL |y|)) (T NIL)))))))
(DEFUN |ILIST;latex;$S;23| (|x| $)
(LET ((|s| "\\left["))
@@ -296,18 +294,18 @@
(DEFUN |ILIST;concat!;3$;25| (|x| |y| $)
(PROG (|z|)
(RETURN
- (SEQ (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 (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|)))))))
(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $)
(PROG (|pp| |f| |pr|)
@@ -343,53 +341,47 @@
(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $)
(PROG (|r| |t|)
(RETURN
- (SEQ (COND
- ((NULL |p|) |q|)
- ((NULL |q|) |p|)
- ((EQ |p| |q|) (|error| "cannot merge a list into itself"))
- (T (SEQ (COND
- ((SPADCALL (CAR |p|) (CAR |q|) |f|)
- (SEQ (LETT |r|
- (LETT |t| |p| |ILIST;merge!;M3$;28|)
- |ILIST;merge!;M3$;28|)
- (EXIT (SETQ |p| (CDR |p|)))))
- (T (SEQ (LETT |r|
- (LETT |t| |q|
- |ILIST;merge!;M3$;28|)
- |ILIST;merge!;M3$;28|)
- (EXIT (SETQ |q| (CDR |q|))))))
- (LOOP
- (COND
- ((NOT (COND
- ((NULL |p|) NIL)
- (T (NOT (NULL |q|)))))
- (RETURN NIL))
- (T (COND
- ((SPADCALL (CAR |p|) (CAR |q|) |f|)
- (SEQ (RPLACD |t| |p|)
- (LETT |t| |p|
- |ILIST;merge!;M3$;28|)
- (EXIT (SETQ |p| (CDR |p|)))))
- (T (SEQ (RPLACD |t| |q|)
- (LETT |t| |q|
- |ILIST;merge!;M3$;28|)
- (EXIT (SETQ |q| (CDR |q|)))))))))
- (RPLACD |t| (COND ((NULL |p|) |q|) (T |p|)))
- (EXIT |r|))))))))
+ (COND
+ ((NULL |p|) |q|)
+ ((NULL |q|) |p|)
+ ((EQ |p| |q|) (|error| "cannot merge a list into itself"))
+ (T (SEQ (COND
+ ((SPADCALL (CAR |p|) (CAR |q|) |f|)
+ (SEQ (LETT |r| (LETT |t| |p| |ILIST;merge!;M3$;28|)
+ |ILIST;merge!;M3$;28|)
+ (EXIT (SETQ |p| (CDR |p|)))))
+ (T (SEQ (LETT |r|
+ (LETT |t| |q| |ILIST;merge!;M3$;28|)
+ |ILIST;merge!;M3$;28|)
+ (EXIT (SETQ |q| (CDR |q|))))))
+ (LOOP
+ (COND
+ ((NOT (COND ((NULL |p|) NIL) (T (NOT (NULL |q|)))))
+ (RETURN NIL))
+ (T (COND
+ ((SPADCALL (CAR |p|) (CAR |q|) |f|)
+ (SEQ (RPLACD |t| |p|)
+ (LETT |t| |p| |ILIST;merge!;M3$;28|)
+ (EXIT (SETQ |p| (CDR |p|)))))
+ (T (SEQ (RPLACD |t| |q|)
+ (LETT |t| |q| |ILIST;merge!;M3$;28|)
+ (EXIT (SETQ |q| (CDR |q|)))))))))
+ (RPLACD |t| (COND ((NULL |p|) |q|) (T |p|)))
+ (EXIT |r|)))))))
(DEFUN |ILIST;split!;$I$;29| (|p| |n| $)
(PROG (|q|)
(RETURN
- (SEQ (COND
- ((< |n| 1) (|error| "index out of range"))
- (T (SEQ (SETQ |p|
- (|ILIST;rest;$Nni$;19| |p|
- (LET ((#0=#:G1485 (- |n| 1)))
- (|check-subtype| (NOT (MINUSP #0#))
- '(|NonNegativeInteger|) #0#))
- $))
- (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|)
- (RPLACD |p| NIL) (EXIT |q|))))))))
+ (COND
+ ((< |n| 1) (|error| "index out of range"))
+ (T (SEQ (SETQ |p|
+ (|ILIST;rest;$Nni$;19| |p|
+ (LET ((#0=#:G1485 (- |n| 1)))
+ (|check-subtype| (NOT (MINUSP #0#))
+ '(|NonNegativeInteger|) #0#))
+ $))
+ (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|)
+ (RPLACD |p| NIL) (EXIT |q|)))))))
(DEFUN |ILIST;mergeSort| (|f| |p| |n| $)
(PROG (|l| |q|)
diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp
index 8e681337..eac82f8a 100644
--- a/src/algebra/strap/INT.lsp
+++ b/src/algebra/strap/INT.lsp
@@ -270,14 +270,14 @@
(PUT '|INT;unitCanonical;2$;55| '|SPADreplace| '|%iabs|)
(DEFUN |INT;writeOMInt| (|dev| |x| $)
- (SEQ (COND
- ((MINUSP |x|)
- (SEQ (SPADCALL |dev| (|getShellEntry| $ 10))
- (SPADCALL |dev| "arith1" "unary_minus"
- (|getShellEntry| $ 12))
- (SPADCALL |dev| (- |x|) (|getShellEntry| $ 15))
- (EXIT (SPADCALL |dev| (|getShellEntry| $ 16)))))
- (T (SPADCALL |dev| |x| (|getShellEntry| $ 15))))))
+ (COND
+ ((MINUSP |x|)
+ (SEQ (SPADCALL |dev| (|getShellEntry| $ 10))
+ (SPADCALL |dev| "arith1" "unary_minus"
+ (|getShellEntry| $ 12))
+ (SPADCALL |dev| (- |x|) (|getShellEntry| $ 15))
+ (EXIT (SPADCALL |dev| (|getShellEntry| $ 16)))))
+ (T (SPADCALL |dev| |x| (|getShellEntry| $ 15)))))
(DEFUN |INT;OMwrite;$S;2| (|x| $)
(LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 852c3da2..692f7a04 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -233,11 +233,11 @@
(EXIT |r|))))))
(DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $)
- (SEQ (COND
- ((OR (< |i| (SVREF $ 6))
- (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|))
- (|error| "index out of range"))
- (T (SEQ (SETF (CHAR |s| (- |i| (SVREF $ 6))) |c|) (EXIT |c|))))))
+ (COND
+ ((OR (< |i| (SVREF $ 6))
+ (< (SPADCALL |s| (|getShellEntry| $ 47)) |i|))
+ (|error| "index out of range"))
+ (T (SEQ (SETF (CHAR |s| (- |i| (SVREF $ 6))) |c|) (EXIT |c|)))))
(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
(LET ((|np| (LENGTH |part|)) (|nw| (LENGTH |whole|)))
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index f0fa12ff..51633f6e 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -155,66 +155,55 @@
(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $)
(PROG (|r| |t|)
(RETURN
- (SEQ (COND
- ((SPADCALL |p| (|getShellEntry| $ 16)) |q|)
- ((SPADCALL |q| (|getShellEntry| $ 16)) |p|)
- ((SPADCALL |p| |q| (|getShellEntry| $ 30))
- (|error| "cannot merge a list into itself"))
- (T (SEQ (COND
- ((SPADCALL (SPADCALL |p| (|getShellEntry| $ 18))
- (SPADCALL |q| (|getShellEntry| $ 18))
- |f|)
- (SEQ (LETT |r|
- (LETT |t| |p| |LSAGG-;merge!;M3A;6|)
- |LSAGG-;merge!;M3A;6|)
- (EXIT (SETQ |p|
+ (COND
+ ((SPADCALL |p| (|getShellEntry| $ 16)) |q|)
+ ((SPADCALL |q| (|getShellEntry| $ 16)) |p|)
+ ((SPADCALL |p| |q| (|getShellEntry| $ 30))
+ (|error| "cannot merge a list into itself"))
+ (T (SEQ (COND
+ ((SPADCALL (SPADCALL |p| (|getShellEntry| $ 18))
+ (SPADCALL |q| (|getShellEntry| $ 18)) |f|)
+ (SEQ (LETT |r| (LETT |t| |p| |LSAGG-;merge!;M3A;6|)
+ |LSAGG-;merge!;M3A;6|)
+ (EXIT (SETQ |p|
(SPADCALL |p|
(|getShellEntry| $ 17))))))
- (T (SEQ (LETT |r|
- (LETT |t| |q|
- |LSAGG-;merge!;M3A;6|)
- |LSAGG-;merge!;M3A;6|)
- (EXIT (SETQ |q|
+ (T (SEQ (LETT |r|
+ (LETT |t| |q| |LSAGG-;merge!;M3A;6|)
+ |LSAGG-;merge!;M3A;6|)
+ (EXIT (SETQ |q|
(SPADCALL |q|
(|getShellEntry| $ 17)))))))
- (LOOP
- (COND
- ((NOT (COND
- ((SPADCALL |p| (|getShellEntry| $ 16))
- NIL)
- (T (NOT
- (SPADCALL |q|
- (|getShellEntry| $ 16))))))
- (RETURN NIL))
- (T (COND
- ((SPADCALL
- (SPADCALL |p|
- (|getShellEntry| $ 18))
- (SPADCALL |q|
- (|getShellEntry| $ 18))
- |f|)
- (SEQ (SPADCALL |t| |p|
- (|getShellEntry| $ 27))
- (LETT |t| |p|
- |LSAGG-;merge!;M3A;6|)
- (EXIT
- (SETQ |p|
+ (LOOP
+ (COND
+ ((NOT (COND
+ ((SPADCALL |p| (|getShellEntry| $ 16)) NIL)
+ (T (NOT (SPADCALL |q|
+ (|getShellEntry| $ 16))))))
+ (RETURN NIL))
+ (T (COND
+ ((SPADCALL
+ (SPADCALL |p| (|getShellEntry| $ 18))
+ (SPADCALL |q| (|getShellEntry| $ 18))
+ |f|)
+ (SEQ (SPADCALL |t| |p|
+ (|getShellEntry| $ 27))
+ (LETT |t| |p| |LSAGG-;merge!;M3A;6|)
+ (EXIT (SETQ |p|
(SPADCALL |p|
(|getShellEntry| $ 17))))))
- (T (SEQ (SPADCALL |t| |q|
- (|getShellEntry| $ 27))
- (LETT |t| |q|
- |LSAGG-;merge!;M3A;6|)
- (EXIT
- (SETQ |q|
+ (T (SEQ (SPADCALL |t| |q|
+ (|getShellEntry| $ 27))
+ (LETT |t| |q| |LSAGG-;merge!;M3A;6|)
+ (EXIT (SETQ |q|
(SPADCALL |q|
(|getShellEntry| $ 17))))))))))
- (SPADCALL |t|
- (COND
- ((SPADCALL |p| (|getShellEntry| $ 16)) |q|)
- (T |p|))
- (|getShellEntry| $ 27))
- (EXIT |r|))))))))
+ (SPADCALL |t|
+ (COND
+ ((SPADCALL |p| (|getShellEntry| $ 16)) |q|)
+ (T |p|))
+ (|getShellEntry| $ 27))
+ (EXIT |r|)))))))
(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $)
(PROG (|y| |z|)
@@ -424,30 +413,27 @@
(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $)
(PROG (|p|)
(RETURN
- (SEQ (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|
+ (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))))))))
+ (EXIT T)))))))
(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $)
(LET ((|r| |i|))
@@ -514,30 +500,27 @@
(DEFUN |LSAGG-;reverse!;2A;20| (|x| $)
(PROG (|z| |y|)
(RETURN
- (SEQ (COND
- ((OR (SPADCALL |x| (|getShellEntry| $ 16))
- (SPADCALL
- (LETT |y| (SPADCALL |x| (|getShellEntry| $ 17))
- |LSAGG-;reverse!;2A;20|)
- (|getShellEntry| $ 16)))
- |x|)
- (T (SEQ (SPADCALL |x| (SPADCALL (|getShellEntry| $ 13))
- (|getShellEntry| $ 27))
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |y|
- (|getShellEntry| $ 16))))
- (RETURN NIL))
- (T (SEQ (LETT |z|
- (SPADCALL |y|
- (|getShellEntry| $ 17))
- |LSAGG-;reverse!;2A;20|)
- (SPADCALL |y| |x|
- (|getShellEntry| $ 27))
- (SETQ |x| |y|)
- (EXIT (LETT |y| |z|
+ (COND
+ ((OR (SPADCALL |x| (|getShellEntry| $ 16))
+ (SPADCALL
+ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 17))
+ |LSAGG-;reverse!;2A;20|)
+ (|getShellEntry| $ 16)))
+ |x|)
+ (T (SEQ (SPADCALL |x| (SPADCALL (|getShellEntry| $ 13))
+ (|getShellEntry| $ 27))
+ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 16))))
+ (RETURN NIL))
+ (T (SEQ (LETT |z|
+ (SPADCALL |y| (|getShellEntry| $ 17))
+ |LSAGG-;reverse!;2A;20|)
+ (SPADCALL |y| |x| (|getShellEntry| $ 27))
+ (SETQ |x| |y|)
+ (EXIT (LETT |y| |z|
|LSAGG-;reverse!;2A;20|))))))
- (EXIT |x|))))))))
+ (EXIT |x|)))))))
(DEFUN |LSAGG-;copy;2A;21| (|x| $)
(LET ((|y| (SPADCALL (|getShellEntry| $ 13))))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index af6c2e66..e1e58863 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -944,19 +944,18 @@
(DEFUN |OUTFORM;differentiate;$Nni$;97| (|a| |nn| $)
(PROG (|r| |s|)
(RETURN
- (SEQ (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 (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|) $))))))))
(DEFUN |OUTFORM;sum;2$;98| (|a| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index a02ca0c4..0025e21f 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -144,55 +144,51 @@
(DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $)
(PROG (|lvar|)
(RETURN
- (SEQ (COND
- ((NULL |l|) |p|)
- (T (SEQ (LET ((#0=#:G1666 |l|))
- (LOOP
- (COND
- ((ATOM #0#) (RETURN NIL))
- (T (LET ((|e| (CAR #0#)))
- (COND
- ((EQL
- (CAR
- (SPADCALL
- (SPADCALL |e|
- (|getShellEntry| $ 14))
- (|getShellEntry| $ 16)))
- 1)
- (RETURN
- (|error|
- "cannot find a variable to evaluate")))))))
- (SETQ #0# (CDR #0#))))
- (LETT |lvar|
- (LET ((#1=#:G1668 |l|) (#2=#:G1667 NIL))
- (LOOP
- (COND
- ((ATOM #1#) (RETURN (NREVERSE #2#)))
- (T (LET ((|e| (CAR #1#)))
- (SETQ #2#
+ (COND
+ ((NULL |l|) |p|)
+ (T (SEQ (LET ((#0=#:G1666 |l|))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN NIL))
+ (T (LET ((|e| (CAR #0#)))
+ (COND
+ ((EQL (CAR
+ (SPADCALL
+ (SPADCALL |e|
+ (|getShellEntry| $ 14))
+ (|getShellEntry| $ 16)))
+ 1)
+ (RETURN
+ (|error| "cannot find a variable to evaluate")))))))
+ (SETQ #0# (CDR #0#))))
+ (LETT |lvar|
+ (LET ((#1=#:G1668 |l|) (#2=#:G1667 NIL))
+ (LOOP
+ (COND
+ ((ATOM #1#) (RETURN (NREVERSE #2#)))
+ (T (LET ((|e| (CAR #1#)))
+ (SETQ #2#
(CONS
(SPADCALL
(SPADCALL |e|
(|getShellEntry| $ 14))
(|getShellEntry| $ 17))
#2#)))))
- (SETQ #1# (CDR #1#))))
- |POLYCAT-;eval;SLS;1|)
- (EXIT (SPADCALL |p| |lvar|
- (LET ((#3=#:G1670 |l|) (#4=#:G1669 NIL))
- (LOOP
- (COND
- ((ATOM #3#)
- (RETURN (NREVERSE #4#)))
- (T
- (LET ((|e| (CAR #3#)))
- (SETQ #4#
- (CONS
- (SPADCALL |e|
- (|getShellEntry| $ 18))
- #4#)))))
- (SETQ #3# (CDR #3#))))
- (|getShellEntry| $ 21))))))))))
+ (SETQ #1# (CDR #1#))))
+ |POLYCAT-;eval;SLS;1|)
+ (EXIT (SPADCALL |p| |lvar|
+ (LET ((#3=#:G1670 |l|) (#4=#:G1669 NIL))
+ (LOOP
+ (COND
+ ((ATOM #3#) (RETURN (NREVERSE #4#)))
+ (T (LET ((|e| (CAR #3#)))
+ (SETQ #4#
+ (CONS
+ (SPADCALL |e|
+ (|getShellEntry| $ 18))
+ #4#)))))
+ (SETQ #3# (CDR #3#))))
+ (|getShellEntry| $ 21)))))))))
(DEFUN |POLYCAT-;monomials;SL;2| (|p| $)
(LET ((|ml| NIL))
@@ -220,19 +216,18 @@
(DEFUN |POLYCAT-;isTimes;SU;4| (|p| $)
(PROG (|lv| |l| |r|)
(RETURN
- (SEQ (COND
- ((OR (NULL (LETT |lv|
- (SPADCALL |p| (|getShellEntry| $ 40))
- |POLYCAT-;isTimes;SU;4|))
- (NOT (SPADCALL |p| (|getShellEntry| $ 42))))
- (CONS 1 "failed"))
- (T (SEQ (LETT |l|
- (LET ((#0=#:G1672 |lv|) (#1=#:G1671 NIL))
- (LOOP
- (COND
- ((ATOM #0#) (RETURN (NREVERSE #1#)))
- (T (LET ((|v| (CAR #0#)))
- (SETQ #1#
+ (COND
+ ((OR (NULL (LETT |lv| (SPADCALL |p| (|getShellEntry| $ 40))
+ |POLYCAT-;isTimes;SU;4|))
+ (NOT (SPADCALL |p| (|getShellEntry| $ 42))))
+ (CONS 1 "failed"))
+ (T (SEQ (LETT |l|
+ (LET ((#0=#:G1672 |lv|) (#1=#:G1671 NIL))
+ (LOOP
+ (COND
+ ((ATOM #0#) (RETURN (NREVERSE #1#)))
+ (T (LET ((|v| (CAR #0#)))
+ (SETQ #1#
(CONS
(SPADCALL (|spadConstant| $ 43)
|v|
@@ -240,23 +235,22 @@
(|getShellEntry| $ 46))
(|getShellEntry| $ 47))
#1#)))))
- (SETQ #0# (CDR #0#))))
- |POLYCAT-;isTimes;SU;4|)
- (EXIT (COND
- ((SPADCALL
- (LETT |r|
- (SPADCALL |p|
- (|getShellEntry| $ 48))
- |POLYCAT-;isTimes;SU;4|)
- (|getShellEntry| $ 49))
- (COND
- ((NULL (CDR |lv|)) (CONS 1 "failed"))
- (T (CONS 0 |l|))))
- (T (CONS 0
- (CONS
- (SPADCALL |r|
+ (SETQ #0# (CDR #0#))))
+ |POLYCAT-;isTimes;SU;4|)
+ (EXIT (COND
+ ((SPADCALL
+ (LETT |r|
+ (SPADCALL |p|
+ (|getShellEntry| $ 48))
+ |POLYCAT-;isTimes;SU;4|)
+ (|getShellEntry| $ 49))
+ (COND
+ ((NULL (CDR |lv|)) (CONS 1 "failed"))
+ (T (CONS 0 |l|))))
+ (T (CONS 0
+ (CONS (SPADCALL |r|
(|getShellEntry| $ 51))
- |l|))))))))))))
+ |l|)))))))))))
(DEFUN |POLYCAT-;isExpt;SU;5| (|p| $)
(PROG (|d|)
@@ -351,80 +345,79 @@
(DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $)
(PROG (|u| |d|)
(RETURN
- (SEQ (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|
- (+
+ (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| $ 82))
- (SPADCALL
- (SPADCALL |u|
- (|getShellEntry| $ 83))
- (|getShellEntry| $ 84)))))
- (EXIT (SETQ |u|
+ (|getShellEntry| $ 83))
+ (|getShellEntry| $ 84)))))
+ (EXIT (SETQ |u|
(SPADCALL |u|
(|getShellEntry| $ 87))))))))
- (EXIT |d|))))))))
+ (EXIT |d|)))))))
(DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $)
(PROG (|v| |u| |d| |w|)
(RETURN
- (SEQ (COND
- ((SPADCALL |p| (|getShellEntry| $ 78)) 0)
- (T (SEQ (LETT |u|
- (SPADCALL |p|
- (LETT |v|
- (LET
- ((#0=#:G1475
- (SPADCALL |p|
- (|getShellEntry| $ 53))))
- (|check-union| (ZEROP (CAR #0#))
- (SVREF $ 9) #0#)
- (CDR #0#))
- |POLYCAT-;totalDegree;SLNni;14|)
- (|getShellEntry| $ 59))
- |POLYCAT-;totalDegree;SLNni;14|)
- (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|)
- (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|)
- (COND
- ((SPADCALL |v| |lv| (|getShellEntry| $ 89))
- (SETQ |w| 1)))
- (LOOP
- (COND
- ((NOT (SPADCALL |u| (|spadConstant| $ 80)
- (|getShellEntry| $ 81)))
- (RETURN NIL))
- (T (SEQ (SETQ |d|
- (MAX |d|
- (+
- (* |w|
- (SPADCALL |u|
- (|getShellEntry| $ 82)))
- (SPADCALL
- (SPADCALL |u|
- (|getShellEntry| $ 83))
- |lv| (|getShellEntry| $ 92)))))
- (EXIT (SETQ |u|
+ (COND
+ ((SPADCALL |p| (|getShellEntry| $ 78)) 0)
+ (T (SEQ (LETT |u|
+ (SPADCALL |p|
+ (LETT |v|
+ (LET ((#0=#:G1475
+ (SPADCALL |p|
+ (|getShellEntry| $ 53))))
+ (|check-union| (ZEROP (CAR #0#))
+ (SVREF $ 9) #0#)
+ (CDR #0#))
+ |POLYCAT-;totalDegree;SLNni;14|)
+ (|getShellEntry| $ 59))
+ |POLYCAT-;totalDegree;SLNni;14|)
+ (LETT |d| 0 |POLYCAT-;totalDegree;SLNni;14|)
+ (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|)
+ (COND
+ ((SPADCALL |v| |lv| (|getShellEntry| $ 89))
+ (SETQ |w| 1)))
+ (LOOP
+ (COND
+ ((NOT (SPADCALL |u| (|spadConstant| $ 80)
+ (|getShellEntry| $ 81)))
+ (RETURN NIL))
+ (T (SEQ (SETQ |d|
+ (MAX |d|
+ (+
+ (* |w|
+ (SPADCALL |u|
+ (|getShellEntry| $ 82)))
+ (SPADCALL
+ (SPADCALL |u|
+ (|getShellEntry| $ 83))
+ |lv| (|getShellEntry| $ 92)))))
+ (EXIT (SETQ |u|
(SPADCALL |u|
(|getShellEntry| $ 87))))))))
- (EXIT |d|))))))))
+ (EXIT |d|)))))))
(DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $)
(SPADCALL (SPADCALL |p1| |mvar| (|getShellEntry| $ 59))
@@ -900,93 +893,86 @@
(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $)
(PROG (|v| |d| |ans| |dd| |cp| |ansx|)
(RETURN
- (SEQ (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))
+ (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 |dd|) 1)
+ (EXIT
+ (COND
+ ((EQL (CAR |ansx|) 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|)
+ (SETQ |d|
+ (SPADCALL |p| |v|
+ (|getShellEntry| $ 46)))
(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))))))))))))))
+ (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 1a319cca..3989a430 100644
--- a/src/algebra/strap/RNS-.lsp
+++ b/src/algebra/strap/RNS-.lsp
@@ -102,23 +102,22 @@
(DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $)
(PROG (|r|)
(RETURN
- (SEQ (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))
+ (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)))))))
(DEFUN |RealNumberSystem&| (|#1|)
(LET* ((|dv$1| (|devaluate| |#1|))
diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp
index 18b88fc4..5dd91da0 100644
--- a/src/algebra/strap/SINT.lsp
+++ b/src/algebra/strap/SINT.lsp
@@ -291,14 +291,13 @@
'(XLAM (|x|) (|%iadd| (|%isub| |x| |$ShortMinimum|) 1)))
(DEFUN |SINT;writeOMSingleInt| (|dev| |x| $)
- (SEQ (COND
- ((MINUSP |x|)
- (SEQ (SPADCALL |dev| (|getShellEntry| $ 11))
- (SPADCALL |dev| "arith1" "unaryminus"
- (|getShellEntry| $ 13))
- (SPADCALL |dev| (- |x|) (|getShellEntry| $ 16))
- (EXIT (SPADCALL |dev| (|getShellEntry| $ 17)))))
- (T (SPADCALL |dev| |x| (|getShellEntry| $ 16))))))
+ (COND
+ ((MINUSP |x|)
+ (SEQ (SPADCALL |dev| (|getShellEntry| $ 11))
+ (SPADCALL |dev| "arith1" "unaryminus" (|getShellEntry| $ 13))
+ (SPADCALL |dev| (- |x|) (|getShellEntry| $ 16))
+ (EXIT (SPADCALL |dev| (|getShellEntry| $ 17)))))
+ (T (SPADCALL |dev| |x| (|getShellEntry| $ 16)))))
(DEFUN |SINT;OMwrite;$S;2| (|x| $)
(LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|))
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp
index 60c28e58..b6b60077 100644
--- a/src/algebra/strap/STAGG-.lsp
+++ b/src/algebra/strap/STAGG-.lsp
@@ -219,11 +219,11 @@
(EXIT |s|))))))))))))
(DEFUN |STAGG-;concat!;3A;13| (|x| |y| $)
- (SEQ (COND
- ((SPADCALL |x| (|getShellEntry| $ 18)) |y|)
- (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y|
- (|getShellEntry| $ 55))
- (EXIT |x|))))))
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 18)) |y|)
+ (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y|
+ (|getShellEntry| $ 55))
+ (EXIT |x|)))))
(DEFUN |StreamAggregate&| (|#1| |#2|)
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index add07b55..787305a0 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -473,133 +473,125 @@
(DEFUN |SYMBOL;name;2$;31| (|sy| $)
(PROG (|str|)
(RETURN
- (SEQ (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 (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"))))))))
(DEFUN |SYMBOL;scripts;$R;32| (|sy| $)
(PROG (|nscripts| |lscripts| |str| |nstr| |m| |allscripts|)
(RETURN
- (SEQ (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
+ (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
(SPADCALL |str| |j|
(|getShellEntry| $ 106))
- (|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| $ 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| $ 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| $ 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 901b077d..7c1983a0 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -224,29 +224,26 @@
(DEFUN |URAGG-;tail;2A;16| (|x| $)
(PROG (|y|)
(RETURN
- (SEQ (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|
+ (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|))))))))
+ (SETQ |k| (+ |k| 1))))
+ (EXIT |x|)))))))
(DEFUN |URAGG-;findCycle| (|x| $)
(LET ((|y| (SPADCALL |x| (|getShellEntry| $ 14))))
@@ -272,93 +269,86 @@
(DEFUN |URAGG-;cycleTail;2A;18| (|x| $)
(PROG (|z| |y|)
(RETURN
- (SEQ (COND
- ((SPADCALL
- (LETT |y|
- (SETQ |x|
- (SPADCALL |x| (|getShellEntry| $ 55)))
- |URAGG-;cycleTail;2A;18|)
- (|getShellEntry| $ 20))
- |x|)
- (T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14))
- |URAGG-;cycleTail;2A;18|)
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |x| |z|
- (|getShellEntry| $ 54))))
- (RETURN NIL))
- (T (SEQ (LETT |y| |z|
- |URAGG-;cycleTail;2A;18|)
- (EXIT (SETQ |z|
+ (COND
+ ((SPADCALL
+ (LETT |y| (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 55)))
+ |URAGG-;cycleTail;2A;18|)
+ (|getShellEntry| $ 20))
+ |x|)
+ (T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14))
+ |URAGG-;cycleTail;2A;18|)
+ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |x| |z|
+ (|getShellEntry| $ 54))))
+ (RETURN NIL))
+ (T (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|)
+ (EXIT (SETQ |z|
(SPADCALL |z|
(|getShellEntry| $ 14))))))))
- (EXIT |y|))))))))
+ (EXIT |y|)))))))
(DEFUN |URAGG-;cycleEntry;2A;19| (|x| $)
(PROG (|z| |l| |y|)
(RETURN
- (SEQ (COND
- ((SPADCALL |x| (|getShellEntry| $ 20)) |x|)
- ((SPADCALL
- (LETT |y| (|URAGG-;findCycle| |x| $)
- |URAGG-;cycleEntry;2A;19|)
- (|getShellEntry| $ 20))
- |y|)
- (T (SEQ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 14))
- |URAGG-;cycleEntry;2A;19|)
- (LETT |l| 1 |URAGG-;cycleEntry;2A;19|)
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |y| |z|
- (|getShellEntry| $ 54))))
- (RETURN NIL))
- (T (SEQ (SETQ |z|
- (SPADCALL |z|
- (|getShellEntry| $ 14)))
- (EXIT (SETQ |l| (+ |l| 1)))))))
- (LETT |y| |x| |URAGG-;cycleEntry;2A;19|)
- (LET ((|k| 1))
- (LOOP
- (COND
- ((> |k| |l|) (RETURN NIL))
- (T (SETQ |y|
- (SPADCALL |y|
- (|getShellEntry| $ 14)))))
- (SETQ |k| (+ |k| 1))))
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |x| |y|
- (|getShellEntry| $ 54))))
- (RETURN NIL))
- (T (SEQ (SETQ |x|
- (SPADCALL |x|
- (|getShellEntry| $ 14)))
- (EXIT (SETQ |y|
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 20)) |x|)
+ ((SPADCALL
+ (LETT |y| (|URAGG-;findCycle| |x| $)
+ |URAGG-;cycleEntry;2A;19|)
+ (|getShellEntry| $ 20))
+ |y|)
+ (T (SEQ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 14))
+ |URAGG-;cycleEntry;2A;19|)
+ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|)
+ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |y| |z|
+ (|getShellEntry| $ 54))))
+ (RETURN NIL))
+ (T (SEQ (SETQ |z|
+ (SPADCALL |z| (|getShellEntry| $ 14)))
+ (EXIT (SETQ |l| (+ |l| 1)))))))
+ (LETT |y| |x| |URAGG-;cycleEntry;2A;19|)
+ (LET ((|k| 1))
+ (LOOP
+ (COND
+ ((> |k| |l|) (RETURN NIL))
+ (T (SETQ |y|
+ (SPADCALL |y| (|getShellEntry| $ 14)))))
+ (SETQ |k| (+ |k| 1))))
+ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |x| |y|
+ (|getShellEntry| $ 54))))
+ (RETURN NIL))
+ (T (SEQ (SETQ |x|
+ (SPADCALL |x| (|getShellEntry| $ 14)))
+ (EXIT (SETQ |y|
(SPADCALL |y|
(|getShellEntry| $ 14))))))))
- (EXIT |x|))))))))
+ (EXIT |x|)))))))
(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $)
(PROG (|y| |k|)
(RETURN
- (SEQ (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 (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|)))))))
(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $)
(SEQ (LET ((|i| 1))
@@ -385,46 +375,41 @@
(|getShellEntry| $ 63))))))
(DEFUN |URAGG-;=;2AB;23| (|x| |y| $)
- (SEQ (COND
- ((SPADCALL |x| |y| (|getShellEntry| $ 54)) T)
- (T (SEQ (LET ((|k| 0))
- (LOOP
- (COND
- ((NOT (COND
- ((SPADCALL |x| (|getShellEntry| $ 20))
- NIL)
- (T (NOT (SPADCALL |y|
- (|getShellEntry| $ 20))))))
- (RETURN NIL))
- (T (SEQ (COND
- ((EQL |k| 1000)
- (COND
- ((SPADCALL |x|
- (|getShellEntry| $ 48))
- (EXIT (|error| "cyclic list"))))))
- (EXIT (COND
- ((SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 8))
- (SPADCALL |y|
- (|getShellEntry| $ 8))
- (|getShellEntry| $ 66))
- (RETURN-FROM |URAGG-;=;2AB;23|
- NIL))
- (T
- (SEQ
- (SETQ |x|
- (SPADCALL |x|
- (|getShellEntry| $ 14)))
- (EXIT
- (SETQ |y|
- (SPADCALL |y|
- (|getShellEntry| $ 14)))))))))))
- (SETQ |k| (+ |k| 1))))
- (EXIT (COND
- ((SPADCALL |x| (|getShellEntry| $ 20))
- (SPADCALL |y| (|getShellEntry| $ 20)))
- (T NIL))))))))
+ (COND
+ ((SPADCALL |x| |y| (|getShellEntry| $ 54)) T)
+ (T (SEQ (LET ((|k| 0))
+ (LOOP
+ (COND
+ ((NOT (COND
+ ((SPADCALL |x| (|getShellEntry| $ 20)) NIL)
+ (T (NOT (SPADCALL |y| (|getShellEntry| $ 20))))))
+ (RETURN NIL))
+ (T (SEQ (COND
+ ((EQL |k| 1000)
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 48))
+ (EXIT (|error| "cyclic list"))))))
+ (EXIT (COND
+ ((SPADCALL
+ (SPADCALL |x|
+ (|getShellEntry| $ 8))
+ (SPADCALL |y|
+ (|getShellEntry| $ 8))
+ (|getShellEntry| $ 66))
+ (RETURN-FROM |URAGG-;=;2AB;23| NIL))
+ (T (SEQ
+ (SETQ |x|
+ (SPADCALL |x|
+ (|getShellEntry| $ 14)))
+ (EXIT
+ (SETQ |y|
+ (SPADCALL |y|
+ (|getShellEntry| $ 14)))))))))))
+ (SETQ |k| (+ |k| 1))))
+ (EXIT (COND
+ ((SPADCALL |x| (|getShellEntry| $ 20))
+ (SPADCALL |y| (|getShellEntry| $ 20)))
+ (T NIL)))))))
(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $)
(SEQ (LET ((|k| 0))
@@ -460,12 +445,12 @@
(|getShellEntry| $ 76)))
(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $)
- (SEQ (COND
- ((SPADCALL |x| (|getShellEntry| $ 20))
- (|error| "setlast: empty list"))
- (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 24)) |s|
- (|getShellEntry| $ 70))
- (EXIT |s|))))))
+ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 20))
+ (|error| "setlast: empty list"))
+ (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 24)) |s|
+ (|getShellEntry| $ 70))
+ (EXIT |s|)))))
(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $)
(COND
@@ -479,44 +464,44 @@
(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $)
(PROG (|q|)
(RETURN
- (SEQ (COND
- ((< |n| 1) (|error| "index out of range"))
- (T (SEQ (SETQ |p|
- (SPADCALL |p|
- (LET ((#0=#:G1503 (- |n| 1)))
- (|check-subtype| (NOT (MINUSP #0#))
- '(|NonNegativeInteger|) #0#))
- (|getShellEntry| $ 62)))
- (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14))
- |URAGG-;split!;AIA;32|)
- (SPADCALL |p| (SPADCALL (|getShellEntry| $ 84))
- (|getShellEntry| $ 74))
- (EXIT |q|))))))))
+ (COND
+ ((< |n| 1) (|error| "index out of range"))
+ (T (SEQ (SETQ |p|
+ (SPADCALL |p|
+ (LET ((#0=#:G1503 (- |n| 1)))
+ (|check-subtype| (NOT (MINUSP #0#))
+ '(|NonNegativeInteger|) #0#))
+ (|getShellEntry| $ 62)))
+ (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14))
+ |URAGG-;split!;AIA;32|)
+ (SPADCALL |p| (SPADCALL (|getShellEntry| $ 84))
+ (|getShellEntry| $ 74))
+ (EXIT |q|)))))))
(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $)
(PROG (|y| |z|)
(RETURN
- (SEQ (COND
- ((OR (SPADCALL
- (LETT |y| (SPADCALL |x| (|getShellEntry| $ 55))
- |URAGG-;cycleSplit!;2A;33|)
- (|getShellEntry| $ 20))
- (SPADCALL |x| |y| (|getShellEntry| $ 54)))
- |y|)
- (T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14))
- |URAGG-;cycleSplit!;2A;33|)
- (LOOP
- (COND
- ((NOT (NOT (SPADCALL |z| |y|
- (|getShellEntry| $ 54))))
- (RETURN NIL))
- (T (SEQ (SETQ |x| |z|)
- (EXIT (SETQ |z|
+ (COND
+ ((OR (SPADCALL
+ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 55))
+ |URAGG-;cycleSplit!;2A;33|)
+ (|getShellEntry| $ 20))
+ (SPADCALL |x| |y| (|getShellEntry| $ 54)))
+ |y|)
+ (T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14))
+ |URAGG-;cycleSplit!;2A;33|)
+ (LOOP
+ (COND
+ ((NOT (NOT (SPADCALL |z| |y|
+ (|getShellEntry| $ 54))))
+ (RETURN NIL))
+ (T (SEQ (SETQ |x| |z|)
+ (EXIT (SETQ |z|
(SPADCALL |z|
(|getShellEntry| $ 14))))))))
- (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84))
- (|getShellEntry| $ 74))
- (EXIT |y|))))))))
+ (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84))
+ (|getShellEntry| $ 74))
+ (EXIT |y|)))))))
(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|)
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
generated by cgit v1.2.3 (git 2.39.1) at 2024-08-28 10:23:58 +0000