diff options
Diffstat (limited to 'src/algebra')
-rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 117 | ||||
-rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 204 | ||||
-rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 469 | ||||
-rw-r--r-- | src/algebra/strap/GCDDOM-.lsp | 252 | ||||
-rw-r--r-- | src/algebra/strap/ILIST.lsp | 26 | ||||
-rw-r--r-- | src/algebra/strap/LSAGG-.lsp | 42 | ||||
-rw-r--r-- | src/algebra/strap/OUTFORM.lsp | 23 | ||||
-rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 215 | ||||
-rw-r--r-- | src/algebra/strap/RNS-.lsp | 32 | ||||
-rw-r--r-- | src/algebra/strap/SYMBOL.lsp | 216 | ||||
-rw-r--r-- | src/algebra/strap/URAGG-.lsp | 73 |
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)) |