diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/ChangeLog | 5 | ||||
-rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 45 | ||||
-rw-r--r-- | src/algebra/strap/EUCDOM-.lsp | 29 | ||||
-rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 89 | ||||
-rw-r--r-- | src/algebra/strap/GCDDOM-.lsp | 37 | ||||
-rw-r--r-- | src/algebra/strap/ILIST.lsp | 81 | ||||
-rw-r--r-- | src/algebra/strap/INS-.lsp | 34 | ||||
-rw-r--r-- | src/algebra/strap/INT.lsp | 10 | ||||
-rw-r--r-- | src/algebra/strap/ISTRING.lsp | 93 | ||||
-rw-r--r-- | src/algebra/strap/LIST.lsp | 43 | ||||
-rw-r--r-- | src/algebra/strap/LSAGG-.lsp | 169 | ||||
-rw-r--r-- | src/algebra/strap/OUTFORM.lsp | 10 | ||||
-rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 110 | ||||
-rw-r--r-- | src/algebra/strap/QFCAT-.lsp | 8 | ||||
-rw-r--r-- | src/algebra/strap/SINT.lsp | 10 | ||||
-rw-r--r-- | src/algebra/strap/STAGG-.lsp | 38 | ||||
-rw-r--r-- | src/algebra/strap/SYMBOL.lsp | 165 | ||||
-rw-r--r-- | src/algebra/strap/URAGG-.lsp | 128 | ||||
-rw-r--r-- | src/interp/g-opt.boot | 16 |
19 files changed, 448 insertions, 672 deletions
diff --git a/src/ChangeLog b/src/ChangeLog index 21c60a9d..db1cc1ab 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,5 +1,10 @@ 2010-06-20 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/g-opt.boot (changeVariableDefinitionToStore): New. + (optimizeFunctionDef): Use it. + +2010-06-20 Gabriel Dos Reis <gdr@cs.tamu.edu> + * interp/compiler.boot (massageLoop): New. (compRepeatOrCollect): Use it to generate appropriate %loop forms. Bind new special variable $mayHaveFreeIteratorVariables. diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index 60f38ca8..6b061736 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -401,7 +401,7 @@ |DFLOAT;**;$F$;88|)) (DEFUN |DFLOAT;OMwrite;$S;1| (|x| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |DFLOAT;OMwrite;$S;1|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |DFLOAT;OMwrite;$S;1|) @@ -413,11 +413,10 @@ (SPADCALL |dev| |x| (|getShellEntry| $ 15)) (SPADCALL |dev| (|getShellEntry| $ 16)) (SPADCALL |dev| (|getShellEntry| $ 17)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |DFLOAT;OMwrite;$S;1|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |DFLOAT;OMwrite;$BS;2| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |DFLOAT;OMwrite;$BS;2|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) @@ -430,9 +429,7 @@ (SPADCALL |dev| |x| (|getShellEntry| $ 15)) (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 16)))) (SPADCALL |dev| (|getShellEntry| $ 17)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) - |DFLOAT;OMwrite;$BS;2|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |DFLOAT;OMwrite;Omd$V;3| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 12)) @@ -658,12 +655,8 @@ ('T (SEQ (LETT |theta| (ATAN (FLOAT-SIGN 1.0 (/ |y| |x|))) |DFLOAT;atan;3$;79|) - (COND - ((< |x| 0.0) - (LETT |theta| (- PI |theta|) |DFLOAT;atan;3$;79|))) - (COND - ((< |y| 0.0) - (LETT |theta| (- |theta|) |DFLOAT;atan;3$;79|))) + (COND ((< |x| 0.0) (SETQ |theta| (- PI |theta|)))) + (COND ((< |y| 0.0) (SETQ |theta| (- |theta|)))) (EXIT |theta|)))))))) (DEFUN |DFLOAT;retract;$F;80| (|x| $) @@ -711,7 +704,7 @@ ('T (SEQ (LETT |s| (|DFLOAT;sign;$I;84| |x| $) |DFLOAT;manexp|) - (LETT |x| (FLOAT-SIGN 1.0 |x|) |DFLOAT;manexp|) + (SETQ |x| (FLOAT-SIGN 1.0 |x|)) (COND ((> |x| |$DoubleFloatMaximum|) (RETURN-FROM |DFLOAT;manexp| @@ -729,9 +722,9 @@ (- (CDR |me|) (FLOAT-DIGITS 0.0))))))))))) (DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $) - (PROG (|#G109| |nu| |ex| BASE |de| |tol| |#G110| |q| |r| |p2| |q2| - |#G111| |#G112| |p0| |p1| |#G113| |#G114| |q0| |q1| - |#G115| |#G116| |s| |t|) + (PROG (|#G109| |nu| |ex| 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|) @@ -814,28 +807,22 @@ |DFLOAT;rationalApproximation;$2NniF;87|) (LETT |#G112| |p2| |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p0| |#G111| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p1| |#G112| - |DFLOAT;rationalApproximation;$2NniF;87|) + (SETQ |p0| |#G111|) + (SETQ |p1| |#G112|) (LETT |#G113| |q1| |DFLOAT;rationalApproximation;$2NniF;87|) (LETT |#G114| |q2| |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q0| |#G113| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |q1| |#G114| - |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|) - (LETT |s| |#G115| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |t| |#G116| - |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 f3aaa896..6116773e 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -67,10 +67,8 @@ (DEFUN |EUCDOM-;gcd;3S;5| (|x| |y| $) (PROG (|#G13| |#G14|) (RETURN - (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 22)) - |EUCDOM-;gcd;3S;5|) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 22)) - |EUCDOM-;gcd;3S;5|) + (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 22))) + (SETQ |y| (SPADCALL |y| (|getShellEntry| $ 22))) (LOOP (COND ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 8)))) @@ -79,12 +77,10 @@ (LETT |#G14| (SPADCALL |x| |y| (|getShellEntry| $ 24)) |EUCDOM-;gcd;3S;5|) - (LETT |x| |#G13| |EUCDOM-;gcd;3S;5|) - (LETT |y| |#G14| |EUCDOM-;gcd;3S;5|) - (EXIT (LETT |y| + (SETQ |x| |#G13|) (SETQ |y| |#G14|) + (EXIT (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 22)) - |EUCDOM-;gcd;3S;5|)))))) + (|getShellEntry| $ 22)))))))) (EXIT |x|))))) (DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) @@ -106,7 +102,7 @@ |c|)))))))) (DEFUN |EUCDOM-;extendedEuclidean;2SR;7| (|x| |y| $) - (PROG (|s3| |s2| |qr| |s1|) + (PROG (|s1| |s2| |s3| |qr|) (RETURN (SEQ (LETT |s1| (|EUCDOM-;unitNormalizeIdealElt| @@ -149,13 +145,11 @@ (|getShellEntry| $ 31)) (CDR |qr|)) |EUCDOM-;extendedEuclidean;2SR;7|) - (LETT |s1| |s2| - |EUCDOM-;extendedEuclidean;2SR;7|) + (SETQ |s1| |s2|) (EXIT - (LETT |s2| + (SETQ |s2| (|EUCDOM-;unitNormalizeIdealElt| - |s3| $) - |EUCDOM-;extendedEuclidean;2SR;7|)))))) + |s3| $))))))) (COND ((NOT (SPADCALL (QVELT |s1| 0) (|getShellEntry| $ 8))) @@ -173,10 +167,9 @@ (|getShellEntry| $ 29)) (|getShellEntry| $ 33))) (EXIT - (LETT |s1| + (SETQ |s1| (|EUCDOM-;unitNormalizeIdealElt| - |s1| $) - |EUCDOM-;extendedEuclidean;2SR;7|))))))) + |s1| $)))))))) (EXIT |s1|))))))))) (DEFUN |EUCDOM-;extendedEuclidean;3SU;8| (|x| |y| |z| $) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 0046e258..061cefde 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -55,10 +55,9 @@ (DEFUN |FFIELDC-;nextItem;SU;3| (|a| $) (COND ((SPADCALL - (LETT |a| + (SETQ |a| (SPADCALL (+ (SPADCALL |a| (|getShellEntry| $ 11)) 1) - (|getShellEntry| $ 14)) - |FFIELDC-;nextItem;SU;3|) + (|getShellEntry| $ 14))) (|getShellEntry| $ 16)) (CONS 1 "failed")) ('T (CONS 0 |a|)))) @@ -114,12 +113,11 @@ '(|PositiveInteger|) |i|) (|getShellEntry| $ 14)) |FFIELDC-;createPrimitiveElement;S;8|) - (EXIT (LETT |found| + (EXIT (SETQ |found| (EQL (SPADCALL |e| (|getShellEntry| $ 19)) - |sm1|) - |FFIELDC-;createPrimitiveElement;S;8|))))) + |sm1|)))))) (SETQ |i| (+ |i| 1)))) (EXIT |e|))))) @@ -141,13 +139,12 @@ (PROGN (SETQ |exp| (CAR #0#)) NIL) (NOT (NOT |equalone|))) (RETURN NIL)) - (T (LETT |equalone| + (T (SETQ |equalone| (SPADCALL (SPADCALL |a| (QUOTIENT2 |q| (CAR |exp|)) (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;primitive?;SB;9|))) + (|getShellEntry| $ 59))))) (SETQ #0# (CDR #0#)))) (EXIT (NOT |equalone|))))))))) @@ -187,26 +184,19 @@ ((OR (> |j| #1#) (NOT |goon|)) (RETURN NIL)) (T - (SEQ - (LETT |ord| |a| - |FFIELDC-;order;SPi;10|) - (LETT |a| + (SEQ (SETQ |ord| |a|) + (SETQ |a| (QUOTIENT2 |ord| - |primeDivisor|) - |FFIELDC-;order;SPi;10|) + |primeDivisor|)) (EXIT - (LETT |goon| + (SETQ |goon| (SPADCALL (SPADCALL |e| |a| (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;order;SPi;10|))))) + (|getShellEntry| $ 59))))))) (SETQ |j| (+ |j| 1)))) (EXIT - (COND - (|goon| - (LETT |ord| |a| - |FFIELDC-;order;SPi;10|)))))))) + (COND (|goon| (SETQ |ord| |a|)))))))) (SETQ #0# (CDR #0#)))) (EXIT |ord|)))))))) @@ -259,10 +249,9 @@ (RETURN NIL)) (T (SEQ - (LETT |exp| + (SETQ |exp| (QUOTIENT2 |exp| - |fac|) - |FFIELDC-;discreteLog;SNni;11|) + |fac|)) (LETT |exptable| (SPADCALL |fac| (|getShellEntry| @@ -318,12 +307,11 @@ |rho|) 0) (SEQ - (LETT + (SETQ |found| - T - |FFIELDC-;discreteLog;SNni;11|) + T) (EXIT - (LETT + (SETQ |disc1| (* (+ @@ -332,10 +320,9 @@ |i|) (CDR |rho|)) - |mult|) - |FFIELDC-;discreteLog;SNni;11|)))) + |mult|))))) ('T - (LETT + (SETQ |c| (SPADCALL |c| @@ -352,25 +339,22 @@ 58)) (|getShellEntry| $ - 77)) - |FFIELDC-;discreteLog;SNni;11|))))))) + 77))))))))) (SETQ |i| (+ |i| 1)))) (EXIT (COND (|found| (SEQ - (LETT |mult| + (SETQ |mult| (* |mult| - |fac|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT + |fac|)) + (SETQ |disclog| (+ |disclog| - |disc1|) - |FFIELDC-;discreteLog;SNni;11|) + |disc1|)) (EXIT - (LETT |a| + (SETQ |a| (SPADCALL |a| (SPADCALL @@ -380,8 +364,7 @@ (|getShellEntry| $ 58)) (|getShellEntry| - $ 77)) - |FFIELDC-;discreteLog;SNni;11|)))) + $ 77)))))) ('T (|error| "discreteLog: ?? discrete logarithm"))))))) @@ -449,9 +432,8 @@ ((> |t| #1#) (RETURN NIL)) (T (SEQ - (LETT |exp| - (QUOTIENT2 |exp| |fac|) - |FFIELDC-;discreteLog;2SU;12|) + (SETQ |exp| + (QUOTIENT2 |exp| |fac|)) (LETT |rhoHelp| (SPADCALL |primroot| (SPADCALL |a| |exp| @@ -473,15 +455,13 @@ (* (CDR |rhoHelp|) |mult|) |FFIELDC-;discreteLog;2SU;12|) - (LETT |disclog| + (SETQ |disclog| (+ |disclog| - |rho|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |mult| - (* |mult| |fac|) - |FFIELDC-;discreteLog;2SU;12|) + |rho|)) + (SETQ |mult| + (* |mult| |fac|)) (EXIT - (LETT |a| + (SETQ |a| (SPADCALL |a| (SPADCALL |logbase| @@ -489,8 +469,7 @@ (|getShellEntry| $ 58)) (|getShellEntry| - $ 77)) - |FFIELDC-;discreteLog;2SU;12|))))))))) + $ 77))))))))))) (SETQ |t| (+ |t| 1))))))))) (SETQ #0# (CDR #0#)))) (EXIT (CONS 0 |disclog|))))))))))) diff --git a/src/algebra/strap/GCDDOM-.lsp b/src/algebra/strap/GCDDOM-.lsp index 1248c146..67277b94 100644 --- a/src/algebra/strap/GCDDOM-.lsp +++ b/src/algebra/strap/GCDDOM-.lsp @@ -43,7 +43,7 @@ (|getShellEntry| $ 19))) (DEFUN |GCDDOM-;gcdPolynomial;3Sup;4| (|p1| |p2| $) - (PROG (|e2| |e1| |c1| |p| |c2|) + (PROG (|c1| |c2| |e2| |e1| |p|) (RETURN (SEQ (COND ((SPADCALL |p1| (|getShellEntry| $ 24)) @@ -55,7 +55,7 @@ |GCDDOM-;gcdPolynomial;3Sup;4|) (LETT |c2| (SPADCALL |p2| (|getShellEntry| $ 26)) |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p1| + (SETQ |p1| (LET ((#0=#:G1418 (SPADCALL |p1| |c1| (|getShellEntry| $ 27)))) @@ -63,23 +63,21 @@ (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) - (CDR #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p2| + (CDR #0#))) + (SETQ |p2| (LET ((#0# (SPADCALL |p2| |c2| (|getShellEntry| $ 27)))) (|check-union| (EQL (CAR #0#) 0) (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) - (CDR #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|) + (CDR #0#))) (SEQ (LETT |e1| (SPADCALL |p1| (|getShellEntry| $ 29)) |GCDDOM-;gcdPolynomial;3Sup;4|) (EXIT (COND ((> |e1| 0) - (LETT |p1| + (SETQ |p1| (LET ((#0# (SPADCALL |p1| @@ -92,14 +90,13 @@ (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) - (CDR #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (CDR #0#))))))) (SEQ (LETT |e2| (SPADCALL |p2| (|getShellEntry| $ 29)) |GCDDOM-;gcdPolynomial;3Sup;4|) (EXIT (COND ((> |e2| 0) - (LETT |p2| + (SETQ |p2| (LET ((#0# (SPADCALL |p2| @@ -112,14 +109,12 @@ (|SparseUnivariatePolynomial| (|getShellEntry| $ 6)) #0#) - (CDR #0#)) - |GCDDOM-;gcdPolynomial;3Sup;4|))))) + (CDR #0#))))))) (LETT |e1| (MIN |e1| |e2|) |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |c1| - (SPADCALL |c1| |c2| (|getShellEntry| $ 10)) - |GCDDOM-;gcdPolynomial;3Sup;4|) - (LETT |p1| + (SETQ |c1| + (SPADCALL |c1| |c2| (|getShellEntry| $ 10))) + (SETQ |p1| (COND ((OR (EQL (SPADCALL |p1| (|getShellEntry| $ 37)) @@ -142,14 +137,13 @@ (|getShellEntry| $ 34))) ('T (SEQ - (LETT |c2| + (SETQ |c2| (SPADCALL (SPADCALL |p1| (|getShellEntry| $ 40)) (SPADCALL |p2| (|getShellEntry| $ 40)) - (|getShellEntry| $ 10)) - |GCDDOM-;gcdPolynomial;3Sup;4|) + (|getShellEntry| $ 10))) (EXIT (SPADCALL (SPADCALL |c1| @@ -174,8 +168,7 @@ (CDR #0#)) (|getShellEntry| $ 42)) (|getShellEntry| $ 41)) - (|getShellEntry| $ 25)))))))))) - |GCDDOM-;gcdPolynomial;3Sup;4|) + (|getShellEntry| $ 25))))))))))) (EXIT (COND ((ZEROP |e1|) |p1|) ('T diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index f43c2f0c..820134e2 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -188,7 +188,7 @@ ((> |i| |n|) (RETURN NIL)) (T (SEQ (COND ((NULL |x|) (|error| "index out of range"))) - (EXIT (LETT |x| (CDR |x|) |ILIST;rest;$Nni$;19|))))) + (EXIT (SETQ |x| (CDR |x|)))))) (SETQ |i| (+ |i| 1)))) (EXIT |x|))) @@ -205,14 +205,13 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 35)) (|error| "cyclic list"))))) - (LETT |y| (CONS (CAR |x|) |y|) - |ILIST;copy;2$;20|) - (EXIT (LETT |x| (CDR |x|) |ILIST;copy;2$;20|))))) + (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 (|s| |y| |z|) + (PROG (|y| |s| |z|) (RETURN (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|) (LETT |s| (SPADCALL |x| (|getShellEntry| $ 40)) @@ -220,13 +219,12 @@ (LOOP (COND ((NOT (NOT (EQ |x| |s|))) (RETURN NIL)) - (T (SEQ (LETT |y| + (T (SEQ (SETQ |y| (CONS (SPADCALL (|SPADfirst| |x|) (|getShellEntry| $ 41)) - |y|) - |ILIST;coerce;$Of;21|) - (EXIT (LETT |x| (CDR |x|) |ILIST;coerce;$Of;21|)))))) - (LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|) + |y|)) + (EXIT (SETQ |x| (CDR |x|))))))) + (SETQ |y| (NREVERSE |y|)) (EXIT (COND ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 45))) ('T @@ -240,15 +238,13 @@ (COND ((NOT (NOT (EQ |s| (CDR |x|)))) (RETURN NIL)) - (T (SEQ (LETT |x| (CDR |x|) - |ILIST;coerce;$Of;21|) + (T (SEQ (SETQ |x| (CDR |x|)) (EXIT - (LETT |z| + (SETQ |z| (CONS (SPADCALL (|SPADfirst| |x|) (|getShellEntry| $ 41)) - |z|) - |ILIST;coerce;$Of;21|)))))) + |z|))))))) (EXIT (SPADCALL (SPADCALL |y| (SPADCALL @@ -271,9 +267,8 @@ (|getShellEntry| $ 53)) (RETURN-FROM |ILIST;=;2$B;22| NIL)) ('T - (SEQ (LETT |x| (CDR |x|) |ILIST;=;2$B;22|) - (EXIT (LETT |y| (CDR |y|) - |ILIST;=;2$B;22|)))))))) + (SEQ (SETQ |x| (CDR |x|)) + (EXIT (SETQ |y| (CDR |y|))))))))) (EXIT (COND ((NULL |x|) (NULL |y|)) ('T NIL)))))))) (DEFUN |ILIST;latex;$S;23| (|x| $) @@ -283,16 +278,14 @@ (LOOP (COND ((NOT (NOT (NULL |x|))) (RETURN NIL)) - (T (SEQ (LETT |s| + (T (SEQ (SETQ |s| (STRCONC |s| (SPADCALL (CAR |x|) - (|getShellEntry| $ 56))) - |ILIST;latex;$S;23|) - (LETT |x| (CDR |x|) |ILIST;latex;$S;23|) + (|getShellEntry| $ 56)))) + (SETQ |x| (CDR |x|)) (EXIT (COND ((NOT (NULL |x|)) - (LETT |s| (STRCONC |s| ", ") - |ILIST;latex;$S;23|)))))))) + (SETQ |s| (STRCONC |s| ", "))))))))) (EXIT (STRCONC |s| " \\right]")))))) (DEFUN |ILIST;member?;S$B;24| (|s| |x| $) @@ -302,7 +295,7 @@ (T (COND ((SPADCALL |s| (CAR |x|) (|getShellEntry| $ 59)) (RETURN-FROM |ILIST;member?;S$B;24| T)) - ('T (LETT |x| (CDR |x|) |ILIST;member?;S$B;24|)))))) + ('T (SETQ |x| (CDR |x|))))))) (EXIT NIL))) (DEFUN |ILIST;concat!;3$;25| (|x| |y| $) @@ -320,11 +313,11 @@ (LOOP (COND ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL)) - (T (LETT |z| (CDR |z|) |ILIST;concat!;3$;25|)))) + (T (SETQ |z| (CDR |z|))))) (QRPLACD |z| |y|) (EXIT |x|)))))))) (DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) - (PROG (|f| |p| |pr| |pp|) + (PROG (|p| |pp| |f| |pr|) (RETURN (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|) (LOOP @@ -333,8 +326,7 @@ (T (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|) (LETT |f| (CAR |p|) |ILIST;removeDuplicates!;2$;26|) - (LETT |p| (CDR |p|) - |ILIST;removeDuplicates!;2$;26|) + (SETQ |p| (CDR |p|)) (EXIT (LOOP (COND ((NOT (NOT @@ -346,9 +338,7 @@ ((SPADCALL (CAR |pr|) |f| (|getShellEntry| $ 59)) (QRPLACD |pp| (CDR |pr|))) - ('T - (LETT |pp| |pr| - |ILIST;removeDuplicates!;2$;26|))))))))))) + ('T (SETQ |pp| |pr|))))))))))) (EXIT |l|))))) (DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) @@ -367,14 +357,12 @@ (SEQ (LETT |r| (LETT |t| |p| |ILIST;merge!;M3$;28|) |ILIST;merge!;M3$;28|) - (EXIT (LETT |p| (CDR |p|) - |ILIST;merge!;M3$;28|)))) + (EXIT (SETQ |p| (CDR |p|))))) ('T (SEQ (LETT |r| (LETT |t| |q| |ILIST;merge!;M3$;28|) |ILIST;merge!;M3$;28|) - (EXIT (LETT |q| (CDR |q|) - |ILIST;merge!;M3$;28|))))) + (EXIT (SETQ |q| (CDR |q|)))))) (LOOP (COND ((NOT (COND @@ -385,13 +373,11 @@ ((SPADCALL (CAR |p|) (CAR |q|) |f|) (SEQ (QRPLACD |t| |p|) (LETT |t| |p| |ILIST;merge!;M3$;28|) - (EXIT (LETT |p| (CDR |p|) - |ILIST;merge!;M3$;28|)))) + (EXIT (SETQ |p| (CDR |p|))))) ('T (SEQ (QRPLACD |t| |q|) (LETT |t| |q| |ILIST;merge!;M3$;28|) - (EXIT (LETT |q| (CDR |q|) - |ILIST;merge!;M3$;28|)))))))) + (EXIT (SETQ |q| (CDR |q|))))))))) (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) (EXIT |r|)))))))) @@ -401,13 +387,12 @@ (SEQ (COND ((< |n| 1) (|error| "index out of range")) ('T - (SEQ (LETT |p| + (SEQ (SETQ |p| (|ILIST;rest;$Nni$;19| |p| (LET ((#0=#:G1506 (- |n| 1))) (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - $) - |ILIST;split!;$I$;29|) + $)) (LETT |q| (CDR |p|) |ILIST;split!;$I$;29|) (QRPLACD |p| NIL) (EXIT |q|)))))))) @@ -419,7 +404,7 @@ (COND ((SPADCALL (|SPADfirst| (CDR |p|)) (|SPADfirst| |p|) |f|) - (LETT |p| (NREVERSE |p|) |ILIST;mergeSort|))))) + (SETQ |p| (NREVERSE |p|)))))) (EXIT (COND ((< |n| 3) |p|) ('T @@ -430,12 +415,10 @@ |ILIST;mergeSort|) (LETT |q| (|ILIST;split!;$I$;29| |p| |l| $) |ILIST;mergeSort|) - (LETT |p| (|ILIST;mergeSort| |f| |p| |l| $) - |ILIST;mergeSort|) - (LETT |q| + (SETQ |p| (|ILIST;mergeSort| |f| |p| |l| $)) + (SETQ |q| (|ILIST;mergeSort| |f| |q| (- |n| |l|) - $) - |ILIST;mergeSort|) + $)) (EXIT (|ILIST;merge!;M3$;28| |f| |p| |q| $)))))))))) (DEFUN |IndexedList| (&REST #0=#:G1520 &AUX #1=#:G1518) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp index 9ea32aca..f75d7e3c 100644 --- a/src/algebra/strap/INS-.lsp +++ b/src/algebra/strap/INS-.lsp @@ -206,9 +206,8 @@ (SEQ (COND ((SPADCALL |n| (|spadConstant| $ 10) (|getShellEntry| $ 28)) - (LETT |n| - (SPADCALL |n| (|getShellEntry| $ 19)) - |INS-;symmetricRemainder;3S;27|))) + (SETQ |n| + (SPADCALL |n| (|getShellEntry| $ 19))))) (EXIT (COND ((SPADCALL |r| (|spadConstant| $ 10) (|getShellEntry| $ 16)) @@ -232,12 +231,11 @@ ('T |r|))))))))))) (DEFUN |INS-;invmod;3S;28| (|a| |b| $) - (PROG (|q| |r| |r1| |c| |c1| |d| |d1|) + (PROG (|c| |c1| |d| |d1| |q| |r| |r1|) (RETURN (SEQ (COND ((SPADCALL |a| (|getShellEntry| $ 85)) - (LETT |a| (SPADCALL |a| |b| (|getShellEntry| $ 86)) - |INS-;invmod;3S;28|))) + (SETQ |a| (SPADCALL |a| |b| (|getShellEntry| $ 86))))) (LETT |c| |a| |INS-;invmod;3S;28|) (LETT |c1| (|spadConstant| $ 22) |INS-;invmod;3S;28|) (LETT |d| |b| |INS-;invmod;3S;28|) @@ -261,10 +259,8 @@ (|getShellEntry| $ 88)) (|getShellEntry| $ 67)) |INS-;invmod;3S;28|) - (LETT |c| |d| |INS-;invmod;3S;28|) - (LETT |c1| |d1| |INS-;invmod;3S;28|) - (LETT |d| |r| |INS-;invmod;3S;28|) - (EXIT (LETT |d1| |r1| |INS-;invmod;3S;28|)))))) + (SETQ |c| |d|) (SETQ |c1| |d1|) (SETQ |d| |r|) + (EXIT (SETQ |d1| |r1|)))))) (COND ((NOT (SPADCALL |c| (|getShellEntry| $ 89))) (EXIT (|error| "inverse does not exist")))) @@ -278,8 +274,7 @@ (RETURN (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 85)) - (LETT |x| (SPADCALL |x| |p| (|getShellEntry| $ 86)) - |INS-;powmod;4S;29|))) + (SETQ |x| (SPADCALL |x| |p| (|getShellEntry| $ 86))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 66)) (|spadConstant| $ 10)) @@ -297,29 +292,26 @@ (COND ((SPADCALL |n| (|getShellEntry| $ 13)) - (LETT |y| + (SETQ |y| (SPADCALL |y| |z| |p| - (|getShellEntry| $ 91)) - |INS-;powmod;4S;29|))) + (|getShellEntry| $ 91))))) (EXIT (COND ((SPADCALL - (LETT |n| + (SETQ |n| (SPADCALL |n| (SPADCALL (|spadConstant| $ 22) (|getShellEntry| $ 19)) - (|getShellEntry| $ 20)) - |INS-;powmod;4S;29|) + (|getShellEntry| $ 20))) (|getShellEntry| $ 66)) (RETURN-FROM |INS-;powmod;4S;29| |y|)) ('T - (LETT |z| + (SETQ |z| (SPADCALL |z| |z| |p| - (|getShellEntry| $ 91)) - |INS-;powmod;4S;29|))))))))))))))))) + (|getShellEntry| $ 91))))))))))))))))))) (DEFUN |IntegerNumberSystem&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/INT.lsp b/src/algebra/strap/INT.lsp index 8a063aeb..919f0c16 100644 --- a/src/algebra/strap/INT.lsp +++ b/src/algebra/strap/INT.lsp @@ -275,7 +275,7 @@ ('T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) (DEFUN |INT;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |INT;OMwrite;$S;2|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$S;2|) @@ -287,11 +287,10 @@ (|INT;writeOMInt| |dev| |x| $) (SPADCALL |dev| (|getShellEntry| $ 24)) (SPADCALL |dev| (|getShellEntry| $ 25)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$S;2|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |INT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |INT;OMwrite;$BS;3|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |INT;OMwrite;$BS;3|) @@ -303,8 +302,7 @@ (|INT;writeOMInt| |dev| |x| $) (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) (SPADCALL |dev| (|getShellEntry| $ 25)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |INT;OMwrite;$BS;3|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |INT;OMwrite;Omd$V;4| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index f388672e..8f2a39fc 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -212,24 +212,21 @@ (COND ((> |i| #1#) (RETURN NIL)) (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) - (EXIT (LETT |k| (+ |k| 1) - |ISTRING;replace;$Us2$;15|))))) + (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 (LETT |k| (+ |k| 1) - |ISTRING;replace;$Us2$;15|))))) + (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 (LETT |k| (+ |k| 1) - |ISTRING;replace;$Us2$;15|))))) + (EXIT (SETQ |k| (+ |k| 1)))))) (SETQ |i| (+ |i| 1)))) (EXIT |r|))))) @@ -247,8 +244,7 @@ (RETURN (SEQ (LETT |np| (QCSIZE |part|) |ISTRING;substring?;2$IB;17|) (LETT |nw| (QCSIZE |whole|) |ISTRING;substring?;2$IB;17|) - (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) - |ISTRING;substring?;2$IB;17|) + (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) (EXIT (COND ((< |startpos| 0) (|error| "index out of bounds")) ((> |np| (- |nw| |startpos|)) NIL) @@ -272,8 +268,7 @@ (DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $) (PROG (|r|) (RETURN - (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) - |ISTRING;position;2$2I;18|) + (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) (EXIT (COND ((< |startpos| 0) (|error| "index out of bounds")) ((>= |startpos| (QCSIZE |t|)) @@ -287,8 +282,7 @@ ('T (+ |r| (|getShellEntry| $ 6))))))))))))) (DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) - (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) - |ISTRING;position;C$2I;19|) + (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) (EXIT (COND ((< |startpos| 0) (|error| "index out of bounds")) ((>= |startpos| (QCSIZE |t|)) @@ -308,8 +302,7 @@ (EXIT (- (|getShellEntry| $ 6) 1)))))))) (DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) - (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) - |ISTRING;position;Cc$2I;20|) + (SEQ (SETQ |startpos| (- |startpos| (|getShellEntry| $ 6))) (EXIT (COND ((< |startpos| 0) (|error| "index out of bounds")) ((>= |startpos| (QCSIZE |t|)) @@ -343,7 +336,7 @@ (- (+ (|getShellEntry| $ 6) |n|) |m|) $)))))))) (DEFUN |ISTRING;split;$CL;22| (|s| |c| $) - (PROG (|n| |j| |i| |l|) + (PROG (|n| |i| |l| |j|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;split;$CL;22|) @@ -356,7 +349,7 @@ (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| (|getShellEntry| $ 69))))) (RETURN NIL)) - (T (LETT |i| (+ |i| 1) |ISTRING;split;$CL;22|)))) + (T (SETQ |i| (+ |i| 1))))) (LETT |l| NIL |ISTRING;split;$CL;22|) (LOOP (COND @@ -369,15 +362,14 @@ |ISTRING;split;$CL;22|) (|getShellEntry| $ 6))))) (RETURN NIL)) - (T (SEQ (LETT |l| + (T (SEQ (SETQ |l| (SPADCALL (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| (- |j| 1) (|getShellEntry| $ 24)) $) - |l| (|getShellEntry| $ 72)) - |ISTRING;split;$CL;22|) - (LETT |i| |j| |ISTRING;split;$CL;22|) + |l| (|getShellEntry| $ 72))) + (SETQ |i| |j|) (EXIT (LOOP (COND ((NOT (COND @@ -388,21 +380,19 @@ |i| $) |c| (|getShellEntry| $ 69))))) (RETURN NIL)) - (T (LETT |i| (+ |i| 1) - |ISTRING;split;$CL;22|))))))))) + (T (SETQ |i| (+ |i| 1)))))))))) (COND ((NOT (> |i| |n|)) - (LETT |l| + (SETQ |l| (SPADCALL (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| |n| (|getShellEntry| $ 24)) $) - |l| (|getShellEntry| $ 72)) - |ISTRING;split;$CL;22|))) + |l| (|getShellEntry| $ 72))))) (EXIT (NREVERSE |l|)))))) (DEFUN |ISTRING;split;$CcL;23| (|s| |cc| $) - (PROG (|n| |j| |i| |l|) + (PROG (|n| |i| |l| |j|) (RETURN (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;split;$CcL;23|) @@ -415,7 +405,7 @@ (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| (|getShellEntry| $ 65))))) (RETURN NIL)) - (T (LETT |i| (+ |i| 1) |ISTRING;split;$CcL;23|)))) + (T (SETQ |i| (+ |i| 1))))) (LETT |l| NIL |ISTRING;split;$CcL;23|) (LOOP (COND @@ -428,15 +418,14 @@ |ISTRING;split;$CcL;23|) (|getShellEntry| $ 6))))) (RETURN NIL)) - (T (SEQ (LETT |l| + (T (SEQ (SETQ |l| (SPADCALL (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| (- |j| 1) (|getShellEntry| $ 24)) $) - |l| (|getShellEntry| $ 72)) - |ISTRING;split;$CcL;23|) - (LETT |i| |j| |ISTRING;split;$CcL;23|) + |l| (|getShellEntry| $ 72))) + (SETQ |i| |j|) (EXIT (LOOP (COND ((NOT (COND @@ -447,17 +436,15 @@ |i| $) |cc| (|getShellEntry| $ 65))))) (RETURN NIL)) - (T (LETT |i| (+ |i| 1) - |ISTRING;split;$CcL;23|))))))))) + (T (SETQ |i| (+ |i| 1)))))))))) (COND ((NOT (> |i| |n|)) - (LETT |l| + (SETQ |l| (SPADCALL (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| |n| (|getShellEntry| $ 24)) $) - |l| (|getShellEntry| $ 72)) - |ISTRING;split;$CcL;23|))) + |l| (|getShellEntry| $ 72))))) (EXIT (NREVERSE |l|)))))) (DEFUN |ISTRING;leftTrim;$C$;24| (|s| |c| $) @@ -474,7 +461,7 @@ (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| (|getShellEntry| $ 69))))) (RETURN NIL)) - (T (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$C$;24|)))) + (T (SETQ |i| (+ |i| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))) @@ -492,7 +479,7 @@ (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| (|getShellEntry| $ 65))))) (RETURN NIL)) - (T (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$Cc$;25|)))) + (T (SETQ |i| (+ |i| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))) @@ -509,7 +496,7 @@ (|getShellEntry| $ 69))) ('T NIL))) (RETURN NIL)) - (T (LETT |j| (- |j| 1) |ISTRING;rightTrim;$C$;26|)))) + (T (SETQ |j| (- |j| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| (|getShellEntry| $ 24)) @@ -528,7 +515,7 @@ (|getShellEntry| $ 65))) ('T NIL))) (RETURN NIL)) - (T (LETT |j| (- |j| 1) |ISTRING;rightTrim;$Cc$;27|)))) + (T (SETQ |j| (- |j| 1))))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| (|getShellEntry| $ 24)) @@ -560,8 +547,7 @@ ((ATOM #4#) (RETURN NIL)) (T (LET ((|s| (CAR #4#))) (SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $) - (EXIT (LETT |i| (+ |i| (QCSIZE |s|)) - |ISTRING;concat;L$;28|)))))) + (EXIT (SETQ |i| (+ |i| (QCSIZE |s|)))))))) (SETQ #4# (CDR #4#)))) (EXIT |t|))))) @@ -570,8 +556,7 @@ (RETURN (SEQ (LETT |m| (QCSIZE |x|) |ISTRING;copyInto!;2$I$;29|) (LETT |n| (QCSIZE |y|) |ISTRING;copyInto!;2$I$;29|) - (LETT |s| (- |s| (|getShellEntry| $ 6)) - |ISTRING;copyInto!;2$I$;29|) + (SETQ |s| (- |s| (|getShellEntry| $ 6))) (COND ((OR (< |s| 0) (> (+ |s| |m|) |n|)) (EXIT (|error| "index out of range")))) @@ -613,7 +598,7 @@ (|stringMatch| |pattern| |target| (CHARACTER |wildcard|))) (DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $) - (PROG (|m| |n| |s| |i| |p| |q|) + (PROG (|m| |n| |p| |i| |q| |s|) (RETURN (SEQ (LETT |n| (SPADCALL |pattern| (|getShellEntry| $ 47)) |ISTRING;match?;2$CB;34|) @@ -662,14 +647,13 @@ (|getShellEntry| $ 24)) $) |ISTRING;match?;2$CB;34|) - (LETT |i| + (SETQ |i| (LET ((#2=#:G1527 (|ISTRING;position;2$2I;18| |s| |target| |i| $))) (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#)) - |ISTRING;match?;2$CB;34|) + '(|NonNegativeInteger|) #2#))) (EXIT (COND ((EQL |i| (- |m| 1)) @@ -678,13 +662,11 @@ NIL)) ('T (SEQ - (LETT |i| - (+ |i| (QCSIZE |s|)) - |ISTRING;match?;2$CB;34|) - (LETT |p| |q| - |ISTRING;match?;2$CB;34|) + (SETQ |i| + (+ |i| (QCSIZE |s|))) + (SETQ |p| |q|) (EXIT - (LETT |q| + (SETQ |q| (LET ((#3=#:G1528 (|ISTRING;position;C$2I;19| @@ -693,8 +675,7 @@ (|check-subtype| (>= #3# 0) '(|NonNegativeInteger|) - #3#)) - |ISTRING;match?;2$CB;34|)))))))))) + #3#)))))))))))) (COND ((SPADCALL |p| |n| (|getShellEntry| $ 87)) (COND diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index a91654a2..3eec6e6d 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -69,13 +69,12 @@ (T (SEQ (SPADCALL |dev| (SPADCALL |x| (|getShellEntry| $ 20)) NIL (|getShellEntry| $ 22)) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 23)) - |LIST;writeOMList|)))))) + (EXIT (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 23)))))))) (EXIT (SPADCALL |dev| (|getShellEntry| $ 24))))) (DEFUN |LIST;OMwrite;$S;6| (|x| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |LIST;OMwrite;$S;6|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$S;6|) @@ -87,11 +86,10 @@ (|LIST;writeOMList| |dev| |x| $) (SPADCALL |dev| (|getShellEntry| $ 29)) (SPADCALL |dev| (|getShellEntry| $ 30)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$S;6|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |LIST;OMwrite;$BS;7|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$BS;7|) @@ -103,8 +101,7 @@ (|LIST;writeOMList| |dev| |x| $) (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 29)))) (SPADCALL |dev| (|getShellEntry| $ 30)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$BS;7|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 28)) @@ -126,8 +123,7 @@ (RETURN (SEQ (LETT |u| (SPADCALL (|getShellEntry| $ 38)) |LIST;setIntersection;3$;11|) - (LETT |l1| (SPADCALL |l1| (|getShellEntry| $ 36)) - |LIST;setIntersection;3$;11|) + (SETQ |l1| (SPADCALL |l1| (|getShellEntry| $ 36))) (LOOP (COND ((NOT (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) @@ -136,22 +132,19 @@ ((SPADCALL (SPADCALL |l1| (|getShellEntry| $ 20)) |l2| (|getShellEntry| $ 40)) - (LETT |u| + (SETQ |u| (CONS (SPADCALL |l1| (|getShellEntry| $ 20)) - |u|) - |LIST;setIntersection;3$;11|))) - (EXIT (LETT |l1| + |u|)))) + (EXIT (SETQ |l1| (SPADCALL |l1| - (|getShellEntry| $ 23)) - |LIST;setIntersection;3$;11|)))))) + (|getShellEntry| $ 23)))))))) (EXIT |u|))))) (DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) - (PROG (|l11| |lu|) + (PROG (|lu| |l11|) (RETURN - (SEQ (LETT |l1| (SPADCALL |l1| (|getShellEntry| $ 36)) - |LIST;setDifference;3$;12|) + (SEQ (SETQ |l1| (SPADCALL |l1| (|getShellEntry| $ 36))) (LETT |lu| (SPADCALL (|getShellEntry| $ 38)) |LIST;setDifference;3$;12|) (LOOP @@ -164,14 +157,12 @@ (COND ((NOT (SPADCALL |l11| |l2| (|getShellEntry| $ 40))) - (LETT |lu| + (SETQ |lu| (SPADCALL |l11| |lu| - (|getShellEntry| $ 43)) - |LIST;setDifference;3$;12|))) - (EXIT (LETT |l1| + (|getShellEntry| $ 43))))) + (EXIT (SETQ |l1| (SPADCALL |l1| - (|getShellEntry| $ 23)) - |LIST;setDifference;3$;12|)))))) + (|getShellEntry| $ 23)))))))) (EXIT |lu|))))) (DEFUN |LIST;convert;$If;13| (|x| $) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index 839b2578..4709bc5a 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -119,8 +119,7 @@ (SPADCALL |x| (|getShellEntry| $ 18)) |f|))))) (RETURN NIL)) - (T (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|)))) + (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) |x|) ('T @@ -139,20 +138,16 @@ (SPADCALL |z| (|getShellEntry| $ 18)) |f|) - (SEQ - (LETT |y| |z| - |LSAGG-;select!;M2A;5|) + (SEQ (SETQ |y| |z|) (EXIT - (LETT |z| + (SETQ |z| (SPADCALL |z| - (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|)))) + (|getShellEntry| $ 17)))))) ('T (SEQ - (LETT |z| + (SETQ |z| (SPADCALL |z| - (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|) + (|getShellEntry| $ 17))) (EXIT (SPADCALL |y| |z| (|getShellEntry| $ 27))))))))) @@ -173,18 +168,16 @@ (SEQ (LETT |r| (LETT |t| |p| |LSAGG-;merge!;M3A;6|) |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |p| + (EXIT (SETQ |p| (SPADCALL |p| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|)))) + (|getShellEntry| $ 17)))))) ('T (SEQ (LETT |r| (LETT |t| |q| |LSAGG-;merge!;M3A;6|) |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |q| + (EXIT (SETQ |q| (SPADCALL |q| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|))))) + (|getShellEntry| $ 17))))))) (LOOP (COND ((NOT (COND @@ -202,18 +195,16 @@ (SEQ (SPADCALL |t| |p| (|getShellEntry| $ 27)) (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |p| + (EXIT (SETQ |p| (SPADCALL |p| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|)))) + (|getShellEntry| $ 17)))))) ('T (SEQ (SPADCALL |t| |q| (|getShellEntry| $ 27)) (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |q| + (EXIT (SETQ |q| (SPADCALL |q| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|)))))))) + (|getShellEntry| $ 17)))))))))) (SPADCALL |t| (COND ((SPADCALL |p| (|getShellEntry| $ 16)) |q|) @@ -283,8 +274,7 @@ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) |f|)))) (RETURN NIL)) - (T (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;remove!;M2A;9|)))) + (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) |x|) ('T @@ -303,21 +293,17 @@ (SPADCALL |q| (|getShellEntry| $ 18)) |f|) - (LETT |q| + (SETQ |q| (SPADCALL |p| (SPADCALL |q| (|getShellEntry| $ 17)) - (|getShellEntry| $ 27)) - |LSAGG-;remove!;M2A;9|)) + (|getShellEntry| $ 27)))) ('T - (SEQ - (LETT |p| |q| - |LSAGG-;remove!;M2A;9|) + (SEQ (SETQ |p| |q|) (EXIT - (LETT |q| + (SETQ |q| (SPADCALL |q| - (|getShellEntry| $ 17)) - |LSAGG-;remove!;M2A;9|)))))))) + (|getShellEntry| $ 17)))))))))) (EXIT |x|))))))))) (DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) @@ -401,8 +387,7 @@ (NOT (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) |f|))))) (RETURN NIL)) - (T (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;find;MAU;12|)))) + (T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (CONS 1 "failed")) @@ -422,10 +407,8 @@ (SPADCALL |x| (|getShellEntry| $ 18)) |f|))))) (RETURN NIL)) - (T (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;position;MAI;13|) - (EXIT (LETT |k| (+ |k| 1) - |LSAGG-;position;MAI;13|)))))) + (T (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |k| (+ |k| 1))))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) @@ -441,8 +424,7 @@ (SPADCALL (SPADCALL |p| (|getShellEntry| $ 17)) (|getShellEntry| $ 18)) (SPADCALL |p| (|getShellEntry| $ 18)) |f|) - (LETT |p| (SPADCALL |p| (|getShellEntry| $ 55)) - |LSAGG-;mergeSort|))))) + (SETQ |p| (SPADCALL |p| (|getShellEntry| $ 55))))))) (EXIT (COND ((< |n| 3) |p|) ('T @@ -455,12 +437,10 @@ (SPADCALL |p| |l| (|getShellEntry| $ 57)) |LSAGG-;mergeSort|) - (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| $) - |LSAGG-;mergeSort|) - (LETT |q| + (SETQ |p| (|LSAGG-;mergeSort| |f| |p| |l| $)) + (SETQ |q| (|LSAGG-;mergeSort| |f| |q| (- |n| |l|) - $) - |LSAGG-;mergeSort|) + $)) (EXIT (SPADCALL |f| |p| |q| (|getShellEntry| $ 23))))))))))) @@ -485,12 +465,9 @@ |f|)) (RETURN-FROM |LSAGG-;sorted?;MAB;15| NIL))) - (EXIT (LETT |p| - (SPADCALL - (LETT |l| |p| - |LSAGG-;sorted?;MAB;15|) - (|getShellEntry| $ 17)) - |LSAGG-;sorted?;MAB;15|)))))) + (EXIT (SETQ |p| + (SPADCALL (SETQ |l| |p|) + (|getShellEntry| $ 17)))))))) (EXIT T)))))))) (DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) @@ -501,15 +478,13 @@ (COND ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) (RETURN NIL)) - (T (SEQ (LETT |r| + (T (SEQ (SETQ |r| (SPADCALL |r| (SPADCALL |x| (|getShellEntry| $ 18)) - |f|) - |LSAGG-;reduce;MA2S;16|) - (EXIT (LETT |x| + |f|)) + (EXIT (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;reduce;MA2S;16|)))))) + (|getShellEntry| $ 17)))))))) (EXIT |r|))))) (DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) @@ -522,15 +497,13 @@ ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) ('T (SPADCALL |r| |a| (|getShellEntry| $ 61))))) (RETURN NIL)) - (T (SEQ (LETT |r| + (T (SEQ (SETQ |r| (SPADCALL |r| (SPADCALL |x| (|getShellEntry| $ 18)) - |f|) - |LSAGG-;reduce;MA3S;17|) - (EXIT (LETT |x| + |f|)) + (EXIT (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;reduce;MA3S;17|)))))) + (|getShellEntry| $ 17)))))))) (EXIT |r|))))) (DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) @@ -542,8 +515,8 @@ (LOOP (COND ((> |k| |n|) (RETURN NIL)) - (T (LETT |l| (SPADCALL |s| |l| (|getShellEntry| $ 14)) - |LSAGG-;new;NniSA;18|))) + (T (SETQ |l| + (SPADCALL |s| |l| (|getShellEntry| $ 14))))) (SETQ |k| (+ |k| 1)))) (EXIT |l|))))) @@ -558,7 +531,7 @@ ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) (RETURN NIL)) - (T (SEQ (LETT |z| + (T (SEQ (SETQ |z| (SPADCALL (SPADCALL (SPADCALL |x| @@ -566,14 +539,11 @@ (SPADCALL |y| (|getShellEntry| $ 18)) |f|) - |z| (|getShellEntry| $ 14)) - |LSAGG-;map;M3A;19|) - (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;map;M3A;19|) - (EXIT (LETT |y| + |z| (|getShellEntry| $ 14))) + (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 17)) - |LSAGG-;map;M3A;19|)))))) + (|getShellEntry| $ 17)))))))) (EXIT (SPADCALL |z| (|getShellEntry| $ 55))))))) (DEFUN |LSAGG-;reverse!;2A;20| (|x| $) @@ -599,7 +569,7 @@ |LSAGG-;reverse!;2A;20|) (SPADCALL |y| |x| (|getShellEntry| $ 27)) - (LETT |x| |y| |LSAGG-;reverse!;2A;20|) + (SETQ |x| |y|) (EXIT (LETT |y| |z| |LSAGG-;reverse!;2A;20|)))))) (EXIT |x|)))))))) @@ -619,16 +589,14 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 67)) (EXIT (|error| "cyclic list")))))) - (LETT |y| + (SETQ |y| (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) - |y| (|getShellEntry| $ 14)) - |LSAGG-;copy;2A;21|) - (EXIT (LETT |x| + |y| (|getShellEntry| $ 14))) + (EXIT (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;copy;2A;21|))))) + (|getShellEntry| $ 17))))))) (SETQ |k| (+ |k| 1)))) (EXIT (SPADCALL |y| (|getShellEntry| $ 55))))))) @@ -662,15 +630,13 @@ (SPADCALL |x| (|getShellEntry| $ 18)) (|getShellEntry| $ 69)) - (LETT |x| + (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;copyInto!;2AIA;22|) + (|getShellEntry| $ 17))) (EXIT - (LETT |z| + (SETQ |z| (SPADCALL |z| - (|getShellEntry| $ 17)) - |LSAGG-;copyInto!;2AIA;22|)))))) + (|getShellEntry| $ 17)))))))) (EXIT |y|))))))))) (DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) @@ -681,13 +647,12 @@ (EXIT (COND ((< |s| |m|) (|error| "index out of range")) ('T - (SEQ (LETT |x| + (SEQ (SETQ |x| (SPADCALL |x| (LET ((#0=#:G1559 (- |s| |m|))) (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 39)) - |LSAGG-;position;SA2I;23|) + (|getShellEntry| $ 39))) (LETT |k| |s| |LSAGG-;position;SA2I;23|) (LOOP (COND @@ -701,13 +666,10 @@ (|getShellEntry| $ 18)) (|getShellEntry| $ 61))))) (RETURN NIL)) - (T (SEQ (LETT |x| + (T (SEQ (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;position;SA2I;23|) - (EXIT - (LETT |k| (+ |k| 1) - |LSAGG-;position;SA2I;23|)))))) + (|getShellEntry| $ 17))) + (EXIT (SETQ |k| (+ |k| 1))))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (- (SPADCALL |x| @@ -723,15 +685,14 @@ (COND ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) (RETURN NIL)) - (T (LETT |p| + (T (SETQ |p| (SPADCALL |p| (SPADCALL (CONS #'|LSAGG-;removeDuplicates!;2A;24!0| (VECTOR $ |p|)) (SPADCALL |p| (|getShellEntry| $ 17)) (|getShellEntry| $ 73)) - (|getShellEntry| $ 27)) - |LSAGG-;removeDuplicates!;2A;24|)))) + (|getShellEntry| $ 27)))))) (EXIT |l|))))) (DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) @@ -756,11 +717,9 @@ (SPADCALL |y| (|getShellEntry| $ 18)) (|getShellEntry| $ 75)))) ('T - (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;<;2AB;25|) - (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;<;2AB;25|)))))))) + (SEQ (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 17))) + (EXIT (SETQ |y| + (SPADCALL |y| (|getShellEntry| $ 17)))))))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (NOT (SPADCALL |y| (|getShellEntry| $ 16)))) diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp index 5cc0a555..70ac70a6 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -675,11 +675,8 @@ (T (LET ((|u| (CAR #0#))) (COND ((EQCAR |u| |c|) - (LETT |l1| (APPEND (CDR |u|) |l1|) - |OUTFORM;blankSeparate;L$;35|)) - ('T - (LETT |l1| (CONS |u| |l1|) - |OUTFORM;blankSeparate;L$;35|)))))) + (SETQ |l1| (APPEND (CDR |u|) |l1|))) + ('T (SETQ |l1| (CONS |u| |l1|))))))) (SETQ #0# (CDR #0#)))) (EXIT (CONS |c| |l1|)))))) @@ -730,8 +727,7 @@ (DEFUN |OUTFORM;supersub;$L$;47| (|a| |l| $) (SEQ (COND ((ODDP (LENGTH |l|)) - (LETT |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $))) - |OUTFORM;supersub;$L$;47|))) + (SETQ |l| (APPEND |l| (LIST (|OUTFORM;empty;$;73| $)))))) (EXIT (CONS 'ALTSUPERSUB (CONS |a| |l|))))) (DEFUN |OUTFORM;hconcat;3$;48| (|a| |b| $) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 77d1c45c..36bc9506 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -202,15 +202,13 @@ ((NOT (SPADCALL |p| (|spadConstant| $ 27) (|getShellEntry| $ 29))) (RETURN NIL)) - (T (SEQ (LETT |ml| + (T (SEQ (SETQ |ml| (CONS (SPADCALL |p| (|getShellEntry| $ 30)) - |ml|) - |POLYCAT-;monomials;SL;2|) - (EXIT (LETT |p| + |ml|)) + (EXIT (SETQ |p| (SPADCALL |p| - (|getShellEntry| $ 32)) - |POLYCAT-;monomials;SL;2|)))))) + (|getShellEntry| $ 32)))))))) (EXIT (REVERSE |ml|)))))) (DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) @@ -365,7 +363,7 @@ (SETQ #0# (CDR #0#))))) (DEFUN |POLYCAT-;totalDegree;SNni;13| (|p| $) - (PROG (|d| |u|) + (PROG (|u| |d|) (RETURN (SEQ (COND ((SPADCALL |p| (|getShellEntry| $ 78)) 0) @@ -386,7 +384,7 @@ ((NOT (SPADCALL |u| (|spadConstant| $ 80) (|getShellEntry| $ 81))) (RETURN NIL)) - (T (SEQ (LETT |d| + (T (SEQ (SETQ |d| (MAX |d| (+ (SPADCALL |u| @@ -394,16 +392,14 @@ (SPADCALL (SPADCALL |u| (|getShellEntry| $ 83)) - (|getShellEntry| $ 84)))) - |POLYCAT-;totalDegree;SNni;13|) - (EXIT (LETT |u| + (|getShellEntry| $ 84))))) + (EXIT (SETQ |u| (SPADCALL |u| - (|getShellEntry| $ 87)) - |POLYCAT-;totalDegree;SNni;13|)))))) + (|getShellEntry| $ 87)))))))) (EXIT |d|)))))))) (DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) - (PROG (|v| |w| |d| |u|) + (PROG (|v| |u| |d| |w|) (RETURN (SEQ (COND ((SPADCALL |p| (|getShellEntry| $ 78)) 0) @@ -425,13 +421,13 @@ (LETT |w| 0 |POLYCAT-;totalDegree;SLNni;14|) (COND ((SPADCALL |v| |lv| (|getShellEntry| $ 89)) - (LETT |w| 1 |POLYCAT-;totalDegree;SLNni;14|))) + (SETQ |w| 1))) (LOOP (COND ((NOT (SPADCALL |u| (|spadConstant| $ 80) - (|getShellEntry| $ 81))) + (|getShellEntry| $ 81))) (RETURN NIL)) - (T (SEQ (LETT |d| + (T (SEQ (SETQ |d| (MAX |d| (+ (* |w| @@ -440,12 +436,10 @@ (SPADCALL (SPADCALL |u| (|getShellEntry| $ 83)) - |lv| (|getShellEntry| $ 92)))) - |POLYCAT-;totalDegree;SLNni;14|) - (EXIT (LETT |u| + |lv| (|getShellEntry| $ 92))))) + (EXIT (SETQ |u| (SPADCALL |u| - (|getShellEntry| $ 87)) - |POLYCAT-;totalDegree;SLNni;14|)))))) + (|getShellEntry| $ 87)))))))) (EXIT |d|)))))))) (DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) @@ -518,7 +512,7 @@ (|getShellEntry| $ 111))) (DEFUN |POLYCAT-;reducedSystem;MM;20| (|m| $) - (PROG (|b| |d| |mm| |l|) + (PROG (|l| |b| |d| |mm|) (RETURN (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 114)) |POLYCAT-;reducedSystem;MM;20|) @@ -551,22 +545,20 @@ |POLYCAT-;reducedSystem;MM;20|) (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) |POLYCAT-;reducedSystem;MM;20|) - (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MM;20|) + (SETQ |l| (CDR |l|)) (LOOP (COND ((NOT (NOT (NULL |l|))) (RETURN NIL)) - (T (SEQ (LETT |mm| + (T (SEQ (SETQ |mm| (SPADCALL |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) - (|getShellEntry| $ 119)) - |POLYCAT-;reducedSystem;MM;20|) - (EXIT (LETT |l| (CDR |l|) - |POLYCAT-;reducedSystem;MM;20|)))))) + (|getShellEntry| $ 119))) + (EXIT (SETQ |l| (CDR |l|))))))) (EXIT |mm|))))) (DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) - (PROG (|b| |d| |n| |mm| |w| |l| |r|) + (PROG (|l| |r| |b| |d| |n| |mm| |w|) (RETURN (SEQ (LETT |l| (SPADCALL |m| (|getShellEntry| $ 114)) |POLYCAT-;reducedSystem;MVR;21|) @@ -608,27 +600,22 @@ |POLYCAT-;reducedSystem;MVR;21|) (LETT |w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $) |POLYCAT-;reducedSystem;MVR;21|) - (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MVR;21|) - (LETT |r| (CDR |r|) |POLYCAT-;reducedSystem;MVR;21|) + (SETQ |l| (CDR |l|)) (SETQ |r| (CDR |r|)) (LOOP (COND ((NOT (NOT (NULL |l|))) (RETURN NIL)) - (T (SEQ (LETT |mm| + (T (SEQ (SETQ |mm| (SPADCALL |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) - (|getShellEntry| $ 119)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |w| + (|getShellEntry| $ 119))) + (SETQ |w| (SPADCALL |w| (|POLYCAT-;P2R| (|SPADfirst| |r|) |d| |n| $) - (|getShellEntry| $ 128)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |l| (CDR |l|) - |POLYCAT-;reducedSystem;MVR;21|) - (EXIT (LETT |r| (CDR |r|) - |POLYCAT-;reducedSystem;MVR;21|)))))) + (|getShellEntry| $ 128))) + (SETQ |l| (CDR |l|)) + (EXIT (SETQ |r| (CDR |r|))))))) (EXIT (CONS |mm| |w|)))))) (DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) @@ -823,16 +810,15 @@ #9#))))) (SETQ #8# (CDR #8#)))) |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| + (SETQ |redmons| (CONS (SPADCALL (|spadConstant| $ 43) |vars| |deg1| (|getShellEntry| $ 70)) - |redmons|) - |POLYCAT-;conditionP;MU;27|) + |redmons|)) (EXIT - (LETT |llR| + (SETQ |llR| (LET ((#11=#:G1728 |l|) (#12=#:G1729 |llR|) @@ -860,12 +846,10 @@ |v|) #13#))))) (SETQ #11# (CDR #11#)) - (SETQ #12# (CDR #12#)))) - |POLYCAT-;conditionP;MU;27|)))))) + (SETQ #12# (CDR #12#)))))))))) (SETQ #7# (CDR #7#)))) - (EXIT (LETT |monslist| - (CONS |redmons| |monslist|) - |POLYCAT-;conditionP;MU;27|)))))) + (EXIT (SETQ |monslist| + (CONS |redmons| |monslist|))))))) (SETQ #2# (CDR #2#)))) (LETT |ans| (SPADCALL @@ -921,11 +905,10 @@ (SPADCALL (CDR |ans|) - (LETT + (SETQ |i| (+ |i| - 1) - |POLYCAT-;conditionP;MU;27|) + 1)) (|getShellEntry| $ 181)) (|getShellEntry| @@ -980,7 +963,7 @@ $)))))))))) (DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $) - (PROG (|v| |dd| |cp| |d| |ans| |ansx|) + (PROG (|v| |d| |ans| |dd| |cp| |ansx|) (RETURN (SEQ (COND ((NULL |vars|) @@ -998,7 +981,7 @@ ('T (SEQ (LETT |v| (|SPADfirst| |vars|) |POLYCAT-;charthRootlv|) - (LETT |vars| (CDR |vars|) |POLYCAT-;charthRootlv|) + (SETQ |vars| (CDR |vars|)) (LETT |d| (SPADCALL |p| |v| (|getShellEntry| $ 46)) |POLYCAT-;charthRootlv|) (LETT |ans| (|spadConstant| $ 27) @@ -1021,12 +1004,11 @@ (SPADCALL |p| |v| |d| (|getShellEntry| $ 188)) |POLYCAT-;charthRootlv|) - (LETT |p| + (SETQ |p| (SPADCALL |p| (SPADCALL |cp| |v| |d| (|getShellEntry| $ 47)) - (|getShellEntry| $ 189)) - |POLYCAT-;charthRootlv|) + (|getShellEntry| $ 189))) (LETT |ansx| (|POLYCAT-;charthRootlv| |cp| |vars| |ch| $) @@ -1039,12 +1021,11 @@ (CONS 1 "failed"))) ('T (SEQ - (LETT |d| + (SETQ |d| (SPADCALL |p| |v| - (|getShellEntry| $ 46)) - |POLYCAT-;charthRootlv|) + (|getShellEntry| $ 46))) (EXIT - (LETT |ans| + (SETQ |ans| (SPADCALL |ans| (SPADCALL (CDR |ansx|) |v| @@ -1058,8 +1039,7 @@ (|getShellEntry| $ 47)) (|getShellEntry| $ - 183)) - |POLYCAT-;charthRootlv|)))))))))))))) + 183)))))))))))))))) (LETT |ansx| (|POLYCAT-;charthRootlv| |p| |vars| |ch| $) |POLYCAT-;charthRootlv|) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp index de5cddb0..daacfe07 100644 --- a/src/algebra/strap/QFCAT-.lsp +++ b/src/algebra/strap/QFCAT-.lsp @@ -174,16 +174,16 @@ (PROGN (LETT |#G19| |y| |QFCAT-;<;2AB;13|) (LETT |#G20| |x| |QFCAT-;<;2AB;13|) - (LETT |x| |#G19| |QFCAT-;<;2AB;13|) - (LETT |y| |#G20| |QFCAT-;<;2AB;13|)))) + (SETQ |x| |#G19|) + (SETQ |y| |#G20|)))) (COND ((SPADCALL (SPADCALL |y| (|getShellEntry| $ 11)) (|spadConstant| $ 52) (|getShellEntry| $ 50)) (PROGN (LETT |#G21| |y| |QFCAT-;<;2AB;13|) (LETT |#G22| |x| |QFCAT-;<;2AB;13|) - (LETT |x| |#G21| |QFCAT-;<;2AB;13|) - (LETT |y| |#G22| |QFCAT-;<;2AB;13|)))) + (SETQ |x| |#G21|) + (SETQ |y| |#G22|)))) (EXIT (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 8)) (SPADCALL |y| (|getShellEntry| $ 11)) diff --git a/src/algebra/strap/SINT.lsp b/src/algebra/strap/SINT.lsp index 47b51bcc..c0ec6dbb 100644 --- a/src/algebra/strap/SINT.lsp +++ b/src/algebra/strap/SINT.lsp @@ -295,7 +295,7 @@ ('T (SPADCALL |dev| |x| (|getShellEntry| $ 18)))))) (DEFUN |SINT;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |SINT;OMwrite;$S;2|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$S;2|) @@ -307,11 +307,10 @@ (|SINT;writeOMSingleInt| |dev| |x| $) (SPADCALL |dev| (|getShellEntry| $ 24)) (SPADCALL |dev| (|getShellEntry| $ 25)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$S;2|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |SINT;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |SINT;OMwrite;$BS;3|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SINT;OMwrite;$BS;3|) @@ -323,8 +322,7 @@ (|SINT;writeOMSingleInt| |dev| |x| $) (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 24)))) (SPADCALL |dev| (|getShellEntry| $ 25)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SINT;OMwrite;$BS;3|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |SINT;OMwrite;Omd$V;4| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 23)) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 7a847cd1..2232262b 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -57,10 +57,9 @@ ((> |i| |n|) (RETURN (NREVERSE #0#))) (T (SETQ #0# (CONS (|STAGG-;c2| |x| - (LETT |x| + (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 13)) - |STAGG-;first;ANniA;3|) + (|getShellEntry| $ 13))) $) #0#)))) (SETQ |i| (+ |i| 1)))) @@ -73,17 +72,15 @@ ('T (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) - (SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;elt;AIS;5|) + (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))) (COND ((OR (< |i| 0) (SPADCALL - (LETT |x| + (SETQ |x| (SPADCALL |x| (|check-subtype| (>= |i| 0) '(|NonNegativeInteger|) |i|) - (|getShellEntry| $ 25)) - |STAGG-;elt;AIS;5|) + (|getShellEntry| $ 25))) (|getShellEntry| $ 18))) (EXIT (|error| "index out of range")))) (EXIT (SPADCALL |x| (|getShellEntry| $ 19))))) @@ -149,10 +146,9 @@ (SPADCALL |l| (|getShellEntry| $ 19)) |f|) (|getShellEntry| $ 46)) - (EXIT (LETT |l| + (EXIT (SETQ |l| (SPADCALL |l| - (|getShellEntry| $ 13)) - |STAGG-;map!;M2A;9|)))))) + (|getShellEntry| $ 13)))))))) (EXIT |y|))))) (DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) @@ -164,30 +160,27 @@ ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) (RETURN NIL)) (T (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) - (EXIT (LETT |y| + (EXIT (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 13)) - |STAGG-;fill!;ASA;10|)))))) + (|getShellEntry| $ 13)))))))) (EXIT |x|))))) (DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) - (SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;setelt;AI2S;11|) + (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))) (COND ((OR (< |i| 0) (SPADCALL - (LETT |x| + (SETQ |x| (SPADCALL |x| (|check-subtype| (>= |i| 0) '(|NonNegativeInteger|) |i|) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AI2S;11|) + (|getShellEntry| $ 25))) (|getShellEntry| $ 18))) (EXIT (|error| "index out of range")))) (EXIT (SPADCALL |x| |s| (|getShellEntry| $ 46))))) (DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) - (PROG (|l| |h| |z| |y|) + (PROG (|l| |h| |y| |z|) (RETURN (SEQ (LETT |l| (- (SPADCALL |i| (|getShellEntry| $ 28)) @@ -237,10 +230,9 @@ (SPADCALL |y| |s| (|getShellEntry| $ 46)) (EXIT - (LETT |y| + (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 13)) - |STAGG-;setelt;AUs2S;12|)))))) + (|getShellEntry| $ 13)))))))) (EXIT |s|))))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index e31d990e..a34479e4 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -122,7 +122,7 @@ ('T (SPADCALL |dev| |x| (|getShellEntry| $ 27))))) (DEFUN |SYMBOL;OMwrite;$S;2| (|x| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |SYMBOL;OMwrite;$S;2|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |SYMBOL;OMwrite;$S;2|) @@ -134,11 +134,10 @@ (|SYMBOL;writeOMSym| |dev| |x| $) (SPADCALL |dev| (|getShellEntry| $ 32)) (SPADCALL |dev| (|getShellEntry| $ 33)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |SYMBOL;OMwrite;$S;2|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |SYMBOL;OMwrite;$BS;3| (|x| |wholeObj| $) - (PROG (|sp| |dev| |s|) + (PROG (|s| |sp| |dev|) (RETURN (SEQ (LETT |s| "" |SYMBOL;OMwrite;$BS;3|) (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) @@ -151,9 +150,7 @@ (|SYMBOL;writeOMSym| |dev| |x| $) (COND (|wholeObj| (SPADCALL |dev| (|getShellEntry| $ 32)))) (SPADCALL |dev| (|getShellEntry| $ 33)) - (LETT |s| (OM-STRINGPTRTOSTRING |sp|) - |SYMBOL;OMwrite;$BS;3|) - (EXIT |s|))))) + (SETQ |s| (OM-STRINGPTRTOSTRING |sp|)) (EXIT |s|))))) (DEFUN |SYMBOL;OMwrite;Omd$V;4| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 31)) @@ -222,7 +219,7 @@ (ZEROP (|SPADfirst| |ns|))) ('T NIL))) (RETURN NIL)) - (T (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|)))) + (T (SETQ |ns| (CDR |ns|))))) (EXIT (SPADCALL (CONS (STRCONC (|getShellEntry| $ 38) (|SYMBOL;istring| @@ -243,15 +240,12 @@ (PROG (|all|) (RETURN (SEQ (LETT |all| (QVELT |sc| 3) |SYMBOL;syscripts|) - (LETT |all| - (SPADCALL (QVELT |sc| 2) |all| (|getShellEntry| $ 94)) - |SYMBOL;syscripts|) - (LETT |all| - (SPADCALL (QVELT |sc| 1) |all| (|getShellEntry| $ 94)) - |SYMBOL;syscripts|) - (LETT |all| - (SPADCALL (QVELT |sc| 0) |all| (|getShellEntry| $ 94)) - |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))))))) (DEFUN |SYMBOL;script;$L$;22| (|sy| |ls| $) @@ -262,23 +256,23 @@ (COND ((NOT (NULL |ls|)) (SEQ (QSETVELT |sc| 0 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) (SEQ (QSETVELT |sc| 1 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) (SEQ (QSETVELT |sc| 2 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) (SEQ (QSETVELT |sc| 3 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SETQ |ls| (CDR |ls|)))))) (COND ((NOT (NULL |ls|)) (SEQ (QSETVELT |sc| 4 (|SPADfirst| |ls|)) - (EXIT (LETT |ls| (CDR |ls|) |SYMBOL;script;$L$;22|))))) + (EXIT (SETQ |ls| (CDR |ls|)))))) (EXIT (|SYMBOL;script;$R$;23| |sy| |sc| $)))))) (DEFUN |SYMBOL;script;$R$;23| (|sy| |sc| $) @@ -301,7 +295,7 @@ ('T (|error| "Cannot form string from non-atomic symbols.")))) (DEFUN |SYMBOL;latex;$S;25| (|e| $) - (PROG (|ss| |lo| |sc| |s|) + (PROG (|s| |ss| |lo| |sc|) (RETURN (SEQ (LETT |s| (PNAME (|SYMBOL;name;2$;31| |e| $)) |SYMBOL;latex;$S;25|) @@ -311,8 +305,7 @@ ((SPADCALL (SPADCALL |s| 1 (|getShellEntry| $ 106)) (SPADCALL "\\" (|getShellEntry| $ 43)) (|getShellEntry| $ 107)) - (LETT |s| (STRCONC "\\mbox{\\it " (STRCONC |s| "}")) - |SYMBOL;latex;$S;25|))))) + (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|) @@ -323,109 +316,88 @@ (LOOP (COND ((NOT (NOT (NULL |lo|))) (RETURN NIL)) - (T (SEQ (LETT |sc| + (T (SEQ (SETQ |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) (EXIT (COND ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|)))))))) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |s| |sc|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 1) |SYMBOL;latex;$S;25|) + (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 (LETT |sc| + (T (SEQ (SETQ |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) (EXIT (COND ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|)))))))) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |s| |sc|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 2) |SYMBOL;latex;$S;25|) + (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 (LETT |sc| + (T (SEQ (SETQ |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) (EXIT (COND ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|)))))))) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |sc| |s|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 3) |SYMBOL;latex;$S;25|) + (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 (LETT |sc| + (T (SEQ (SETQ |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) (EXIT (COND ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|)))))))) - (LETT |sc| (STRCONC |sc| "}") |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |sc| |s|) - |SYMBOL;latex;$S;25|))))) - (LETT |lo| (QVELT |ss| 4) |SYMBOL;latex;$S;25|) + (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 (LETT |sc| + (T (SEQ (SETQ |sc| (STRCONC |sc| (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) + (|getShellEntry| $ 112)))) + (SETQ |lo| (CDR |lo|)) (EXIT (COND ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|)))))))) - (LETT |sc| (STRCONC |sc| "} \\right)") - |SYMBOL;latex;$S;25|) - (EXIT (LETT |s| (STRCONC |s| |sc|) - |SYMBOL;latex;$S;25|))))) + (SETQ |sc| (STRCONC |sc| ", "))))))))) + (SETQ |sc| (STRCONC |sc| "} \\right)")) + (EXIT (SETQ |s| (STRCONC |s| |sc|)))))) (EXIT |s|))))) (DEFUN |SYMBOL;anyRadix| (|n| |s| $) - (PROG (|qr| |ns|) + (PROG (|ns| |qr|) (RETURN (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) (EXIT (LOOP @@ -433,16 +405,15 @@ (NIL (RETURN NIL)) (T (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) |SYMBOL;anyRadix|) - (LETT |n| (CAR |qr|) |SYMBOL;anyRadix|) - (LETT |ns| + (SETQ |n| (CAR |qr|)) + (SETQ |ns| (SPADCALL (SPADCALL |s| (+ (CDR |qr|) (SPADCALL |s| (|getShellEntry| $ 117))) (|getShellEntry| $ 106)) - |ns| (|getShellEntry| $ 119)) - |SYMBOL;anyRadix|) + |ns| (|getShellEntry| $ 119))) (EXIT (COND ((ZEROP |n|) (RETURN-FROM |SYMBOL;anyRadix| @@ -486,8 +457,8 @@ (|SYMBOL;string;$S;24| (|SYMBOL;name;2$;31| |x| $) $))) |SYMBOL;new;2$;28|) - (LETT |xx| (STRCONC "%" |xx|) |SYMBOL;new;2$;28|) - (LETT |xx| + (SETQ |xx| (STRCONC "%" |xx|)) + (SETQ |xx| (COND ((>= (SPADCALL (SPADCALL |xx| @@ -503,8 +474,7 @@ ('T (STRCONC |xx| (|SYMBOL;anyRadix| |n| - (|getShellEntry| $ 19) $)))) - |SYMBOL;new;2$;28|) + (|getShellEntry| $ 19) $))))) (COND ((NOT (|SYMBOL;scripted?;$B;30| |x| $)) (EXIT (|SYMBOL;coerce;S$;8| |xx| $)))) @@ -559,7 +529,7 @@ (EXIT (|error| "Improper scripted symbol"))))))))) (DEFUN |SYMBOL;scripts;$R;32| (|sy| $) - (PROG (|lscripts| |str| |nstr| |nscripts| |allscripts| |m|) + (PROG (|nscripts| |lscripts| |str| |nstr| |m| |allscripts|) (RETURN (SEQ (COND ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) @@ -601,17 +571,15 @@ (|getShellEntry| $ 148)))) (SETQ |i| (+ |i| 1)) (SETQ |j| (+ |j| 1)))) - (LETT |nscripts| + (SETQ |nscripts| (SPADCALL (CDR |nscripts|) (|SPADfirst| |nscripts|) - (|getShellEntry| $ 151)) - |SYMBOL;scripts;$R;32|) + (|getShellEntry| $ 151))) (LETT |allscripts| (CDR (|SYMBOL;list;$L;34| |sy| $)) |SYMBOL;scripts;$R;32|) - (LETT |m| - (SPADCALL |lscripts| (|getShellEntry| $ 153)) - |SYMBOL;scripts;$R;32|) + (SETQ |m| + (SPADCALL |lscripts| (|getShellEntry| $ 153))) (LET ((|i| |m|) (#1=#:G1552 |nscripts|)) (LOOP (COND @@ -641,10 +609,9 @@ (SETQ #2# (CDR #2#)))) (|getShellEntry| $ 157)) (EXIT - (LETT |allscripts| + (SETQ |allscripts| (SPADCALL |allscripts| |n| - (|getShellEntry| $ 158)) - |SYMBOL;scripts;$R;32|)))))))) + (|getShellEntry| $ 158)))))))))) (SETQ |i| (+ |i| 1)) (SETQ #1# (CDR #1#)))) (EXIT (VECTOR (SPADCALL |lscripts| |m| diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index 5729726e..87934534 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -145,11 +145,10 @@ (COND ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) (RETURN NIL)) - (T (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) - (EXIT (LETT |x| + (T (SEQ (SETQ |l| (CONS |x| |l|)) + (EXIT (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 14)) - |URAGG-;nodes;AL;8|)))))) + (|getShellEntry| $ 14)))))))) (EXIT (NREVERSE |l|)))))) (DEFUN |URAGG-;children;AL;9| (|x| $) @@ -181,10 +180,8 @@ (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) ('T NIL))) (RETURN NIL)) - (T (SEQ (LETT |l| (SPADCALL |l| (|getShellEntry| $ 14)) - |URAGG-;less?;ANniB;12|) - (EXIT (LETT |i| (- |i| 1) - |URAGG-;less?;ANniB;12|)))))) + (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) + (EXIT (SETQ |i| (- |i| 1))))))) (EXIT (> |i| 0)))))) (DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) @@ -198,10 +195,8 @@ (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) ('T NIL))) (RETURN NIL)) - (T (SEQ (LETT |l| (SPADCALL |l| (|getShellEntry| $ 14)) - |URAGG-;more?;ANniB;13|) - (EXIT (LETT |i| (- |i| 1) - |URAGG-;more?;ANniB;13|)))))) + (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) + (EXIT (SETQ |i| (- |i| 1))))))) (EXIT (COND ((ZEROP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) @@ -217,10 +212,8 @@ ((SPADCALL |l| (|getShellEntry| $ 20)) NIL) ('T (> |i| 0)))) (RETURN NIL)) - (T (SEQ (LETT |l| (SPADCALL |l| (|getShellEntry| $ 14)) - |URAGG-;size?;ANniB;14|) - (EXIT (LETT |i| (- |i| 1) - |URAGG-;size?;ANniB;14|)))))) + (T (SEQ (SETQ |l| (SPADCALL |l| (|getShellEntry| $ 14))) + (EXIT (SETQ |i| (- |i| 1))))))) (EXIT (COND ((SPADCALL |l| (|getShellEntry| $ 20)) (ZEROP |i|)) ('T NIL))))))) @@ -238,9 +231,8 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 48)) (EXIT (|error| "cyclic list")))))) - (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;#;ANni;15|) - (EXIT (LETT |k| (+ |k| 1) |URAGG-;#;ANni;15|)))))) + (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))) + (EXIT (SETQ |k| (+ |k| 1))))))) (EXIT |k|))))) (DEFUN |URAGG-;tail;2A;16| (|x| $) @@ -264,12 +256,9 @@ ((SPADCALL |x| (|getShellEntry| $ 48)) (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |y| - (SPADCALL - (LETT |x| |y| - |URAGG-;tail;2A;16|) - (|getShellEntry| $ 14)) - |URAGG-;tail;2A;16|))))) + (EXIT (SETQ |y| + (SPADCALL (SETQ |x| |y|) + (|getShellEntry| $ 14))))))) (SETQ |k| (+ |k| 1)))) (EXIT |x|)))))))) @@ -285,30 +274,27 @@ (T (SEQ (COND ((SPADCALL |x| |y| (|getShellEntry| $ 54)) (RETURN-FROM |URAGG-;findCycle| |x|))) - (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;findCycle|) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;findCycle|) + (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 (LETT |y| + (EXIT (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;findCycle|)))))) + (|getShellEntry| $ 14)))))))) (EXIT |y|))))) (DEFUN |URAGG-;cycleTail;2A;18| (|x| $) - (PROG (|y| |z|) + (PROG (|z| |y|) (RETURN (SEQ (COND ((SPADCALL (LETT |y| - (LETT |x| (SPADCALL |x| (|getShellEntry| $ 55)) - |URAGG-;cycleTail;2A;18|) + (SETQ |x| + (SPADCALL |x| (|getShellEntry| $ 55))) |URAGG-;cycleTail;2A;18|) (|getShellEntry| $ 20)) |x|) @@ -321,10 +307,9 @@ (|getShellEntry| $ 54)))) (RETURN NIL)) (T (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) - (EXIT (LETT |z| + (EXIT (SETQ |z| (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleTail;2A;18|)))))) + (|getShellEntry| $ 14)))))))) (EXIT |y|)))))))) (DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) @@ -346,34 +331,29 @@ ((NOT (NOT (SPADCALL |y| |z| (|getShellEntry| $ 54)))) (RETURN NIL)) - (T (SEQ (LETT |z| + (T (SEQ (SETQ |z| (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (EXIT (LETT |l| (+ |l| 1) - |URAGG-;cycleEntry;2A;19|)))))) + (|getShellEntry| $ 14))) + (EXIT (SETQ |l| (+ |l| 1))))))) (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) (LET ((|k| 1)) (LOOP (COND ((> |k| |l|) (RETURN NIL)) - (T (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|))) + (T (SETQ |y| + (SPADCALL |y| (|getShellEntry| $ 14))))) (SETQ |k| (+ |k| 1)))) (LOOP (COND ((NOT (NOT (SPADCALL |x| |y| (|getShellEntry| $ 54)))) (RETURN NIL)) - (T (SEQ (LETT |x| + (T (SEQ (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (EXIT (LETT |y| + (|getShellEntry| $ 14))) + (EXIT (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|)))))) + (|getShellEntry| $ 14)))))))) (EXIT |x|)))))))) (DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) @@ -381,9 +361,7 @@ (RETURN (SEQ (COND ((OR (SPADCALL |x| (|getShellEntry| $ 20)) - (SPADCALL - (LETT |x| (|URAGG-;findCycle| |x| $) - |URAGG-;cycleLength;ANni;20|) + (SPADCALL (SETQ |x| (|URAGG-;findCycle| |x| $)) (|getShellEntry| $ 20))) 0) ('T @@ -395,12 +373,10 @@ ((NOT (NOT (SPADCALL |x| |y| (|getShellEntry| $ 54)))) (RETURN NIL)) - (T (SEQ (LETT |y| + (T (SEQ (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;cycleLength;ANni;20|) - (EXIT (LETT |k| (+ |k| 1) - |URAGG-;cycleLength;ANni;20|)))))) + (|getShellEntry| $ 14))) + (EXIT (SETQ |k| (+ |k| 1))))))) (EXIT |k|)))))))) (DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) @@ -411,9 +387,7 @@ (T (COND ((SPADCALL |x| (|getShellEntry| $ 20)) (|error| "Index out of range")) - ('T - (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;rest;ANniA;21|))))) + ('T (SETQ |x| (SPADCALL |x| (|getShellEntry| $ 14))))))) (SETQ |i| (+ |i| 1)))) (EXIT |x|))) @@ -464,15 +438,13 @@ NIL)) ('T (SEQ - (LETT |x| + (SETQ |x| (SPADCALL |x| - (|getShellEntry| $ 14)) - |URAGG-;=;2AB;23|) + (|getShellEntry| $ 14))) (EXIT - (LETT |y| + (SETQ |y| (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;=;2AB;23|))))))))) + (|getShellEntry| $ 14))))))))))) (SETQ |k| (+ |k| 1)))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 20)) @@ -494,10 +466,9 @@ (COND ((SPADCALL |v| (|getShellEntry| $ 48)) (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |v| + (EXIT (SETQ |v| (SPADCALL |v| - (|getShellEntry| $ 14)) - |URAGG-;node?;2AB;24|))))))) + (|getShellEntry| $ 14))))))))) (SETQ |k| (+ |k| 1)))) (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 68))))) @@ -538,13 +509,12 @@ (SEQ (COND ((< |n| 1) (|error| "index out of range")) ('T - (SEQ (LETT |p| + (SEQ (SETQ |p| (SPADCALL |p| (LET ((#0=#:G1528 (- |n| 1))) (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 62)) - |URAGG-;split!;AIA;32|) + (|getShellEntry| $ 62))) (LETT |q| (SPADCALL |p| (|getShellEntry| $ 14)) |URAGG-;split!;AIA;32|) (SPADCALL |p| (SPADCALL (|getShellEntry| $ 84)) @@ -569,12 +539,10 @@ ((NOT (NOT (SPADCALL |z| |y| (|getShellEntry| $ 54)))) (RETURN NIL)) - (T (SEQ (LETT |x| |z| - |URAGG-;cycleSplit!;2A;33|) - (EXIT (LETT |z| + (T (SEQ (SETQ |x| |z|) + (EXIT (SETQ |z| (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleSplit!;2A;33|)))))) + (|getShellEntry| $ 14)))))))) (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84)) (|getShellEntry| $ 74)) (EXIT |y|)))))))) diff --git a/src/interp/g-opt.boot b/src/interp/g-opt.boot index 119da259..e47f7be0 100644 --- a/src/interp/g-opt.boot +++ b/src/interp/g-opt.boot @@ -65,7 +65,20 @@ emitIndirectCall(fn,args,x) == x --% OPTIMIZER - + +++ Change (%LET id expr) to (%store id expr) if `id' is being +++ updated as opposed to being defined. `vars' is the list of +++ all variable definitions in scope. +changeVariableDefinitionToStore(form,vars) == + isAtomicForm form => nil + form is ['%LET,v,expr] => + changeVariableDefinitionToStore(expr,vars) + if v in vars then form.op := '%store + for x in form repeat + changeVariableDefinitionToStore(x,vars) + x is ['%LET,v,:.] and not (v in vars) => + vars := [v,:vars] + optimizeFunctionDef(def) == if $reportOptimization then sayBrightlyI bright '"Original LISP code:" @@ -95,6 +108,7 @@ optimizeFunctionDef(def) == atom x => nil replaceThrowByReturn(first x,g) replaceThrowByReturn(rest x,g) + changeVariableDefinitionToStore(body',args) [name,[slamOrLam,args,body']] optimize x == |