diff options
| author | dos-reis <gdr@axiomatics.org> | 2010-07-25 00:12:57 +0000 |
|---|---|---|
| committer | dos-reis <gdr@axiomatics.org> | 2010-07-25 00:12:57 +0000 |
| commit | f5181e8acaf34cb5a26a30bd3901a19485933c6d (patch) | |
| tree | e30eb7600dbe651222f96e3d977e052285475227 /src/algebra/strap/STAGG-.lsp | |
| parent | c19e54f03e3230811e6c86998568ce63ccbc42c9 (diff) | |
| download | open-axiom-f5181e8acaf34cb5a26a30bd3901a19485933c6d.tar.gz | |
* interp/cattable.boot: Use %true for truth value in VM expressions.
* interp/clam.boot: Likewise.
* interp/define.boot: Likewise.
* interp/format.boot: Likewise.
* interp/functor.boot: Likewise.
* interp/g-opt.boot: Likewise.
* interp/mark.boot: Likewise.
* interp/pspad1.boot: Likewise.
* interp/pspad2.boot: Likewise.
* interp/slam.boot: Likewise.
* interp/wi1.boot: Likewise.
* interp/wi2.boot: Likewise.
* interp/sys-constants.boot: Remove $true and $false as unused.
Diffstat (limited to 'src/algebra/strap/STAGG-.lsp')
| -rw-r--r-- | src/algebra/strap/STAGG-.lsp | 133 |
1 files changed, 66 insertions, 67 deletions
diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index cdcf96d8..4a3fbda0 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -69,7 +69,7 @@ (COND ((SPADCALL |x| (|getShellEntry| $ 18)) (|error| "Index out of range")) - ('T (SPADCALL |x| (|getShellEntry| $ 19))))) + (T (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) (SEQ (SETQ |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21)))) @@ -99,23 +99,23 @@ '(|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| (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) - (|check-subtype| (NOT (MINUSP #0#)) - '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 35)))))))))))) + (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| + (NOT (MINUSP |l|)) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + (LET ((#0=#:G1420 (+ (- |h| |l|) 1))) + (|check-subtype| (NOT (MINUSP #0#)) + '(|NonNegativeInteger|) #0#)) + (|getShellEntry| $ 35)))))))))))) (DEFUN |STAGG-;concat;3A;7| (|x| |y| $) (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) |y| @@ -124,10 +124,9 @@ (DEFUN |STAGG-;concat;LA;8| (|l| $) (COND ((NULL |l|) (SPADCALL (|getShellEntry| $ 32))) - ('T - (SPADCALL (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 30)) - (SPADCALL (CDR |l|) (|getShellEntry| $ 44)) - (|getShellEntry| $ 37))))) + (T (SPADCALL (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 30)) + (SPADCALL (CDR |l|) (|getShellEntry| $ 44)) + (|getShellEntry| $ 37))))) (DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) (LET ((|y| |l|)) @@ -175,56 +174,56 @@ (SPADCALL |x| (|getShellEntry| $ 21))))) (COND ((MINUSP |l|) (|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| - (NOT (MINUSP |l|)) - '(|NonNegativeInteger|) |l|) - (|getShellEntry| $ 25)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| - (SPADCALL |y| - (LET - ((#0=#:G1443 (+ (- |h| |l|) 1))) - (|check-subtype| - (NOT (MINUSP #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| + (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| + (NOT (MINUSP |l|)) + '(|NonNegativeInteger|) |l|) + (|getShellEntry| $ 25)) + |STAGG-;setelt;AUs2S;12|) + (LETT |z| (SPADCALL |y| - (|getShellEntry| $ 13)))))))) - (EXIT |s|)))))))))))) + (LET + ((#0=#:G1443 + (+ (- |h| |l|) 1))) + (|check-subtype| + (NOT (MINUSP #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|)))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) (SEQ (COND ((SPADCALL |x| (|getShellEntry| $ 18)) |y|) - ('T - (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y| - (|getShellEntry| $ 55)) - (EXIT |x|)))))) + (T (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y| + (|getShellEntry| $ 55)) + (EXIT |x|)))))) (DEFUN |StreamAggregate&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) |