From 6fa5b85a7a68ad4422b98eb982a2a44998d6ee53 Mon Sep 17 00:00:00 2001 From: dos-reis Date: Tue, 20 Apr 2010 14:28:31 +0000 Subject: * interp/compiler.boot (joinIntegerModes): New. (compIntegerValue): Likewise. (compStepIterator): Likewise. (compIterate): Use it. --- src/algebra/strap/STAGG-.lsp | 187 +++++++++++++++++++++---------------------- 1 file changed, 93 insertions(+), 94 deletions(-) (limited to 'src/algebra/strap/STAGG-.lsp') diff --git a/src/algebra/strap/STAGG-.lsp b/src/algebra/strap/STAGG-.lsp index 4fabe92e..d58c703a 100644 --- a/src/algebra/strap/STAGG-.lsp +++ b/src/algebra/strap/STAGG-.lsp @@ -61,23 +61,23 @@ (CONS (|STAGG-;c2| |x| (LETT |x| (SPADCALL |x| - (|getShellEntry| $ 17)) + (|getShellEntry| $ 13)) |STAGG-;first;ANniA;3|) $) #0#) |STAGG-;first;ANniA;3|) (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (|getShellEntry| $ 19)))))) + (|getShellEntry| $ 15)))))) (DEFUN |STAGG-;c2| (|x| |r| $) (COND - ((SPADCALL |x| (|getShellEntry| $ 21)) + ((SPADCALL |x| (|getShellEntry| $ 18)) (|error| "Index out of range")) - ('T (SPADCALL |x| (|getShellEntry| $ 22))))) + ('T (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) - (SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 24))) + (SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))) |STAGG-;elt;AIS;5|) (COND ((OR (< |i| 0) @@ -87,62 +87,62 @@ (PROG1 |i| (|check-subtype| (>= |i| 0) '(|NonNegativeInteger|) |i|)) - (|getShellEntry| $ 28)) + (|getShellEntry| $ 25)) |STAGG-;elt;AIS;5|) - (|getShellEntry| $ 21))) + (|getShellEntry| $ 18))) (EXIT (|error| "index out of range")))) - (EXIT (SPADCALL |x| (|getShellEntry| $ 22))))) + (EXIT (SPADCALL |x| (|getShellEntry| $ 19))))) (DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) (PROG (|l| |h| #0=#:G1416) (RETURN (SEQ (LETT |l| - (- (SPADCALL |i| (|getShellEntry| $ 31)) - (SPADCALL |x| (|getShellEntry| $ 24))) + (- (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| $ 32))) + ((NOT (SPADCALL |i| (|getShellEntry| $ 29))) (SPADCALL (SPADCALL |x| (PROG1 |l| (|check-subtype| (>= |l| 0) '(|NonNegativeInteger|) |l|)) - (|getShellEntry| $ 28)) - (|getShellEntry| $ 33))) + (|getShellEntry| $ 25)) + (|getShellEntry| $ 30))) ('T (SEQ (LETT |h| - (- (SPADCALL |i| (|getShellEntry| $ 34)) - (SPADCALL |x| (|getShellEntry| $ 24))) + (- (SPADCALL |i| (|getShellEntry| $ 31)) + (SPADCALL |x| (|getShellEntry| $ 21))) |STAGG-;elt;AUsA;6|) (EXIT (COND ((< |h| |l|) - (SPADCALL (|getShellEntry| $ 35))) + (SPADCALL (|getShellEntry| $ 32))) ('T (SPADCALL (SPADCALL |x| (PROG1 |l| (|check-subtype| (>= |l| 0) '(|NonNegativeInteger|) |l|)) - (|getShellEntry| $ 28)) + (|getShellEntry| $ 25)) (PROG1 (LETT #0# (+ (- |h| |l|) 1) |STAGG-;elt;AUsA;6|) (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 37))))))))))))) + (|getShellEntry| $ 35))))))))))))) (DEFUN |STAGG-;concat;3A;7| (|x| |y| $) - (SPADCALL (SPADCALL |x| (|getShellEntry| $ 33)) |y| - (|getShellEntry| $ 39))) + (SPADCALL (SPADCALL |x| (|getShellEntry| $ 30)) |y| + (|getShellEntry| $ 37))) (DEFUN |STAGG-;concat;LA;8| (|l| $) (COND - ((NULL |l|) (SPADCALL (|getShellEntry| $ 35))) + ((NULL |l|) (SPADCALL (|getShellEntry| $ 32))) ('T - (SPADCALL (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 33)) - (SPADCALL (CDR |l|) (|getShellEntry| $ 46)) - (|getShellEntry| $ 39))))) + (SPADCALL (SPADCALL (|SPADfirst| |l|) (|getShellEntry| $ 30)) + (SPADCALL (CDR |l|) (|getShellEntry| $ 44)) + (|getShellEntry| $ 37))))) (DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) (PROG (|y|) @@ -150,14 +150,14 @@ (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) (SEQ G190 (COND - ((NULL (NOT (SPADCALL |l| (|getShellEntry| $ 21)))) + ((NULL (NOT (SPADCALL |l| (|getShellEntry| $ 18)))) (GO G191))) (SEQ (SPADCALL |l| (SPADCALL - (SPADCALL |l| (|getShellEntry| $ 22)) |f|) - (|getShellEntry| $ 48)) + (SPADCALL |l| (|getShellEntry| $ 19)) |f|) + (|getShellEntry| $ 46)) (EXIT (LETT |l| - (SPADCALL |l| (|getShellEntry| $ 17)) + (SPADCALL |l| (|getShellEntry| $ 13)) |STAGG-;map!;M2A;9|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))))) @@ -168,17 +168,17 @@ (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) (SEQ G190 (COND - ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 21)))) + ((NULL (NOT (SPADCALL |y| (|getShellEntry| $ 18)))) (GO G191))) - (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 48)) + (SEQ (SPADCALL |y| |s| (|getShellEntry| $ 46)) (EXIT (LETT |y| - (SPADCALL |y| (|getShellEntry| $ 17)) + (SPADCALL |y| (|getShellEntry| $ 13)) |STAGG-;fill!;ASA;10|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) (DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) - (SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 24))) + (SEQ (LETT |i| (- |i| (SPADCALL |x| (|getShellEntry| $ 21))) |STAGG-;setelt;AI2S;11|) (COND ((OR (< |i| 0) @@ -188,31 +188,31 @@ (PROG1 |i| (|check-subtype| (>= |i| 0) '(|NonNegativeInteger|) |i|)) - (|getShellEntry| $ 28)) + (|getShellEntry| $ 25)) |STAGG-;setelt;AI2S;11|) - (|getShellEntry| $ 21))) + (|getShellEntry| $ 18))) (EXIT (|error| "index out of range")))) - (EXIT (SPADCALL |x| |s| (|getShellEntry| $ 48))))) + (EXIT (SPADCALL |x| |s| (|getShellEntry| $ 46))))) (DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) (PROG (|l| |h| #0=#:G1436 |z| |y|) (RETURN (SEQ (LETT |l| - (- (SPADCALL |i| (|getShellEntry| $ 31)) - (SPADCALL |x| (|getShellEntry| $ 24))) + (- (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| $ 32)) + ((SPADCALL |i| (|getShellEntry| $ 29)) (- (SPADCALL |i| - (|getShellEntry| $ 34)) + (|getShellEntry| $ 31)) (SPADCALL |x| - (|getShellEntry| $ 24)))) + (|getShellEntry| $ 21)))) ('T - (SPADCALL |x| (|getShellEntry| $ 53)))) + (SPADCALL |x| (|getShellEntry| $ 51)))) |STAGG-;setelt;AUs2S;12|) (EXIT (COND ((< |h| |l|) |s|) @@ -223,7 +223,7 @@ (|check-subtype| (>= |l| 0) '(|NonNegativeInteger|) |l|)) - (|getShellEntry| $ 28)) + (|getShellEntry| $ 25)) |STAGG-;setelt;AUs2S;12|) (LETT |z| (SPADCALL |y| @@ -233,32 +233,32 @@ (|check-subtype| (>= #0# 0) '(|NonNegativeInteger|) #0#)) - (|getShellEntry| $ 28)) + (|getShellEntry| $ 25)) |STAGG-;setelt;AUs2S;12|) (SEQ G190 (COND ((NULL (NOT (SPADCALL |y| |z| - (|getShellEntry| $ 54)))) + (|getShellEntry| $ 52)))) (GO G191))) (SEQ (SPADCALL |y| |s| - (|getShellEntry| $ 48)) + (|getShellEntry| $ 46)) (EXIT (LETT |y| (SPADCALL |y| - (|getShellEntry| $ 17)) + (|getShellEntry| $ 13)) |STAGG-;setelt;AUs2S;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |s|))))))))))))) (DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) (SEQ (COND - ((SPADCALL |x| (|getShellEntry| $ 21)) |y|) + ((SPADCALL |x| (|getShellEntry| $ 18)) |y|) ('T - (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 56)) |y| - (|getShellEntry| $ 57)) + (SEQ (SPADCALL (SPADCALL |x| (|getShellEntry| $ 54)) |y| + (|getShellEntry| $ 55)) (EXIT |x|)))))) (DEFUN |StreamAggregate&| (|#1| |#2|) @@ -268,7 +268,7 @@ (LETT |dv$1| (|devaluate| |#1|) . #0=(|StreamAggregate&|)) (LETT |dv$2| (|devaluate| |#2|) . #0#) (LETT |dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (|newShell| 63) . #0#) + (LETT $ (|newShell| 61) . #0#) (|setShellEntry| $ 0 |dv$|) (|setShellEntry| $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) @@ -278,19 +278,19 @@ (COND ((|HasAttribute| |#1| '|shallowlyMutable|) (PROGN - (|setShellEntry| $ 40 + (|setShellEntry| $ 38 (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $)) - (|setShellEntry| $ 47 + (|setShellEntry| $ 45 (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $)) - (|setShellEntry| $ 50 + (|setShellEntry| $ 48 (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $)) - (|setShellEntry| $ 51 + (|setShellEntry| $ 49 (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $)) - (|setShellEntry| $ 52 + (|setShellEntry| $ 50 (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $)) - (|setShellEntry| $ 55 + (|setShellEntry| $ 53 (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $)) - (|setShellEntry| $ 58 + (|setShellEntry| $ 56 (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $))))) $)))) @@ -298,45 +298,44 @@ (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|Boolean|) (0 . |cyclic?|) (5 . |not|) |STAGG-;explicitlyFinite?;AB;1| - |STAGG-;possiblyInfinite?;AB;2| (|SingleInteger|) - (10 . |One|) (|NonNegativeInteger|) (14 . |One|) - (18 . |rest|) (|List| 7) (23 . |construct|) - |STAGG-;first;ANniA;3| (28 . |empty?|) (33 . |first|) - (|Integer|) (38 . |minIndex|) (43 . -) (49 . |Zero|) - (53 . <) (59 . |rest|) |STAGG-;elt;AIS;5| - (|UniversalSegment| 23) (65 . |lo|) (70 . |hasHi|) - (75 . |copy|) (80 . |hi|) (85 . |empty|) (89 . +) - (95 . |first|) |STAGG-;elt;AUsA;6| (101 . |concat!|) - (107 . |concat|) (|List| 6) (113 . |empty?|) - (118 . |first|) (123 . |rest|) (|List| $) (128 . |concat|) - (133 . |concat|) (138 . |setfirst!|) (|Mapping| 7 7) - (144 . |map!|) (150 . |fill!|) (156 . |setelt|) - (163 . |maxIndex|) (168 . |eq?|) (174 . |setelt|) - (181 . |tail|) (186 . |setrest!|) (192 . |concat!|) - '"rest" '"last" '"first" '"value") - '#(|setelt| 198 |possiblyInfinite?| 212 |map!| 217 |first| - 223 |fill!| 229 |explicitlyFinite?| 235 |elt| 240 - |concat!| 252 |concat| 258) + |STAGG-;possiblyInfinite?;AB;2| (10 . |rest|) (|List| 7) + (15 . |construct|) (|NonNegativeInteger|) + |STAGG-;first;ANniA;3| (20 . |empty?|) (25 . |first|) + (|Integer|) (30 . |minIndex|) (35 . -) (41 . |Zero|) + (45 . <) (51 . |rest|) |STAGG-;elt;AIS;5| + (|UniversalSegment| 20) (57 . |lo|) (62 . |hasHi|) + (67 . |copy|) (72 . |hi|) (77 . |empty|) (81 . |One|) + (85 . +) (91 . |first|) |STAGG-;elt;AUsA;6| + (97 . |concat!|) (103 . |concat|) (|List| 6) + (109 . |empty?|) (114 . |first|) (119 . |rest|) (|List| $) + (124 . |concat|) (129 . |concat|) (134 . |setfirst!|) + (|Mapping| 7 7) (140 . |map!|) (146 . |fill!|) + (152 . |setelt|) (159 . |maxIndex|) (164 . |eq?|) + (170 . |setelt|) (177 . |tail|) (182 . |setrest!|) + (188 . |concat!|) '"rest" '"last" '"first" '"value") + '#(|setelt| 194 |possiblyInfinite?| 208 |map!| 213 |first| + 219 |fill!| 225 |explicitlyFinite?| 231 |elt| 236 + |concat!| 248 |concat| 254) 'NIL (CONS (|makeByteWordVec2| 1 'NIL) (CONS '#() (CONS '#() - (|makeByteWordVec2| 58 - '(1 6 8 0 9 1 8 0 0 10 0 13 0 14 0 15 0 - 16 1 6 0 0 17 1 6 0 18 19 1 6 8 0 21 - 1 6 7 0 22 1 6 23 0 24 2 23 0 0 0 25 - 0 23 0 26 2 23 8 0 0 27 2 6 0 0 15 28 - 1 30 23 0 31 1 30 8 0 32 1 6 0 0 33 1 - 30 23 0 34 0 6 0 35 2 23 0 0 0 36 2 6 - 0 0 15 37 2 6 0 0 0 39 2 0 0 0 0 40 1 - 41 8 0 42 1 41 6 0 43 1 41 0 0 44 1 6 - 0 45 46 1 0 0 45 47 2 6 7 0 7 48 2 0 - 0 49 0 50 2 0 0 0 7 51 3 0 7 0 23 7 - 52 1 6 23 0 53 2 6 8 0 0 54 3 0 7 0 - 30 7 55 1 6 0 0 56 2 6 0 0 0 57 2 0 0 - 0 0 58 3 0 7 0 23 7 52 3 0 7 0 30 7 - 55 1 0 8 0 12 2 0 0 49 0 50 2 0 0 0 - 15 20 2 0 0 0 7 51 1 0 8 0 11 2 0 7 0 - 23 29 2 0 0 0 30 38 2 0 0 0 0 58 1 0 - 0 45 47 2 0 0 0 0 40))))) + (|makeByteWordVec2| 56 + '(1 6 8 0 9 1 8 0 0 10 1 6 0 0 13 1 6 0 + 14 15 1 6 8 0 18 1 6 7 0 19 1 6 20 0 + 21 2 20 0 0 0 22 0 20 0 23 2 20 8 0 0 + 24 2 6 0 0 16 25 1 27 20 0 28 1 27 8 + 0 29 1 6 0 0 30 1 27 20 0 31 0 6 0 32 + 0 16 0 33 2 20 0 0 0 34 2 6 0 0 16 35 + 2 6 0 0 0 37 2 0 0 0 0 38 1 39 8 0 40 + 1 39 6 0 41 1 39 0 0 42 1 6 0 43 44 1 + 0 0 43 45 2 6 7 0 7 46 2 0 0 47 0 48 + 2 0 0 0 7 49 3 0 7 0 20 7 50 1 6 20 0 + 51 2 6 8 0 0 52 3 0 7 0 27 7 53 1 6 0 + 0 54 2 6 0 0 0 55 2 0 0 0 0 56 3 0 7 + 0 20 7 50 3 0 7 0 27 7 53 1 0 8 0 12 + 2 0 0 47 0 48 2 0 0 0 16 17 2 0 0 0 7 + 49 1 0 8 0 11 2 0 7 0 20 26 2 0 0 0 + 27 36 2 0 0 0 0 56 1 0 0 43 45 2 0 0 + 0 0 38))))) '|lookupComplete|)) -- cgit v1.2.3