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/CLAGG-.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/CLAGG-.lsp')
-rw-r--r-- | src/algebra/strap/CLAGG-.lsp | 201 |
1 files changed, 84 insertions, 117 deletions
diff --git a/src/algebra/strap/CLAGG-.lsp b/src/algebra/strap/CLAGG-.lsp index 6d50e7cb..eb404d15 100644 --- a/src/algebra/strap/CLAGG-.lsp +++ b/src/algebra/strap/CLAGG-.lsp @@ -45,123 +45,90 @@ (LENGTH (SPADCALL |c| (|getShellEntry| $ 9)))) (DEFUN |CLAGG-;count;MANni;2| (|f| |c| $) - (PROG (|x| #0=#:G1429 #1=#:G1403 #2=#:G1401 #3=#:G1402) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;count;MANni;2|) - (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|) - (LETT #0# (SPADCALL |c| (|getShellEntry| $ 9)) - |CLAGG-;count;MANni;2|) - G190 - (COND - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) - (GO G191))) - (COND - ((SPADCALL |x| |f|) - (PROGN - (LETT #1# 1 |CLAGG-;count;MANni;2|) - (COND - (#3# (LETT #2# (+ #2# #1#) - |CLAGG-;count;MANni;2|)) - ('T - (PROGN - (LETT #2# #1# |CLAGG-;count;MANni;2|) - (LETT #3# 'T |CLAGG-;count;MANni;2|))))))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T 0))))))) + (LET ((#0=#:G1402 NIL) (#1=#:G1403 T) + (#2=#:G1429 (SPADCALL |c| (|getShellEntry| $ 9)))) + (LOOP + (COND + ((ATOM #2#) (RETURN (COND (#1# 0) (T #0#)))) + (T (LET ((|x| (CAR #2#))) + (AND (SPADCALL |x| |f|) + (LET ((#3=#:G1401 1)) + (COND + (#1# (SETQ #0# #3#)) + (T (SETQ #0# (+ #0# #3#)))) + (SETQ #1# NIL)))))) + (SETQ #2# (CDR #2#))))) (DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $) - (PROG (|x| #0=#:G1430 #1=#:G1408 #2=#:G1406 #3=#:G1407) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;any?;MAB;3|) - (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) - (LETT #0# (SPADCALL |c| (|getShellEntry| $ 9)) - |CLAGG-;any?;MAB;3|) - G190 - (COND - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) - (GO G191))) - (PROGN - (LETT #1# (SPADCALL |x| |f|) |CLAGG-;any?;MAB;3|) - (COND - (#3# (LETT #2# (COND (#2# T) ('T #1#)) - |CLAGG-;any?;MAB;3|)) - ('T - (PROGN - (LETT #2# #1# |CLAGG-;any?;MAB;3|) - (LETT #3# 'T |CLAGG-;any?;MAB;3|))))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T NIL))))))) + (LET ((#0=#:G1407 NIL) (#1=#:G1408 T) + (#2=#:G1430 (SPADCALL |c| (|getShellEntry| $ 9)))) + (LOOP + (COND + ((ATOM #2#) (RETURN (COND (#1# NIL) (T #0#)))) + (T (LET ((|x| (CAR #2#))) + (LET ((#3=#:G1406 (SPADCALL |x| |f|))) + (COND (#1# (SETQ #0# #3#)) (T (SETQ #0# (OR #0# #3#)))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#))))) (DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $) - (PROG (|x| #0=#:G1431 #1=#:G1412 #2=#:G1410 #3=#:G1411) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;every?;MAB;4|) - (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) - (LETT #0# (SPADCALL |c| (|getShellEntry| $ 9)) - |CLAGG-;every?;MAB;4|) - G190 - (COND - ((OR (ATOM #0#) (PROGN (SETQ |x| (CAR #0#)) NIL)) - (GO G191))) - (PROGN - (LETT #1# (SPADCALL |x| |f|) |CLAGG-;every?;MAB;4|) - (COND - (#3# (LETT #2# (COND (#2# #1#) ('T NIL)) - |CLAGG-;every?;MAB;4|)) - ('T - (PROGN - (LETT #2# #1# |CLAGG-;every?;MAB;4|) - (LETT #3# 'T |CLAGG-;every?;MAB;4|))))) - (SETQ #0# (CDR #0#)) (GO G190) G191 (EXIT NIL)) - (COND (#3# #2#) ('T T))))))) + (LET ((#0=#:G1411 NIL) (#1=#:G1412 T) + (#2=#:G1431 (SPADCALL |c| (|getShellEntry| $ 9)))) + (LOOP + (COND + ((ATOM #2#) (RETURN (COND (#1# T) (T #0#)))) + (T (LET ((|x| (CAR #2#))) + (LET ((#3=#:G1410 (SPADCALL |x| |f|))) + (COND + (#1# (SETQ #0# #3#)) + (T (SETQ #0# (AND #0# #3#)))) + (SETQ #1# NIL))))) + (SETQ #2# (CDR #2#))))) (DEFUN |CLAGG-;find;MAU;5| (|f| |c| $) (SPADCALL |f| (SPADCALL |c| (|getShellEntry| $ 9)) - (|getShellEntry| $ 24))) + (|getShellEntry| $ 26))) (DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $) (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) - (|getShellEntry| $ 27))) + (|getShellEntry| $ 29))) (DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $) (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) |s| - (|getShellEntry| $ 29))) + (|getShellEntry| $ 31))) (DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $) (SPADCALL (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) - (|getShellEntry| $ 31)) - (|getShellEntry| $ 32))) + (|getShellEntry| $ 33)) + (|getShellEntry| $ 34))) (DEFUN |CLAGG-;select;M2A;9| (|f| |x| $) (SPADCALL (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) - (|getShellEntry| $ 34)) - (|getShellEntry| $ 32))) + (|getShellEntry| $ 36)) + (|getShellEntry| $ 34))) (DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $) (SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x| - (|getShellEntry| $ 37))) + (|getShellEntry| $ 39))) (DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$) (SPADCALL |#1| (|getShellEntry| $$ 1) - (|getShellEntry| (|getShellEntry| $$ 0) 36))) + (|getShellEntry| (|getShellEntry| $$ 0) 38))) (DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $) (SPADCALL |f| (SPADCALL |x| (|getShellEntry| $ 9)) |s1| |s2| - (|getShellEntry| $ 39))) + (|getShellEntry| $ 41))) (DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $) (SPADCALL (SPADCALL (SPADCALL |x| (|getShellEntry| $ 9)) - (|getShellEntry| $ 41)) - (|getShellEntry| $ 32))) + (|getShellEntry| $ 43)) + (|getShellEntry| $ 34))) (DEFUN |Collection&| (|#1| |#2|) (LET* ((|dv$1| (|devaluate| |#1|)) (|dv$2| (|devaluate| |#2|)) (|dv$| (LIST '|Collection&| |dv$1| |dv$2|)) - ($ (|newShell| 43)) + ($ (|newShell| 45)) (|pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#2| (LIST '|ConvertibleTo| '(|InputForm|))) @@ -181,26 +148,26 @@ (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $)) (|setShellEntry| $ 21 (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $)) - (|setShellEntry| $ 22 + (|setShellEntry| $ 24 (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $)) - (|setShellEntry| $ 25 + (|setShellEntry| $ 27 (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $)) - (|setShellEntry| $ 28 - (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) (|setShellEntry| $ 30 + (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) + (|setShellEntry| $ 32 (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $)) - (|setShellEntry| $ 33 - (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) (|setShellEntry| $ 35 + (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) + (|setShellEntry| $ 37 (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $)) (COND ((|testBitVector| |pv$| 2) (PROGN - (|setShellEntry| $ 38 - (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) $)) (|setShellEntry| $ 40 - (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) $)) + (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) $)) (|setShellEntry| $ 42 + (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) $)) + (|setShellEntry| $ 44 (CONS (|dispatchFunction| |CLAGG-;removeDuplicates;2A;12|) $)))))))) @@ -210,37 +177,37 @@ (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) (10 . |#|) (15 . |One|) (19 . +) (25 . |Zero|) (|Boolean|) - (|Mapping| 16 7) (29 . |count|) (35 . |true|) - (39 . |false|) (43 . |any?|) (49 . |every?|) - (|Union| 7 '"failed") (55 . |find|) (61 . |find|) - (|Mapping| 7 7 7) (67 . |reduce|) (73 . |reduce|) - (79 . |reduce|) (86 . |reduce|) (93 . |remove|) - (99 . |construct|) (104 . |remove|) (110 . |select|) - (116 . |select|) (122 . =) (128 . |remove|) - (134 . |remove|) (140 . |reduce|) (148 . |reduce|) - (156 . |removeDuplicates|) (161 . |removeDuplicates|)) - '#(|select| 166 |removeDuplicates| 172 |remove| 177 |reduce| - 189 |find| 210 |every?| 216 |count| 222 |any?| 228 |#| - 234) + (|Mapping| 16 7) (29 . |count|) (35 . |or|) (41 . |false|) + (45 . |any?|) (51 . |and|) (57 . |true|) (61 . |every?|) + (|Union| 7 '"failed") (67 . |find|) (73 . |find|) + (|Mapping| 7 7 7) (79 . |reduce|) (85 . |reduce|) + (91 . |reduce|) (98 . |reduce|) (105 . |remove|) + (111 . |construct|) (116 . |remove|) (122 . |select|) + (128 . |select|) (134 . =) (140 . |remove|) + (146 . |remove|) (152 . |reduce|) (160 . |reduce|) + (168 . |removeDuplicates|) (173 . |removeDuplicates|)) + '#(|select| 178 |removeDuplicates| 184 |remove| 189 |reduce| + 201 |find| 222 |every?| 228 |count| 234 |any?| 240 |#| + 246) 'NIL (CONS (|makeByteWordVec2| 1 'NIL) (CONS '#() (CONS '#() - (|makeByteWordVec2| 42 + (|makeByteWordVec2| 44 '(1 6 8 0 9 1 8 10 0 11 1 0 10 0 12 0 10 0 13 2 10 0 0 0 14 0 10 0 15 2 0 - 10 17 0 18 0 16 0 19 0 16 0 20 2 0 16 - 17 0 21 2 0 16 17 0 22 2 8 23 17 0 24 - 2 0 23 17 0 25 2 8 7 26 0 27 2 0 7 26 - 0 28 3 8 7 26 0 7 29 3 0 7 26 0 7 30 - 2 8 0 17 0 31 1 6 0 8 32 2 0 0 17 0 - 33 2 8 0 17 0 34 2 0 0 17 0 35 2 7 16 - 0 0 36 2 6 0 17 0 37 2 0 0 7 0 38 4 8 - 7 26 0 7 7 39 4 0 7 26 0 7 7 40 1 8 0 - 0 41 1 0 0 0 42 2 0 0 17 0 35 1 0 0 0 - 42 2 0 0 7 0 38 2 0 0 17 0 33 4 0 7 - 26 0 7 7 40 3 0 7 26 0 7 30 2 0 7 26 - 0 28 2 0 23 17 0 25 2 0 16 17 0 22 2 - 0 10 17 0 18 2 0 16 17 0 21 1 0 10 0 - 12))))) + 10 17 0 18 2 16 0 0 0 19 0 16 0 20 2 + 0 16 17 0 21 2 16 0 0 0 22 0 16 0 23 + 2 0 16 17 0 24 2 8 25 17 0 26 2 0 25 + 17 0 27 2 8 7 28 0 29 2 0 7 28 0 30 3 + 8 7 28 0 7 31 3 0 7 28 0 7 32 2 8 0 + 17 0 33 1 6 0 8 34 2 0 0 17 0 35 2 8 + 0 17 0 36 2 0 0 17 0 37 2 7 16 0 0 38 + 2 6 0 17 0 39 2 0 0 7 0 40 4 8 7 28 0 + 7 7 41 4 0 7 28 0 7 7 42 1 8 0 0 43 1 + 0 0 0 44 2 0 0 17 0 37 1 0 0 0 44 2 0 + 0 7 0 40 2 0 0 17 0 35 4 0 7 28 0 7 7 + 42 3 0 7 28 0 7 32 2 0 7 28 0 30 2 0 + 25 17 0 27 2 0 16 17 0 24 2 0 10 17 0 + 18 2 0 16 17 0 21 1 0 10 0 12))))) '|lookupComplete|)) |