aboutsummaryrefslogtreecommitdiff
path: root/src/algebra/aggcat.spad.pamphlet
diff options
context:
space:
mode:
Diffstat (limited to 'src/algebra/aggcat.spad.pamphlet')
-rw-r--r--src/algebra/aggcat.spad.pamphlet3268
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