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/algebra/strap/FFIELDC-.lsp | |
| 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/algebra/strap/FFIELDC-.lsp')
| -rw-r--r-- | src/algebra/strap/FFIELDC-.lsp | 205 |
1 files changed, 96 insertions, 109 deletions
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))) |