\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra aggcat.spad}
\author{Michael Monagan, Manuel Bronstein, Richard Jenks, Stephen Watt}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{category AGG Aggregate}
<<category AGG Aggregate>>=

)abbrev category AGG Aggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ The notion of aggregate serves to model any data structure aggregate,
++ designating any collection of objects,
++ with heterogenous or homogeneous members,
++ with a finite or infinite number
++ of members, explicitly or implicitly represented.
++ An aggregate can in principle
++ represent everything from a string of characters to abstract sets such
++ as "the set of x satisfying relation {\em r(x)}"
++ An attribute \spadatt{finiteAggregate} is used to assert that a domain
++ has a finite number of elements.
Aggregate: Category == Type with
   eq?: (%,%) -> Boolean
     ++ eq?(u,v) tests if u and v are same objects.
   copy: % -> %
     ++ copy(u) returns a top-level (non-recursive) copy of u.
     ++ Note: for collections, \axiom{copy(u) == [x for x in u]}.
   empty: () -> %
     ++ empty()$D creates an aggregate of type D with 0 elements.
     ++ Note: The {\em $D} can be dropped if understood by context,
     ++ e.g. \axiom{u: D := empty()}.
   empty?: % -> Boolean
     ++ empty?(u) tests if u has 0 elements.
   less?: (%,NonNegativeInteger) -> Boolean
     ++ less?(u,n) tests if u has less than n elements.
   more?: (%,NonNegativeInteger) -> Boolean
     ++ more?(u,n) tests if u has greater than n elements.
   size?: (%,NonNegativeInteger) -> Boolean
     ++ size?(u,n) tests if u has exactly n elements.
   sample: constant -> %    ++ sample yields a value of type %
   if % has finiteAggregate then
     "#": % -> NonNegativeInteger     ++ # u returns the number of items in u.
 add
  eq?(a,b) == EQ(a,b)$Lisp
  sample() == empty()
  if % has finiteAggregate then
    empty? a   == #a = 0
    less?(a,n) == #a < n
    more?(a,n) == #a > n
    size?(a,n) == #a = n

