diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-06-09 16:00:43 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-06-09 16:00:43 +0000 |
| commit | 050ebc37a782f65ea7d305d32d79f1427057787f (patch) | |
| tree | d2227523738cb9819c4f694089209d9eb65b39ec /src/algebra/strap/UFD-.lsp | |
| parent | 4e8ea57821d8deaccd9ffb47ff7a4a7f505880c5 (diff) | |
| download | open-axiom-050ebc37a782f65ea7d305d32d79f1427057787f.tar.gz | |
* interp/compiler.boot (canReturn): Handle %when and %bind.
(compMatchAlternative): Generate %bind form.
(compMatch): Likewise.
(compReduce1): Rewrite.
(getIdentity): Tidy.
* interp/g-opt.boot (changeThrowToExit): HAndle %reduce.
(varIsAssigned): %store is side-effectful.
* interp/g-util.boot (expandReduce): New. Expand %reduce forms.
* interp/i-map.boot (getUserIdentifiersIn): Handle %reduce.
(findLocalVars1): Likewise.
* interp/i-spec1.boot (checkForFreeVariables): Likewise.
Diffstat (limited to 'src/algebra/strap/UFD-.lsp')
| -rw-r--r-- | src/algebra/strap/UFD-.lsp | 52 |
1 files changed, 22 insertions, 30 deletions
diff --git a/src/algebra/strap/UFD-.lsp b/src/algebra/strap/UFD-.lsp index 02114011..741e93a8 100644 --- a/src/algebra/strap/UFD-.lsp +++ b/src/algebra/strap/UFD-.lsp @@ -8,37 +8,29 @@ |UFD-;prime?;SB;2|)) (DEFUN |UFD-;squareFreePart;2S;1| (|x| $) - (PROG (|s| |f| #0=#:G1419 #1=#:G1406 #2=#:G1404 #3=#:G1405) + (PROG (|s|) (RETURN - (SEQ (SPADCALL - (SPADCALL - (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8)) - |UFD-;squareFreePart;2S;1|) - (|getShellEntry| $ 10)) - (PROGN - (LETT #3# NIL |UFD-;squareFreePart;2S;1|) - (SEQ (LETT |f| NIL |UFD-;squareFreePart;2S;1|) - (LETT #0# (SPADCALL |s| (|getShellEntry| $ 14)) - |UFD-;squareFreePart;2S;1|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN (SETQ |f| (CAR #0#)) NIL)) - (GO G191))) - (PROGN - (LETT #1# (CAR |f|) |UFD-;squareFreePart;2S;1|) - (COND - (#3# (LETT #2# - (SPADCALL #2# #1# - (|getShellEntry| $ 15)) - |UFD-;squareFreePart;2S;1|)) - ('T - (PROGN - (LETT #2# #1# |UFD-;squareFreePart;2S;1|) - (LETT #3# 'T |UFD-;squareFreePart;2S;1|))))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T (|spadConstant| $ 16)))) - (|getShellEntry| $ 15)))))) + (SPADCALL + (SPADCALL + (LETT |s| (SPADCALL |x| (|getShellEntry| $ 8)) + |UFD-;squareFreePart;2S;1|) + (|getShellEntry| $ 10)) + (LET ((#0=#:G1405 NIL) (#1=#:G1406 T) + (#2=#:G1419 (SPADCALL |s| (|getShellEntry| $ 14)))) + (LOOP + (COND + ((ATOM #2#) + (RETURN (COND (#1# (|spadConstant| $ 16)) (T #0#)))) + (T (LET ((|f| (CAR #2#))) + (LET ((#3=#:G1404 (CAR |f|))) + (COND + (#1# (SETQ #0# #3#)) + (T (SETQ #0# + (SPADCALL #0# #3# + (|getShellEntry| $ 15))))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#)))) + (|getShellEntry| $ 15))))) (DEFUN |UFD-;prime?;SB;2| (|x| $) (EQL (LENGTH (SPADCALL (SPADCALL |x| (|getShellEntry| $ 18)) |