diff options
Diffstat (limited to 'src/algebra/aggcat.spad.pamphlet')
| -rw-r--r-- | src/algebra/aggcat.spad.pamphlet | 3268 |
1 files changed, 8 insertions, 3260 deletions
diff --git a/src/algebra/aggcat.spad.pamphlet b/src/algebra/aggcat.spad.pamphlet index fe95c2e1..8ed6c354 100644 --- a/src/algebra/aggcat.spad.pamphlet +++ b/src/algebra/aggcat.spad.pamphlet @@ -143,428 +143,7 @@ HomogeneousAggregate(S:Type): Category == Aggregate with commaSeparate [a::OutputForm for a in parts x]$List(OutputForm) @ -\section{HOAGG.lsp BOOTSTRAP} -{\bf HOAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf HOAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf HOAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<HOAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |HomogeneousAggregate;CAT| 'NIL) - -(DEFPARAMETER |HomogeneousAggregate;AL| 'NIL) - -(DEFUN |HomogeneousAggregate| (#0=#:G1399) - (LET (#1=#:G1400) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |HomogeneousAggregate;AL|)) - (CDR #1#)) - (T (SETQ |HomogeneousAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|HomogeneousAggregate;| #0#))) - |HomogeneousAggregate;AL|)) - #1#)))) - -(DEFUN |HomogeneousAggregate;| (|t#1|) - (PROG (#0=#:G1398) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|HomogeneousAggregate;CAT|) - ('T - (LETT |HomogeneousAggregate;CAT| - (|Join| (|Aggregate|) - (|mkCategory| '|domain| - '(((|map| - ($ (|Mapping| |t#1| |t#1|) - $)) - T) - ((|map!| - ($ (|Mapping| |t#1| |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|any?| - ((|Boolean|) - (|Mapping| (|Boolean|) - |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|every?| - ((|Boolean|) - (|Mapping| (|Boolean|) - |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|count| - ((|NonNegativeInteger|) - (|Mapping| (|Boolean|) - |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|parts| - ((|List| |t#1|) $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|members| - ((|List| |t#1|) $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|count| - ((|NonNegativeInteger|) - |t#1| $)) - (AND - (|has| |t#1| - (|SetCategory|)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|)))) - ((|member?| - ((|Boolean|) |t#1| $)) - (AND - (|has| |t#1| - (|SetCategory|)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))))) - '(((|CoercibleTo| - (|OutputForm|)) - (|has| |t#1| - (|CoercibleTo| - (|OutputForm|)))) - ((|SetCategory|) - (|has| |t#1| - (|SetCategory|))) - ((|Evalable| |t#1|) - (AND - (|has| |t#1| - (|Evalable| |t#1|)) - (|has| |t#1| - (|SetCategory|))))) - '((|Boolean|) - (|NonNegativeInteger|) - (|List| |t#1|)) - NIL)) - . #1=(|HomogeneousAggregate|))))) . #1#) - (SETELT #0# 0 - (LIST '|HomogeneousAggregate| (|devaluate| |t#1|))))))) -@ -\section{HOAGG-.lsp BOOTSTRAP} -{\bf HOAGG-} depends on {\bf HOAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf HOAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf HOAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<HOAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| $) - (SPADCALL (CONS #'|HOAGG-;eval;ALA;1!0| (VECTOR $ |l|)) |u| - (QREFELT $ 11))) - -(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| $$) - (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 9))) - -(DEFUN |HOAGG-;#;ANni;2| (|c| $) - (LENGTH (SPADCALL |c| (QREFELT $ 14)))) - -(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| $) - (PROG (|x| #0=#:G1409 #1=#:G1406 #2=#:G1404 #3=#:G1405) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |HOAGG-;any?;MAB;3|) - (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|) - (LETT #0# (SPADCALL |c| (QREFELT $ 14)) - |HOAGG-;any?;MAB;3|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |HOAGG-;any?;MAB;3|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |HOAGG-;any?;MAB;3|) - (COND - (#3# (LETT #2# - (COND (#2# 'T) ('T #1#)) - |HOAGG-;any?;MAB;3|)) - ('T - (PROGN - (LETT #2# #1# |HOAGG-;any?;MAB;3|) - (LETT #3# 'T |HOAGG-;any?;MAB;3|))))))) - (LETT #0# (CDR #0#) |HOAGG-;any?;MAB;3|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'NIL))))))) - -(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| $) - (PROG (|x| #0=#:G1414 #1=#:G1412 #2=#:G1410 #3=#:G1411) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |HOAGG-;every?;MAB;4|) - (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|) - (LETT #0# (SPADCALL |c| (QREFELT $ 14)) - |HOAGG-;every?;MAB;4|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |HOAGG-;every?;MAB;4|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #1# (SPADCALL |x| |f|) - |HOAGG-;every?;MAB;4|) - (COND - (#3# (LETT #2# - (COND (#2# #1#) ('T 'NIL)) - |HOAGG-;every?;MAB;4|)) - ('T - (PROGN - (LETT #2# #1# - |HOAGG-;every?;MAB;4|) - (LETT #3# 'T |HOAGG-;every?;MAB;4|))))))) - (LETT #0# (CDR #0#) |HOAGG-;every?;MAB;4|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'T))))))) - -(DEFUN |HOAGG-;count;MANni;5| (|f| |c| $) - (PROG (|x| #0=#:G1419 #1=#:G1417 #2=#:G1415 #3=#:G1416) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |HOAGG-;count;MANni;5|) - (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|) - (LETT #0# (SPADCALL |c| (QREFELT $ 14)) - |HOAGG-;count;MANni;5|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |HOAGG-;count;MANni;5|) - NIL)) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| |f|) - (PROGN - (LETT #1# 1 |HOAGG-;count;MANni;5|) - (COND - (#3# - (LETT #2# (+ #2# #1#) - |HOAGG-;count;MANni;5|)) - ('T - (PROGN - (LETT #2# #1# - |HOAGG-;count;MANni;5|) - (LETT #3# 'T - |HOAGG-;count;MANni;5|))))))))) - (LETT #0# (CDR #0#) |HOAGG-;count;MANni;5|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 0))))))) - -(DEFUN |HOAGG-;members;AL;6| (|x| $) (SPADCALL |x| (QREFELT $ 14))) - -(DEFUN |HOAGG-;count;SANni;7| (|s| |x| $) - (SPADCALL (CONS #'|HOAGG-;count;SANni;7!0| (VECTOR $ |s|)) |x| - (QREFELT $ 24))) - -(DEFUN |HOAGG-;count;SANni;7!0| (|#1| $$) - (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) - -(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| $) - (SPADCALL (CONS #'|HOAGG-;member?;SAB;8!0| (VECTOR $ |e|)) |c| - (QREFELT $ 26))) - -(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| $$) - (SPADCALL (QREFELT $$ 1) |#1| (QREFELT (QREFELT $$ 0) 23))) - -(DEFUN |HOAGG-;=;2AB;9| (|x| |y| $) - (PROG (|b| #0=#:G1429 |a| #1=#:G1428 #2=#:G1425 #3=#:G1423 - #4=#:G1424) - (RETURN - (SEQ (COND - ((SPADCALL |x| (SPADCALL |y| (QREFELT $ 28)) - (QREFELT $ 29)) - (PROGN - (LETT #4# NIL |HOAGG-;=;2AB;9|) - (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|) - (LETT #0# (SPADCALL |y| (QREFELT $ 14)) - |HOAGG-;=;2AB;9|) - (LETT |a| NIL |HOAGG-;=;2AB;9|) - (LETT #1# (SPADCALL |x| (QREFELT $ 14)) - |HOAGG-;=;2AB;9|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |a| (CAR #1#) |HOAGG-;=;2AB;9|) - NIL) - (ATOM #0#) - (PROGN - (LETT |b| (CAR #0#) |HOAGG-;=;2AB;9|) - NIL)) - (GO G191))) - (SEQ (EXIT (PROGN - (LETT #2# - (SPADCALL |a| |b| - (QREFELT $ 23)) - |HOAGG-;=;2AB;9|) - (COND - (#4# - (LETT #3# - (COND (#3# #2#) ('T 'NIL)) - |HOAGG-;=;2AB;9|)) - ('T - (PROGN - (LETT #3# #2# |HOAGG-;=;2AB;9|) - (LETT #4# 'T |HOAGG-;=;2AB;9|))))))) - (LETT #1# - (PROG1 (CDR #1#) - (LETT #0# (CDR #0#) |HOAGG-;=;2AB;9|)) - |HOAGG-;=;2AB;9|) - (GO G190) G191 (EXIT NIL)) - (COND (#4# #3#) ('T 'T)))) - ('T 'NIL)))))) - -(DEFUN |HOAGG-;coerce;AOf;10| (|x| $) - (PROG (#0=#:G1433 |a| #1=#:G1434) - (RETURN - (SEQ (SPADCALL - (SPADCALL - (PROGN - (LETT #0# NIL |HOAGG-;coerce;AOf;10|) - (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|) - (LETT #1# (SPADCALL |x| (QREFELT $ 14)) - |HOAGG-;coerce;AOf;10|) - G190 - (COND - ((OR (ATOM #1#) - (PROGN - (LETT |a| (CAR #1#) - |HOAGG-;coerce;AOf;10|) - NIL)) - (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (SPADCALL |a| (QREFELT $ 32)) - #0#) - |HOAGG-;coerce;AOf;10|))) - (LETT #1# (CDR #1#) |HOAGG-;coerce;AOf;10|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (QREFELT $ 34)) - (QREFELT $ 35)))))) - -(DEFUN |HomogeneousAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|HomogeneousAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| - (LIST '|HomogeneousAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 38) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|finiteAggregate|) - (|HasAttribute| |#1| '|shallowlyMutable|) - (|HasCategory| |#2| - (LIST '|Evalable| (|devaluate| |#2|))) - (|HasCategory| |#2| '(|SetCategory|)) - (|HasCategory| |#2| - '(|CoercibleTo| (|OutputForm|))))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 3) - (QSETREFV $ 12 - (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) $)))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (QSETREFV $ 16 - (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) $)) - (QSETREFV $ 19 - (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) $)) - (QSETREFV $ 20 - (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) $)) - (QSETREFV $ 21 - (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) $)) - (QSETREFV $ 22 - (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) $)) - (COND - ((|testBitVector| |pv$| 4) - (PROGN - (QSETREFV $ 25 - (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) - $)) - (QSETREFV $ 27 - (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) - $)) - (QSETREFV $ 30 - (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) $))))) - (COND - ((|testBitVector| |pv$| 5) - (QSETREFV $ 36 - (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) - $))))))) - $)))) - -(MAKEPROP '|HomogeneousAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|List| 37) (0 . |eval|) (|Mapping| 7 7) (6 . |map|) - (12 . |eval|) (|List| 7) (18 . |parts|) - (|NonNegativeInteger|) (23 . |#|) (|Boolean|) - (|Mapping| 17 7) (28 . |any?|) (34 . |every?|) - (40 . |count|) (46 . |members|) (51 . =) (57 . |count|) - (63 . |count|) (69 . |any?|) (75 . |member?|) (81 . |#|) - (86 . |size?|) (92 . =) (|OutputForm|) (98 . |coerce|) - (|List| $) (103 . |commaSeparate|) (108 . |bracket|) - (113 . |coerce|) (|Equation| 7)) - '#(|members| 118 |member?| 123 |every?| 129 |eval| 135 - |count| 141 |coerce| 153 |any?| 158 = 164 |#| 170) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 36 - '(2 7 0 0 8 9 2 6 0 10 0 11 2 0 0 0 8 - 12 1 6 13 0 14 1 0 15 0 16 2 0 17 18 - 0 19 2 0 17 18 0 20 2 0 15 18 0 21 1 - 0 13 0 22 2 7 17 0 0 23 2 6 15 18 0 - 24 2 0 15 7 0 25 2 6 17 18 0 26 2 0 - 17 7 0 27 1 6 15 0 28 2 6 17 0 15 29 - 2 0 17 0 0 30 1 7 31 0 32 1 31 0 33 - 34 1 31 0 0 35 1 0 31 0 36 1 0 13 0 - 22 2 0 17 7 0 27 2 0 17 18 0 20 2 0 0 - 0 8 12 2 0 15 7 0 25 2 0 15 18 0 21 1 - 0 31 0 36 2 0 17 18 0 19 2 0 17 0 0 - 30 1 0 15 0 16))))) - '|lookupComplete|)) -@ + \section{category CLAGG Collection} <<category CLAGG Collection>>= )abbrev category CLAGG Collection @@ -649,353 +228,7 @@ Collection(S:Type): Category == HomogeneousAggregate(S) with removeDuplicates(x) == construct removeDuplicates parts x @ -\section{CLAGG.lsp BOOTSTRAP} -{\bf CLAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CLAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CLAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<CLAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |Collection;CAT| 'NIL) - -(DEFPARAMETER |Collection;AL| 'NIL) - -(DEFUN |Collection| (#0=#:G1398) - (LET (#1=#:G1399) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |Collection;AL|)) - (CDR #1#)) - (T (SETQ |Collection;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|Collection;| #0#))) - |Collection;AL|)) - #1#)))) - -(DEFUN |Collection;| (|t#1|) - (PROG (#0=#:G1397) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|Collection;CAT|) - ('T - (LETT |Collection;CAT| - (|Join| (|HomogeneousAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|construct| - ($ (|List| |t#1|))) - T) - ((|find| - ((|Union| |t#1| "failed") - (|Mapping| (|Boolean|) - |t#1|) - $)) - T) - ((|reduce| - (|t#1| - (|Mapping| |t#1| |t#1| - |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|reduce| - (|t#1| - (|Mapping| |t#1| |t#1| - |t#1|) - $ |t#1|)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|remove| - ($ - (|Mapping| (|Boolean|) - |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|select| - ($ - (|Mapping| (|Boolean|) - |t#1|) - $)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))) - ((|reduce| - (|t#1| - (|Mapping| |t#1| |t#1| - |t#1|) - $ |t#1| |t#1|)) - (AND - (|has| |t#1| - (|SetCategory|)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|)))) - ((|remove| ($ |t#1| $)) - (AND - (|has| |t#1| - (|SetCategory|)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|)))) - ((|removeDuplicates| ($ $)) - (AND - (|has| |t#1| - (|SetCategory|)) - (|has| $ - (ATTRIBUTE - |finiteAggregate|))))) - '(((|ConvertibleTo| - (|InputForm|)) - (|has| |t#1| - (|ConvertibleTo| - (|InputForm|))))) - '((|List| |t#1|)) NIL)) - . #1=(|Collection|))))) . #1#) - (SETELT #0# 0 (LIST '|Collection| (|devaluate| |t#1|))))))) -@ -\section{CLAGG-.lsp BOOTSTRAP} -{\bf CLAGG-} depends on {\bf CLAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CLAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CLAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<CLAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |CLAGG-;#;ANni;1| (|c| $) - (LENGTH (SPADCALL |c| (QREFELT $ 9)))) - -(DEFUN |CLAGG-;count;MANni;2| (|f| |c| $) - (PROG (|x| #0=#:G1406 #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| (QREFELT $ 9)) - |CLAGG-;count;MANni;2|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |CLAGG-;count;MANni;2|) - NIL)) - (GO G191))) - (SEQ (EXIT (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|))))))))) - (LETT #0# (CDR #0#) |CLAGG-;count;MANni;2|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 0))))))) - -(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| $) - (PROG (|x| #0=#:G1411 #1=#:G1409 #2=#:G1407 #3=#:G1408) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;any?;MAB;3|) - (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) - (LETT #0# (SPADCALL |c| (QREFELT $ 9)) - |CLAGG-;any?;MAB;3|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |CLAGG-;any?;MAB;3|) - NIL)) - (GO G191))) - (SEQ (EXIT (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|))))))) - (LETT #0# (CDR #0#) |CLAGG-;any?;MAB;3|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'NIL))))))) - -(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| $) - (PROG (|x| #0=#:G1416 #1=#:G1414 #2=#:G1412 #3=#:G1413) - (RETURN - (SEQ (PROGN - (LETT #3# NIL |CLAGG-;every?;MAB;4|) - (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) - (LETT #0# (SPADCALL |c| (QREFELT $ 9)) - |CLAGG-;every?;MAB;4|) - G190 - (COND - ((OR (ATOM #0#) - (PROGN - (LETT |x| (CAR #0#) |CLAGG-;every?;MAB;4|) - NIL)) - (GO G191))) - (SEQ (EXIT (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|))))))) - (LETT #0# (CDR #0#) |CLAGG-;every?;MAB;4|) (GO G190) - G191 (EXIT NIL)) - (COND (#3# #2#) ('T 'T))))))) - -(DEFUN |CLAGG-;find;MAU;5| (|f| |c| $) - (SPADCALL |f| (SPADCALL |c| (QREFELT $ 9)) (QREFELT $ 18))) - -(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| $) - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 21))) - -(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| $) - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s| (QREFELT $ 23))) - -(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| $) - (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 25)) - (QREFELT $ 26))) - -(DEFUN |CLAGG-;select;M2A;9| (|f| |x| $) - (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 28)) - (QREFELT $ 26))) - -(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| $) - (SPADCALL (CONS #'|CLAGG-;remove;S2A;10!0| (VECTOR $ |s|)) |x| - (QREFELT $ 31))) - -(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| $$) - (SPADCALL |#1| (QREFELT $$ 1) (QREFELT (QREFELT $$ 0) 30))) - -(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| $) - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 9)) |s1| |s2| (QREFELT $ 33))) - -(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 35)) - (QREFELT $ 26))) - -(DEFUN |Collection&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|Collection&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|Collection&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 37) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasCategory| |#2| - '(|ConvertibleTo| (|InputForm|))) - (|HasCategory| |#2| '(|SetCategory|)) - (|HasAttribute| |#1| '|finiteAggregate|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 3) - (PROGN - (QSETREFV $ 11 - (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) $)) - (QSETREFV $ 13 - (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) $)) - (QSETREFV $ 15 - (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) $)) - (QSETREFV $ 16 - (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) $)) - (QSETREFV $ 19 - (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) $)) - (QSETREFV $ 22 - (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) $)) - (QSETREFV $ 24 - (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) $)) - (QSETREFV $ 27 - (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) $)) - (QSETREFV $ 29 - (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) $)) - (COND - ((|testBitVector| |pv$| 2) - (PROGN - (QSETREFV $ 32 - (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) - $)) - (QSETREFV $ 34 - (CONS (|dispatchFunction| - |CLAGG-;reduce;MA3S;11|) - $)) - (QSETREFV $ 36 - (CONS (|dispatchFunction| - |CLAGG-;removeDuplicates;2A;12|) - $)))))))) - $)))) - -(MAKEPROP '|Collection&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) - (|Mapping| 14 7) (10 . |count|) (|Boolean|) (16 . |any?|) - (22 . |every?|) (|Union| 7 '"failed") (28 . |find|) - (34 . |find|) (|Mapping| 7 7 7) (40 . |reduce|) - (46 . |reduce|) (52 . |reduce|) (59 . |reduce|) - (66 . |remove|) (72 . |construct|) (77 . |remove|) - (83 . |select|) (89 . |select|) (95 . =) (101 . |remove|) - (107 . |remove|) (113 . |reduce|) (121 . |reduce|) - (129 . |removeDuplicates|) (134 . |removeDuplicates|)) - '#(|select| 139 |removeDuplicates| 145 |remove| 150 |reduce| - 162 |find| 183 |every?| 189 |count| 195 |any?| 201 |#| - 207) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 36 - '(1 6 8 0 9 1 0 10 0 11 2 0 10 12 0 13 - 2 0 14 12 0 15 2 0 14 12 0 16 2 8 17 - 12 0 18 2 0 17 12 0 19 2 8 7 20 0 21 - 2 0 7 20 0 22 3 8 7 20 0 7 23 3 0 7 - 20 0 7 24 2 8 0 12 0 25 1 6 0 8 26 2 - 0 0 12 0 27 2 8 0 12 0 28 2 0 0 12 0 - 29 2 7 14 0 0 30 2 6 0 12 0 31 2 0 0 - 7 0 32 4 8 7 20 0 7 7 33 4 0 7 20 0 7 - 7 34 1 8 0 0 35 1 0 0 0 36 2 0 0 12 0 - 29 1 0 0 0 36 2 0 0 7 0 32 2 0 0 12 0 - 27 4 0 7 20 0 7 7 34 3 0 7 20 0 7 24 - 2 0 7 20 0 22 2 0 17 12 0 19 2 0 14 - 12 0 16 2 0 10 12 0 13 2 0 14 12 0 15 - 1 0 10 0 11))))) - '|lookupComplete|)) -@ + \section{category BGAGG BagAggregate} <<category BGAGG BagAggregate>>= )abbrev category BGAGG BagAggregate @@ -1387,137 +620,6 @@ SetAggregate(S:SetCategory): difference(s:%, x:S) == difference(s, {x}) @ -\section{SETAGG.lsp BOOTSTRAP} -{\bf SETAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<SETAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |SetAggregate;CAT| 'NIL) - -(DEFPARAMETER |SetAggregate;AL| 'NIL) - -(DEFUN |SetAggregate| (#0=#:G1394) - (LET (#1=#:G1395) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |SetAggregate;AL|)) - (CDR #1#)) - (T (SETQ |SetAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|SetAggregate;| #0#))) - |SetAggregate;AL|)) - #1#)))) - -(DEFUN |SetAggregate;| (|t#1|) - (PROG (#0=#:G1393) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|SetAggregate;CAT|) - ('T - (LETT |SetAggregate;CAT| - (|Join| (|SetCategory|) - (|Collection| '|t#1|) - (|mkCategory| '|domain| - '(((|part?| ((|Boolean|) $ $)) - T) - ((|brace| ($)) T) - ((|brace| - ($ (|List| |t#1|))) - T) - ((|set| ($)) T) - ((|set| ($ (|List| |t#1|))) - T) - ((|intersect| ($ $ $)) T) - ((|difference| ($ $ $)) T) - ((|difference| ($ $ |t#1|)) - T) - ((|symmetricDifference| - ($ $ $)) - T) - ((|subset?| - ((|Boolean|) $ $)) - T) - ((|union| ($ $ $)) T) - ((|union| ($ $ |t#1|)) T) - ((|union| ($ |t#1| $)) T)) - '((|partiallyOrderedSet| T)) - '((|Boolean|) (|List| |t#1|)) - NIL)) - . #1=(|SetAggregate|))))) . #1#) - (SETELT #0# 0 (LIST '|SetAggregate| (|devaluate| |t#1|))))))) -@ - -\section{SETAGG-.lsp BOOTSTRAP} -{\bf SETAGG-} depends on {\bf SETAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<SETAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| $) - (SPADCALL (SPADCALL |x| |y| (|getShellEntry| $ 8)) - (SPADCALL |y| |x| (|getShellEntry| $ 8)) (|getShellEntry| $ 9))) - -(DEFUN |SETAGG-;union;ASA;2| (|s| |x| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) - (|getShellEntry| $ 9))) - -(DEFUN |SETAGG-;union;S2A;3| (|x| |s| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) - (|getShellEntry| $ 9))) - -(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| $) - (SPADCALL |s| (SPADCALL (LIST |x|) (|getShellEntry| $ 12)) - (|getShellEntry| $ 8))) - -(DEFUN |SetAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|SetAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|SetAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (|newShell| 16) . #0#) - (|setShellEntry| $ 0 |dv$|) - (|setShellEntry| $ 3 - (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (|setShellEntry| $ 6 |#1|) - (|setShellEntry| $ 7 |#2|) - $)))) - -(MAKEPROP '|SetAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |difference|) (6 . |union|) - |SETAGG-;symmetricDifference;3A;1| (|List| 7) - (12 . |brace|) |SETAGG-;union;ASA;2| |SETAGG-;union;S2A;3| - |SETAGG-;difference;ASA;4|) - '#(|union| 17 |symmetricDifference| 29 |difference| 35) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 15 - '(2 6 0 0 0 8 2 6 0 0 0 9 1 6 0 11 12 2 - 0 0 7 0 14 2 0 0 0 7 13 2 0 0 0 0 10 - 2 0 0 0 7 15))))) - '|lookupComplete|)) -@ \section{category FSAGG FiniteSetAggregate} <<category FSAGG FiniteSetAggregate>>= @@ -2049,156 +1151,7 @@ RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with child?(x,l) == member?(x,children(l)) @ -\section{RCAGG.lsp BOOTSTRAP} -{\bf RCAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RCAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RCAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RCAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |RecursiveAggregate;CAT| 'NIL) - -(DEFPARAMETER |RecursiveAggregate;AL| 'NIL) - -(DEFUN |RecursiveAggregate| (#0=#:G1398) - (LET (#1=#:G1399) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |RecursiveAggregate;AL|)) - (CDR #1#)) - (T (SETQ |RecursiveAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|RecursiveAggregate;| #0#))) - |RecursiveAggregate;AL|)) - #1#)))) - -(DEFUN |RecursiveAggregate;| (|t#1|) - (PROG (#0=#:G1397) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|RecursiveAggregate;CAT|) - ('T - (LETT |RecursiveAggregate;CAT| - (|Join| (|HomogeneousAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|children| ((|List| $) $)) - T) - ((|nodes| ((|List| $) $)) T) - ((|leaf?| ((|Boolean|) $)) - T) - ((|value| (|t#1| $)) T) - ((|elt| (|t#1| $ "value")) - T) - ((|cyclic?| ((|Boolean|) $)) - T) - ((|leaves| - ((|List| |t#1|) $)) - T) - ((|distance| - ((|Integer|) $ $)) - T) - ((|child?| - ((|Boolean|) $ $)) - (|has| |t#1| - (|SetCategory|))) - ((|node?| ((|Boolean|) $ $)) - (|has| |t#1| - (|SetCategory|))) - ((|setchildren!| - ($ $ (|List| $))) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setelt| - (|t#1| $ "value" |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setvalue!| - (|t#1| $ |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|)))) - NIL - '((|List| $) (|Boolean|) - (|Integer|) (|List| |t#1|)) - NIL)) - . #1=(|RecursiveAggregate|))))) . #1#) - (SETELT #0# 0 (LIST '|RecursiveAggregate| (|devaluate| |t#1|))))))) -@ -\section{RCAGG-.lsp BOOTSTRAP} -{\bf RCAGG-} depends on {\bf RCAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RCAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RCAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<RCAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |RCAGG-;elt;AvalueS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) - -(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| T1 |y| $) - (SPADCALL |x| |y| (QREFELT $ 11))) - -(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| $) - (SPADCALL |x| (SPADCALL |l| (QREFELT $ 14)) (QREFELT $ 17))) - -(DEFUN |RecursiveAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|RecursiveAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|RecursiveAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 19) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|) - (|HasCategory| |#2| '(|SetCategory|)))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|testBitVector| |pv$| 1) - (QSETREFV $ 12 - (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) $)))) - (COND - ((|testBitVector| |pv$| 2) - (QSETREFV $ 18 - (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) $)))) - $)))) - -(MAKEPROP '|RecursiveAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |value|) '"value" |RCAGG-;elt;AvalueS;1| - (5 . |setvalue!|) (11 . |setelt|) (|List| $) - (18 . |children|) (|Boolean|) (|List| 6) (23 . |member?|) - (29 . |child?|)) - '#(|setelt| 35 |elt| 42 |child?| 48) 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 18 - '(1 6 7 0 8 2 6 7 0 7 11 3 0 7 0 9 7 12 - 1 6 13 0 14 2 16 15 6 0 17 2 0 15 0 0 - 18 3 0 7 0 9 7 12 2 0 7 0 9 10 2 0 15 - 0 0 18))))) - '|lookupComplete|)) -@ + \section{category BRAGG BinaryRecursiveAggregate} <<category BRAGG BinaryRecursiveAggregate>>= )abbrev category BRAGG BinaryRecursiveAggregate @@ -2625,753 +1578,7 @@ UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with y @ -\section{URAGG.lsp BOOTSTRAP} -{\bf URAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf URAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf URAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<URAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |UnaryRecursiveAggregate;CAT| 'NIL) - -(DEFPARAMETER |UnaryRecursiveAggregate;AL| 'NIL) - -(DEFUN |UnaryRecursiveAggregate| (#0=#:G1426) - (LET (#1=#:G1427) - (COND - ((SETQ #1# - (|assoc| (|devaluate| #0#) |UnaryRecursiveAggregate;AL|)) - (CDR #1#)) - (T (SETQ |UnaryRecursiveAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# - (|UnaryRecursiveAggregate;| #0#))) - |UnaryRecursiveAggregate;AL|)) - #1#)))) - -(DEFUN |UnaryRecursiveAggregate;| (|t#1|) - (PROG (#0=#:G1425) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|UnaryRecursiveAggregate;CAT|) - ('T - (LETT |UnaryRecursiveAggregate;CAT| - (|Join| (|RecursiveAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|concat| ($ $ $)) T) - ((|concat| ($ |t#1| $)) T) - ((|first| (|t#1| $)) T) - ((|elt| (|t#1| $ "first")) - T) - ((|first| - ($ $ - (|NonNegativeInteger|))) - T) - ((|rest| ($ $)) T) - ((|elt| ($ $ "rest")) T) - ((|rest| - ($ $ - (|NonNegativeInteger|))) - T) - ((|last| (|t#1| $)) T) - ((|elt| (|t#1| $ "last")) T) - ((|last| - ($ $ - (|NonNegativeInteger|))) - T) - ((|tail| ($ $)) T) - ((|second| (|t#1| $)) T) - ((|third| (|t#1| $)) T) - ((|cycleEntry| ($ $)) T) - ((|cycleLength| - ((|NonNegativeInteger|) $)) - T) - ((|cycleTail| ($ $)) T) - ((|concat!| ($ $ $)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|concat!| ($ $ |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|cycleSplit!| ($ $)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setfirst!| - (|t#1| $ |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setelt| - (|t#1| $ "first" |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setrest!| ($ $ $)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setelt| ($ $ "rest" $)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setlast!| - (|t#1| $ |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|setelt| - (|t#1| $ "last" |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|))) - ((|split!| - ($ $ (|Integer|))) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|)))) - NIL - '((|Integer|) - (|NonNegativeInteger|)) - NIL)) - . #1=(|UnaryRecursiveAggregate|))))) . #1#) - (SETELT #0# 0 - (LIST '|UnaryRecursiveAggregate| (|devaluate| |t#1|))))))) -@ -\section{URAGG-.lsp BOOTSTRAP} -{\bf URAGG-} depends on {\bf URAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf URAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf URAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<URAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |URAGG-;elt;AfirstS;1| (|x| T0 $) (SPADCALL |x| (QREFELT $ 8))) - -(DEFUN |URAGG-;elt;AlastS;2| (|x| T1 $) (SPADCALL |x| (QREFELT $ 11))) - -(DEFUN |URAGG-;elt;ArestA;3| (|x| T2 $) (SPADCALL |x| (QREFELT $ 14))) - -(DEFUN |URAGG-;second;AS;4| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 8))) - -(DEFUN |URAGG-;third;AS;5| (|x| $) - (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT $ 14)) (QREFELT $ 14)) - (QREFELT $ 8))) - -(DEFUN |URAGG-;cyclic?;AB;6| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 20)) 'NIL) - ('T - (SPADCALL (SPADCALL (|URAGG-;findCycle| |x| $) (QREFELT $ 20)) - (QREFELT $ 21))))) - -(DEFUN |URAGG-;last;AS;7| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 23)) (QREFELT $ 8))) - -(DEFUN |URAGG-;nodes;AL;8| (|x| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;nodes;AL;8|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (NREVERSE |l|)))))) - -(DEFUN |URAGG-;children;AL;9| (|x| $) - (PROG (|l|) - (RETURN - (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 20)) |l|) - ('T (CONS (SPADCALL |x| (QREFELT $ 14)) |l|)))))))) - -(DEFUN |URAGG-;leaf?;AB;10| (|x| $) (SPADCALL |x| (QREFELT $ 20))) - -(DEFUN |URAGG-;value;AS;11| (|x| $) - (COND - ((SPADCALL |x| (QREFELT $ 20)) (|error| "value of empty object")) - ('T (SPADCALL |x| (QREFELT $ 8))))) - -(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) - (SEQ G190 - (COND - ((NULL (COND - ((< 0 |i|) - (SPADCALL (SPADCALL |l| (QREFELT $ 20)) - (QREFELT $ 21))) - ('T 'NIL))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) - |URAGG-;less?;ANniB;12|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;less?;ANniB;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (< 0 |i|)))))) - -(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) - (SEQ G190 - (COND - ((NULL (COND - ((< 0 |i|) - (SPADCALL (SPADCALL |l| (QREFELT $ 20)) - (QREFELT $ 21))) - ('T 'NIL))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) - |URAGG-;more?;ANniB;13|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;more?;ANniB;13|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((ZEROP |i|) - (SPADCALL (SPADCALL |l| (QREFELT $ 20)) - (QREFELT $ 21))) - ('T 'NIL))))))) - -(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| $) - (PROG (|i|) - (RETURN - (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |l| (QREFELT $ 20)) 'NIL) - ('T (< 0 |i|)))) - (GO G191))) - (SEQ (LETT |l| (SPADCALL |l| (QREFELT $ 14)) - |URAGG-;size?;ANniB;14|) - (EXIT (LETT |i| (- |i| 1) |URAGG-;size?;ANniB;14|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |l| (QREFELT $ 20)) (ZEROP |i|)) - ('T 'NIL))))))) - -(DEFUN |URAGG-;#;ANni;15| (|x| $) - (PROG (|k|) - (RETURN - (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;#;ANni;15|))) - (LETT |k| (QSADD1 |k|) |URAGG-;#;ANni;15|) (GO G190) - G191 (EXIT NIL)) - (EXIT |k|))))) - -(DEFUN |URAGG-;tail;2A;16| (|x| $) - (PROG (|k| |y|) - (RETURN - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 20)) (|error| "empty list")) - ('T - (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;tail;2A;16|) - (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (EXIT (|error| "cyclic list")))))) - (EXIT (LETT |y| - (SPADCALL - (LETT |x| |y| |URAGG-;tail;2A;16|) - (QREFELT $ 14)) - |URAGG-;tail;2A;16|))) - (LETT |k| (QSADD1 |k|) |URAGG-;tail;2A;16|) - (GO G190) G191 (EXIT NIL)) - (EXIT |x|)))))))) - -(DEFUN |URAGG-;findCycle| (|x| $) - (PROG (#0=#:G1475 |y|) - (RETURN - (SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;findCycle|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (COND - ((SPADCALL |x| |y| (QREFELT $ 37)) - (PROGN - (LETT #0# |x| |URAGG-;findCycle|) - (GO #0#)))) - (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;findCycle|) - (LETT |y| (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;findCycle|) - (COND - ((SPADCALL |y| (QREFELT $ 20)) - (PROGN - (LETT #0# |y| |URAGG-;findCycle|) - (GO #0#)))) - (COND - ((SPADCALL |x| |y| (QREFELT $ 37)) - (PROGN - (LETT #0# |y| |URAGG-;findCycle|) - (GO #0#)))) - (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;findCycle|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|))) - #0# (EXIT #0#))))) - -(DEFUN |URAGG-;cycleTail;2A;18| (|x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (COND - ((SPADCALL - (LETT |y| - (LETT |x| (SPADCALL |x| (QREFELT $ 38)) - |URAGG-;cycleTail;2A;18|) - |URAGG-;cycleTail;2A;18|) - (QREFELT $ 20)) - |x|) - ('T - (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleTail;2A;18|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |x| |z| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) - (EXIT (LETT |z| - (SPADCALL |z| (QREFELT $ 14)) - |URAGG-;cycleTail;2A;18|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|)))))))) - -(DEFUN |URAGG-;cycleEntry;2A;19| (|x| $) - (PROG (|l| |z| |k| |y|) - (RETURN - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 20)) |x|) - ((SPADCALL - (LETT |y| (|URAGG-;findCycle| |x| $) - |URAGG-;cycleEntry;2A;19|) - (QREFELT $ 20)) - |y|) - ('T - (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|) - (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| |z| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (EXIT (LETT |z| - (SPADCALL |z| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|))) - (LETT |l| (QSADD1 |l|) - |URAGG-;cycleEntry;2A;19|) - (GO G190) G191 (EXIT NIL)) - (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) - (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 - (COND ((QSGREATERP |k| |l|) (GO G191))) - (SEQ (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|))) - (LETT |k| (QSADD1 |k|) - |URAGG-;cycleEntry;2A;19|) - (GO G190) G191 (EXIT NIL)) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |x| |y| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|) - (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleEntry;2A;19|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|)))))))) - -(DEFUN |URAGG-;cycleLength;ANni;20| (|x| $) - (PROG (|k| |y|) - (RETURN - (SEQ (COND - ((OR (SPADCALL |x| (QREFELT $ 20)) - (SPADCALL - (LETT |x| (|URAGG-;findCycle| |x| $) - |URAGG-;cycleLength;ANni;20|) - (QREFELT $ 20))) - 0) - ('T - (SEQ (LETT |y| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleLength;ANni;20|) - (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |x| |y| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (EXIT (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;cycleLength;ANni;20|))) - (LETT |k| (QSADD1 |k|) - |URAGG-;cycleLength;ANni;20|) - (GO G190) G191 (EXIT NIL)) - (EXIT |k|)))))))) - -(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| $) - (PROG (|i|) - (RETURN - (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |x| (QREFELT $ 20)) - (|error| "Index out of range")) - ('T - (LETT |x| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;rest;ANniA;21|))))) - (LETT |i| (QSADD1 |i|) |URAGG-;rest;ANniA;21|) - (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |URAGG-;last;ANniA;22| (|x| |n| $) - (PROG (|m| #0=#:G1498) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 43)) - |URAGG-;last;ANniA;22|) - (EXIT (COND - ((< |m| |n|) (|error| "index out of range")) - ('T - (SPADCALL - (SPADCALL |x| - (PROG1 (LETT #0# (- |m| |n|) - |URAGG-;last;ANniA;22|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 44)) - (QREFELT $ 45))))))))) - -(DEFUN |URAGG-;=;2AB;23| (|x| |y| $) - (PROG (|k| #0=#:G1508) - (RETURN - (SEQ (EXIT (COND - ((SPADCALL |x| |y| (QREFELT $ 37)) 'T) - ('T - (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 20)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |y| - (QREFELT $ 20)) - (QREFELT $ 21))))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 34)) - (EXIT (|error| "cyclic list")))))) - (COND - ((NULL - (SPADCALL - (SPADCALL |x| (QREFELT $ 8)) - (SPADCALL |y| (QREFELT $ 8)) - (QREFELT $ 47))) - (EXIT - (PROGN - (LETT #0# 'NIL - |URAGG-;=;2AB;23|) - (GO #0#))))) - (LETT |x| - (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;=;2AB;23|) - (EXIT - (LETT |y| - (SPADCALL |y| (QREFELT $ 14)) - |URAGG-;=;2AB;23|))) - (LETT |k| (QSADD1 |k|) |URAGG-;=;2AB;23|) - (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 20)) - (SPADCALL |y| (QREFELT $ 20))) - ('T 'NIL))))))) - #0# (EXIT #0#))))) - -(DEFUN |URAGG-;node?;2AB;24| (|u| |v| $) - (PROG (|k| #0=#:G1513) - (RETURN - (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 - (COND - ((NULL (SPADCALL - (SPADCALL |v| (QREFELT $ 20)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL |u| |v| - (QREFELT $ 49)) - (PROGN - (LETT #0# 'T - |URAGG-;node?;2AB;24|) - (GO #0#))) - ('T - (SEQ - (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |v| - (QREFELT $ 34)) - (EXIT - (|error| - "cyclic list")))))) - (EXIT - (LETT |v| - (SPADCALL |v| - (QREFELT $ 14)) - |URAGG-;node?;2AB;24|))))))) - (LETT |k| (QSADD1 |k|) - |URAGG-;node?;2AB;24|) - (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |u| |v| (QREFELT $ 49))))) - #0# (EXIT #0#))))) - -(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| T3 |a| $) - (SPADCALL |x| |a| (QREFELT $ 51))) - -(DEFUN |URAGG-;setelt;Alast2S;26| (|x| T4 |a| $) - (SPADCALL |x| |a| (QREFELT $ 53))) - -(DEFUN |URAGG-;setelt;Arest2A;27| (|x| T5 |a| $) - (SPADCALL |x| |a| (QREFELT $ 55))) - -(DEFUN |URAGG-;concat;3A;28| (|x| |y| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| (QREFELT $ 57))) - -(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| $) - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 20)) - (|error| "setlast: empty list")) - ('T - (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 23)) |s| - (QREFELT $ 51)) - (EXIT |s|)))))) - -(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| $) - (COND - ((EQL (LENGTH |lv|) 1) - (SPADCALL |u| (|SPADfirst| |lv|) (QREFELT $ 55))) - ('T (|error| "wrong number of children specified")))) - -(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| $) - (SPADCALL |u| |s| (QREFELT $ 51))) - -(DEFUN |URAGG-;split!;AIA;32| (|p| |n| $) - (PROG (#0=#:G1524 |q|) - (RETURN - (SEQ (COND - ((< |n| 1) (|error| "index out of range")) - ('T - (SEQ (LETT |p| - (SPADCALL |p| - (PROG1 (LETT #0# (- |n| 1) - |URAGG-;split!;AIA;32|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 44)) - |URAGG-;split!;AIA;32|) - (LETT |q| (SPADCALL |p| (QREFELT $ 14)) - |URAGG-;split!;AIA;32|) - (SPADCALL |p| (SPADCALL (QREFELT $ 62)) - (QREFELT $ 55)) - (EXIT |q|)))))))) - -(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (COND - ((OR (SPADCALL - (LETT |y| (SPADCALL |x| (QREFELT $ 38)) - |URAGG-;cycleSplit!;2A;33|) - (QREFELT $ 20)) - (SPADCALL |x| |y| (QREFELT $ 37))) - |y|) - ('T - (SEQ (LETT |z| (SPADCALL |x| (QREFELT $ 14)) - |URAGG-;cycleSplit!;2A;33|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |z| |y| (QREFELT $ 37)) - (QREFELT $ 21))) - (GO G191))) - (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) - (EXIT (LETT |z| - (SPADCALL |z| (QREFELT $ 14)) - |URAGG-;cycleSplit!;2A;33|))) - NIL (GO G190) G191 (EXIT NIL)) - (SPADCALL |x| (SPADCALL (QREFELT $ 62)) - (QREFELT $ 55)) - (EXIT |y|)))))))) - -(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) - . #0=(|UnaryRecursiveAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| - (LIST '|UnaryRecursiveAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 67) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasAttribute| |#1| '|finiteAggregate|) - (QSETREFV $ 46 - (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) $)))) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (PROGN - (QSETREFV $ 48 - (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) $)) - (QSETREFV $ 50 - (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) $))))) - (COND - ((|testBitVector| |pv$| 1) - (PROGN - (QSETREFV $ 52 - (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) - $)) - (QSETREFV $ 54 - (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) - $)) - (QSETREFV $ 56 - (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) - $)) - (QSETREFV $ 58 - (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) $)) - (QSETREFV $ 59 - (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) $)) - (QSETREFV $ 60 - (CONS (|dispatchFunction| - |URAGG-;setchildren!;ALA;30|) - $)) - (QSETREFV $ 61 - (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) - $)) - (QSETREFV $ 64 - (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) $)) - (QSETREFV $ 65 - (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) - $))))) - $)))) - -(MAKEPROP '|UnaryRecursiveAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (0 . |first|) '"first" |URAGG-;elt;AfirstS;1| (5 . |last|) - '"last" |URAGG-;elt;AlastS;2| (10 . |rest|) '"rest" - |URAGG-;elt;ArestA;3| |URAGG-;second;AS;4| - |URAGG-;third;AS;5| (|Boolean|) (15 . |empty?|) - (20 . |not|) |URAGG-;cyclic?;AB;6| (25 . |tail|) - |URAGG-;last;AS;7| (|List| $) |URAGG-;nodes;AL;8| - |URAGG-;children;AL;9| |URAGG-;leaf?;AB;10| - |URAGG-;value;AS;11| (|NonNegativeInteger|) - |URAGG-;less?;ANniB;12| |URAGG-;more?;ANniB;13| - |URAGG-;size?;ANniB;14| (30 . |cyclic?|) - |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (35 . |eq?|) - (41 . |cycleEntry|) |URAGG-;cycleTail;2A;18| - |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| - |URAGG-;rest;ANniA;21| (46 . |#|) (51 . |rest|) - (57 . |copy|) (62 . |last|) (68 . =) (74 . =) (80 . =) - (86 . |node?|) (92 . |setfirst!|) (98 . |setelt|) - (105 . |setlast!|) (111 . |setelt|) (118 . |setrest!|) - (124 . |setelt|) (131 . |concat!|) (137 . |concat|) - (143 . |setlast!|) (149 . |setchildren!|) - (155 . |setvalue!|) (161 . |empty|) (|Integer|) - (165 . |split!|) (171 . |cycleSplit!|) '"value") - '#(|value| 176 |third| 181 |tail| 186 |split!| 191 |size?| - 197 |setvalue!| 203 |setlast!| 209 |setelt| 215 - |setchildren!| 236 |second| 242 |rest| 247 |nodes| 253 - |node?| 258 |more?| 264 |less?| 270 |leaf?| 276 |last| 281 - |elt| 292 |cyclic?| 310 |cycleTail| 315 |cycleSplit!| 320 - |cycleLength| 325 |cycleEntry| 330 |concat| 335 |children| - 341 = 346 |#| 352) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 65 - '(1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 - 19 0 20 1 19 0 0 21 1 6 0 0 23 1 6 19 - 0 34 2 6 19 0 0 37 1 6 0 0 38 1 6 30 - 0 43 2 6 0 0 30 44 1 6 0 0 45 2 0 0 0 - 30 46 2 7 19 0 0 47 2 0 19 0 0 48 2 6 - 19 0 0 49 2 0 19 0 0 50 2 6 7 0 7 51 - 3 0 7 0 9 7 52 2 6 7 0 7 53 3 0 7 0 - 12 7 54 2 6 0 0 0 55 3 0 0 0 15 0 56 - 2 6 0 0 0 57 2 0 0 0 0 58 2 0 7 0 7 - 59 2 0 0 0 25 60 2 0 7 0 7 61 0 6 0 - 62 2 0 0 0 63 64 1 0 0 0 65 1 0 7 0 - 29 1 0 7 0 18 1 0 0 0 36 2 0 0 0 63 - 64 2 0 19 0 30 33 2 0 7 0 7 61 2 0 7 - 0 7 59 3 0 7 0 12 7 54 3 0 0 0 15 0 - 56 3 0 7 0 9 7 52 2 0 0 0 25 60 1 0 7 - 0 17 2 0 0 0 30 42 1 0 25 0 26 2 0 19 - 0 0 50 2 0 19 0 30 32 2 0 19 0 30 31 - 1 0 19 0 28 2 0 0 0 30 46 1 0 7 0 24 - 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 - 10 1 0 19 0 22 1 0 0 0 39 1 0 0 0 65 - 1 0 30 0 41 1 0 0 0 40 2 0 0 0 0 58 1 - 0 25 0 27 2 0 19 0 0 48 1 0 30 0 35))))) - '|lookupComplete|)) -@ + \section{category STAGG StreamAggregate} <<category STAGG StreamAggregate>>= )abbrev category STAGG StreamAggregate @@ -3463,366 +1670,7 @@ StreamAggregate(S:Type): Category == x @ -\section{STAGG.lsp BOOTSTRAP} -{\bf STAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf STAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf STAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<STAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |StreamAggregate;CAT| 'NIL) - -(DEFPARAMETER |StreamAggregate;AL| 'NIL) - -(DEFUN |StreamAggregate| (#0=#:G1405) - (LET (#1=#:G1406) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |StreamAggregate;AL|)) - (CDR #1#)) - (T (SETQ |StreamAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|StreamAggregate;| #0#))) - |StreamAggregate;AL|)) - #1#)))) - -(DEFUN |StreamAggregate;| (|t#1|) - (PROG (#0=#:G1404) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|StreamAggregate;CAT|) - ('T - (LETT |StreamAggregate;CAT| - (|Join| (|UnaryRecursiveAggregate| - '|t#1|) - (|LinearAggregate| '|t#1|) - (|mkCategory| '|domain| - '(((|explicitlyFinite?| - ((|Boolean|) $)) - T) - ((|possiblyInfinite?| - ((|Boolean|) $)) - T)) - NIL '((|Boolean|)) NIL)) - . #1=(|StreamAggregate|))))) . #1#) - (SETELT #0# 0 (LIST '|StreamAggregate| (|devaluate| |t#1|))))))) -@ -\section{STAGG-.lsp BOOTSTRAP} -{\bf STAGG-} depends on {\bf STAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf STAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf STAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<STAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 9)) (QREFELT $ 10))) - -(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| $) - (SPADCALL |x| (QREFELT $ 9))) - -(DEFUN |STAGG-;first;ANniA;3| (|x| |n| $) - (PROG (#0=#:G1411 |i|) - (RETURN - (SEQ (SPADCALL - (PROGN - (LETT #0# NIL |STAGG-;first;ANniA;3|) - (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 - (COND ((QSGREATERP |i| |n|) (GO G191))) - (SEQ (EXIT (LETT #0# - (CONS - (|STAGG-;c2| |x| - (LETT |x| - (SPADCALL |x| (QREFELT $ 13)) - |STAGG-;first;ANniA;3|) - $) - #0#) - |STAGG-;first;ANniA;3|))) - (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) - (GO G190) G191 (EXIT (NREVERSE0 #0#)))) - (QREFELT $ 15)))))) - -(DEFUN |STAGG-;c2| (|x| |r| $) - (COND - ((SPADCALL |x| (QREFELT $ 18)) (|error| "Index out of range")) - ('T (SPADCALL |x| (QREFELT $ 19))))) - -(DEFUN |STAGG-;elt;AIS;5| (|x| |i| $) - (PROG (#0=#:G1414) - (RETURN - (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;elt;AIS;5|) - (COND - ((OR (< |i| 0) - (SPADCALL - (LETT |x| - (SPADCALL |x| - (PROG1 (LETT #0# |i| - |STAGG-;elt;AIS;5|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 22)) - |STAGG-;elt;AIS;5|) - (QREFELT $ 18))) - (EXIT (|error| "index out of range")))) - (EXIT (SPADCALL |x| (QREFELT $ 19))))))) - -(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| $) - (PROG (|l| #0=#:G1418 |h| #1=#:G1420 #2=#:G1421) - (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (QREFELT $ 25)) - (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ((NULL (SPADCALL |i| (QREFELT $ 26))) - (SPADCALL - (SPADCALL |x| - (PROG1 (LETT #0# |l| |STAGG-;elt;AUsA;6|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 22)) - (QREFELT $ 27))) - ('T - (SEQ (LETT |h| - (- (SPADCALL |i| (QREFELT $ 28)) - (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;elt;AUsA;6|) - (EXIT (COND - ((< |h| |l|) - (SPADCALL (QREFELT $ 29))) - ('T - (SPADCALL - (SPADCALL |x| - (PROG1 - (LETT #1# |l| - |STAGG-;elt;AUsA;6|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) #1#)) - (QREFELT $ 22)) - (PROG1 - (LETT #2# (+ (- |h| |l|) 1) - |STAGG-;elt;AUsA;6|) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) #2#)) - (QREFELT $ 30))))))))))))) - -(DEFUN |STAGG-;concat;3A;7| (|x| |y| $) - (SPADCALL (SPADCALL |x| (QREFELT $ 27)) |y| (QREFELT $ 32))) - -(DEFUN |STAGG-;concat;LA;8| (|l| $) - (COND - ((NULL |l|) (SPADCALL (QREFELT $ 29))) - ('T - (SPADCALL (SPADCALL (|SPADfirst| |l|) (QREFELT $ 27)) - (SPADCALL (CDR |l|) (QREFELT $ 35)) (QREFELT $ 32))))) - -(DEFUN |STAGG-;map!;M2A;9| (|f| |l| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |l| (QREFELT $ 18)) - (QREFELT $ 10))) - (GO G191))) - (SEQ (SPADCALL |l| - (SPADCALL (SPADCALL |l| (QREFELT $ 19)) |f|) - (QREFELT $ 37)) - (EXIT (LETT |l| (SPADCALL |l| (QREFELT $ 13)) - |STAGG-;map!;M2A;9|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|))))) - -(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| $) - (PROG (|y|) - (RETURN - (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |y| (QREFELT $ 18)) - (QREFELT $ 10))) - (GO G191))) - (SEQ (SPADCALL |y| |s| (QREFELT $ 37)) - (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 13)) - |STAGG-;fill!;ASA;10|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))) - -(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| $) - (PROG (#0=#:G1437) - (RETURN - (SEQ (LETT |i| (- |i| (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;setelt;AI2S;11|) - (COND - ((OR (< |i| 0) - (SPADCALL - (LETT |x| - (SPADCALL |x| - (PROG1 (LETT #0# |i| - |STAGG-;setelt;AI2S;11|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 22)) - |STAGG-;setelt;AI2S;11|) - (QREFELT $ 18))) - (EXIT (|error| "index out of range")))) - (EXIT (SPADCALL |x| |s| (QREFELT $ 37))))))) - -(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| $) - (PROG (|l| |h| #0=#:G1442 #1=#:G1443 |z| |y|) - (RETURN - (SEQ (LETT |l| - (- (SPADCALL |i| (QREFELT $ 25)) - (SPADCALL |x| (QREFELT $ 21))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |l| 0) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (QREFELT $ 26)) - (- (SPADCALL |i| (QREFELT $ 28)) - (SPADCALL |x| (QREFELT $ 21)))) - ('T (SPADCALL |x| (QREFELT $ 42)))) - |STAGG-;setelt;AUs2S;12|) - (EXIT (COND - ((< |h| |l|) |s|) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# |l| - |STAGG-;setelt;AUs2S;12|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) - #0#)) - (QREFELT $ 22)) - |STAGG-;setelt;AUs2S;12|) - (LETT |z| - (SPADCALL |y| - (PROG1 - (LETT #1# (+ (- |h| |l|) 1) - |STAGG-;setelt;AUs2S;12|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) - #1#)) - (QREFELT $ 22)) - |STAGG-;setelt;AUs2S;12|) - (SEQ G190 - (COND - ((NULL - (SPADCALL - (SPADCALL |y| |z| - (QREFELT $ 43)) - (QREFELT $ 10))) - (GO G191))) - (SEQ - (SPADCALL |y| |s| - (QREFELT $ 37)) - (EXIT - (LETT |y| - (SPADCALL |y| - (QREFELT $ 13)) - |STAGG-;setelt;AUs2S;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |s|))))))))))))) - -(DEFUN |STAGG-;concat!;3A;13| (|x| |y| $) - (SEQ (COND - ((SPADCALL |x| (QREFELT $ 18)) |y|) - ('T - (SEQ (SPADCALL (SPADCALL |x| (QREFELT $ 45)) |y| - (QREFELT $ 46)) - (EXIT |x|)))))) - -(DEFUN |StreamAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|StreamAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|StreamAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 52) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasAttribute| |#1| '|shallowlyMutable|) - (PROGN - (QSETREFV $ 33 - (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) $)) - (QSETREFV $ 36 - (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) $)) - (QSETREFV $ 39 - (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) $)) - (QSETREFV $ 40 - (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) $)) - (QSETREFV $ 41 - (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) $)) - (QSETREFV $ 44 - (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) $)) - (QSETREFV $ 47 - (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) $))))) - $)))) - -(MAKEPROP '|StreamAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|Boolean|) (0 . |cyclic?|) (5 . |not|) - |STAGG-;explicitlyFinite?;AB;1| - |STAGG-;possiblyInfinite?;AB;2| (10 . |rest|) (|List| 7) - (15 . |construct|) (|NonNegativeInteger|) - |STAGG-;first;ANniA;3| (20 . |empty?|) (25 . |first|) - (|Integer|) (30 . |minIndex|) (35 . |rest|) - |STAGG-;elt;AIS;5| (|UniversalSegment| 20) (41 . |lo|) - (46 . |hasHi|) (51 . |copy|) (56 . |hi|) (61 . |empty|) - (65 . |first|) |STAGG-;elt;AUsA;6| (71 . |concat!|) - (77 . |concat|) (|List| $) (83 . |concat|) (88 . |concat|) - (93 . |setfirst!|) (|Mapping| 7 7) (99 . |map!|) - (105 . |fill!|) (111 . |setelt|) (118 . |maxIndex|) - (123 . |eq?|) (129 . |setelt|) (136 . |tail|) - (141 . |setrest!|) (147 . |concat!|) '"rest" '"last" - '"first" '"value") - '#(|setelt| 153 |possiblyInfinite?| 167 |map!| 172 |first| - 178 |fill!| 184 |explicitlyFinite?| 190 |elt| 195 - |concat!| 207 |concat| 213) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 47 - '(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 6 0 0 16 22 1 24 20 0 25 1 24 8 - 0 26 1 6 0 0 27 1 24 20 0 28 0 6 0 29 - 2 6 0 0 16 30 2 6 0 0 0 32 2 0 0 0 0 - 33 1 6 0 34 35 1 0 0 34 36 2 6 7 0 7 - 37 2 0 0 38 0 39 2 0 0 0 7 40 3 0 7 0 - 20 7 41 1 6 20 0 42 2 6 8 0 0 43 3 0 - 7 0 24 7 44 1 6 0 0 45 2 6 0 0 0 46 2 - 0 0 0 0 47 3 0 7 0 20 7 41 3 0 7 0 24 - 7 44 1 0 8 0 12 2 0 0 38 0 39 2 0 0 0 - 16 17 2 0 0 0 7 40 1 0 8 0 11 2 0 7 0 - 20 23 2 0 0 0 24 31 2 0 0 0 0 47 1 0 - 0 34 36 2 0 0 0 0 33))))) - '|lookupComplete|)) -@ + \section{category LNAGG LinearAggregate} <<category LNAGG LinearAggregate>>= )abbrev category LNAGG LinearAggregate @@ -3908,189 +1756,7 @@ LinearAggregate(S:Type): Category == --if % has shallowlyMutable then new(n, s) == fill_!(new n, s) @ -\section{LNAGG.lsp BOOTSTRAP} -{\bf LNAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LNAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LNAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LNAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |LinearAggregate;CAT| 'NIL) - -(DEFPARAMETER |LinearAggregate;AL| 'NIL) - -(DEFUN |LinearAggregate| (#0=#:G1400) - (LET (#1=#:G1401) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |LinearAggregate;AL|)) - (CDR #1#)) - (T (SETQ |LinearAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|LinearAggregate;| #0#))) - |LinearAggregate;AL|)) - #1#)))) - -(DEFUN |LinearAggregate;| (|t#1|) - (PROG (#0=#:G1399) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (|sublisV| - (PAIR '(#1=#:G1398) (LIST '(|Integer|))) - (COND - (|LinearAggregate;CAT|) - ('T - (LETT |LinearAggregate;CAT| - (|Join| - (|IndexedAggregate| '#1# '|t#1|) - (|Collection| '|t#1|) - (|mkCategory| '|domain| - '(((|new| - ($ (|NonNegativeInteger|) - |t#1|)) - T) - ((|concat| ($ $ |t#1|)) T) - ((|concat| ($ |t#1| $)) T) - ((|concat| ($ $ $)) T) - ((|concat| ($ (|List| $))) T) - ((|map| - ($ - (|Mapping| |t#1| |t#1| - |t#1|) - $ $)) - T) - ((|elt| - ($ $ - (|UniversalSegment| - (|Integer|)))) - T) - ((|delete| ($ $ (|Integer|))) - T) - ((|delete| - ($ $ - (|UniversalSegment| - (|Integer|)))) - T) - ((|insert| - ($ |t#1| $ (|Integer|))) - T) - ((|insert| ($ $ $ (|Integer|))) - T) - ((|setelt| - (|t#1| $ - (|UniversalSegment| - (|Integer|)) - |t#1|)) - (|has| $ - (ATTRIBUTE - |shallowlyMutable|)))) - NIL - '((|UniversalSegment| - (|Integer|)) - (|Integer|) (|List| $) - (|NonNegativeInteger|)) - NIL)) - . #2=(|LinearAggregate|)))))) . #2#) - (SETELT #0# 0 (LIST '|LinearAggregate| (|devaluate| |t#1|))))))) -@ -\section{LNAGG-.lsp BOOTSTRAP} -{\bf LNAGG-} depends on {\bf LNAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LNAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LNAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LNAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |LNAGG-;indices;AL;1| (|a| $) - (PROG (#0=#:G1404 |i| #1=#:G1405) - (RETURN - (SEQ (PROGN - (LETT #0# NIL |LNAGG-;indices;AL;1|) - (SEQ (LETT |i| (SPADCALL |a| (QREFELT $ 9)) - |LNAGG-;indices;AL;1|) - (LETT #1# (SPADCALL |a| (QREFELT $ 10)) - |LNAGG-;indices;AL;1|) - G190 (COND ((> |i| #1#) (GO G191))) - (SEQ (EXIT (LETT #0# (CONS |i| #0#) - |LNAGG-;indices;AL;1|))) - (LETT |i| (+ |i| 1) |LNAGG-;indices;AL;1|) (GO G190) - G191 (EXIT (NREVERSE0 #0#)))))))) - -(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| $) - (COND - ((< |i| (SPADCALL |a| (QREFELT $ 9))) 'NIL) - ('T - (SPADCALL (< (SPADCALL |a| (QREFELT $ 10)) |i|) (QREFELT $ 14))))) - -(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| $) - (SPADCALL |a| (SPADCALL 1 |x| (QREFELT $ 17)) (QREFELT $ 18))) - -(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| $) - (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |y| (QREFELT $ 18))) - -(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| $) - (SPADCALL (SPADCALL 1 |x| (QREFELT $ 17)) |a| |i| (QREFELT $ 21))) - -(DEFUN |LNAGG-;maxIndex;AI;6| (|l| $) - (+ (- (SPADCALL |l| (QREFELT $ 23)) 1) (SPADCALL |l| (QREFELT $ 9)))) - -(DEFUN |LinearAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|LinearAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|LinearAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 26) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 - (LETT |pv$| - (|buildPredVector| 0 0 - (LIST (|HasAttribute| |#1| '|shallowlyMutable|))) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasAttribute| |#1| '|finiteAggregate|) - (QSETREFV $ 24 - (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) $)))) - $)))) - -(MAKEPROP '|LinearAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|Integer|) (0 . |minIndex|) (5 . |maxIndex|) (|List| 8) - |LNAGG-;indices;AL;1| (|Boolean|) (10 . |not|) - |LNAGG-;index?;IAB;2| (|NonNegativeInteger|) (15 . |new|) - (21 . |concat|) |LNAGG-;concat;ASA;3| - |LNAGG-;concat;S2A;4| (27 . |insert|) - |LNAGG-;insert;SAIA;5| (34 . |#|) (39 . |maxIndex|) - (|List| $)) - '#(|maxIndex| 44 |insert| 49 |indices| 56 |index?| 61 - |concat| 67) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 24 - '(1 6 8 0 9 1 6 8 0 10 1 13 0 0 14 2 6 - 0 16 7 17 2 6 0 0 0 18 3 6 0 0 0 8 21 - 1 6 16 0 23 1 0 8 0 24 1 0 8 0 24 3 0 - 0 7 0 8 22 1 0 11 0 12 2 0 13 8 0 15 - 2 0 0 0 7 19 2 0 0 7 0 20))))) - '|lookupComplete|)) -@ + \section{category FLAGG FiniteLinearAggregate} <<category FLAGG FiniteLinearAggregate>>= )abbrev category FLAGG FiniteLinearAggregate @@ -4717,860 +2383,7 @@ ListAggregate(S:Type): Category == Join(StreamAggregate S, false @ -\section{LSAGG.lsp BOOTSTRAP} -{\bf LSAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LSAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LSAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LSAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |ListAggregate;CAT| 'NIL) - -(DEFPARAMETER |ListAggregate;AL| 'NIL) - -(DEFUN |ListAggregate| (#0=#:G1431) - (LET (#1=#:G1432) - (COND - ((SETQ #1# (|assoc| (|devaluate| #0#) |ListAggregate;AL|)) - (CDR #1#)) - (T (SETQ |ListAggregate;AL| - (|cons5| (CONS (|devaluate| #0#) - (SETQ #1# (|ListAggregate;| #0#))) - |ListAggregate;AL|)) - #1#)))) - -(DEFUN |ListAggregate;| (|t#1|) - (PROG (#0=#:G1430) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1|) (LIST (|devaluate| |t#1|))) - (COND - (|ListAggregate;CAT|) - ('T - (LETT |ListAggregate;CAT| - (|Join| (|StreamAggregate| '|t#1|) - (|FiniteLinearAggregate| - '|t#1|) - (|ExtensibleLinearAggregate| - '|t#1|) - (|mkCategory| '|domain| - '(((|list| ($ |t#1|)) T)) NIL - 'NIL NIL)) - . #1=(|ListAggregate|))))) . #1#) - (SETELT #0# 0 (LIST '|ListAggregate| (|devaluate| |t#1|))))))) -@ -\section{LSAGG-.lsp BOOTSTRAP} -{\bf LSAGG-} depends on {\bf LSAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LSAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LSAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<LSAGG-.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| $) - (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) - -(DEFUN |LSAGG-;list;SA;2| (|x| $) - (SPADCALL |x| (SPADCALL (QREFELT $ 12)) (QREFELT $ 13))) - -(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| $) - (COND - ((SPADCALL |x| (QREFELT $ 16)) - (|error| "reducing over an empty list needs the 3 argument form")) - ('T - (SPADCALL |f| (SPADCALL |x| (QREFELT $ 17)) - (SPADCALL |x| (QREFELT $ 18)) (QREFELT $ 20))))) - -(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| $) - (SPADCALL |f| (SPADCALL |p| (QREFELT $ 22)) - (SPADCALL |q| (QREFELT $ 22)) (QREFELT $ 23))) - -(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| $) - (PROG (|y| |z|) - (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) |x|) - ('T - (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) - (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |z| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL - (SPADCALL |z| (QREFELT $ 18)) - |f|) - (SEQ - (LETT |y| |z| - |LSAGG-;select!;M2A;5|) - (EXIT - (LETT |z| - (SPADCALL |z| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|)))) - ('T - (SEQ - (LETT |z| - (SPADCALL |z| (QREFELT $ 17)) - |LSAGG-;select!;M2A;5|) - (EXIT - (SPADCALL |y| |z| - (QREFELT $ 26)))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| $) - (PROG (|r| |t|) - (RETURN - (SEQ (COND - ((SPADCALL |p| (QREFELT $ 16)) |q|) - ((SPADCALL |q| (QREFELT $ 16)) |p|) - ((SPADCALL |p| |q| (QREFELT $ 29)) - (|error| "cannot merge a list into itself")) - ('T - (SEQ (COND - ((SPADCALL (SPADCALL |p| (QREFELT $ 18)) - (SPADCALL |q| (QREFELT $ 18)) |f|) - (SEQ (LETT |r| - (LETT |t| |p| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |p| - (SPADCALL |p| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|)))) - ('T - (SEQ (LETT |r| - (LETT |t| |q| |LSAGG-;merge!;M3A;6|) - |LSAGG-;merge!;M3A;6|) - (EXIT (LETT |q| - (SPADCALL |q| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|))))) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |p| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL |q| (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (COND - ((SPADCALL - (SPADCALL |p| (QREFELT $ 18)) - (SPADCALL |q| (QREFELT $ 18)) - |f|) - (SEQ - (SPADCALL |t| |p| - (QREFELT $ 26)) - (LETT |t| |p| - |LSAGG-;merge!;M3A;6|) - (EXIT - (LETT |p| - (SPADCALL |p| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|)))) - ('T - (SEQ - (SPADCALL |t| |q| - (QREFELT $ 26)) - (LETT |t| |q| - |LSAGG-;merge!;M3A;6|) - (EXIT - (LETT |q| - (SPADCALL |q| (QREFELT $ 17)) - |LSAGG-;merge!;M3A;6|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (SPADCALL |t| - (COND - ((SPADCALL |p| (QREFELT $ 16)) |q|) - ('T |p|)) - (QREFELT $ 26)) - (EXIT |r|)))))))) - -(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| $) - (PROG (|m| #0=#:G1464 |y| |z|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;insert!;SAIA;7|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |s| |x| (QREFELT $ 13))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# (- (- |i| 1) |m|) - |LSAGG-;insert!;SAIA;7|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;insert!;SAIA;7|) - (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;insert!;SAIA;7|) - (SPADCALL |y| - (SPADCALL |s| |z| (QREFELT $ 13)) - (QREFELT $ 26)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| $) - (PROG (|m| #0=#:G1468 |y| |z|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;insert!;2AIA;8|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |w| |x| (QREFELT $ 35))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# (- (- |i| 1) |m|) - |LSAGG-;insert!;2AIA;8|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;insert!;2AIA;8|) - (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;insert!;2AIA;8|) - (SPADCALL |y| |w| (QREFELT $ 26)) - (SPADCALL |y| |z| (QREFELT $ 35)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| $) - (PROG (|p| |q|) - (RETURN - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|)))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;remove!;M2A;9|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) |x|) - ('T - (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) - (LETT |q| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;remove!;M2A;9|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |q| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT - (COND - ((SPADCALL - (SPADCALL |q| (QREFELT $ 18)) - |f|) - (LETT |q| - (SPADCALL |p| - (SPADCALL |q| (QREFELT $ 17)) - (QREFELT $ 26)) - |LSAGG-;remove!;M2A;9|)) - ('T - (SEQ - (LETT |p| |q| - |LSAGG-;remove!;M2A;9|) - (EXIT - (LETT |q| - (SPADCALL |q| (QREFELT $ 17)) - |LSAGG-;remove!;M2A;9|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| $) - (PROG (|m| #0=#:G1480 |y|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;delete!;AIA;10|) - (EXIT (COND - ((< |i| |m|) (|error| "index out of range")) - ((EQL |i| |m|) (SPADCALL |x| (QREFELT $ 17))) - ('T - (SEQ (LETT |y| - (SPADCALL |x| - (PROG1 - (LETT #0# (- (- |i| 1) |m|) - |LSAGG-;delete!;AIA;10|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;delete!;AIA;10|) - (SPADCALL |y| (SPADCALL |y| 2 (QREFELT $ 33)) - (QREFELT $ 26)) - (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| $) - (PROG (|l| |m| |h| #0=#:G1485 #1=#:G1486 |t| #2=#:G1487) - (RETURN - (SEQ (LETT |l| (SPADCALL |i| (QREFELT $ 40)) - |LSAGG-;delete!;AUsA;11|) - (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |l| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |h| - (COND - ((SPADCALL |i| (QREFELT $ 41)) - (SPADCALL |i| (QREFELT $ 42))) - ('T (SPADCALL |x| (QREFELT $ 43)))) - |LSAGG-;delete!;AUsA;11|) - (EXIT (COND - ((< |h| |l|) |x|) - ((EQL |l| |m|) - (SPADCALL |x| - (PROG1 - (LETT #0# (- (+ |h| 1) |m|) - |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33))) - ('T - (SEQ (LETT |t| - (SPADCALL |x| - (PROG1 - (LETT #1# (- (- |l| 1) |m|) - |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #1# 0) - '(|NonNegativeInteger|) - #1#)) - (QREFELT $ 33)) - |LSAGG-;delete!;AUsA;11|) - (SPADCALL |t| - (SPADCALL |t| - (PROG1 - (LETT #2# (+ (- |h| |l|) 2) - |LSAGG-;delete!;AUsA;11|) - (|check-subtype| (>= #2# 0) - '(|NonNegativeInteger|) - #2#)) - (QREFELT $ 33)) - (QREFELT $ 26)) - (EXIT |x|))))))))))))) - -(DEFUN |LSAGG-;find;MAU;12| (|f| |x| $) - (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;find;MAU;12|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) (CONS 1 "failed")) - ('T (CONS 0 (SPADCALL |x| (QREFELT $ 18)))))))) - -(DEFUN |LSAGG-;position;MAI;13| (|f| |x| $) - (PROG (|k|) - (RETURN - (SEQ (SEQ (LETT |k| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;position;MAI;13|) - G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - |f|) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;position;MAI;13|))) - (LETT |k| (+ |k| 1) |LSAGG-;position;MAI;13|) (GO G190) - G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) - (- (SPADCALL |x| (QREFELT $ 32)) 1)) - ('T |k|))))))) - -(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| $) - (PROG (#0=#:G1507 |l| |q|) - (RETURN - (SEQ (COND - ((EQL |n| 2) - (COND - ((SPADCALL - (SPADCALL (SPADCALL |p| (QREFELT $ 17)) - (QREFELT $ 18)) - (SPADCALL |p| (QREFELT $ 18)) |f|) - (LETT |p| (SPADCALL |p| (QREFELT $ 48)) - |LSAGG-;mergeSort|))))) - (EXIT (COND - ((< |n| 3) |p|) - ('T - (SEQ (LETT |l| - (PROG1 (LETT #0# (QUOTIENT2 |n| 2) - |LSAGG-;mergeSort|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - |LSAGG-;mergeSort|) - (LETT |q| (SPADCALL |p| |l| (QREFELT $ 49)) - |LSAGG-;mergeSort|) - (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| $) - |LSAGG-;mergeSort|) - (LETT |q| - (|LSAGG-;mergeSort| |f| |q| (- |n| |l|) - $) - |LSAGG-;mergeSort|) - (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 23))))))))))) - -(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| $) - (PROG (#0=#:G1516 |p|) - (RETURN - (SEQ (EXIT (COND - ((SPADCALL |l| (QREFELT $ 16)) 'T) - ('T - (SEQ (LETT |p| (SPADCALL |l| (QREFELT $ 17)) - |LSAGG-;sorted?;MAB;15|) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |p| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT - (COND - ((NULL - (SPADCALL - (SPADCALL |l| (QREFELT $ 18)) - (SPADCALL |p| (QREFELT $ 18)) - |f|)) - (PROGN - (LETT #0# 'NIL - |LSAGG-;sorted?;MAB;15|) - (GO #0#))) - ('T - (LETT |p| - (SPADCALL - (LETT |l| |p| - |LSAGG-;sorted?;MAB;15|) - (QREFELT $ 17)) - |LSAGG-;sorted?;MAB;15|))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT 'T))))) - #0# (EXIT #0#))))) - -(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (LETT |r| - (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) - |f|) - |LSAGG-;reduce;MA2S;16|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;reduce;MA2S;16|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| $) - (PROG (|r|) - (RETURN - (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL (SPADCALL |r| |a| (QREFELT $ 52)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (LETT |r| - (SPADCALL |r| (SPADCALL |x| (QREFELT $ 18)) - |f|) - |LSAGG-;reduce;MA3S;17|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;reduce;MA3S;17|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |r|))))) - -(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| $) - (PROG (|k| |l|) - (RETURN - (SEQ (LETT |l| (SPADCALL (QREFELT $ 12)) |LSAGG-;new;NniSA;18|) - (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 - (COND ((QSGREATERP |k| |n|) (GO G191))) - (SEQ (EXIT (LETT |l| (SPADCALL |s| |l| (QREFELT $ 13)) - |LSAGG-;new;NniSA;18|))) - (LETT |k| (QSADD1 |k|) |LSAGG-;new;NniSA;18|) (GO G190) - G191 (EXIT NIL)) - (EXIT |l|))))) - -(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| $) - (PROG (|z|) - (RETURN - (SEQ (LETT |z| (SPADCALL (QREFELT $ 12)) |LSAGG-;map;M3A;19|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) 'NIL) - ('T - (SPADCALL (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (LETT |z| - (SPADCALL - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) - (SPADCALL |y| (QREFELT $ 18)) |f|) - |z| (QREFELT $ 13)) - |LSAGG-;map;M3A;19|) - (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;map;M3A;19|) - (EXIT (LETT |y| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;map;M3A;19|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (SPADCALL |z| (QREFELT $ 48))))))) - -(DEFUN |LSAGG-;reverse!;2A;20| (|x| $) - (PROG (|z| |y|) - (RETURN - (SEQ (COND - ((OR (SPADCALL |x| (QREFELT $ 16)) - (SPADCALL - (LETT |y| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;reverse!;2A;20|) - (QREFELT $ 16))) - |x|) - ('T - (SEQ (SPADCALL |x| (SPADCALL (QREFELT $ 12)) - (QREFELT $ 26)) - (SEQ G190 - (COND - ((NULL (SPADCALL - (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (LETT |z| (SPADCALL |y| (QREFELT $ 17)) - |LSAGG-;reverse!;2A;20|) - (SPADCALL |y| |x| (QREFELT $ 26)) - (LETT |x| |y| |LSAGG-;reverse!;2A;20|) - (EXIT (LETT |y| |z| - |LSAGG-;reverse!;2A;20|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |x|)))))))) - -(DEFUN |LSAGG-;copy;2A;21| (|x| $) - (PROG (|k| |y|) - (RETURN - (SEQ (LETT |y| (SPADCALL (QREFELT $ 12)) |LSAGG-;copy;2A;21|) - (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 - (COND - ((NULL (SPADCALL (SPADCALL |x| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (COND - ((EQL |k| 1000) - (COND - ((SPADCALL |x| (QREFELT $ 57)) - (EXIT (|error| "cyclic list")))))) - (LETT |y| - (SPADCALL (SPADCALL |x| (QREFELT $ 18)) |y| - (QREFELT $ 13)) - |LSAGG-;copy;2A;21|) - (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;copy;2A;21|))) - (LETT |k| (QSADD1 |k|) |LSAGG-;copy;2A;21|) (GO G190) - G191 (EXIT NIL)) - (EXIT (SPADCALL |y| (QREFELT $ 48))))))) - -(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| $) - (PROG (|m| #0=#:G1545 |z|) - (RETURN - (SEQ (LETT |m| (SPADCALL |y| (QREFELT $ 32)) - |LSAGG-;copyInto!;2AIA;22|) - (EXIT (COND - ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |z| - (SPADCALL |y| - (PROG1 - (LETT #0# (- |s| |m|) - |LSAGG-;copyInto!;2AIA;22|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;copyInto!;2AIA;22|) - (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |z| (QREFELT $ 16)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |x| - (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (SPADCALL |z| - (SPADCALL |x| (QREFELT $ 18)) - (QREFELT $ 59)) - (LETT |x| - (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;copyInto!;2AIA;22|) - (EXIT - (LETT |z| - (SPADCALL |z| (QREFELT $ 17)) - |LSAGG-;copyInto!;2AIA;22|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |y|))))))))) - -(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| $) - (PROG (|m| #0=#:G1552 |k|) - (RETURN - (SEQ (LETT |m| (SPADCALL |x| (QREFELT $ 32)) - |LSAGG-;position;SA2I;23|) - (EXIT (COND - ((< |s| |m|) (|error| "index out of range")) - ('T - (SEQ (LETT |x| - (SPADCALL |x| - (PROG1 - (LETT #0# (- |s| |m|) - |LSAGG-;position;SA2I;23|) - (|check-subtype| (>= #0# 0) - '(|NonNegativeInteger|) #0#)) - (QREFELT $ 33)) - |LSAGG-;position;SA2I;23|) - (SEQ (LETT |k| |s| |LSAGG-;position;SA2I;23|) - G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |w| - (SPADCALL |x| - (QREFELT $ 18)) - (QREFELT $ 52)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT - (LETT |x| - (SPADCALL |x| (QREFELT $ 17)) - |LSAGG-;position;SA2I;23|))) - (LETT |k| (+ |k| 1) - |LSAGG-;position;SA2I;23|) - (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) - (- (SPADCALL |x| (QREFELT $ 32)) 1)) - ('T |k|))))))))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| $) - (PROG (|p|) - (RETURN - (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) - (SEQ G190 - (COND - ((NULL (SPADCALL (SPADCALL |p| (QREFELT $ 16)) - (QREFELT $ 25))) - (GO G191))) - (SEQ (EXIT (LETT |p| - (SPADCALL |p| - (SPADCALL - (CONS - #'|LSAGG-;removeDuplicates!;2A;24!0| - (VECTOR $ |p|)) - (SPADCALL |p| (QREFELT $ 17)) - (QREFELT $ 62)) - (QREFELT $ 26)) - |LSAGG-;removeDuplicates!;2A;24|))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT |l|))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| $$) - (PROG ($) - (LETT $ (QREFELT $$ 0) |LSAGG-;removeDuplicates!;2A;24|) - (RETURN - (PROGN - (SPADCALL |#1| (SPADCALL (QREFELT $$ 1) (QREFELT $ 18)) - (QREFELT $ 52)))))) - -(DEFUN |LSAGG-;<;2AB;25| (|x| |y| $) - (PROG (#0=#:G1566) - (RETURN - (SEQ (EXIT (SEQ (SEQ G190 - (COND - ((NULL (COND - ((SPADCALL |x| (QREFELT $ 16)) - 'NIL) - ('T - (SPADCALL - (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))))) - (GO G191))) - (SEQ (EXIT (COND - ((NULL - (SPADCALL - (SPADCALL |x| - (QREFELT $ 18)) - (SPADCALL |y| - (QREFELT $ 18)) - (QREFELT $ 52))) - (PROGN - (LETT #0# - (SPADCALL - (SPADCALL |x| - (QREFELT $ 18)) - (SPADCALL |y| - (QREFELT $ 18)) - (QREFELT $ 64)) - |LSAGG-;<;2AB;25|) - (GO #0#))) - ('T - (SEQ - (LETT |x| - (SPADCALL |x| - (QREFELT $ 17)) - |LSAGG-;<;2AB;25|) - (EXIT - (LETT |y| - (SPADCALL |y| - (QREFELT $ 17)) - |LSAGG-;<;2AB;25|))))))) - NIL (GO G190) G191 (EXIT NIL)) - (EXIT (COND - ((SPADCALL |x| (QREFELT $ 16)) - (SPADCALL (SPADCALL |y| (QREFELT $ 16)) - (QREFELT $ 25))) - ('T 'NIL))))) - #0# (EXIT #0#))))) - -(DEFUN |ListAggregate&| (|#1| |#2|) - (PROG (|dv$1| |dv$2| |dv$| $ |pv$|) - (RETURN - (PROGN - (LETT |dv$1| (|devaluate| |#1|) . #0=(|ListAggregate&|)) - (LETT |dv$2| (|devaluate| |#2|) . #0#) - (LETT |dv$| (LIST '|ListAggregate&| |dv$1| |dv$2|) . #0#) - (LETT $ (GETREFV 67) . #0#) - (QSETREFV $ 0 |dv$|) - (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#)) - (|stuffDomainSlots| $) - (QSETREFV $ 6 |#1|) - (QSETREFV $ 7 |#2|) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (QSETREFV $ 53 - (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) $)))) - (COND - ((|HasCategory| |#2| '(|SetCategory|)) - (PROGN - (QSETREFV $ 61 - (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) - $)) - (QSETREFV $ 63 - (CONS (|dispatchFunction| - |LSAGG-;removeDuplicates!;2A;24|) - $))))) - (COND - ((|HasCategory| |#2| '(|OrderedSet|)) - (QSETREFV $ 65 - (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) $)))) - $)))) - -(MAKEPROP '|ListAggregate&| '|infovec| - (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) - (|NonNegativeInteger|) (0 . |#|) (|Mapping| 15 7 7) - |LSAGG-;sort!;M2A;1| (5 . |empty|) (9 . |concat|) - |LSAGG-;list;SA;2| (|Boolean|) (15 . |empty?|) - (20 . |rest|) (25 . |first|) (|Mapping| 7 7 7) - (30 . |reduce|) |LSAGG-;reduce;MAS;3| (37 . |copy|) - (42 . |merge!|) |LSAGG-;merge;M3A;4| (49 . |not|) - (54 . |setrest!|) (|Mapping| 15 7) |LSAGG-;select!;M2A;5| - (60 . |eq?|) |LSAGG-;merge!;M3A;6| (|Integer|) - (66 . |minIndex|) (71 . |rest|) |LSAGG-;insert!;SAIA;7| - (77 . |concat!|) |LSAGG-;insert!;2AIA;8| - |LSAGG-;remove!;M2A;9| |LSAGG-;delete!;AIA;10| - (|UniversalSegment| 31) (83 . |lo|) (88 . |hasHi|) - (93 . |hi|) (98 . |maxIndex|) |LSAGG-;delete!;AUsA;11| - (|Union| 7 '"failed") |LSAGG-;find;MAU;12| - |LSAGG-;position;MAI;13| (103 . |reverse!|) - (108 . |split!|) |LSAGG-;sorted?;MAB;15| - |LSAGG-;reduce;MA2S;16| (114 . =) (120 . |reduce|) - |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| - |LSAGG-;reverse!;2A;20| (128 . |cyclic?|) - |LSAGG-;copy;2A;21| (133 . |setfirst!|) - |LSAGG-;copyInto!;2AIA;22| (139 . |position|) - (146 . |remove!|) (152 . |removeDuplicates!|) (157 . <) - (163 . <) (|Mapping| 7 7)) - '#(|sorted?| 169 |sort!| 175 |select!| 181 |reverse!| 187 - |removeDuplicates!| 192 |remove!| 197 |reduce| 203 - |position| 224 |new| 237 |merge!| 243 |merge| 250 |map| - 257 |list| 264 |insert!| 269 |find| 283 |delete!| 289 - |copyInto!| 301 |copy| 308 < 313) - 'NIL - (CONS (|makeByteWordVec2| 1 'NIL) - (CONS '#() - (CONS '#() - (|makeByteWordVec2| 65 - '(1 6 8 0 9 0 6 0 12 2 6 0 7 0 13 1 6 - 15 0 16 1 6 0 0 17 1 6 7 0 18 3 6 7 - 19 0 7 20 1 6 0 0 22 3 6 0 10 0 0 23 - 1 15 0 0 25 2 6 0 0 0 26 2 6 15 0 0 - 29 1 6 31 0 32 2 6 0 0 8 33 2 6 0 0 0 - 35 1 39 31 0 40 1 39 15 0 41 1 39 31 - 0 42 1 6 31 0 43 1 6 0 0 48 2 6 0 0 - 31 49 2 7 15 0 0 52 4 0 7 19 0 7 7 53 - 1 6 15 0 57 2 6 7 0 7 59 3 0 31 7 0 - 31 61 2 6 0 27 0 62 1 0 0 0 63 2 7 15 - 0 0 64 2 0 15 0 0 65 2 0 15 10 0 50 2 - 0 0 10 0 11 2 0 0 27 0 28 1 0 0 0 56 - 1 0 0 0 63 2 0 0 27 0 37 3 0 7 19 0 7 - 51 4 0 7 19 0 7 7 53 2 0 7 19 0 21 2 - 0 31 27 0 47 3 0 31 7 0 31 61 2 0 0 8 - 7 54 3 0 0 10 0 0 30 3 0 0 10 0 0 24 - 3 0 0 19 0 0 55 1 0 0 7 14 3 0 0 7 0 - 31 34 3 0 0 0 0 31 36 2 0 45 27 0 46 - 2 0 0 0 39 44 2 0 0 0 31 38 3 0 0 0 0 - 31 60 1 0 0 0 58 2 0 15 0 0 65))))) - '|lookupComplete|)) -@ + \section{category ALAGG AssociationListAggregate} <<category ALAGG AssociationListAggregate>>= )abbrev category ALAGG AssociationListAggregate @@ -5594,72 +2407,7 @@ AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category == ++ with key k, or "failed" if u has no key k. @ -\section{ALAGG.lsp BOOTSTRAP} -{\bf ALAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ALAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ALAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<<ALAGG.lsp BOOTSTRAP>>= - -(/VERSIONCHECK 2) - -(DEFPARAMETER |AssociationListAggregate;CAT| 'NIL) - -(DEFPARAMETER |AssociationListAggregate;AL| 'NIL) - -(DEFUN |AssociationListAggregate| (&REST #0=#:G1397 &AUX #1=#:G1395) - (DSETQ #1# #0#) - (LET (#2=#:G1396) - (COND - ((SETQ #2# - (|assoc| (|devaluateList| #1#) - |AssociationListAggregate;AL|)) - (CDR #2#)) - (T (SETQ |AssociationListAggregate;AL| - (|cons5| (CONS (|devaluateList| #1#) - (SETQ #2# - (APPLY - #'|AssociationListAggregate;| #1#))) - |AssociationListAggregate;AL|)) - #2#)))) - -(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) - (PROG (#0=#:G1394) - (RETURN - (PROG1 (LETT #0# - (|sublisV| - (PAIR '(|t#1| |t#2|) - (LIST (|devaluate| |t#1|) - (|devaluate| |t#2|))) - (|sublisV| - (PAIR '(#1=#:G1393) - (LIST '(|Record| (|:| |key| |t#1|) - (|:| |entry| |t#2|)))) - (COND - (|AssociationListAggregate;CAT|) - ('T - (LETT |AssociationListAggregate;CAT| - (|Join| - (|TableAggregate| '|t#1| '|t#2|) - (|ListAggregate| '#1#) - (|mkCategory| '|domain| - '(((|assoc| - ((|Union| - (|Record| (|:| |key| |t#1|) - (|:| |entry| |t#2|)) - "failed") - |t#1| $)) - T)) - NIL 'NIL NIL)) - . #2=(|AssociationListAggregate|)))))) . #2#) - (SETELT #0# 0 - (LIST '|AssociationListAggregate| (|devaluate| |t#1|) - (|devaluate| |t#2|))))))) -@ + \section{category SRAGG StringAggregate} <<category SRAGG StringAggregate>>= )abbrev category SRAGG StringAggregate |