@
\section{category HOAGG HomogeneousAggregate}
<<category HOAGG HomogeneousAggregate>>=
)abbrev category HOAGG HomogeneousAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991, May 1995
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A homogeneous aggregate is an aggregate of elements all of the
++ same type.
++ In the current system, all aggregates are homogeneous.
++ Two attributes characterize classes of aggregates.
++ Aggregates from domains with attribute \spadatt{finiteAggregate}
++ have a finite number of members.
++ Those with attribute \spadatt{shallowlyMutable} allow an element
++ to be modified or updated without changing its overall value.
HomogeneousAggregate(S:Type): Category == Aggregate with
   if S has CoercibleTo(OutputForm) then CoercibleTo(OutputForm)
   if S has SetCategory then SetCategory
   if S has SetCategory then
      if S has Evalable S then Evalable S
   map	   : (S->S,%) -> %
     ++ map(f,u) returns a copy of u with each element x replaced by f(x).
     ++ For collections, \axiom{map(f,u) = [f(x) for x in u]}.
   if % has shallowlyMutable then
     map_!: (S->S,%) -> %
	++ map!(f,u) destructively replaces each element x of u by \axiom{f(x)}.
   if % has finiteAggregate then
      any?: (S->Boolean,%) -> Boolean
	++ any?(p,u) tests if \axiom{p(x)} is true for any element x of u.
	++ Note: for collections,
	++ \axiom{any?(p,u) = reduce(or,map(f,u),false,true)}.
      every?: (S->Boolean,%) -> Boolean
	++ every?(f,u) tests if p(x) is true for all elements x of u.
	++ Note: for collections,
	++ \axiom{every?(p,u) = reduce(and,map(f,u),true,false)}.
      count: (S->Boolean,%) -> NonNegativeInteger
	++ count(p,u) returns the number of elements x in u
	++ such that \axiom{p(x)} is true. For collections,
	++ \axiom{count(p,u) = reduce(+,[1 for x in u | p(x)],0)}.
      parts: % -> List S
	++ parts(u) returns a list of the consecutive elements of u.
	++ For collections, \axiom{parts([x,y,...,z]) = (x,y,...,z)}.
      members: % -> List S
	++ members(u) returns a list of the consecutive elements of u.
	++ For collections, \axiom{parts([x,y,...,z]) = (x,y,...,z)}.
      if S has SetCategory then
	count: (S,%) -> NonNegativeInteger
	  ++ count(x,u) returns the number of occurrences of x in u.
	  ++ For collections, \axiom{count(x,u) = reduce(+,[x=y for y in u],0)}.
	member?: (S,%) -> Boolean
	  ++ member?(x,u) tests if x is a member of u.
	  ++ For collections,
	  ++ \axiom{member?(x,u) = reduce(or,[x=y for y in u],false)}.
  add
   if S has Evalable S then
     eval(u:%,l:List Equation S):% == map(eval(#1,l),u)
   if % has finiteAggregate then
     #c			  == # parts c
     any?(f, c)		  == _or/[f x for x in parts c]
     every?(f, c)	  == _and/[f x for x in parts c]
     count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x]
     members x		  == parts x
     if S has SetCategory then
       count(s:S, x:%) == count(s = #1, x)
       member?(e, c)   == any?(e = #1,c)
       x = y ==
	  size?(x, #y) and _and/[a = b for a in parts x for b in parts y]
     if S has CoercibleTo(OutputForm) then
       coerce(x:%):OutputForm ==
	 bracket
	    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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A collection is a homogeneous aggregate which can built from
++ list of members. The operation used to build the aggregate is
++ generically named \spadfun{construct}. However, each collection
++ provides its own special function with the same name as the
++ data type, except with an initial lower case letter, e.g.
++ \spadfun{list} for \spadtype{List},
++ \spadfun{flexibleArray} for \spadtype{FlexibleArray}, and so on.
Collection(S:Type): Category == HomogeneousAggregate(S) with
   construct: List S -> %
     ++ \axiom{construct(x,y,...,z)} returns the collection of elements \axiom{x,y,...,z}
     ++ ordered as given. Equivalently written as \axiom{[x,y,...,z]$D}, where
     ++ D is the domain. D may be omitted for those of type List.
   find: (S->Boolean, %) -> Union(S, "failed")
     ++ find(p,u) returns the first x in u such that \axiom{p(x)} is true, and
     ++ "failed" otherwise.
   if % has finiteAggregate then
      reduce: ((S,S)->S,%) -> S
	++ reduce(f,u) reduces the binary operation f across u. For example,
	++ if u is \axiom{[x,y,...,z]} then \axiom{reduce(f,u)} returns \axiom{f(..f(f(x,y),...),z)}.
	++ Note: if u has one element x, \axiom{reduce(f,u)} returns x.
	++ Error: if u is empty.
      reduce: ((S,S)->S,%,S) -> S
	++ reduce(f,u,x) reduces the binary operation f across u, where x is
	++ the identity operation of f.
	++ Same as \axiom{reduce(f,u)} if u has 2 or more elements.
	++ Returns \axiom{f(x,y)} if u has one element y,
	++ x if u is empty.
	++ For example, \axiom{reduce(+,u,0)} returns the
	++ sum of the elements of u.
      remove: (S->Boolean,%) -> %
	++ remove(p,u) returns a copy of u removing all elements x such that
	++ \axiom{p(x)} is true.
	++ Note: \axiom{remove(p,u) == [x for x in u | not p(x)]}.
      select: (S->Boolean,%) -> %
	++ select(p,u) returns a copy of u containing only those elements such
	++ \axiom{p(x)} is true.
	++ Note: \axiom{select(p,u) == [x for x in u | p(x)]}.
      if S has SetCategory then
	reduce: ((S,S)->S,%,S,S) -> S
	  ++ reduce(f,u,x,z) reduces the binary operation f across u, stopping
	  ++ when an "absorbing element" z is encountered.
	  ++ As for \axiom{reduce(f,u,x)}, x is the identity operation of f.
	  ++ Same as \axiom{reduce(f,u,x)} when u contains no element z.
	  ++ Thus the third argument x is returned when u is empty.
	remove: (S,%) -> %
	  ++ remove(x,u) returns a copy of u with all
	  ++ elements \axiom{y = x} removed.
	  ++ Note: \axiom{remove(y,c) == [x for x in c | x ^= y]}.
	removeDuplicates: % -> %
	  ++ removeDuplicates(u) returns a copy of u with all duplicates removed.
   if S has ConvertibleTo InputForm then ConvertibleTo InputForm
 add
   if % has finiteAggregate then
     #c			  == # parts c
     count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x]
     any?(f, c)		  == _or/[f x for x in parts c]
     every?(f, c)	  == _and/[f x for x in parts c]
     find(f:S -> Boolean, c:%) == find(f, parts c)
     reduce(f:(S,S)->S, x:%) == reduce(f, parts x)
     reduce(f:(S,S)->S, x:%, s:S) == reduce(f, parts x, s)
     remove(f:S->Boolean, x:%) ==
       construct remove(f, parts x)
     select(f:S->Boolean, x:%) ==
       construct select(f, parts x)

     if S has SetCategory then
       remove(s:S, x:%) == remove(#1 = s, x)
       reduce(f:(S,S)->S, x:%, s1:S, s2:S) == reduce(f, parts x, s1, s2)
       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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A bag aggregate is an aggregate for which one can insert and extract objects,
++ and where the order in which objects are inserted determines the order
++ of extraction.
++ Examples of bags are stacks, queues, and dequeues.
BagAggregate(S:Type): Category == HomogeneousAggregate S with
   shallowlyMutable
     ++ shallowlyMutable means that elements of bags may be destructively changed.
   bag: List S -> %
     ++ bag([x,y,...,z]) creates a bag with elements x,y,...,z.
   extract_!: % -> S
     ++ extract!(u) destructively removes a (random) item from bag u.
   insert_!: (S,%) -> %
     ++ insert!(x,u) inserts item x into bag u.
   inspect: % -> S
     ++ inspect(u) returns an (random) element from a bag.
 add
   bag(l) ==
     x:=empty()
     for s in l repeat x:=insert_!(s,x)
     x

@
\section{category SKAGG StackAggregate}
<<category SKAGG StackAggregate>>=
)abbrev category SKAGG StackAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A stack is a bag where the last item inserted is the first item extracted.
StackAggregate(S:Type): Category == BagAggregate S with
   finiteAggregate
   push_!: (S,%) -> S
     ++ push!(x,s) pushes x onto stack s, i.e. destructively changing s
     ++ so as to have a new first (top) element x.
     ++ Afterwards, pop!(s) produces x and pop!(s) produces the original s.
   pop_!: % -> S
     ++ pop!(s) returns the top element x, destructively removing x from s.
     ++ Note: Use \axiom{top(s)} to obtain x without removing it from s.
     ++ Error: if s is empty.
   top: % -> S
     ++ top(s) returns the top element x from s; s remains unchanged.
     ++ Note: Use \axiom{pop!(s)} to obtain x and remove it from s.
   depth: % -> NonNegativeInteger
     ++ depth(s) returns the number of elements of stack s.
     ++ Note: \axiom{depth(s) = #s}.


@
\section{category QUAGG QueueAggregate}
<<category QUAGG QueueAggregate>>=
)abbrev category QUAGG QueueAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A queue is a bag where the first item inserted is the first item extracted.
QueueAggregate(S:Type): Category == BagAggregate S with
   finiteAggregate
   enqueue_!: (S, %) -> S
     ++ enqueue!(x,q) inserts x into the queue q at the back end.
   dequeue_!: % -> S
     ++ dequeue! s destructively extracts the first (top) element from queue q.
     ++ The element previously second in the queue becomes the first element.
     ++ Error: if q is empty.
   rotate_!: % -> %
     ++ rotate! q rotates queue q so that the element at the front of
     ++ the queue goes to the back of the queue.
     ++ Note: rotate! q is equivalent to enqueue!(dequeue!(q)).
   length: % -> NonNegativeInteger
     ++ length(q) returns the number of elements in the queue.
     ++ Note: \axiom{length(q) = #q}.
   front: % -> S
     ++ front(q) returns the element at the front of the queue.
     ++ The queue q is unchanged by this operation.
     ++ Error: if q is empty.
   back: % -> S
     ++ back(q) returns the element at the back of the queue.
     ++ The queue q is unchanged by this operation.
     ++ Error: if q is empty.

@
\section{category DQAGG DequeueAggregate}
<<category DQAGG DequeueAggregate>>=
)abbrev category DQAGG DequeueAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A dequeue is a doubly ended stack, that is, a bag where first items
++ inserted are the first items extracted, at either the front or the back end
++ of the data structure.
DequeueAggregate(S:Type):
 Category == Join(StackAggregate S,QueueAggregate S) with
   dequeue: () -> %
     ++ dequeue()$D creates an empty dequeue of type D.
   dequeue: List S -> %
     ++ dequeue([x,y,...,z]) creates a dequeue with first (top or front)
     ++ element x, second element y,...,and last (bottom or back) element z.
   height: % -> NonNegativeInteger
     ++ height(d) returns the number of elements in dequeue d.
     ++ Note: \axiom{height(d) = # d}.
   top_!: % -> S
     ++ top!(d) returns the element at the top (front) of the dequeue.
   bottom_!: % -> S
     ++ bottom!(d) returns the element at the bottom (back) of the dequeue.
   insertTop_!: (S,%) -> S
     ++ insertTop!(x,d) destructively inserts x into the dequeue d, that is,
     ++ at the top (front) of the dequeue.
     ++ The element previously at the top of the dequeue becomes the
     ++ second in the dequeue, and so on.
   insertBottom_!: (S,%) -> S
     ++ insertBottom!(x,d) destructively inserts x into the dequeue d
     ++ at the bottom (back) of the dequeue.
   extractTop_!: % -> S
     ++ extractTop!(d) destructively extracts the top (front) element
     ++ from the dequeue d.
     ++ Error: if d is empty.
   extractBottom_!: % -> S
     ++ extractBottom!(d) destructively extracts the bottom (back) element
     ++ from the dequeue d.
     ++ Error: if d is empty.
   reverse_!: % -> %
     ++ reverse!(d) destructively replaces d by its reverse dequeue, i.e.
     ++ the top (front) element is now the bottom (back) element, and so on.

@
\section{category PRQAGG PriorityQueueAggregate}
<<category PRQAGG PriorityQueueAggregate>>=
)abbrev category PRQAGG PriorityQueueAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A priority queue is a bag of items from an ordered set where the item
++ extracted is always the maximum element.
PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with
   finiteAggregate
   max: % -> S
     ++ max(q) returns the maximum element of priority queue q.
   merge: (%,%) -> %
     ++ merge(q1,q2) returns combines priority queues q1 and q2 to return
     ++ a single priority queue q.
   merge_!: (%,%) -> %
     ++ merge!(q,q1) destructively changes priority queue q to include the
     ++ values from priority queue q1.

@
\section{category DIOPS DictionaryOperations}
<<category DIOPS DictionaryOperations>>=
)abbrev category DIOPS DictionaryOperations
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ This category is a collection of operations common to both
++ categories \spadtype{Dictionary} and \spadtype{MultiDictionary}
DictionaryOperations(S:SetCategory): Category ==
  Join(BagAggregate S, Collection(S)) with
   dictionary: () -> %
     ++ dictionary()$D creates an empty dictionary of type D.
   dictionary: List S -> %
     ++ dictionary([x,y,...,z]) creates a dictionary consisting of
     ++ entries \axiom{x,y,...,z}.
-- insert: (S,%) -> S		      ++ insert an entry
-- member?: (S,%) -> Boolean		      ++ search for an entry
-- remove_!: (S,%,NonNegativeInteger) -> %
--   ++ remove!(x,d,n) destructively changes dictionary d by removing
--   ++ up to n entries y such that \axiom{y = x}.
-- remove_!: (S->Boolean,%,NonNegativeInteger) -> %
--   ++ remove!(p,d,n) destructively changes dictionary d by removing
--   ++ up to n entries x such that \axiom{p(x)} is true.
   if % has finiteAggregate then
     remove_!: (S,%) -> %
       ++ remove!(x,d) destructively changes dictionary d by removing
       ++ all entries y such that \axiom{y = x}.
     remove_!: (S->Boolean,%) -> %
       ++ remove!(p,d) destructively changes dictionary d by removeing
       ++ all entries x such that \axiom{p(x)} is true.
     select_!: (S->Boolean,%) -> %
       ++ select!(p,d) destructively changes dictionary d by removing
       ++ all entries x such that \axiom{p(x)} is not true.
 add
   construct l == dictionary l
   dictionary() == empty()
   if % has finiteAggregate then
     copy d == dictionary parts d
     coerce(s:%):OutputForm ==
       prefix("dictionary"@String :: OutputForm,
				      [x::OutputForm for x in parts s])

@
\section{category DIAGG Dictionary}
<<category DIAGG Dictionary>>=
)abbrev category DIAGG Dictionary
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A dictionary is an aggregate in which entries can be inserted,
++ searched for and removed. Duplicates are thrown away on insertion.
++ This category models the usual notion of dictionary which involves
++ large amounts of data where copying is impractical.
++ Principal operations are thus destructive (non-copying) ones.
Dictionary(S:SetCategory): Category ==
 DictionaryOperations S add
   dictionary l ==
     d := dictionary()
     for x in l repeat insert_!(x, d)
     d

   if % has finiteAggregate then
    -- remove(f:S->Boolean,t:%)  == remove_!(f, copy t)
    -- select(f, t)	   == select_!(f, copy t)
     select_!(f, t)	 == remove_!(not f #1, t)

     --extract_! d ==
     --	 empty? d => error "empty dictionary"
     --	 remove_!(x := first parts d, d, 1)
     --	 x

     s = t ==
       eq?(s,t) => true
       #s ^= #t => false
       _and/[member?(x, t) for x in parts s]

     remove_!(f:S->Boolean, t:%) ==
       for m in parts t repeat if f m then remove_!(m, t)
       t

@
\section{category MDAGG MultiDictionary}
<<category MDAGG MultiDictionary>>=
)abbrev category MDAGG MultiDictionary
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A multi-dictionary is a dictionary which may contain duplicates.
++ As for any dictionary, its size is assumed large so that
++ copying (non-destructive) operations are generally to be avoided.
MultiDictionary(S:SetCategory): Category == DictionaryOperations S with
-- count: (S,%) -> NonNegativeInteger		       ++ multiplicity count
   insert_!: (S,%,NonNegativeInteger) -> %
     ++ insert!(x,d,n) destructively inserts n copies of x into dictionary d.
-- remove_!: (S,%,NonNegativeInteger) -> %
--   ++ remove!(x,d,n) destructively removes (up to) n copies of x from
--   ++ dictionary d.
   removeDuplicates_!: % -> %
     ++ removeDuplicates!(d) destructively removes any duplicate values
     ++ in dictionary d.
   duplicates: % -> List Record(entry:S,count:NonNegativeInteger)
     ++ duplicates(d) returns a list of values which have duplicates in d
--   ++ duplicates(d) returns a list of		     ++ duplicates iterator
-- to become duplicates: % -> Iterator(D,D)

@
\section{category SETAGG SetAggregate}
<<category SETAGG SetAggregate>>=
)abbrev category SETAGG SetAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: 14 Oct, 1993 by RSS
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A set category lists a collection of set-theoretic operations
++ useful for both finite sets and multisets.
++ Note however that finite sets are distinct from multisets.
++ Although the operations defined for set categories are
++ common to both, the relationship between the two cannot
++ be described by inclusion or inheritance.
SetAggregate(S:SetCategory):
  Category == Join(SetCategory, Collection(S)) with
   partiallyOrderedSet
   "<"         : (%, %) -> Boolean
     ++ s < t returns true if all elements of set aggregate s are also
     ++ elements of set aggregate t.
   brace       : () -> %
     ++ brace()$D (otherwise written {}$D)
     ++ creates an empty set aggregate of type D.
     ++ This form is considered obsolete. Use \axiomFun{set} instead.
   brace       : List S -> %
     ++ brace([x,y,...,z]) 
     ++ creates a set aggregate containing items x,y,...,z.
     ++ This form is considered obsolete. Use \axiomFun{set} instead.
   set	       : () -> %
     ++ set()$D creates an empty set aggregate of type D.
   set	       : List S -> %
     ++ set([x,y,...,z]) creates a set aggregate containing items x,y,...,z.
   intersect: (%, %) -> %
     ++ intersect(u,v) returns the set aggregate w consisting of
     ++ elements common to both set aggregates u and v.
     ++ Note: equivalent to the notation (not currently supported)
     ++ {x for x in u | member?(x,v)}.
   difference  : (%, %) -> %
     ++ difference(u,v) returns the set aggregate w consisting of
     ++ elements in set aggregate u but not in set aggregate v.
     ++ If u and v have no elements in common, \axiom{difference(u,v)}
     ++ returns a copy of u.
     ++ Note: equivalent to the notation (not currently supported)
     ++ \axiom{{x for x in u | not member?(x,v)}}.
   difference  : (%, S) -> %
     ++ difference(u,x) returns the set aggregate u with element x removed.
     ++ If u does not contain x, a copy of u is returned.
     ++ Note: \axiom{difference(s, x) = difference(s, {x})}.
   symmetricDifference : (%, %) -> %
     ++ symmetricDifference(u,v) returns the set aggregate of elements x which
     ++ are members of set aggregate u or set aggregate v but not both.
     ++ If u and v have no elements in common, \axiom{symmetricDifference(u,v)}
     ++ returns a copy of u.
     ++ Note: \axiom{symmetricDifference(u,v) = union(difference(u,v),difference(v,u))}
   subset?     : (%, %) -> Boolean
     ++ subset?(u,v) tests if u is a subset of v.
     ++ Note: equivalent to
     ++ \axiom{reduce(and,{member?(x,v) for x in u},true,false)}.
   union       : (%, %) -> %
     ++ union(u,v) returns the set aggregate of elements which are members
     ++ of either set aggregate u or v.
   union       : (%, S) -> %
     ++ union(u,x) returns the set aggregate u with the element x added.
     ++ If u already contains x, \axiom{union(u,x)} returns a copy of u.
   union       : (S, %) -> %
     ++ union(x,u) returns the set aggregate u with the element x added.
     ++ If u already contains x, \axiom{union(x,u)} returns a copy of u.
 add
  symmetricDifference(x, y)    == union(difference(x, y), difference(y, x))
  union(s:%, x:S) == union(s, {x})
  union(x:S, s:%) == union(s, {x})
  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=#:G1398)
  (LET (#1=#:G1399)
    (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=#:G1397)
    (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|
                                         '(((< ((|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| (QREFELT $ 8))
      (SPADCALL |y| |x| (QREFELT $ 8)) (QREFELT $ 9))) 

(DEFUN |SETAGG-;union;ASA;2| (|s| |x| $)
  (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT $ 12)) (QREFELT $ 9))) 

(DEFUN |SETAGG-;union;S2A;3| (|x| |s| $)
  (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT $ 12)) (QREFELT $ 9))) 

