diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-06-22 17:20:38 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-06-22 17:20:38 +0000 |
| commit | b06599402ca23cce8ba7eea03886dc11a5d29af4 (patch) | |
| tree | 763ae52bb73dfb7f76feb7433b7853056acb9605 /src/algebra/strap/STAGG-.lsp | |
| parent | 48d55f8e89cdc22afbf661b823bf059d231b0db4 (diff) | |
| download | open-axiom-b06599402ca23cce8ba7eea03886dc11a5d29af4.tar.gz | |
Group sequence of LETT definitions into LET/LET* expressions where
appropriate.
* interp/g-opt.boot (jumpToToplevel?): New.
(singleAssignment?): Likewise.
(groupVariableDefinitions): Likewise. Use them.
(optimizeFunctionDef): Group toplevel variable definitions into
a bind expression.
* interp/g-util.boot (expandBind): Tidy.
* interp/c-util.boot (transformToBackendCode): Refrain from
enclosing let-expressions in SEQ if not needed.
Diffstat (limited to 'src/algebra/strap/STAGG-.lsp')
| -rw-r--r-- | src/algebra/strap/STAGG-.lsp | 206 |
1 files changed, 93 insertions, 113 deletions
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 2232262b..7bfb0d2d 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -86,40 +86,35 @@ (EXIT (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) - (PROG (|l| |h|) + (PROG (|h|) (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (|getShellEntry| $ 28)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ((NOT (SPADCALL |i| (|getShellEntry| $ 29))) - (SPADCALL - (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (|getShellEntry| $ 30))) - ('T - (SEQ (LETT |h| - (- (SPADCALL |i| (|getShellEntry| $ 31)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |h| |l|) - (SPADCALL (|getShellEntry| $ 32))) - ('T - (SPADCALL - (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (LET - ((#0=#:G1420 (+ (- |h| |l|) 1))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 35))))))))))))) + (LET ((|l| (- (SPADCALL |i| (|getShellEntry| $ 28)) + (SPADCALL |x| (|getShellEntry| $ 21))))) + (COND + ((< |l| 0) (|error| "index out of range")) + ((NOT (SPADCALL |i| (|getShellEntry| $ 29))) + (SPADCALL (SPADCALL |x| + (|check-subtype| (>= |l| 0) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (|getShellEntry| $ 30))) + ('T + (SEQ (LETT |h| + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21))) + |STAGG-;elt;AUsA;6|) + (EXIT (COND + ((< |h| |l|) (SPADCALL (|getShellEntry| $ 32))) + ('T + (SPADCALL + (SPADCALL |x| + (|check-subtype| (>= |l| 0) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 35)))))))))))) (DEFUN |STAGG-;concat;3A;7| (|x| |y| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) |y| @@ -134,36 +129,29 @@ (|getShellEntry| $ 37))))) (DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) - (RETURN NIL)) - (T (SEQ (SPADCALL |l| - (SPADCALL - (SPADCALL |l| (|getShellEntry| $ 19)) - |f|) - (|getShellEntry| $ 46)) - (EXIT (SETQ |l| - (SPADCALL |l| - (|getShellEntry| $ 13)))))))) - (EXIT |y|))))) + (LET ((|y| |l|)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) + (RETURN NIL)) + (T (SEQ (SPADCALL |l| + (SPADCALL + (SPADCALL |l| (|getShellEntry| $ 19)) |f|) + (|getShellEntry| $ 46)) + (EXIT (SETQ |l| + (SPADCALL |l| (|getShellEntry| $ 13)))))))) + (EXIT |y|)))) (DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) - (LOOP - (COND - ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) - (RETURN NIL)) - (T (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) - (EXIT (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 13)))))))) - (EXIT |x|))))) + (LET ((|y| |x|)) + (SEQ (LOOP + (COND + ((NOT (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) + (RETURN NIL)) + (T (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) + (EXIT (SETQ |y| + (SPADCALL |y| (|getShellEntry| $ 13)))))))) + (EXIT |x|)))) (DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))) @@ -180,60 +168,52 @@ (EXIT (SPADCALL |x| |s| (|getShellEntry| $ 46))))) (DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) - (PROG (|l| |h| |y| |z|) + (PROG (|h| |y| |z|) (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (|getShellEntry| $ 28)) - (SPADCALL |x| (|getShellEntry| $ 21))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (|getShellEntry| $ 29)) - (- (SPADCALL |i| - (|getShellEntry| $ 31)) - (SPADCALL |x| - (|getShellEntry| $ 21)))) - ('T - (SPADCALL |x| (|getShellEntry| $ 51)))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |h| |l|) |s|) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (|check-subtype| (>= |l| 0) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| + (LET ((|l| (- (SPADCALL |i| (|getShellEntry| $ 28)) + (SPADCALL |x| (|getShellEntry| $ 21))))) + (COND + ((< |l| 0) (|error| "index out of range")) + ('T + (SEQ (LETT |h| + (COND + ((SPADCALL |i| (|getShellEntry| $ 29)) + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21)))) + ('T (SPADCALL |x| (|getShellEntry| $ 51)))) + |STAGG-;setelt;AUs2S;12|) + (EXIT (COND + ((< |h| |l|) |s|) + ('T + (SEQ (LETT |y| + (SPADCALL |x| + (|check-subtype| (>= |l| 0) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LETT |z| + (SPADCALL |y| + (LET + ((#0=#:G1443 (+ (- |h| |l|) 1))) + (|check-subtype| (>= #0# 0) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LOOP + (COND + ((NOT + (NOT + (SPADCALL |y| |z| + (|getShellEntry| $ 52)))) + (RETURN NIL)) + (T (SEQ + (SPADCALL |y| |s| + (|getShellEntry| $ 46)) + (EXIT + (SETQ |y| (SPADCALL |y| - (LET - ((#0=#:G1443 - (+ (- |h| |l|) 1))) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) - #0#)) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LOOP - (COND - ((NOT - (NOT - (SPADCALL |y| |z| - (|getShellEntry| $ 52)))) - (RETURN NIL)) - (T - (SEQ - (SPADCALL |y| |s| - (|getShellEntry| $ 46)) - (EXIT - (SETQ |y| - (SPADCALL |y| - (|getShellEntry| $ 13)))))))) - (EXIT |s|))))))))))))) + (|getShellEntry| $ 13)))))))) + (EXIT |s|)))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) (SEQ (COND |