aboutsummaryrefslogtreecommitdiff
path: root/src/algebra
diff options
context:
space:
mode:
authordos-reis <gdr@axiomatics.org>2010-06-20 15:00:29 +0000
committerdos-reis <gdr@axiomatics.org>2010-06-20 15:00:29 +0000
commit9cde874de258533a18944602afa62c9e56ac991a (patch)
tree0ba1cbbf0a13d8d5085aa411304ff34ca63e7bb0 /src/algebra
parent4ee9e8c9ec410567f7904da3e3be59c06f059a6c (diff)
downloadopen-axiom-9cde874de258533a18944602afa62c9e56ac991a.tar.gz
* interp/compiler.boot (massageLoop): New.
(compRepeatOrCollect): Use it to generate appropriate %loop forms. Bind new special variable $mayHaveFreeIteratorVariables. (complainIfShadowing): Set it as appropriate.
Diffstat (limited to 'src/algebra')
-rw-r--r--src/algebra/strap/DFLOAT.lsp114
-rw-r--r--src/algebra/strap/EUCDOM-.lsp93
-rw-r--r--src/algebra/strap/FFIELDC-.lsp559
-rw-r--r--src/algebra/strap/ILIST.lsp241
-rw-r--r--src/algebra/strap/INS-.lsp55
-rw-r--r--src/algebra/strap/ISTRING.lsp554
-rw-r--r--src/algebra/strap/LIST.lsp85
-rw-r--r--src/algebra/strap/LSAGG-.lsp656
-rw-r--r--src/algebra/strap/OUTFORM.lsp29
-rw-r--r--src/algebra/strap/POLYCAT-.lsp635
-rw-r--r--src/algebra/strap/QFCAT-.lsp17
-rw-r--r--src/algebra/strap/STAGG-.lsp75
-rw-r--r--src/algebra/strap/SYMBOL.lsp379
-rw-r--r--src/algebra/strap/URAGG-.lsp433
14 files changed, 1938 insertions, 1987 deletions
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|))))))))
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-27 19:40:07 +0000