aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/ChangeLog10
-rw-r--r--src/algebra/strap/DFLOAT.lsp360
-rw-r--r--src/algebra/strap/FFIELDC-.lsp205
-rw-r--r--src/algebra/strap/ILIST.lsp73
-rw-r--r--src/algebra/strap/INS-.lsp91
-rw-r--r--src/algebra/strap/ISTRING.lsp378
-rw-r--r--src/algebra/strap/LSAGG-.lsp153
-rw-r--r--src/algebra/strap/OUTFORM.lsp20
-rw-r--r--src/algebra/strap/POLYCAT-.lsp705
-rw-r--r--src/algebra/strap/SYMBOL.lsp123
-rw-r--r--src/algebra/strap/URAGG-.lsp212
-rw-r--r--src/interp/g-util.boot21
12 files changed, 1054 insertions, 1297 deletions
diff --git a/src/ChangeLog b/src/ChangeLog
index 16f72544..3c00a3c7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,13 @@
+2010-06-08 Gabriel Dos Reis <gdr@cs.tamu.edu>
+
+ Widen scope of iterator variables in presence of terminating
+ predicate iterators. There is exactly one instance in the entire
+ OpenAxio library.
+ * interp/g-util.boot (expandIN): Take one more parameter to
+ determine early binding.
+ (expandIterators): Determine if wider scope is needed for iterator
+ variables.
+
2010-06-07 Gabriel Dos Reis <gdr@cs.tamu.edu>
* interp/compiler.boot (finishLambdaExpression): Bind escaped
diff --git a/src/algebra/strap/DFLOAT.lsp b/src/algebra/strap/DFLOAT.lsp
index 849d143a..a33c35b3 100644
--- a/src/algebra/strap/DFLOAT.lsp
+++ b/src/algebra/strap/DFLOAT.lsp
@@ -704,212 +704,178 @@
(FLOAT-SIGN 1.0 |x|))
(DEFUN |DFLOAT;manexp| (|x| $)
- (PROG (|s| #0=#:G1529 |me| |two53|)
+ (PROG (|s| |me| |two53|)
(RETURN
- (SEQ (EXIT (COND
- ((ZEROP |x|) (CONS 0 0))
- ('T
- (SEQ (LETT |s| (|DFLOAT;sign;$I;84| |x| $)
- |DFLOAT;manexp|)
- (LETT |x| (FLOAT-SIGN 1.0 |x|)
- |DFLOAT;manexp|)
- (COND
- ((> |x| |$DoubleFloatMaximum|)
- (PROGN
- (LETT #0#
- (CONS
- (+
- (* |s|
- (|DFLOAT;mantissa;$I;7|
- |$DoubleFloatMaximum| $))
- 1)
- (|DFLOAT;exponent;$I;8|
- |$DoubleFloatMaximum| $))
- |DFLOAT;manexp|)
- (GO #0#))))
- (LETT |me| (MANEXP |x|) |DFLOAT;manexp|)
- (LETT |two53|
- (EXPT (FLOAT-RADIX 0.0)
- (FLOAT-DIGITS 0.0))
- |DFLOAT;manexp|)
- (EXIT (CONS (* |s|
- (FIX (* |two53| (CAR |me|))))
- (- (CDR |me|) (FLOAT-DIGITS 0.0))))))))
- #0# (EXIT #0#)))))
+ (SEQ (COND
+ ((ZEROP |x|) (CONS 0 0))
+ ('T
+ (SEQ (LETT |s| (|DFLOAT;sign;$I;84| |x| $)
+ |DFLOAT;manexp|)
+ (LETT |x| (FLOAT-SIGN 1.0 |x|) |DFLOAT;manexp|)
+ (COND
+ ((> |x| |$DoubleFloatMaximum|)
+ (RETURN-FROM |DFLOAT;manexp|
+ (CONS (+ (* |s|
+ (|DFLOAT;mantissa;$I;7|
+ |$DoubleFloatMaximum| $))
+ 1)
+ (|DFLOAT;exponent;$I;8|
+ |$DoubleFloatMaximum| $)))))
+ (LETT |me| (MANEXP |x|) |DFLOAT;manexp|)
+ (LETT |two53|
+ (EXPT (FLOAT-RADIX 0.0) (FLOAT-DIGITS 0.0))
+ |DFLOAT;manexp|)
+ (EXIT (CONS (* |s| (FIX (* |two53| (CAR |me|))))
+ (- (CDR |me|) (FLOAT-DIGITS 0.0)))))))))))
(DEFUN |DFLOAT;rationalApproximation;$2NniF;87| (|f| |d| |b| $)
(PROG (|#G109| |nu| |ex| BASE |de| |tol| |#G110| |q| |r| |p2| |q2|
- #0=#:G1539 |#G111| |#G112| |p0| |p1| |#G113| |#G114|
- |q0| |q1| |#G115| |#G116| |s| |t|)
+ |#G111| |#G112| |p0| |p1| |#G113| |#G114| |q0| |q1|
+ |#G115| |#G116| |s| |t|)
(RETURN
- (SEQ (EXIT (SEQ (LETT |#G109| (|DFLOAT;manexp| |f| $)
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |nu| (CAR |#G109|)
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |ex| (CDR |#G109|)
- |DFLOAT;rationalApproximation;$2NniF;87|)
- |#G109|
- (LETT BASE (FLOAT-RADIX 0.0)
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (EXIT (COND
- ((>= |ex| 0)
- (SPADCALL
- (* |nu|
- (EXPT BASE
- (|check-subtype| (>= |ex| 0)
- '(|NonNegativeInteger|) |ex|)))
- (|getShellEntry| $ 135)))
- ('T
- (SEQ (LETT |de|
- (EXPT BASE
- (LET ((#1=#:G1540 (- |ex|)))
- (|check-subtype| (>= #1# 0)
- '(|NonNegativeInteger|) #1#)))
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (EXIT
- (COND
- ((< |b| 2)
- (|error| "base must be > 1"))
- ('T
- (SEQ
- (LETT |tol| (EXPT |b| |d|)
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |s| |nu|
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |t| |de|
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |p0| 0
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |p1| 1
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |q0| 1
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (LETT |q1| 0
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (EXIT
- (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|)
- (COND
- ((OR (EQL |r| 0)
- (<
- (SPADCALL |tol|
- (ABS
- (- (* |nu| |q2|)
- (* |de| |p2|)))
- (|getShellEntry| $
- 144))
- (* |de| (ABS |p2|))))
- (EXIT
- (PROGN
- (LETT #0#
- (SPADCALL |p2| |q2|
- (|getShellEntry| $
- 142))
- |DFLOAT;rationalApproximation;$2NniF;87|)
- (GO #0#)))))
- (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)))))))))))))
- #0# (EXIT #0#)))))
+ (SEQ (LETT |#G109| (|DFLOAT;manexp| |f| $)
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |nu| (CAR |#G109|)
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |ex| (CDR |#G109|)
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ |#G109|
+ (LETT BASE (FLOAT-RADIX 0.0)
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (EXIT (COND
+ ((>= |ex| 0)
+ (SPADCALL
+ (* |nu|
+ (EXPT BASE
+ (|check-subtype| (>= |ex| 0)
+ '(|NonNegativeInteger|) |ex|)))
+ (|getShellEntry| $ 135)))
+ ('T
+ (SEQ (LETT |de|
+ (EXPT BASE
+ (LET ((#0=#:G1540 (- |ex|)))
+ (|check-subtype| (>= #0# 0)
+ '(|NonNegativeInteger|) #0#)))
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (EXIT (COND
+ ((< |b| 2)
+ (|error| "base must be > 1"))
+ ('T
+ (SEQ (LETT |tol| (EXPT |b| |d|)
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |s| |nu|
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |t| |de|
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |p0| 0
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |p1| 1
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |q0| 1
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (LETT |q1| 0
+ |DFLOAT;rationalApproximation;$2NniF;87|)
+ (EXIT
+ (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|)
+ (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)))))))))))))))
(DEFUN |DFLOAT;**;$F$;88| (|x| |r| $)
- (PROG (|n| |d| #0=#:G1550)
+ (PROG (|n| |d|)
(RETURN
- (SEQ (EXIT (COND
- ((ZEROP |x|)
- (COND
- ((SPADCALL |r| (|getShellEntry| $ 146))
- (|error| "0**0 is undefined"))
- ((SPADCALL |r| (|getShellEntry| $ 147))
- (|error| "division by 0"))
- ('T 0.0)))
- ((OR (SPADCALL |r| (|getShellEntry| $ 146))
- (= |x| 1.0))
- 1.0)
- ('T
- (COND
- ((SPADCALL |r| (|getShellEntry| $ 148)) |x|)
- ('T
- (SEQ (LETT |n|
- (SPADCALL |r|
- (|getShellEntry| $ 149))
- |DFLOAT;**;$F$;88|)
- (LETT |d|
- (SPADCALL |r|
- (|getShellEntry| $ 150))
- |DFLOAT;**;$F$;88|)
- (EXIT (COND
- ((MINUSP |x|)
- (COND
- ((ODDP |d|)
- (COND
- ((ODDP |n|)
- (PROGN
- (LETT #0#
- (-
- (|DFLOAT;**;$F$;88|
- (- |x|) |r| $))
- |DFLOAT;**;$F$;88|)
- (GO #0#)))
- ('T
- (PROGN
- (LETT #0#
- (|DFLOAT;**;$F$;88|
- (- |x|) |r| $)
- |DFLOAT;**;$F$;88|)
- (GO #0#)))))
- ('T (|error| "negative root"))))
- ((EQL |d| 2)
- (EXPT (|DFLOAT;sqrt;2$;33| |x| $)
- |n|))
+ (SEQ (COND
+ ((ZEROP |x|)
+ (COND
+ ((SPADCALL |r| (|getShellEntry| $ 146))
+ (|error| "0**0 is undefined"))
+ ((SPADCALL |r| (|getShellEntry| $ 147))
+ (|error| "division by 0"))
+ ('T 0.0)))
+ ((OR (SPADCALL |r| (|getShellEntry| $ 146)) (= |x| 1.0))
+ 1.0)
+ ('T
+ (COND
+ ((SPADCALL |r| (|getShellEntry| $ 148)) |x|)
+ ('T
+ (SEQ (LETT |n| (SPADCALL |r| (|getShellEntry| $ 149))
+ |DFLOAT;**;$F$;88|)
+ (LETT |d| (SPADCALL |r| (|getShellEntry| $ 150))
+ |DFLOAT;**;$F$;88|)
+ (EXIT (COND
+ ((MINUSP |x|)
+ (COND
+ ((ODDP |d|)
+ (COND
+ ((ODDP |n|)
+ (RETURN-FROM |DFLOAT;**;$F$;88|
+ (-
+ (|DFLOAT;**;$F$;88| (- |x|) |r|
+ $))))
('T
- (|DFLOAT;**;3$;36| |x|
- (/
- (FLOAT |n|
- |$DoubleFloatMaximum|)
- (FLOAT |d|
- |$DoubleFloatMaximum|))
- $))))))))))
- #0# (EXIT #0#)))))
+ (RETURN-FROM |DFLOAT;**;$F$;88|
+ (|DFLOAT;**;$F$;88| (- |x|) |r|
+ $)))))
+ ('T (|error| "negative root"))))
+ ((EQL |d| 2)
+ (EXPT (|DFLOAT;sqrt;2$;33| |x| $) |n|))
+ ('T
+ (|DFLOAT;**;3$;36| |x|
+ (/ (FLOAT |n| |$DoubleFloatMaximum|)
+ (FLOAT |d| |$DoubleFloatMaximum|))
+ $)))))))))))))
(DEFUN |DoubleFloat| ()
(PROG (#0=#:G1562)
diff --git a/src/algebra/strap/FFIELDC-.lsp b/src/algebra/strap/FFIELDC-.lsp
index a9339d57..ca71780b 100644
--- a/src/algebra/strap/FFIELDC-.lsp
+++ b/src/algebra/strap/FFIELDC-.lsp
@@ -363,121 +363,108 @@
(DEFUN |FFIELDC-;discreteLog;2SU;12| (|logbase| |b| $)
(PROG (|groupord| |faclist| |f| #0=#:G1518 |fac| |primroot| |t|
- #1=#:G1519 |exp| |rhoHelp| #2=#:G1499 |rho| |disclog|
- |mult| |a|)
+ #1=#:G1519 |exp| |rhoHelp| |rho| |disclog| |mult| |a|)
(RETURN
- (SEQ (EXIT (COND
- ((SPADCALL |b| (|getShellEntry| $ 16))
- (SEQ (SPADCALL "discreteLog: logarithm of zero"
- (|getShellEntry| $ 83))
- (EXIT (CONS 1 "failed"))))
- ((SPADCALL |logbase| (|getShellEntry| $ 16))
- (SEQ (SPADCALL
- "discreteLog: logarithm to base zero"
- (|getShellEntry| $ 83))
- (EXIT (CONS 1 "failed"))))
- ((SPADCALL |b| |logbase| (|getShellEntry| $ 63))
- (CONS 0 1))
- ('T
- (COND
- ((NOT (ZEROP (REMAINDER2
- (LETT |groupord|
- (SPADCALL |logbase|
- (|getShellEntry| $ 19))
- |FFIELDC-;discreteLog;2SU;12|)
- (SPADCALL |b|
- (|getShellEntry| $ 19)))))
- (SEQ (SPADCALL
- "discreteLog: second argument not in cyclic group generated by first argument"
- (|getShellEntry| $ 83))
- (EXIT (CONS 1 "failed"))))
- ('T
- (SEQ (LETT |faclist|
- (SPADCALL
- (SPADCALL |groupord|
- (|getShellEntry| $ 87))
- (|getShellEntry| $ 89))
- |FFIELDC-;discreteLog;2SU;12|)
- (LETT |a| |b|
- |FFIELDC-;discreteLog;2SU;12|)
- (LETT |disclog| 0
- |FFIELDC-;discreteLog;2SU;12|)
- (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|
+ (SEQ (COND
+ ((SPADCALL |b| (|getShellEntry| $ 16))
+ (SEQ (SPADCALL "discreteLog: logarithm of zero"
+ (|getShellEntry| $ 83))
+ (EXIT (CONS 1 "failed"))))
+ ((SPADCALL |logbase| (|getShellEntry| $ 16))
+ (SEQ (SPADCALL "discreteLog: logarithm to base zero"
+ (|getShellEntry| $ 83))
+ (EXIT (CONS 1 "failed"))))
+ ((SPADCALL |b| |logbase| (|getShellEntry| $ 63))
+ (CONS 0 1))
+ ('T
+ (COND
+ ((NOT (ZEROP (REMAINDER2
+ (LETT |groupord|
(SPADCALL |logbase|
- (QUOTIENT2 |groupord| |fac|)
- (|getShellEntry| $ 58))
+ (|getShellEntry| $ 19))
|FFIELDC-;discreteLog;2SU;12|)
- (EXIT
+ (SPADCALL |b| (|getShellEntry| $ 19)))))
+ (SEQ (SPADCALL
+ "discreteLog: second argument not in cyclic group generated by first argument"
+ (|getShellEntry| $ 83))
+ (EXIT (CONS 1 "failed"))))
+ ('T
+ (SEQ (LETT |faclist|
+ (SPADCALL
+ (SPADCALL |groupord|
+ (|getShellEntry| $ 87))
+ (|getShellEntry| $ 89))
+ |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |a| |b| |FFIELDC-;discreteLog;2SU;12|)
+ (LETT |disclog| 0 |FFIELDC-;discreteLog;2SU;12|)
+ (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 |t| 0
+ (LETT |exp|
+ (QUOTIENT2 |exp| |fac|)
|FFIELDC-;discreteLog;2SU;12|)
- (LETT #1# (- (CDR |f|) 1)
+ (LETT |rhoHelp|
+ (SPADCALL |primroot|
+ (SPADCALL |a| |exp|
+ (|getShellEntry| $ 58))
+ |fac| (|getShellEntry| $ 91))
|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)
- (PROGN
- (LETT #2#
- (CONS 1 "failed")
- |FFIELDC-;discreteLog;2SU;12|)
- (GO #2#)))
- ('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))
- (EXIT (CONS 0 |disclog|))))))))
- #2# (EXIT #2#)))))
+ (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))
+ (EXIT (CONS 0 |disclog|)))))))))))
(DEFUN |FFIELDC-;squareFreePolynomial| (|f| $)
(SPADCALL |f| (|getShellEntry| $ 96)))
diff --git a/src/algebra/strap/ILIST.lsp b/src/algebra/strap/ILIST.lsp
index 53c404ad..07e52a12 100644
--- a/src/algebra/strap/ILIST.lsp
+++ b/src/algebra/strap/ILIST.lsp
@@ -256,35 +256,24 @@
(|getShellEntry| $ 45)))))))))))
(DEFUN |ILIST;=;2$B;22| (|x| |y| $)
- (PROG (#0=#:G1467)
- (RETURN
- (SEQ (EXIT (COND
- ((EQ |x| |y|) T)
- ('T
- (SEQ (SEQ G190
- (COND
- ((NULL (COND
- ((NULL |x|) NIL)
- ('T (NOT (NULL |y|)))))
- (GO G191)))
- (SEQ (EXIT
- (COND
- ((SPADCALL (CAR |x|) (CAR |y|)
- (|getShellEntry| $ 53))
- (PROGN
- (LETT #0# NIL
- |ILIST;=;2$B;22|)
- (GO #0#)))
- ('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))
- (EXIT (COND ((NULL |x|) (NULL |y|)) ('T NIL)))))))
- #0# (EXIT #0#)))))
+ (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))
+ (EXIT (COND ((NULL |x|) (NULL |y|)) ('T NIL))))))))
(DEFUN |ILIST;latex;$S;23| (|x| $)
(PROG (|s|)
@@ -305,23 +294,15 @@
(EXIT (STRCONC |s| " \\right]"))))))
(DEFUN |ILIST;member?;S$B;24| (|s| |x| $)
- (PROG (#0=#:G1475)
- (RETURN
- (SEQ (EXIT (SEQ (SEQ G190
- (COND ((NULL (NOT (NULL |x|))) (GO G191)))
- (SEQ (EXIT (COND
- ((SPADCALL |s| (CAR |x|)
- (|getShellEntry| $ 59))
- (PROGN
- (LETT #0# T
- |ILIST;member?;S$B;24|)
- (GO #0#)))
- ('T
- (LETT |x| (CDR |x|)
- |ILIST;member?;S$B;24|)))))
- NIL (GO G190) G191 (EXIT NIL))
- (EXIT NIL)))
- #0# (EXIT #0#)))))
+ (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))
+ (EXIT NIL)))
(DEFUN |ILIST;concat!;3$;25| (|x| |y| $)
(PROG (|z|)
diff --git a/src/algebra/strap/INS-.lsp b/src/algebra/strap/INS-.lsp
index 4fb5914a..9b1413c2 100644
--- a/src/algebra/strap/INS-.lsp
+++ b/src/algebra/strap/INS-.lsp
@@ -275,55 +275,50 @@
('T |c1|)))))))
(DEFUN |INS-;powmod;4S;29| (|x| |n| |p| $)
- (PROG (|y| #0=#:G1483 |z|)
+ (PROG (|y| |z|)
(RETURN
- (SEQ (EXIT (SEQ (COND
- ((SPADCALL |x| (|getShellEntry| $ 85))
- (LETT |x|
- (SPADCALL |x| |p|
- (|getShellEntry| $ 86))
- |INS-;powmod;4S;29|)))
- (EXIT (COND
- ((SPADCALL |x| (|getShellEntry| $ 66))
- (|spadConstant| $ 10))
- ((SPADCALL |n| (|getShellEntry| $ 66))
- (|spadConstant| $ 22))
- ('T
- (SEQ (LETT |y| (|spadConstant| $ 22)
- |INS-;powmod;4S;29|)
- (LETT |z| |x| |INS-;powmod;4S;29|)
- (EXIT
- (SEQ G190 NIL
- (SEQ
- (COND
- ((SPADCALL |n|
- (|getShellEntry| $ 13))
- (LETT |y|
- (SPADCALL |y| |z| |p|
- (|getShellEntry| $ 91))
- |INS-;powmod;4S;29|)))
- (EXIT
- (COND
- ((SPADCALL
- (LETT |n|
- (SPADCALL |n|
- (SPADCALL
- (|spadConstant| $ 22)
- (|getShellEntry| $ 19))
- (|getShellEntry| $ 20))
- |INS-;powmod;4S;29|)
- (|getShellEntry| $ 66))
- (PROGN
- (LETT #0# |y|
- |INS-;powmod;4S;29|)
- (GO #0#)))
- ('T
- (LETT |z|
- (SPADCALL |z| |z| |p|
- (|getShellEntry| $ 91))
- |INS-;powmod;4S;29|)))))
- NIL (GO G190) G191 (EXIT NIL)))))))))
- #0# (EXIT #0#)))))
+ (SEQ (COND
+ ((SPADCALL |x| (|getShellEntry| $ 85))
+ (LETT |x| (SPADCALL |x| |p| (|getShellEntry| $ 86))
+ |INS-;powmod;4S;29|)))
+ (EXIT (COND
+ ((SPADCALL |x| (|getShellEntry| $ 66))
+ (|spadConstant| $ 10))
+ ((SPADCALL |n| (|getShellEntry| $ 66))
+ (|spadConstant| $ 22))
+ ('T
+ (SEQ (LETT |y| (|spadConstant| $ 22)
+ |INS-;powmod;4S;29|)
+ (LETT |z| |x| |INS-;powmod;4S;29|)
+ (EXIT (SEQ G190 NIL
+ (SEQ
+ (COND
+ ((SPADCALL |n|
+ (|getShellEntry| $ 13))
+ (LETT |y|
+ (SPADCALL |y| |z| |p|
+ (|getShellEntry| $ 91))
+ |INS-;powmod;4S;29|)))
+ (EXIT
+ (COND
+ ((SPADCALL
+ (LETT |n|
+ (SPADCALL |n|
+ (SPADCALL
+ (|spadConstant| $ 22)
+ (|getShellEntry| $ 19))
+ (|getShellEntry| $ 20))
+ |INS-;powmod;4S;29|)
+ (|getShellEntry| $ 66))
+ (RETURN-FROM
+ |INS-;powmod;4S;29|
+ |y|))
+ ('T
+ (LETT |z|
+ (SPADCALL |z| |z| |p|
+ (|getShellEntry| $ 91))
+ |INS-;powmod;4S;29|)))))
+ NIL (GO G190) G191 (EXIT NIL)))))))))))
(DEFUN |IntegerNumberSystem&| (|#1|)
(LET* ((|dv$1| (|devaluate| |#1|))
diff --git a/src/algebra/strap/ISTRING.lsp b/src/algebra/strap/ISTRING.lsp
index 5ff74145..4cd0567f 100644
--- a/src/algebra/strap/ISTRING.lsp
+++ b/src/algebra/strap/ISTRING.lsp
@@ -239,54 +239,37 @@
(EXIT |c|))))))
(DEFUN |ISTRING;substring?;2$IB;17| (|part| |whole| |startpos| $)
- (PROG (|np| |nw| |iw| |ip| #0=#:G1535 #1=#:G1450 #2=#:G1446)
+ (PROG (|np| |nw| |iw| |ip| #0=#:G1535)
(RETURN
- (SEQ (EXIT (SEQ (LETT |np| (QCSIZE |part|)
- |ISTRING;substring?;2$IB;17|)
- (LETT |nw| (QCSIZE |whole|)
- |ISTRING;substring?;2$IB;17|)
- (LETT |startpos|
- (- |startpos| (|getShellEntry| $ 6))
- |ISTRING;substring?;2$IB;17|)
- (EXIT (COND
- ((< |startpos| 0)
- (|error| "index out of bounds"))
- ((> |np| (- |nw| |startpos|)) NIL)
- ('T
- (SEQ (SEQ
- (EXIT
- (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|)))
- (PROGN
- (LETT #2#
- (PROGN
- (LETT #1# NIL
- |ISTRING;substring?;2$IB;17|)
- (GO #1#))
- |ISTRING;substring?;2$IB;17|)
- (GO #2#))))))
- (SETQ |ip|
- (PROG1 (QSADD1 |ip|)
- (SETQ |iw| (+ |iw| 1))))
- (GO G190) G191 (EXIT NIL)))
- #2# (EXIT #2#))
- (EXIT T)))))))
- #1# (EXIT #1#)))))
+ (SEQ (LETT |np| (QCSIZE |part|) |ISTRING;substring?;2$IB;17|)
+ (LETT |nw| (QCSIZE |whole|) |ISTRING;substring?;2$IB;17|)
+ (LETT |startpos| (- |startpos| (|getShellEntry| $ 6))
+ |ISTRING;substring?;2$IB;17|)
+ (EXIT (COND
+ ((< |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))
+ (EXIT T)))))))))
(DEFUN |ISTRING;position;2$2I;18| (|s| |t| |startpos| $)
(PROG (|r|)
@@ -306,73 +289,55 @@
('T (+ |r| (|getShellEntry| $ 6)))))))))))))
(DEFUN |ISTRING;position;C$2I;19| (|c| |t| |startpos| $)
- (PROG (|r| #0=#:G1536 #1=#:G1460)
+ (PROG (|r| #0=#:G1536)
(RETURN
- (SEQ (EXIT (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|)
- (PROGN
- (LETT #1#
- (+ |r|
- (|getShellEntry| $ 6))
- |ISTRING;position;C$2I;19|)
- (GO #1#))))))
- (SETQ |r| (+ |r| 1)) (GO G190)
- G191 (EXIT NIL))
- (EXIT (- (|getShellEntry| $ 6) 1))))))))
- #1# (EXIT #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 (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))))))))))
(DEFUN |ISTRING;position;Cc$2I;20| (|cc| |t| |startpos| $)
- (PROG (|r| #0=#:G1537 #1=#:G1466)
+ (PROG (|r| #0=#:G1537)
(RETURN
- (SEQ (EXIT (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| $ 64))
- (PROGN
- (LETT #1#
- (+ |r|
- (|getShellEntry| $ 6))
- |ISTRING;position;Cc$2I;20|)
- (GO #1#))))))
- (SETQ |r| (+ |r| 1)) (GO G190)
- G191 (EXIT NIL))
- (EXIT (- (|getShellEntry| $ 6) 1))))))))
- #1# (EXIT #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 (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| $ 64))
+ (RETURN-FROM
+ |ISTRING;position;Cc$2I;20|
+ (+ |r| (|getShellEntry| $ 6)))))))
+ (SETQ |r| (+ |r| 1)) (GO G190) G191
+ (EXIT NIL))
+ (EXIT (- (|getShellEntry| $ 6) 1))))))))))
(DEFUN |ISTRING;suffix?;2$B;21| (|s| |t| $)
(PROG (|m| |n|)
@@ -670,115 +635,98 @@
(|stringMatch| |pattern| |target| (CHARACTER |wildcard|)))
(DEFUN |ISTRING;match?;2$CB;34| (|pattern| |target| |dontcare| $)
- (PROG (|m| |n| |s| #0=#:G1521 |i| |p| |q|)
+ (PROG (|m| |n| |s| |i| |p| |q|)
(RETURN
- (SEQ (EXIT (SEQ (LETT |n|
- (SPADCALL |pattern| (|getShellEntry| $ 47))
- |ISTRING;match?;2$CB;34|)
- (LETT |p|
- (LET ((#1=#:G1522
+ (SEQ (LETT |n| (SPADCALL |pattern| (|getShellEntry| $ 47))
+ |ISTRING;match?;2$CB;34|)
+ (LETT |p|
+ (LET ((#0=#:G1522
+ (|ISTRING;position;C$2I;19| |dontcare|
+ |pattern|
+ (LETT |m|
+ (|ISTRING;minIndex;$I;11|
+ |pattern| $)
+ |ISTRING;match?;2$CB;34|)
+ $)))
+ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|)
+ #0#))
+ |ISTRING;match?;2$CB;34|)
+ (EXIT (COND
+ ((EQL |p| (- |m| 1)) (EQUAL |pattern| |target|))
+ ('T
+ (SEQ (COND
+ ((SPADCALL |p| |m| (|getShellEntry| $ 88))
+ (COND
+ ((NOT (SPADCALL
+ (|ISTRING;elt;$Us$;31| |pattern|
+ (SPADCALL |m| (- |p| 1)
+ (|getShellEntry| $ 24))
+ $)
+ |target| (|getShellEntry| $ 89)))
+ (EXIT NIL)))))
+ (LETT |i| |p| |ISTRING;match?;2$CB;34|)
+ (LETT |q|
+ (LET ((#1=#:G1523
(|ISTRING;position;C$2I;19|
- |dontcare| |pattern|
- (LETT |m|
- (|ISTRING;minIndex;$I;11|
- |pattern| $)
- |ISTRING;match?;2$CB;34|)
+ |dontcare| |pattern| (+ |p| 1)
$)))
- (|check-subtype| (>= #1# 0)
- '(|NonNegativeInteger|) #1#))
- |ISTRING;match?;2$CB;34|)
- (EXIT (COND
- ((EQL |p| (- |m| 1))
- (EQUAL |pattern| |target|))
- ('T
- (SEQ (COND
- ((SPADCALL |p| |m|
- (|getShellEntry| $ 88))
- (COND
- ((NOT
- (SPADCALL
- (|ISTRING;elt;$Us$;31|
- |pattern|
- (SPADCALL |m| (- |p| 1)
- (|getShellEntry| $ 24))
- $)
- |target|
- (|getShellEntry| $ 89)))
- (EXIT NIL)))))
- (LETT |i| |p|
- |ISTRING;match?;2$CB;34|)
- (LETT |q|
- (LET
- ((#2=#:G1523
- (|ISTRING;position;C$2I;19|
- |dontcare| |pattern| (+ |p| 1)
- $)))
- (|check-subtype| (>= #2# 0)
- '(|NonNegativeInteger|) #2#))
- |ISTRING;match?;2$CB;34|)
- (SEQ G190
- (COND
- ((NULL
- (SPADCALL |q| (- |m| 1)
- (|getShellEntry| $ 88)))
- (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
- ((#3=#:G1524
- (|ISTRING;position;2$2I;18|
- |s| |target| |i| $)))
- (|check-subtype| (>= #3# 0)
- '(|NonNegativeInteger|) #3#))
- |ISTRING;match?;2$CB;34|)
- (EXIT
- (COND
- ((EQL |i| (- |m| 1))
- (PROGN
- (LETT #0# NIL
- |ISTRING;match?;2$CB;34|)
- (GO #0#)))
- ('T
- (SEQ
- (LETT |i|
- (+ |i| (QCSIZE |s|))
- |ISTRING;match?;2$CB;34|)
- (LETT |p| |q|
- |ISTRING;match?;2$CB;34|)
- (EXIT
- (LETT |q|
- (LET
- ((#4=#:G1525
- (|ISTRING;position;C$2I;19|
- |dontcare| |pattern|
- (+ |q| 1) $)))
- (|check-subtype|
- (>= #4# 0)
- '(|NonNegativeInteger|)
- #4#))
- |ISTRING;match?;2$CB;34|)))))))
- NIL (GO G190) G191 (EXIT NIL))
+ (|check-subtype| (>= #1# 0)
+ '(|NonNegativeInteger|) #1#))
+ |ISTRING;match?;2$CB;34|)
+ (SEQ G190
+ (COND
+ ((NULL (SPADCALL |q| (- |m| 1)
+ (|getShellEntry| $ 88)))
+ (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=#:G1524
+ (|ISTRING;position;2$2I;18| |s|
+ |target| |i| $)))
+ (|check-subtype| (>= #2# 0)
+ '(|NonNegativeInteger|) #2#))
+ |ISTRING;match?;2$CB;34|)
+ (EXIT
(COND
- ((SPADCALL |p| |n|
- (|getShellEntry| $ 88))
- (COND
- ((NOT
- (|ISTRING;suffix?;2$B;21|
- (|ISTRING;elt;$Us$;31|
- |pattern|
- (SPADCALL (+ |p| 1) |n|
- (|getShellEntry| $ 24))
- $)
- |target| $))
- (EXIT NIL)))))
- (EXIT T)))))))
- #0# (EXIT #0#)))))
+ ((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=#:G1525
+ (|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))
+ (COND
+ ((SPADCALL |p| |n| (|getShellEntry| $ 88))
+ (COND
+ ((NOT (|ISTRING;suffix?;2$B;21|
+ (|ISTRING;elt;$Us$;31| |pattern|
+ (SPADCALL (+ |p| 1) |n|
+ (|getShellEntry| $ 24))
+ $)
+ |target| $))
+ (EXIT NIL)))))
+ (EXIT T)))))))))
(DEFUN |IndexedString| (#0=#:G1542)
(PROG (#1=#:G1543)
diff --git a/src/algebra/strap/LSAGG-.lsp b/src/algebra/strap/LSAGG-.lsp
index f53a0661..d55706bc 100644
--- a/src/algebra/strap/LSAGG-.lsp
+++ b/src/algebra/strap/LSAGG-.lsp
@@ -481,43 +481,35 @@
(|getShellEntry| $ 23)))))))))))
(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $)
- (PROG (#0=#:G1516 |p|)
+ (PROG (|p|)
(RETURN
- (SEQ (EXIT (COND
- ((SPADCALL |l| (|getShellEntry| $ 16)) T)
- ('T
- (SEQ (LETT |p|
- (SPADCALL |l| (|getShellEntry| $ 17))
- |LSAGG-;sorted?;MAB;15|)
- (SEQ G190
- (COND
- ((NULL (NOT
- (SPADCALL |p|
- (|getShellEntry| $ 16))))
- (GO G191)))
- (SEQ (EXIT
- (COND
- ((NOT
- (SPADCALL
- (SPADCALL |l|
- (|getShellEntry| $ 18))
- (SPADCALL |p|
- (|getShellEntry| $ 18))
- |f|))
- (PROGN
- (LETT #0# NIL
- |LSAGG-;sorted?;MAB;15|)
- (GO #0#)))
- ('T
- (LETT |p|
- (SPADCALL
- (LETT |l| |p|
- |LSAGG-;sorted?;MAB;15|)
- (|getShellEntry| $ 17))
- |LSAGG-;sorted?;MAB;15|)))))
- NIL (GO G190) G191 (EXIT NIL))
- (EXIT T)))))
- #0# (EXIT #0#)))))
+ (SEQ (COND
+ ((SPADCALL |l| (|getShellEntry| $ 16)) T)
+ ('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))
+ (EXIT T))))))))
(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $)
(PROG (|r|)
@@ -765,63 +757,42 @@
(EXIT |l|)))))
(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$)
- (PROG ($)
- (SETQ $ (|getShellEntry| $$ 0))
- (RETURN
- (PROGN
- (SPADCALL |#1|
- (SPADCALL (|getShellEntry| $$ 1) (|getShellEntry| $ 18))
- (|getShellEntry| $ 74))))))
+ (LET (($ (|getShellEntry| $$ 0)))
+ (SPADCALL |#1|
+ (SPADCALL (|getShellEntry| $$ 1) (|getShellEntry| $ 18))
+ (|getShellEntry| $ 74))))
(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $)
- (PROG (#0=#:G1566)
- (RETURN
- (SEQ (EXIT (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| $ 63))
- (PROGN
- (LETT #0#
- (SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 18))
- (SPADCALL |y|
- (|getShellEntry| $ 18))
- (|getShellEntry| $ 77))
- |LSAGG-;<;2AB;25|)
- (GO #0#)))
- ('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))
- (EXIT (COND
- ((SPADCALL |x| (|getShellEntry| $ 16))
- (NOT (SPADCALL |y|
- (|getShellEntry| $ 16))))
- ('T NIL)))))
- #0# (EXIT #0#)))))
+ (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| $ 63))
+ (RETURN-FROM |LSAGG-;<;2AB;25|
+ (SPADCALL
+ (SPADCALL |x| (|getShellEntry| $ 18))
+ (SPADCALL |y| (|getShellEntry| $ 18))
+ (|getShellEntry| $ 77))))
+ ('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))
+ (EXIT (COND
+ ((SPADCALL |x| (|getShellEntry| $ 16))
+ (NOT (SPADCALL |y| (|getShellEntry| $ 16))))
+ ('T NIL)))))
(DEFUN |ListAggregate&| (|#1| |#2|)
(LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|))
diff --git a/src/algebra/strap/OUTFORM.lsp b/src/algebra/strap/OUTFORM.lsp
index 7fcd1a22..e9b6abc6 100644
--- a/src/algebra/strap/OUTFORM.lsp
+++ b/src/algebra/strap/OUTFORM.lsp
@@ -836,19 +836,15 @@
(DEFUN |OUTFORM;empty;$;73| ($) (LIST 'NOTHING))
(DEFUN |OUTFORM;infix?;$B;74| (|a| $)
- (PROG (#0=#:G1496 |e|)
+ (PROG (|e|)
(RETURN
- (SEQ (EXIT (SEQ (LETT |e|
- (COND
- ((IDENTP |a|) |a|)
- ((STRINGP |a|) (INTERN |a|))
- ('T
- (PROGN
- (LETT #0# NIL |OUTFORM;infix?;$B;74|)
- (GO #0#))))
- |OUTFORM;infix?;$B;74|)
- (EXIT (COND ((GET |e| 'INFIXOP) T) ('T NIL)))))
- #0# (EXIT #0#)))))
+ (SEQ (LETT |e|
+ (COND
+ ((IDENTP |a|) |a|)
+ ((STRINGP |a|) (INTERN |a|))
+ ('T (RETURN-FROM |OUTFORM;infix?;$B;74| NIL)))
+ |OUTFORM;infix?;$B;74|)
+ (EXIT (COND ((GET |e| 'INFIXOP) T) ('T NIL)))))))
(DEFUN |OUTFORM;elt;$L$;75| (|a| |l| $)
(DECLARE (IGNORE $))
diff --git a/src/algebra/strap/POLYCAT-.lsp b/src/algebra/strap/POLYCAT-.lsp
index e44c104e..a5482945 100644
--- a/src/algebra/strap/POLYCAT-.lsp
+++ b/src/algebra/strap/POLYCAT-.lsp
@@ -733,288 +733,257 @@
(DEFUN |POLYCAT-;conditionP;MU;27| (|mat| $)
(PROG (#0=#:G1610 #1=#:G1730 #2=#:G1731 #3=#:G1605 #4=#:G1603
- #5=#:G1604 |nd| #6=#:G1609 |ll| |ch| |l| #7=#:G1722 |u|
- #8=#:G1723 #9=#:G1583 #10=#:G1581 #11=#:G1582 |mons| |m|
- #12=#:G1724 |vars| |degs| |deg1| |redmons| |llR| |monslist|
- |ans| |i|)
+ #5=#:G1604 |nd| |ll| |ch| |l| #6=#:G1722 |u| #7=#:G1723
+ #8=#:G1583 #9=#:G1581 #10=#:G1582 |mons| |m| #11=#:G1724
+ |vars| |degs| |deg1| |redmons| |llR| |monslist| |ans| |i|)
(RETURN
- (SEQ (EXIT (SEQ (LETT |ll|
- (SPADCALL
- (SPADCALL |mat|
- (|getShellEntry| $ 166))
- (|getShellEntry| $ 114))
- |POLYCAT-;conditionP;MU;27|)
- (LETT |llR|
- (LET ((#13=#:G1721 (|SPADfirst| |ll|))
- (#14=#:G1720 NIL))
- (LOOP
- (COND
- ((ATOM #13#)
- (RETURN (NREVERSE #14#)))
- (T (LET ((|z| (CAR #13#)))
- (SETQ #14# (CONS NIL #14#)))))
- (SETQ #13# (CDR #13#))))
- |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 #7# |ll| |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #7#)
- (PROGN (SETQ |l| (CAR #7#)) NIL))
- (GO G191)))
- (SEQ (LETT |mons|
- (PROGN
- (LETT #11# NIL
- |POLYCAT-;conditionP;MU;27|)
- (SEQ
- (LETT |u| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #8# |l|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #8#)
- (PROGN
- (SETQ |u| (CAR #8#))
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (PROGN
+ (SEQ (LETT |ll|
+ (SPADCALL (SPADCALL |mat| (|getShellEntry| $ 166))
+ (|getShellEntry| $ 114))
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT |llR|
+ (LET ((#12=#:G1721 (|SPADfirst| |ll|))
+ (#13=#:G1720 NIL))
+ (LOOP
+ (COND
+ ((ATOM #12#) (RETURN (NREVERSE #13#)))
+ (T (LET ((|z| (CAR #12#)))
+ (SETQ #13# (CONS NIL #13#)))))
+ (SETQ #12# (CDR #12#))))
+ |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 #6# |ll| |POLYCAT-;conditionP;MU;27|) G190
+ (COND
+ ((OR (ATOM #6#) (PROGN (SETQ |l| (CAR #6#)) NIL))
+ (GO G191)))
+ (SEQ (LETT |mons|
+ (PROGN
+ (LETT #10# NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (SEQ (LETT |u| NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #7# |l|
+ |POLYCAT-;conditionP;MU;27|)
+ G190
+ (COND
+ ((OR (ATOM #7#)
+ (PROGN (SETQ |u| (CAR #7#)) NIL))
+ (GO G191)))
+ (SEQ (EXIT
+ (PROGN
+ (LETT #8#
+ (SPADCALL |u|
+ (|getShellEntry| $ 98))
+ |POLYCAT-;conditionP;MU;27|)
+ (COND
+ (#10#
(LETT #9#
- (SPADCALL |u|
- (|getShellEntry| $ 98))
- |POLYCAT-;conditionP;MU;27|)
- (COND
- (#11#
- (LETT #10#
- (SPADCALL #10# #9#
- (|getShellEntry| $
- 170))
- |POLYCAT-;conditionP;MU;27|))
- ('T
- (PROGN
- (LETT #10# #9#
- |POLYCAT-;conditionP;MU;27|)
- (LETT #11# 'T
- |POLYCAT-;conditionP;MU;27|)))))))
- (SETQ #8# (CDR #8#)) (GO G190)
- G191 (EXIT NIL))
- (COND
- (#11# #10#)
- ('T
- (|IdentityError|
- '|setUnion|))))
- |POLYCAT-;conditionP;MU;27|)
- (LETT |redmons| NIL
- |POLYCAT-;conditionP;MU;27|)
- (SEQ (LETT |m| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #12# |mons|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #12#)
- (PROGN
- (SETQ |m| (CAR #12#))
- 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
- ((#15=#:G1726 |degs|)
- (#16=#:G1725 NIL))
- (LOOP
- (COND
- ((ATOM #15#)
- (RETURN (NREVERSE #16#)))
- (T
- (LET ((|d| (CAR #15#)))
- (SETQ #16#
- (CONS
- (SEQ
- (LETT |nd|
- (SPADCALL |d| |ch|
- (|getShellEntry| $
- 173))
- |POLYCAT-;conditionP;MU;27|)
- (EXIT
- (COND
- ((EQL (CAR |nd|)
- 1)
- (PROGN
- (LETT #6#
- (CONS 1
- "failed")
- |POLYCAT-;conditionP;MU;27|)
- (GO #6#)))
- ('T
- (LET
- ((#17=#:G1612
- (CDR |nd|)))
- (|check-subtype|
- (>= #17# 0)
- '(|NonNegativeInteger|)
- #17#))))))
- #16#)))))
- (SETQ #15# (CDR #15#))))
- |POLYCAT-;conditionP;MU;27|)
- (LETT |redmons|
- (CONS
- (SPADCALL (|spadConstant| $ 43)
- |vars| |deg1|
- (|getShellEntry| $ 70))
- |redmons|)
- |POLYCAT-;conditionP;MU;27|)
- (EXIT
- (LETT |llR|
- (LET
- ((#18=#:G1728 |l|)
- (#19=#:G1729 |llR|)
- (#20=#:G1727 NIL))
- (LOOP
- (COND
- ((OR (ATOM #18#)
- (ATOM #19#))
- (RETURN
- (NREVERSE #20#)))
- (T
- (LET
- ((|u| (CAR #18#))
- (|v| (CAR #19#)))
- (SETQ #20#
- (CONS
- (CONS
- (SPADCALL
- (SPADCALL |u|
- |vars| |degs|
- (|getShellEntry|
- $ 68))
- (|getShellEntry| $
- 175))
- |v|)
- #20#)))))
- (SETQ #18# (CDR #18#))
- (SETQ #19# (CDR #19#))))
- |POLYCAT-;conditionP;MU;27|)))
- (SETQ #12# (CDR #12#)) (GO G190)
- G191 (EXIT NIL))
- (EXIT (LETT |monslist|
- (CONS |redmons| |monslist|)
- |POLYCAT-;conditionP;MU;27|)))
- (SETQ #7# (CDR #7#)) (GO G190) G191
- (EXIT NIL))
- (LETT |ans|
- (SPADCALL
- (SPADCALL
- (SPADCALL |llR|
- (|getShellEntry| $ 111))
- (|getShellEntry| $ 178))
- (|getShellEntry| $ 180))
- |POLYCAT-;conditionP;MU;27|)
- (EXIT (COND
- ((EQL (CAR |ans|) 1) (CONS 1 "failed"))
- ('T
- (SEQ (LETT |i| 0
+ (SPADCALL #9# #8#
+ (|getShellEntry| $ 170))
+ |POLYCAT-;conditionP;MU;27|))
+ ('T
+ (PROGN
+ (LETT #9# #8#
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #10# 'T
+ |POLYCAT-;conditionP;MU;27|)))))))
+ (SETQ #7# (CDR #7#)) (GO G190) G191
+ (EXIT NIL))
+ (COND
+ (#10# #9#)
+ ('T (|IdentityError| '|setUnion|))))
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT |redmons| NIL |POLYCAT-;conditionP;MU;27|)
+ (SEQ (LETT |m| NIL |POLYCAT-;conditionP;MU;27|)
+ (LETT #11# |mons|
+ |POLYCAT-;conditionP;MU;27|)
+ G190
+ (COND
+ ((OR (ATOM #11#)
+ (PROGN (SETQ |m| (CAR #11#)) NIL))
+ (GO G191)))
+ (SEQ (LETT |vars|
+ (SPADCALL |m|
+ (|getShellEntry| $ 40))
|POLYCAT-;conditionP;MU;27|)
- (EXIT
- (CONS 0
- (LET
- ((#21=#:G1611
- (|makeSimpleArray|
- (|getVMType|
- (|getShellEntry| $ 6))
- (SIZE |monslist|))))
- (SEQ
- (LETT #0# 0
- |POLYCAT-;conditionP;MU;27|)
- (LETT |mons| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #1# |monslist|
- |POLYCAT-;conditionP;MU;27|)
- G190
+ (LETT |degs|
+ (SPADCALL |m| |vars|
+ (|getShellEntry| $ 171))
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT |deg1|
+ (LET
+ ((#14=#:G1726 |degs|)
+ (#15=#:G1725 NIL))
+ (LOOP
(COND
- ((OR (ATOM #1#)
- (PROGN
- (SETQ |mons| (CAR #1#))
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (|setSimpleArrayEntry| #21#
- #0#
+ ((ATOM #14#)
+ (RETURN (NREVERSE #15#)))
+ (T
+ (LET ((|d| (CAR #14#)))
+ (SETQ #15#
+ (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
+ ((#16=#:G1612
+ (CDR |nd|)))
+ (|check-subtype|
+ (>= #16# 0)
+ '(|NonNegativeInteger|)
+ #16#))))))
+ #15#)))))
+ (SETQ #14# (CDR #14#))))
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT |redmons|
+ (CONS
+ (SPADCALL (|spadConstant| $ 43)
+ |vars| |deg1|
+ (|getShellEntry| $ 70))
+ |redmons|)
+ |POLYCAT-;conditionP;MU;27|)
+ (EXIT (LETT |llR|
+ (LET
+ ((#17=#:G1728 |l|)
+ (#18=#:G1729 |llR|)
+ (#19=#:G1727 NIL))
+ (LOOP
+ (COND
+ ((OR (ATOM #17#)
+ (ATOM #18#))
+ (RETURN (NREVERSE #19#)))
+ (T
+ (LET
+ ((|u| (CAR #17#))
+ (|v| (CAR #18#)))
+ (SETQ #19#
+ (CONS
+ (CONS
+ (SPADCALL
+ (SPADCALL |u| |vars|
+ |degs|
+ (|getShellEntry| $
+ 68))
+ (|getShellEntry| $
+ 175))
+ |v|)
+ #19#)))))
+ (SETQ #17# (CDR #17#))
+ (SETQ #18# (CDR #18#))))
+ |POLYCAT-;conditionP;MU;27|)))
+ (SETQ #11# (CDR #11#)) (GO G190) G191
+ (EXIT NIL))
+ (EXIT (LETT |monslist| (CONS |redmons| |monslist|)
+ |POLYCAT-;conditionP;MU;27|)))
+ (SETQ #6# (CDR #6#)) (GO G190) G191 (EXIT NIL))
+ (LETT |ans|
+ (SPADCALL
+ (SPADCALL (SPADCALL |llR| (|getShellEntry| $ 111))
+ (|getShellEntry| $ 178))
+ (|getShellEntry| $ 180))
+ |POLYCAT-;conditionP;MU;27|)
+ (EXIT (COND
+ ((EQL (CAR |ans|) 1) (CONS 1 "failed"))
+ ('T
+ (SEQ (LETT |i| 0 |POLYCAT-;conditionP;MU;27|)
+ (EXIT (CONS 0
+ (LET
+ ((#20=#:G1611
+ (|makeSimpleArray|
+ (|getVMType|
+ (|getShellEntry| $ 6))
+ (SIZE |monslist|))))
+ (SEQ
+ (LETT #0# 0
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT |mons| NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #1# |monslist|
+ |POLYCAT-;conditionP;MU;27|)
+ G190
+ (COND
+ ((OR (ATOM #1#)
(PROGN
- (LETT #5# NIL
+ (SETQ |mons| (CAR #1#))
+ NIL))
+ (GO G191)))
+ (SEQ
+ (EXIT
+ (|setSimpleArrayEntry| #20#
+ #0#
+ (PROGN
+ (LETT #5# NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (SEQ
+ (LETT |m| NIL
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #2# |mons|
|POLYCAT-;conditionP;MU;27|)
+ G190
+ (COND
+ ((OR (ATOM #2#)
+ (PROGN
+ (SETQ |m|
+ (CAR #2#))
+ NIL))
+ (GO G191)))
(SEQ
- (LETT |m| NIL
- |POLYCAT-;conditionP;MU;27|)
- (LETT #2# |mons|
- |POLYCAT-;conditionP;MU;27|)
- G190
- (COND
- ((OR (ATOM #2#)
- (PROGN
- (SETQ |m|
- (CAR #2#))
- NIL))
- (GO G191)))
- (SEQ
- (EXIT
- (PROGN
- (LETT #3#
- (SPADCALL |m|
+ (EXIT
+ (PROGN
+ (LETT #3#
+ (SPADCALL |m|
+ (SPADCALL
(SPADCALL
- (SPADCALL
- (CDR |ans|)
- (LETT |i|
- (+ |i| 1)
- |POLYCAT-;conditionP;MU;27|)
- (|getShellEntry|
- $ 181))
+ (CDR |ans|)
+ (LETT |i|
+ (+ |i| 1)
+ |POLYCAT-;conditionP;MU;27|)
(|getShellEntry|
- $ 51))
+ $ 181))
(|getShellEntry| $
- 182))
- |POLYCAT-;conditionP;MU;27|)
- (COND
- (#5#
- (LETT #4#
- (SPADCALL #4#
- #3#
- (|getShellEntry|
- $ 183))
- |POLYCAT-;conditionP;MU;27|))
- ('T
- (PROGN
- (LETT #4# #3#
- |POLYCAT-;conditionP;MU;27|)
- (LETT #5# 'T
- |POLYCAT-;conditionP;MU;27|)))))))
- (SETQ #2# (CDR #2#))
- (GO G190) G191
- (EXIT NIL))
- (COND
- (#5# #4#)
- ('T
- (|spadConstant| $ 27)))))))
- (SETQ #1#
- (PROG1 (CDR #1#)
- (SETQ #0# (QSADD1 #0#))))
- (GO G190) G191 (EXIT NIL))
- #21#)))))))))
- #6# (EXIT #6#)))))
+ 51))
+ (|getShellEntry| $
+ 182))
+ |POLYCAT-;conditionP;MU;27|)
+ (COND
+ (#5#
+ (LETT #4#
+ (SPADCALL #4# #3#
+ (|getShellEntry|
+ $ 183))
+ |POLYCAT-;conditionP;MU;27|))
+ ('T
+ (PROGN
+ (LETT #4# #3#
+ |POLYCAT-;conditionP;MU;27|)
+ (LETT #5# 'T
+ |POLYCAT-;conditionP;MU;27|)))))))
+ (SETQ #2# (CDR #2#))
+ (GO G190) G191
+ (EXIT NIL))
+ (COND
+ (#5# #4#)
+ ('T
+ (|spadConstant| $ 27)))))))
+ (SETQ #1#
+ (PROG1 (CDR #1#)
+ (SETQ #0# (QSADD1 #0#))))
+ (GO G190) G191 (EXIT NIL))
+ #20#)))))))))))
(DEFUN |POLYCAT-;charthRoot;SU;28| (|p| $)
(PROG (|vars| |ans| |ch|)
@@ -1043,111 +1012,95 @@
$))))))))))
(DEFUN |POLYCAT-;charthRootlv| (|p| |vars| |ch| $)
- (PROG (|v| |dd| |cp| |d| |ans| |ansx| #0=#:G1639)
+ (PROG (|v| |dd| |cp| |d| |ans| |ansx|)
(RETURN
- (SEQ (EXIT (COND
- ((NULL |vars|)
- (SEQ (LETT |ans|
- (SPADCALL
- (SPADCALL |p|
- (|getShellEntry| $ 175))
- (|getShellEntry| $ 185))
- |POLYCAT-;charthRootlv|)
- (EXIT (COND
- ((EQL (CAR |ans|) 1)
- (CONS 1 "failed"))
- ('T
- (CONS 0
- (SPADCALL (CDR |ans|)
- (|getShellEntry| $ 51))))))))
- ('T
- (SEQ (LETT |v| (|SPADfirst| |vars|)
- |POLYCAT-;charthRootlv|)
- (LETT |vars| (CDR |vars|)
- |POLYCAT-;charthRootlv|)
- (LETT |d|
- (SPADCALL |p| |v|
- (|getShellEntry| $ 46))
- |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)
- (PROGN
- (LETT #0# (CONS 1 "failed")
- |POLYCAT-;charthRootlv|)
- (GO #0#)))
- ('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)
- (PROGN
- (LETT #0#
- (CONS 1 "failed")
- |POLYCAT-;charthRootlv|)
- (GO #0#)))
- ('T
- (SEQ
- (LETT |d|
- (SPADCALL |p| |v|
- (|getShellEntry| $ 46))
- |POLYCAT-;charthRootlv|)
- (EXIT
- (LETT |ans|
- (SPADCALL |ans|
- (SPADCALL (CDR |ansx|)
- |v|
- (LET
- ((#1=#:G1640
- (CDR |dd|)))
- (|check-subtype|
- (>= #1# 0)
- '(|NonNegativeInteger|)
- #1#))
- (|getShellEntry| $ 47))
- (|getShellEntry| $ 183))
- |POLYCAT-;charthRootlv|)))))))))))
- NIL (GO G190) G191 (EXIT NIL))
- (LETT |ansx|
- (|POLYCAT-;charthRootlv| |p| |vars| |ch|
- $)
- |POLYCAT-;charthRootlv|)
- (EXIT (COND
- ((EQL (CAR |ansx|) 1)
- (PROGN
- (LETT #0# (CONS 1 "failed")
- |POLYCAT-;charthRootlv|)
- (GO #0#)))
- ('T
- (PROGN
- (LETT #0#
- (CONS 0
- (SPADCALL |ans| (CDR |ansx|)
- (|getShellEntry| $ 183)))
- |POLYCAT-;charthRootlv|)
- (GO #0#)))))))))
- #0# (EXIT #0#)))))
+ (SEQ (COND
+ ((NULL |vars|)
+ (SEQ (LETT |ans|
+ (SPADCALL
+ (SPADCALL |p| (|getShellEntry| $ 175))
+ (|getShellEntry| $ 185))
+ |POLYCAT-;charthRootlv|)
+ (EXIT (COND
+ ((EQL (CAR |ans|) 1) (CONS 1 "failed"))
+ ('T
+ (CONS 0
+ (SPADCALL (CDR |ans|)
+ (|getShellEntry| $ 51))))))))
+ ('T
+ (SEQ (LETT |v| (|SPADfirst| |vars|)
+ |POLYCAT-;charthRootlv|)
+ (LETT |vars| (CDR |vars|) |POLYCAT-;charthRootlv|)
+ (LETT |d| (SPADCALL |p| |v| (|getShellEntry| $ 46))
+ |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))
+ (LETT |ansx|
+ (|POLYCAT-;charthRootlv| |p| |vars| |ch| $)
+ |POLYCAT-;charthRootlv|)
+ (EXIT (COND
+ ((EQL (CAR |ansx|) 1)
+ (RETURN-FROM |POLYCAT-;charthRootlv|
+ (CONS 1 "failed")))
+ ('T
+ (RETURN-FROM |POLYCAT-;charthRootlv|
+ (CONS 0
+ (SPADCALL |ans| (CDR |ansx|)
+ (|getShellEntry| $ 183))))))))))))))
(DEFUN |POLYCAT-;monicDivide;2SVarSetR;30| (|p1| |p2| |mvar| $)
(PROG (|result|)
diff --git a/src/algebra/strap/SYMBOL.lsp b/src/algebra/strap/SYMBOL.lsp
index 9386c8f1..42f3b36e 100644
--- a/src/algebra/strap/SYMBOL.lsp
+++ b/src/algebra/strap/SYMBOL.lsp
@@ -426,33 +426,27 @@
(EXIT |s|)))))
(DEFUN |SYMBOL;anyRadix| (|n| |s| $)
- (PROG (|qr| |ns| #0=#:G1504)
+ (PROG (|qr| |ns|)
(RETURN
- (SEQ (EXIT (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|)
- (PROGN
- (LETT #0# |ns|
- |SYMBOL;anyRadix|)
- (GO #0#))))))
- NIL (GO G190) G191 (EXIT NIL)))))
- #0# (EXIT #0#)))))
+ (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)))))))
(DEFUN |SYMBOL;new;$;27| ($)
(PROG (|sym|)
@@ -538,56 +532,35 @@
(DEFUN |SYMBOL;scripted?;$B;30| (|sy| $) (NOT (ATOM |sy|)))
(DEFUN |SYMBOL;name;2$;31| (|sy| $)
- (PROG (|str| |i| #0=#:G1551 #1=#:G1531 #2=#:G1529)
+ (PROG (|str| |i| #0=#:G1551)
(RETURN
- (SEQ (EXIT (COND
- ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
- ('T
- (SEQ (LETT |str|
- (|SYMBOL;string;$S;24|
- (SPADCALL
- (|SYMBOL;list;$L;34| |sy| $)
- (|getShellEntry| $ 137))
- $)
- |SYMBOL;name;2$;31|)
- (SEQ (EXIT (SEQ
- (LETT |i|
- (+ (|getShellEntry| $ 41) 1)
- |SYMBOL;name;2$;31|)
- (LETT #0# (QCSIZE |str|)
- |SYMBOL;name;2$;31|)
- G190
- (COND ((> |i| #0#) (GO G191)))
- (SEQ
- (EXIT
- (COND
- ((NOT
- (SPADCALL
- (SPADCALL |str| |i|
- (|getShellEntry| $ 106))
- (|getShellEntry| $ 139)))
- (PROGN
- (LETT #2#
- (PROGN
- (LETT #1#
- (|SYMBOL;coerce;S$;8|
- (SPADCALL |str|
- (SPADCALL |i|
- (QCSIZE |str|)
- (|getShellEntry| $
- 141))
- (|getShellEntry| $
- 142))
- $)
- |SYMBOL;name;2$;31|)
- (GO #1#))
- |SYMBOL;name;2$;31|)
- (GO #2#))))))
- (SETQ |i| (+ |i| 1)) (GO G190)
- G191 (EXIT NIL)))
- #2# (EXIT #2#))
- (EXIT (|error| "Improper scripted symbol"))))))
- #1# (EXIT #1#)))))
+ (SEQ (COND
+ ((NOT (|SYMBOL;scripted?;$B;30| |sy| $)) |sy|)
+ ('T
+ (SEQ (LETT |str|
+ (|SYMBOL;string;$S;24|
+ (SPADCALL (|SYMBOL;list;$L;34| |sy| $)
+ (|getShellEntry| $ 137))
+ $)
+ |SYMBOL;name;2$;31|)
+ (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))
+ (EXIT (|error| "Improper scripted symbol")))))))))
(DEFUN |SYMBOL;scripts;$R;32| (|sy| $)
(PROG (|lscripts| |str| |nstr| |j| |nscripts| |m| |n| #0=#:G1552 |i|
diff --git a/src/algebra/strap/URAGG-.lsp b/src/algebra/strap/URAGG-.lsp
index 9cea2704..44f85770 100644
--- a/src/algebra/strap/URAGG-.lsp
+++ b/src/algebra/strap/URAGG-.lsp
@@ -273,49 +273,32 @@
(EXIT |x|))))))))
(DEFUN |URAGG-;findCycle| (|x| $)
- (PROG (#0=#:G1475 |y|)
+ (PROG (|y|)
(RETURN
- (SEQ (EXIT (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| $ 51))
- (PROGN
- (LETT #0# |x| |URAGG-;findCycle|)
- (GO #0#))))
- (LETT |x|
- (SPADCALL |x|
- (|getShellEntry| $ 14))
- |URAGG-;findCycle|)
- (LETT |y|
- (SPADCALL |y|
- (|getShellEntry| $ 14))
- |URAGG-;findCycle|)
- (COND
- ((SPADCALL |y|
- (|getShellEntry| $ 20))
- (PROGN
- (LETT #0# |y| |URAGG-;findCycle|)
- (GO #0#))))
- (COND
- ((SPADCALL |x| |y|
- (|getShellEntry| $ 51))
- (PROGN
- (LETT #0# |y| |URAGG-;findCycle|)
- (GO #0#))))
- (EXIT (LETT |y|
- (SPADCALL |y|
- (|getShellEntry| $ 14))
- |URAGG-;findCycle|)))
- NIL (GO G190) G191 (EXIT NIL))
- (EXIT |y|)))
- #0# (EXIT #0#)))))
+ (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| $ 51))
+ (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| $ 51))
+ (RETURN-FROM |URAGG-;findCycle| |y|)))
+ (EXIT (LETT |y|
+ (SPADCALL |y| (|getShellEntry| $ 14))
+ |URAGG-;findCycle|)))
+ NIL (GO G190) G191 (EXIT NIL))
+ (EXIT |y|)))))
(DEFUN |URAGG-;cycleTail;2A;18| (|x| $)
(PROG (|y| |z|)
@@ -446,94 +429,79 @@
(|getShellEntry| $ 60)))))))))
(DEFUN |URAGG-;=;2AB;23| (|x| |y| $)
- (PROG (|k| #0=#:G1508)
+ (PROG (|k|)
(RETURN
- (SEQ (EXIT (COND
- ((SPADCALL |x| |y| (|getShellEntry| $ 51)) 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
+ ((SPADCALL |x| |y| (|getShellEntry| $ 51)) 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
+ ((EQL |k| 1000)
+ (COND
+ ((SPADCALL |x|
+ (|getShellEntry| $ 48))
+ (EXIT (|error| "cyclic list"))))))
+ (EXIT (COND
+ ((SPADCALL
+ (SPADCALL |x|
+ (|getShellEntry| $ 8))
+ (SPADCALL |y|
+ (|getShellEntry| $ 8))
+ (|getShellEntry| $ 63))
+ (RETURN-FROM |URAGG-;=;2AB;23|
+ NIL))
+ ('T
+ (SEQ
+ (LETT |x|
+ (SPADCALL |x|
+ (|getShellEntry| $ 14))
+ |URAGG-;=;2AB;23|)
+ (EXIT
+ (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))))))))))
+
+(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| $ 65))
+ (RETURN-FROM |URAGG-;node?;2AB;24| T))
+ ('T
(SEQ (COND
((EQL |k| 1000)
(COND
- ((SPADCALL |x|
+ ((SPADCALL |v|
(|getShellEntry| $ 48))
(EXIT (|error| "cyclic list"))))))
(EXIT
- (COND
- ((SPADCALL
- (SPADCALL |x|
- (|getShellEntry| $ 8))
- (SPADCALL |y|
- (|getShellEntry| $ 8))
- (|getShellEntry| $ 63))
- (PROGN
- (LETT #0# NIL
- |URAGG-;=;2AB;23|)
- (GO #0#)))
- ('T
- (SEQ
- (LETT |x|
- (SPADCALL |x|
- (|getShellEntry| $ 14))
- |URAGG-;=;2AB;23|)
- (EXIT
- (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)))))))
- #0# (EXIT #0#)))))
-
-(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $)
- (PROG (|k| #0=#:G1513)
- (RETURN
- (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190
- (COND
- ((NULL (NOT
+ (LETT |v|
(SPADCALL |v|
- (|getShellEntry| $ 20))))
- (GO G191)))
- (SEQ (EXIT (COND
- ((SPADCALL |u| |v|
- (|getShellEntry| $ 65))
- (PROGN
- (LETT #0# T
- |URAGG-;node?;2AB;24|)
- (GO #0#)))
- ('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| $ 65)))))
- #0# (EXIT #0#)))))
+ (|getShellEntry| $ 14))
+ |URAGG-;node?;2AB;24|)))))))
+ (SETQ |k| (QSADD1 |k|)) (GO G190) G191 (EXIT NIL))
+ (EXIT (SPADCALL |u| |v| (|getShellEntry| $ 65)))))))
(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $)
(SPADCALL |x| |a| (|getShellEntry| $ 67)))
diff --git a/src/interp/g-util.boot b/src/interp/g-util.boot
index 0d786928..ac31d47e 100644
--- a/src/interp/g-util.boot
+++ b/src/interp/g-util.boot
@@ -108,11 +108,15 @@ mkVMForm(op,args) ==
--% 4. loop termination predicate
++ Generate code that sequentially visits each component of a list.
-expandIN(x,l) ==
+expandIN(x,l,early?) ==
g := gensym() -- rest of the list yet to be visited
+ early? => -- give the loop variable a wider scope.
+ [[[g,middleEndExpand l],[x,'NIL]],
+ nil,[['SETQ,g,['CDR,g]]],
+ nil,[['ATOM,g],['PROGN,['SETQ,x,['CAR,g]],'NIL]]]
[[[g,middleEndExpand l]],
- [[x,["CAR",g]]],[["SETQ",g,["CDR",g]]],
- nil,[["ATOM",g]]]
+ [[x,['CAR,g]]],[['SETQ,g,['CDR,g]]],
+ nil,[['ATOM,g]]]
expandON(x,l) ==
[[[x,middleEndExpand l]],nil,[["SETQ",x,["CDR",x]]],nil,[["ATOM",x]]]
@@ -165,10 +169,15 @@ expandInit(var,val) ==
[[[var,middleEndExpand val]],nil,nil,nil,nil]
expandIterators iters ==
- [toLisp it or leave "failed" for it in iters] where
- toLisp it ==
+ -- Exit predicates may reference iterator variables. In that case,
+ -- the scope the variables must cover the generated loop body. The
+ -- following is much more coarse approximation than we may want,
+ -- but it will do. For now.
+ early? := or/[ it.op in '(WHILE UNTIL) for it in iters]
+ [toLisp(it,early?) or leave "failed" for it in iters] where
+ toLisp(it,early?) ==
it is ["STEP",var,lo,inc,:hi] => expandSTEP(var,lo,inc,hi)
- it is ["IN",var,seq] => expandIN(var,seq)
+ it is ["IN",var,seq] => expandIN(var,seq,early?)
it is ["ON",var,seq] => expandON(var,seq)
it is ["WHILE",pred] => expandWHILE pred
it is [op,pred] and op in '(SUCHTHAT _|) => expandSUCHTHAT pred