(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| $)
  (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT $ 12)) (QREFELT $ 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 $ (GETREFV 16) . #0#)
        (QSETREFV $ 0 |dv$|)
        (QSETREFV $ 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #0#))
        (|stuffDomainSlots| $)
        (QSETREFV $ 6 |#1|)
        (QSETREFV $ 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>>=
)abbrev category FSAGG FiniteSetAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: 14 Oct, 1993 by RSS
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A finite-set aggregate models the notion of a finite set, that is,
++ a collection of elements characterized by membership, but not
++ by order or multiplicity.
++ See \spadtype{Set} for an example.
FiniteSetAggregate(S:SetCategory): Category ==
  Join(Dictionary S, SetAggregate S) with
    finiteAggregate
    cardinality: % -> NonNegativeInteger
      ++ cardinality(u) returns the number of elements of u.
      ++ Note: \axiom{cardinality(u) = #u}.
    if S has Finite then
      Finite
      complement: % -> %
	++ complement(u) returns the complement of the set u,
	++ i.e. the set of all values not in u.
      universe: () -> %
	++ universe()$D returns the universal set for finite set aggregate D.
    if S has OrderedSet then
      max: % -> S
	++ max(u) returns the largest element of aggregate u.
      min: % -> S
	++ min(u) returns the smallest element of aggregate u.

 add
   s < t	   == #s < #t and s = intersect(s,t)
   s = t	   == #s = #t and empty? difference(s,t)
   brace l	   == construct l
   set	 l	   == construct l
   cardinality s   == #s
   construct l	   == (s := set(); for x in l repeat insert_!(x,s); s)
   count(x:S, s:%) == (member?(x, s) => 1; 0)
   subset?(s, t)   == #s < #t and _and/[member?(x, t) for x in parts s]

   coerce(s:%):OutputForm ==
     brace [x::OutputForm for x in parts s]$List(OutputForm)

   intersect(s, t) ==
     i := {}
     for x in parts s | member?(x, t) repeat insert_!(x, i)
     i

   difference(s:%, t:%) ==
     m := copy s
     for x in parts t repeat remove_!(x, m)
     m

   symmetricDifference(s, t) ==
     d := copy s
     for x in parts t repeat
       if member?(x, s) then remove_!(x, d) else insert_!(x, d)
     d

   union(s:%, t:%) ==
      u := copy s
      for x in parts t repeat insert_!(x, u)
      u

   if S has Finite then
     universe()	  == {index(i::PositiveInteger) for i in 1..size()$S}
     complement s == difference(universe(), s )
     size()	  == 2 ** size()$S
     index i	 == {index(j::PositiveInteger)$S for j in 1..size()$S | bit?(i-1,j-1)}
     random()	  == index((random()$Integer rem (size()$% + 1))::PositiveInteger)

     lookup s ==
       n:PositiveInteger := 1
       for x in parts s repeat n := n + 2 ** ((lookup(x) - 1)::NonNegativeInteger)
       n

   if S has OrderedSet then
     max s ==
       empty?(l := parts s) => error "Empty set"
       reduce("max", l)

     min s ==
       empty?(l := parts s) => error "Empty set"
       reduce("min", l)

@
\section{category MSETAGG MultisetAggregate}
<<category MSETAGG MultisetAggregate>>=
)abbrev category MSETAGG MultisetAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A multi-set aggregate is a set which keeps track of the multiplicity
++ of its elements.
MultisetAggregate(S:SetCategory):
 Category == Join(MultiDictionary S, SetAggregate S)

@
\section{category OMSAGG OrderedMultisetAggregate}
<<category OMSAGG OrderedMultisetAggregate>>=
)abbrev category OMSAGG OrderedMultisetAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ An ordered-multiset aggregate is a multiset built over an ordered set S
++ so that the relative sizes of its entries can be assessed.
++ These aggregates serve as models for priority queues.
OrderedMultisetAggregate(S:OrderedSet): Category ==
   Join(MultisetAggregate S,PriorityQueueAggregate S) with
   -- max: % -> S		      ++ smallest entry in the set
   -- duplicates: % -> List Record(entry:S,count:NonNegativeInteger)
        ++ to become an in order iterator
   -- parts: % -> List S	      ++ in order iterator
      min: % -> S
	++ min(u) returns the smallest entry in the multiset aggregate u.

@
\section{category KDAGG KeyedDictionary}
<<category KDAGG KeyedDictionary>>=
)abbrev category KDAGG KeyedDictionary
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A keyed dictionary is a dictionary of key-entry pairs for which there is
++ a unique entry for each key.
KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category ==
  Dictionary Record(key:Key,entry:Entry) with
   key?: (Key, %) -> Boolean
     ++ key?(k,t) tests if k is a key in table t.
   keys: % -> List Key
     ++ keys(t) returns the list the keys in table t.
   -- to become keys: % -> Key* and keys: % -> Iterator(Entry,Entry)
   remove_!: (Key, %) -> Union(Entry,"failed")
     ++ remove!(k,t) searches the table t for the key k removing
     ++ (and return) the entry if there.
     ++ If t has no such key, \axiom{remove!(k,t)} returns "failed".
   search: (Key, %) -> Union(Entry,"failed")
     ++ search(k,t) searches the table t for the key k,
     ++ returning the entry stored in t for key k.
     ++ If t has no such key, \axiom{search(k,t)} returns "failed".
 add
   key?(k, t) == search(k, t) case Entry

   member?(p, t) ==
     r := search(p.key, t)
     r case Entry and r::Entry = p.entry

   if % has finiteAggregate then
     keys t == [x.key for x in parts t]

@
\section{category ELTAB Eltable}
<<category ELTAB Eltable>>=
)abbrev category ELTAB Eltable
++ Author: Michael Monagan; revised by Manuel Bronstein and Manuel Bronstein
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ An eltable over domains D and I is a structure which can be viewed
++ as a function from D to I.
++ Examples of eltable structures range from data structures, e.g. those
++ of type \spadtype{List}, to algebraic structures, e.g. \spadtype{Polynomial}.
Eltable(S:SetCategory, Index:Type): Category == with
  elt : (%, S) -> Index
     ++ elt(u,i) (also written: u . i) returns the element of u indexed by i.
     ++ Error: if i is not an index of u.

@
\section{category ELTAGG EltableAggregate}
<<category ELTAGG EltableAggregate>>=
)abbrev category ELTAGG EltableAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ An eltable aggregate is one which can be viewed as a function.
++ For example, the list \axiom{[1,7,4]} can applied to 0,1, and 2 respectively
++ will return the integers 1,7, and 4; thus this list may be viewed
++ as mapping 0 to 1, 1 to 7 and 2 to 4. In general, an aggregate
++ can map members of a domain {\em Dom} to an image domain {\em Im}.
EltableAggregate(Dom:SetCategory, Im:Type): Category ==
-- This is separated from Eltable
-- and series won't have to support qelt's and setelt's.
  Eltable(Dom, Im) with
    elt : (%, Dom, Im) -> Im
       ++ elt(u, x, y) applies u to x if x is in the domain of u,
       ++ and returns y otherwise.
       ++ For example, if u is a polynomial in \axiom{x} over the rationals,
       ++ \axiom{elt(u,n,0)} may define the coefficient of \axiom{x}
       ++ to the power n, returning 0 when n is out of range.
    qelt: (%, Dom) -> Im
       ++ qelt(u, x) applies \axiom{u} to \axiom{x} without checking whether
       ++ \axiom{x} is in the domain of \axiom{u}.  If \axiom{x} is not in the
       ++ domain of \axiom{u} a memory-access violation may occur.  If a check
       ++ on whether \axiom{x} is in the domain of \axiom{u} is required, use
       ++ the function \axiom{elt}.
    if % has shallowlyMutable then
       setelt : (%, Dom, Im) -> Im
	   ++ setelt(u,x,y) sets the image of x to be y under u,
	   ++ assuming x is in the domain of u.
	   ++ Error: if x is not in the domain of u.
	   -- this function will soon be renamed as setelt!.
       qsetelt_!: (%, Dom, Im) -> Im
	   ++ qsetelt!(u,x,y) sets the image of \axiom{x} to be \axiom{y} under
           ++ \axiom{u}, without checking that \axiom{x} is in the domain of
           ++ \axiom{u}.
           ++ If such a check is required use the function \axiom{setelt}.
 add
  qelt(a, x) == elt(a, x)
  if % has shallowlyMutable then
    qsetelt_!(a, x, y) == (a.x := y)

@
\section{category IXAGG IndexedAggregate}
<<category IXAGG IndexedAggregate>>=
)abbrev category IXAGG IndexedAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ An indexed aggregate is a many-to-one mapping of indices to entries.
++ For example, a one-dimensional-array is an indexed aggregate where
++ the index is an integer.  Also, a table is an indexed aggregate
++ where the indices and entries may have any type.
IndexedAggregate(Index: SetCategory, Entry: Type): Category ==
  Join(HomogeneousAggregate(Entry), EltableAggregate(Index, Entry)) with
   entries: % -> List Entry
      ++ entries(u) returns a list of all the entries of aggregate u
      ++ in no assumed order.
      -- to become entries: % -> Entry* and entries: % -> Iterator(Entry,Entry)
   index?: (Index,%) -> Boolean
      ++ index?(i,u) tests if i is an index of aggregate u.
   indices: % -> List Index
      ++ indices(u) returns a list of indices of aggregate u in no
      ++ particular order.
      -- to become indices: % -> Index* and indices: % -> Iterator(Index,Index).
-- map: ((Entry,Entry)->Entry,%,%,Entry) -> %
--    ++ exists c = map(f,a,b,x), i:Index where
--    ++    c.i = f(a(i,x),b(i,x)) | index?(i,a) or index?(i,b)
   if Entry has SetCategory and % has finiteAggregate then
      entry?: (Entry,%) -> Boolean
	++ entry?(x,u) tests if x equals \axiom{u . i} for some index i.
   if Index has OrderedSet then
      maxIndex: % -> Index
	++ maxIndex(u) returns the maximum index i of aggregate u.
	++ Note: in general,
	++ \axiom{maxIndex(u) = reduce(max,[i for i in indices u])};
	++ if u is a list, \axiom{maxIndex(u) = #u}.
      minIndex: % -> Index
	++ minIndex(u) returns the minimum index i of aggregate u.
	++ Note: in general,
	++ \axiom{minIndex(a) = reduce(min,[i for i in indices a])};
	++ for lists, \axiom{minIndex(a) = 1}.
      first   : % -> Entry
	++ first(u) returns the first element x of u.
	++ Note: for collections, \axiom{first([x,y,...,z]) = x}.
	++ Error: if u is empty.

   if % has shallowlyMutable then
      fill_!: (%,Entry) -> %
	++ fill!(u,x) replaces each entry in aggregate u by x.
	++ The modified u is returned as value.
      swap_!: (%,Index,Index) -> Void
	++ swap!(u,i,j) interchanges elements i and j of aggregate u.
	++ No meaningful value is returned.
 add
  elt(a, i, x) == (index?(i, a) => qelt(a, i); x)

  if % has finiteAggregate then
    entries x == parts x
    if Entry has SetCategory then
      entry?(x, a) == member?(x, a)

  if Index has OrderedSet then
    maxIndex a == "max"/indices(a)
    minIndex a == "min"/indices(a)
    first a    == a minIndex a

  if % has shallowlyMutable then
    map(f, a) == map_!(f, copy a)

    map_!(f, a) ==
      for i in indices a repeat qsetelt_!(a, i, f qelt(a, i))
      a

    fill_!(a, x) ==
      for i in indices a repeat qsetelt_!(a, i, x)
      a

    swap_!(a, i, j) ==
      t := a.i
      qsetelt_!(a, i, a.j)
      qsetelt_!(a, j, t)
      void

@
\section{category TBAGG TableAggregate}
<<category TBAGG TableAggregate>>=
)abbrev category TBAGG TableAggregate
++ Author: Michael Monagan, Stephen Watt; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A table aggregate is a model of a table, i.e. a discrete many-to-one
++ mapping from keys to entries.
TableAggregate(Key:SetCategory, Entry:SetCategory): Category ==
  Join(KeyedDictionary(Key,Entry),IndexedAggregate(Key,Entry)) with
   setelt: (%,Key,Entry) -> Entry	   -- setelt_! later
     ++ setelt(t,k,e) (also written \axiom{t.k := e}) is equivalent
     ++ to \axiom{(insert([k,e],t); e)}.
   table: () -> %
     ++ table()$T creates an empty table of type T.
   table: List Record(key:Key,entry:Entry) -> %
     ++ table([x,y,...,z]) creates a table consisting of entries
     ++ \axiom{x,y,...,z}.
   -- to become table: Record(key:Key,entry:Entry)* -> %
   map: ((Entry, Entry) -> Entry, %, %) -> %
     ++ map(fn,t1,t2) creates a new table t from given tables t1 and t2 with
     ++ elements fn(x,y) where x and y are corresponding elements from t1
     ++ and t2 respectively.
 add
   table()	       == empty()
   table l	       == dictionary l
