From 9cde874de258533a18944602afa62c9e56ac991a Mon Sep 17 00:00:00 2001 From: dos-reis Date: Sun, 20 Jun 2010 15:00:29 +0000 Subject: * interp/compiler.boot (massageLoop): New. (compRepeatOrCollect): Use it to generate appropriate %loop forms. Bind new special variable $mayHaveFreeIteratorVariables. (complainIfShadowing): Set it as appropriate. --- src/algebra/strap/DFLOAT.lsp | 114 +++---- src/algebra/strap/EUCDOM-.lsp | 93 +++--- src/algebra/strap/FFIELDC-.lsp | 559 ++++++++++++++++++----------------- src/algebra/strap/ILIST.lsp | 241 ++++++++------- src/algebra/strap/INS-.lsp | 55 ++-- src/algebra/strap/ISTRING.lsp | 554 +++++++++++++++++----------------- src/algebra/strap/LIST.lsp | 85 +++--- src/algebra/strap/LSAGG-.lsp | 656 ++++++++++++++++++++--------------------- src/algebra/strap/OUTFORM.lsp | 29 +- src/algebra/strap/POLYCAT-.lsp | 635 ++++++++++++++++++++------------------- src/algebra/strap/QFCAT-.lsp | 17 +- src/algebra/strap/STAGG-.lsp | 75 ++--- src/algebra/strap/SYMBOL.lsp | 379 ++++++++++++------------ src/algebra/strap/URAGG-.lsp | 433 +++++++++++++-------------- 14 files changed, 1938 insertions(+), 1987 deletions(-) (limited to 'src/algebra/strap') diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp index dd27cb87..60f38ca8 100644 --- a/src/algebra/strap/DFLOAT.lsp +++ b/src/algebra/strap/DFLOAT.lsp @@ -776,62 +776,66 @@ (LETT |q1| 0 |DFLOAT;rationalApproximation;$2NniF;87|) (EXIT - (SEQ G190 NIL - (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|) + (LOOP (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|) - (LETT |p0| |#G111| - |DFLOAT;rationalApproximation;$2NniF;87|) - (LETT |p1| |#G112| - |DFLOAT;rationalApproximation;$2NniF;87|) - (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|) - (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|)))) - NIL (GO G190) G191 (EXIT NIL))))))))))))))) + (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|) + (LETT |p0| |#G111| + |DFLOAT;rationalApproximation;$2NniF;87|) + (LETT |p1| |#G112| + |DFLOAT;rationalApproximation;$2NniF;87|) + (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|) + (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|)))))))))))))))))))) (DEFUN |DFLOAT;**;$F$;88| (|x| |r| $) (PROG (|n| |d|) diff --git a/src/algebra/strap/EUCDOM-.lsp b/src/algebra/strap/EUCDOM-.lsp index 6af1eb73..f3aaa896 100644 --- a/src/algebra/strap/EUCDOM-.lsp +++ b/src/algebra/strap/EUCDOM-.lsp @@ -71,20 +71,20 @@ |EUCDOM-;gcd;3S;5|) (LETT |y| (SPADCALL |y| (|getShellEntry| $ 22)) |EUCDOM-;gcd;3S;5|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 8)))) - (GO G191))) - (SEQ (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) - (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| - (SPADCALL |y| (|getShellEntry| $ 22)) - |EUCDOM-;gcd;3S;5|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 8)))) + (RETURN NIL)) + (T (SEQ (LETT |#G13| |y| |EUCDOM-;gcd;3S;5|) + (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| + (SPADCALL |y| + (|getShellEntry| $ 22)) + |EUCDOM-;gcd;3S;5|)))))) (EXIT |x|))))) (DEFUN |EUCDOM-;unitNormalizeIdealElt| (|s| $) @@ -124,39 +124,38 @@ ((SPADCALL |y| (|getShellEntry| $ 8)) |s1|) ((SPADCALL |x| (|getShellEntry| $ 8)) |s2|) ('T - (SEQ (SEQ G190 - (COND - ((NULL (NOT - (SPADCALL (QVELT |s2| 2) - (|getShellEntry| $ 8)))) - (GO G191))) - (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|) - (LETT |s1| |s2| - |EUCDOM-;extendedEuclidean;2SR;7|) - (EXIT - (LETT |s2| - (|EUCDOM-;unitNormalizeIdealElt| - |s3| $) - |EUCDOM-;extendedEuclidean;2SR;7|))) - NIL (GO G190) G191 (EXIT NIL)) + (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|) + (LETT |s1| |s2| + |EUCDOM-;extendedEuclidean;2SR;7|) + (EXIT + (LETT |s2| + (|EUCDOM-;unitNormalizeIdealElt| + |s3| $) + |EUCDOM-;extendedEuclidean;2SR;7|)))))) (COND ((NOT (SPADCALL (QVELT |s1| 0) (|getShellEntry| $ 8))) diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp index 2f429a7e..0046e258 100644 --- a/src/algebra/strap/FFIELDC-.lsp +++ b/src/algebra/strap/FFIELDC-.lsp @@ -91,7 +91,7 @@ (CONS 0 (SPADCALL |x| (|getShellEntry| $ 32)))) (DEFUN |FFIELDC-;createPrimitiveElement;S;8| ($) - (PROG (|sm1| |start| |i| |e| |found|) + (PROG (|e| |sm1| |start| |found|) (RETURN (SEQ (LETT |sm1| (- (SPADCALL (|getShellEntry| $ 40)) 1) |FFIELDC-;createPrimitiveElement;S;8|) @@ -103,26 +103,28 @@ ('T 1)) |FFIELDC-;createPrimitiveElement;S;8|) (LETT |found| NIL |FFIELDC-;createPrimitiveElement;S;8|) - (SEQ (LETT |i| |start| - |FFIELDC-;createPrimitiveElement;S;8|) - G190 (COND ((NULL (NOT |found|)) (GO G191))) - (SEQ (LETT |e| - (SPADCALL - (|check-subtype| - (AND (>= |i| 0) (> |i| 0)) - '(|PositiveInteger|) |i|) - (|getShellEntry| $ 14)) - |FFIELDC-;createPrimitiveElement;S;8|) - (EXIT (LETT |found| - (EQL (SPADCALL |e| + (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 (LETT |found| + (EQL + (SPADCALL |e| (|getShellEntry| $ 19)) |sm1|) - |FFIELDC-;createPrimitiveElement;S;8|))) - (SETQ |i| (+ |i| 1)) (GO G190) G191 (EXIT NIL)) + |FFIELDC-;createPrimitiveElement;S;8|))))) + (SETQ |i| (+ |i| 1)))) (EXIT |e|))))) (DEFUN |FFIELDC-;primitive?;SB;9| (|a| $) - (PROG (|explist| |q| |exp| #0=#:G1513 |equalone|) + (PROG (|explist| |q| |equalone|) (RETURN (SEQ (COND ((SPADCALL |a| (|getShellEntry| $ 16)) NIL) @@ -132,27 +134,25 @@ (LETT |q| (- (SPADCALL (|getShellEntry| $ 40)) 1) |FFIELDC-;primitive?;SB;9|) (LETT |equalone| NIL |FFIELDC-;primitive?;SB;9|) - (SEQ (LETT |exp| NIL |FFIELDC-;primitive?;SB;9|) - (LETT #0# |explist| |FFIELDC-;primitive?;SB;9|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |exp| (CAR #0#)) NIL) - (NULL (NOT |equalone|))) - (GO G191))) - (LETT |equalone| - (SPADCALL - (SPADCALL |a| - (QUOTIENT2 |q| (CAR |exp|)) - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;primitive?;SB;9|) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) + (LET ((#0=#:G1513 |explist|) (|exp| NIL)) + (LOOP + (COND + ((OR (ATOM #0#) + (PROGN (SETQ |exp| (CAR #0#)) NIL) + (NOT (NOT |equalone|))) + (RETURN NIL)) + (T (LETT |equalone| + (SPADCALL + (SPADCALL |a| + (QUOTIENT2 |q| (CAR |exp|)) + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59)) + |FFIELDC-;primitive?;SB;9|))) + (SETQ #0# (CDR #0#)))) (EXIT (NOT |equalone|))))))))) (DEFUN |FFIELDC-;order;SPi;10| (|e| $) - (PROG (|lof| |rec| #0=#:G1514 |primeDivisor| |j| #1=#:G1515 |a| - |goon| |ord|) + (PROG (|primeDivisor| |a| |goon| |ord| |lof|) (RETURN (SEQ (COND ((SPADCALL |e| (|spadConstant| $ 7) @@ -163,57 +163,56 @@ |FFIELDC-;order;SPi;10|) (LETT |lof| (SPADCALL (|getShellEntry| $ 56)) |FFIELDC-;order;SPi;10|) - (SEQ (LETT |rec| NIL |FFIELDC-;order;SPi;10|) - (LETT #0# |lof| |FFIELDC-;order;SPi;10|) G190 - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |rec| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (LETT |a| - (QUOTIENT2 |ord| - (LETT |primeDivisor| (CAR |rec|) - |FFIELDC-;order;SPi;10|)) - |FFIELDC-;order;SPi;10|) - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;order;SPi;10|) - (SEQ (LETT |j| 0 |FFIELDC-;order;SPi;10|) - (LETT #1# (- (CDR |rec|) 2) - |FFIELDC-;order;SPi;10|) - G190 - (COND - ((OR (QSGREATERP |j| #1#) - (NULL |goon|)) - (GO G191))) - (SEQ (LETT |ord| |a| - |FFIELDC-;order;SPi;10|) - (LETT |a| - (QUOTIENT2 |ord| - |primeDivisor|) - |FFIELDC-;order;SPi;10|) - (EXIT - (LETT |goon| - (SPADCALL - (SPADCALL |e| |a| - (|getShellEntry| $ 58)) - (|getShellEntry| $ 59)) - |FFIELDC-;order;SPi;10|))) - (SETQ |j| (QSADD1 |j|)) (GO G190) - G191 (EXIT NIL)) - (EXIT (COND - (|goon| - (LETT |ord| |a| - |FFIELDC-;order;SPi;10|))))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) + (LET ((#0=#:G1514 |lof|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|rec| (CAR #0#))) + (SEQ (LETT |a| + (QUOTIENT2 |ord| + (LETT |primeDivisor| (CAR |rec|) + |FFIELDC-;order;SPi;10|)) + |FFIELDC-;order;SPi;10|) + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59)) + |FFIELDC-;order;SPi;10|) + (LET + ((|j| 0) + (#1=#:G1515 (- (CDR |rec|) 2))) + (LOOP + (COND + ((OR (> |j| #1#) (NOT |goon|)) + (RETURN NIL)) + (T + (SEQ + (LETT |ord| |a| + |FFIELDC-;order;SPi;10|) + (LETT |a| + (QUOTIENT2 |ord| + |primeDivisor|) + |FFIELDC-;order;SPi;10|) + (EXIT + (LETT |goon| + (SPADCALL + (SPADCALL |e| |a| + (|getShellEntry| $ 58)) + (|getShellEntry| $ 59)) + |FFIELDC-;order;SPi;10|))))) + (SETQ |j| (+ |j| 1)))) + (EXIT + (COND + (|goon| + (LETT |ord| |a| + |FFIELDC-;order;SPi;10|)))))))) + (SETQ #0# (CDR #0#)))) (EXIT |ord|)))))))) (DEFUN |FFIELDC-;discreteLog;SNni;11| (|b| $) - (PROG (|faclist| |gen| |groupord| |f| #0=#:G1516 |fac| |t| #1=#:G1517 - |exp| |exptable| |n| |end| |i| |rho| |found| |disc1| |c| - |mult| |disclog| |a|) + (PROG (|rho| |exptable| |n| |c| |end| |found| |disc1| |fac| |faclist| + |a| |gen| |disclog| |mult| |groupord| |exp|) (RETURN (SEQ (COND ((SPADCALL |b| (|getShellEntry| $ 16)) @@ -240,130 +239,159 @@ |FFIELDC-;discreteLog;SNni;11|) (LETT |exp| |groupord| |FFIELDC-;discreteLog;SNni;11|) - (SEQ (LETT |f| NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT #0# |faclist| - |FFIELDC-;discreteLog;SNni;11|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (SETQ |f| (CAR #0#)) - NIL)) - (GO G191))) - (SEQ - (LETT |fac| (CAR |f|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (SEQ - (LETT |t| 0 - |FFIELDC-;discreteLog;SNni;11|) - (LETT #1# (- (CDR |f|) 1) - |FFIELDC-;discreteLog;SNni;11|) - G190 - (COND - ((QSGREATERP |t| #1#) - (GO G191))) - (SEQ - (LETT |exp| - (QUOTIENT2 |exp| |fac|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |exptable| - (SPADCALL |fac| - (|getShellEntry| $ 67)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |n| - (SPADCALL |exptable| - (|getShellEntry| $ 68)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |c| - (SPADCALL |a| |exp| - (|getShellEntry| $ 58)) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |end| - (QUOTIENT2 (- |fac| 1) |n|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |found| NIL - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disc1| 0 - |FFIELDC-;discreteLog;SNni;11|) + (LET ((#0=#:G1516 |faclist|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T + (LET ((|f| (CAR #0#))) (SEQ - (LETT |i| 0 + (LETT |fac| (CAR |f|) |FFIELDC-;discreteLog;SNni;11|) - G190 - (COND - ((OR - (QSGREATERP |i| |end|) - (NULL (NOT |found|))) - (GO G191))) - (SEQ - (LETT |rho| - (SPADCALL - (SPADCALL |c| - (|getShellEntry| $ 11)) - |exptable| - (|getShellEntry| $ 71)) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (COND - ((EQL (CAR |rho|) 0) - (SEQ - (LETT |found| T - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LETT |disc1| - (* - (+ (* |n| |i|) - (CDR |rho|)) - |mult|) - |FFIELDC-;discreteLog;SNni;11|)))) - ('T - (LETT |c| - (SPADCALL |c| - (SPADCALL |gen| - (* - (QUOTIENT2 - |groupord| |fac|) - (- |n|)) - (|getShellEntry| $ - 58)) - (|getShellEntry| $ - 77)) - |FFIELDC-;discreteLog;SNni;11|))))) - (SETQ |i| (QSADD1 |i|)) - (GO G190) G191 (EXIT NIL)) - (EXIT - (COND - (|found| - (SEQ - (LETT |mult| - (* |mult| |fac|) - |FFIELDC-;discreteLog;SNni;11|) - (LETT |disclog| - (+ |disclog| |disc1|) - |FFIELDC-;discreteLog;SNni;11|) - (EXIT - (LETT |a| - (SPADCALL |a| - (SPADCALL |gen| - (- |disc1|) - (|getShellEntry| $ - 58)) - (|getShellEntry| $ - 77)) - |FFIELDC-;discreteLog;SNni;11|)))) - ('T - (|error| - "discreteLog: ?? discrete logarithm"))))) - (SETQ |t| (QSADD1 |t|)) - (GO G190) G191 (EXIT NIL)))) - (SETQ #0# (CDR #0#)) (GO G190) - G191 (EXIT NIL)) + (EXIT + (LET + ((|t| 0) + (#1=#:G1517 + (- (CDR |f|) 1))) + (LOOP + (COND + ((> |t| #1#) + (RETURN NIL)) + (T + (SEQ + (LETT |exp| + (QUOTIENT2 |exp| + |fac|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |exptable| + (SPADCALL |fac| + (|getShellEntry| + $ 67)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |n| + (SPADCALL + |exptable| + (|getShellEntry| + $ 68)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |c| + (SPADCALL |a| + |exp| + (|getShellEntry| + $ 58)) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |end| + (QUOTIENT2 + (- |fac| 1) |n|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT |found| NIL + |FFIELDC-;discreteLog;SNni;11|) + (LETT |disc1| 0 + |FFIELDC-;discreteLog;SNni;11|) + (LET ((|i| 0)) + (LOOP + (COND + ((OR + (> |i| + |end|) + (NOT + (NOT + |found|))) + (RETURN + NIL)) + (T + (SEQ + (LETT |rho| + (SPADCALL + (SPADCALL + |c| + (|getShellEntry| + $ 11)) + |exptable| + (|getShellEntry| + $ 71)) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (COND + ((EQL + (CAR + |rho|) + 0) + (SEQ + (LETT + |found| + T + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LETT + |disc1| + (* + (+ + (* + |n| + |i|) + (CDR + |rho|)) + |mult|) + |FFIELDC-;discreteLog;SNni;11|)))) + ('T + (LETT + |c| + (SPADCALL + |c| + (SPADCALL + |gen| + (* + (QUOTIENT2 + |groupord| + |fac|) + (- + |n|)) + (|getShellEntry| + $ + 58)) + (|getShellEntry| + $ + 77)) + |FFIELDC-;discreteLog;SNni;11|))))))) + (SETQ |i| + (+ |i| 1)))) + (EXIT + (COND + (|found| + (SEQ + (LETT |mult| + (* |mult| + |fac|) + |FFIELDC-;discreteLog;SNni;11|) + (LETT + |disclog| + (+ |disclog| + |disc1|) + |FFIELDC-;discreteLog;SNni;11|) + (EXIT + (LETT |a| + (SPADCALL + |a| + (SPADCALL + |gen| + (- + |disc1|) + (|getShellEntry| + $ 58)) + (|getShellEntry| + $ 77)) + |FFIELDC-;discreteLog;SNni;11|)))) + ('T + (|error| + "discreteLog: ?? discrete logarithm"))))))) + (SETQ |t| (+ |t| 1))))))))) + (SETQ #0# (CDR #0#)))) (EXIT |disclog|)))))))))))) (DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $) - (PROG (|groupord| |faclist| |f| #0=#:G1518 |fac| |primroot| |t| - #1=#:G1519 |exp| |rhoHelp| |rho| |disclog| |mult| |a|) + (PROG (|rhoHelp| |rho| |fac| |primroot| |groupord| |faclist| |a| + |disclog| |mult| |exp|) (RETURN (SEQ (COND ((SPADCALL |b| (|getShellEntry| $ 16)) @@ -400,70 +428,71 @@ (LETT |mult| 1 |FFIELDC-;discreteLog;2SU;12|) (LETT |exp| |groupord| |FFIELDC-;discreteLog;2SU;12|) - (SEQ (LETT |f| NIL |FFIELDC-;discreteLog;2SU;12|) - (LETT #0# |faclist| - |FFIELDC-;discreteLog;2SU;12|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |f| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (LETT |fac| (CAR |f|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |primroot| - (SPADCALL |logbase| - (QUOTIENT2 |groupord| |fac|) - (|getShellEntry| $ 58)) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT (SEQ - (LETT |t| 0 - |FFIELDC-;discreteLog;2SU;12|) - (LETT #1# (- (CDR |f|) 1) - |FFIELDC-;discreteLog;2SU;12|) - G190 - (COND - ((QSGREATERP |t| #1#) - (GO G191))) - (SEQ - (LETT |exp| - (QUOTIENT2 |exp| |fac|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |rhoHelp| - (SPADCALL |primroot| - (SPADCALL |a| |exp| - (|getShellEntry| $ 58)) - |fac| (|getShellEntry| $ 91)) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (COND - ((EQL (CAR |rhoHelp|) 1) - (RETURN-FROM - |FFIELDC-;discreteLog;2SU;12| - (CONS 1 "failed"))) - ('T - (SEQ - (LETT |rho| - (* (CDR |rhoHelp|) - |mult|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |disclog| - (+ |disclog| |rho|) - |FFIELDC-;discreteLog;2SU;12|) - (LETT |mult| - (* |mult| |fac|) - |FFIELDC-;discreteLog;2SU;12|) - (EXIT - (LETT |a| - (SPADCALL |a| - (SPADCALL |logbase| - (- |rho|) - (|getShellEntry| $ 58)) - (|getShellEntry| $ 77)) - |FFIELDC-;discreteLog;2SU;12|))))))) - (SETQ |t| (QSADD1 |t|)) - (GO G190) G191 (EXIT NIL)))) - (SETQ #0# (CDR #0#)) (GO G190) G191 - (EXIT NIL)) + (LET ((#0=#:G1518 |faclist|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|f| (CAR #0#))) + (SEQ (LETT |fac| (CAR |f|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |primroot| + (SPADCALL |logbase| + (QUOTIENT2 |groupord| |fac|) + (|getShellEntry| $ 58)) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (LET + ((|t| 0) + (#1=#:G1519 (- (CDR |f|) 1))) + (LOOP + (COND + ((> |t| #1#) (RETURN NIL)) + (T + (SEQ + (LETT |exp| + (QUOTIENT2 |exp| |fac|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |rhoHelp| + (SPADCALL |primroot| + (SPADCALL |a| |exp| + (|getShellEntry| $ + 58)) + |fac| + (|getShellEntry| $ 91)) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (COND + ((EQL (CAR |rhoHelp|) + 1) + (RETURN-FROM + |FFIELDC-;discreteLog;2SU;12| + (CONS 1 "failed"))) + ('T + (SEQ + (LETT |rho| + (* (CDR |rhoHelp|) + |mult|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |disclog| + (+ |disclog| + |rho|) + |FFIELDC-;discreteLog;2SU;12|) + (LETT |mult| + (* |mult| |fac|) + |FFIELDC-;discreteLog;2SU;12|) + (EXIT + (LETT |a| + (SPADCALL |a| + (SPADCALL + |logbase| + (- |rho|) + (|getShellEntry| + $ 58)) + (|getShellEntry| + $ 77)) + |FFIELDC-;discreteLog;2SU;12|))))))))) + (SETQ |t| (+ |t| 1))))))))) + (SETQ #0# (CDR #0#)))) (EXIT (CONS 0 |disclog|))))))))))) (DEFUN |FFIELDC-;squareFreePolynomial| (|f| $) diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp index df20936f..f43c2f0c 100644 --- a/src/algebra/strap/ILIST.lsp +++ b/src/algebra/strap/ILIST.lsp @@ -182,30 +182,33 @@ (DEFUN |ILIST;minIndex;$I;18| (|x| $) (|getShellEntry| $ 7)) (DEFUN |ILIST;rest;$Nni$;19| (|x| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |ILIST;rest;$Nni$;19|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (COND + (SEQ (LET ((|i| 1)) + (LOOP + (COND + ((> |i| |n|) (RETURN NIL)) + (T (SEQ (COND ((NULL |x|) (|error| "index out of range"))) - (EXIT (LETT |x| (CDR |x|) |ILIST;rest;$Nni$;19|))) - (SETQ |i| (QSADD1 |i|)) (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) + (EXIT (LETT |x| (CDR |x|) |ILIST;rest;$Nni$;19|))))) + (SETQ |i| (+ |i| 1)))) + (EXIT |x|))) (DEFUN |ILIST;copy;2$;20| (|x| $) - (PROG (|i| |y|) + (PROG (|y|) (RETURN (SEQ (LETT |y| NIL |ILIST;copy;2$;20|) - (SEQ (LETT |i| 0 |ILIST;copy;2$;20|) G190 - (COND ((NULL (NOT (NULL |x|))) (GO G191))) - (SEQ (COND - ((EQL |i| 1000) - (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 |i| (QSADD1 |i|)) (GO G190) G191 (EXIT NIL)) + (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"))))) + (LETT |y| (CONS (CAR |x|) |y|) + |ILIST;copy;2$;20|) + (EXIT (LETT |x| (CDR |x|) |ILIST;copy;2$;20|))))) + (SETQ |i| (+ |i| 1)))) (EXIT (NREVERSE |y|)))))) (DEFUN |ILIST;coerce;$Of;21| (|x| $) @@ -214,14 +217,15 @@ (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|) (LETT |s| (SPADCALL |x| (|getShellEntry| $ 40)) |ILIST;coerce;$Of;21|) - (SEQ G190 (COND ((NULL (NOT (EQ |x| |s|))) (GO G191))) - (SEQ (LETT |y| - (CONS (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - |y|) - |ILIST;coerce;$Of;21|) - (EXIT (LETT |x| (CDR |x|) |ILIST;coerce;$Of;21|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (EQ |x| |s|))) (RETURN NIL)) + (T (SEQ (LETT |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|) (EXIT (COND ((NULL |s|) (SPADCALL |y| (|getShellEntry| $ 45))) @@ -232,20 +236,19 @@ (|getShellEntry| $ 41)) (|getShellEntry| $ 46)) |ILIST;coerce;$Of;21|) - (SEQ G190 - (COND - ((NULL (NOT (EQ |s| (CDR |x|)))) - (GO G191))) - (SEQ (LETT |x| (CDR |x|) - |ILIST;coerce;$Of;21|) - (EXIT - (LETT |z| - (CONS - (SPADCALL (|SPADfirst| |x|) - (|getShellEntry| $ 41)) - |z|) - |ILIST;coerce;$Of;21|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (EQ |s| (CDR |x|)))) + (RETURN NIL)) + (T (SEQ (LETT |x| (CDR |x|) + |ILIST;coerce;$Of;21|) + (EXIT + (LETT |z| + (CONS + (SPADCALL (|SPADfirst| |x|) + (|getShellEntry| $ 41)) + |z|) + |ILIST;coerce;$Of;21|)))))) (EXIT (SPADCALL (SPADCALL |y| (SPADCALL @@ -259,49 +262,47 @@ (SEQ (COND ((EQ |x| |y|) T) ('T - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((NULL |x|) NIL) - ('T (NOT (NULL |y|))))) - (GO G191))) - (COND - ((SPADCALL (CAR |x|) (CAR |y|) - (|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|))))) - NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (COND ((NULL |x|) NIL) ('T (NOT (NULL |y|))))) + (RETURN NIL)) + (T (COND + ((SPADCALL (CAR |x|) (CAR |y|) + (|getShellEntry| $ 53)) + (RETURN-FROM |ILIST;=;2$B;22| NIL)) + ('T + (SEQ (LETT |x| (CDR |x|) |ILIST;=;2$B;22|) + (EXIT (LETT |y| (CDR |y|) + |ILIST;=;2$B;22|)))))))) (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|) - (SEQ G190 (COND ((NULL (NOT (NULL |x|))) (GO G191))) - (SEQ (LETT |s| - (STRCONC |s| - (SPADCALL (CAR |x|) - (|getShellEntry| $ 56))) - |ILIST;latex;$S;23|) - (LETT |x| (CDR |x|) |ILIST;latex;$S;23|) - (EXIT (COND - ((NOT (NULL |x|)) - (LETT |s| (STRCONC |s| ", ") - |ILIST;latex;$S;23|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |x|))) (RETURN NIL)) + (T (SEQ (LETT |s| + (STRCONC |s| + (SPADCALL (CAR |x|) + (|getShellEntry| $ 56))) + |ILIST;latex;$S;23|) + (LETT |x| (CDR |x|) |ILIST;latex;$S;23|) + (EXIT (COND + ((NOT (NULL |x|)) + (LETT |s| (STRCONC |s| ", ") + |ILIST;latex;$S;23|)))))))) (EXIT (STRCONC |s| " \\right]")))))) (DEFUN |ILIST;member?;S$B;24| (|s| |x| $) - (SEQ (SEQ G190 (COND ((NULL (NOT (NULL |x|))) (GO G191))) - (SEQ (EXIT (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|))))) - NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (NOT (NULL |x|))) (RETURN NIL)) + (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|)))))) (EXIT NIL))) (DEFUN |ILIST;concat!;3$;25| (|x| |y| $) @@ -316,41 +317,38 @@ (QRPLACD |x| (CDR |y|)) (EXIT |x|))))) ('T (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|) - (SEQ G190 - (COND - ((NULL (NOT (NULL (CDR |z|)))) (GO G191))) - (LETT |z| (CDR |z|) |ILIST;concat!;3$;25|) NIL - (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL (CDR |z|)))) (RETURN NIL)) + (T (LETT |z| (CDR |z|) |ILIST;concat!;3$;25|)))) (QRPLACD |z| |y|) (EXIT |x|)))))))) (DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $) (PROG (|f| |p| |pr| |pp|) (RETURN (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|) - (SEQ G190 (COND ((NULL (NOT (NULL |p|))) (GO G191))) - (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|) - (LETT |f| (CAR |p|) - |ILIST;removeDuplicates!;2$;26|) - (LETT |p| (CDR |p|) - |ILIST;removeDuplicates!;2$;26|) - (EXIT (SEQ G190 - (COND - ((NULL - (NOT - (NULL - (LETT |pr| (CDR |pp|) - |ILIST;removeDuplicates!;2$;26|)))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL (CAR |pr|) |f| - (|getShellEntry| $ 59)) - (QRPLACD |pp| (CDR |pr|))) - ('T - (LETT |pp| |pr| - |ILIST;removeDuplicates!;2$;26|))))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) + (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|) + (LETT |p| (CDR |p|) + |ILIST;removeDuplicates!;2$;26|) + (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 + (LETT |pp| |pr| + |ILIST;removeDuplicates!;2$;26|))))))))))) (EXIT |l|))))) (DEFUN |ILIST;sort!;M2$;27| (|f| |l| $) @@ -377,24 +375,23 @@ |ILIST;merge!;M3$;28|) (EXIT (LETT |q| (CDR |q|) |ILIST;merge!;M3$;28|))))) - (SEQ G190 - (COND - ((NULL (COND - ((NULL |p|) NIL) - ('T (NOT (NULL |q|))))) - (GO G191))) - (COND - ((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|)))) - ('T - (SEQ (QRPLACD |t| |q|) - (LETT |t| |q| |ILIST;merge!;M3$;28|) - (EXIT (LETT |q| (CDR |q|) - |ILIST;merge!;M3$;28|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((NULL |p|) NIL) + ('T (NOT (NULL |q|))))) + (RETURN NIL)) + (T (COND + ((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|)))) + ('T + (SEQ (QRPLACD |t| |q|) + (LETT |t| |q| |ILIST;merge!;M3$;28|) + (EXIT (LETT |q| (CDR |q|) + |ILIST;merge!;M3$;28|)))))))) (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|))) (EXIT |r|)))))))) diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp index 9b1413c2..9ea32aca 100644 --- a/src/algebra/strap/INS-.lsp +++ b/src/algebra/strap/INS-.lsp @@ -242,30 +242,29 @@ (LETT |c1| (|spadConstant| $ 22) |INS-;invmod;3S;28|) (LETT |d| |b| |INS-;invmod;3S;28|) (LETT |d1| (|spadConstant| $ 10) |INS-;invmod;3S;28|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |d| (|getShellEntry| $ 66)))) - (GO G191))) - (SEQ (LETT |q| - (SPADCALL |c| |d| (|getShellEntry| $ 87)) - |INS-;invmod;3S;28|) - (LETT |r| - (SPADCALL |c| - (SPADCALL |q| |d| - (|getShellEntry| $ 88)) - (|getShellEntry| $ 67)) - |INS-;invmod;3S;28|) - (LETT |r1| - (SPADCALL |c1| - (SPADCALL |q| |d1| - (|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|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |d| (|getShellEntry| $ 66)))) + (RETURN NIL)) + (T (SEQ (LETT |q| + (SPADCALL |c| |d| (|getShellEntry| $ 87)) + |INS-;invmod;3S;28|) + (LETT |r| + (SPADCALL |c| + (SPADCALL |q| |d| + (|getShellEntry| $ 88)) + (|getShellEntry| $ 67)) + |INS-;invmod;3S;28|) + (LETT |r1| + (SPADCALL |c1| + (SPADCALL |q| |d1| + (|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|)))))) (COND ((NOT (SPADCALL |c| (|getShellEntry| $ 89))) (EXIT (|error| "inverse does not exist")))) @@ -290,7 +289,10 @@ (SEQ (LETT |y| (|spadConstant| $ 22) |INS-;powmod;4S;29|) (LETT |z| |x| |INS-;powmod;4S;29|) - (EXIT (SEQ G190 NIL + (EXIT (LOOP + (COND + (NIL (RETURN NIL)) + (T (SEQ (COND ((SPADCALL |n| @@ -317,8 +319,7 @@ (LETT |z| (SPADCALL |z| |z| |p| (|getShellEntry| $ 91)) - |INS-;powmod;4S;29|))))) - NIL (GO G190) G191 (EXIT NIL))))))))))) + |INS-;powmod;4S;29|))))))))))))))))) (DEFUN |IntegerNumberSystem&| (|#1|) (LET* ((|dv$1| (|devaluate| |#1|)) diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp index 1fbd9827..f388672e 100644 --- a/src/algebra/strap/ISTRING.lsp +++ b/src/algebra/strap/ISTRING.lsp @@ -178,7 +178,7 @@ (STRCONC "\\mbox{``" (STRCONC |s| "''}"))) (DEFUN |ISTRING;replace;$Us2$;15| (|s| |sg| |t| $) - (PROG (|l| |m| |n| |h| |r| #0=#:G1535 #1=#:G1536 |i| #2=#:G1537 |k|) + (PROG (|l| |m| |n| |h| |r| |k|) (RETURN (SEQ (LETT |l| (- (SPADCALL |sg| (|getShellEntry| $ 44)) @@ -200,34 +200,37 @@ (EXIT (|error| "index out of range")))) (LETT |r| (MAKE-FULL-CVEC - (LET ((#3=#:G1444 + (LET ((#0=#:G1444 (+ (- |m| (+ (- |h| |l|) 1)) |n|))) - (|check-subtype| (>= #3# 0) - '(|NonNegativeInteger|) #3#)) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) (|spadConstant| $ 53)) |ISTRING;replace;$Us2$;15|) (LETT |k| 0 |ISTRING;replace;$Us2$;15|) - (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) - (LETT #0# (- |l| 1) |ISTRING;replace;$Us2$;15|) G190 - (COND ((QSGREATERP |i| #0#) (GO G191))) - (SEQ (QESET |r| |k| (CHAR |s| |i|)) - (EXIT (LETT |k| (+ |k| 1) - |ISTRING;replace;$Us2$;15|))) - (SETQ |i| (QSADD1 |i|)) (GO G190) G191 (EXIT NIL)) - (SEQ (LETT |i| 0 |ISTRING;replace;$Us2$;15|) - (LETT #1# (- |n| 1) |ISTRING;replace;$Us2$;15|) G190 - (COND ((QSGREATERP |i| #1#) (GO G191))) - (SEQ (QESET |r| |k| (CHAR |t| |i|)) - (EXIT (LETT |k| (+ |k| 1) - |ISTRING;replace;$Us2$;15|))) - (SETQ |i| (QSADD1 |i|)) (GO G190) G191 (EXIT NIL)) - (SEQ (LETT |i| (+ |h| 1) |ISTRING;replace;$Us2$;15|) - (LETT #2# (- |m| 1) |ISTRING;replace;$Us2$;15|) G190 - (COND ((> |i| #2#) (GO G191))) - (SEQ (QESET |r| |k| (CHAR |s| |i|)) - (EXIT (LETT |k| (+ |k| 1) - |ISTRING;replace;$Us2$;15|))) - (SETQ |i| (+ |i| 1)) (GO G190) G191 (EXIT NIL)) + (LET ((|i| 0) (#1=#:G1535 (- |l| 1))) + (LOOP + (COND + ((> |i| #1#) (RETURN NIL)) + (T (SEQ (QESET |r| |k| (CHAR |s| |i|)) + (EXIT (LETT |k| (+ |k| 1) + |ISTRING;replace;$Us2$;15|))))) + (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|))))) + (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|))))) + (SETQ |i| (+ |i| 1)))) (EXIT |r|))))) (DEFUN |ISTRING;setelt;$I2C;16| (|s| |i| |c| $) @@ -240,7 +243,7 @@ (EXIT |c|)))))) (DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $) - (PROG (|np| |nw| |iw| |ip| #0=#:G1538) + (PROG (|np| |nw|) (RETURN (SEQ (LETT |np| (QCSIZE |part|) |ISTRING;substring?;2$IB;17|) (LETT |nw| (QCSIZE |whole|) |ISTRING;substring?;2$IB;17|) @@ -250,26 +253,20 @@ ((< |startpos| 0) (|error| "index out of bounds")) ((> |np| (- |nw| |startpos|)) NIL) ('T - (SEQ (SEQ (LETT |iw| |startpos| - |ISTRING;substring?;2$IB;17|) - (LETT |ip| 0 - |ISTRING;substring?;2$IB;17|) - (LETT #0# (- |np| 1) - |ISTRING;substring?;2$IB;17|) - G190 - (COND ((QSGREATERP |ip| #0#) (GO G191))) - (SEQ (EXIT - (COND - ((NOT - (CHAR= (CHAR |part| |ip|) - (CHAR |whole| |iw|))) - (RETURN-FROM - |ISTRING;substring?;2$IB;17| - NIL))))) - (SETQ |ip| - (PROG1 (QSADD1 |ip|) - (SETQ |iw| (+ |iw| 1)))) - (GO G190) G191 (EXIT NIL)) + (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| $) @@ -290,55 +287,47 @@ ('T (+ |r| (|getShellEntry| $ 6))))))))))))) (DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $) - (PROG (|r| #0=#:G1539) - (RETURN - (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) - |ISTRING;position;C$2I;19|) - (EXIT (COND - ((< |startpos| 0) (|error| "index out of bounds")) - ((>= |startpos| (QCSIZE |t|)) - (- (|getShellEntry| $ 6) 1)) - ('T - (SEQ (SEQ (LETT |r| |startpos| - |ISTRING;position;C$2I;19|) - (LETT #0# (- (QCSIZE |t|) 1) - |ISTRING;position;C$2I;19|) - G190 (COND ((> |r| #0#) (GO G191))) - (SEQ (EXIT - (COND - ((CHAR= (CHAR |t| |r|) |c|) - (RETURN-FROM - |ISTRING;position;C$2I;19| - (+ |r| (|getShellEntry| $ 6))))))) - (SETQ |r| (+ |r| 1)) (GO G190) G191 - (EXIT NIL)) - (EXIT (- (|getShellEntry| $ 6) 1)))))))))) + (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) + |ISTRING;position;C$2I;19|) + (EXIT (COND + ((< |startpos| 0) (|error| "index out of bounds")) + ((>= |startpos| (QCSIZE |t|)) + (- (|getShellEntry| $ 6) 1)) + ('T + (SEQ (LET ((|r| |startpos|) + (#0=#:G1539 (- (QCSIZE |t|) 1))) + (LOOP + (COND + ((> |r| #0#) (RETURN NIL)) + (T (COND + ((CHAR= (CHAR |t| |r|) |c|) + (RETURN-FROM + |ISTRING;position;C$2I;19| + (+ |r| (|getShellEntry| $ 6))))))) + (SETQ |r| (+ |r| 1)))) + (EXIT (- (|getShellEntry| $ 6) 1)))))))) (DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $) - (PROG (|r| #0=#:G1540) - (RETURN - (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) - |ISTRING;position;Cc$2I;20|) - (EXIT (COND - ((< |startpos| 0) (|error| "index out of bounds")) - ((>= |startpos| (QCSIZE |t|)) - (- (|getShellEntry| $ 6) 1)) - ('T - (SEQ (SEQ (LETT |r| |startpos| - |ISTRING;position;Cc$2I;20|) - (LETT #0# (- (QCSIZE |t|) 1) - |ISTRING;position;Cc$2I;20|) - G190 (COND ((> |r| #0#) (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL (CHAR |t| |r|) |cc| - (|getShellEntry| $ 65)) - (RETURN-FROM - |ISTRING;position;Cc$2I;20| - (+ |r| (|getShellEntry| $ 6))))))) - (SETQ |r| (+ |r| 1)) (GO G190) G191 - (EXIT NIL)) - (EXIT (- (|getShellEntry| $ 6) 1)))))))))) + (SEQ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6)) + |ISTRING;position;Cc$2I;20|) + (EXIT (COND + ((< |startpos| 0) (|error| "index out of bounds")) + ((>= |startpos| (QCSIZE |t|)) + (- (|getShellEntry| $ 6) 1)) + ('T + (SEQ (LET ((|r| |startpos|) + (#0=#:G1540 (- (QCSIZE |t|) 1))) + (LOOP + (COND + ((> |r| #0#) (RETURN NIL)) + (T (COND + ((SPADCALL (CHAR |t| |r|) |cc| + (|getShellEntry| $ 65)) + (RETURN-FROM + |ISTRING;position;Cc$2I;20| + (+ |r| (|getShellEntry| $ 6))))))) + (SETQ |r| (+ |r| 1)))) + (EXIT (- (|getShellEntry| $ 6) 1)))))))) (DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $) (PROG (|m| |n|) @@ -359,53 +348,48 @@ (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;split;$CL;22|) (LETT |i| (|getShellEntry| $ 6) |ISTRING;split;$CL;22|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |c| (|getShellEntry| $ 69))))) - (GO G191))) - (SEQ (EXIT (LETT |i| (+ |i| 1) |ISTRING;split;$CL;22|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| + (|getShellEntry| $ 69))))) + (RETURN NIL)) + (T (LETT |i| (+ |i| 1) |ISTRING;split;$CL;22|)))) (LETT |l| NIL |ISTRING;split;$CL;22|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| |n|) NIL) - ('T - (>= (LETT |j| - (|ISTRING;position;C$2I;19| |c| - |s| |i| $) - |ISTRING;split;$CL;22|) - (|getShellEntry| $ 6))))) - (GO G191))) - (SEQ (LETT |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|) - (EXIT (SEQ G190 - (COND - ((NULL - (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL - (|ISTRING;elt;$IC;30| |s| |i| - $) - |c| (|getShellEntry| $ 69))))) - (GO G191))) - (SEQ (EXIT - (LETT |i| (+ |i| 1) - |ISTRING;split;$CL;22|))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) + (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 (LETT |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|) + (EXIT (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL + (|ISTRING;elt;$IC;30| |s| + |i| $) + |c| (|getShellEntry| $ 69))))) + (RETURN NIL)) + (T (LETT |i| (+ |i| 1) + |ISTRING;split;$CL;22|))))))))) (COND ((NOT (> |i| |n|)) (LETT |l| @@ -423,53 +407,48 @@ (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;split;$CcL;23|) (LETT |i| (|getShellEntry| $ 6) |ISTRING;split;$CcL;23|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |cc| (|getShellEntry| $ 65))))) - (GO G191))) - (SEQ (EXIT (LETT |i| (+ |i| 1) |ISTRING;split;$CcL;23|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| + (|getShellEntry| $ 65))))) + (RETURN NIL)) + (T (LETT |i| (+ |i| 1) |ISTRING;split;$CcL;23|)))) (LETT |l| NIL |ISTRING;split;$CcL;23|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| |n|) NIL) - ('T - (>= (LETT |j| - (|ISTRING;position;Cc$2I;20| |cc| - |s| |i| $) - |ISTRING;split;$CcL;23|) - (|getShellEntry| $ 6))))) - (GO G191))) - (SEQ (LETT |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|) - (EXIT (SEQ G190 - (COND - ((NULL - (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL - (|ISTRING;elt;$IC;30| |s| |i| - $) - |cc| (|getShellEntry| $ 65))))) - (GO G191))) - (SEQ (EXIT - (LETT |i| (+ |i| 1) - |ISTRING;split;$CcL;23|))) - NIL (GO G190) G191 (EXIT NIL)))) - NIL (GO G190) G191 (EXIT NIL)) + (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 (LETT |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|) + (EXIT (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL + (|ISTRING;elt;$IC;30| |s| + |i| $) + |cc| (|getShellEntry| $ 65))))) + (RETURN NIL)) + (T (LETT |i| (+ |i| 1) + |ISTRING;split;$CcL;23|))))))))) (COND ((NOT (> |i| |n|)) (LETT |l| @@ -487,17 +466,15 @@ (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;leftTrim;$C$;24|) (LETT |i| (|getShellEntry| $ 6) |ISTRING;leftTrim;$C$;24|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |c| (|getShellEntry| $ 69))))) - (GO G191))) - (SEQ (EXIT (LETT |i| (+ |i| 1) - |ISTRING;leftTrim;$C$;24|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |c| + (|getShellEntry| $ 69))))) + (RETURN NIL)) + (T (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$C$;24|)))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))) @@ -507,17 +484,15 @@ (SEQ (LETT |n| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;leftTrim;$Cc$;25|) (LETT |i| (|getShellEntry| $ 6) |ISTRING;leftTrim;$Cc$;25|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| |n|) NIL) - ('T - (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) - |cc| (|getShellEntry| $ 65))))) - (GO G191))) - (SEQ (EXIT (LETT |i| (+ |i| 1) - |ISTRING;leftTrim;$Cc$;25|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((> |i| |n|) NIL) + ('T + (SPADCALL (|ISTRING;elt;$IC;30| |s| |i| $) |cc| + (|getShellEntry| $ 65))))) + (RETURN NIL)) + (T (LETT |i| (+ |i| 1) |ISTRING;leftTrim;$Cc$;25|)))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL |i| |n| (|getShellEntry| $ 24)) $)))))) @@ -526,17 +501,15 @@ (RETURN (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;rightTrim;$C$;26|) - (SEQ G190 - (COND - ((NULL (COND - ((>= |j| (|getShellEntry| $ 6)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) - |c| (|getShellEntry| $ 69))) - ('T NIL))) - (GO G191))) - (SEQ (EXIT (LETT |j| (- |j| 1) - |ISTRING;rightTrim;$C$;26|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((>= |j| (|getShellEntry| $ 6)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |c| + (|getShellEntry| $ 69))) + ('T NIL))) + (RETURN NIL)) + (T (LETT |j| (- |j| 1) |ISTRING;rightTrim;$C$;26|)))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| (|getShellEntry| $ 24)) @@ -547,51 +520,49 @@ (RETURN (SEQ (LETT |j| (SPADCALL |s| (|getShellEntry| $ 47)) |ISTRING;rightTrim;$Cc$;27|) - (SEQ G190 - (COND - ((NULL (COND - ((>= |j| (|getShellEntry| $ 6)) - (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) - |cc| (|getShellEntry| $ 65))) - ('T NIL))) - (GO G191))) - (SEQ (EXIT (LETT |j| (- |j| 1) - |ISTRING;rightTrim;$Cc$;27|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((>= |j| (|getShellEntry| $ 6)) + (SPADCALL (|ISTRING;elt;$IC;30| |s| |j| $) |cc| + (|getShellEntry| $ 65))) + ('T NIL))) + (RETURN NIL)) + (T (LETT |j| (- |j| 1) |ISTRING;rightTrim;$Cc$;27|)))) (EXIT (|ISTRING;elt;$Us$;31| |s| (SPADCALL (|ISTRING;minIndex;$I;11| |s| $) |j| (|getShellEntry| $ 24)) $)))))) (DEFUN |ISTRING;concat;L$;28| (|l| $) - (PROG (|t| |s| #0=#:G1542 |i|) + (PROG (|t| |i|) (RETURN (SEQ (LETT |t| (MAKE-FULL-CVEC - (LET ((#1=#:G1497 NIL) (#2=#:G1498 T) - (#3=#:G1541 |l|)) + (LET ((#0=#:G1497 NIL) (#1=#:G1498 T) + (#2=#:G1541 |l|)) (LOOP (COND - ((ATOM #3#) (RETURN (COND (#2# 0) (T #1#)))) - (T (LET ((|s| (CAR #3#))) - (LET ((#4=#:G1496 (QCSIZE |s|))) + ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) + (T (LET ((|s| (CAR #2#))) + (LET ((#3=#:G1496 (QCSIZE |s|))) (COND - (#2# (SETQ #1# #4#)) - (T (SETQ #1# (+ #1# #4#)))) - (SETQ #2# NIL))))) - (SETQ #3# (CDR #3#)))) + (#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|) - (SEQ (LETT |s| NIL |ISTRING;concat;L$;28|) - (LETT #0# |l| |ISTRING;concat;L$;28|) G190 - (COND - ((OR (ATOM #0#) (PROGN (SETQ |s| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (|ISTRING;copyInto!;2$I$;29| |t| |s| |i| $) - (EXIT (LETT |i| (+ |i| (QCSIZE |s|)) - |ISTRING;concat;L$;28|))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) + (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 (LETT |i| (+ |i| (QCSIZE |s|)) + |ISTRING;concat;L$;28|)))))) + (SETQ #4# (CDR #4#)))) (EXIT |t|))))) (DEFUN |ISTRING;copyInto!;2$I$;29| (|y| |x| |s| $) @@ -680,49 +651,50 @@ (|check-subtype| (>= #1# 0) '(|NonNegativeInteger|) #1#)) |ISTRING;match?;2$CB;34|) - (SEQ G190 - (COND - ((NULL (SPADCALL |q| (- |m| 1) - (|getShellEntry| $ 87))) - (GO G191))) - (SEQ (LETT |s| - (|ISTRING;elt;$Us$;31| |pattern| - (SPADCALL (+ |p| 1) (- |q| 1) - (|getShellEntry| $ 24)) - $) - |ISTRING;match?;2$CB;34|) - (LETT |i| - (LET - ((#2=#:G1527 - (|ISTRING;position;2$2I;18| |s| - |target| |i| $))) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#)) - |ISTRING;match?;2$CB;34|) - (EXIT - (COND - ((EQL |i| (- |m| 1)) - (RETURN-FROM - |ISTRING;match?;2$CB;34| - NIL)) - ('T - (SEQ - (LETT |i| (+ |i| (QCSIZE |s|)) - |ISTRING;match?;2$CB;34|) - (LETT |p| |q| - |ISTRING;match?;2$CB;34|) - (EXIT - (LETT |q| - (LET - ((#3=#:G1528 - (|ISTRING;position;C$2I;19| - |dontcare| |pattern| - (+ |q| 1) $))) - (|check-subtype| (>= #3# 0) - '(|NonNegativeInteger|) - #3#)) - |ISTRING;match?;2$CB;34|))))))) - NIL (GO G190) G191 (EXIT NIL)) + (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|) + (LETT |i| + (LET + ((#2=#:G1527 + (|ISTRING;position;2$2I;18| + |s| |target| |i| $))) + (|check-subtype| (>= #2# 0) + '(|NonNegativeInteger|) #2#)) + |ISTRING;match?;2$CB;34|) + (EXIT + (COND + ((EQL |i| (- |m| 1)) + (RETURN-FROM + |ISTRING;match?;2$CB;34| + NIL)) + ('T + (SEQ + (LETT |i| + (+ |i| (QCSIZE |s|)) + |ISTRING;match?;2$CB;34|) + (LETT |p| |q| + |ISTRING;match?;2$CB;34|) + (EXIT + (LETT |q| + (LET + ((#3=#:G1528 + (|ISTRING;position;C$2I;19| + |dontcare| |pattern| + (+ |q| 1) $))) + (|check-subtype| + (>= #3# 0) + '(|NonNegativeInteger|) + #3#)) + |ISTRING;match?;2$CB;34|)))))))))) (COND ((SPADCALL |p| |n| (|getShellEntry| $ 87)) (COND diff --git a/src/algebra/strap/LIST.lsp b/src/algebra/strap/LIST.lsp index 4f3d5c16..a91654a2 100644 --- a/src/algebra/strap/LIST.lsp +++ b/src/algebra/strap/LIST.lsp @@ -63,12 +63,15 @@ (DEFUN |LIST;writeOMList| (|dev| |x| $) (SEQ (SPADCALL |dev| (|getShellEntry| $ 16)) (SPADCALL |dev| "list1" "list" (|getShellEntry| $ 18)) - (SEQ G190 (COND ((NULL (NOT (NULL |x|))) (GO G191))) - (SEQ (SPADCALL |dev| (SPADCALL |x| (|getShellEntry| $ 20)) - NIL (|getShellEntry| $ 22)) - (EXIT (LETT |x| (SPADCALL |x| (|getShellEntry| $ 23)) - |LIST;writeOMList|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |x|))) (RETURN NIL)) + (T (SEQ (SPADCALL |dev| + (SPADCALL |x| (|getShellEntry| $ 20)) NIL + (|getShellEntry| $ 22)) + (EXIT (LETT |x| + (SPADCALL |x| (|getShellEntry| $ 23)) + |LIST;writeOMList|)))))) (EXIT (SPADCALL |dev| (|getShellEntry| $ 24))))) (DEFUN |LIST;OMwrite;$S;6| (|x| $) @@ -125,23 +128,23 @@ |LIST;setIntersection;3$;11|) (LETT |l1| (SPADCALL |l1| (|getShellEntry| $ 36)) |LIST;setIntersection;3$;11|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) - (GO G191))) - (SEQ (COND - ((SPADCALL - (SPADCALL |l1| (|getShellEntry| $ 20)) |l2| - (|getShellEntry| $ 40)) - (LETT |u| - (CONS (SPADCALL |l1| - (|getShellEntry| $ 20)) - |u|) - |LIST;setIntersection;3$;11|))) - (EXIT (LETT |l1| - (SPADCALL |l1| (|getShellEntry| $ 23)) - |LIST;setIntersection;3$;11|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) + (RETURN NIL)) + (T (SEQ (COND + ((SPADCALL + (SPADCALL |l1| (|getShellEntry| $ 20)) + |l2| (|getShellEntry| $ 40)) + (LETT |u| + (CONS (SPADCALL |l1| + (|getShellEntry| $ 20)) + |u|) + |LIST;setIntersection;3$;11|))) + (EXIT (LETT |l1| + (SPADCALL |l1| + (|getShellEntry| $ 23)) + |LIST;setIntersection;3$;11|)))))) (EXIT |u|))))) (DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $) @@ -151,24 +154,24 @@ |LIST;setDifference;3$;12|) (LETT |lu| (SPADCALL (|getShellEntry| $ 38)) |LIST;setDifference;3$;12|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) - (GO G191))) - (SEQ (LETT |l11| - (SPADCALL |l1| 1 (|getShellEntry| $ 42)) - |LIST;setDifference;3$;12|) - (COND - ((NOT (SPADCALL |l11| |l2| - (|getShellEntry| $ 40))) - (LETT |lu| - (SPADCALL |l11| |lu| - (|getShellEntry| $ 43)) - |LIST;setDifference;3$;12|))) - (EXIT (LETT |l1| - (SPADCALL |l1| (|getShellEntry| $ 23)) - |LIST;setDifference;3$;12|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |l1| (|getShellEntry| $ 39)))) + (RETURN NIL)) + (T (SEQ (LETT |l11| + (SPADCALL |l1| 1 (|getShellEntry| $ 42)) + |LIST;setDifference;3$;12|) + (COND + ((NOT (SPADCALL |l11| |l2| + (|getShellEntry| $ 40))) + (LETT |lu| + (SPADCALL |l11| |lu| + (|getShellEntry| $ 43)) + |LIST;setDifference;3$;12|))) + (EXIT (LETT |l1| + (SPADCALL |l1| + (|getShellEntry| $ 23)) + |LIST;setDifference;3$;12|)))))) (EXIT |lu|))))) (DEFUN |LIST;convert;$If;13| (|x| $) diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp index c563a160..839b2578 100644 --- a/src/algebra/strap/LSAGG-.lsp +++ b/src/algebra/strap/LSAGG-.lsp @@ -110,20 +110,17 @@ (DEFUN |LSAGG-;select!;M2A;5| (|f| |x| $) (PROG (|y| |z|) (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| - (|getShellEntry| $ 18)) - |f|))))) - (GO G191))) - (SEQ (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|))) - NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T + (NOT (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|))))) + (RETURN NIL)) + (T (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) + |LSAGG-;select!;M2A;5|)))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) |x|) ('T @@ -131,36 +128,34 @@ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 17)) |LSAGG-;select!;M2A;5|) - (SEQ G190 - (COND - ((NULL (NOT - (SPADCALL |z| - (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL - (SPADCALL |z| - (|getShellEntry| $ 18)) - |f|) - (SEQ - (LETT |y| |z| - |LSAGG-;select!;M2A;5|) - (EXIT - (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|)))) - ('T - (SEQ - (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 17)) - |LSAGG-;select!;M2A;5|) - (EXIT - (SPADCALL |y| |z| - (|getShellEntry| $ 27)))))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT + (SPADCALL |z| + (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (COND + ((SPADCALL + (SPADCALL |z| + (|getShellEntry| $ 18)) + |f|) + (SEQ + (LETT |y| |z| + |LSAGG-;select!;M2A;5|) + (EXIT + (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 17)) + |LSAGG-;select!;M2A;5|)))) + ('T + (SEQ + (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 17)) + |LSAGG-;select!;M2A;5|) + (EXIT + (SPADCALL |y| |z| + (|getShellEntry| $ 27))))))))) (EXIT |x|))))))))) (DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) @@ -190,38 +185,35 @@ (SPADCALL |q| (|getShellEntry| $ 17)) |LSAGG-;merge!;M3A;6|))))) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |p| - (|getShellEntry| $ 16)) - NIL) - ('T - (NOT - (SPADCALL |q| + (LOOP + (COND + ((NOT (COND + ((SPADCALL |p| (|getShellEntry| $ 16)) + NIL) + ('T + (NOT (SPADCALL |q| (|getShellEntry| $ 16)))))) - (GO G191))) - (COND - ((SPADCALL - (SPADCALL |p| (|getShellEntry| $ 18)) - (SPADCALL |q| (|getShellEntry| $ 18)) - |f|) - (SEQ (SPADCALL |t| |p| - (|getShellEntry| $ 27)) - (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |p| - (SPADCALL |p| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|)))) - ('T - (SEQ (SPADCALL |t| |q| - (|getShellEntry| $ 27)) - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |q| - (SPADCALL |q| - (|getShellEntry| $ 17)) - |LSAGG-;merge!;M3A;6|))))) - NIL (GO G190) G191 (EXIT NIL)) + (RETURN NIL)) + (T (COND + ((SPADCALL + (SPADCALL |p| (|getShellEntry| $ 18)) + (SPADCALL |q| (|getShellEntry| $ 18)) + |f|) + (SEQ (SPADCALL |t| |p| + (|getShellEntry| $ 27)) + (LETT |t| |p| |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 17)) + |LSAGG-;merge!;M3A;6|)))) + ('T + (SEQ (SPADCALL |t| |q| + (|getShellEntry| $ 27)) + (LETT |t| |q| |LSAGG-;merge!;M3A;6|) + (EXIT (LETT |q| + (SPADCALL |q| + (|getShellEntry| $ 17)) + |LSAGG-;merge!;M3A;6|)))))))) (SPADCALL |t| (COND ((SPADCALL |p| (|getShellEntry| $ 16)) |q|) @@ -283,19 +275,16 @@ (DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) (PROG (|p| |q|) (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|)))) - (GO G191))) - (SEQ (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;remove!;M2A;9|))) - NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) + |f|)))) + (RETURN NIL)) + (T (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) + |LSAGG-;remove!;M2A;9|)))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) |x|) ('T @@ -303,34 +292,32 @@ (LETT |q| (SPADCALL |x| (|getShellEntry| $ 17)) |LSAGG-;remove!;M2A;9|) - (SEQ G190 - (COND - ((NULL (NOT - (SPADCALL |q| - (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL - (SPADCALL |q| - (|getShellEntry| $ 18)) - |f|) - (LETT |q| - (SPADCALL |p| - (SPADCALL |q| - (|getShellEntry| $ 17)) - (|getShellEntry| $ 27)) - |LSAGG-;remove!;M2A;9|)) - ('T - (SEQ - (LETT |p| |q| - |LSAGG-;remove!;M2A;9|) - (EXIT - (LETT |q| - (SPADCALL |q| - (|getShellEntry| $ 17)) - |LSAGG-;remove!;M2A;9|))))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT + (SPADCALL |q| + (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (COND + ((SPADCALL + (SPADCALL |q| + (|getShellEntry| $ 18)) + |f|) + (LETT |q| + (SPADCALL |p| + (SPADCALL |q| + (|getShellEntry| $ 17)) + (|getShellEntry| $ 27)) + |LSAGG-;remove!;M2A;9|)) + ('T + (SEQ + (LETT |p| |q| + |LSAGG-;remove!;M2A;9|) + (EXIT + (LETT |q| + (SPADCALL |q| + (|getShellEntry| $ 17)) + |LSAGG-;remove!;M2A;9|)))))))) (EXIT |x|))))))))) (DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) @@ -406,18 +393,16 @@ (EXIT |x|))))))))))))) (DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;find;MAU;12|))) - NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T + (NOT (SPADCALL + (SPADCALL |x| (|getShellEntry| $ 18)) |f|))))) + (RETURN NIL)) + (T (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) + |LSAGG-;find;MAU;12|)))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (CONS 1 "failed")) @@ -428,21 +413,19 @@ (RETURN (SEQ (LETT |k| (SPADCALL |x| (|getShellEntry| $ 33)) |LSAGG-;position;MAI;13|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL - (SPADCALL |x| - (|getShellEntry| $ 18)) - |f|))))) - (GO G191))) - (SEQ (LETT |x| (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;position;MAI;13|) - (EXIT (LETT |k| (+ |k| 1) - |LSAGG-;position;MAI;13|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T + (NOT (SPADCALL + (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|)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (- (SPADCALL |x| (|getShellEntry| $ 33)) 1)) @@ -489,82 +472,79 @@ ('T (SEQ (LETT |p| (SPADCALL |l| (|getShellEntry| $ 17)) |LSAGG-;sorted?;MAB;15|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |p| - (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (COND - ((NOT (SPADCALL - (SPADCALL |l| - (|getShellEntry| $ 18)) - (SPADCALL |p| - (|getShellEntry| $ 18)) - |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|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (COND + ((NOT (SPADCALL + (SPADCALL |l| + (|getShellEntry| $ 18)) + (SPADCALL |p| + (|getShellEntry| $ 18)) + |f|)) + (RETURN-FROM |LSAGG-;sorted?;MAB;15| + NIL))) + (EXIT (LETT |p| + (SPADCALL + (LETT |l| |p| + |LSAGG-;sorted?;MAB;15|) + (|getShellEntry| $ 17)) + |LSAGG-;sorted?;MAB;15|)))))) (EXIT T)))))))) (DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) (PROG (|r|) (RETURN (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (LETT |r| - (SPADCALL |r| - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|) - |LSAGG-;reduce;MA2S;16|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;reduce;MA2S;16|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (LETT |r| + (SPADCALL |r| + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|) + |LSAGG-;reduce;MA2S;16|) + (EXIT (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 17)) + |LSAGG-;reduce;MA2S;16|)))))) (EXIT |r|))))) (DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) (PROG (|r|) (RETURN (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (SPADCALL |r| |a| (|getShellEntry| $ 61))))) - (GO G191))) - (SEQ (LETT |r| - (SPADCALL |r| - (SPADCALL |x| (|getShellEntry| $ 18)) - |f|) - |LSAGG-;reduce;MA3S;17|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;reduce;MA3S;17|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T (SPADCALL |r| |a| (|getShellEntry| $ 61))))) + (RETURN NIL)) + (T (SEQ (LETT |r| + (SPADCALL |r| + (SPADCALL |x| (|getShellEntry| $ 18)) + |f|) + |LSAGG-;reduce;MA3S;17|) + (EXIT (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 17)) + |LSAGG-;reduce;MA3S;17|)))))) (EXIT |r|))))) (DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) - (PROG (|k| |l|) + (PROG (|l|) (RETURN (SEQ (LETT |l| (SPADCALL (|getShellEntry| $ 13)) |LSAGG-;new;NniSA;18|) - (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 - (COND ((QSGREATERP |k| |n|) (GO G191))) - (SEQ (EXIT (LETT |l| - (SPADCALL |s| |l| - (|getShellEntry| $ 14)) - |LSAGG-;new;NniSA;18|))) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 (EXIT NIL)) + (LET ((|k| 1)) + (LOOP + (COND + ((> |k| |n|) (RETURN NIL)) + (T (LETT |l| (SPADCALL |s| |l| (|getShellEntry| $ 14)) + |LSAGG-;new;NniSA;18|))) + (SETQ |k| (+ |k| 1)))) (EXIT |l|))))) (DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) @@ -572,29 +552,28 @@ (RETURN (SEQ (LETT |z| (SPADCALL (|getShellEntry| $ 13)) |LSAGG-;map;M3A;19|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T - (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) - (GO G191))) - (SEQ (LETT |z| - (SPADCALL - (SPADCALL - (SPADCALL |x| - (|getShellEntry| $ 18)) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) + (RETURN NIL)) + (T (SEQ (LETT |z| + (SPADCALL + (SPADCALL + (SPADCALL |x| + (|getShellEntry| $ 18)) + (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| (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| - (SPADCALL |y| (|getShellEntry| $ 17)) - |LSAGG-;map;M3A;19|))) - NIL (GO G190) G191 (EXIT NIL)) + (|getShellEntry| $ 17)) + |LSAGG-;map;M3A;19|)))))) (EXIT (SPADCALL |z| (|getShellEntry| $ 55))))))) (DEFUN |LSAGG-;reverse!;2A;20| (|x| $) @@ -610,45 +589,47 @@ ('T (SEQ (SPADCALL |x| (SPADCALL (|getShellEntry| $ 13)) (|getShellEntry| $ 27)) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |y| - (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (LETT |z| - (SPADCALL |y| - (|getShellEntry| $ 17)) - |LSAGG-;reverse!;2A;20|) - (SPADCALL |y| |x| (|getShellEntry| $ 27)) - (LETT |x| |y| |LSAGG-;reverse!;2A;20|) - (EXIT (LETT |y| |z| - |LSAGG-;reverse!;2A;20|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (SEQ (LETT |z| + (SPADCALL |y| + (|getShellEntry| $ 17)) + |LSAGG-;reverse!;2A;20|) + (SPADCALL |y| |x| + (|getShellEntry| $ 27)) + (LETT |x| |y| |LSAGG-;reverse!;2A;20|) + (EXIT (LETT |y| |z| + |LSAGG-;reverse!;2A;20|)))))) (EXIT |x|)))))))) (DEFUN |LSAGG-;copy;2A;21| (|x| $) - (PROG (|k| |y|) + (PROG (|y|) (RETURN (SEQ (LETT |y| (SPADCALL (|getShellEntry| $ 13)) |LSAGG-;copy;2A;21|) - (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 - (COND - ((NULL (NOT (SPADCALL |x| (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (|getShellEntry| $ 67)) - (EXIT (|error| "cyclic list")))))) - (LETT |y| - (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - |y| (|getShellEntry| $ 14)) - |LSAGG-;copy;2A;21|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 17)) - |LSAGG-;copy;2A;21|))) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 (EXIT NIL)) + (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")))))) + (LETT |y| + (SPADCALL + (SPADCALL |x| + (|getShellEntry| $ 18)) + |y| (|getShellEntry| $ 14)) + |LSAGG-;copy;2A;21|) + (EXIT (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 17)) + |LSAGG-;copy;2A;21|))))) + (SETQ |k| (+ |k| 1)))) (EXIT (SPADCALL |y| (|getShellEntry| $ 55))))))) (DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) @@ -666,31 +647,30 @@ '(|NonNegativeInteger|) #0#)) (|getShellEntry| $ 39)) |LSAGG-;copyInto!;2AIA;22|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |z| - (|getShellEntry| $ 16)) - NIL) - ('T - (NOT - (SPADCALL |x| - (|getShellEntry| $ 16)))))) - (GO G191))) - (SEQ (SPADCALL |z| - (SPADCALL |x| - (|getShellEntry| $ 18)) - (|getShellEntry| $ 69)) - (LETT |x| - (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;copyInto!;2AIA;22|) - (EXIT - (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 17)) - |LSAGG-;copyInto!;2AIA;22|))) - NIL (GO G190) G191 (EXIT NIL)) + (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)) + (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 17)) + |LSAGG-;copyInto!;2AIA;22|) + (EXIT + (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 17)) + |LSAGG-;copyInto!;2AIA;22|)))))) (EXIT |y|))))))))) (DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) @@ -709,26 +689,25 @@ (|getShellEntry| $ 39)) |LSAGG-;position;SA2I;23|) (LETT |k| |s| |LSAGG-;position;SA2I;23|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| - (|getShellEntry| $ 16)) - NIL) - ('T - (SPADCALL |w| - (SPADCALL |x| - (|getShellEntry| $ 18)) - (|getShellEntry| $ 61))))) - (GO G191))) - (SEQ (LETT |x| - (SPADCALL |x| - (|getShellEntry| $ 17)) - |LSAGG-;position;SA2I;23|) - (EXIT - (LETT |k| (+ |k| 1) - |LSAGG-;position;SA2I;23|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| + (|getShellEntry| $ 16)) + NIL) + ('T + (SPADCALL |w| + (SPADCALL |x| + (|getShellEntry| $ 18)) + (|getShellEntry| $ 61))))) + (RETURN NIL)) + (T (SEQ (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 17)) + |LSAGG-;position;SA2I;23|) + (EXIT + (LETT |k| (+ |k| 1) + |LSAGG-;position;SA2I;23|)))))) (EXIT (COND ((SPADCALL |x| (|getShellEntry| $ 16)) (- (SPADCALL |x| @@ -740,22 +719,19 @@ (PROG (|p|) (RETURN (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) - (GO G191))) - (SEQ (EXIT (LETT |p| - (SPADCALL |p| - (SPADCALL - (CONS - #'|LSAGG-;removeDuplicates!;2A;24!0| - (VECTOR $ |p|)) - (SPADCALL |p| - (|getShellEntry| $ 17)) - (|getShellEntry| $ 73)) - (|getShellEntry| $ 27)) - |LSAGG-;removeDuplicates!;2A;24|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |p| (|getShellEntry| $ 16)))) + (RETURN NIL)) + (T (LETT |p| + (SPADCALL |p| + (SPADCALL + (CONS #'|LSAGG-;removeDuplicates!;2A;24!0| + (VECTOR $ |p|)) + (SPADCALL |p| (|getShellEntry| $ 17)) + (|getShellEntry| $ 73)) + (|getShellEntry| $ 27)) + |LSAGG-;removeDuplicates!;2A;24|)))) (EXIT |l|))))) (DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) @@ -765,32 +741,26 @@ (|getShellEntry| $ 72)))) (DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) - ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - (SPADCALL |y| (|getShellEntry| $ 18)) - (|getShellEntry| $ 61)) - (RETURN-FROM |LSAGG-;<;2AB;25| - (SPADCALL - (SPADCALL |x| (|getShellEntry| $ 18)) - (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|))))))) - NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 16)) NIL) + ('T (NOT (SPADCALL |y| (|getShellEntry| $ 16)))))) + (RETURN NIL)) + (T (COND + ((SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) + (SPADCALL |y| (|getShellEntry| $ 18)) + (|getShellEntry| $ 61)) + (RETURN-FROM |LSAGG-;<;2AB;25| + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) + (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|)))))))) (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 7f50792b..5cc0a555 100644 --- a/src/algebra/strap/OUTFORM.lsp +++ b/src/algebra/strap/OUTFORM.lsp @@ -664,24 +664,23 @@ (CONS 'AGGSET |l|)) (DEFUN |OUTFORM;blankSeparate;L$;35| (|l| $) - (PROG (|c| |u| #0=#:G1555 |l1|) + (PROG (|c| |l1|) (RETURN (SEQ (LETT |c| 'CONCATB |OUTFORM;blankSeparate;L$;35|) (LETT |l1| NIL |OUTFORM;blankSeparate;L$;35|) - (SEQ (LETT |u| NIL |OUTFORM;blankSeparate;L$;35|) - (LETT #0# (REVERSE |l|) |OUTFORM;blankSeparate;L$;35|) - G190 - (COND - ((OR (ATOM #0#) (PROGN (SETQ |u| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (EXIT (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 #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) + (LET ((#0=#:G1555 (REVERSE |l|))) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (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 #0# (CDR #0#)))) (EXIT (CONS |c| |l1|)))))) (DEFUN |OUTFORM;brace;2$;36| (|a| $) diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp index 7da03455..77d1c45c 100644 --- a/src/algebra/strap/POLYCAT-.lsp +++ b/src/algebra/strap/POLYCAT-.lsp @@ -142,84 +142,75 @@ |POLYCAT-;convert;SIf;43|)) (DEFUN |POLYCAT-;eval;SLS;1| (|p| |l| $) - (PROG (|e| #0=#:G1691 #1=#:G1427 |lvar|) + (PROG (|lvar|) (RETURN (SEQ (COND ((NULL |l|) |p|) ('T - (SEQ (SEQ (EXIT (SEQ (LETT |e| NIL |POLYCAT-;eval;SLS;1|) - (LETT #0# |l| |POLYCAT-;eval;SLS;1|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (SETQ |e| (CAR #0#)) - NIL)) - (GO G191))) - (COND - ((EQL - (CAR - (SPADCALL - (SPADCALL |e| - (|getShellEntry| $ 14)) - (|getShellEntry| $ 16))) - 1) - (PROGN - (LETT #1# - (|error| - "cannot find a variable to evaluate") - |POLYCAT-;eval;SLS;1|) - (GO #1#)))) - (SETQ #0# (CDR #0#)) (GO G190) G191 - (EXIT NIL))) - #1# (EXIT #1#)) + (SEQ (LET ((#0=#:G1691 |l|)) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|e| (CAR #0#))) + (COND + ((EQL (CAR + (SPADCALL + (SPADCALL |e| + (|getShellEntry| $ 14)) + (|getShellEntry| $ 16))) + 1) + (RETURN + (|error| + "cannot find a variable to evaluate"))))))) + (SETQ #0# (CDR #0#)))) (LETT |lvar| - (LET ((#2=#:G1693 |l|) (#3=#:G1692 NIL)) + (LET ((#1=#:G1693 |l|) (#2=#:G1692 NIL)) (LOOP (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|e| (CAR #2#))) - (SETQ #3# + ((ATOM #1#) (RETURN (NREVERSE #2#))) + (T (LET ((|e| (CAR #1#))) + (SETQ #2# (CONS (SPADCALL (SPADCALL |e| (|getShellEntry| $ 14)) (|getShellEntry| $ 17)) - #3#))))) - (SETQ #2# (CDR #2#)))) + #2#))))) + (SETQ #1# (CDR #1#)))) |POLYCAT-;eval;SLS;1|) (EXIT (SPADCALL |p| |lvar| - (LET ((#4=#:G1695 |l|) (#5=#:G1694 NIL)) + (LET ((#3=#:G1695 |l|) (#4=#:G1694 NIL)) (LOOP (COND - ((ATOM #4#) (RETURN (NREVERSE #5#))) + ((ATOM #3#) (RETURN (NREVERSE #4#))) (T - (LET ((|e| (CAR #4#))) - (SETQ #5# + (LET ((|e| (CAR #3#))) + (SETQ #4# (CONS (SPADCALL |e| (|getShellEntry| $ 18)) - #5#))))) - (SETQ #4# (CDR #4#)))) + #4#))))) + (SETQ #3# (CDR #3#)))) (|getShellEntry| $ 21)))))))))) (DEFUN |POLYCAT-;monomials;SL;2| (|p| $) (PROG (|ml|) (RETURN (SEQ (LETT |ml| NIL |POLYCAT-;monomials;SL;2|) - (SEQ G190 - (COND - ((NULL (SPADCALL |p| (|spadConstant| $ 27) - (|getShellEntry| $ 29))) - (GO G191))) - (SEQ (LETT |ml| - (CONS (SPADCALL |p| (|getShellEntry| $ 30)) - |ml|) - |POLYCAT-;monomials;SL;2|) - (EXIT (LETT |p| - (SPADCALL |p| (|getShellEntry| $ 32)) - |POLYCAT-;monomials;SL;2|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (SPADCALL |p| (|spadConstant| $ 27) + (|getShellEntry| $ 29))) + (RETURN NIL)) + (T (SEQ (LETT |ml| + (CONS (SPADCALL |p| + (|getShellEntry| $ 30)) + |ml|) + |POLYCAT-;monomials;SL;2|) + (EXIT (LETT |p| + (SPADCALL |p| + (|getShellEntry| $ 32)) + |POLYCAT-;monomials;SL;2|)))))) (EXIT (REVERSE |ml|)))))) (DEFUN |POLYCAT-;isPlus;SU;3| (|p| $) @@ -390,26 +381,25 @@ (|getShellEntry| $ 59)) |POLYCAT-;totalDegree;SNni;13|) (LETT |d| 0 |POLYCAT-;totalDegree;SNni;13|) - (SEQ G190 - (COND - ((NULL (SPADCALL |u| (|spadConstant| $ 80) - (|getShellEntry| $ 81))) - (GO G191))) - (SEQ (LETT |d| - (MAX |d| - (+ - (SPADCALL |u| - (|getShellEntry| $ 82)) - (SPADCALL + (LOOP + (COND + ((NOT (SPADCALL |u| (|spadConstant| $ 80) + (|getShellEntry| $ 81))) + (RETURN NIL)) + (T (SEQ (LETT |d| + (MAX |d| + (+ + (SPADCALL |u| + (|getShellEntry| $ 82)) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 83)) + (|getShellEntry| $ 84)))) + |POLYCAT-;totalDegree;SNni;13|) + (EXIT (LETT |u| (SPADCALL |u| - (|getShellEntry| $ 83)) - (|getShellEntry| $ 84)))) - |POLYCAT-;totalDegree;SNni;13|) - (EXIT (LETT |u| - (SPADCALL |u| - (|getShellEntry| $ 87)) - |POLYCAT-;totalDegree;SNni;13|))) - NIL (GO G190) G191 (EXIT NIL)) + (|getShellEntry| $ 87)) + |POLYCAT-;totalDegree;SNni;13|)))))) (EXIT |d|)))))))) (DEFUN |POLYCAT-;totalDegree;SLNni;14| (|p| |lv| $) @@ -436,27 +426,26 @@ (COND ((SPADCALL |v| |lv| (|getShellEntry| $ 89)) (LETT |w| 1 |POLYCAT-;totalDegree;SLNni;14|))) - (SEQ G190 - (COND - ((NULL (SPADCALL |u| (|spadConstant| $ 80) - (|getShellEntry| $ 81))) - (GO G191))) - (SEQ (LETT |d| - (MAX |d| - (+ - (* |w| - (SPADCALL |u| - (|getShellEntry| $ 82))) - (SPADCALL + (LOOP + (COND + ((NOT (SPADCALL |u| (|spadConstant| $ 80) + (|getShellEntry| $ 81))) + (RETURN NIL)) + (T (SEQ (LETT |d| + (MAX |d| + (+ + (* |w| + (SPADCALL |u| + (|getShellEntry| $ 82))) + (SPADCALL + (SPADCALL |u| + (|getShellEntry| $ 83)) + |lv| (|getShellEntry| $ 92)))) + |POLYCAT-;totalDegree;SLNni;14|) + (EXIT (LETT |u| (SPADCALL |u| - (|getShellEntry| $ 83)) - |lv| (|getShellEntry| $ 92)))) - |POLYCAT-;totalDegree;SLNni;14|) - (EXIT (LETT |u| - (SPADCALL |u| - (|getShellEntry| $ 87)) - |POLYCAT-;totalDegree;SLNni;14|))) - NIL (GO G190) G191 (EXIT NIL)) + (|getShellEntry| $ 87)) + |POLYCAT-;totalDegree;SLNni;14|)))))) (EXIT |d|)))))))) (DEFUN |POLYCAT-;resultant;2SVarSetS;15| (|p1| |p2| |mvar| $) @@ -484,28 +473,24 @@ (|getShellEntry| $ 100))) (DEFUN |POLYCAT-;P2R| (|p| |b| |n| $) - (PROG (|w| |bj| #0=#:G1703 |i| #1=#:G1702) + (PROG (|w|) (RETURN (SEQ (LETT |w| (SPADCALL |n| (|spadConstant| $ 28) (|getShellEntry| $ 102)) |POLYCAT-;P2R|) - (SEQ (LETT |bj| NIL |POLYCAT-;P2R|) - (LETT #0# |b| |POLYCAT-;P2R|) - (LETT |i| (SPADCALL |w| (|getShellEntry| $ 104)) - |POLYCAT-;P2R|) - (LETT #1# (|sizeOfSimpleArray| |w|) |POLYCAT-;P2R|) - G190 - (COND - ((OR (> |i| #1#) (ATOM #0#) - (PROGN (SETQ |bj| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (EXIT (SPADCALL |w| |i| - (SPADCALL |p| |bj| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 107)))) - (SETQ |i| (PROG1 (+ |i| 1) (SETQ #0# (CDR #0#)))) - (GO G190) G191 (EXIT NIL)) + (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| $) @@ -567,16 +552,17 @@ (LETT |mm| (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| $) |POLYCAT-;reducedSystem;MM;20|) (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MM;20|) - (SEQ G190 (COND ((NULL (NOT (NULL |l|))) (GO G191))) - (SEQ (LETT |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|getShellEntry| $ 119)) - |POLYCAT-;reducedSystem;MM;20|) - (EXIT (LETT |l| (CDR |l|) - |POLYCAT-;reducedSystem;MM;20|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |l|))) (RETURN NIL)) + (T (SEQ (LETT |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 119)) + |POLYCAT-;reducedSystem;MM;20|) + (EXIT (LETT |l| (CDR |l|) + |POLYCAT-;reducedSystem;MM;20|)))))) (EXIT |mm|))))) (DEFUN |POLYCAT-;reducedSystem;MVR;21| (|m| |v| $) @@ -624,24 +610,25 @@ |POLYCAT-;reducedSystem;MVR;21|) (LETT |l| (CDR |l|) |POLYCAT-;reducedSystem;MVR;21|) (LETT |r| (CDR |r|) |POLYCAT-;reducedSystem;MVR;21|) - (SEQ G190 (COND ((NULL (NOT (NULL |l|))) (GO G191))) - (SEQ (LETT |mm| - (SPADCALL |mm| - (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| - $) - (|getShellEntry| $ 119)) - |POLYCAT-;reducedSystem;MVR;21|) - (LETT |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|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |l|))) (RETURN NIL)) + (T (SEQ (LETT |mm| + (SPADCALL |mm| + (|POLYCAT-;eq2R| (|SPADfirst| |l|) |d| + $) + (|getShellEntry| $ 119)) + |POLYCAT-;reducedSystem;MVR;21|) + (LETT |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|)))))) (EXIT (CONS |mm| |w|)))))) (DEFUN |POLYCAT-;gcdPolynomial;3Sup;22| (|pp| |qq| $) @@ -730,149 +717,156 @@ (|getShellEntry| $ 159))))))))))) (DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $) - (PROG (|nd| |ll| |ch| |l| #0=#:G1722 |mons| |m| #1=#:G1724 |vars| - |degs| |deg1| |redmons| |llR| |monslist| |ans| |i|) + (PROG (|nd| |vars| |degs| |deg1| |mons| |redmons| |ll| |llR| + |monslist| |ch| |ans| |i|) (RETURN (SEQ (LETT |ll| (SPADCALL (SPADCALL |mat| (|getShellEntry| $ 166)) (|getShellEntry| $ 114)) |POLYCAT-;conditionP;MU;27|) (LETT |llR| - (LET ((#2=#:G1721 (|SPADfirst| |ll|)) - (#3=#:G1720 NIL)) + (LET ((#0=#:G1721 (|SPADfirst| |ll|)) + (#1=#:G1720 NIL)) (LOOP (COND - ((ATOM #2#) (RETURN (NREVERSE #3#))) - (T (LET ((|z| (CAR #2#))) - (SETQ #3# (CONS NIL #3#))))) - (SETQ #2# (CDR #2#)))) + ((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|) - (SEQ (LETT |l| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #0# |ll| |POLYCAT-;conditionP;MU;27|) G190 - (COND - ((OR (ATOM #0#) (PROGN (SETQ |l| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (LETT |mons| - (LET ((#4=#:G1582 NIL) (#5=#:G1583 T) - (#6=#:G1723 |l|)) + (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)))) + (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 #6#) - (RETURN - (COND - (#5# - (|IdentityError| '|setUnion|)) - (T #4#)))) - (T (LET ((|u| (CAR #6#))) - (LET - ((#7=#:G1581 - (SPADCALL |u| - (|getShellEntry| $ 98)))) - (COND - (#5# (SETQ #4# #7#)) - (T - (SETQ #4# - (SPADCALL #4# #7# - (|getShellEntry| $ 170))))) - (SETQ #5# NIL))))) - (SETQ #6# (CDR #6#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| NIL |POLYCAT-;conditionP;MU;27|) - (SEQ (LETT |m| NIL |POLYCAT-;conditionP;MU;27|) - (LETT #1# |mons| |POLYCAT-;conditionP;MU;27|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN (SETQ |m| (CAR #1#)) NIL)) - (GO G191))) - (SEQ (LETT |vars| - (SPADCALL |m| - (|getShellEntry| $ 40)) - |POLYCAT-;conditionP;MU;27|) - (LETT |degs| - (SPADCALL |m| |vars| - (|getShellEntry| $ 171)) - |POLYCAT-;conditionP;MU;27|) - (LETT |deg1| - (LET - ((#8=#:G1726 |degs|) - (#9=#:G1725 NIL)) - (LOOP - (COND - ((ATOM #8#) - (RETURN (NREVERSE #9#))) - (T - (LET ((|d| (CAR #8#))) - (SETQ #9# - (CONS - (SEQ - (LETT |nd| - (SPADCALL |d| |ch| - (|getShellEntry| $ - 173)) - |POLYCAT-;conditionP;MU;27|) - (EXIT - (COND - ((EQL (CAR |nd|) 1) - (RETURN-FROM - |POLYCAT-;conditionP;MU;27| - (CONS 1 - "failed"))) - ('T - (LET - ((#10=#:G1612 - (CDR |nd|))) - (|check-subtype| - (>= #10# 0) - '(|NonNegativeInteger|) - #10#)))))) - #9#))))) - (SETQ #8# (CDR #8#)))) - |POLYCAT-;conditionP;MU;27|) - (LETT |redmons| - (CONS - (SPADCALL (|spadConstant| $ 43) - |vars| |deg1| - (|getShellEntry| $ 70)) - |redmons|) - |POLYCAT-;conditionP;MU;27|) - (EXIT (LETT |llR| - (LET - ((#11=#:G1728 |l|) - (#12=#:G1729 |llR|) - (#13=#:G1727 NIL)) - (LOOP - (COND - ((OR (ATOM #11#) - (ATOM #12#)) - (RETURN (NREVERSE #13#))) - (T - (LET - ((|u| (CAR #11#)) - (|v| (CAR #12#))) - (SETQ #13# - (CONS - (CONS - (SPADCALL - (SPADCALL |u| |vars| - |degs| - (|getShellEntry| $ - 68)) - (|getShellEntry| $ - 175)) - |v|) - #13#))))) - (SETQ #11# (CDR #11#)) - (SETQ #12# (CDR #12#)))) - |POLYCAT-;conditionP;MU;27|))) - (SETQ #1# (CDR #1#)) (GO G190) G191 - (EXIT NIL)) - (EXIT (LETT |monslist| (CONS |redmons| |monslist|) - |POLYCAT-;conditionP;MU;27|))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) + ((ATOM #7#) (RETURN NIL)) + (T (LET ((|m| (CAR #7#))) + (SEQ + (LETT |vars| + (SPADCALL |m| + (|getShellEntry| $ 40)) + |POLYCAT-;conditionP;MU;27|) + (LETT |degs| + (SPADCALL |m| |vars| + (|getShellEntry| $ 171)) + |POLYCAT-;conditionP;MU;27|) + (LETT |deg1| + (LET + ((#8=#:G1726 |degs|) + (#9=#:G1725 NIL)) + (LOOP + (COND + ((ATOM #8#) + (RETURN (NREVERSE #9#))) + (T + (LET ((|d| (CAR #8#))) + (SETQ #9# + (CONS + (SEQ + (LETT |nd| + (SPADCALL |d| |ch| + (|getShellEntry| + $ 173)) + |POLYCAT-;conditionP;MU;27|) + (EXIT + (COND + ((EQL (CAR |nd|) + 1) + (RETURN-FROM + |POLYCAT-;conditionP;MU;27| + (CONS 1 + "failed"))) + ('T + (LET + ((#10=#:G1612 + (CDR |nd|))) + (|check-subtype| + (>= #10# 0) + '(|NonNegativeInteger|) + #10#)))))) + #9#))))) + (SETQ #8# (CDR #8#)))) + |POLYCAT-;conditionP;MU;27|) + (LETT |redmons| + (CONS + (SPADCALL + (|spadConstant| $ 43) |vars| + |deg1| + (|getShellEntry| $ 70)) + |redmons|) + |POLYCAT-;conditionP;MU;27|) + (EXIT + (LETT |llR| + (LET + ((#11=#:G1728 |l|) + (#12=#:G1729 |llR|) + (#13=#:G1727 NIL)) + (LOOP + (COND + ((OR (ATOM #11#) + (ATOM #12#)) + (RETURN + (NREVERSE #13#))) + (T + (LET + ((|u| (CAR #11#)) + (|v| (CAR #12#))) + (SETQ #13# + (CONS + (CONS + (SPADCALL + (SPADCALL |u| + |vars| |degs| + (|getShellEntry| + $ 68)) + (|getShellEntry| + $ 175)) + |v|) + #13#))))) + (SETQ #11# (CDR #11#)) + (SETQ #12# (CDR #12#)))) + |POLYCAT-;conditionP;MU;27|)))))) + (SETQ #7# (CDR #7#)))) + (EXIT (LETT |monslist| + (CONS |redmons| |monslist|) + |POLYCAT-;conditionP;MU;27|)))))) + (SETQ #2# (CDR #2#)))) (LETT |ans| (SPADCALL (SPADCALL (SPADCALL |llR| (|getShellEntry| $ 111)) @@ -1009,60 +1003,63 @@ |POLYCAT-;charthRootlv|) (LETT |ans| (|spadConstant| $ 27) |POLYCAT-;charthRootlv|) - (SEQ G190 (COND ((NULL (> |d| 0)) (GO G191))) - (SEQ (LETT |dd| - (SPADCALL |d| |ch| - (|getShellEntry| $ 173)) - |POLYCAT-;charthRootlv|) - (EXIT (COND - ((EQL (CAR |dd|) 1) - (RETURN-FROM - |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - ('T - (SEQ - (LETT |cp| - (SPADCALL |p| |v| |d| - (|getShellEntry| $ 188)) - |POLYCAT-;charthRootlv|) - (LETT |p| - (SPADCALL |p| - (SPADCALL |cp| |v| |d| - (|getShellEntry| $ 47)) - (|getShellEntry| $ 189)) - |POLYCAT-;charthRootlv|) - (LETT |ansx| - (|POLYCAT-;charthRootlv| |cp| - |vars| |ch| $) - |POLYCAT-;charthRootlv|) - (EXIT - (COND - ((EQL (CAR |ansx|) 1) - (RETURN-FROM - |POLYCAT-;charthRootlv| - (CONS 1 "failed"))) - ('T - (SEQ - (LETT |d| - (SPADCALL |p| |v| - (|getShellEntry| $ 46)) - |POLYCAT-;charthRootlv|) - (EXIT - (LETT |ans| - (SPADCALL |ans| - (SPADCALL (CDR |ansx|) - |v| - (LET - ((#0=#:G1640 - (CDR |dd|))) - (|check-subtype| - (>= #0# 0) - '(|NonNegativeInteger|) - #0#)) - (|getShellEntry| $ 47)) - (|getShellEntry| $ 183)) - |POLYCAT-;charthRootlv|))))))))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (> |d| 0)) (RETURN NIL)) + (T (SEQ (LETT |dd| + (SPADCALL |d| |ch| + (|getShellEntry| $ 173)) + |POLYCAT-;charthRootlv|) + (EXIT (COND + ((EQL (CAR |dd|) 1) + (RETURN-FROM + |POLYCAT-;charthRootlv| + (CONS 1 "failed"))) + ('T + (SEQ + (LETT |cp| + (SPADCALL |p| |v| |d| + (|getShellEntry| $ 188)) + |POLYCAT-;charthRootlv|) + (LETT |p| + (SPADCALL |p| + (SPADCALL |cp| |v| |d| + (|getShellEntry| $ 47)) + (|getShellEntry| $ 189)) + |POLYCAT-;charthRootlv|) + (LETT |ansx| + (|POLYCAT-;charthRootlv| |cp| + |vars| |ch| $) + |POLYCAT-;charthRootlv|) + (EXIT + (COND + ((EQL (CAR |ansx|) 1) + (RETURN-FROM + |POLYCAT-;charthRootlv| + (CONS 1 "failed"))) + ('T + (SEQ + (LETT |d| + (SPADCALL |p| |v| + (|getShellEntry| $ 46)) + |POLYCAT-;charthRootlv|) + (EXIT + (LETT |ans| + (SPADCALL |ans| + (SPADCALL (CDR |ansx|) + |v| + (LET + ((#0=#:G1640 + (CDR |dd|))) + (|check-subtype| + (>= #0# 0) + '(|NonNegativeInteger|) + #0#)) + (|getShellEntry| $ + 47)) + (|getShellEntry| $ + 183)) + |POLYCAT-;charthRootlv|)))))))))))))) (LETT |ansx| (|POLYCAT-;charthRootlv| |p| |vars| |ch| $) |POLYCAT-;charthRootlv|) diff --git a/src/algebra/strap/QFCAT-.lsp b/src/algebra/strap/QFCAT-.lsp index 2a1f2d4d..de5cddb0 100644 --- a/src/algebra/strap/QFCAT-.lsp +++ b/src/algebra/strap/QFCAT-.lsp @@ -270,15 +270,14 @@ (DEFUN |QFCAT-;random;A;26| ($) (PROG (|d|) (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (SPADCALL - (LETT |d| - (SPADCALL (|getShellEntry| $ 97)) - |QFCAT-;random;A;26|) - (|getShellEntry| $ 98))) - (GO G191))) - (SEQ (EXIT |d|)) NIL (GO G190) G191 (EXIT NIL)) + (SEQ (LOOP + (COND + ((NOT (SPADCALL + (LETT |d| (SPADCALL (|getShellEntry| $ 97)) + |QFCAT-;random;A;26|) + (|getShellEntry| $ 98))) + (RETURN NIL)) + (T |d|))) (EXIT (SPADCALL (SPADCALL (|getShellEntry| $ 97)) |d| (|getShellEntry| $ 15))))))) diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 3323f313..7a847cd1 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -140,33 +140,34 @@ (PROG (|y|) (RETURN (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) - (GO G191))) - (SEQ (SPADCALL |l| - (SPADCALL - (SPADCALL |l| (|getShellEntry| $ 19)) |f|) - (|getShellEntry| $ 46)) - (EXIT (LETT |l| - (SPADCALL |l| (|getShellEntry| $ 13)) - |STAGG-;map!;M2A;9|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) + (RETURN NIL)) + (T (SEQ (SPADCALL |l| + (SPADCALL + (SPADCALL |l| (|getShellEntry| $ 19)) + |f|) + (|getShellEntry| $ 46)) + (EXIT (LETT |l| + (SPADCALL |l| + (|getShellEntry| $ 13)) + |STAGG-;map!;M2A;9|)))))) (EXIT |y|))))) (DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) (PROG (|y|) (RETURN (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) - (GO G191))) - (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) - (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 13)) - |STAGG-;fill!;ASA;10|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) + (RETURN NIL)) + (T (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) + (EXIT (LETT |y| + (SPADCALL |y| + (|getShellEntry| $ 13)) + |STAGG-;fill!;ASA;10|)))))) (EXIT |x|))))) (DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) @@ -224,22 +225,22 @@ #0#)) (|getShellEntry| $ 25)) |STAGG-;setelt;AUs2S;12|) - (SEQ G190 - (COND - ((NULL - (NOT - (SPADCALL |y| |z| - (|getShellEntry| $ 52)))) - (GO G191))) - (SEQ - (SPADCALL |y| |s| - (|getShellEntry| $ 46)) - (EXIT - (LETT |y| - (SPADCALL |y| - (|getShellEntry| $ 13)) - |STAGG-;setelt;AUs2S;12|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT + (NOT + (SPADCALL |y| |z| + (|getShellEntry| $ 52)))) + (RETURN NIL)) + (T + (SEQ + (SPADCALL |y| |s| + (|getShellEntry| $ 46)) + (EXIT + (LETT |y| + (SPADCALL |y| + (|getShellEntry| $ 13)) + |STAGG-;setelt;AUs2S;12|)))))) (EXIT |s|))))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp index aaa222da..e31d990e 100644 --- a/src/algebra/strap/SYMBOL.lsp +++ b/src/algebra/strap/SYMBOL.lsp @@ -215,15 +215,14 @@ (LIST (LENGTH (QVELT |sc| 3)) (LENGTH (QVELT |sc| 2)) (LENGTH (QVELT |sc| 1)) (LENGTH (QVELT |sc| 0))) |SYMBOL;syprefix|) - (SEQ G190 - (COND - ((NULL (COND - ((>= (LENGTH |ns|) 2) - (ZEROP (|SPADfirst| |ns|))) - ('T NIL))) - (GO G191))) - (SEQ (EXIT (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((>= (LENGTH |ns|) 2) + (ZEROP (|SPADfirst| |ns|))) + ('T NIL))) + (RETURN NIL)) + (T (LETT |ns| (CDR |ns|) |SYMBOL;syprefix|)))) (EXIT (SPADCALL (CONS (STRCONC (|getShellEntry| $ 38) (|SYMBOL;istring| @@ -321,20 +320,20 @@ (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "_{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND ((NULL (NOT (NULL |lo|))) (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (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|))))) @@ -342,20 +341,20 @@ (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "^{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND ((NULL (NOT (NULL |lo|))) (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (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|))))) @@ -363,20 +362,20 @@ (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "{}^{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND ((NULL (NOT (NULL |lo|))) (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (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|))))) @@ -384,20 +383,20 @@ (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "{}_{" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND ((NULL (NOT (NULL |lo|))) (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (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|))))) @@ -405,20 +404,20 @@ (COND ((NOT (NULL |lo|)) (SEQ (LETT |sc| "\\left( {" |SYMBOL;latex;$S;25|) - (SEQ G190 - (COND ((NULL (NOT (NULL |lo|))) (GO G191))) - (SEQ (LETT |sc| - (STRCONC |sc| - (SPADCALL (|SPADfirst| |lo|) - (|getShellEntry| $ 112))) - |SYMBOL;latex;$S;25|) - (LETT |lo| (CDR |lo|) - |SYMBOL;latex;$S;25|) - (EXIT (COND - ((NOT (NULL |lo|)) - (LETT |sc| (STRCONC |sc| ", ") - |SYMBOL;latex;$S;25|))))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (NULL |lo|))) (RETURN NIL)) + (T (SEQ (LETT |sc| + (STRCONC |sc| + (SPADCALL (|SPADfirst| |lo|) + (|getShellEntry| $ 112))) + |SYMBOL;latex;$S;25|) + (LETT |lo| (CDR |lo|) + |SYMBOL;latex;$S;25|) + (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|) @@ -429,24 +428,25 @@ (PROG (|qr| |ns|) (RETURN (SEQ (LETT |ns| "" |SYMBOL;anyRadix|) - (EXIT (SEQ G190 NIL - (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) - |SYMBOL;anyRadix|) - (LETT |n| (CAR |qr|) |SYMBOL;anyRadix|) - (LETT |ns| - (SPADCALL - (SPADCALL |s| - (+ (CDR |qr|) - (SPADCALL |s| - (|getShellEntry| $ 117))) - (|getShellEntry| $ 106)) - |ns| (|getShellEntry| $ 119)) - |SYMBOL;anyRadix|) - (EXIT (COND - ((ZEROP |n|) - (RETURN-FROM |SYMBOL;anyRadix| - |ns|))))) - NIL (GO G190) G191 (EXIT NIL))))))) + (EXIT (LOOP + (COND + (NIL (RETURN NIL)) + (T (SEQ (LETT |qr| (DIVIDE2 |n| (QCSIZE |s|)) + |SYMBOL;anyRadix|) + (LETT |n| (CAR |qr|) |SYMBOL;anyRadix|) + (LETT |ns| + (SPADCALL + (SPADCALL |s| + (+ (CDR |qr|) + (SPADCALL |s| + (|getShellEntry| $ 117))) + (|getShellEntry| $ 106)) + |ns| (|getShellEntry| $ 119)) + |SYMBOL;anyRadix|) + (EXIT (COND + ((ZEROP |n|) + (RETURN-FROM |SYMBOL;anyRadix| + |ns|))))))))))))) (DEFUN |SYMBOL;new;$;27| ($) (PROG (|sym|) @@ -512,27 +512,22 @@ (|SYMBOL;scripts;$R;32| |x| $) $)))))) (DEFUN |SYMBOL;resetNew;V;29| ($) - (PROG (|k| #0=#:G1550) - (RETURN - (SEQ (SPADCALL (|getShellEntry| $ 10) 0 (|getShellEntry| $ 121)) - (EXIT (SEQ (LETT |k| NIL |SYMBOL;resetNew;V;29|) - (LETT #0# - (SPADCALL (|getShellEntry| $ 13) - (|getShellEntry| $ 133)) - |SYMBOL;resetNew;V;29|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |k| (CAR #0#)) NIL)) - (GO G191))) - (SEQ (EXIT (SPADCALL |k| (|getShellEntry| $ 13) - (|getShellEntry| $ 134)))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL))))))) + (SEQ (SPADCALL (|getShellEntry| $ 10) 0 (|getShellEntry| $ 121)) + (EXIT (LET ((#0=#:G1550 + (SPADCALL (|getShellEntry| $ 13) + (|getShellEntry| $ 133)))) + (LOOP + (COND + ((ATOM #0#) (RETURN NIL)) + (T (LET ((|k| (CAR #0#))) + (SPADCALL |k| (|getShellEntry| $ 13) + (|getShellEntry| $ 134))))) + (SETQ #0# (CDR #0#))))))) (DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) (NOT (ATOM |sy|))) (DEFUN |SYMBOL;name;2$;31| (|sy| $) - (PROG (|str| |i| #0=#:G1551) + (PROG (|str|) (RETURN (SEQ (COND ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|) @@ -543,28 +538,28 @@ (|getShellEntry| $ 137)) $) |SYMBOL;name;2$;31|) - (SEQ (LETT |i| (+ (|getShellEntry| $ 41) 1) - |SYMBOL;name;2$;31|) - (LETT #0# (QCSIZE |str|) |SYMBOL;name;2$;31|) - G190 (COND ((> |i| #0#) (GO G191))) - (COND - ((NOT (SPADCALL - (SPADCALL |str| |i| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 139))) - (RETURN-FROM |SYMBOL;name;2$;31| - (|SYMBOL;coerce;S$;8| - (SPADCALL |str| - (SPADCALL |i| (QCSIZE |str|) - (|getShellEntry| $ 141)) - (|getShellEntry| $ 142)) - $)))) - (SETQ |i| (+ |i| 1)) (GO G190) G191 (EXIT NIL)) + (LET ((|i| (+ (|getShellEntry| $ 41) 1)) + (#0=#:G1551 (QCSIZE |str|))) + (LOOP + (COND + ((> |i| #0#) (RETURN NIL)) + (T (COND + ((NOT (SPADCALL + (SPADCALL |str| |i| + (|getShellEntry| $ 106)) + (|getShellEntry| $ 139))) + (RETURN-FROM |SYMBOL;name;2$;31| + (|SYMBOL;coerce;S$;8| + (SPADCALL |str| + (SPADCALL |i| (QCSIZE |str|) + (|getShellEntry| $ 141)) + (|getShellEntry| $ 142)) + $)))))) + (SETQ |i| (+ |i| 1)))) (EXIT (|error| "Improper scripted symbol"))))))))) (DEFUN |SYMBOL;scripts;$R;32| (|sy| $) - (PROG (|lscripts| |str| |nstr| |j| |nscripts| |m| |n| #0=#:G1552 |i| - |allscripts|) + (PROG (|lscripts| |str| |nstr| |nscripts| |allscripts| |m|) (RETURN (SEQ (COND ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) @@ -584,30 +579,28 @@ (LETT |m| (SPADCALL |nscripts| (|getShellEntry| $ 144)) |SYMBOL;scripts;$R;32|) - (SEQ (LETT |j| (+ (|getShellEntry| $ 41) 1) - |SYMBOL;scripts;$R;32|) - (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 - (COND - ((OR (> |j| |nstr|) - (NULL (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 139)))) - (GO G191))) - (SPADCALL |nscripts| |i| - (LET ((#1=#:G1542 - (- - (SPADCALL - (SPADCALL |str| |j| - (|getShellEntry| $ 106)) - (|getShellEntry| $ 44)) - (|getShellEntry| $ 45)))) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) #1#)) - (|getShellEntry| $ 148)) - (SETQ |i| - (PROG1 (+ |i| 1) (SETQ |j| (+ |j| 1)))) - (GO G190) G191 (EXIT NIL)) + (LET ((|i| |m|) (|j| (+ (|getShellEntry| $ 41) 1))) + (LOOP + (COND + ((OR (> |j| |nstr|) + (NOT (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 106)) + (|getShellEntry| $ 139)))) + (RETURN NIL)) + (T (SPADCALL |nscripts| |i| + (LET ((#0=#:G1542 + (- + (SPADCALL + (SPADCALL |str| |j| + (|getShellEntry| $ 106)) + (|getShellEntry| $ 44)) + (|getShellEntry| $ 45)))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 148)))) + (SETQ |i| (+ |i| 1)) + (SETQ |j| (+ |j| 1)))) (LETT |nscripts| (SPADCALL (CDR |nscripts|) (|SPADfirst| |nscripts|) @@ -619,43 +612,41 @@ (LETT |m| (SPADCALL |lscripts| (|getShellEntry| $ 153)) |SYMBOL;scripts;$R;32|) - (SEQ (LETT |n| NIL |SYMBOL;scripts;$R;32|) - (LETT #0# |nscripts| |SYMBOL;scripts;$R;32|) - (LETT |i| |m| |SYMBOL;scripts;$R;32|) G190 - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |n| (CAR #0#)) NIL)) - (GO G191))) - (COND - ((< (LENGTH |allscripts|) |n|) - (|error| "Improper script count in symbol")) - ('T - (SEQ (SPADCALL |lscripts| |i| - (LET - ((#2=#:G1554 - (SPADCALL |allscripts| |n| - (|getShellEntry| $ 156))) - (#3=#:G1553 NIL)) - (LOOP - (COND - ((ATOM #2#) - (RETURN (NREVERSE #3#))) - (T - (LET ((|a| (CAR #2#))) - (SETQ #3# - (CONS - (|SYMBOL;coerce;$Of;11| - |a| $) - #3#))))) - (SETQ #2# (CDR #2#)))) - (|getShellEntry| $ 157)) - (EXIT (LETT |allscripts| - (SPADCALL |allscripts| |n| - (|getShellEntry| $ 158)) - |SYMBOL;scripts;$R;32|))))) - (SETQ |i| - (PROG1 (+ |i| 1) (SETQ #0# (CDR #0#)))) - (GO G190) G191 (EXIT NIL)) + (LET ((|i| |m|) (#1=#:G1552 |nscripts|)) + (LOOP + (COND + ((ATOM #1#) (RETURN NIL)) + (T (LET ((|n| (CAR #1#))) + (COND + ((< (LENGTH |allscripts|) |n|) + (|error| "Improper script count in symbol")) + ('T + (SEQ (SPADCALL |lscripts| |i| + (LET + ((#2=#:G1554 + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 156))) + (#3=#:G1553 NIL)) + (LOOP + (COND + ((ATOM #2#) + (RETURN (NREVERSE #3#))) + (T + (LET ((|a| (CAR #2#))) + (SETQ #3# + (CONS + (|SYMBOL;coerce;$Of;11| + |a| $) + #3#))))) + (SETQ #2# (CDR #2#)))) + (|getShellEntry| $ 157)) + (EXIT + (LETT |allscripts| + (SPADCALL |allscripts| |n| + (|getShellEntry| $ 158)) + |SYMBOL;scripts;$R;32|)))))))) + (SETQ |i| (+ |i| 1)) + (SETQ #1# (CDR #1#)))) (EXIT (VECTOR (SPADCALL |lscripts| |m| (|getShellEntry| $ 159)) (SPADCALL |lscripts| (+ |m| 1) diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp index 68179ede..5729726e 100644 --- a/src/algebra/strap/URAGG-.lsp +++ b/src/algebra/strap/URAGG-.lsp @@ -141,15 +141,15 @@ (PROG (|l|) (RETURN (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) - (GO G191))) - (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) - (EXIT (LETT |x| - (SPADCALL |x| (|getShellEntry| $ 14)) - |URAGG-;nodes;AL;8|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) + (EXIT (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 14)) + |URAGG-;nodes;AL;8|)))))) (EXIT (NREVERSE |l|)))))) (DEFUN |URAGG-;children;AL;9| (|x| $) @@ -174,34 +174,34 @@ (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| 0) - (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (|getShellEntry| $ 14)) - |URAGG-;less?;ANniB;12|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;less?;ANniB;12|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((> |i| 0) + (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|)))))) (EXIT (> |i| 0)))))) (DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) - (SEQ G190 - (COND - ((NULL (COND - ((> |i| 0) - (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) - ('T NIL))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (|getShellEntry| $ 14)) - |URAGG-;more?;ANniB;13|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;more?;ANniB;13|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((> |i| 0) + (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|)))))) (EXIT (COND ((ZEROP |i|) (NOT (SPADCALL |l| (|getShellEntry| $ 20)))) @@ -211,16 +211,16 @@ (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |l| (|getShellEntry| $ 20)) NIL) - ('T (> |i| 0)))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (|getShellEntry| $ 14)) - |URAGG-;size?;ANniB;14|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;size?;ANniB;14|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (COND + ((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|)))))) (EXIT (COND ((SPADCALL |l| (|getShellEntry| $ 20)) (ZEROP |i|)) ('T NIL))))))) @@ -229,23 +229,22 @@ (PROG (|k|) (RETURN (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |x| (|getShellEntry| $ 20)))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (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|))) - NIL (GO G190) G191 (EXIT NIL)) + (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")))))) + (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;#;ANni;15|) + (EXIT (LETT |k| (+ |k| 1) |URAGG-;#;ANni;15|)))))) (EXIT |k|))))) (DEFUN |URAGG-;tail;2A;16| (|x| $) - (PROG (|k| |y|) + (PROG (|y|) (RETURN (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 20)) @@ -253,24 +252,25 @@ ('T (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;tail;2A;16|) - (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 - (COND - ((NULL (NOT (SPADCALL |y| - (|getShellEntry| $ 20)))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((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|))) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 - (EXIT NIL)) + (LET ((|k| 0)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| + (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |x| + (|getShellEntry| $ 48)) + (EXIT (|error| "cyclic list")))))) + (EXIT (LETT |y| + (SPADCALL + (LETT |x| |y| + |URAGG-;tail;2A;16|) + (|getShellEntry| $ 14)) + |URAGG-;tail;2A;16|))))) + (SETQ |k| (+ |k| 1)))) (EXIT |x|)))))))) (DEFUN |URAGG-;findCycle| (|x| $) @@ -278,27 +278,27 @@ (RETURN (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;findCycle|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 20)))) - (GO G191))) - (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|) - (COND - ((SPADCALL |y| (|getShellEntry| $ 20)) - (RETURN-FROM |URAGG-;findCycle| |y|))) - (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 54)) - (RETURN-FROM |URAGG-;findCycle| |y|))) - (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;findCycle|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 20)))) + (RETURN NIL)) + (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|) + (COND + ((SPADCALL |y| (|getShellEntry| $ 20)) + (RETURN-FROM |URAGG-;findCycle| |y|))) + (COND + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) + (RETURN-FROM |URAGG-;findCycle| |y|))) + (EXIT (LETT |y| + (SPADCALL |y| + (|getShellEntry| $ 14)) + |URAGG-;findCycle|)))))) (EXIT |y|))))) (DEFUN |URAGG-;cycleTail;2A;18| (|x| $) @@ -315,21 +315,20 @@ ('T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;cycleTail;2A;18|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |x| |z| - (|getShellEntry| $ 54)))) - (GO G191))) - (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) - (EXIT (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleTail;2A;18|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| |z| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) + (EXIT (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 14)) + |URAGG-;cycleTail;2A;18|)))))) (EXIT |y|)))))))) (DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) - (PROG (|z| |l| |k| |y|) + (PROG (|z| |l| |y|) (RETURN (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 20)) |x|) @@ -342,39 +341,39 @@ (SEQ (LETT |z| (SPADCALL |y| (|getShellEntry| $ 14)) |URAGG-;cycleEntry;2A;19|) (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |y| |z| - (|getShellEntry| $ 54)))) - (GO G191))) - (SEQ (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (EXIT (LETT |l| (+ |l| 1) - |URAGG-;cycleEntry;2A;19|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |y| |z| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|) + (EXIT (LETT |l| (+ |l| 1) + |URAGG-;cycleEntry;2A;19|)))))) (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) - (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 - (COND ((QSGREATERP |k| |l|) (GO G191))) - (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 - (EXIT NIL)) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |x| |y| - (|getShellEntry| $ 54)))) - (GO G191))) - (SEQ (LETT |x| - (SPADCALL |x| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|) - (EXIT (LETT |y| - (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;cycleEntry;2A;19|))) - NIL (GO G190) G191 (EXIT NIL)) + (LET ((|k| 1)) + (LOOP + (COND + ((> |k| |l|) (RETURN NIL)) + (T (LETT |y| + (SPADCALL |y| (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|))) + (SETQ |k| (+ |k| 1)))) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| |y| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (LETT |x| + (SPADCALL |x| + (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|) + (EXIT (LETT |y| + (SPADCALL |y| + (|getShellEntry| $ 14)) + |URAGG-;cycleEntry;2A;19|)))))) (EXIT |x|)))))))) (DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) @@ -391,35 +390,32 @@ (SEQ (LETT |y| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;cycleLength;ANni;20|) (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |x| |y| - (|getShellEntry| $ 54)))) - (GO G191))) - (SEQ (LETT |y| - (SPADCALL |y| - (|getShellEntry| $ 14)) - |URAGG-;cycleLength;ANni;20|) - (EXIT (LETT |k| (+ |k| 1) - |URAGG-;cycleLength;ANni;20|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |x| |y| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (LETT |y| + (SPADCALL |y| + (|getShellEntry| $ 14)) + |URAGG-;cycleLength;ANni;20|) + (EXIT (LETT |k| (+ |k| 1) + |URAGG-;cycleLength;ANni;20|)))))) (EXIT |k|)))))))) (DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 20)) - (|error| "Index out of range")) - ('T - (LETT |x| - (SPADCALL |x| - (|getShellEntry| $ 14)) - |URAGG-;rest;ANniA;21|))))) - (SETQ |i| (QSADD1 |i|)) (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) + (SEQ (LET ((|i| 1)) + (LOOP + (COND + ((> |i| |n|) (RETURN NIL)) + (T (COND + ((SPADCALL |x| (|getShellEntry| $ 20)) + (|error| "Index out of range")) + ('T + (LETT |x| (SPADCALL |x| (|getShellEntry| $ 14)) + |URAGG-;rest;ANniA;21|))))) + (SETQ |i| (+ |i| 1)))) + (EXIT |x|))) (DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) (PROG (|m|) @@ -438,23 +434,20 @@ (|getShellEntry| $ 63))))))))) (DEFUN |URAGG-;=;2AB;23| (|x| |y| $) - (PROG (|k|) - (RETURN - (SEQ (COND - ((SPADCALL |x| |y| (|getShellEntry| $ 54)) T) - ('T - (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 - (COND - ((NULL (COND - ((SPADCALL |x| - (|getShellEntry| $ 20)) - NIL) - ('T - (NOT - (SPADCALL |y| - (|getShellEntry| $ 20)))))) - (GO G191))) - (SEQ (COND + (SEQ (COND + ((SPADCALL |x| |y| (|getShellEntry| $ 54)) T) + ('T + (SEQ (LET ((|k| 0)) + (LOOP + (COND + ((NOT (COND + ((SPADCALL |x| (|getShellEntry| $ 20)) + NIL) + ('T + (NOT (SPADCALL |y| + (|getShellEntry| $ 20)))))) + (RETURN NIL)) + (T (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| @@ -479,38 +472,34 @@ (LETT |y| (SPADCALL |y| (|getShellEntry| $ 14)) - |URAGG-;=;2AB;23|))))))) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 - (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (|getShellEntry| $ 20)) - (SPADCALL |y| (|getShellEntry| $ 20))) - ('T NIL)))))))))) + |URAGG-;=;2AB;23|))))))))) + (SETQ |k| (+ |k| 1)))) + (EXIT (COND + ((SPADCALL |x| (|getShellEntry| $ 20)) + (SPADCALL |y| (|getShellEntry| $ 20))) + ('T NIL)))))))) (DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) - (PROG (|k|) - (RETURN - (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 - (COND - ((NULL (NOT (SPADCALL |v| (|getShellEntry| $ 20)))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |u| |v| (|getShellEntry| $ 68)) - (RETURN-FROM |URAGG-;node?;2AB;24| T)) - ('T - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |v| - (|getShellEntry| $ 48)) - (EXIT (|error| "cyclic list")))))) - (EXIT - (LETT |v| - (SPADCALL |v| - (|getShellEntry| $ 14)) - |URAGG-;node?;2AB;24|))))))) - (SETQ |k| (QSADD1 |k|)) (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 68))))))) + (SEQ (LET ((|k| 0)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |v| (|getShellEntry| $ 20)))) + (RETURN NIL)) + (T (COND + ((SPADCALL |u| |v| (|getShellEntry| $ 68)) + (RETURN-FROM |URAGG-;node?;2AB;24| T)) + ('T + (SEQ (COND + ((EQL |k| 1000) + (COND + ((SPADCALL |v| (|getShellEntry| $ 48)) + (EXIT (|error| "cyclic list")))))) + (EXIT (LETT |v| + (SPADCALL |v| + (|getShellEntry| $ 14)) + |URAGG-;node?;2AB;24|))))))) + (SETQ |k| (+ |k| 1)))) + (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 68))))) (DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) (SPADCALL |x| |a| (|getShellEntry| $ 70))) @@ -575,17 +564,17 @@ ('T (SEQ (LETT |z| (SPADCALL |x| (|getShellEntry| $ 14)) |URAGG-;cycleSplit!;2A;33|) - (SEQ G190 - (COND - ((NULL (NOT (SPADCALL |z| |y| - (|getShellEntry| $ 54)))) - (GO G191))) - (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) - (EXIT (LETT |z| - (SPADCALL |z| - (|getShellEntry| $ 14)) - |URAGG-;cycleSplit!;2A;33|))) - NIL (GO G190) G191 (EXIT NIL)) + (LOOP + (COND + ((NOT (NOT (SPADCALL |z| |y| + (|getShellEntry| $ 54)))) + (RETURN NIL)) + (T (SEQ (LETT |x| |z| + |URAGG-;cycleSplit!;2A;33|) + (EXIT (LETT |z| + (SPADCALL |z| + (|getShellEntry| $ 14)) + |URAGG-;cycleSplit!;2A;33|)))))) (SPADCALL |x| (SPADCALL (|getShellEntry| $ 84)) (|getShellEntry| $ 74)) (EXIT |y|)))))))) -- cgit v1.2.3