diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-06-09 02:04:08 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-06-09 02:04:08 +0000 |
| commit | ddd0d01eed235ef965e622c982667eeb2eb528c8 (patch) | |
| tree | 934290623d267f317669a29ea0f7254b49c464b8 /src | |
| parent | 6aca99e6211a8fe97a8bb84d2bc85f9900f35315 (diff) | |
| download | open-axiom-ddd0d01eed235ef965e622c982667eeb2eb528c8.tar.gz | |
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.
Diffstat (limited to 'src')
| -rw-r--r-- | src/ChangeLog | 10 | ||||
| -rw-r--r-- | src/algebra/strap/DFLOAT.lsp | 360 | ||||
| -rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 205 | ||||
| -rw-r--r-- | src/algebra/strap/ILIST.lsp | 73 | ||||
| -rw-r--r-- | src/algebra/strap/INS-.lsp | 91 | ||||
| -rw-r--r-- | src/algebra/strap/ISTRING.lsp | 378 | ||||
| -rw-r--r-- | src/algebra/strap/LSAGG-.lsp | 153 | ||||
| -rw-r--r-- | src/algebra/strap/OUTFORM.lsp | 20 | ||||
| -rw-r--r-- | src/algebra/strap/POLYCAT-.lsp | 705 | ||||
| -rw-r--r-- | src/algebra/strap/SYMBOL.lsp | 123 | ||||
| -rw-r--r-- | src/algebra/strap/URAGG-.lsp | 212 | ||||
| -rw-r--r-- | src/interp/g-util.boot | 21 |
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 |