-- empty()	       == dictionary()

   insert_!(p, t)      == (t(p.key) := p.entry; t)
   indices t	       == keys t

   coerce(t:%):OutputForm ==
     prefix("table"::OutputForm,
		    [k::OutputForm = (t.k)::OutputForm for k in keys t])

   elt(t, k) ==
      (r := search(k, t)) case Entry => r::Entry
      error "key not in table"

   elt(t, k, e) ==
      (r := search(k, t)) case Entry => r::Entry
      e

   map_!(f, t) ==
      for k in keys t repeat t.k := f t.k
      t

   map(f:(Entry, Entry) -> Entry, s:%, t:%) ==
      z := table()
      for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k)
      z

-- map(f, s, t, x) ==
--    z := table()
--    for k in keys s repeat z.k := f(s.k, t(k, x))
--    for k in keys t | not key?(k, s) repeat z.k := f(t.k, x)
--    z

   if % has finiteAggregate then
     parts(t:%):List Record(key:Key,entry:Entry)	     == [[k, t.k] for k in keys t]
     parts(t:%):List Entry   == [t.k for k in keys t]
     entries(t:%):List Entry == parts(t)

     s:% = t:% ==
       eq?(s,t) => true
       #s ^= #t => false
       for k in keys s repeat
	 (e := search(k, t)) case "failed" or (e::Entry) ^= s.k => false
       true

     map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry), t: %): % ==
       z := table()
       for k in keys t repeat
	 ke: Record(key:Key,entry:Entry) := f [k, t.k]
	 z ke.key := ke.entry
       z
     map_!(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry), t: %): % ==
       lke: List Record(key:Key,entry:Entry) := nil()
       for k in keys t repeat
	 lke := cons(f [k, remove_!(k,t)::Entry], lke)
       for ke in lke repeat
	 t ke.key := ke.entry
       t

     inspect(t: %): Record(key:Key,entry:Entry) ==
       ks := keys t
       empty? ks => error "Cannot extract from an empty aggregate"
       [first ks, t first ks]

     find(f: Record(key:Key,entry:Entry)->Boolean, t:%): Union(Record(key:Key,entry:Entry), "failed") ==
       for ke in parts(t)@List(Record(key:Key,entry:Entry)) repeat if f ke then return ke
       "failed"

     index?(k: Key, t: %): Boolean ==
       search(k,t) case Entry

     remove_!(x:Record(key:Key,entry:Entry), t:%) ==
       if member?(x, t) then remove_!(x.key, t)
       t
     extract_!(t: %): Record(key:Key,entry:Entry) ==
       k: Record(key:Key,entry:Entry) := inspect t
       remove_!(k.key, t)
       k

     any?(f: Entry->Boolean, t: %): Boolean ==
       for k in keys t | f t k repeat return true
       false
     every?(f: Entry->Boolean, t: %): Boolean ==
       for k in keys t | not f t k repeat return false
       true
     count(f: Entry->Boolean, t: %): NonNegativeInteger ==
       tally: NonNegativeInteger := 0
       for k in keys t | f t k repeat tally := tally + 1
       tally

@
\section{category RCAGG RecursiveAggregate}
<<category RCAGG RecursiveAggregate>>=
)abbrev category RCAGG RecursiveAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A recursive aggregate over a type S is a model for a
++ a directed graph containing values of type S.
++ Recursively, a recursive aggregate is a {\em node}
++ consisting of a \spadfun{value} from S and 0 or more \spadfun{children}
++ which are recursive aggregates.
++ A node with no children is called a \spadfun{leaf} node.
++ A recursive aggregate may be cyclic for which some operations as noted
++ may go into an infinite loop.
RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with
   children: % -> List %
     ++ children(u) returns a list of the children of aggregate u.
   -- should be % -> %* and also needs children: % -> Iterator(S,S)
   nodes: % -> List %
     ++ nodes(u) returns a list of all of the nodes of aggregate u.
   -- to become % -> %* and also nodes: % -> Iterator(S,S)
   leaf?: % -> Boolean
     ++ leaf?(u) tests if u is a terminal node.
   value: % -> S
     ++ value(u) returns the value of the node u.
   elt: (%,"value") -> S
     ++ elt(u,"value") (also written: \axiom{a. value}) is
     ++ equivalent to \axiom{value(a)}.
   cyclic?: % -> Boolean
     ++ cyclic?(u) tests if u has a cycle.
   leaves: % -> List S
     ++ leaves(t) returns the list of values in obtained by visiting the
     ++ nodes of tree \axiom{t} in left-to-right order.
   distance: (%,%) -> Integer
     ++ distance(u,v) returns the path length (an integer) from node u to v.
   if S has SetCategory then
      child?: (%,%) -> Boolean
	++ child?(u,v) tests if node u is a child of node v.
      node?: (%,%) -> Boolean
	++ node?(u,v) tests if node u is contained in node v
	++ (either as a child, a child of a child, etc.).
   if % has shallowlyMutable then
      setchildren_!: (%,List %)->%
	++ setchildren!(u,v) replaces the current children of node u
	++ with the members of v in left-to-right order.
      setelt: (%,"value",S) -> S
	++ setelt(a,"value",x) (also written \axiom{a . value := x})
	++ is equivalent to \axiom{setvalue!(a,x)}
      setvalue_!: (%,S) -> S
	++ setvalue!(u,x) sets the value of node u to x.
 add
   elt(x,"value") == value x
   if % has shallowlyMutable then
     setelt(x,"value",y) == setvalue_!(x,y)
   if S has SetCategory then
     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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A binary-recursive aggregate has 0, 1 or 2 children and
++ serves as a model for a binary tree or a doubly-linked aggregate structure
BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with
   -- needs preorder, inorder and postorder iterators
   left: % -> %
     ++ left(u) returns the left child.
   elt: (%,"left") -> %
     ++ elt(u,"left") (also written: \axiom{a . left}) is
     ++ equivalent to \axiom{left(a)}.
   right: % -> %
     ++ right(a) returns the right child.
   elt: (%,"right") -> %
     ++ elt(a,"right") (also written: \axiom{a . right})
     ++ is equivalent to \axiom{right(a)}.
   if % has shallowlyMutable then
      setelt: (%,"left",%) -> %
	++ setelt(a,"left",b) (also written \axiom{a . left := b}) is equivalent
	++ to \axiom{setleft!(a,b)}.
      setleft_!: (%,%) -> %
	 ++ setleft!(a,b) sets the left child of \axiom{a} to be b.
      setelt: (%,"right",%) -> %
	 ++ setelt(a,"right",b) (also written \axiom{b . right := b})
	 ++ is equivalent to \axiom{setright!(a,b)}.
      setright_!: (%,%) -> %
	 ++ setright!(a,x) sets the right child of t to be x.
 add
   cycleMax ==> 1000

   elt(x,"left")  == left x
   elt(x,"right") == right x
   leaf? x == empty? x or empty? left x and empty? right x
   leaves t ==
     empty? t => empty()$List(S)
     leaf? t => [value t]
     concat(leaves left t,leaves right t)
   nodes x ==
     l := empty()$List(%)
     empty? x => l
     concat(nodes left x,concat([x],nodes right x))
   children x ==
     l := empty()$List(%)
     empty? x => l
     empty? left x  => [right x]
     empty? right x => [left x]
     [left x, right x]
   if % has SetAggregate(S) and S has SetCategory then
     node?(u,v) ==
       empty? v => false
       u = v => true
       for y in children v repeat node?(u,y) => return true
       false
     x = y ==
       empty?(x) => empty?(y)
       empty?(y) => false
       value x = value y and left x = left y and right x = right y
     if % has finiteAggregate then
       member?(x,u) ==
	 empty? u => false
	 x = value u => true
	 member?(x,left u) or member?(x,right u)

   if S has CoercibleTo(OutputForm) then
     coerce(t:%): OutputForm ==
       empty? t =>  "[]"::OutputForm
       v := value(t):: OutputForm
       empty? left t =>
	 empty? right t => v
	 r := (right t)::OutputForm
	 bracket ["."::OutputForm, v, r]
       l := (left t)::OutputForm
       r :=
	 empty? right t => "."::OutputForm
	 (right t)::OutputForm
       bracket [l, v, r]

   if % has finiteAggregate then
     aggCount: (%,NonNegativeInteger) -> NonNegativeInteger
     #x == aggCount(x,0)
     aggCount(x,k) ==
       empty? x => 0
       k := k + 1
       k = cycleMax and cyclic? x => error "cyclic tree"
       for y in children x repeat k := aggCount(y,k)
       k

   isCycle?:  (%, List %) -> Boolean
   eqMember?: (%, List %) -> Boolean
   cyclic? x	 == not empty? x and isCycle?(x,empty()$(List %))
   isCycle?(x,acc) ==
     empty? x => false
     eqMember?(x,acc) => true
     for y in children x | not empty? y repeat
       isCycle?(y,acc) => return true
     false
   eqMember?(y,l) ==
     for x in l repeat eq?(x,y) => return true
     false
   if % has shallowlyMutable then
     setelt(x,"left",b)  == setleft_!(x,b)
     setelt(x,"right",b) == setright_!(x,b)

@
\section{category DLAGG DoublyLinkedAggregate}
<<category DLAGG DoublyLinkedAggregate>>=
)abbrev category DLAGG DoublyLinkedAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A doubly-linked aggregate serves as a model for a doubly-linked
++ list, that is, a list which can has links to both next and previous
++ nodes and thus can be efficiently traversed in both directions.
DoublyLinkedAggregate(S:Type): Category == RecursiveAggregate S with
   last: % -> S
     ++ last(l) returns the last element of a doubly-linked aggregate l.
     ++ Error: if l is empty.
   head: % -> %
     ++ head(l) returns the first element of a doubly-linked aggregate l.
     ++ Error: if l is empty.
   tail: % -> %
     ++ tail(l) returns the doubly-linked aggregate l starting at
     ++ its second element.
     ++ Error: if l is empty.
   previous: % -> %
     ++ previous(l) returns the doubly-link list beginning with its previous
     ++ element.
     ++ Error: if l has no previous element.
     ++ Note: \axiom{next(previous(l)) = l}.
   next: % -> %
     ++ next(l) returns the doubly-linked aggregate beginning with its next
     ++ element.
     ++ Error: if l has no next element.
     ++ Note: \axiom{next(l) = rest(l)} and \axiom{previous(next(l)) = l}.
   if % has shallowlyMutable then
      concat_!: (%,%) -> %
	++ concat!(u,v) destructively concatenates doubly-linked aggregate v to the end of doubly-linked aggregate u.
      setprevious_!: (%,%) -> %
	++ setprevious!(u,v) destructively sets the previous node of doubly-linked aggregate u to v, returning v.
      setnext_!: (%,%) -> %
	++ setnext!(u,v) destructively sets the next node of doubly-linked aggregate u to v, returning v.

