diff options
| -rw-r--r-- | src/ChangeLog | 13 | ||||
| -rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 261 | ||||
| -rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 316 | ||||
| -rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 75 | ||||
| -rw-r--r-- | src/algebra/strap/ILIST.lsp | 177 | ||||
| -rw-r--r-- | src/algebra/strap/INS-.lsp | 61 | ||||
| -rw-r--r-- | src/algebra/strap/INT.lsp | 106 | ||||
| -rw-r--r-- | src/algebra/strap/ISTRING.lsp | 760 | ||||
| -rw-r--r-- | src/algebra/strap/LIST.lsp | 80 | ||||
| -rw-r--r-- | src/algebra/strap/LSAGG-.lsp | 552 | ||||
| -rw-r--r-- | src/algebra/strap/NNI.lsp | 15 | ||||
| -rw-r--r-- | src/algebra/strap/OUTFORM.lsp | 88 | ||||
| -rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 811 | ||||
| -rw-r--r-- | src/algebra/strap/QFCAT-.lsp | 97 | ||||
| -rw-r--r-- | src/algebra/strap/RNS-.lsp | 40 | ||||
| -rw-r--r-- | src/algebra/strap/SINT.lsp | 59 | ||||
| -rw-r--r-- | src/algebra/strap/STAGG-.lsp | 206 | ||||
| -rw-r--r-- | src/algebra/strap/SYMBOL.lsp | 428 | ||||
| -rw-r--r-- | src/algebra/strap/URAGG-.lsp | 207 | ||||
| -rw-r--r-- | src/interp/c-util.boot | 6 | ||||
| -rw-r--r-- | src/interp/g-opt.boot | 29 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 9 |
22 files changed, 2028 insertions, 2368 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index fdc8c734..209f8c98 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,16 @@ +2010-06-22 Gabriel Dos Reis <gdr@cs.tamu.edu> + + Group sequence of LETT definitions into LET/LET* expressions where + appropriate. + * interp/g-opt.boot (jumpToToplevel?): New. + (singleAssignment?): Likewise. + (groupVariableDefinitions): Likewise. Use them. + (optimizeFunctionDef): Group toplevel variable definitions into + a bind expression. + * interp/g-util.boot (expandBind): Tidy. + * interp/c-util.boot (transformToBackendCode): Refrain from + enclosing let-expressions in SEQ if not needed. + 2010-06-21 Gabriel Dos Reis <gdr@cs.tamu.edu> * interp/c-util.boot (middleEndExpand): Give it another macro diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 6b061736..2d6c6a81 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -401,35 +401,24 @@ |DFLOAT;**;$F$;88|)) (DEFUN |DFLOAT;OMwrite;$S;1| (|x| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |DFLOAT;OMwrite;$S;1|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |DFLOAT;OMwrite;$S;1|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 7)) - (|getShellEntry| $ 10)) - |DFLOAT;OMwrite;$S;1|) - (SPADCALL |dev| (|getShellEntry| $ 12)) - (SPADCALL |dev| |x| (|getShellEntry| $ 15)) - (SPADCALL |dev| (|getShellEntry| $ 16)) - (SPADCALL |dev| (|getShellEntry| $ 17)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 7)) + (|getShellEntry| $ 10)))) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 12)) + (SPADCALL |dev| |x| (|getShellEntry| $ 15)) + (SPADCALL |dev| (|getShellEntry| $ 16)) + (SPADCALL |dev| (|getShellEntry| $ 17)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |DFLOAT;OMwrite;$BS;2| (|x| |wholeObj| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |DFLOAT;OMwrite;$BS;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) - |DFLOAT;OMwrite;$BS;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 7)) - (|getShellEntry| $ 10)) - |DFLOAT;OMwrite;$BS;2|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 12)))) - (SPADCALL |dev| |x| (|getShellEntry| $ 15)) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 16)))) - (SPADCALL |dev| (|getShellEntry| $ 17)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 7)) + (|getShellEntry| $ 10)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 12)))) + (SPADCALL |dev| |x| (|getShellEntry| $ 15)) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 16)))) + (SPADCALL |dev| (|getShellEntry| $ 17)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |DFLOAT;OMwrite;Omd$V;3| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 12)) @@ -673,21 +662,16 @@ (FLOAT-RADIX 0.0) $))) (DEFUN |DFLOAT;retract;$I;82| (|x| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| (FIX |x|) |DFLOAT;retract;$I;82|) - (EXIT (COND - ((= |x| (FLOAT |n| |$DoubleFloatMaximum|)) |n|) - ('T (|error| "Not an integer")))))))) + (LET ((|n| (FIX |x|))) + (COND + ((= |x| (FLOAT |n| |$DoubleFloatMaximum|)) |n|) + ('T (|error| "Not an integer"))))) (DEFUN |DFLOAT;retractIfCan;$U;83| (|x| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| (FIX |x|) |DFLOAT;retractIfCan;$U;83|) - (EXIT (COND - ((= |x| (FLOAT |n| |$DoubleFloatMaximum|)) - (CONS 0 |n|)) - ('T (CONS 1 "failed")))))))) + (LET ((|n| (FIX |x|))) + (COND + ((= |x| (FLOAT |n| |$DoubleFloatMaximum|)) (CONS 0 |n|)) + ('T (CONS 1 "failed"))))) (DEFUN |DFLOAT;sign;$I;84| (|x| $) (|DFLOAT;retract;$I;82| (FLOAT-SIGN |x| 1.0) $)) @@ -722,107 +706,104 @@ (- (CDR |me|) (FLOAT-DIGITS 0.0))))))))))) (DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $) - (PROG (|#G109| |nu| |ex| BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| - |#G110| |q| |r| |p2| |q2| |#G111| |#G112| |#G113| - |#G114| |#G115| |#G116|) + (PROG (BASE |de| |tol| |s| |t| |p0| |p1| |q0| |q1| |#G110| |q| |r| + |p2| |q2| |#G111| |#G112| |#G113| |#G114| |#G115| + |#G116|) (RETURN - (SEQ (LETT |#G109| (|DFLOAT;manexp| |f| $) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |nu| (CAR |#G109|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |ex| (CDR |#G109|) - |DFLOAT;rationalApproximation;$2NniF;87|) - |#G109| - (LETT BASE (FLOAT-RADIX 0.0) - |DFLOAT;rationalApproximation;$2NniF;87|) - (EXIT (COND - ((>= |ex| 0) - (SPADCALL - (* |nu| - (EXPT BASE - (|check-subtype| (>= |ex| 0) - '(|NonNegativeInteger|) |ex|))) - (|getShellEntry| $ 135))) - ('T - (SEQ (LETT |de| - (EXPT BASE - (LET ((#0=#:G1540 (- |ex|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#))) - |DFLOAT;rationalApproximation;$2NniF;87|) - (EXIT (COND - ((< |b| 2) - (|error| "base must be > 1")) - ('T - (SEQ (LETT |tol| (EXPT |b| |d|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |s| |nu| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |t| |de| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p0| 0 - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p1| 1 - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q0| 1 - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q1| 0 - |DFLOAT;rationalApproximation;$2NniF;87|) - (EXIT - (LOOP - (COND - (NIL (RETURN NIL)) - (T - (SEQ - (LETT |#G110| - (DIVIDE2 |s| |t|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q| (CAR |#G110|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |r| (CDR |#G110|) - |DFLOAT;rationalApproximation;$2NniF;87|) - |#G110| - (LETT |p2| - (+ (* |q| |p1|) |p0|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q2| - (+ (* |q| |q1|) |q0|) - |DFLOAT;rationalApproximation;$2NniF;87|) - (COND - ((OR (EQL |r| 0) - (< - (SPADCALL |tol| - (ABS - (- (* |nu| |q2|) - (* |de| |p2|))) - (|getShellEntry| $ - 144)) - (* |de| (ABS |p2|)))) - (RETURN-FROM - |DFLOAT;rationalApproximation;$2NniF;87| - (SPADCALL |p2| |q2| - (|getShellEntry| $ - 142))))) - (LETT |#G111| |p1| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G112| |p2| - |DFLOAT;rationalApproximation;$2NniF;87|) - (SETQ |p0| |#G111|) - (SETQ |p1| |#G112|) - (LETT |#G113| |q1| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G114| |q2| - |DFLOAT;rationalApproximation;$2NniF;87|) - (SETQ |q0| |#G113|) - (SETQ |q1| |#G114|) - (EXIT - (PROGN - (LETT |#G115| |t| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |#G116| |r| - |DFLOAT;rationalApproximation;$2NniF;87|) - (SETQ |s| |#G115|) - (SETQ |t| |#G116|)))))))))))))))))))) + (LET* ((|#G109| (|DFLOAT;manexp| |f| $)) (|nu| (CAR |#G109|)) + (|ex| (CDR |#G109|))) + (SEQ |#G109| + (LETT BASE (FLOAT-RADIX 0.0) + |DFLOAT;rationalApproximation;$2NniF;87|) + (EXIT (COND + ((>= |ex| 0) + (SPADCALL + (* |nu| + (EXPT BASE + (|check-subtype| (>= |ex| 0) + '(|NonNegativeInteger|) |ex|))) + (|getShellEntry| $ 135))) + ('T + (SEQ (LETT |de| + (EXPT BASE + (LET ((#0=#:G1540 (- |ex|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#))) + |DFLOAT;rationalApproximation;$2NniF;87|) + (EXIT (COND + ((< |b| 2) + (|error| "base must be > 1")) + ('T + (SEQ + (LETT |tol| (EXPT |b| |d|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |s| |nu| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |t| |de| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p0| 0 + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p1| 1 + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q0| 1 + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q1| 0 + |DFLOAT;rationalApproximation;$2NniF;87|) + (EXIT + (LOOP + (COND + (NIL (RETURN NIL)) + (T + (SEQ + (LETT |#G110| + (DIVIDE2 |s| |t|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q| (CAR |#G110|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |r| (CDR |#G110|) + |DFLOAT;rationalApproximation;$2NniF;87|) + |#G110| + (LETT |p2| + (+ (* |q| |p1|) |p0|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |q2| + (+ (* |q| |q1|) |q0|) + |DFLOAT;rationalApproximation;$2NniF;87|) + (COND + ((OR (EQL |r| 0) + (< + (SPADCALL |tol| + (ABS + (- (* |nu| |q2|) + (* |de| |p2|))) + (|getShellEntry| $ + 144)) + (* |de| (ABS |p2|)))) + (RETURN-FROM + |DFLOAT;rationalApproximation;$2NniF;87| + (SPADCALL |p2| |q2| + (|getShellEntry| $ + 142))))) + (LETT |#G111| |p1| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G112| |p2| + |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |p0| |#G111|) + (SETQ |p1| |#G112|) + (LETT |#G113| |q1| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G114| |q2| + |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |q0| |#G113|) + (SETQ |q1| |#G114|) + (EXIT + (PROGN + (LETT |#G115| |t| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |#G116| |r| + |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |s| |#G115|) + (SETQ |t| |#G116|))))))))))))))))))))) (DEFUN |DFLOAT;**;$F$;88| (|x| |r| $) (PROG (|n| |d|) diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 6116773e..50fe1009 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -84,93 +84,80 @@ (EXIT |x|))))) (DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) - (PROG (|#G16| |u| |c| |a|) - (RETURN - (SEQ (LETT |#G16| (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 27)) - |EUCDOM-;unitNormalizeIdealElt|) - (LETT |u| (QVELT |#G16| 0) |EUCDOM-;unitNormalizeIdealElt|) - (LETT |c| (QVELT |#G16| 1) |EUCDOM-;unitNormalizeIdealElt|) - (LETT |a| (QVELT |#G16| 2) |EUCDOM-;unitNormalizeIdealElt|) - |#G16| - (EXIT (COND - ((SPADCALL |a| (|getShellEntry| $ 28)) |s|) - ('T - (VECTOR (SPADCALL |a| (QVELT |s| 0) - (|getShellEntry| $ 29)) - (SPADCALL |a| (QVELT |s| 1) - (|getShellEntry| $ 29)) - |c|)))))))) + (LET* ((|#G16| (SPADCALL (QVELT |s| 2) (|getShellEntry| $ 27))) + (|u| (QVELT |#G16| 0)) (|c| (QVELT |#G16| 1)) + (|a| (QVELT |#G16| 2))) + (SEQ |#G16| + (EXIT (COND + ((SPADCALL |a| (|getShellEntry| $ 28)) |s|) + ('T + (VECTOR (SPADCALL |a| (QVELT |s| 0) + (|getShellEntry| $ 29)) + (SPADCALL |a| (QVELT |s| 1) + (|getShellEntry| $ 29)) + |c|))))))) (DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) - (PROG (|s1| |s2| |s3| |qr|) + (PROG (|s3| |qr|) (RETURN - (SEQ (LETT |s1| - (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 30) - (|spadConstant| $ 19) |x|) - $) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s2| - (|EUCDOM-;unitNormalizeIdealElt| - (VECTOR (|spadConstant| $ 19) - (|spadConstant| $ 30) |y|) - $) - |EUCDOM-;extendedEuclidean;2SR;7|) - (EXIT (COND - ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) - ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) - ('T - (SEQ (LOOP - (COND - ((NOT (NOT - (SPADCALL (QVELT |s2| 2) - (|getShellEntry| $ 8)))) - (RETURN NIL)) - (T (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 2) - (QVELT |s2| 2) - (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s3| - (VECTOR - (SPADCALL (QVELT |s1| 0) - (SPADCALL (CAR |qr|) - (QVELT |s2| 0) - (|getShellEntry| $ 29)) - (|getShellEntry| $ 31)) - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) - (QVELT |s2| 1) - (|getShellEntry| $ 29)) - (|getShellEntry| $ 31)) - (CDR |qr|)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (SETQ |s1| |s2|) - (EXIT - (SETQ |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $))))))) - (COND - ((NOT (SPADCALL (QVELT |s1| 0) - (|getShellEntry| $ 8))) - (COND - ((NOT (SPADCALL (QVELT |s1| 0) |y| - (|getShellEntry| $ 32))) - (SEQ (LETT |qr| - (SPADCALL (QVELT |s1| 0) |y| + (LET* ((|s1| (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| $ 30) + (|spadConstant| $ 19) |x|) + $)) + (|s2| (|EUCDOM-;unitNormalizeIdealElt| + (VECTOR (|spadConstant| $ 19) + (|spadConstant| $ 30) |y|) + $))) + (COND + ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) + ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) + ('T + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL (QVELT |s2| 2) + (|getShellEntry| $ 8)))) + (RETURN NIL)) + (T (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 2) + (QVELT |s2| 2) (|getShellEntry| $ 16)) - |EUCDOM-;extendedEuclidean;2SR;7|) - (QSETVELT |s1| 0 (CDR |qr|)) - (QSETVELT |s1| 1 - (SPADCALL (QVELT |s1| 1) - (SPADCALL (CAR |qr|) |x| - (|getShellEntry| $ 29)) - (|getShellEntry| $ 33))) - (EXIT - (SETQ |s1| - (|EUCDOM-;unitNormalizeIdealElt| - |s1| $)))))))) - (EXIT |s1|))))))))) + |EUCDOM-;extendedEuclidean;2SR;7|) + (LETT |s3| + (VECTOR (SPADCALL (QVELT |s1| 0) + (SPADCALL (CAR |qr|) + (QVELT |s2| 0) + (|getShellEntry| $ 29)) + (|getShellEntry| $ 31)) + (SPADCALL (QVELT |s1| 1) + (SPADCALL (CAR |qr|) + (QVELT |s2| 1) + (|getShellEntry| $ 29)) + (|getShellEntry| $ 31)) + (CDR |qr|)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (SETQ |s1| |s2|) + (EXIT (SETQ |s2| + (|EUCDOM-;unitNormalizeIdealElt| + |s3| $))))))) + (COND + ((NOT (SPADCALL (QVELT |s1| 0) (|getShellEntry| $ 8))) + (COND + ((NOT (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 32))) + (SEQ (LETT |qr| + (SPADCALL (QVELT |s1| 0) |y| + (|getShellEntry| $ 16)) + |EUCDOM-;extendedEuclidean;2SR;7|) + (QSETVELT |s1| 0 (CDR |qr|)) + (QSETVELT |s1| 1 + (SPADCALL (QVELT |s1| 1) + (SPADCALL (CAR |qr|) |x| + (|getShellEntry| $ 29)) + (|getShellEntry| $ 33))) + (EXIT (SETQ |s1| + (|EUCDOM-;unitNormalizeIdealElt| + |s1| $)))))))) + (EXIT |s1|)))))))) (DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) (PROG (|s| |w| |qr|) @@ -303,99 +290,86 @@ (SETQ #2# (CDR #2#))))))))))))))) (DEFUN |EUCDOM-;multiEuclidean;LSU;11| (|l| |z| $) - (PROG (|n| |l1| |l2| |u| |v1| |v2|) + (PROG (|l1| |l2| |u| |v1| |v2|) (RETURN - (SEQ (LETT |n| (LENGTH |l|) |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((ZEROP |n|) - (|error| "empty list passed to multiEuclidean")) - ((EQL |n| 1) (CONS 0 (LIST |z|))) - ('T - (SEQ (LETT |l1| - (SPADCALL |l| (|getShellEntry| $ 58)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |l2| - (SPADCALL |l1| (QUOTIENT2 |n| 2) - (|getShellEntry| $ 61)) - |EUCDOM-;multiEuclidean;LSU;11|) - (LETT |u| - (SPADCALL - (LET - ((#0=#:G1504 NIL) (#1=#:G1505 T) - (#2=#:G1524 |l1|)) - (LOOP + (LET ((|n| (LENGTH |l|))) + (COND + ((ZEROP |n|) (|error| "empty list passed to multiEuclidean")) + ((EQL |n| 1) (CONS 0 (LIST |z|))) + ('T + (SEQ (LETT |l1| (SPADCALL |l| (|getShellEntry| $ 58)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |l2| + (SPADCALL |l1| (QUOTIENT2 |n| 2) + (|getShellEntry| $ 61)) + |EUCDOM-;multiEuclidean;LSU;11|) + (LETT |u| + (SPADCALL + (LET ((#0=#:G1504 NIL) (#1=#:G1505 T) + (#2=#:G1524 |l1|)) + (LOOP + (COND + ((ATOM #2#) + (RETURN + (COND + (#1# (|spadConstant| $ 30)) + (T #0#)))) + (T (LET ((#3=#:G1397 (CAR #2#))) + (LET ((#4=#:G1503 #3#)) (COND - ((ATOM #2#) - (RETURN - (COND - (#1# - (|spadConstant| $ 30)) - (T #0#)))) + (#1# (SETQ #0# #4#)) (T - (LET ((#3=#:G1397 (CAR #2#))) - (LET ((#4=#:G1503 #3#)) - (COND - (#1# (SETQ #0# #4#)) - (T - (SETQ #0# - (SPADCALL #0# #4# - (|getShellEntry| $ - 29))))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (LET - ((#5=#:G1507 NIL) (#6=#:G1508 T) - (#7=#:G1525 |l2|)) - (LOOP + (SETQ #0# + (SPADCALL #0# #4# + (|getShellEntry| $ 29))))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (LET ((#5=#:G1507 NIL) (#6=#:G1508 T) + (#7=#:G1525 |l2|)) + (LOOP + (COND + ((ATOM #7#) + (RETURN + (COND + (#6# (|spadConstant| $ 30)) + (T #5#)))) + (T (LET ((#8=#:G1398 (CAR #7#))) + (LET ((#9=#:G1506 #8#)) (COND - ((ATOM #7#) - (RETURN - (COND - (#6# - (|spadConstant| $ 30)) - (T #5#)))) + (#6# (SETQ #5# #9#)) (T - (LET ((#8=#:G1398 (CAR #7#))) - (LET ((#9=#:G1506 #8#)) - (COND - (#6# (SETQ #5# #9#)) - (T - (SETQ #5# - (SPADCALL #5# #9# - (|getShellEntry| $ - 29))))) - (SETQ #6# NIL))))) - (SETQ #7# (CDR #7#)))) - |z| (|getShellEntry| $ 62)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT (COND - ((EQL (CAR |u|) 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |v1| - (SPADCALL |l1| (CDR (CDR |u|)) - (|getShellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((EQL (CAR |v1|) 1) - (CONS 1 "failed")) - ('T - (SEQ - (LETT |v2| - (SPADCALL |l2| - (CAR (CDR |u|)) - (|getShellEntry| $ 63)) - |EUCDOM-;multiEuclidean;LSU;11|) - (EXIT - (COND - ((EQL (CAR |v2|) 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (CDR |v1|) - (CDR |v2|) - (|getShellEntry| $ - 64)))))))))))))))))))))) + (SETQ #5# + (SPADCALL #5# #9# + (|getShellEntry| $ 29))))) + (SETQ #6# NIL))))) + (SETQ #7# (CDR #7#)))) + |z| (|getShellEntry| $ 62)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((EQL (CAR |u|) 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |v1| + (SPADCALL |l1| (CDR (CDR |u|)) + (|getShellEntry| $ 63)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT (COND + ((EQL (CAR |v1|) 1) + (CONS 1 "failed")) + ('T + (SEQ + (LETT |v2| + (SPADCALL |l2| (CAR (CDR |u|)) + (|getShellEntry| $ 63)) + |EUCDOM-;multiEuclidean;LSU;11|) + (EXIT + (COND + ((EQL (CAR |v2|) 1) + (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (CDR |v1|) + (CDR |v2|) + (|getShellEntry| $ 64))))))))))))))))))))) (DEFUN |EuclideanDomain&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 061cefde..26185c00 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -67,18 +67,15 @@ (|getShellEntry| $ 22))) (DEFUN |FFIELDC-;conditionP;MU;5| (|mat| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| (SPADCALL |mat| (|getShellEntry| $ 27)) - |FFIELDC-;conditionP;MU;5|) - (COND - ((OR (NULL |l|) - (SPADCALL (ELT $ 16) (|SPADfirst| |l|) - (|getShellEntry| $ 31))) - (EXIT (CONS 1 "failed")))) - (EXIT (CONS 0 - (SPADCALL (ELT $ 32) (|SPADfirst| |l|) - (|getShellEntry| $ 34)))))))) + (LET ((|l| (SPADCALL |mat| (|getShellEntry| $ 27)))) + (SEQ (COND + ((OR (NULL |l|) + (SPADCALL (ELT $ 16) (|SPADfirst| |l|) + (|getShellEntry| $ 31))) + (EXIT (CONS 1 "failed")))) + (EXIT (CONS 0 + (SPADCALL (ELT $ 32) (|SPADfirst| |l|) + (|getShellEntry| $ 34))))))) (DEFUN |FFIELDC-;charthRoot;2S;6| (|x| $) (SPADCALL |x| @@ -90,36 +87,34 @@ (CONS 0 (SPADCALL |x| (|getShellEntry| $ 32)))) (DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($) - (PROG (|e| |sm1| |start| |found|) + (PROG (|e|) (RETURN - (SEQ (LETT |sm1| (- (SPADCALL (|getShellEntry| $ 40)) 1) - |FFIELDC-;createPrimitiveElement;S;8|) - (LETT |start| + (LET* ((|sm1| (- (SPADCALL (|getShellEntry| $ 40)) 1)) + (|start| (COND + ((SPADCALL (SPADCALL (|getShellEntry| $ 48)) + (CONS 1 "polynomial") + (|getShellEntry| $ 49)) + (|spadConstant| $ 41)) + ('T 1))) + (|found| NIL)) + (SEQ (LET ((|i| |start|)) + (LOOP (COND - ((SPADCALL (SPADCALL (|getShellEntry| $ 48)) - (CONS 1 "polynomial") (|getShellEntry| $ 49)) - (|spadConstant| $ 41)) - ('T 1)) - |FFIELDC-;createPrimitiveElement;S;8|) - (LETT |found| NIL |FFIELDC-;createPrimitiveElement;S;8|) - (LET ((|i| |start|)) - (LOOP - (COND - ((NOT (NOT |found|)) (RETURN NIL)) - (T (SEQ (LETT |e| - (SPADCALL - (|check-subtype| - (AND (>= |i| 0) (> |i| 0)) - '(|PositiveInteger|) |i|) - (|getShellEntry| $ 14)) - |FFIELDC-;createPrimitiveElement;S;8|) - (EXIT (SETQ |found| - (EQL - (SPADCALL |e| - (|getShellEntry| $ 19)) - |sm1|)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT |e|))))) + ((NOT (NOT |found|)) (RETURN NIL)) + (T (SEQ (LETT |e| + (SPADCALL + (|check-subtype| + (AND (>= |i| 0) (> |i| 0)) + '(|PositiveInteger|) |i|) + (|getShellEntry| $ 14)) + |FFIELDC-;createPrimitiveElement;S;8|) + (EXIT (SETQ |found| + (EQL + (SPADCALL |e| + (|getShellEntry| $ 19)) + |sm1|)))))) + (SETQ |i| (+ |i| 1)))) + (EXIT |e|)))))) (DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) (PROG (|explist| |q| |equalone|) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index 820134e2..3f05b3f2 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -193,66 +193,62 @@ (EXIT |x|))) (DEFUN |ILIST;copy;2$;20| (|x| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| NIL |ILIST;copy;2$;20|) - (LET ((|i| 0)) - (LOOP - (COND - ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (SEQ (COND - ((EQL |i| 1000) - (COND - ((SPADCALL |x| (|getShellEntry| $ 35)) - (|error| "cyclic list"))))) - (SETQ |y| (CONS (CAR |x|) |y|)) - (EXIT (SETQ |x| (CDR |x|)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT (NREVERSE |y|)))))) + (LET ((|y| (SPADCALL (|getShellEntry| $ 16)))) + (SEQ (LET ((|i| 0)) + (LOOP + (COND + ((NOT (NOT (NULL |x|))) (RETURN NIL)) + (T (SEQ (COND + ((EQL |i| 1000) + (COND + ((SPADCALL |x| (|getShellEntry| $ 35)) + (|error| "cyclic list"))))) + (SETQ |y| (CONS (CAR |x|) |y|)) + (EXIT (SETQ |x| (CDR |x|)))))) + (SETQ |i| (+ |i| 1)))) + (EXIT (NREVERSE |y|))))) (DEFUN |ILIST;coerce;$Of;21| (|x| $) - (PROG (|y| |s| |z|) + (PROG (|z|) (RETURN - (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|) - (LETT |s| (SPADCALL |x| (|getShellEntry| $ 40)) - |ILIST;coerce;$Of;21|) - (LOOP - (COND - ((NOT (NOT (EQ |x| |s|))) (RETURN NIL)) - (T (SEQ (SETQ |y| - (CONS (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - |y|)) - (EXIT (SETQ |x| (CDR |x|))))))) - (SETQ |y| (NREVERSE |y|)) - (EXIT (COND - ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 45))) - ('T - (SEQ (LETT |z| - (SPADCALL - (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - (|getShellEntry| $ 46)) - |ILIST;coerce;$Of;21|) - (LOOP - (COND - ((NOT (NOT (EQ |s| (CDR |x|)))) - (RETURN NIL)) - (T (SEQ (SETQ |x| (CDR |x|)) - (EXIT - (SETQ |z| - (CONS - (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - |z|))))))) - (EXIT (SPADCALL - (SPADCALL |y| - (SPADCALL - (SPADCALL (NREVERSE |z|) - (|getShellEntry| $ 47)) - (|getShellEntry| $ 48)) - (|getShellEntry| $ 49)) - (|getShellEntry| $ 45))))))))))) + (LET* ((|y| NIL) (|s| (SPADCALL |x| (|getShellEntry| $ 40)))) + (SEQ (LOOP + (COND + ((NOT (NOT (EQ |x| |s|))) (RETURN NIL)) + (T (SEQ (SETQ |y| + (CONS (SPADCALL (|SPADfirst| |x|) + (|getShellEntry| $ 41)) + |y|)) + (EXIT (SETQ |x| (CDR |x|))))))) + (SETQ |y| (NREVERSE |y|)) + (EXIT (COND + ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 45))) + ('T + (SEQ (LETT |z| + (SPADCALL + (SPADCALL (|SPADfirst| |x|) + (|getShellEntry| $ 41)) + (|getShellEntry| $ 46)) + |ILIST;coerce;$Of;21|) + (LOOP + (COND + ((NOT (NOT (EQ |s| (CDR |x|)))) + (RETURN NIL)) + (T (SEQ (SETQ |x| (CDR |x|)) + (EXIT + (SETQ |z| + (CONS + (SPADCALL (|SPADfirst| |x|) + (|getShellEntry| $ 41)) + |z|))))))) + (EXIT (SPADCALL + (SPADCALL |y| + (SPADCALL + (SPADCALL (NREVERSE |z|) + (|getShellEntry| $ 47)) + (|getShellEntry| $ 48)) + (|getShellEntry| $ 49)) + (|getShellEntry| $ 45)))))))))))) (DEFUN |ILIST;=;2$B;22| (|x| |y| $) (SEQ (COND @@ -272,21 +268,19 @@ (EXIT (COND ((NULL |x|) (NULL |y|)) ('T NIL)))))))) (DEFUN |ILIST;latex;$S;23| (|x| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| "\\left[" |ILIST;latex;$S;23|) - (LOOP - (COND - ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (SEQ (SETQ |s| - (STRCONC |s| - (SPADCALL (CAR |x|) - (|getShellEntry| $ 56)))) - (SETQ |x| (CDR |x|)) - (EXIT (COND - ((NOT (NULL |x|)) - (SETQ |s| (STRCONC |s| ", "))))))))) - (EXIT (STRCONC |s| " \\right]")))))) + (LET ((|s| "\\left[")) + (SEQ (LOOP + (COND + ((NOT (NOT (NULL |x|))) (RETURN NIL)) + (T (SEQ (SETQ |s| + (STRCONC |s| + (SPADCALL (CAR |x|) + (|getShellEntry| $ 56)))) + (SETQ |x| (CDR |x|)) + (EXIT (COND + ((NOT (NULL |x|)) + (SETQ |s| (STRCONC |s| ", "))))))))) + (EXIT (STRCONC |s| " \\right]"))))) (DEFUN |ILIST;member?;S$B;24| (|s| |x| $) (SEQ (LOOP @@ -317,29 +311,32 @@ (QRPLACD |z| |y|) (EXIT |x|)))))))) (DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) - (PROG (|p| |pp| |f| |pr|) + (PROG (|pp| |f| |pr|) (RETURN - (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|) - (LOOP - (COND - ((NOT (NOT (NULL |p|))) (RETURN NIL)) - (T (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|) - (LETT |f| (CAR |p|) - |ILIST;removeDuplicates!;2$;26|) - (SETQ |p| (CDR |p|)) - (EXIT (LOOP - (COND - ((NOT (NOT - (NULL - (LETT |pr| (CDR |pp|) - |ILIST;removeDuplicates!;2$;26|)))) - (RETURN NIL)) - (T (COND + (LET ((|p| |l|)) + (SEQ (LOOP + (COND + ((NOT (NOT (NULL |p|))) (RETURN NIL)) + (T (SEQ (LETT |pp| |p| + |ILIST;removeDuplicates!;2$;26|) + (LETT |f| (CAR |p|) + |ILIST;removeDuplicates!;2$;26|) + (SETQ |p| (CDR |p|)) + (EXIT (LOOP + (COND + ((NOT + (NOT + (NULL + (LETT |pr| (CDR |pp|) + |ILIST;removeDuplicates!;2$;26|)))) + (RETURN NIL)) + (T + (COND ((SPADCALL (CAR |pr|) |f| (|getShellEntry| $ 59)) (QRPLACD |pp| (CDR |pr|))) ('T (SETQ |pp| |pr|))))))))))) - (EXIT |l|))))) + (EXIT |l|)))))) (DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) (|ILIST;mergeSort| |f| |l| (LENGTH |l|) $)) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp index f75d7e3c..794d4374 100644 --- a/src/algebra/strap/INS-.lsp +++ b/src/algebra/strap/INS-.lsp @@ -194,41 +194,32 @@ (|getShellEntry| $ 76)))) (DEFUN |INS-;symmetricRemainder;3S;27| (|x| |n| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| (SPADCALL |x| |n| (|getShellEntry| $ 80)) - |INS-;symmetricRemainder;3S;27|) - (EXIT (COND - ((SPADCALL |r| (|spadConstant| $ 10) - (|getShellEntry| $ 27)) - |r|) - ('T - (SEQ (COND - ((SPADCALL |n| (|spadConstant| $ 10) - (|getShellEntry| $ 28)) - (SETQ |n| - (SPADCALL |n| (|getShellEntry| $ 19))))) - (EXIT (COND - ((SPADCALL |r| (|spadConstant| $ 10) - (|getShellEntry| $ 16)) - (COND - ((SPADCALL - (SPADCALL 2 |r| - (|getShellEntry| $ 82)) - |n| (|getShellEntry| $ 16)) - (SPADCALL |r| |n| - (|getShellEntry| $ 67))) - ('T |r|))) - ((NOT (SPADCALL - (SPADCALL - (SPADCALL 2 |r| - (|getShellEntry| $ 82)) - |n| (|getShellEntry| $ 83)) - (|spadConstant| $ 10) - (|getShellEntry| $ 16))) - (SPADCALL |r| |n| - (|getShellEntry| $ 83))) - ('T |r|))))))))))) + (LET ((|r| (SPADCALL |x| |n| (|getShellEntry| $ 80)))) + (COND + ((SPADCALL |r| (|spadConstant| $ 10) (|getShellEntry| $ 27)) |r|) + ('T + (SEQ (COND + ((SPADCALL |n| (|spadConstant| $ 10) + (|getShellEntry| $ 28)) + (SETQ |n| (SPADCALL |n| (|getShellEntry| $ 19))))) + (EXIT (COND + ((SPADCALL |r| (|spadConstant| $ 10) + (|getShellEntry| $ 16)) + (COND + ((SPADCALL + (SPADCALL 2 |r| (|getShellEntry| $ 82)) |n| + (|getShellEntry| $ 16)) + (SPADCALL |r| |n| (|getShellEntry| $ 67))) + ('T |r|))) + ((NOT (SPADCALL + (SPADCALL + (SPADCALL 2 |r| + (|getShellEntry| $ 82)) + |n| (|getShellEntry| $ 83)) + (|spadConstant| $ 10) + (|getShellEntry| $ 16))) + (SPADCALL |r| |n| (|getShellEntry| $ 83))) + ('T |r|)))))))) (DEFUN |INS-;invmod;3S;28| (|a| |b| $) (PROG (|c| |c1| |d| |d1| |q| |r| |r1|) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 919f0c16..6ebab972 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -275,34 +275,24 @@ ('T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) (DEFUN |INT;OMwrite;$S;2| (|x| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |INT;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) - (|getShellEntry| $ 22)) - |INT;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 23)) - (|INT;writeOMInt| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 24)) - (SPADCALL |dev| (|getShellEntry| $ 25)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) + (|getShellEntry| $ 22)))) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) + (|INT;writeOMInt| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 24)) + (SPADCALL |dev| (|getShellEntry| $ 25)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |INT;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) - (|getShellEntry| $ 22)) - |INT;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 23)))) - (|INT;writeOMInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) - (SPADCALL |dev| (|getShellEntry| $ 25)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) + (|getShellEntry| $ 22)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 23)))) + (|INT;writeOMInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) + (SPADCALL |dev| (|getShellEntry| $ 25)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) @@ -349,16 +339,10 @@ (INTEGER-LENGTH |a|)) (DEFUN |INT;addmod;4$;20| (|a| |b| |p| $) - (PROG (|c|) - (RETURN - (SEQ (LETT |c| (+ |a| |b|) |INT;addmod;4$;20|) - (EXIT (COND ((>= |c| |p|) (- |c| |p|)) ('T |c|))))))) + (LET ((|c| (+ |a| |b|))) (COND ((>= |c| |p|) (- |c| |p|)) ('T |c|)))) (DEFUN |INT;submod;4$;21| (|a| |b| |p| $) - (PROG (|c|) - (RETURN - (SEQ (LETT |c| (- |a| |b|) |INT;submod;4$;21|) - (EXIT (COND ((< |c| 0) (+ |c| |p|)) ('T |c|))))))) + (LET ((|c| (- |a| |b|))) (COND ((< |c| 0) (+ |c| |p|)) ('T |c|)))) (DEFUN |INT;mulmod;4$;22| (|a| |b| |p| $) (REMAINDER2 (* |a| |b|) |p|)) @@ -378,11 +362,9 @@ (STRINGIMAGE |x|)) (DEFUN |INT;latex;$S;27| (|x| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| (STRINGIMAGE |x|) |INT;latex;$S;27|) - (COND ((< -1 |x|) (COND ((< |x| 10) (EXIT |s|))))) - (EXIT (STRCONC "{" (STRCONC |s| "}"))))))) + (LET ((|s| (STRINGIMAGE |x|))) + (SEQ (COND ((< -1 |x|) (COND ((< |x| 10) (EXIT |s|))))) + (EXIT (STRCONC "{" (STRCONC |s| "}")))))) (DEFUN |INT;positiveRemainder;3$;28| (|a| |b| $) (PROG (|r|) @@ -472,31 +454,27 @@ (SPADCALL |p| (|getShellEntry| $ 106))) (DEFUN |INT;factorPolynomial| (|p| $) - (PROG (|pp|) - (RETURN - (SEQ (LETT |pp| (SPADCALL |p| (|getShellEntry| $ 107)) - |INT;factorPolynomial|) - (EXIT (COND - ((EQL (SPADCALL |pp| (|getShellEntry| $ 108)) - (SPADCALL |p| (|getShellEntry| $ 108))) - (SPADCALL |p| (|getShellEntry| $ 110))) - ('T - (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 110)) - (SPADCALL (CONS #'|INT;factorPolynomial!0| $) - (SPADCALL - (LET ((#0=#:G1499 - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 108)) - (SPADCALL |pp| - (|getShellEntry| $ 108)) - (|getShellEntry| $ 112)))) - (|check-union| (EQL (CAR #0#) 0) $ - #0#) - (CDR #0#)) - (|getShellEntry| $ 114)) - (|getShellEntry| $ 118)) - (|getShellEntry| $ 120))))))))) + (LET ((|pp| (SPADCALL |p| (|getShellEntry| $ 107)))) + (COND + ((EQL (SPADCALL |pp| (|getShellEntry| $ 108)) + (SPADCALL |p| (|getShellEntry| $ 108))) + (SPADCALL |p| (|getShellEntry| $ 110))) + ('T + (SPADCALL (SPADCALL |pp| (|getShellEntry| $ 110)) + (SPADCALL (CONS #'|INT;factorPolynomial!0| $) + (SPADCALL + (LET ((#0=#:G1499 + (SPADCALL + (SPADCALL |p| + (|getShellEntry| $ 108)) + (SPADCALL |pp| + (|getShellEntry| $ 108)) + (|getShellEntry| $ 112)))) + (|check-union| (EQL (CAR #0#) 0) $ #0#) + (CDR #0#)) + (|getShellEntry| $ 114)) + (|getShellEntry| $ 118)) + (|getShellEntry| $ 120)))))) (DEFUN |INT;factorPolynomial!0| (|#1| $) (SPADCALL |#1| (|getShellEntry| $ 111))) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 8f2a39fc..9340674d 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -178,57 +178,52 @@ (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) (DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) - (PROG (|l| |m| |n| |h| |r| |k|) + (PROG (|r| |k|) (RETURN - (SEQ (LETT |l| - (- (SPADCALL |sg| (|getShellEntry| $ 44)) - (|getShellEntry| $ 6)) - |ISTRING;replace;$Us2$;15|) - (LETT |m| (QCSIZE |s|) |ISTRING;replace;$Us2$;15|) - (LETT |n| (QCSIZE |t|) |ISTRING;replace;$Us2$;15|) - (LETT |h| + (LET* ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44)) + (|getShellEntry| $ 6))) + (|m| (QCSIZE |s|)) (|n| (QCSIZE |t|)) + (|h| (COND + ((SPADCALL |sg| (|getShellEntry| $ 45)) + (- (SPADCALL |sg| (|getShellEntry| $ 46)) + (|getShellEntry| $ 6))) + ('T + (- (SPADCALL |s| (|getShellEntry| $ 47)) + (|getShellEntry| $ 6)))))) + (SEQ (COND + ((OR (OR (< |l| 0) (>= |h| |m|)) (< |h| (- |l| 1))) + (EXIT (|error| "index out of range")))) + (LETT |r| + (MAKE-FULL-CVEC + (LET ((#0=#:G1444 + (+ (- |m| (+ (- |h| |l|) 1)) |n|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|spadConstant| $ 53)) + |ISTRING;replace;$Us2$;15|) + (LETT |k| 0 |ISTRING;replace;$Us2$;15|) + (LET ((|i| 0) (#1=#:G1535 (- |l| 1))) + (LOOP (COND - ((SPADCALL |sg| (|getShellEntry| $ 45)) - (- (SPADCALL |sg| (|getShellEntry| $ 46)) - (|getShellEntry| $ 6))) - ('T - (- (SPADCALL |s| (|getShellEntry| $ 47)) - (|getShellEntry| $ 6)))) - |ISTRING;replace;$Us2$;15|) - (COND - ((OR (OR (< |l| 0) (>= |h| |m|)) (< |h| (- |l| 1))) - (EXIT (|error| "index out of range")))) - (LETT |r| - (MAKE-FULL-CVEC - (LET ((#0=#:G1444 - (+ (- |m| (+ (- |h| |l|) 1)) |n|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|spadConstant| $ 53)) - |ISTRING;replace;$Us2$;15|) - (LETT |k| 0 |ISTRING;replace;$Us2$;15|) - (LET ((|i| 0) (#1=#:G1535 (- |l| 1))) - (LOOP - (COND - ((> |i| #1#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) - (EXIT (SETQ |k| (+ |k| 1)))))) - (SETQ |i| (+ |i| 1)))) - (LET ((|i| 0) (#2=#:G1536 (- |n| 1))) - (LOOP - (COND - ((> |i| #2#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |t| |i|)) - (EXIT (SETQ |k| (+ |k| 1)))))) - (SETQ |i| (+ |i| 1)))) - (LET ((|i| (+ |h| 1)) (#3=#:G1537 (- |m| 1))) - (LOOP - (COND - ((> |i| #3#) (RETURN NIL)) - (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) - (EXIT (SETQ |k| (+ |k| 1)))))) - (SETQ |i| (+ |i| 1)))) - (EXIT |r|))))) + ((> |i| #1#) (RETURN NIL)) + (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) + (EXIT (SETQ |k| (+ |k| 1)))))) + (SETQ |i| (+ |i| 1)))) + (LET ((|i| 0) (#2=#:G1536 (- |n| 1))) + (LOOP + (COND + ((> |i| #2#) (RETURN NIL)) + (T (SEQ (QESET |r| |k| (CHAR |t| |i|)) + (EXIT (SETQ |k| (+ |k| 1)))))) + (SETQ |i| (+ |i| 1)))) + (LET ((|i| (+ |h| 1)) (#3=#:G1537 (- |m| 1))) + (LOOP + (COND + ((> |i| #3#) (RETURN NIL)) + (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) + (EXIT (SETQ |k| (+ |k| 1)))))) + (SETQ |i| (+ |i| 1)))) + (EXIT |r|)))))) (DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $) (SEQ (COND @@ -240,30 +235,27 @@ (EXIT |c|)))))) (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) - (PROG (|np| |nw|) - (RETURN - (SEQ (LETT |np| (QCSIZE |part|) |ISTRING;substring?;2$IB;17|) - (LETT |nw| (QCSIZE |whole|) |ISTRING;substring?;2$IB;17|) - (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) - (EXIT (COND - ((< |startpos| 0) (|error| "index out of bounds")) - ((> |np| (- |nw| |startpos|)) NIL) - ('T - (SEQ (LET ((|ip| 0) (#0=#:G1538 (- |np| 1)) - (|iw| |startpos|)) - (LOOP - (COND - ((> |ip| #0#) (RETURN NIL)) - (T (COND - ((NOT - (CHAR= (CHAR |part| |ip|) - (CHAR |whole| |iw|))) - (RETURN-FROM - |ISTRING;substring?;2$IB;17| - NIL))))) - (SETQ |ip| (+ |ip| 1)) - (SETQ |iw| (+ |iw| 1)))) - (EXIT T))))))))) + (LET* ((|np| (QCSIZE |part|)) (|nw| (QCSIZE |whole|))) + (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) + (EXIT (COND + ((< |startpos| 0) (|error| "index out of bounds")) + ((> |np| (- |nw| |startpos|)) NIL) + ('T + (SEQ (LET ((|ip| 0) (#0=#:G1538 (- |np| 1)) + (|iw| |startpos|)) + (LOOP + (COND + ((> |ip| #0#) (RETURN NIL)) + (T (COND + ((NOT + (CHAR= (CHAR |part| |ip|) + (CHAR |whole| |iw|))) + (RETURN-FROM + |ISTRING;substring?;2$IB;17| + NIL))))) + (SETQ |ip| (+ |ip| 1)) + (SETQ |iw| (+ |iw| 1)))) + (EXIT T)))))))) (DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) (PROG (|r|) @@ -323,244 +315,224 @@ (EXIT (- (|getShellEntry| $ 6) 1)))))))) (DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) - (PROG (|m| |n|) - (RETURN - (SEQ (LETT |m| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;suffix?;2$B;21|) - (LETT |n| (SPADCALL |t| (|getShellEntry| $ 47)) - |ISTRING;suffix?;2$B;21|) - (EXIT (COND - ((> |m| |n|) NIL) - ('T - (|ISTRING;substring?;2$IB;17| |s| |t| - (- (+ (|getShellEntry| $ 6) |n|) |m|) $)))))))) + (LET* ((|m| (SPADCALL |s| (|getShellEntry| $ 47))) + (|n| (SPADCALL |t| (|getShellEntry| $ 47)))) + (COND + ((> |m| |n|) NIL) + ('T + (|ISTRING;substring?;2$IB;17| |s| |t| + (- (+ (|getShellEntry| $ 6) |n|) |m|) $))))) (DEFUN |ISTRING;split;$CL;22| (|s| |c| $) - (PROG (|n| |i| |l| |j|) + (PROG (|l| |j|) (RETURN - (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;split;$CL;22|) - (LETT |i| (|getShellEntry| $ 6) |ISTRING;split;$CL;22|) - (LOOP - (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| - (|getShellEntry| $ 69))))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (LETT |l| NIL |ISTRING;split;$CL;22|) - (LOOP + (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47))) + (|i| (|getShellEntry| $ 6))) + (SEQ (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) + |c| (|getShellEntry| $ 69))))) + (RETURN NIL)) + (T (SETQ |i| (+ |i| 1))))) + (LETT |l| NIL |ISTRING;split;$CL;22|) + (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (>= (LETT |j| + (|ISTRING;position;C$2I;19| |c| |s| + |i| $) + |ISTRING;split;$CL;22|) + (|getShellEntry| $ 6))))) + (RETURN NIL)) + (T (SEQ (SETQ |l| + (SPADCALL + (|ISTRING;elt;$Us$;31| |s| + (SPADCALL |i| (- |j| 1) + (|getShellEntry| $ 24)) + $) + |l| (|getShellEntry| $ 72))) + (SETQ |i| |j|) + (EXIT (LOOP + (COND + ((NOT + (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL + (|ISTRING;elt;$IC;30| |s| |i| + $) + |c| (|getShellEntry| $ 69))))) + (RETURN NIL)) + (T (SETQ |i| (+ |i| 1)))))))))) (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (>= (LETT |j| - (|ISTRING;position;C$2I;19| |c| |s| - |i| $) - |ISTRING;split;$CL;22|) - (|getShellEntry| $ 6))))) - (RETURN NIL)) - (T (SEQ (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| (- |j| 1) - (|getShellEntry| $ 24)) - $) - |l| (|getShellEntry| $ 72))) - (SETQ |i| |j|) - (EXIT (LOOP - (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL - (|ISTRING;elt;$IC;30| |s| - |i| $) - |c| (|getShellEntry| $ 69))))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1)))))))))) - (COND - ((NOT (> |i| |n|)) - (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|getShellEntry| $ 24)) - $) - |l| (|getShellEntry| $ 72))))) - (EXIT (NREVERSE |l|)))))) + ((NOT (> |i| |n|)) + (SETQ |l| + (SPADCALL + (|ISTRING;elt;$Us$;31| |s| + (SPADCALL |i| |n| (|getShellEntry| $ 24)) + $) + |l| (|getShellEntry| $ 72))))) + (EXIT (NREVERSE |l|))))))) (DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $) - (PROG (|n| |i| |l| |j|) + (PROG (|l| |j|) (RETURN - (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;split;$CcL;23|) - (LETT |i| (|getShellEntry| $ 6) |ISTRING;split;$CcL;23|) - (LOOP - (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| - (|getShellEntry| $ 65))))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (LETT |l| NIL |ISTRING;split;$CcL;23|) - (LOOP + (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47))) + (|i| (|getShellEntry| $ 6))) + (SEQ (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) + |cc| (|getShellEntry| $ 65))))) + (RETURN NIL)) + (T (SETQ |i| (+ |i| 1))))) + (LETT |l| NIL |ISTRING;split;$CcL;23|) + (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (>= (LETT |j| + (|ISTRING;position;Cc$2I;20| |cc| + |s| |i| $) + |ISTRING;split;$CcL;23|) + (|getShellEntry| $ 6))))) + (RETURN NIL)) + (T (SEQ (SETQ |l| + (SPADCALL + (|ISTRING;elt;$Us$;31| |s| + (SPADCALL |i| (- |j| 1) + (|getShellEntry| $ 24)) + $) + |l| (|getShellEntry| $ 72))) + (SETQ |i| |j|) + (EXIT (LOOP + (COND + ((NOT + (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL + (|ISTRING;elt;$IC;30| |s| |i| + $) + |cc| (|getShellEntry| $ 65))))) + (RETURN NIL)) + (T (SETQ |i| (+ |i| 1)))))))))) (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (>= (LETT |j| - (|ISTRING;position;Cc$2I;20| |cc| |s| - |i| $) - |ISTRING;split;$CcL;23|) - (|getShellEntry| $ 6))))) - (RETURN NIL)) - (T (SEQ (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| (- |j| 1) - (|getShellEntry| $ 24)) - $) - |l| (|getShellEntry| $ 72))) - (SETQ |i| |j|) - (EXIT (LOOP - (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL - (|ISTRING;elt;$IC;30| |s| - |i| $) - |cc| (|getShellEntry| $ 65))))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1)))))))))) - (COND - ((NOT (> |i| |n|)) - (SETQ |l| - (SPADCALL - (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|getShellEntry| $ 24)) - $) - |l| (|getShellEntry| $ 72))))) - (EXIT (NREVERSE |l|)))))) + ((NOT (> |i| |n|)) + (SETQ |l| + (SPADCALL + (|ISTRING;elt;$Us$;31| |s| + (SPADCALL |i| |n| (|getShellEntry| $ 24)) + $) + |l| (|getShellEntry| $ 72))))) + (EXIT (NREVERSE |l|))))))) (DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $) - (PROG (|n| |i|) - (RETURN - (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;leftTrim;$C$;24|) - (LETT |i| (|getShellEntry| $ 6) |ISTRING;leftTrim;$C$;24|) - (LOOP - (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| - (|getShellEntry| $ 69))))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))) + (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47))) + (|i| (|getShellEntry| $ 6))) + (SEQ (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| + (|getShellEntry| $ 69))))) + (RETURN NIL)) + (T (SETQ |i| (+ |i| 1))))) + (EXIT (|ISTRING;elt;$Us$;31| |s| + (SPADCALL |i| |n| (|getShellEntry| $ 24)) $))))) (DEFUN |ISTRING;leftTrim;$Cc$;25| (|s| |cc| $) - (PROG (|n| |i|) - (RETURN - (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;leftTrim;$Cc$;25|) - (LETT |i| (|getShellEntry| $ 6) |ISTRING;leftTrim;$Cc$;25|) - (LOOP - (COND - ((NOT (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| - (|getShellEntry| $ 65))))) - (RETURN NIL)) - (T (SETQ |i| (+ |i| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))) + (LET* ((|n| (SPADCALL |s| (|getShellEntry| $ 47))) + (|i| (|getShellEntry| $ 6))) + (SEQ (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| + (|getShellEntry| $ 65))))) + (RETURN NIL)) + (T (SETQ |i| (+ |i| 1))))) + (EXIT (|ISTRING;elt;$Us$;31| |s| + (SPADCALL |i| |n| (|getShellEntry| $ 24)) $))))) (DEFUN |ISTRING;rightTrim;$C$;26| (|s| |c| $) - (PROG (|j|) - (RETURN - (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;rightTrim;$C$;26|) - (LOOP - (COND - ((NOT (COND - ((>= |j| (|getShellEntry| $ 6)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| - (|getShellEntry| $ 69))) - ('T NIL))) - (RETURN NIL)) - (T (SETQ |j| (- |j| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| - (|getShellEntry| $ 24)) - $)))))) + (LET ((|j| (SPADCALL |s| (|getShellEntry| $ 47)))) + (SEQ (LOOP + (COND + ((NOT (COND + ((>= |j| (|getShellEntry| $ 6)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| + (|getShellEntry| $ 69))) + ('T NIL))) + (RETURN NIL)) + (T (SETQ |j| (- |j| 1))))) + (EXIT (|ISTRING;elt;$Us$;31| |s| + (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| + (|getShellEntry| $ 24)) + $))))) (DEFUN |ISTRING;rightTrim;$Cc$;27| (|s| |cc| $) - (PROG (|j|) - (RETURN - (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 47)) - |ISTRING;rightTrim;$Cc$;27|) - (LOOP - (COND - ((NOT (COND - ((>= |j| (|getShellEntry| $ 6)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| - (|getShellEntry| $ 65))) - ('T NIL))) - (RETURN NIL)) - (T (SETQ |j| (- |j| 1))))) - (EXIT (|ISTRING;elt;$Us$;31| |s| - (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| - (|getShellEntry| $ 24)) - $)))))) + (LET ((|j| (SPADCALL |s| (|getShellEntry| $ 47)))) + (SEQ (LOOP + (COND + ((NOT (COND + ((>= |j| (|getShellEntry| $ 6)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| + (|getShellEntry| $ 65))) + ('T NIL))) + (RETURN NIL)) + (T (SETQ |j| (- |j| 1))))) + (EXIT (|ISTRING;elt;$Us$;31| |s| + (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| + (|getShellEntry| $ 24)) + $))))) (DEFUN |ISTRING;concat;L$;28| (|l| $) - (PROG (|t| |i|) - (RETURN - (SEQ (LETT |t| - (MAKE-FULL-CVEC - (LET ((#0=#:G1497 NIL) (#1=#:G1498 T) - (#2=#:G1541 |l|)) - (LOOP - (COND - ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) - (T (LET ((|s| (CAR #2#))) - (LET ((#3=#:G1496 (QCSIZE |s|))) - (COND - (#1# (SETQ #0# #3#)) - (T (SETQ #0# (+ #0# #3#)))) - (SETQ #1# NIL))))) - (SETQ #2# (CDR #2#)))) - (|spadConstant| $ 53)) - |ISTRING;concat;L$;28|) - (LETT |i| (|getShellEntry| $ 6) |ISTRING;concat;L$;28|) - (LET ((#4=#:G1542 |l|)) - (LOOP - (COND - ((ATOM #4#) (RETURN NIL)) - (T (LET ((|s| (CAR #4#))) - (SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $) - (EXIT (SETQ |i| (+ |i| (QCSIZE |s|)))))))) - (SETQ #4# (CDR #4#)))) - (EXIT |t|))))) + (LET* ((|t| (SPADCALL + (LET ((#0=#:G1497 NIL) (#1=#:G1498 T) + (#2=#:G1542 |l|)) + (LOOP + (COND + ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) + (T (LET ((|s| (CAR #2#))) + (LET ((#3=#:G1496 + (SPADCALL |s| + (|getShellEntry| $ 16)))) + (COND + (#1# (SETQ #0# #3#)) + (T (SETQ #0# (+ #0# #3#)))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (|spadConstant| $ 53) (|getShellEntry| $ 9))) + (|i| (|getShellEntry| $ 6))) + (SEQ (LET ((#4=#:G1541 |l|)) + (LOOP + (COND + ((ATOM #4#) (RETURN NIL)) + (T (LET ((|s| (CAR #4#))) + (SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $) + (EXIT (SETQ |i| (+ |i| (QCSIZE |s|)))))))) + (SETQ #4# (CDR #4#)))) + (EXIT |t|)))) (DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $) - (PROG (|m| |n|) - (RETURN - (SEQ (LETT |m| (QCSIZE |x|) |ISTRING;copyInto!;2$I$;29|) - (LETT |n| (QCSIZE |y|) |ISTRING;copyInto!;2$I$;29|) - (SETQ |s| (- |s| (|getShellEntry| $ 6))) - (COND - ((OR (< |s| 0) (> (+ |s| |m|) |n|)) - (EXIT (|error| "index out of range")))) - (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|))))) + (LET* ((|m| (SPADCALL |x| (|getShellEntry| $ 16))) + (|n| (QCSIZE |y|))) + (SEQ (SETQ |s| (- |s| (|getShellEntry| $ 6))) + (COND + ((OR (< |s| 0) (> (+ |s| |m|) |n|)) + (EXIT (|error| "index out of range")))) + (RPLACSTR |y| |s| |m| |x| 0 |m|) (EXIT |y|)))) (DEFUN |ISTRING;elt;$IC;30| (|s| |i| $) (COND @@ -570,25 +542,19 @@ ('T (CHAR |s| (- |i| (|getShellEntry| $ 6)))))) (DEFUN |ISTRING;elt;$Us$;31| (|s| |sg| $) - (PROG (|l| |h|) - (RETURN - (SEQ (LETT |l| - (- (SPADCALL |sg| (|getShellEntry| $ 44)) - (|getShellEntry| $ 6)) - |ISTRING;elt;$Us$;31|) - (LETT |h| - (COND - ((SPADCALL |sg| (|getShellEntry| $ 45)) - (- (SPADCALL |sg| (|getShellEntry| $ 46)) - (|getShellEntry| $ 6))) - ('T - (- (SPADCALL |s| (|getShellEntry| $ 47)) - (|getShellEntry| $ 6)))) - |ISTRING;elt;$Us$;31|) - (COND - ((OR (< |l| 0) (>= |h| (QCSIZE |s|))) - (EXIT (|error| "index out of bound")))) - (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1)))))))) + (LET* ((|l| (- (SPADCALL |sg| (|getShellEntry| $ 44)) + (|getShellEntry| $ 6))) + (|h| (COND + ((SPADCALL |sg| (|getShellEntry| $ 45)) + (- (SPADCALL |sg| (|getShellEntry| $ 46)) + (|getShellEntry| $ 6))) + ('T + (- (SPADCALL |s| (|getShellEntry| $ 47)) + (|getShellEntry| $ 6)))))) + (SEQ (COND + ((OR (< |l| 0) (>= |h| (QCSIZE |s|))) + (EXIT (|error| "index out of bound")))) + (EXIT (SUBSTRING |s| |l| (MAX 0 (+ (- |h| |l|) 1))))))) (DEFUN |ISTRING;hash;$Si;32| (|s| $) (DECLARE (IGNORE $)) @@ -598,95 +564,95 @@ (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) (DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) - (PROG (|m| |n| |p| |i| |q| |s|) + (PROG (|m| |p| |i| |q| |s|) (RETURN - (SEQ (LETT |n| (SPADCALL |pattern| (|getShellEntry| $ 47)) - |ISTRING;match?;2$CB;34|) - (LETT |p| - (LET ((#0=#:G1525 - (|ISTRING;position;C$2I;19| |dontcare| - |pattern| - (LETT |m| - (|ISTRING;minIndex;$I;11| - |pattern| $) - |ISTRING;match?;2$CB;34|) - $))) - (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) - #0#)) - |ISTRING;match?;2$CB;34|) - (EXIT (COND - ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|)) - ('T - (SEQ (COND - ((SPADCALL |p| |m| (|getShellEntry| $ 87)) - (COND - ((NOT (SPADCALL - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL |m| (- |p| 1) - (|getShellEntry| $ 24)) - $) - |target| (|getShellEntry| $ 88))) - (EXIT NIL))))) - (LETT |i| |p| |ISTRING;match?;2$CB;34|) - (LETT |q| - (LET ((#1=#:G1526 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| (+ |p| 1) - $))) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) #1#)) - |ISTRING;match?;2$CB;34|) - (LOOP + (LET ((|n| (SPADCALL |pattern| (|getShellEntry| $ 47)))) + (SEQ (LETT |p| + (LET ((#0=#:G1525 + (|ISTRING;position;C$2I;19| |dontcare| + |pattern| + (LETT |m| + (|ISTRING;minIndex;$I;11| + |pattern| $) + |ISTRING;match?;2$CB;34|) + $))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + |ISTRING;match?;2$CB;34|) + (EXIT (COND + ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|)) + ('T + (SEQ (COND + ((SPADCALL |p| |m| (|getShellEntry| $ 87)) + (COND + ((NOT (SPADCALL + (|ISTRING;elt;$Us$;31| |pattern| + (SPADCALL |m| (- |p| 1) + (|getShellEntry| $ 24)) + $) + |target| (|getShellEntry| $ 88))) + (EXIT NIL))))) + (LETT |i| |p| |ISTRING;match?;2$CB;34|) + (LETT |q| + (LET ((#1=#:G1526 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| (+ |p| 1) + $))) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) #1#)) + |ISTRING;match?;2$CB;34|) + (LOOP + (COND + ((NOT (SPADCALL |q| (- |m| 1) + (|getShellEntry| $ 87))) + (RETURN NIL)) + (T (SEQ (LETT |s| + (|ISTRING;elt;$Us$;31| + |pattern| + (SPADCALL (+ |p| 1) (- |q| 1) + (|getShellEntry| $ 24)) + $) + |ISTRING;match?;2$CB;34|) + (SETQ |i| + (LET + ((#2=#:G1527 + (|ISTRING;position;2$2I;18| + |s| |target| |i| $))) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#))) + (EXIT + (COND + ((EQL |i| (- |m| 1)) + (RETURN-FROM + |ISTRING;match?;2$CB;34| + NIL)) + ('T + (SEQ + (SETQ |i| + (+ |i| (QCSIZE |s|))) + (SETQ |p| |q|) + (EXIT + (SETQ |q| + (LET + ((#3=#:G1528 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| + (+ |q| 1) $))) + (|check-subtype| + (>= #3# 0) + '(|NonNegativeInteger|) + #3#)))))))))))) (COND - ((NOT (SPADCALL |q| (- |m| 1) - (|getShellEntry| $ 87))) - (RETURN NIL)) - (T (SEQ (LETT |s| - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL (+ |p| 1) (- |q| 1) - (|getShellEntry| $ 24)) - $) - |ISTRING;match?;2$CB;34|) - (SETQ |i| - (LET - ((#2=#:G1527 - (|ISTRING;position;2$2I;18| - |s| |target| |i| $))) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#))) - (EXIT - (COND - ((EQL |i| (- |m| 1)) - (RETURN-FROM - |ISTRING;match?;2$CB;34| - NIL)) - ('T - (SEQ - (SETQ |i| - (+ |i| (QCSIZE |s|))) - (SETQ |p| |q|) - (EXIT - (SETQ |q| - (LET - ((#3=#:G1528 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| - (+ |q| 1) $))) - (|check-subtype| - (>= #3# 0) - '(|NonNegativeInteger|) - #3#)))))))))))) - (COND - ((SPADCALL |p| |n| (|getShellEntry| $ 87)) - (COND - ((NOT (|ISTRING;suffix?;2$B;21| - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL (+ |p| 1) |n| - (|getShellEntry| $ 24)) - $) - |target| $)) - (EXIT NIL))))) - (EXIT T))))))))) + ((SPADCALL |p| |n| (|getShellEntry| $ 87)) + (COND + ((NOT (|ISTRING;suffix?;2$B;21| + (|ISTRING;elt;$Us$;31| |pattern| + (SPADCALL (+ |p| 1) |n| + (|getShellEntry| $ 24)) + $) + |target| $)) + (EXIT NIL))))) + (EXIT T)))))))))) (DEFUN |IndexedString| (#0=#:G1543) (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index 3eec6e6d..3f7d4cd1 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -74,34 +74,24 @@ (EXIT (SPADCALL |dev| (|getShellEntry| $ 24))))) (DEFUN |LIST;OMwrite;$S;6| (|x| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |LIST;OMwrite;$S;6|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$S;6|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 26)) - (|getShellEntry| $ 27)) - |LIST;OMwrite;$S;6|) - (SPADCALL |dev| (|getShellEntry| $ 28)) - (|LIST;writeOMList| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 29)) - (SPADCALL |dev| (|getShellEntry| $ 30)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 26)) + (|getShellEntry| $ 27)))) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 28)) + (|LIST;writeOMList| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 29)) + (SPADCALL |dev| (|getShellEntry| $ 30)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |LIST;OMwrite;$BS;7|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$BS;7|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 26)) - (|getShellEntry| $ 27)) - |LIST;OMwrite;$BS;7|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 28)))) - (|LIST;writeOMList| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 29)))) - (SPADCALL |dev| (|getShellEntry| $ 30)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 26)) + (|getShellEntry| $ 27)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 28)))) + (|LIST;writeOMList| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 29)))) + (SPADCALL |dev| (|getShellEntry| $ 30)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 28)) @@ -119,27 +109,23 @@ (|getShellEntry| $ 36))) (DEFUN |LIST;setIntersection;3$;11| (|l1| |l2| $) - (PROG (|u|) - (RETURN - (SEQ (LETT |u| (SPADCALL (|getShellEntry| $ 38)) - |LIST;setIntersection;3$;11|) - (SETQ |l1| (SPADCALL |l1| (|getShellEntry| $ 36))) - (LOOP - (COND - ((NOT (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) - (RETURN NIL)) - (T (SEQ (COND - ((SPADCALL - (SPADCALL |l1| (|getShellEntry| $ 20)) - |l2| (|getShellEntry| $ 40)) - (SETQ |u| - (CONS (SPADCALL |l1| - (|getShellEntry| $ 20)) - |u|)))) - (EXIT (SETQ |l1| - (SPADCALL |l1| - (|getShellEntry| $ 23)))))))) - (EXIT |u|))))) + (LET ((|u| (SPADCALL (|getShellEntry| $ 38)))) + (SEQ (SETQ |l1| (SPADCALL |l1| (|getShellEntry| $ 36))) + (LOOP + (COND + ((NOT (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) + (RETURN NIL)) + (T (SEQ (COND + ((SPADCALL + (SPADCALL |l1| (|getShellEntry| $ 20)) |l2| + (|getShellEntry| $ 40)) + (SETQ |u| + (CONS (SPADCALL |l1| + (|getShellEntry| $ 20)) + |u|)))) + (EXIT (SETQ |l1| + (SPADCALL |l1| (|getShellEntry| $ 23)))))))) + (EXIT |u|)))) (DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) (PROG (|lu| |l11|) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index 4709bc5a..a2d94892 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -213,55 +213,45 @@ (EXIT |r|)))))))) (DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) - (PROG (|m| |y| |z|) + (PROG (|y| |z|) (RETURN - (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33)) - |LSAGG-;insert!;SAIA;7|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) - (SPADCALL |s| |x| (|getShellEntry| $ 14))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (LET - ((#0=#:G1467 (- (- |i| 1) |m|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;insert!;SAIA;7|) - (LETT |z| - (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;insert!;SAIA;7|) - (SPADCALL |y| - (SPADCALL |s| |z| (|getShellEntry| $ 14)) - (|getShellEntry| $ 27)) - (EXIT |x|))))))))) + (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 33)))) + (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |s| |x| (|getShellEntry| $ 14))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (LET ((#0=#:G1467 (- (- |i| 1) |m|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;insert!;SAIA;7|) + (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) + |LSAGG-;insert!;SAIA;7|) + (SPADCALL |y| (SPADCALL |s| |z| (|getShellEntry| $ 14)) + (|getShellEntry| $ 27)) + (EXIT |x|)))))))) (DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) - (PROG (|m| |y| |z|) + (PROG (|y| |z|) (RETURN - (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33)) - |LSAGG-;insert!;2AIA;8|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) - (SPADCALL |w| |x| (|getShellEntry| $ 41))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (LET - ((#0=#:G1471 (- (- |i| 1) |m|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;insert!;2AIA;8|) - (LETT |z| - (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;insert!;2AIA;8|) - (SPADCALL |y| |w| (|getShellEntry| $ 27)) - (SPADCALL |y| |z| (|getShellEntry| $ 41)) - (EXIT |x|))))))))) + (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 33)))) + (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |w| |x| (|getShellEntry| $ 41))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (LET ((#0=#:G1471 (- (- |i| 1) |m|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;insert!;2AIA;8|) + (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) + |LSAGG-;insert!;2AIA;8|) + (SPADCALL |y| |w| (|getShellEntry| $ 27)) + (SPADCALL |y| |z| (|getShellEntry| $ 41)) (EXIT |x|)))))))) (DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) (PROG (|p| |q|) @@ -307,76 +297,64 @@ (EXIT |x|))))))))) (DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) - (PROG (|m| |y|) + (PROG (|y|) (RETURN - (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33)) - |LSAGG-;delete!;AIA;10|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) - (SPADCALL |x| (|getShellEntry| $ 17))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (LET - ((#0=#:G1483 (- (- |i| 1) |m|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;delete!;AIA;10|) - (SPADCALL |y| - (SPADCALL |y| 2 (|getShellEntry| $ 39)) - (|getShellEntry| $ 27)) - (EXIT |x|))))))))) + (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 33)))) + (COND + ((< |i| |m|) (|error| "index out of range")) + ((EQL |i| |m|) (SPADCALL |x| (|getShellEntry| $ 17))) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (LET ((#0=#:G1483 (- (- |i| 1) |m|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;delete!;AIA;10|) + (SPADCALL |y| (SPADCALL |y| 2 (|getShellEntry| $ 39)) + (|getShellEntry| $ 27)) + (EXIT |x|)))))))) (DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) - (PROG (|l| |m| |h| |t|) + (PROG (|h| |t|) (RETURN - (SEQ (LETT |l| (SPADCALL |i| (|getShellEntry| $ 46)) - |LSAGG-;delete!;AUsA;11|) - (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33)) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |l| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|getShellEntry| $ 47)) - (SPADCALL |i| (|getShellEntry| $ 48))) - ('T - (SPADCALL |x| (|getShellEntry| $ 49)))) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |h| |l|) |x|) - ((EQL |l| |m|) - (SPADCALL |x| + (LET* ((|l| (SPADCALL |i| (|getShellEntry| $ 46))) + (|m| (SPADCALL |x| (|getShellEntry| $ 33)))) + (COND + ((< |l| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (|getShellEntry| $ 47)) + (SPADCALL |i| (|getShellEntry| $ 48))) + ('T (SPADCALL |x| (|getShellEntry| $ 49)))) + |LSAGG-;delete!;AUsA;11|) + (EXIT (COND + ((< |h| |l|) |x|) + ((EQL |l| |m|) + (SPADCALL |x| + (LET ((#0=#:G1489 (- (+ |h| 1) |m|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39))) + ('T + (SEQ (LETT |t| + (SPADCALL |x| + (LET + ((#1=#:G1490 (- (- |l| 1) |m|))) + (|check-subtype| (>= #1# 0) + '(|NonNegativeInteger|) #1#)) + (|getShellEntry| $ 39)) + |LSAGG-;delete!;AUsA;11|) + (SPADCALL |t| + (SPADCALL |t| (LET - ((#0=#:G1489 (- (+ |h| 1) |m|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39))) - ('T - (SEQ (LETT |t| - (SPADCALL |x| - (LET - ((#1=#:G1490 - (- (- |l| 1) |m|))) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) - #1#)) - (|getShellEntry| $ 39)) - |LSAGG-;delete!;AUsA;11|) - (SPADCALL |t| - (SPADCALL |t| - (LET - ((#2=#:G1491 - (+ (- |h| |l|) 2))) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) - #2#)) - (|getShellEntry| $ 39)) - (|getShellEntry| $ 27)) - (EXIT |x|))))))))))))) + ((#2=#:G1491 (+ (- |h| |l|) 2))) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)) + (|getShellEntry| $ 39)) + (|getShellEntry| $ 27)) + (EXIT |x|)))))))))))) (DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) (SEQ (LOOP @@ -394,25 +372,22 @@ ('T (CONS 0 (SPADCALL |x| (|getShellEntry| $ 18)))))))) (DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) - (PROG (|k|) - (RETURN - (SEQ (LETT |k| (SPADCALL |x| (|getShellEntry| $ 33)) - |LSAGG-;position;MAI;13|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|))))) - (RETURN NIL)) - (T (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) - (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) - ('T |k|))))))) + (LET ((|k| (SPADCALL |x| (|getShellEntry| $ 33)))) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T + (NOT (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|))))) + (RETURN NIL)) + (T (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |k| (+ |k| 1))))))) + (EXIT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) + (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) + ('T |k|)))))) (DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) (PROG (|l| |q|) @@ -471,80 +446,66 @@ (EXIT T)))))))) (DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (SETQ |r| - (SPADCALL |r| - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|)) - (EXIT (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 17)))))))) - (EXIT |r|))))) + (LET ((|r| |i|)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (SETQ |r| + (SPADCALL |r| + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|)) + (EXIT (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 17)))))))) + (EXIT |r|)))) (DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T (SPADCALL |r| |a| (|getShellEntry| $ 61))))) - (RETURN NIL)) - (T (SEQ (SETQ |r| - (SPADCALL |r| - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|)) - (EXIT (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 17)))))))) - (EXIT |r|))))) + (LET ((|r| |i|)) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T (SPADCALL |r| |a| (|getShellEntry| $ 61))))) + (RETURN NIL)) + (T (SEQ (SETQ |r| + (SPADCALL |r| + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|)) + (EXIT (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 17)))))))) + (EXIT |r|)))) (DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| (SPADCALL (|getShellEntry| $ 13)) - |LSAGG-;new;NniSA;18|) - (LET ((|k| 1)) - (LOOP - (COND - ((> |k| |n|) (RETURN NIL)) - (T (SETQ |l| - (SPADCALL |s| |l| (|getShellEntry| $ 14))))) - (SETQ |k| (+ |k| 1)))) - (EXIT |l|))))) - -(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) - (PROG (|z|) - (RETURN - (SEQ (LETT |z| (SPADCALL (|getShellEntry| $ 13)) - |LSAGG-;map;M3A;19|) + (LET ((|l| (SPADCALL (|getShellEntry| $ 13)))) + (SEQ (LET ((|k| 1)) (LOOP (COND - ((NOT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) - (RETURN NIL)) - (T (SEQ (SETQ |z| - (SPADCALL - (SPADCALL - (SPADCALL |x| - (|getShellEntry| $ 18)) - (SPADCALL |y| - (|getShellEntry| $ 18)) - |f|) - |z| (|getShellEntry| $ 14))) - (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) - (EXIT (SETQ |y| + ((> |k| |n|) (RETURN NIL)) + (T (SETQ |l| (SPADCALL |s| |l| (|getShellEntry| $ 14))))) + (SETQ |k| (+ |k| 1)))) + (EXIT |l|)))) + +(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) + (LET ((|z| (SPADCALL (|getShellEntry| $ 13)))) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) + (RETURN NIL)) + (T (SEQ (SETQ |z| + (SPADCALL + (SPADCALL + (SPADCALL |x| + (|getShellEntry| $ 18)) (SPADCALL |y| - (|getShellEntry| $ 17)))))))) - (EXIT (SPADCALL |z| (|getShellEntry| $ 55))))))) + (|getShellEntry| $ 18)) + |f|) + |z| (|getShellEntry| $ 14))) + (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |y| + (SPADCALL |y| (|getShellEntry| $ 17)))))))) + (EXIT (SPADCALL |z| (|getShellEntry| $ 55)))))) (DEFUN |LSAGG-;reverse!;2A;20| (|x| $) (PROG (|z| |y|) @@ -575,125 +536,104 @@ (EXIT |x|)))))))) (DEFUN |LSAGG-;copy;2A;21| (|x| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| (SPADCALL (|getShellEntry| $ 13)) - |LSAGG-;copy;2A;21|) - (LET ((|k| 0)) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (|getShellEntry| $ 67)) - (EXIT (|error| "cyclic list")))))) - (SETQ |y| - (SPADCALL + (LET ((|y| (SPADCALL (|getShellEntry| $ 13)))) + (SEQ (LET ((|k| 0)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (|getShellEntry| $ 67)) + (EXIT (|error| "cyclic list")))))) + (SETQ |y| + (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) + |y| (|getShellEntry| $ 14))) + (EXIT (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 18)) - |y| (|getShellEntry| $ 14))) - (EXIT (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 17))))))) - (SETQ |k| (+ |k| 1)))) - (EXIT (SPADCALL |y| (|getShellEntry| $ 55))))))) + (|getShellEntry| $ 17))))))) + (SETQ |k| (+ |k| 1)))) + (EXIT (SPADCALL |y| (|getShellEntry| $ 55)))))) (DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) - (PROG (|m| |z|) + (PROG (|z|) (RETURN - (SEQ (LETT |m| (SPADCALL |y| (|getShellEntry| $ 33)) - |LSAGG-;copyInto!;2AIA;22|) - (EXIT (COND - ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |z| - (SPADCALL |y| - (LET ((#0=#:G1552 (- |s| |m|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;copyInto!;2AIA;22|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |z| - (|getShellEntry| $ 16)) - NIL) - ('T - (NOT - (SPADCALL |x| - (|getShellEntry| $ 16)))))) - (RETURN NIL)) - (T (SEQ (SPADCALL |z| - (SPADCALL |x| - (|getShellEntry| $ 18)) - (|getShellEntry| $ 69)) - (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 17))) - (EXIT - (SETQ |z| - (SPADCALL |z| - (|getShellEntry| $ 17)))))))) - (EXIT |y|))))))))) + (LET ((|m| (SPADCALL |y| (|getShellEntry| $ 33)))) + (COND + ((< |s| |m|) (|error| "index out of range")) + ('T + (SEQ (LETT |z| + (SPADCALL |y| + (LET ((#0=#:G1552 (- |s| |m|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39)) + |LSAGG-;copyInto!;2AIA;22|) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |z| (|getShellEntry| $ 16)) NIL) + ('T + (NOT (SPADCALL |x| (|getShellEntry| $ 16)))))) + (RETURN NIL)) + (T (SEQ (SPADCALL |z| + (SPADCALL |x| (|getShellEntry| $ 18)) + (|getShellEntry| $ 69)) + (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |z| + (SPADCALL |z| + (|getShellEntry| $ 17)))))))) + (EXIT |y|)))))))) (DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) - (PROG (|m| |k|) + (PROG (|k|) (RETURN - (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 33)) - |LSAGG-;position;SA2I;23|) - (EXIT (COND - ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (SETQ |x| - (SPADCALL |x| - (LET ((#0=#:G1559 (- |s| |m|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39))) - (LETT |k| |s| |LSAGG-;position;SA2I;23|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |x| - (|getShellEntry| $ 16)) - NIL) - ('T - (SPADCALL |w| - (SPADCALL |x| - (|getShellEntry| $ 18)) - (|getShellEntry| $ 61))))) - (RETURN NIL)) - (T (SEQ (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 17))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) - (- (SPADCALL |x| - (|getShellEntry| $ 33)) - 1)) - ('T |k|))))))))))) + (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 33)))) + (COND + ((< |s| |m|) (|error| "index out of range")) + ('T + (SEQ (SETQ |x| + (SPADCALL |x| + (LET ((#0=#:G1559 (- |s| |m|))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 39))) + (LETT |k| |s| |LSAGG-;position;SA2I;23|) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T + (SPADCALL |w| + (SPADCALL |x| (|getShellEntry| $ 18)) + (|getShellEntry| $ 61))))) + (RETURN NIL)) + (T (SEQ (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |k| (+ |k| 1))))))) + (EXIT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) + (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) + ('T |k|)))))))))) (DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) - (PROG (|p|) - (RETURN - (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) - (RETURN NIL)) - (T (SETQ |p| - (SPADCALL |p| - (SPADCALL - (CONS #'|LSAGG-;removeDuplicates!;2A;24!0| - (VECTOR $ |p|)) - (SPADCALL |p| (|getShellEntry| $ 17)) - (|getShellEntry| $ 73)) - (|getShellEntry| $ 27)))))) - (EXIT |l|))))) + (LET ((|p| |l|)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SETQ |p| + (SPADCALL |p| + (SPADCALL + (CONS #'|LSAGG-;removeDuplicates!;2A;24!0| + (VECTOR $ |p|)) + (SPADCALL |p| (|getShellEntry| $ 17)) + (|getShellEntry| $ 73)) + (|getShellEntry| $ 27)))))) + (EXIT |l|)))) (DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) (LET (($ (|getShellEntry| $$ 0))) diff --git a/src/algebra/strap/NNI.lsp b/src/algebra/strap/NNI.lsp index 5419507e..184b8ab6 100644 --- a/src/algebra/strap/NNI.lsp +++ b/src/algebra/strap/NNI.lsp @@ -31,15 +31,12 @@ (ASH |x| |n|)) (DEFUN |NNI;subtractIfCan;2$U;3| (|x| |y| $) - (PROG (|c|) - (RETURN - (SEQ (LETT |c| (- |x| |y|) |NNI;subtractIfCan;2$U;3|) - (EXIT (COND - ((< |c| 0) (CONS 1 "failed")) - ('T - (CONS 0 - (|check-subtype| (>= |c| 0) - '(|NonNegativeInteger|) |c|))))))))) + (LET ((|c| (- |x| |y|))) + (COND + ((< |c| 0) (CONS 1 "failed")) + ('T + (CONS 0 + (|check-subtype| (>= |c| 0) '(|NonNegativeInteger|) |c|)))))) (DEFUN |NonNegativeInteger| () (DECLARE (SPECIAL |$ConstructorCache|)) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 70ac70a6..6244906c 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -526,11 +526,8 @@ '(XLAM (|a|) (LIST 'SUPERSUB |a| " " '|,|))) (DEFUN |OUTFORM;doubleFloatFormat;2S;1| (|s| $) - (PROG (|ss|) - (RETURN - (SEQ (LETT |ss| (|getShellEntry| $ 6) - |OUTFORM;doubleFloatFormat;2S;1|) - (|setShellEntry| $ 6 |s|) (EXIT |ss|))))) + (LET ((|ss| (|getShellEntry| $ 6))) + (SEQ (|setShellEntry| $ 6 |s|) (EXIT |ss|)))) (DEFUN |OUTFORM;sform| (|s| $) (DECLARE (IGNORE $)) |s|) @@ -638,18 +635,14 @@ (|OUTFORM;rspace;2I$;30| |n| (- |m| 1) $) $)))) (DEFUN |OUTFORM;matrix;L$;31| (|ll| $) - (PROG (|lv|) - (RETURN - (SEQ (LETT |lv| - (LET ((#0=#:G1554 |ll|) (#1=#:G1553 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|l| (CAR #0#))) - (SETQ #1# (CONS (LIST2VEC |l|) #1#))))) - (SETQ #0# (CDR #0#)))) - |OUTFORM;matrix;L$;31|) - (EXIT (CONS 'MATRIX (LIST2VEC |lv|))))))) + (LET ((|lv| (LET ((#0=#:G1554 |ll|) (#1=#:G1553 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|l| (CAR #0#))) + (SETQ #1# (CONS (LIST2VEC |l|) #1#))))) + (SETQ #0# (CDR #0#)))))) + (CONS 'MATRIX (LIST2VEC |lv|)))) (DEFUN |OUTFORM;pile;L$;32| (|l| $) (DECLARE (IGNORE $)) @@ -664,21 +657,18 @@ (CONS 'AGGSET |l|)) (DEFUN |OUTFORM;blankSeparate;L$;35| (|l| $) - (PROG (|c| |l1|) - (RETURN - (SEQ (LETT |c| 'CONCATB |OUTFORM;blankSeparate;L$;35|) - (LETT |l1| NIL |OUTFORM;blankSeparate;L$;35|) - (LET ((#0=#:G1555 (REVERSE |l|))) - (LOOP - (COND - ((ATOM #0#) (RETURN NIL)) - (T (LET ((|u| (CAR #0#))) - (COND - ((EQCAR |u| |c|) - (SETQ |l1| (APPEND (CDR |u|) |l1|))) - ('T (SETQ |l1| (CONS |u| |l1|))))))) - (SETQ #0# (CDR #0#)))) - (EXIT (CONS |c| |l1|)))))) + (LET* ((|c| 'CONCATB) (|l1| NIL)) + (SEQ (LET ((#0=#:G1555 (REVERSE |l|))) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|u| (CAR #0#))) + (COND + ((EQCAR |u| |c|) + (SETQ |l1| (APPEND (CDR |u|) |l1|))) + ('T (SETQ |l1| (CONS |u| |l1|))))))) + (SETQ #0# (CDR #0#)))) + (EXIT (CONS |c| |l1|))))) (DEFUN |OUTFORM;brace;2$;36| (|a| $) (DECLARE (IGNORE $)) @@ -831,15 +821,11 @@ (DEFUN |OUTFORM;empty;$;73| ($) (LIST 'NOTHING)) (DEFUN |OUTFORM;infix?;$B;74| (|a| $) - (PROG (|e|) - (RETURN - (SEQ (LETT |e| - (COND - ((IDENTP |a|) |a|) - ((STRINGP |a|) (INTERN |a|)) - ('T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL))) - |OUTFORM;infix?;$B;74|) - (EXIT (COND ((GET |e| 'INFIXOP) T) ('T NIL))))))) + (LET ((|e| (COND + ((IDENTP |a|) |a|) + ((STRINGP |a|) (INTERN |a|)) + ('T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL))))) + (COND ((GET |e| 'INFIXOP) T) ('T NIL)))) (DEFUN |OUTFORM;elt;$L$;75| (|a| |l| $) (DECLARE (IGNORE $)) @@ -893,22 +879,14 @@ (LIST 'SUPERSUB |a| " " '|,|)) (DEFUN |OUTFORM;dot;$Nni$;85| (|a| |nn| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| - (MAKE-FULL-CVEC |nn| - (SPADCALL "." (|getShellEntry| $ 119))) - |OUTFORM;dot;$Nni$;85|) - (EXIT (LIST 'SUPERSUB |a| " " |s|)))))) + (LET ((|s| (MAKE-FULL-CVEC |nn| + (SPADCALL "." (|getShellEntry| $ 119))))) + (LIST 'SUPERSUB |a| " " |s|))) (DEFUN |OUTFORM;prime;$Nni$;86| (|a| |nn| $) - (PROG (|s|) - (RETURN - (SEQ (LETT |s| - (MAKE-FULL-CVEC |nn| - (SPADCALL "," (|getShellEntry| $ 119))) - |OUTFORM;prime;$Nni$;86|) - (EXIT (LIST 'SUPERSUB |a| " " |s|)))))) + (LET ((|s| (MAKE-FULL-CVEC |nn| + (SPADCALL "," (|getShellEntry| $ 119))))) + (LIST 'SUPERSUB |a| " " |s|))) (DEFUN |OUTFORM;overlabel;3$;87| (|a| |b| $) (DECLARE (IGNORE $)) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 36bc9506..ca4bdc5f 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -194,22 +194,18 @@ (|getShellEntry| $ 21)))))))))) (DEFUN |POLYCAT-;monomials;SL;2| (|p| $) - (PROG (|ml|) - (RETURN - (SEQ (LETT |ml| NIL |POLYCAT-;monomials;SL;2|) - (LOOP - (COND - ((NOT (SPADCALL |p| (|spadConstant| $ 27) - (|getShellEntry| $ 29))) - (RETURN NIL)) - (T (SEQ (SETQ |ml| - (CONS (SPADCALL |p| - (|getShellEntry| $ 30)) - |ml|)) - (EXIT (SETQ |p| - (SPADCALL |p| - (|getShellEntry| $ 32)))))))) - (EXIT (REVERSE |ml|)))))) + (LET ((|ml| NIL)) + (SEQ (LOOP + (COND + ((NOT (SPADCALL |p| (|spadConstant| $ 27) + (|getShellEntry| $ 29))) + (RETURN NIL)) + (T (SEQ (SETQ |ml| + (CONS (SPADCALL |p| (|getShellEntry| $ 30)) + |ml|)) + (EXIT (SETQ |p| + (SPADCALL |p| (|getShellEntry| $ 32)))))))) + (EXIT (REVERSE |ml|))))) (DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) (PROG (|l|) @@ -263,23 +259,21 @@ |l|)))))))))))) (DEFUN |POLYCAT-;isExpt;SU;5| (|p| $) - (PROG (|u| |d|) + (PROG (|d|) (RETURN - (SEQ (LETT |u| (SPADCALL |p| (|getShellEntry| $ 53)) - |POLYCAT-;isExpt;SU;5|) - (EXIT (COND - ((OR (EQL (CAR |u|) 1) - (NOT (SPADCALL |p| - (SPADCALL (|spadConstant| $ 43) - (CDR |u|) - (LETT |d| - (SPADCALL |p| (CDR |u|) - (|getShellEntry| $ 46)) - |POLYCAT-;isExpt;SU;5|) - (|getShellEntry| $ 47)) - (|getShellEntry| $ 54)))) - (CONS 1 "failed")) - ('T (CONS 0 (CONS (CDR |u|) |d|))))))))) + (LET ((|u| (SPADCALL |p| (|getShellEntry| $ 53)))) + (COND + ((OR (EQL (CAR |u|) 1) + (NOT (SPADCALL |p| + (SPADCALL (|spadConstant| $ 43) (CDR |u|) + (LETT |d| + (SPADCALL |p| (CDR |u|) + (|getShellEntry| $ 46)) + |POLYCAT-;isExpt;SU;5|) + (|getShellEntry| $ 47)) + (|getShellEntry| $ 54)))) + (CONS 1 "failed")) + ('T (CONS 0 (CONS (CDR |u|) |d|)))))))) (DEFUN |POLYCAT-;coefficient;SVarSetNniS;6| (|p| |v| |n| $) (SPADCALL (SPADCALL |p| |v| (|getShellEntry| $ 59)) |n| @@ -313,20 +307,15 @@ (CDR |lv|) (CDR |ln|) (|getShellEntry| $ 70))))) (DEFUN |POLYCAT-;retract;SVarSet;9| (|p| $) - (PROG (|q|) - (RETURN - (SEQ (LETT |q| - (LET ((#0=#:G1478 - (SPADCALL |p| (|getShellEntry| $ 53)))) - (|check-union| (EQL (CAR #0#) 0) - (|getShellEntry| $ 9) #0#) - (CDR #0#)) - |POLYCAT-;retract;SVarSet;9|) - (EXIT (COND - ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 72)) |p| - (|getShellEntry| $ 54)) - |q|) - ('T (|error| "Polynomial is not a single variable")))))))) + (LET ((|q| (LET ((#0=#:G1478 (SPADCALL |p| (|getShellEntry| $ 53)))) + (|check-union| (EQL (CAR #0#) 0) (|getShellEntry| $ 9) + #0#) + (CDR #0#)))) + (COND + ((SPADCALL (SPADCALL |q| (|getShellEntry| $ 72)) |p| + (|getShellEntry| $ 54)) + |q|) + ('T (|error| "Polynomial is not a single variable"))))) (DEFUN |POLYCAT-;retractIfCan;SU;10| (|p| $) (PROG (|q| #0=#:G1486) @@ -467,25 +456,20 @@ (|getShellEntry| $ 100))) (DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) - (PROG (|w|) - (RETURN - (SEQ (LETT |w| - (SPADCALL |n| (|spadConstant| $ 28) - (|getShellEntry| $ 102)) - |POLYCAT-;P2R|) - (LET ((|i| (SPADCALL |w| (|getShellEntry| $ 104))) - (#0=#:G1702 (|sizeOfSimpleArray| |w|)) - (#1=#:G1703 |b|)) - (LOOP - (COND - ((OR (> |i| #0#) (ATOM #1#)) (RETURN NIL)) - (T (LET ((|bj| (CAR #1#))) - (SPADCALL |w| |i| - (SPADCALL |p| |bj| (|getShellEntry| $ 106)) - (|getShellEntry| $ 107))))) - (SETQ |i| (+ |i| 1)) - (SETQ #1# (CDR #1#)))) - (EXIT |w|))))) + (LET ((|w| (SPADCALL |n| (|spadConstant| $ 28) + (|getShellEntry| $ 102)))) + (SEQ (LET ((|i| (SPADCALL |w| (|getShellEntry| $ 104))) + (#0=#:G1702 (|sizeOfSimpleArray| |w|)) (#1=#:G1703 |b|)) + (LOOP + (COND + ((OR (> |i| #0#) (ATOM #1#)) (RETURN NIL)) + (T (LET ((|bj| (CAR #1#))) + (SPADCALL |w| |i| + (SPADCALL |p| |bj| (|getShellEntry| $ 106)) + (|getShellEntry| $ 107))))) + (SETQ |i| (+ |i| 1)) + (SETQ #1# (CDR #1#)))) + (EXIT |w|)))) (DEFUN |POLYCAT-;eq2R| (|l| |b| $) (SPADCALL @@ -512,111 +496,92 @@ (|getShellEntry| $ 111))) (DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) - (PROG (|l| |b| |d| |mm|) - (RETURN - (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 114)) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |b| - (SPADCALL - (SPADCALL - (LET ((#0=#:G1709 |l|) (#1=#:G1708 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|r| (CAR #0#))) - (SETQ #1# - (CONS (|POLYCAT-;allMonoms| |r| $) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|getShellEntry| $ 99)) - (|getShellEntry| $ 100)) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |d| - (LET ((#2=#:G1711 |b|) (#3=#:G1710 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|bj| (CAR #2#))) - (SETQ #3# - (CONS (SPADCALL |bj| - (|getShellEntry| $ 75)) - #3#))))) - (SETQ #2# (CDR #2#)))) - |POLYCAT-;reducedSystem;MM;20|) - (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) - |POLYCAT-;reducedSystem;MM;20|) - (SETQ |l| (CDR |l|)) - (LOOP - (COND - ((NOT (NOT (NULL |l|))) (RETURN NIL)) - (T (SEQ (SETQ |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|getShellEntry| $ 119))) - (EXIT (SETQ |l| (CDR |l|))))))) - (EXIT |mm|))))) - -(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) - (PROG (|l| |r| |b| |d| |n| |mm| |w|) - (RETURN - (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 114)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |r| (SPADCALL |v| (|getShellEntry| $ 123)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |b| - (SPADCALL - (SPADCALL (|POLYCAT-;allMonoms| |r| $) - (SPADCALL - (LET ((#0=#:G1713 |l|) (#1=#:G1712 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T - (LET ((|s| (CAR #0#))) - (SETQ #1# + (LET* ((|l| (SPADCALL |m| (|getShellEntry| $ 114))) + (|b| (SPADCALL + (SPADCALL + (LET ((#0=#:G1709 |l|) (#1=#:G1708 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|r| (CAR #0#))) + (SETQ #1# (CONS - (|POLYCAT-;allMonoms| |s| $) + (|POLYCAT-;allMonoms| |r| $) #1#))))) - (SETQ #0# (CDR #0#)))) - (|getShellEntry| $ 99)) - (|getShellEntry| $ 124)) - (|getShellEntry| $ 100)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |d| - (LET ((#2=#:G1715 |b|) (#3=#:G1714 NIL)) - (LOOP - (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|bj| (CAR #2#))) - (SETQ #3# - (CONS (SPADCALL |bj| - (|getShellEntry| $ 75)) - #3#))))) - (SETQ #2# (CDR #2#)))) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |n| (LENGTH |d|) |POLYCAT-;reducedSystem;MVR;21|) - (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $) - |POLYCAT-;reducedSystem;MVR;21|) - (SETQ |l| (CDR |l|)) (SETQ |r| (CDR |r|)) - (LOOP - (COND - ((NOT (NOT (NULL |l|))) (RETURN NIL)) - (T (SEQ (SETQ |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|getShellEntry| $ 119))) - (SETQ |w| - (SPADCALL |w| - (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| - |n| $) - (|getShellEntry| $ 128))) - (SETQ |l| (CDR |l|)) - (EXIT (SETQ |r| (CDR |r|))))))) - (EXIT (CONS |mm| |w|)))))) + (SETQ #0# (CDR #0#)))) + (|getShellEntry| $ 99)) + (|getShellEntry| $ 100))) + (|d| (LET ((#2=#:G1711 |b|) (#3=#:G1710 NIL)) + (LOOP + (COND + ((ATOM #2#) (RETURN (NREVERSE #3#))) + (T (LET ((|bj| (CAR #2#))) + (SETQ #3# + (CONS (SPADCALL |bj| + (|getShellEntry| $ 75)) + #3#))))) + (SETQ #2# (CDR #2#))))) + (|mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $))) + (SEQ (SETQ |l| (CDR |l|)) + (LOOP + (COND + ((NOT (NOT (NULL |l|))) (RETURN NIL)) + (T (SEQ (SETQ |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 119))) + (EXIT (SETQ |l| (CDR |l|))))))) + (EXIT |mm|)))) + +(DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) + (LET* ((|l| (SPADCALL |m| (|getShellEntry| $ 114))) + (|r| (SPADCALL |v| (|getShellEntry| $ 123))) + (|b| (SPADCALL + (SPADCALL (|POLYCAT-;allMonoms| |r| $) + (SPADCALL + (LET ((#0=#:G1713 |l|) (#1=#:G1712 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|s| (CAR #0#))) + (SETQ #1# + (CONS + (|POLYCAT-;allMonoms| |s| $) + #1#))))) + (SETQ #0# (CDR #0#)))) + (|getShellEntry| $ 99)) + (|getShellEntry| $ 124)) + (|getShellEntry| $ 100))) + (|d| (LET ((#2=#:G1715 |b|) (#3=#:G1714 NIL)) + (LOOP + (COND + ((ATOM #2#) (RETURN (NREVERSE #3#))) + (T (LET ((|bj| (CAR #2#))) + (SETQ #3# + (CONS (SPADCALL |bj| + (|getShellEntry| $ 75)) + #3#))))) + (SETQ #2# (CDR #2#))))) + (|n| (LENGTH |d|)) + (|mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $)) + (|w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $))) + (SEQ (SETQ |l| (CDR |l|)) (SETQ |r| (CDR |r|)) + (LOOP + (COND + ((NOT (NOT (NULL |l|))) (RETURN NIL)) + (T (SEQ (SETQ |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 119))) + (SETQ |w| + (SPADCALL |w| + (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| + |n| $) + (|getShellEntry| $ 128))) + (SETQ |l| (CDR |l|)) (EXIT (SETQ |r| (CDR |r|))))))) + (EXIT (CONS |mm| |w|))))) (DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) (SPADCALL |pp| |qq| (|getShellEntry| $ 133))) @@ -631,139 +596,122 @@ (SPADCALL |pp| (|getShellEntry| $ 146))) (DEFUN |POLYCAT-;factor;SF;26| (|p| $) - (PROG (|v| |ansR| |up| |ansSUP|) + (PROG (|ansR| |up| |ansSUP|) (RETURN - (SEQ (LETT |v| (SPADCALL |p| (|getShellEntry| $ 53)) - |POLYCAT-;factor;SF;26|) - (EXIT (COND - ((EQL (CAR |v|) 1) - (SEQ (LETT |ansR| - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 48)) - (|getShellEntry| $ 149)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL + (LET ((|v| (SPADCALL |p| (|getShellEntry| $ 53)))) + (COND + ((EQL (CAR |v|) 1) + (SEQ (LETT |ansR| + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 48)) + (|getShellEntry| $ 149)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansR| (|getShellEntry| $ 151)) + (|getShellEntry| $ 51)) + (LET ((#0=#:G1717 (SPADCALL |ansR| - (|getShellEntry| $ 151)) - (|getShellEntry| $ 51)) - (LET - ((#0=#:G1717 - (SPADCALL |ansR| - (|getShellEntry| $ 155))) - (#1=#:G1716 NIL)) - (LOOP - (COND - ((ATOM #0#) - (RETURN (NREVERSE #1#))) - (T - (LET ((|w| (CAR #0#))) - (SETQ #1# - (CONS - (VECTOR (QVELT |w| 0) - (SPADCALL (QVELT |w| 1) - (|getShellEntry| $ 51)) - (QVELT |w| 2)) - #1#))))) - (SETQ #0# (CDR #0#)))) - (|getShellEntry| $ 159))))) - ('T - (SEQ (LETT |up| - (SPADCALL |p| (CDR |v|) - (|getShellEntry| $ 59)) - |POLYCAT-;factor;SF;26|) - (LETT |ansSUP| - (SPADCALL |up| (|getShellEntry| $ 143)) - |POLYCAT-;factor;SF;26|) - (EXIT (SPADCALL - (SPADCALL + (|getShellEntry| $ 155))) + (#1=#:G1716 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|w| (CAR #0#))) + (SETQ #1# + (CONS + (VECTOR (QVELT |w| 0) + (SPADCALL (QVELT |w| 1) + (|getShellEntry| $ 51)) + (QVELT |w| 2)) + #1#))))) + (SETQ #0# (CDR #0#)))) + (|getShellEntry| $ 159))))) + ('T + (SEQ (LETT |up| + (SPADCALL |p| (CDR |v|) (|getShellEntry| $ 59)) + |POLYCAT-;factor;SF;26|) + (LETT |ansSUP| (SPADCALL |up| (|getShellEntry| $ 143)) + |POLYCAT-;factor;SF;26|) + (EXIT (SPADCALL + (SPADCALL + (SPADCALL |ansSUP| + (|getShellEntry| $ 160)) + (CDR |v|) (|getShellEntry| $ 161)) + (LET ((#2=#:G1719 (SPADCALL |ansSUP| - (|getShellEntry| $ 160)) - (CDR |v|) (|getShellEntry| $ 161)) - (LET - ((#2=#:G1719 - (SPADCALL |ansSUP| - (|getShellEntry| $ 164))) - (#3=#:G1718 NIL)) - (LOOP - (COND - ((ATOM #2#) - (RETURN (NREVERSE #3#))) - (T - (LET ((|ww| (CAR #2#))) - (SETQ #3# - (CONS - (VECTOR (QVELT |ww| 0) - (SPADCALL (QVELT |ww| 1) - (CDR |v|) - (|getShellEntry| $ 161)) - (QVELT |ww| 2)) - #3#))))) - (SETQ #2# (CDR #2#)))) - (|getShellEntry| $ 159))))))))))) + (|getShellEntry| $ 164))) + (#3=#:G1718 NIL)) + (LOOP + (COND + ((ATOM #2#) (RETURN (NREVERSE #3#))) + (T (LET ((|ww| (CAR #2#))) + (SETQ #3# + (CONS + (VECTOR (QVELT |ww| 0) + (SPADCALL (QVELT |ww| 1) + (CDR |v|) + (|getShellEntry| $ 161)) + (QVELT |ww| 2)) + #3#))))) + (SETQ #2# (CDR #2#)))) + (|getShellEntry| $ 159)))))))))) (DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) - (PROG (|nd| |vars| |degs| |deg1| |mons| |redmons| |ll| |llR| - |monslist| |ch| |ans| |i|) + (PROG (|nd| |vars| |degs| |deg1| |mons| |redmons| |ans| |i|) (RETURN - (SEQ (LETT |ll| - (SPADCALL (SPADCALL |mat| (|getShellEntry| $ 166)) - (|getShellEntry| $ 114)) - |POLYCAT-;conditionP;MU;27|) - (LETT |llR| - (LET ((#0=#:G1721 (|SPADfirst| |ll|)) - (#1=#:G1720 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|z| (CAR #0#))) - (SETQ #1# (CONS NIL #1#))))) - (SETQ #0# (CDR #0#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |monslist| NIL |POLYCAT-;conditionP;MU;27|) - (LETT |ch| (|spadConstant| $ 169) - |POLYCAT-;conditionP;MU;27|) - (LET ((#2=#:G1722 |ll|)) - (LOOP - (COND - ((ATOM #2#) (RETURN NIL)) - (T (LET ((|l| (CAR #2#))) - (SEQ (LETT |mons| - (LET ((#3=#:G1582 NIL) (#4=#:G1583 T) - (#5=#:G1723 |l|)) - (LOOP - (COND - ((ATOM #5#) - (RETURN - (COND - (#4# - (|IdentityError| - '|setUnion|)) - (T #3#)))) - (T - (LET ((|u| (CAR #5#))) - (LET - ((#6=#:G1581 - (SPADCALL |u| - (|getShellEntry| $ 98)))) + (LET* ((|ll| (SPADCALL (SPADCALL |mat| (|getShellEntry| $ 166)) + (|getShellEntry| $ 114))) + (|llR| (LET ((#0=#:G1731 (|SPADfirst| |ll|)) + (#1=#:G1730 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|z| (CAR #0#))) + (SETQ #1# (CONS NIL #1#))))) + (SETQ #0# (CDR #0#))))) + (|monslist| NIL) (|ch| (|spadConstant| $ 169))) + (SEQ (LET ((#2=#:G1720 |ll|)) + (LOOP + (COND + ((ATOM #2#) (RETURN NIL)) + (T (LET ((|l| (CAR #2#))) + (SEQ (LETT |mons| + (LET + ((#3=#:G1582 NIL) (#4=#:G1583 T) + (#5=#:G1721 |l|)) + (LOOP + (COND + ((ATOM #5#) + (RETURN (COND - (#4# (SETQ #3# #6#)) - (T - (SETQ #3# - (SPADCALL #3# #6# - (|getShellEntry| $ - 170))))) - (SETQ #4# NIL))))) - (SETQ #5# (CDR #5#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| NIL - |POLYCAT-;conditionP;MU;27|) - (LET ((#7=#:G1724 |mons|)) - (LOOP - (COND - ((ATOM #7#) (RETURN NIL)) - (T (LET ((|m| (CAR #7#))) + (#4# + (|IdentityError| + '|setUnion|)) + (T #3#)))) + (T + (LET ((|u| (CAR #5#))) + (LET + ((#6=#:G1581 + (SPADCALL |u| + (|getShellEntry| $ 98)))) + (COND + (#4# (SETQ #3# #6#)) + (T + (SETQ #3# + (SPADCALL #3# #6# + (|getShellEntry| $ + 170))))) + (SETQ #4# NIL))))) + (SETQ #5# (CDR #5#)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |redmons| NIL + |POLYCAT-;conditionP;MU;27|) + (LET ((#7=#:G1722 |mons|)) + (LOOP + (COND + ((ATOM #7#) (RETURN NIL)) + (T + (LET ((|m| (CAR #7#))) (SEQ (LETT |vars| (SPADCALL |m| @@ -775,8 +723,8 @@ |POLYCAT-;conditionP;MU;27|) (LETT |deg1| (LET - ((#8=#:G1726 |degs|) - (#9=#:G1725 NIL)) + ((#8=#:G1724 |degs|) + (#9=#:G1723 NIL)) (LOOP (COND ((ATOM #8#) @@ -820,9 +768,9 @@ (EXIT (SETQ |llR| (LET - ((#11=#:G1728 |l|) - (#12=#:G1729 |llR|) - (#13=#:G1727 NIL)) + ((#11=#:G1726 |l|) + (#12=#:G1727 |llR|) + (#13=#:G1725 NIL)) (LOOP (COND ((OR (ATOM #11#) @@ -847,120 +795,120 @@ #13#))))) (SETQ #11# (CDR #11#)) (SETQ #12# (CDR #12#)))))))))) - (SETQ #7# (CDR #7#)))) - (EXIT (SETQ |monslist| - (CONS |redmons| |monslist|))))))) - (SETQ #2# (CDR #2#)))) - (LETT |ans| - (SPADCALL - (SPADCALL (SPADCALL |llR| (|getShellEntry| $ 111)) - (|getShellEntry| $ 178)) - (|getShellEntry| $ 180)) - |POLYCAT-;conditionP;MU;27|) - (EXIT (COND - ((EQL (CAR |ans|) 1) (CONS 1 "failed")) - ('T - (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|) - (EXIT (CONS 0 - (LET - ((#14=#:G1611 - (|makeSimpleArray| - (|getVMType| - (|getShellEntry| $ 6)) - (SIZE |monslist|)))) + (SETQ #7# (CDR #7#)))) + (EXIT (SETQ |monslist| + (CONS |redmons| |monslist|))))))) + (SETQ #2# (CDR #2#)))) + (LETT |ans| + (SPADCALL + (SPADCALL + (SPADCALL |llR| (|getShellEntry| $ 111)) + (|getShellEntry| $ 178)) + (|getShellEntry| $ 180)) + |POLYCAT-;conditionP;MU;27|) + (EXIT (COND + ((EQL (CAR |ans|) 1) (CONS 1 "failed")) + ('T + (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|) + (EXIT (CONS 0 (LET - ((#15=#:G1730 |monslist|) - (#16=#:G1610 0)) - (LOOP - (COND - ((ATOM #15#) - (RETURN #14#)) - (T - (LET - ((|mons| (CAR #15#))) - (|setSimpleArrayEntry| - #14# #16# - (LET - ((#17=#:G1604 NIL) - (#18=#:G1605 T) - (#19=#:G1731 |mons|)) - (LOOP - (COND - ((ATOM #19#) - (RETURN - (COND - (#18# - (|spadConstant| - $ 27)) - (T #17#)))) - (T - (LET - ((|m| - (CAR #19#))) - (LET - ((#20=#:G1603 - (SPADCALL - |m| - (SPADCALL - (SPADCALL - (CDR - |ans|) - (SETQ - |i| - (+ |i| - 1)) - (|getShellEntry| - $ 181)) - (|getShellEntry| - $ 51)) - (|getShellEntry| - $ 182)))) + ((#14=#:G1611 + (|makeSimpleArray| + (|getVMType| + (|getShellEntry| $ 6)) + (SIZE |monslist|)))) + (LET + ((#15=#:G1728 |monslist|) + (#16=#:G1610 0)) + (LOOP + (COND + ((ATOM #15#) + (RETURN #14#)) + (T + (LET + ((|mons| (CAR #15#))) + (|setSimpleArrayEntry| + #14# #16# + (LET + ((#17=#:G1604 NIL) + (#18=#:G1605 T) + (#19=#:G1729 + |mons|)) + (LOOP + (COND + ((ATOM #19#) + (RETURN (COND (#18# - (SETQ - #17# - #20#)) - (T - (SETQ - #17# + (|spadConstant| + $ 27)) + (T #17#)))) + (T + (LET + ((|m| + (CAR #19#))) + (LET + ((#20=#:G1603 + (SPADCALL + |m| (SPADCALL - #17# - #20# + (SPADCALL + (CDR + |ans|) + (SETQ + |i| + (+ + |i| + 1)) + (|getShellEntry| + $ + 181)) (|getShellEntry| - $ - 183))))) - (SETQ #18# - NIL))))) - (SETQ #19# - (CDR #19#)))))))) - (SETQ #15# (CDR #15#)) - (SETQ #16# (+ #16# 1))))))))))))))) + $ 51)) + (|getShellEntry| + $ 182)))) + (COND + (#18# + (SETQ + #17# + #20#)) + (T + (SETQ + #17# + (SPADCALL + #17# + #20# + (|getShellEntry| + $ + 183))))) + (SETQ + #18# + NIL))))) + (SETQ #19# + (CDR #19#)))))))) + (SETQ #15# (CDR #15#)) + (SETQ #16# (+ #16# 1)))))))))))))))) (DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $) - (PROG (|vars| |ans| |ch|) + (PROG (|ans| |ch|) (RETURN - (SEQ (LETT |vars| (SPADCALL |p| (|getShellEntry| $ 40)) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (COND - ((NULL |vars|) - (SEQ (LETT |ans| - (SPADCALL - (SPADCALL |p| - (|getShellEntry| $ 175)) - (|getShellEntry| $ 185)) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (COND - ((EQL (CAR |ans|) 1) - (CONS 1 "failed")) - ('T - (CONS 0 - (SPADCALL (CDR |ans|) - (|getShellEntry| $ 51)))))))) - ('T - (SEQ (LETT |ch| (|spadConstant| $ 169) - |POLYCAT-;charthRoot;SU;28|) - (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| - $)))))))))) + (LET ((|vars| (SPADCALL |p| (|getShellEntry| $ 40)))) + (COND + ((NULL |vars|) + (SEQ (LETT |ans| + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 175)) + (|getShellEntry| $ 185)) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (COND + ((EQL (CAR |ans|) 1) (CONS 1 "failed")) + ('T + (CONS 0 + (SPADCALL (CDR |ans|) + (|getShellEntry| $ 51)))))))) + ('T + (SEQ (LETT |ch| (|spadConstant| $ 169) + |POLYCAT-;charthRoot;SU;28|) + (EXIT (|POLYCAT-;charthRootlv| |p| |vars| |ch| $))))))))) (DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) (PROG (|v| |d| |ans| |dd| |cp| |ansx|) @@ -1054,18 +1002,12 @@ (|getShellEntry| $ 183)))))))))))))) (DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $) - (PROG (|result|) - (RETURN - (SEQ (LETT |result| - (SPADCALL - (SPADCALL |p1| |mvar| (|getShellEntry| $ 59)) - (SPADCALL |p2| |mvar| (|getShellEntry| $ 59)) - (|getShellEntry| $ 191)) - |POLYCAT-;monicDivide;2SVarSetR;30|) - (EXIT (CONS (SPADCALL (CAR |result|) |mvar| - (|getShellEntry| $ 161)) - (SPADCALL (CDR |result|) |mvar| - (|getShellEntry| $ 161)))))))) + (LET ((|result| + (SPADCALL (SPADCALL |p1| |mvar| (|getShellEntry| $ 59)) + (SPADCALL |p2| |mvar| (|getShellEntry| $ 59)) + (|getShellEntry| $ 191)))) + (CONS (SPADCALL (CAR |result|) |mvar| (|getShellEntry| $ 161)) + (SPADCALL (CDR |result|) |mvar| (|getShellEntry| $ 161))))) (DEFUN |POLYCAT-;squareFree;SF;31| (|p| $) (SPADCALL |p| (|getShellEntry| $ 194))) @@ -1130,26 +1072,21 @@ 1)) (DEFUN |POLYCAT-;before?;2SB;38| (|p| |q| $) - (PROG (|dp| |dq|) - (RETURN - (SEQ (LETT |dp| (SPADCALL |p| (|getShellEntry| $ 75)) - |POLYCAT-;before?;2SB;38|) - (LETT |dq| (SPADCALL |q| (|getShellEntry| $ 75)) - |POLYCAT-;before?;2SB;38|) - (EXIT (COND - ((SPADCALL |dp| |dq| (|getShellEntry| $ 214)) - (SPADCALL (|spadConstant| $ 28) - (SPADCALL |q| (|getShellEntry| $ 48)) - (|getShellEntry| $ 215))) - ((SPADCALL |dq| |dp| (|getShellEntry| $ 214)) - (SPADCALL (SPADCALL |p| (|getShellEntry| $ 48)) - (|spadConstant| $ 28) (|getShellEntry| $ 215))) - ('T - (SPADCALL - (SPADCALL (SPADCALL |p| |q| - (|getShellEntry| $ 189)) - (|getShellEntry| $ 48)) - (|spadConstant| $ 28) (|getShellEntry| $ 215))))))))) + (LET* ((|dp| (SPADCALL |p| (|getShellEntry| $ 75))) + (|dq| (SPADCALL |q| (|getShellEntry| $ 75)))) + (COND + ((SPADCALL |dp| |dq| (|getShellEntry| $ 214)) + (SPADCALL (|spadConstant| $ 28) + (SPADCALL |q| (|getShellEntry| $ 48)) + (|getShellEntry| $ 215))) + ((SPADCALL |dq| |dp| (|getShellEntry| $ 214)) + (SPADCALL (SPADCALL |p| (|getShellEntry| $ 48)) + (|spadConstant| $ 28) (|getShellEntry| $ 215))) + ('T + (SPADCALL + (SPADCALL (SPADCALL |p| |q| (|getShellEntry| $ 189)) + (|getShellEntry| $ 48)) + (|spadConstant| $ 28) (|getShellEntry| $ 215)))))) (DEFUN |POLYCAT-;patternMatch;SP2Pmr;39| (|p| |pat| |l| $) (SPADCALL |p| |pat| |l| (|getShellEntry| $ 220))) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp index daacfe07..b52baeae 100644 --- a/src/algebra/strap/QFCAT-.lsp +++ b/src/algebra/strap/QFCAT-.lsp @@ -94,19 +94,15 @@ (|getShellEntry| $ 15))) (DEFUN |QFCAT-;nextItem;AU;4| (|n| $) - (PROG (|m|) - (RETURN - (SEQ (LETT |m| - (SPADCALL (SPADCALL |n| (|getShellEntry| $ 8)) - (|getShellEntry| $ 18)) - |QFCAT-;nextItem;AU;4|) - (EXIT (COND - ((EQL (CAR |m|) 1) - (|error| "We seem to have a Fraction of a finite object")) - ('T - (CONS 0 - (SPADCALL (CDR |m|) (|spadConstant| $ 14) - (|getShellEntry| $ 15)))))))))) + (LET ((|m| (SPADCALL (SPADCALL |n| (|getShellEntry| $ 8)) + (|getShellEntry| $ 18)))) + (COND + ((EQL (CAR |m|) 1) + (|error| "We seem to have a Fraction of a finite object")) + ('T + (CONS 0 + (SPADCALL (CDR |m|) (|spadConstant| $ 14) + (|getShellEntry| $ 15))))))) (DEFUN |QFCAT-;map;M2A;5| (|fn| |x| $) (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) |fn|) @@ -119,21 +115,16 @@ (DEFUN |QFCAT-;characteristic;Nni;7| ($) (|spadConstant| $ 30)) (DEFUN |QFCAT-;differentiate;AMA;8| (|x| |deriv| $) - (PROG (|n| |d|) - (RETURN - (SEQ (LETT |n| (SPADCALL |x| (|getShellEntry| $ 8)) - |QFCAT-;differentiate;AMA;8|) - (LETT |d| (SPADCALL |x| (|getShellEntry| $ 11)) - |QFCAT-;differentiate;AMA;8|) - (EXIT (SPADCALL - (SPADCALL - (SPADCALL (SPADCALL |n| |deriv|) |d| - (|getShellEntry| $ 32)) - (SPADCALL |n| (SPADCALL |d| |deriv|) - (|getShellEntry| $ 32)) - (|getShellEntry| $ 33)) - (SPADCALL |d| 2 (|getShellEntry| $ 35)) - (|getShellEntry| $ 15))))))) + (LET* ((|n| (SPADCALL |x| (|getShellEntry| $ 8))) + (|d| (SPADCALL |x| (|getShellEntry| $ 11)))) + (SPADCALL + (SPADCALL + (SPADCALL (SPADCALL |n| |deriv|) |d| + (|getShellEntry| $ 32)) + (SPADCALL |n| (SPADCALL |d| |deriv|) + (|getShellEntry| $ 32)) + (|getShellEntry| $ 33)) + (SPADCALL |d| 2 (|getShellEntry| $ 35)) (|getShellEntry| $ 15)))) (DEFUN |QFCAT-;convert;AIf;9| (|x| $) (SPADCALL @@ -216,13 +207,10 @@ (|getShellEntry| $ 60))) (DEFUN |QFCAT-;retractIfCan;AU;18| (|x| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| (SPADCALL |x| (|getShellEntry| $ 63)) - |QFCAT-;retractIfCan;AU;18|) - (EXIT (COND - ((EQL (CAR |r|) 1) (CONS 1 "failed")) - ('T (SPADCALL (CDR |r|) (|getShellEntry| $ 65))))))))) + (LET ((|r| (SPADCALL |x| (|getShellEntry| $ 63)))) + (COND + ((EQL (CAR |r|) 1) (CONS 1 "failed")) + ('T (SPADCALL (CDR |r|) (|getShellEntry| $ 65)))))) (DEFUN |QFCAT-;convert;AP;19| (|x| $) (SPADCALL @@ -259,13 +247,10 @@ (|getShellEntry| $ 92))) (DEFUN |QFCAT-;retractIfCan;AU;25| (|x| $) - (PROG (|u|) - (RETURN - (SEQ (LETT |u| (SPADCALL |x| (|getShellEntry| $ 63)) - |QFCAT-;retractIfCan;AU;25|) - (EXIT (COND - ((EQL (CAR |u|) 1) (CONS 1 "failed")) - ('T (SPADCALL (CDR |u|) (|getShellEntry| $ 95))))))))) + (LET ((|u| (SPADCALL |x| (|getShellEntry| $ 63)))) + (COND + ((EQL (CAR |u|) 1) (CONS 1 "failed")) + ('T (SPADCALL (CDR |u|) (|getShellEntry| $ 95)))))) (DEFUN |QFCAT-;random;A;26| ($) (PROG (|d|) @@ -282,23 +267,17 @@ (|getShellEntry| $ 15))))))) (DEFUN |QFCAT-;reducedSystem;MVR;27| (|m| |v| $) - (PROG (|n|) - (RETURN - (SEQ (LETT |n| - (SPADCALL - (SPADCALL (SPADCALL |v| (|getShellEntry| $ 101)) - |m| (|getShellEntry| $ 102)) - (|getShellEntry| $ 103)) - |QFCAT-;reducedSystem;MVR;27|) - (EXIT (CONS (SPADCALL |n| - (SPADCALL |n| (|getShellEntry| $ 104)) - (SPADCALL |n| (|getShellEntry| $ 105)) - (+ 1 (SPADCALL |n| (|getShellEntry| $ 107))) - (SPADCALL |n| (|getShellEntry| $ 109)) - (|getShellEntry| $ 110)) - (SPADCALL |n| - (SPADCALL |n| (|getShellEntry| $ 107)) - (|getShellEntry| $ 112)))))))) + (LET ((|n| (SPADCALL + (SPADCALL (SPADCALL |v| (|getShellEntry| $ 101)) |m| + (|getShellEntry| $ 102)) + (|getShellEntry| $ 103)))) + (CONS (SPADCALL |n| (SPADCALL |n| (|getShellEntry| $ 104)) + (SPADCALL |n| (|getShellEntry| $ 105)) + (+ 1 (SPADCALL |n| (|getShellEntry| $ 107))) + (SPADCALL |n| (|getShellEntry| $ 109)) + (|getShellEntry| $ 110)) + (SPADCALL |n| (SPADCALL |n| (|getShellEntry| $ 107)) + (|getShellEntry| $ 112))))) (DEFUN |QuotientFieldCategory&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) diff --git a/src/algebra/strap/RNS-.lsp b/src/algebra/strap/RNS-.lsp index de5580c1..18ebf104 100644 --- a/src/algebra/strap/RNS-.lsp +++ b/src/algebra/strap/RNS-.lsp @@ -83,34 +83,22 @@ (|getShellEntry| $ 35))) (DEFUN |RNS-;floor;2S;8| (|x| $) - (PROG (|x1|) - (RETURN - (SEQ (LETT |x1| - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 37)) - (|getShellEntry| $ 20)) - |RNS-;floor;2S;8|) - (EXIT (COND - ((SPADCALL |x| |x1| (|getShellEntry| $ 38)) |x|) - ((SPADCALL |x| (|spadConstant| $ 39) - (|getShellEntry| $ 41)) - (SPADCALL |x1| (|spadConstant| $ 18) - (|getShellEntry| $ 11))) - ('T |x1|))))))) + (LET ((|x1| (SPADCALL (SPADCALL |x| (|getShellEntry| $ 37)) + (|getShellEntry| $ 20)))) + (COND + ((SPADCALL |x| |x1| (|getShellEntry| $ 38)) |x|) + ((SPADCALL |x| (|spadConstant| $ 39) (|getShellEntry| $ 41)) + (SPADCALL |x1| (|spadConstant| $ 18) (|getShellEntry| $ 11))) + ('T |x1|)))) (DEFUN |RNS-;ceiling;2S;9| (|x| $) - (PROG (|x1|) - (RETURN - (SEQ (LETT |x1| - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 37)) - (|getShellEntry| $ 20)) - |RNS-;ceiling;2S;9|) - (EXIT (COND - ((SPADCALL |x| |x1| (|getShellEntry| $ 38)) |x|) - ((SPADCALL |x| (|spadConstant| $ 39) - (|getShellEntry| $ 44)) - (SPADCALL |x1| (|spadConstant| $ 18) - (|getShellEntry| $ 24))) - ('T |x1|))))))) + (LET ((|x1| (SPADCALL (SPADCALL |x| (|getShellEntry| $ 37)) + (|getShellEntry| $ 20)))) + (COND + ((SPADCALL |x| |x1| (|getShellEntry| $ 38)) |x|) + ((SPADCALL |x| (|spadConstant| $ 39) (|getShellEntry| $ 44)) + (SPADCALL |x1| (|spadConstant| $ 18) (|getShellEntry| $ 24))) + ('T |x1|)))) (DEFUN |RNS-;patternMatch;SP2Pmr;10| (|x| |p| |l| $) (PROG (|r|) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index c0ec6dbb..ca473e7e 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -295,34 +295,24 @@ ('T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) (DEFUN |SINT;OMwrite;$S;2| (|x| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |SINT;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) - (|getShellEntry| $ 22)) - |SINT;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 23)) - (|SINT;writeOMSingleInt| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 24)) - (SPADCALL |dev| (|getShellEntry| $ 25)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) + (|getShellEntry| $ 22)))) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) + (|SINT;writeOMSingleInt| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 24)) + (SPADCALL |dev| (|getShellEntry| $ 25)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |SINT;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) - (|getShellEntry| $ 22)) - |SINT;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 23)))) - (|SINT;writeOMSingleInt| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) - (SPADCALL |dev| (|getShellEntry| $ 25)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 21)) + (|getShellEntry| $ 22)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 23)))) + (|SINT;writeOMSingleInt| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) + (SPADCALL |dev| (|getShellEntry| $ 25)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) @@ -498,16 +488,13 @@ (CONS |m| |v|)) (DEFUN |SINT;positiveRemainder;3$;58| (|x| |n| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| (QSREMAINDER |x| |n|) - |SINT;positiveRemainder;3$;58|) - (EXIT (COND - ((QSMINUSP |r|) - (COND - ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) - ('T (QSPLUS |r| |n|)))) - ('T |r|))))))) + (LET ((|r| (QSREMAINDER |x| |n|))) + (COND + ((QSMINUSP |r|) + (COND + ((QSMINUSP |n|) (QSDIFFERENCE |x| |n|)) + ('T (QSPLUS |r| |n|)))) + ('T |r|)))) (DEFUN |SINT;coerce;I$;59| (|x| $) (|check-subtype| (SMINTP |x|) '(|SingleInteger|) |x|)) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 2232262b..7bfb0d2d 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -86,40 +86,35 @@ (EXIT (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) - (PROG (|l| |h|) + (PROG (|h|) (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (|getShellEntry| $ 28)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ((NOT (SPADCALL |i| (|getShellEntry| $ 29))) - (SPADCALL - (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (|getShellEntry| $ 30))) - ('T - (SEQ (LETT |h| - (- (SPADCALL |i| (|getShellEntry| $ 31)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |h| |l|) - (SPADCALL (|getShellEntry| $ 32))) - ('T - (SPADCALL - (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (LET - ((#0=#:G1420 (+ (- |h| |l|) 1))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 35))))))))))))) + (LET ((|l| (- (SPADCALL |i| (|getShellEntry| $ 28)) + (SPADCALL |x| (|getShellEntry| $ 21))))) + (COND + ((< |l| 0) (|error| "index out of range")) + ((NOT (SPADCALL |i| (|getShellEntry| $ 29))) + (SPADCALL (SPADCALL |x| + (|check-subtype| (>= |l| 0) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (|getShellEntry| $ 30))) + ('T + (SEQ (LETT |h| + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |h| |l|) (SPADCALL (|getShellEntry| $ 32))) + ('T + (SPADCALL + (SPADCALL |x| + (|check-subtype| (>= |l| 0) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 35)))))))))))) (DEFUN |STAGG-;concat;3A;7| (|x| |y| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) |y| @@ -134,36 +129,29 @@ (|getShellEntry| $ 37))))) (DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) - (RETURN NIL)) - (T (SEQ (SPADCALL |l| - (SPADCALL - (SPADCALL |l| (|getShellEntry| $ 19)) - |f|) - (|getShellEntry| $ 46)) - (EXIT (SETQ |l| - (SPADCALL |l| - (|getShellEntry| $ 13)))))))) - (EXIT |y|))))) + (LET ((|y| |l|)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) + (RETURN NIL)) + (T (SEQ (SPADCALL |l| + (SPADCALL + (SPADCALL |l| (|getShellEntry| $ 19)) |f|) + (|getShellEntry| $ 46)) + (EXIT (SETQ |l| + (SPADCALL |l| (|getShellEntry| $ 13)))))))) + (EXIT |y|)))) (DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) - (RETURN NIL)) - (T (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) - (EXIT (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 13)))))))) - (EXIT |x|))))) + (LET ((|y| |x|)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) + (RETURN NIL)) + (T (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) + (EXIT (SETQ |y| + (SPADCALL |y| (|getShellEntry| $ 13)))))))) + (EXIT |x|)))) (DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))) @@ -180,60 +168,52 @@ (EXIT (SPADCALL |x| |s| (|getShellEntry| $ 46))))) (DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) - (PROG (|l| |h| |y| |z|) + (PROG (|h| |y| |z|) (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (|getShellEntry| $ 28)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|getShellEntry| $ 29)) - (- (SPADCALL |i| - (|getShellEntry| $ 31)) - (SPADCALL |x| - (|getShellEntry| $ 21)))) - ('T - (SPADCALL |x| (|getShellEntry| $ 51)))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |h| |l|) |s|) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| + (LET ((|l| (- (SPADCALL |i| (|getShellEntry| $ 28)) + (SPADCALL |x| (|getShellEntry| $ 21))))) + (COND + ((< |l| 0) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (|getShellEntry| $ 29)) + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21)))) + ('T (SPADCALL |x| (|getShellEntry| $ 51)))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |h| |l|) |s|) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (|check-subtype| (>= |l| 0) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LETT |z| + (SPADCALL |y| + (LET + ((#0=#:G1443 (+ (- |h| |l|) 1))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LOOP + (COND + ((NOT + (NOT + (SPADCALL |y| |z| + (|getShellEntry| $ 52)))) + (RETURN NIL)) + (T (SEQ + (SPADCALL |y| |s| + (|getShellEntry| $ 46)) + (EXIT + (SETQ |y| (SPADCALL |y| - (LET - ((#0=#:G1443 - (+ (- |h| |l|) 1))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) - #0#)) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LOOP - (COND - ((NOT - (NOT - (SPADCALL |y| |z| - (|getShellEntry| $ 52)))) - (RETURN NIL)) - (T - (SEQ - (SPADCALL |y| |s| - (|getShellEntry| $ 46)) - (EXIT - (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 13)))))))) - (EXIT |s|))))))))))))) + (|getShellEntry| $ 13)))))))) + (EXIT |s|)))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) (SEQ (COND diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index a34479e4..7aca9e5f 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -122,35 +122,24 @@ ('T (SPADCALL |dev| |x| (|getShellEntry| $ 27))))) (DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SYMBOL;OMwrite;$S;2|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 29)) - (|getShellEntry| $ 30)) - |SYMBOL;OMwrite;$S;2|) - (SPADCALL |dev| (|getShellEntry| $ 31)) - (|SYMBOL;writeOMSym| |dev| |x| $) - (SPADCALL |dev| (|getShellEntry| $ 32)) - (SPADCALL |dev| (|getShellEntry| $ 33)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 29)) + (|getShellEntry| $ 30)))) + (SEQ (SPADCALL |dev| (|getShellEntry| $ 31)) + (|SYMBOL;writeOMSym| |dev| |x| $) + (SPADCALL |dev| (|getShellEntry| $ 32)) + (SPADCALL |dev| (|getShellEntry| $ 33)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|s| |sp| |dev|) - (RETURN - (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) - (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) - |SYMBOL;OMwrite;$BS;3|) - (LETT |dev| - (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 29)) - (|getShellEntry| $ 30)) - |SYMBOL;OMwrite;$BS;3|) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31)))) - (|SYMBOL;writeOMSym| |dev| |x| $) - (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 32)))) - (SPADCALL |dev| (|getShellEntry| $ 33)) - (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) + (LET* ((|s| "") (|sp| (OM-STRINGTOSTRINGPTR |s|)) + (|dev| (SPADCALL |sp| (SPADCALL (|getShellEntry| $ 29)) + (|getShellEntry| $ 30)))) + (SEQ (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 31)))) + (|SYMBOL;writeOMSym| |dev| |x| $) + (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 32)))) + (SPADCALL |dev| (|getShellEntry| $ 33)) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|)))) (DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 31)) @@ -206,74 +195,64 @@ (SPADCALL |x| (|getShellEntry| $ 79))) (DEFUN |SYMBOL;syprefix| (|sc| $) - (PROG (|ns|) - (RETURN - (SEQ (LETT |ns| - (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) - (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) - |SYMBOL;syprefix|) - (LOOP - (COND - ((NOT (COND - ((>= (LENGTH |ns|) 2) - (ZEROP (|SPADfirst| |ns|))) - ('T NIL))) - (RETURN NIL)) - (T (SETQ |ns| (CDR |ns|))))) - (EXIT (SPADCALL - (CONS (STRCONC (|getShellEntry| $ 38) - (|SYMBOL;istring| - (LENGTH (QVELT |sc| 4)) $)) - (LET ((#0=#:G1549 (NREVERSE |ns|)) - (#1=#:G1548 NIL)) - (LOOP - (COND - ((ATOM #0#) (RETURN (NREVERSE #1#))) - (T (LET ((|n| (CAR #0#))) - (SETQ #1# - (CONS (|SYMBOL;istring| |n| $) - #1#))))) - (SETQ #0# (CDR #0#))))) - (|getShellEntry| $ 93))))))) + (LET ((|ns| (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) + (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))))) + (SEQ (LOOP + (COND + ((NOT (COND + ((>= (LENGTH |ns|) 2) (ZEROP (|SPADfirst| |ns|))) + ('T NIL))) + (RETURN NIL)) + (T (SETQ |ns| (CDR |ns|))))) + (EXIT (SPADCALL + (CONS (STRCONC (|getShellEntry| $ 38) + (|SYMBOL;istring| + (LENGTH (QVELT |sc| 4)) $)) + (LET ((#0=#:G1549 (NREVERSE |ns|)) + (#1=#:G1548 NIL)) + (LOOP + (COND + ((ATOM #0#) (RETURN (NREVERSE #1#))) + (T (LET ((|n| (CAR #0#))) + (SETQ #1# + (CONS (|SYMBOL;istring| |n| $) + #1#))))) + (SETQ #0# (CDR #0#))))) + (|getShellEntry| $ 93)))))) (DEFUN |SYMBOL;syscripts| (|sc| $) - (PROG (|all|) - (RETURN - (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) - (SETQ |all| - (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 94))) - (SETQ |all| - (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 94))) - (SETQ |all| - (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 94))) - (EXIT (SPADCALL |all| (QVELT |sc| 4) (|getShellEntry| $ 94))))))) + (LET ((|all| (QVELT |sc| 3))) + (SEQ (SETQ |all| + (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 94))) + (SETQ |all| + (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 94))) + (SETQ |all| + (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 94))) + (EXIT (SPADCALL |all| (QVELT |sc| 4) (|getShellEntry| $ 94)))))) (DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) - (PROG (|sc|) - (RETURN - (SEQ (LETT |sc| (VECTOR NIL NIL NIL NIL NIL) - |SYMBOL;script;$L$;22|) - (COND - ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (COND - ((NOT (NULL |ls|)) - (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) - (EXIT (SETQ |ls| (CDR |ls|)))))) - (EXIT (|SYMBOL;script;$R$;23| |sy| |sc| $)))))) + (LET ((|sc| (VECTOR NIL NIL NIL NIL NIL))) + (SEQ (COND + ((NOT (NULL |ls|)) + (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) + (EXIT (SETQ |ls| (CDR |ls|)))))) + (COND + ((NOT (NULL |ls|)) + (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) + (EXIT (SETQ |ls| (CDR |ls|)))))) + (COND + ((NOT (NULL |ls|)) + (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) + (EXIT (SETQ |ls| (CDR |ls|)))))) + (COND + ((NOT (NULL |ls|)) + (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) + (EXIT (SETQ |ls| (CDR |ls|)))))) + (COND + ((NOT (NULL |ls|)) + (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) + (EXIT (SETQ |ls| (CDR |ls|)))))) + (EXIT (|SYMBOL;script;$R$;23| |sy| |sc| $))))) (DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $) (COND @@ -295,145 +274,146 @@ ('T (|error| "Cannot form string from non-atomic symbols.")))) (DEFUN |SYMBOL;latex;$S;25| (|e| $) - (PROG (|s| |ss| |lo| |sc|) + (PROG (|ss| |lo| |sc|) (RETURN - (SEQ (LETT |s| (PNAME (|SYMBOL;name;2$;31| |e| $)) - |SYMBOL;latex;$S;25|) - (COND - ((> (QCSIZE |s|) 1) - (COND - ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106)) - (SPADCALL "\\" (|getShellEntry| $ 43)) - (|getShellEntry| $ 107)) - (SETQ |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}"))))))) - (COND ((NOT (|SYMBOL;scripted?;$B;30| |e| $)) (EXIT |s|))) - (LETT |ss| (|SYMBOL;scripts;$R;32| |e| $) - |SYMBOL;latex;$S;25|) - (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (SETQ |lo| (QVELT |ss| 1)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (SETQ |lo| (QVELT |ss| 2)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) - (SETQ |lo| (QVELT |ss| 3)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "}")) - (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) - (SETQ |lo| (QVELT |ss| 4)) - (COND - ((NOT (NULL |lo|)) - (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) - (LOOP - (COND - ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (SETQ |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112)))) - (SETQ |lo| (CDR |lo|)) - (EXIT (COND - ((NOT (NULL |lo|)) - (SETQ |sc| (STRCONC |sc| ", "))))))))) - (SETQ |sc| (STRCONC |sc| "} \\right)")) - (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) - (EXIT |s|))))) + (LET ((|s| (PNAME (SPADCALL |e| (|getShellEntry| $ 100))))) + (SEQ (COND + ((> (QCSIZE |s|) 1) + (COND + ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106)) + (SPADCALL "\\" (|getShellEntry| $ 43)) + (|getShellEntry| $ 107)) + (SETQ |s| + (STRCONC "\\mbox{\\it " (STRCONC |s| "}"))))))) + (COND + ((NOT (|SYMBOL;scripted?;$B;30| |e| $)) (EXIT |s|))) + (LETT |ss| (|SYMBOL;scripts;$R;32| |e| $) + |SYMBOL;latex;$S;25|) + (LETT |lo| (QVELT |ss| 0) |SYMBOL;latex;$S;25|) + (COND + ((NOT (NULL |lo|)) + (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (SETQ |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) + (EXIT (COND + ((NOT (NULL |lo|)) + (SETQ |sc| + (STRCONC |sc| ", "))))))))) + (SETQ |sc| (STRCONC |sc| "}")) + (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) + (SETQ |lo| (QVELT |ss| 1)) + (COND + ((NOT (NULL |lo|)) + (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (SETQ |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) + (EXIT (COND + ((NOT (NULL |lo|)) + (SETQ |sc| + (STRCONC |sc| ", "))))))))) + (SETQ |sc| (STRCONC |sc| "}")) + (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) + (SETQ |lo| (QVELT |ss| 2)) + (COND + ((NOT (NULL |lo|)) + (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (SETQ |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) + (EXIT (COND + ((NOT (NULL |lo|)) + (SETQ |sc| + (STRCONC |sc| ", "))))))))) + (SETQ |sc| (STRCONC |sc| "}")) + (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) + (SETQ |lo| (QVELT |ss| 3)) + (COND + ((NOT (NULL |lo|)) + (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (SETQ |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) + (EXIT (COND + ((NOT (NULL |lo|)) + (SETQ |sc| + (STRCONC |sc| ", "))))))))) + (SETQ |sc| (STRCONC |sc| "}")) + (EXIT (SETQ |s| (STRCONC |sc| |s|)))))) + (SETQ |lo| (QVELT |ss| 4)) + (COND + ((NOT (NULL |lo|)) + (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (SETQ |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) + (EXIT (COND + ((NOT (NULL |lo|)) + (SETQ |sc| + (STRCONC |sc| ", "))))))))) + (SETQ |sc| (STRCONC |sc| "} \\right)")) + (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) + (EXIT |s|)))))) (DEFUN |SYMBOL;anyRadix| (|n| |s| $) - (PROG (|ns| |qr|) + (PROG (|qr|) (RETURN - (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) - (EXIT (LOOP - (COND - (NIL (RETURN NIL)) - (T (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) - |SYMBOL;anyRadix|) - (SETQ |n| (CAR |qr|)) - (SETQ |ns| - (SPADCALL - (SPADCALL |s| - (+ (CDR |qr|) - (SPADCALL |s| - (|getShellEntry| $ 117))) - (|getShellEntry| $ 106)) - |ns| (|getShellEntry| $ 119))) - (EXIT (COND - ((ZEROP |n|) - (RETURN-FROM |SYMBOL;anyRadix| - |ns|))))))))))))) + (LET ((|ns| "")) + (LOOP + (COND + (NIL (RETURN NIL)) + (T (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) + |SYMBOL;anyRadix|) + (SETQ |n| (CAR |qr|)) + (SETQ |ns| + (SPADCALL + (SPADCALL |s| + (+ (CDR |qr|) + (SPADCALL |s| + (|getShellEntry| $ 117))) + (|getShellEntry| $ 106)) + |ns| (|getShellEntry| $ 119))) + (EXIT (COND + ((ZEROP |n|) + (RETURN-FROM |SYMBOL;anyRadix| |ns|)))))))))))) (DEFUN |SYMBOL;new;$;27| ($) - (PROG (|sym|) - (RETURN - (SEQ (LETT |sym| - (|SYMBOL;anyRadix| - (SPADCALL (|getShellEntry| $ 10) - (|getShellEntry| $ 120)) - (|getShellEntry| $ 20) $) - |SYMBOL;new;$;27|) - (SPADCALL (|getShellEntry| $ 10) - (+ (SPADCALL (|getShellEntry| $ 10) - (|getShellEntry| $ 120)) - 1) - (|getShellEntry| $ 121)) - (EXIT (|SYMBOL;coerce;S$;8| (STRCONC "%" |sym|) $)))))) + (LET ((|sym| (|SYMBOL;anyRadix| + (SPADCALL (|getShellEntry| $ 10) + (|getShellEntry| $ 120)) + (|getShellEntry| $ 20) $))) + (SEQ (SPADCALL (|getShellEntry| $ 10) + (+ (SPADCALL (|getShellEntry| $ 10) + (|getShellEntry| $ 120)) + 1) + (|getShellEntry| $ 121)) + (EXIT (|SYMBOL;coerce;S$;8| (STRCONC "%" |sym|) $))))) (DEFUN |SYMBOL;new;2$;28| (|x| $) (PROG (|u| |n| |xx|) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index 87934534..6befa66f 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -138,27 +138,21 @@ (|getShellEntry| $ 8))) (DEFUN |URAGG-;nodes;AL;8| (|x| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (CONS |x| |l|)) - (EXIT (SETQ |x| - (SPADCALL |x| - (|getShellEntry| $ 14)))))))) - (EXIT (NREVERSE |l|)))))) + (LET ((|l| NIL)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (SEQ (SETQ |l| (CONS |x| |l|)) + (EXIT (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 14)))))))) + (EXIT (NREVERSE |l|))))) (DEFUN |URAGG-;children;AL;9| (|x| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) - (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 20)) |l|) - ('T - (CONS (SPADCALL |x| (|getShellEntry| $ 14)) |l|)))))))) + (LET ((|l| NIL)) + (COND + ((SPADCALL |x| (|getShellEntry| $ 20)) |l|) + ('T (CONS (SPADCALL |x| (|getShellEntry| $ 14)) |l|))))) (DEFUN |URAGG-;leaf?;AB;10| (|x| $) (SPADCALL |x| (|getShellEntry| $ 20))) @@ -170,70 +164,62 @@ ('T (SPADCALL |x| (|getShellEntry| $ 8))))) (DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) - (LOOP - (COND - ((NOT (COND - ((> |i| 0) - (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) - (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (> |i| 0)))))) + (LET ((|i| |n|)) + (SEQ (LOOP + (COND + ((NOT (COND + ((> |i| 0) + (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) + ('T NIL))) + (RETURN NIL)) + (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) + (EXIT (SETQ |i| (- |i| 1))))))) + (EXIT (> |i| 0))))) (DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) - (LOOP - (COND - ((NOT (COND - ((> |i| 0) - (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) - (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (COND - ((ZEROP |i|) - (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))))))) + (LET ((|i| |n|)) + (SEQ (LOOP + (COND + ((NOT (COND + ((> |i| 0) + (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) + ('T NIL))) + (RETURN NIL)) + (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) + (EXIT (SETQ |i| (- |i| 1))))))) + (EXIT (COND + ((ZEROP |i|) + (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) + ('T NIL)))))) (DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) - (LOOP - (COND - ((NOT (COND - ((SPADCALL |l| (|getShellEntry| $ 20)) NIL) - ('T (> |i| 0)))) - (RETURN NIL)) - (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) - (EXIT (SETQ |i| (- |i| 1))))))) - (EXIT (COND - ((SPADCALL |l| (|getShellEntry| $ 20)) (ZEROP |i|)) - ('T NIL))))))) + (LET ((|i| |n|)) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |l| (|getShellEntry| $ 20)) NIL) + ('T (> |i| 0)))) + (RETURN NIL)) + (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) + (EXIT (SETQ |i| (- |i| 1))))))) + (EXIT (COND + ((SPADCALL |l| (|getShellEntry| $ 20)) (ZEROP |i|)) + ('T NIL)))))) (DEFUN |URAGG-;#;ANni;15| (|x| $) - (PROG (|k|) - (RETURN - (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) - (RETURN NIL)) - (T (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (|getShellEntry| $ 48)) - (EXIT (|error| "cyclic list")))))) - (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))) - (EXIT (SETQ |k| (+ |k| 1))))))) - (EXIT |k|))))) + (LET ((|k| 0)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| (|getShellEntry| $ 48)) + (EXIT (|error| "cyclic list")))))) + (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))) + (EXIT (SETQ |k| (+ |k| 1))))))) + (EXIT |k|)))) (DEFUN |URAGG-;tail;2A;16| (|x| $) (PROG (|y|) @@ -263,29 +249,25 @@ (EXIT |x|)))))))) (DEFUN |URAGG-;findCycle| (|x| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;findCycle|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 20)))) - (RETURN NIL)) - (T (SEQ (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 54)) - (RETURN-FROM |URAGG-;findCycle| |x|))) - (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))) - (SETQ |y| (SPADCALL |y| (|getShellEntry| $ 14))) - (COND - ((SPADCALL |y| (|getShellEntry| $ 20)) - (RETURN-FROM |URAGG-;findCycle| |y|))) - (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 54)) - (RETURN-FROM |URAGG-;findCycle| |y|))) - (EXIT (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 14)))))))) - (EXIT |y|))))) + (LET ((|y| (SPADCALL |x| (|getShellEntry| $ 14)))) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (SEQ (COND + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) + (RETURN-FROM |URAGG-;findCycle| |x|))) + (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))) + (SETQ |y| (SPADCALL |y| (|getShellEntry| $ 14))) + (COND + ((SPADCALL |y| (|getShellEntry| $ 20)) + (RETURN-FROM |URAGG-;findCycle| |y|))) + (COND + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) + (RETURN-FROM |URAGG-;findCycle| |y|))) + (EXIT (SETQ |y| + (SPADCALL |y| (|getShellEntry| $ 14)))))))) + (EXIT |y|)))) (DEFUN |URAGG-;cycleTail;2A;18| (|x| $) (PROG (|z| |y|) @@ -392,20 +374,17 @@ (EXIT |x|))) (DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) - (PROG (|m|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (|getShellEntry| $ 60)) - |URAGG-;last;ANniA;22|) - (EXIT (COND - ((> |n| |m|) (|error| "index out of range")) - ('T - (SPADCALL - (SPADCALL |x| - (LET ((#0=#:G1502 (- |m| |n|))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 62)) - (|getShellEntry| $ 63))))))))) + (LET ((|m| (SPADCALL |x| (|getShellEntry| $ 60)))) + (COND + ((> |n| |m|) (|error| "index out of range")) + ('T + (SPADCALL + (SPADCALL |x| + (LET ((#0=#:G1502 (- |m| |n|))) + (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) + #0#)) + (|getShellEntry| $ 62)) + (|getShellEntry| $ 63)))))) (DEFUN |URAGG-;=;2AB;23| (|x| |y| $) (SEQ (COND diff --git a/src/interp/c-util.boot b/src/interp/c-util.boot index ab80ac63..17d630b4 100644 --- a/src/interp/c-util.boot +++ b/src/interp/c-util.boot @@ -1620,8 +1620,10 @@ transformToBackendCode x == -- Make it explicitly a sequence of statements if it is not a one liner. body := body is [stmt] and - (atom stmt or stmt.op = "SEQ" or not CONTAINED("EXIT",stmt)) => - body + (atom stmt + or stmt.op in '(SEQ LET LET_*) + or not CONTAINED("EXIT",stmt)) => + body [simplifySEQ ["SEQ",:body]] $FluidVars := removeDuplicates nreverse $FluidVars $LocalVars := S_-(S_-(removeDuplicates nreverse $LocalVars,$FluidVars), diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index e47f7be0..f8e28b42 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -79,6 +79,33 @@ changeVariableDefinitionToStore(form,vars) == x is ['%LET,v,:.] and not (v in vars) => vars := [v,:vars] +++ Return true if `x' contains control transfer to a point outside itself. +jumpToToplevel? x == + isAtomicForm x => false + op := x.op + op = 'SEQ => CONTAINED('THROW,x.args) + op in '(EXIT THROW %leave) => true + or/[jumpToToplevel? x' for x' in x] + +++ Return true if `form' is just one assignment expression. +singleAssignment? form == + form is ['%LET,.,rhs] and not CONTAINED('%LET,rhs) + +++ Turns `form' into a `%bind'-expression if it starts with a +++ a sequence of first-time variable definitions. +groupVariableDefinitions form == + isAtomicForm form => form + form isnt ['SEQ,:stmts,['EXIT,val]] => form + defs := nil + for x in stmts while singleAssignment? x repeat + defs := [x.args,:defs] + defs = nil or jumpToToplevel? defs => form + stmts := drop(#defs,stmts) + expr := + stmts = nil => val + ['SEQ,:stmts,['EXIT,val]] + ['%bind,nreverse defs,expr] + optimizeFunctionDef(def) == if $reportOptimization then sayBrightlyI bright '"Original LISP code:" @@ -109,7 +136,7 @@ optimizeFunctionDef(def) == replaceThrowByReturn(first x,g) replaceThrowByReturn(rest x,g) changeVariableDefinitionToStore(body',args) - [name,[slamOrLam,args,body']] + [name,[slamOrLam,args,groupVariableDefinitions body']] optimize x == (opt x; x) where diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot index ed134390..bf4a02ee 100644 --- a/src/interp/g-util.boot +++ b/src/interp/g-util.boot @@ -227,11 +227,16 @@ expandEq ["%eq",:args] == ["EQ",:expandToVMForm args] -- Local variable bindings -expandBind ["%bind",inits,body] == +expandBind ['%bind,inits,body] == body := expandToVMForm body inits := [[first x,expandToVMForm second x] for x in inits] + n := #inits + n = 0 => body -- FIXME: we should consider turning LET* into LET or direct inlining. - ["LET*",inits,body] + op := + n = 1 => 'LET + 'LET_* + [op,inits,body] -- Memory load/store |