@
\section{category URAGG UnaryRecursiveAggregate}
<<category URAGG UnaryRecursiveAggregate>>=
)abbrev category URAGG UnaryRecursiveAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A unary-recursive aggregate is a one where nodes may have either
++ 0 or 1 children.
++ This aggregate models, though not precisely, a linked
++ list possibly with a single cycle.
++ A node with one children models a non-empty list, with the
++ \spadfun{value} of the list designating the head, or \spadfun{first}, of the
++ list, and the child designating the tail, or \spadfun{rest}, of the list.
++ A node with no child then designates the empty list.
++ Since these aggregates are recursive aggregates, they may be cyclic.
UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with
   concat: (%,%) -> %
      ++ concat(u,v) returns an aggregate w consisting of the elements of u
      ++ followed by the elements of v.
      ++ Note: \axiom{v = rest(w,#a)}.
   concat: (S,%) -> %
      ++ concat(x,u) returns aggregate consisting of x followed by
      ++ the elements of u.
      ++ Note: if \axiom{v = concat(x,u)} then \axiom{x = first v}
      ++ and \axiom{u = rest v}.
   first: % -> S
      ++ first(u) returns the first element of u
      ++ (equivalently, the value at the current node).
   elt: (%,"first") -> S
      ++ elt(u,"first") (also written: \axiom{u . first}) is equivalent to first u.
   first: (%,NonNegativeInteger) -> %
      ++ first(u,n) returns a copy of the first n (\axiom{n >= 0}) elements of u.
   rest: % -> %
      ++ rest(u) returns an aggregate consisting of all but the first
      ++ element of u
      ++ (equivalently, the next node of u).
   elt: (%,"rest") -> %
      ++ elt(%,"rest") (also written: \axiom{u.rest}) is
      ++ equivalent to \axiom{rest u}.
   rest: (%,NonNegativeInteger) -> %
      ++ rest(u,n) returns the \axiom{n}th (n >= 0) node of u.
      ++ Note: \axiom{rest(u,0) = u}.
   last: % -> S
      ++ last(u) resturn the last element of u.
      ++ Note: for lists, \axiom{last(u) = u . (maxIndex u) = u . (# u - 1)}.
   elt: (%,"last") -> S
      ++ elt(u,"last") (also written: \axiom{u . last}) is equivalent to last u.
   last: (%,NonNegativeInteger) -> %
      ++ last(u,n) returns a copy of the last n (\axiom{n >= 0}) nodes of u.
      ++ Note: \axiom{last(u,n)} is a list of n elements.
   tail: % -> %
      ++ tail(u) returns the last node of u.
      ++ Note: if u is \axiom{shallowlyMutable},
      ++ \axiom{setrest(tail(u),v) = concat(u,v)}.
   second: % -> S
      ++ second(u) returns the second element of u.
      ++ Note: \axiom{second(u) = first(rest(u))}.
   third: % -> S
      ++ third(u) returns the third element of u.
      ++ Note: \axiom{third(u) = first(rest(rest(u)))}.
   cycleEntry: % -> %
      ++ cycleEntry(u) returns the head of a top-level cycle contained in
      ++ aggregate u, or \axiom{empty()} if none exists.
   cycleLength: % -> NonNegativeInteger
      ++ cycleLength(u) returns the length of a top-level cycle
      ++ contained  in aggregate u, or 0 is u has no such cycle.
   cycleTail: % -> %
      ++ cycleTail(u) returns the last node in the cycle, or
      ++ empty if none exists.
   if % has shallowlyMutable then
      concat_!: (%,%) -> %
	++ concat!(u,v) destructively concatenates v to the end of u.
	++ Note: \axiom{concat!(u,v) = setlast_!(u,v)}.
      concat_!: (%,S) -> %
	++ concat!(u,x) destructively adds element x to the end of u.
	++ Note: \axiom{concat!(a,x) = setlast!(a,[x])}.
      cycleSplit_!: % -> %
	++ cycleSplit!(u) splits the aggregate by dropping off the cycle.
	++ The value returned is the cycle entry, or nil if none exists.
	++ For example, if \axiom{w = concat(u,v)} is the cyclic list where v is
	++ the head of the cycle, \axiom{cycleSplit!(w)} will drop v off w thus
	++ destructively changing w to u, and returning v.
      setfirst_!: (%,S) -> S
	++ setfirst!(u,x) destructively changes the first element of a to x.
      setelt: (%,"first",S) -> S
	++ setelt(u,"first",x) (also written: \axiom{u.first := x}) is
	++ equivalent to \axiom{setfirst!(u,x)}.
      setrest_!: (%,%) -> %
	++ setrest!(u,v) destructively changes the rest of u to v.
      setelt: (%,"rest",%) -> %
	++ setelt(u,"rest",v) (also written: \axiom{u.rest := v}) is equivalent to
	++ \axiom{setrest!(u,v)}.
      setlast_!: (%,S) -> S
	++ setlast!(u,x) destructively changes the last element of u to x.
      setelt: (%,"last",S) -> S
	++ setelt(u,"last",x) (also written: \axiom{u.last := b})
	++ is equivalent to \axiom{setlast!(u,v)}.
      split_!: (%,Integer) -> %
	 ++ split!(u,n) splits u into two aggregates: \axiom{v = rest(u,n)}
	 ++ and \axiom{w = first(u,n)}, returning \axiom{v}.
	 ++ Note: afterwards \axiom{rest(u,n)} returns \axiom{empty()}.
 add
  cycleMax ==> 1000

  findCycle: % -> %

  elt(x, "first") == first x
  elt(x,  "last") == last x
  elt(x,  "rest") == rest x
  second x	  == first rest x
  third x	  == first rest rest x
  cyclic? x	  == not empty? x and not empty? findCycle x
  last x	  == first tail x

  nodes x ==
    l := empty()$List(%)
    while not empty? x repeat
      l := concat(x, l)
      x := rest x
    reverse_! l

  children x ==
    l := empty()$List(%)
    empty? x => l
    concat(rest x,l)

  leaf? x == empty? x

  value x ==
    empty? x => error "value of empty object"
    first x

  less?(l, n) ==
    i := n::Integer
    while i > 0 and not empty? l repeat (l := rest l; i := i - 1)
    i > 0

  more?(l, n) ==
    i := n::Integer
    while i > 0 and not empty? l repeat (l := rest l; i := i - 1)
    zero?(i) and not empty? l

  size?(l, n) ==
    i := n::Integer
    while not empty? l and i > 0 repeat (l := rest l; i := i - 1)
    empty? l and zero? i

  #x ==
    for k in 0.. while not empty? x repeat
      k = cycleMax and cyclic? x => error "cyclic list"
      x := rest x
    k

  tail x ==
    empty? x => error "empty list"
    y := rest x
    for k in 0.. while not empty? y repeat
      k = cycleMax and cyclic? x => error "cyclic list"
      y := rest(x := y)
    x

  findCycle x ==
    y := rest x
    while not empty? y repeat
      if eq?(x, y) then return x
      x := rest x
      y := rest y
      if empty? y then return y
      if eq?(x, y) then return y
      y := rest y
    y

  cycleTail x ==
    empty?(y := x := cycleEntry x) => x
    z := rest x
    while not eq?(x,z) repeat (y := z; z := rest z)
    y

  cycleEntry x ==
    empty? x => x
    empty?(y := findCycle x) => y
    z := rest y
    for l in 1.. while not eq?(y,z) repeat z := rest z
    y := x
    for k in 1..l repeat y := rest y
    while not eq?(x,y) repeat (x := rest x; y := rest y)
    x

  cycleLength x ==
    empty? x => 0
    empty?(x := findCycle x) => 0
    y := rest x
    for k in 1.. while not eq?(x,y) repeat y := rest y
    k

  rest(x, n) ==
    for i in 1..n repeat
      empty? x => error "Index out of range"
      x := rest x
    x

  if % has finiteAggregate then
    last(x, n) ==
      n > (m := #x) => error "index out of range"
      copy rest(x, (m - n)::NonNegativeInteger)

  if S has SetCategory then
    x = y ==
      eq?(x, y) => true
      for k in 0.. while not empty? x and not empty? y repeat
	k = cycleMax and cyclic? x => error "cyclic list"
	first x ^= first y => return false
	x := rest x
	y := rest y
      empty? x and empty? y

    node?(u, v) ==
      for k in 0.. while not empty? v repeat
	u = v => return true
	k = cycleMax and cyclic? v => error "cyclic list"
	v := rest v
      u=v

  if % has shallowlyMutable then
    setelt(x, "first", a) == setfirst_!(x, a)
    setelt(x,  "last", a) == setlast_!(x, a)
    setelt(x,  "rest", a) == setrest_!(x, a)
    concat(x:%, y:%)	  == concat_!(copy x, y)

    setlast_!(x, s) ==
      empty? x => error "setlast: empty list"
      setfirst_!(tail x, s)
      s

    setchildren_!(u,lv) ==
      #lv=1 => setrest_!(u, first lv)
      error "wrong number of children specified"

    setvalue_!(u,s) == setfirst_!(u,s)

    split_!(p, n) ==
      n < 1 => error "index out of range"
      p := rest(p, (n - 1)::NonNegativeInteger)
      q := rest p
      setrest_!(p, empty())
      q

    cycleSplit_! x ==
      empty?(y := cycleEntry x) or eq?(x, y) => y
      z := rest x
      while not eq?(z, y) repeat (x := z; z := rest z)
      setrest_!(x, empty())
      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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A stream aggregate is a linear aggregate which possibly has an infinite
++ number of elements. A basic domain constructor which builds stream
++ aggregates is \spadtype{Stream}. From streams, a number of infinite
++ structures such power series can be built. A stream aggregate may
++ also be infinite since it may be cyclic.
++ For example, see \spadtype{DecimalExpansion}.
StreamAggregate(S:Type): Category ==
   Join(UnaryRecursiveAggregate S, LinearAggregate S) with
      explicitlyFinite?: % -> Boolean
	++ explicitlyFinite?(s) tests if the stream has a finite
	++ number of elements, and false otherwise.
	++ Note: for many datatypes, \axiom{explicitlyFinite?(s) = not possiblyInfinite?(s)}.
      possiblyInfinite?: % -> Boolean
	++ possiblyInfinite?(s) tests if the stream s could possibly
	++ have an infinite number of elements.
	++ Note: for many datatypes, \axiom{possiblyInfinite?(s) = not explictlyFinite?(s)}.
 add
   c2: (%, %) -> S

   explicitlyFinite? x == not cyclic? x
   possiblyInfinite? x == cyclic? x
   first(x, n)	       == construct [c2(x, x := rest x) for i in 1..n]

   c2(x, r) ==
     empty? x => error "Index out of range"
     first x

   elt(x:%, i:Integer) ==
     i := i - minIndex x
     (i < 0) or empty?(x := rest(x, i::NonNegativeInteger)) => error "index out of range"
     first x

   elt(x:%, i:UniversalSegment(Integer)) ==
     l := lo(i) - minIndex x
     l < 0 => error "index out of range"
     not hasHi i => copy(rest(x, l::NonNegativeInteger))
     (h := hi(i) - minIndex x) < l => empty()
     first(rest(x, l::NonNegativeInteger), (h - l + 1)::NonNegativeInteger)

   if % has shallowlyMutable then
     concat(x:%, y:%) == concat_!(copy x, y)

     concat l ==
       empty? l => empty()
       concat_!(copy first l, concat rest l)

     map_!(f, l) ==
       y := l
       while not empty? l repeat
	 setfirst_!(l, f first l)
	 l := rest l
       y

     fill_!(x, s) ==
       y := x
       while not empty? y repeat (setfirst_!(y, s); y := rest y)
       x

     setelt(x:%, i:Integer, s:S) ==
      i := i - minIndex x
      (i < 0) or empty?(x := rest(x,i::NonNegativeInteger)) => error "index out of range"
      setfirst_!(x, s)

     setelt(x:%, i:UniversalSegment(Integer), s:S) ==
      (l := lo(i) - minIndex x) < 0 => error "index out of range"
      h := if hasHi i then hi(i) - minIndex x else maxIndex x
      h < l => s
      y := rest(x, l::NonNegativeInteger)
      z := rest(y, (h - l + 1)::NonNegativeInteger)
      while not eq?(y, z) repeat (setfirst_!(y, s); y := rest y)
      s

     concat_!(x:%, y:%) ==
       empty? x => y
       setrest_!(tail x, y)
       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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A linear aggregate is an aggregate whose elements are indexed by integers.
++ Examples of linear aggregates are strings, lists, and
++ arrays.
++ Most of the exported operations for linear aggregates are non-destructive
++ but are not always efficient for a particular aggregate.
++ For example, \spadfun{concat} of two lists needs only to copy its first
++ argument, whereas \spadfun{concat} of two arrays needs to copy both arguments.
++ Most of the operations exported here apply to infinite objects (e.g. streams)
++ as well to finite ones.
++ For finite linear aggregates, see \spadtype{FiniteLinearAggregate}.
LinearAggregate(S:Type): Category ==
  Join(IndexedAggregate(Integer, S), Collection(S)) with
   new	 : (NonNegativeInteger,S) -> %
     ++ new(n,x) returns \axiom{fill!(new n,x)}.
   concat: (%,S) -> %
     ++ concat(u,x) returns aggregate u with additional element x at the end.
     ++ Note: for lists, \axiom{concat(u,x) == concat(u,[x])}
   concat: (S,%) -> %
     ++ concat(x,u) returns aggregate u with additional element at the front.
     ++ Note: for lists: \axiom{concat(x,u) == concat([x],u)}.
   concat: (%,%) -> %
      ++ concat(u,v) returns an aggregate consisting of the elements of u
      ++ followed by the elements of v.
      ++ Note: if \axiom{w = concat(u,v)} then \axiom{w.i = u.i for i in indices u}
      ++ and \axiom{w.(j + maxIndex u) = v.j for j in indices v}.
   concat: List % -> %
      ++ concat(u), where u is a lists of aggregates \axiom{[a,b,...,c]}, returns
      ++ a single aggregate consisting of the elements of \axiom{a}
      ++ followed by those
      ++ of b followed ... by the elements of c.
      ++ Note: \axiom{concat(a,b,...,c) = concat(a,concat(b,...,c))}.
   map: ((S,S)->S,%,%) -> %
     ++ map(f,u,v) returns a new collection w with elements \axiom{z = f(x,y)}
     ++ for corresponding elements x and y from u and v.
     ++ Note: for linear aggregates, \axiom{w.i = f(u.i,v.i)}.
   elt: (%,UniversalSegment(Integer)) -> %
      ++ elt(u,i..j) (also written: \axiom{a(i..j)}) returns the aggregate of
      ++ elements \axiom{u} for k from i to j in that order.
      ++ Note: in general, \axiom{a.s = [a.k for i in s]}.
   delete: (%,Integer) -> %
      ++ delete(u,i) returns a copy of u with the \axiom{i}th element deleted.
      ++ Note: for lists, \axiom{delete(a,i) == concat(a(0..i - 1),a(i + 1,..))}.
   delete: (%,UniversalSegment(Integer)) -> %
      ++ delete(u,i..j) returns a copy of u with the \axiom{i}th through
      ++ \axiom{j}th element deleted.
      ++ Note: \axiom{delete(a,i..j) = concat(a(0..i-1),a(j+1..))}.
   insert: (S,%,Integer) -> %
      ++ insert(x,u,i) returns a copy of u having x as its \axiom{i}th element.
      ++ Note: \axiom{insert(x,a,k) = concat(concat(a(0..k-1),x),a(k..))}.
   insert: (%,%,Integer) -> %
      ++ insert(v,u,k) returns a copy of u having v inserted beginning at the
      ++ \axiom{i}th element.
      ++ Note: \axiom{insert(v,u,k) = concat( u(0..k-1), v, u(k..) )}.
   if % has shallowlyMutable then setelt: (%,UniversalSegment(Integer),S) -> S
      ++ setelt(u,i..j,x) (also written: \axiom{u(i..j) := x}) destructively
      ++ replaces each element in the segment \axiom{u(i..j)} by x.
      ++ The value x is returned.
      ++ Note: u is destructively change so
      ++ that \axiom{u.k := x for k in i..j};
      ++ its length remains unchanged.
 add
  indices a	 == [i for i in minIndex a .. maxIndex a]
  index?(i, a)	 == i >= minIndex a and i <= maxIndex a
  concat(a:%, x:S)	== concat(a, new(1, x))
  concat(x:S, y:%)	== concat(new(1, x), y)
  insert(x:S, a:%, i:Integer) == insert(new(1, x), a, i)
  if % has finiteAggregate then
    maxIndex l == #l - 1 + minIndex l

--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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A finite linear aggregate is a linear aggregate of finite length.
++ The finite property of the aggregate adds several exports to the
++ list of exports from \spadtype{LinearAggregate} such as
++ \spadfun{reverse}, \spadfun{sort}, and so on.
FiniteLinearAggregate(S:Type): Category == LinearAggregate S with
   finiteAggregate
   merge: ((S,S)->Boolean,%,%) -> %
      ++ merge(p,a,b) returns an aggregate c which merges \axiom{a} and b.
      ++ The result is produced by examining each element x of \axiom{a} and y
      ++ of b successively. If \axiom{p(x,y)} is true, then x is inserted into
      ++ the result; otherwise y is inserted. If x is chosen, the next element
      ++ of \axiom{a} is examined, and so on. When all the elements of one
      ++ aggregate are examined, the remaining elements of the other
      ++ are appended.
      ++ For example, \axiom{merge(<,[1,3],[2,7,5])} returns \axiom{[1,2,3,7,5]}.
   reverse: % -> %
      ++ reverse(a) returns a copy of \axiom{a} with elements in reverse order.
   sort: ((S,S)->Boolean,%) -> %
      ++ sort(p,a) returns a copy of \axiom{a} sorted using total ordering predicate p.
   sorted?: ((S,S)->Boolean,%) -> Boolean
      ++ sorted?(p,a) tests if \axiom{a} is sorted according to predicate p.
   position: (S->Boolean, %) -> Integer
      ++ position(p,a) returns the index i of the first x in \axiom{a} such that
      ++ \axiom{p(x)} is true, and \axiom{minIndex(a) - 1} if there is no such x.
   if S has SetCategory then
      position: (S, %)	-> Integer
	++ position(x,a) returns the index i of the first occurrence of x in a,
	++ and \axiom{minIndex(a) - 1} if there is no such x.
      position: (S,%,Integer) -> Integer
	++ position(x,a,n) returns the index i of the first occurrence of x in
	++ \axiom{a} where \axiom{i >= n}, and \axiom{minIndex(a) - 1} if no such x is found.
   if S has OrderedSet then
      OrderedSet
      merge: (%,%) -> %
	++ merge(u,v) merges u and v in ascending order.
	++ Note: \axiom{merge(u,v) = merge(<=,u,v)}.
      sort: % -> %
	++ sort(u) returns an u with elements in ascending order.
	++ Note: \axiom{sort(u) = sort(<=,u)}.
      sorted?: % -> Boolean
	++ sorted?(u) tests if the elements of u are in ascending order.
   if % has shallowlyMutable then
      copyInto_!: (%,%,Integer) -> %
	++ copyInto!(u,v,i) returns aggregate u containing a copy of
	++ v inserted at element i.
      reverse_!: % -> %
	++ reverse!(u) returns u with its elements in reverse order.
      sort_!: ((S,S)->Boolean,%) -> %
	++ sort!(p,u) returns u with its elements ordered by p.
      if S has OrderedSet then sort_!: % -> %
	++ sort!(u) returns u with its elements in ascending order.
 add
    if S has SetCategory then
      position(x:S, t:%) == position(x, t, minIndex t)

    if S has OrderedSet then
--    sorted? l	  == sorted?(_<$S, l)
      sorted? l	  == sorted?(#1 < #2 or #1 = #2, l)
      merge(x, y) == merge(_<$S, x, y)
      sort l	  == sort(_<$S, l)

    if % has shallowlyMutable then
      reverse x	 == reverse_! copy x
      sort(f, l) == sort_!(f, copy l)
      reverse x	 == reverse_! copy x

      if S has OrderedSet then
	sort_! l == sort_!(_<$S, l)

@
\section{category A1AGG OneDimensionalArrayAggregate}
<<category A1AGG OneDimensionalArrayAggregate>>=
)abbrev category A1AGG OneDimensionalArrayAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ One-dimensional-array aggregates serves as models for one-dimensional arrays.
++ Categorically, these aggregates are finite linear aggregates
++ with the \spadatt{shallowlyMutable} property, that is, any component of
++ the array may be changed without affecting the
++ identity of the overall array.
++ Array data structures are typically represented by a fixed area in storage and
++ therefore cannot efficiently grow or shrink on demand as can list structures
++ (see however \spadtype{FlexibleArray} for a data structure which
++ is a cross between a list and an array).
++ Iteration over, and access to, elements of arrays is extremely fast
++ (and often can be optimized to open-code).
++ Insertion and deletion however is generally slow since an entirely new
++ data structure must be created for the result.
OneDimensionalArrayAggregate(S:Type): Category ==
    FiniteLinearAggregate S with shallowlyMutable
  add
    parts x	    == [qelt(x, i) for i in minIndex x .. maxIndex x]
    sort_!(f, a) == quickSort(f, a)$FiniteLinearAggregateSort(S, %)

    any?(f, a) ==
      for i in minIndex a .. maxIndex a repeat
	f qelt(a, i) => return true
      false

    every?(f, a) ==
      for i in minIndex a .. maxIndex a repeat
	not(f qelt(a, i)) => return false
      true

    position(f:S -> Boolean, a:%) ==
      for i in minIndex a .. maxIndex a repeat
	f qelt(a, i) => return i
      minIndex(a) - 1

    find(f, a) ==
      for i in minIndex a .. maxIndex a repeat
	f qelt(a, i) => return qelt(a, i)
      "failed"

    count(f:S->Boolean, a:%) ==
      n:NonNegativeInteger := 0
      for i in minIndex a .. maxIndex a repeat
	if f(qelt(a, i)) then n := n+1
      n

    map_!(f, a) ==
      for i in minIndex a .. maxIndex a repeat
	qsetelt_!(a, i, f qelt(a, i))
      a

    setelt(a:%, s:UniversalSegment(Integer), x:S) ==
      l := lo s; h := if hasHi s then hi s else maxIndex a
      l < minIndex a or h > maxIndex a => error "index out of range"
      for k in l..h repeat qsetelt_!(a, k, x)
      x

    reduce(f, a) ==
      empty? a => error "cannot reduce an empty aggregate"
      r := qelt(a, m := minIndex a)
      for k in m+1 .. maxIndex a repeat r := f(r, qelt(a, k))
      r

    reduce(f, a, identity) ==
      for k in minIndex a .. maxIndex a repeat
	identity := f(identity, qelt(a, k))
      identity

    if S has SetCategory then
       reduce(f, a, identity,absorber) ==
	 for k in minIndex a .. maxIndex a while identity ^= absorber
		repeat identity := f(identity, qelt(a, k))
	 identity

-- this is necessary since new has disappeared.
    stupidnew: (NonNegativeInteger, %, %) -> %
    stupidget: List % -> S
-- a and b are not both empty if n > 0
    stupidnew(n, a, b) ==
      zero? n => empty()
      new(n, (empty? a => qelt(b, minIndex b); qelt(a, minIndex a)))
-- at least one element of l must be non-empty
    stupidget l ==
      for a in l repeat
	not empty? a => return first a
      error "Should not happen"

    map(f, a, b) ==
      m := max(minIndex a, minIndex b)
      n := min(maxIndex a, maxIndex b)
      l := max(0, n - m + 1)::NonNegativeInteger
      c := stupidnew(l, a, b)
      for i in minIndex(c).. for j in m..n repeat
	qsetelt_!(c, i, f(qelt(a, j), qelt(b, j)))
      c

--  map(f, a, b, x) ==
--    m := min(minIndex a, minIndex b)
--    n := max(maxIndex a, maxIndex b)
--    l := (n - m + 1)::NonNegativeInteger
--    c := new l
--    for i in minIndex(c).. for j in m..n repeat
--	qsetelt_!(c, i, f(a(j, x), b(j, x)))
--    c

    merge(f, a, b) ==
      r := stupidnew(#a + #b, a, b)
      i := minIndex a
      m := maxIndex a
      j := minIndex b
      n := maxIndex b
      for k in minIndex(r).. while i <= m and j <= n repeat
	if f(qelt(a, i), qelt(b, j)) then
	  qsetelt_!(r, k, qelt(a, i))
	  i := i+1
	else
	  qsetelt_!(r, k, qelt(b, j))
	  j := j+1
      for k in k.. for i in i..m repeat qsetelt_!(r, k, elt(a, i))
      for k in k.. for j in j..n repeat qsetelt_!(r, k, elt(b, j))
      r

    elt(a:%, s:UniversalSegment(Integer)) ==
      l := lo s
      h := if hasHi s then hi s else maxIndex a
      l < minIndex a or h > maxIndex a => error "index out of range"
      r := stupidnew(max(0, h - l + 1)::NonNegativeInteger, a, a)
      for k in minIndex r.. for i in l..h repeat
	qsetelt_!(r, k, qelt(a, i))
      r

    insert(a:%, b:%, i:Integer) ==
      m := minIndex b
      n := maxIndex b
      i < m or i > n => error "index out of range"
      y := stupidnew(#a + #b, a, b)
      for k in minIndex y.. for j in m..i-1 repeat
	qsetelt_!(y, k, qelt(b, j))
      for k in k.. for j in minIndex a .. maxIndex a repeat
	qsetelt_!(y, k, qelt(a, j))
      for k in k.. for j in i..n repeat qsetelt_!(y, k, qelt(b, j))
      y

    copy x ==
      y := stupidnew(#x, x, x)
      for i in minIndex x .. maxIndex x for j in minIndex y .. repeat
	qsetelt_!(y, j, qelt(x, i))
      y

    copyInto_!(y, x, s) ==
      s < minIndex y or s + #x > maxIndex y + 1 =>
					      error "index out of range"
      for i in minIndex x .. maxIndex x for j in s.. repeat
	qsetelt_!(y, j, qelt(x, i))
      y

    construct l ==
--    a := new(#l)
      empty? l => empty()
      a := new(#l, first l)
      for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x)
      a

    delete(a:%, s:UniversalSegment(Integer)) ==
      l := lo s; h := if hasHi s then hi s else maxIndex a
      l < minIndex a or h > maxIndex a => error "index out of range"
      h < l => copy a
      r := stupidnew((#a - h + l - 1)::NonNegativeInteger, a, a)
      for k in minIndex(r).. for i in minIndex a..l-1 repeat
	qsetelt_!(r, k, qelt(a, i))
      for k in k.. for i in h+1 .. maxIndex a repeat
	qsetelt_!(r, k, qelt(a, i))
      r

    delete(x:%, i:Integer) ==
      i < minIndex x or i > maxIndex x => error "index out of range"
      y := stupidnew((#x - 1)::NonNegativeInteger, x, x)
      for i in minIndex(y).. for j in minIndex x..i-1 repeat
	qsetelt_!(y, i, qelt(x, j))
      for i in i .. for j in i+1 .. maxIndex x repeat
	qsetelt_!(y, i, qelt(x, j))
      y

    reverse_! x ==
      m := minIndex x
      n := maxIndex x
      for i in 0..((n-m) quo 2) repeat swap_!(x, m+i, n-i)
      x

    concat l ==
      empty? l => empty()
      n := _+/[#a for a in l]
      i := minIndex(r := new(n, stupidget l))
      for a in l repeat
	copyInto_!(r, a, i)
	i := i + #a
      r

    sorted?(f, a) ==
      for i in minIndex(a)..maxIndex(a)-1 repeat
	not f(qelt(a, i), qelt(a, i + 1)) => return false
      true

    concat(x:%, y:%) ==
      z := stupidnew(#x + #y, x, y)
      copyInto_!(z, x, i := minIndex z)
      copyInto_!(z, y, i + #x)
      z

    if S has CoercibleTo(OutputForm) then
      coerce(r:%):OutputForm ==
	bracket commaSeparate
	      [qelt(r, k)::OutputForm for k in minIndex r .. maxIndex r]

    if S has SetCategory then
      x = y ==
	#x ^= #y => false
	for i in minIndex x .. maxIndex x repeat
	  not(qelt(x, i) = qelt(y, i)) => return false
	true

      position(x:S, t:%, s:Integer) ==
	n := maxIndex t
	s < minIndex t or s > n => error "index out of range"
	for k in s..n repeat
	  qelt(t, k) = x => return k
	minIndex(t) - 1

    if S has OrderedSet then
      a < b ==
	for i in minIndex a .. maxIndex a
	  for j in minIndex b .. maxIndex b repeat
	    qelt(a, i) ^= qelt(b, j) => return a.i < b.j
	#a < #b


@
\section{category ELAGG ExtensibleLinearAggregate}
<<category ELAGG ExtensibleLinearAggregate>>=
)abbrev category ELAGG ExtensibleLinearAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ An extensible aggregate is one which allows insertion and deletion of entries.
++ These aggregates are models of lists and streams which are represented
++ by linked structures so as to make insertion, deletion, and
++ concatenation efficient. However, access to elements of these
++ extensible aggregates is generally slow since access is made from the end.
++ See \spadtype{FlexibleArray} for an exception.
ExtensibleLinearAggregate(S:Type):Category == LinearAggregate S with
   shallowlyMutable
   concat_!: (%,S) -> %
     ++ concat!(u,x) destructively adds element x to the end of u.
   concat_!: (%,%) -> %
     ++ concat!(u,v) destructively appends v to the end of u.
     ++ v is unchanged
   delete_!: (%,Integer) -> %
     ++ delete!(u,i) destructively deletes the \axiom{i}th element of u.
   delete_!: (%,UniversalSegment(Integer)) -> %
     ++ delete!(u,i..j) destructively deletes elements u.i through u.j.
   remove_!: (S->Boolean,%) -> %
     ++ remove!(p,u) destructively removes all elements x of
     ++ u such that \axiom{p(x)} is true.
   insert_!: (S,%,Integer) -> %
     ++ insert!(x,u,i) destructively inserts x into u at position i.
   insert_!: (%,%,Integer) -> %
     ++ insert!(v,u,i) destructively inserts aggregate v into u at position i.
   merge_!: ((S,S)->Boolean,%,%) -> %
     ++ merge!(p,u,v) destructively merges u and v using predicate p.
   select_!: (S->Boolean,%) -> %
     ++ select!(p,u) destructively changes u by keeping only values x such that
     ++ \axiom{p(x)}.
   if S has SetCategory then
     remove_!: (S,%) -> %
       ++ remove!(x,u) destructively removes all values x from u.
     removeDuplicates_!: % -> %
       ++ removeDuplicates!(u) destructively removes duplicates from u.
   if S has OrderedSet then merge_!: (%,%) -> %
       ++ merge!(u,v) destructively merges u and v in ascending order.
 add
   delete(x:%, i:Integer)	   == delete_!(copy x, i)
   delete(x:%, i:UniversalSegment(Integer))	   == delete_!(copy x, i)
   remove(f:S -> Boolean, x:%)   == remove_!(f, copy x)
   insert(s:S, x:%, i:Integer)   == insert_!(s, copy x, i)
   insert(w:%, x:%, i:Integer)   == insert_!(copy w, copy x, i)
   select(f, x)		   == select_!(f, copy x)
   concat(x:%, y:%)	   == concat_!(copy x, y)
   concat(x:%, y:S)	   == concat_!(copy x, new(1, y))
   concat_!(x:%, y:S)	   == concat_!(x, new(1, y))
   if S has SetCategory then
     remove(s:S, x:%)	     == remove_!(s, copy x)
     remove_!(s:S, x:%)	     == remove_!(#1 = s, x)
     removeDuplicates(x:%)   == removeDuplicates_!(copy x)

   if S has OrderedSet then
     merge_!(x, y) == merge_!(_<$S, x, y)

@
\section{category LSAGG ListAggregate}
<<category LSAGG ListAggregate>>=
)abbrev category LSAGG ListAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A list aggregate is a model for a linked list data structure.
++ A linked list is a versatile
++ data structure. Insertion and deletion are efficient and
++ searching is a linear operation.
ListAggregate(S:Type): Category == Join(StreamAggregate S,
   FiniteLinearAggregate S, ExtensibleLinearAggregate S) with
      list: S -> %
	++ list(x) returns the list of one element x.
 add
   cycleMax ==> 1000

   mergeSort: ((S, S) -> Boolean, %, Integer) -> %

   sort_!(f, l)	      == mergeSort(f, l, #l)
   list x		   == concat(x, empty())
   reduce(f, x)		   ==
     empty? x => error "reducing over an empty list needs the 3 argument form"
     reduce(f, rest x, first x)
   merge(f, p, q)	   == merge_!(f, copy p, copy q)

   select_!(f, x) ==
     while not empty? x and not f first x repeat x := rest x
     empty? x => x
     y := x
     z := rest y
     while not empty? z repeat
       if f first z then (y := z; z := rest z)
		    else (z := rest z; setrest_!(y, z))
     x

   merge_!(f, p, q) ==
     empty? p => q
     empty? q => p
     eq?(p, q) => error "cannot merge a list into itself"
     if f(first p, first q)
       then (r := t := p; p := rest p)
       else (r := t := q; q := rest q)
     while not empty? p and not empty? q repeat
       if f(first p, first q)
	 then (setrest_!(t, p); t := p; p := rest p)
	 else (setrest_!(t, q); t := q; q := rest q)
     setrest_!(t, if empty? p then q else p)
     r

   insert_!(s:S, x:%, i:Integer) ==
     i < (m := minIndex x) => error "index out of range"
     i = m => concat(s, x)
     y := rest(x, (i - 1 - m)::NonNegativeInteger)
     z := rest y
     setrest_!(y, concat(s, z))
     x

   insert_!(w:%, x:%, i:Integer) ==
     i < (m := minIndex x) => error "index out of range"
     i = m => concat_!(w, x)
     y := rest(x, (i - 1 - m)::NonNegativeInteger)
     z := rest y
     setrest_!(y, w)
     concat_!(y, z)
     x

   remove_!(f:S -> Boolean, x:%) ==
     while not empty? x and f first x repeat x := rest x
     empty? x => x
     p := x
     q := rest x
     while not empty? q repeat
       if f first q then q := setrest_!(p, rest q)
		    else (p := q; q := rest q)
     x

   delete_!(x:%, i:Integer) ==
     i < (m := minIndex x) => error "index out of range"
     i = m => rest x
     y := rest(x, (i - 1 - m)::NonNegativeInteger)
     setrest_!(y, rest(y, 2))
     x

   delete_!(x:%, i:UniversalSegment(Integer)) ==
     (l := lo i) < (m := minIndex x) => error "index out of range"
     h := if hasHi i then hi i else maxIndex x
     h < l => x
     l = m => rest(x, (h + 1 - m)::NonNegativeInteger)
     t := rest(x, (l - 1 - m)::NonNegativeInteger)
     setrest_!(t, rest(t, (h - l + 2)::NonNegativeInteger))
     x

   find(f, x) ==
     while not empty? x and not f first x repeat x := rest x
     empty? x => "failed"
     first x

   position(f:S -> Boolean, x:%) ==
     for k in minIndex(x).. while not empty? x and not f first x repeat
       x := rest x
     empty? x => minIndex(x) - 1
     k

   mergeSort(f, p, n) ==
     if n = 2 and f(first rest p, first p) then p := reverse_! p
     n < 3 => p
     l := (n quo 2)::NonNegativeInteger
     q := split_!(p, l)
     p := mergeSort(f, p, l)
     q := mergeSort(f, q, n - l)
     merge_!(f, p, q)

   sorted?(f, l) ==
     empty? l => true
     p := rest l
     while not empty? p repeat
       not f(first l, first p) => return false
       p := rest(l := p)
     true

   reduce(f, x, i) ==
     r := i
     while not empty? x repeat (r := f(r, first x); x := rest x)
     r

   if S has SetCategory then
      reduce(f, x, i,a) ==
	r := i
	while not empty? x and r ^= a repeat
	  r := f(r, first x)
	  x := rest x
	r

   new(n, s) ==
     l := empty()
     for k in 1..n repeat l := concat(s, l)
     l

   map(f, x, y) ==
     z := empty()
     while not empty? x and not empty? y repeat
       z := concat(f(first x, first y), z)
       x := rest x
       y := rest y
     reverse_! z

-- map(f, x, y, d) ==
--   z := empty()
--   while not empty? x and not empty? y repeat
--     z := concat(f(first x, first y), z)
--     x := rest x
--     y := rest y
--   z := reverseInPlace z
--   if not empty? x then
--	z := concat_!(z, map(f(#1, d), x))
--   if not empty? y then
--	z := concat_!(z, map(f(d, #1), y))
--   z

   reverse_! x ==
     empty? x => x
     empty?(y := rest x) => x
     setrest_!(x, empty())
     while not empty? y repeat
       z := rest y
       setrest_!(y, x)
       x := y
       y := z
     x

   copy x ==
     y := empty()
     for k in 0.. while not empty? x repeat
       k = cycleMax and cyclic? x => error "cyclic list"
       y := concat(first x, y)
       x := rest x
     reverse_! y

   copyInto_!(y, x, s) ==
     s < (m := minIndex y) => error "index out of range"
     z := rest(y, (s - m)::NonNegativeInteger)
     while not empty? z and not empty? x repeat
       setfirst_!(z, first x)
       x := rest x
       z := rest z
     y

   if S has SetCategory then
     position(w, x, s) ==
       s < (m := minIndex x) => error "index out of range"
       x := rest(x, (s - m)::NonNegativeInteger)
       for k in s.. while not empty? x and w ^= first x repeat
	 x := rest x
       empty? x => minIndex x - 1
       k

     removeDuplicates_! l ==
       p := l
       while not empty? p repeat
	 p := setrest_!(p, remove_!(#1 = first p, rest p))
       l

   if S has OrderedSet then
     x < y ==
	while not empty? x and not empty? y repeat
	  first x ^= first y => return(first x < first y)
	  x := rest x
	  y := rest y
	empty? x => not empty? y
	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
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ An association list is a list of key entry pairs which may be viewed
++ as a table.	It is a poor mans version of a table:
++ searching for a key is a linear operation.
AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category ==
   Join(TableAggregate(Key, Entry), ListAggregate Record(key:Key,entry:Entry)) with
      assoc: (Key, %) -> Union(Record(key:Key,entry:Entry), "failed")
	++ assoc(k,u) returns the element x in association list u stored
	++ 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=#:G1402 &AUX #1=#:G1400)
  (DSETQ #1# #0#)
  (LET (#2=#:G1401)
    (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=#:G1399)
    (RETURN
      (PROG1 (LETT #0#
                   (|sublisV|
                       (PAIR '(|t#1| |t#2|)
                             (LIST (|devaluate| |t#1|)
                                   (|devaluate| |t#2|)))
                       (|sublisV|
                           (PAIR '(#1=#:G1398)
                                 (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
++ Author: Stephen Watt and Michael Monagan. revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ A string aggregate is a category for strings, that is,
++ one dimensional arrays of characters.
StringAggregate: Category == OneDimensionalArrayAggregate Character with
    lowerCase	    : % -> %
      ++ lowerCase(s) returns the string with all characters in lower case.
    lowerCase_!: % -> %
      ++ lowerCase!(s) destructively replaces the alphabetic characters
      ++ in s by lower case.
    upperCase	    : % -> %
      ++ upperCase(s) returns the string with all characters in upper case.
    upperCase_!: % -> %
      ++ upperCase!(s) destructively replaces the alphabetic characters
      ++ in s by upper case characters.
    prefix?	    : (%, %) -> Boolean
      ++ prefix?(s,t) tests if the string s is the initial substring of t.
      ++ Note: \axiom{prefix?(s,t) == reduce(and,[s.i = t.i for i in 0..maxIndex s])}.
    suffix?	    : (%, %) -> Boolean
      ++ suffix?(s,t) tests if the string s is the final substring of t.
      ++ Note: \axiom{suffix?(s,t) == reduce(and,[s.i = t.(n - m + i) for i in 0..maxIndex s])}
      ++ where m and n denote the maxIndex of s and t respectively.
    substring?: (%, %, Integer) -> Boolean
      ++ substring?(s,t,i) tests if s is a substring of t beginning at
      ++ index i.
      ++ Note: \axiom{substring?(s,t,0) = prefix?(s,t)}.
    match: (%, %, Character) -> NonNegativeInteger
      ++ match(p,s,wc) tests if pattern \axiom{p} matches subject \axiom{s}
      ++ where \axiom{wc} is a wild card character. If no match occurs,
      ++ the index \axiom{0} is returned; otheriwse, the value returned
      ++ is the first index of the first character in the subject matching
      ++ the subject (excluding that matched by an initial wild-card).
      ++ For example, \axiom{match("*to*","yorktown","*")} returns \axiom{5}
      ++ indicating a successful match starting at index \axiom{5} of
      ++ \axiom{"yorktown"}.
    match?: (%, %, Character) -> Boolean
      ++ match?(s,t,c) tests if s matches t except perhaps for
      ++ multiple and consecutive occurrences of character c.
      ++ Typically c is the blank character.
    replace	    : (%, UniversalSegment(Integer), %) -> %
      ++ replace(s,i..j,t) replaces the substring \axiom{s(i..j)} of s by string t.
    position	    : (%, %, Integer) -> Integer
      ++ position(s,t,i) returns the position j of the substring s in string t,
      ++ where \axiom{j >= i} is required.
    position	    : (CharacterClass, %, Integer) -> Integer
      ++ position(cc,t,i) returns the position \axiom{j >= i} in t of
      ++ the first character belonging to cc.
    coerce	    : Character -> %
      ++ coerce(c) returns c as a string s with the character c.

    split: (%, Character) -> List %
      ++ split(s,c) returns a list of substrings delimited by character c.
    split: (%, CharacterClass) -> List %
      ++ split(s,cc) returns a list of substrings delimited by characters in cc.

    trim: (%, Character) -> %
      ++ trim(s,c) returns s with all characters c deleted from right
      ++ and left ends.
      ++ For example, \axiom{trim(" abc ", char " ")} returns \axiom{"abc"}.
    trim: (%, CharacterClass) -> %
      ++ trim(s,cc) returns s with all characters in cc deleted from right
      ++ and left ends.
      ++ For example, \axiom{trim("(abc)", charClass "()")} returns \axiom{"abc"}.
    leftTrim: (%, Character) -> %
      ++ leftTrim(s,c) returns s with all leading characters c deleted.
      ++ For example, \axiom{leftTrim("  abc  ", char " ")} returns \axiom{"abc  "}.
    leftTrim: (%, CharacterClass) -> %
      ++ leftTrim(s,cc) returns s with all leading characters in cc deleted.
      ++ For example, \axiom{leftTrim("(abc)", charClass "()")} returns \axiom{"abc)"}.
    rightTrim: (%, Character) -> %
      ++ rightTrim(s,c) returns s with all trailing occurrences of c deleted.
      ++ For example, \axiom{rightTrim("  abc  ", char " ")} returns \axiom{"  abc"}.
    rightTrim: (%, CharacterClass) -> %
      ++ rightTrim(s,cc) returns s with all trailing occurences of
      ++ characters in cc deleted.
      ++ For example, \axiom{rightTrim("(abc)", charClass "()")} returns \axiom{"(abc"}.
    elt: (%, %) -> %
      ++ elt(s,t) returns the concatenation of s and t. It is provided to
      ++ allow juxtaposition of strings to work as concatenation.
      ++ For example, \axiom{"smoo" "shed"} returns \axiom{"smooshed"}.
 add
   trim(s: %, c:  Character)	  == leftTrim(rightTrim(s, c),	c)
   trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc)

   lowerCase s		 == lowerCase_! copy s
   upperCase s		 == upperCase_! copy s
   prefix?(s, t)	 == substring?(s, t, minIndex t)
   coerce(c:Character):% == new(1, c)
   elt(s:%, t:%): %	 == concat(s,t)$%

@
\section{category BTAGG BitAggregate}
<<category BTAGG BitAggregate>>=
)abbrev category BTAGG BitAggregate
++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks
++ Date Created: August 87 through August 88
++ Date Last Updated: April 1991
++ Basic Operations:
++ Related Constructors:
++ Also See:
++ AMS Classifications:
++ Keywords:
++ References:
++ Description:
++ The bit aggregate category models aggregates representing large
++ quantities of Boolean data.
BitAggregate(): Category ==
  Join(OrderedSet, Logic, OneDimensionalArrayAggregate Boolean) with
    "not": % -> %
      ++ not(b) returns the logical {\em not} of bit aggregate 
      ++ \axiom{b}.
    "^"  : % -> %
      ++ ^ b returns the logical {\em not} of bit aggregate 
      ++ \axiom{b}.
    nand : (%, %) -> %
      ++ nand(a,b) returns the logical {\em nand} of bit aggregates \axiom{a}
      ++ and \axiom{b}.
    nor	 : (%, %) -> %
      ++ nor(a,b) returns the logical {\em nor} of bit aggregates \axiom{a} and 
      ++ \axiom{b}.
    _and : (%, %) -> %
      ++ a and b returns the logical {\em and} of bit aggregates \axiom{a} and 
      ++ \axiom{b}.
    _or	 : (%, %) -> %
      ++ a or b returns the logical {\em or} of bit aggregates \axiom{a} and 
      ++ \axiom{b}.
    xor	 : (%, %) -> %
      ++ xor(a,b) returns the logical {\em exclusive-or} of bit aggregates
      ++ \axiom{a} and \axiom{b}.

 add
   not v      == map(_not, v)
   _^ v	      == map(_not, v)
   _~(v)      == map(_~, v)
   _/_\(v, u) == map(_/_\, v, u)
   _\_/(v, u) == map(_\_/, v, u)
   nand(v, u) == map(nand, v, u)
   nor(v, u)  == map(nor, v, u)

@
\section{License}
<<license>>=
--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
--All rights reserved.
--
--Redistribution and use in source and binary forms, with or without
--modification, are permitted provided that the following conditions are
--met:
--
--    - Redistributions of source code must retain the above copyright
--      notice, this list of conditions and the following disclaimer.
--
--    - Redistributions in binary form must reproduce the above copyright
--      notice, this list of conditions and the following disclaimer in
--      the documentation and/or other materials provided with the
--      distribution.
--
--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
--      names of its contributors may be used to endorse or promote products
--      derived from this software without specific prior written permission.
--
--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
@
<<*>>=
<<license>>

<<category AGG Aggregate>>
<<category HOAGG HomogeneousAggregate>>
<<category CLAGG Collection>>
<<category BGAGG BagAggregate>>
<<category SKAGG StackAggregate>>
<<category QUAGG QueueAggregate>>
<<category DQAGG DequeueAggregate>>
<<category PRQAGG PriorityQueueAggregate>>
<<category DIOPS DictionaryOperations>>
<<category DIAGG Dictionary>>
<<category MDAGG MultiDictionary>>
<<category SETAGG SetAggregate>>
<<category FSAGG FiniteSetAggregate>>
<<category MSETAGG MultisetAggregate>>
<<category OMSAGG OrderedMultisetAggregate>>
<<category KDAGG KeyedDictionary>>
<<category ELTAB Eltable>>
<<category ELTAGG EltableAggregate>>
<<category IXAGG IndexedAggregate>>
<<category TBAGG TableAggregate>>
<<category RCAGG RecursiveAggregate>>
<<category BRAGG BinaryRecursiveAggregate>>
<<category DLAGG DoublyLinkedAggregate>>
<<category URAGG UnaryRecursiveAggregate>>
<<category STAGG StreamAggregate>>
<<category LNAGG LinearAggregate>>
<<category FLAGG FiniteLinearAggregate>>
<<category A1AGG OneDimensionalArrayAggregate>>
<<category ELAGG ExtensibleLinearAggregate>>
<<category LSAGG ListAggregate>>
<<category ALAGG AssociationListAggregate>>
<<category SRAGG StringAggregate>>
<<category BTAGG BitAggregate>>

@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}