\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra list.spad}
\author{Michael Monagon, Manuel Bronstein}
\maketitle
\begin{abstract}
\end{abstract}
\eject
\tableofcontents
\eject
\section{domain ILIST IndexedList}
<<domain ILIST IndexedList>>=
)abbrev domain ILIST IndexedList
++ Author: Michael Monagan
++ Date Created: Sep 1987
++ Change History:
++ Basic Operations:
++   \#, concat, concat!, construct, copy, elt, elt, empty,
++   empty?, eq?, first, member?, merge!, mergeSort, minIndex,
++   parts, removeDuplicates!, rest, rest, reverse, reverse!,
++   setelt, setfirst!, setrest!, sort!, split!
++ Related Constructors: List
++ Also See:
++ AMS Classification:
++ Keywords: list, aggregate, index
++ Description:
++   \spadtype{IndexedList} is a basic implementation of the functions
++   in \spadtype{ListAggregate}, often using functions in the underlying
++   LISP system. The second parameter to the constructor (\spad{mn})
++   is the beginning index of the list. That is, if \spad{l} is a
++   list, then \spad{elt(l,mn)} is the first value. This constructor
++   is probably best viewed as the implementation of singly-linked
++   lists that are addressable by index rather than as a mere wrapper
++   for LISP lists.
IndexedList(S:Type, mn:Integer): Exports == Implementation where
 cycleMax ==> 1000        -- value used in checking for cycles

-- The following seems to be a bit out of date, but is kept in case
-- a knowledgeable person wants to update it:
--   The following LISP dependencies are divided into two groups
--   Those that are required
--   CONS, EQ, NIL, NULL, QCAR, QCDR, RPLACA, RPLACD
--   Those that are included for efficiency only
--   NEQ, LIST, CAR, CDR, NCONC2, NREVERSE, LENGTH
--   Also REVERSE, since it's called in Polynomial Ring

 Qfirst  ==> QCAR$Lisp
 Qrest   ==> QCDR$Lisp
 Qnull   ==> NULL$Lisp
 Qeq     ==> EQ$Lisp
 Qneq    ==> NEQ$Lisp
 Qcons   ==> CONS$Lisp
 Qpush   ==> PUSH$Lisp
 
 Exports ==> ListAggregate S 
 Implementation ==>
  add
   #x                  == LENGTH(x)$Lisp
   concat(s:S,x:%)     == CONS(s,x)$Lisp
   eq?(x,y)            == EQ(x,y)$Lisp
   first x             == SPADfirst(x)$Lisp
   elt(x,"first")      == SPADfirst(x)$Lisp
   empty()             == NIL$Lisp
   empty? x            == NULL(x)$Lisp
   rest x              == CDR(x)$Lisp
   elt(x,"rest")       == CDR(x)$Lisp
   setfirst_!(x,s)     ==
      empty? x => error "Cannot update an empty list"
      Qfirst RPLACA(x,s)$Lisp
   setelt(x,"first",s) ==
      empty? x => error "Cannot update an empty list"
      Qfirst RPLACA(x,s)$Lisp
   setrest_!(x,y)      ==
      empty? x => error "Cannot update an empty list"
      Qrest RPLACD(x,y)$Lisp
   setelt(x,"rest",y)  ==
      empty? x => error "Cannot update an empty list"
      Qrest RPLACD(x,y)$Lisp
   construct l         == l pretend %
   parts s             == s pretend List S
   reverse_! x         == NREVERSE(x)$Lisp
   reverse x           == REVERSE(x)$Lisp
   minIndex x          == mn

   rest(x, n) ==
      for i in 1..n repeat
         if Qnull x then error "index out of range"
         x := Qrest x
      x

   copy x ==
      y := empty()
      for i in 0.. while not Qnull x repeat
         if Qeq(i,cycleMax) and cyclic? x then error "cyclic list"
         y := Qcons(Qfirst x,y)
         x := Qrest x
      (NREVERSE(y)$Lisp)@%

   if S has CoercibleTo(OutputForm) then
     coerce(x):OutputForm ==
        -- displays cycle with overbar over the cycle
        y := empty()$List(OutputForm)
        s := cycleEntry x
        while Qneq(x, s) repeat
          y := concat((first x)::OutputForm, y)
          x := rest x
        y := reverse_! y
        empty? s => bracket y
        -- cyclic case: z is cylic part
        z := list((first x)::OutputForm)
        while Qneq(s, rest x) repeat
           x := rest x
           z := concat((first x)::OutputForm, z)
        bracket concat_!(y, overbar commaSeparate reverse_! z)

   if S has SetCategory then
     x = y ==
       Qeq(x,y) => true
       while not Qnull x and not Qnull y repeat
          Qfirst x ^=$S Qfirst y => return false
          x := Qrest x
          y := Qrest y
       Qnull x and Qnull y

     latex(x : %): String ==
       s : String := "\left["
       while not Qnull x repeat
         s := concat(s, latex(Qfirst x)$S)$String
         x := Qrest x
         if not Qnull x then s := concat(s, ", ")$String
       concat(s, " \right]")$String

     member?(s,x) ==
        while not Qnull x repeat
           if s = Qfirst x then return true else x := Qrest x
        false

   -- Lots of code from parts of AGGCAT, repeated here to
   -- get faster compilation
   concat_!(x:%,y:%) ==
      Qnull x => 
        Qnull y => x
        Qpush(first y,x)
        QRPLACD(x,rest y)$Lisp
        x
      z:=x
      while not Qnull Qrest z repeat
        z:=Qrest z
      QRPLACD(z,y)$Lisp
      x

   -- Then a quicky:
   if S has SetCategory then
     removeDuplicates_! l ==
       p := l
       while not Qnull p repeat
--       p := setrest_!(p, remove_!(#1 = Qfirst p, Qrest p))
-- far too expensive - builds closures etc.
         pp:=p
         f:S:=Qfirst p
         p:=Qrest p
         while not Qnull (pr:=Qrest pp) repeat
           if (Qfirst pr)@S = f then QRPLACD(pp,Qrest pr)$Lisp
           else pp:=pr
       l

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

   sort_!(f, l)       == mergeSort(f, l, #l)

   merge_!(f, p, q) ==
     Qnull p => q
     Qnull q => p
     Qeq(p, q) => error "cannot merge a list into itself"
     if f(Qfirst p, Qfirst q)
       then (r := t := p; p := Qrest p)
       else (r := t := q; q := Qrest q)
     while not Qnull p and not Qnull q repeat
       if f(Qfirst p, Qfirst q)
         then (QRPLACD(t, p)$Lisp; t := p; p := Qrest p)
         else (QRPLACD(t, q)$Lisp; t := q; q := Qrest q)
     QRPLACD(t, if Qnull p then q else p)$Lisp
     r

   split_!(p, n) ==
      n < 1 => error "index out of range"
      p := rest(p, (n - 1)::NonNegativeInteger)
      q := Qrest p
      QRPLACD(p, NIL$Lisp)$Lisp
      q

   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)

@
\section{ILIST.lsp BOOTSTRAP} 
{\bf ILIST} 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 ILIST} category which we can write
into the {\bf MID} directory. We compile the lisp code and copy the
{\bf ILIST.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.

<<ILIST.lsp BOOTSTRAP>>=

(/VERSIONCHECK 2) 

(PUT '|ILIST;#;$Nni;1| '|SPADreplace| 'LENGTH) 

(DEFUN |ILIST;#;$Nni;1| (|x| $) (LENGTH |x|)) 

(PUT '|ILIST;concat;S2$;2| '|SPADreplace| 'CONS) 

(DEFUN |ILIST;concat;S2$;2| (|s| |x| $) (CONS |s| |x|)) 

(PUT '|ILIST;eq?;2$B;3| '|SPADreplace| 'EQ) 

(DEFUN |ILIST;eq?;2$B;3| (|x| |y| $) (EQ |x| |y|)) 

(PUT '|ILIST;first;$S;4| '|SPADreplace| '|SPADfirst|) 

(DEFUN |ILIST;first;$S;4| (|x| $) (|SPADfirst| |x|)) 

(PUT '|ILIST;elt;$firstS;5| '|SPADreplace|
     '(XLAM (|x| "first") (|SPADfirst| |x|))) 

(DEFUN |ILIST;elt;$firstS;5| (|x| T0 $) (|SPADfirst| |x|)) 

(PUT '|ILIST;empty;$;6| '|SPADreplace| '(XLAM NIL NIL)) 

(DEFUN |ILIST;empty;$;6| ($) NIL) 

(PUT '|ILIST;empty?;$B;7| '|SPADreplace| 'NULL) 

(DEFUN |ILIST;empty?;$B;7| (|x| $) (NULL |x|)) 

(PUT '|ILIST;rest;2$;8| '|SPADreplace| 'CDR) 

(DEFUN |ILIST;rest;2$;8| (|x| $) (CDR |x|)) 

(PUT '|ILIST;elt;$rest$;9| '|SPADreplace|
     '(XLAM (|x| "rest") (CDR |x|))) 

(DEFUN |ILIST;elt;$rest$;9| (|x| T1 $) (CDR |x|)) 

(DEFUN |ILIST;setfirst!;$2S;10| (|x| |s| $)
  (COND
    ((SPADCALL |x| (QREFELT $ 17))
     (|error| "Cannot update an empty list"))
    ('T (QCAR (RPLACA |x| |s|))))) 

(DEFUN |ILIST;setelt;$first2S;11| (|x| T2 |s| $)
  (COND
    ((SPADCALL |x| (QREFELT $ 17))
     (|error| "Cannot update an empty list"))
    ('T (QCAR (RPLACA |x| |s|))))) 

(DEFUN |ILIST;setrest!;3$;12| (|x| |y| $)
  (COND
    ((SPADCALL |x| (QREFELT $ 17))
     (|error| "Cannot update an empty list"))
    ('T (QCDR (RPLACD |x| |y|))))) 

(DEFUN |ILIST;setelt;$rest2$;13| (|x| T3 |y| $)
  (COND
    ((SPADCALL |x| (QREFELT $ 17))
     (|error| "Cannot update an empty list"))
    ('T (QCDR (RPLACD |x| |y|))))) 

(PUT '|ILIST;construct;L$;14| '|SPADreplace| '(XLAM (|l|) |l|)) 

(DEFUN |ILIST;construct;L$;14| (|l| $) |l|) 

(PUT '|ILIST;parts;$L;15| '|SPADreplace| '(XLAM (|s|) |s|)) 

(DEFUN |ILIST;parts;$L;15| (|s| $) |s|) 

(PUT '|ILIST;reverse!;2$;16| '|SPADreplace| 'NREVERSE) 

(DEFUN |ILIST;reverse!;2$;16| (|x| $) (NREVERSE |x|)) 

(PUT '|ILIST;reverse;2$;17| '|SPADreplace| 'REVERSE) 

(DEFUN |ILIST;reverse;2$;17| (|x| $) (REVERSE |x|)) 

(DEFUN |ILIST;minIndex;$I;18| (|x| $) (QREFELT $ 7)) 

(DEFUN |ILIST;rest;$Nni$;19| (|x| |n| $)
  (PROG (|i|)
    (RETURN
      (SEQ (SEQ (LETT |i| 1 |ILIST;rest;$Nni$;19|) G190
                (COND ((QSGREATERP |i| |n|) (GO G191)))
                (SEQ (COND
                       ((NULL |x|) (|error| "index out of range")))
                     (EXIT (LETT |x| (QCDR |x|) |ILIST;rest;$Nni$;19|)))
                (LETT |i| (QSADD1 |i|) |ILIST;rest;$Nni$;19|) (GO G190)
                G191 (EXIT NIL))
           (EXIT |x|))))) 

(DEFUN |ILIST;copy;2$;20| (|x| $)
  (PROG (|i| |y|)
    (RETURN
      (SEQ (LETT |y| (SPADCALL (QREFELT $ 16)) |ILIST;copy;2$;20|)
           (SEQ (LETT |i| 0 |ILIST;copy;2$;20|) G190
                (COND
                  ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33)))
                   (GO G191)))
                (SEQ (COND
                       ((EQ |i| 1000)
                        (COND
                          ((SPADCALL |x| (QREFELT $ 34))
                           (|error| "cyclic list")))))
                     (LETT |y| (CONS (QCAR |x|) |y|)
                           |ILIST;copy;2$;20|)
                     (EXIT (LETT |x| (QCDR |x|) |ILIST;copy;2$;20|)))
                (LETT |i| (QSADD1 |i|) |ILIST;copy;2$;20|) (GO G190)
                G191 (EXIT NIL))
           (EXIT (NREVERSE |y|)))))) 

(DEFUN |ILIST;coerce;$Of;21| (|x| $)
  (PROG (|s| |y| |z|)
    (RETURN
      (SEQ (LETT |y| NIL |ILIST;coerce;$Of;21|)
           (LETT |s| (SPADCALL |x| (QREFELT $ 36))
                 |ILIST;coerce;$Of;21|)
           (SEQ G190 (COND ((NULL (NEQ |x| |s|)) (GO G191)))
                (SEQ (LETT |y|
                           (CONS (SPADCALL
                                     (SPADCALL |x| (QREFELT $ 13))
                                     (QREFELT $ 38))
                                 |y|)
                           |ILIST;coerce;$Of;21|)
                     (EXIT (LETT |x| (SPADCALL |x| (QREFELT $ 18))
                                 |ILIST;coerce;$Of;21|)))
                NIL (GO G190) G191 (EXIT NIL))
           (LETT |y| (NREVERSE |y|) |ILIST;coerce;$Of;21|)
           (EXIT (COND
                   ((SPADCALL |s| (QREFELT $ 17))
                    (SPADCALL |y| (QREFELT $ 40)))
                   ('T
                    (SEQ (LETT |z|
                               (SPADCALL
                                   (SPADCALL
                                    (SPADCALL |x| (QREFELT $ 13))
                                    (QREFELT $ 38))
                                   (QREFELT $ 42))
                               |ILIST;coerce;$Of;21|)
                         (SEQ G190
                              (COND
                                ((NULL (NEQ |s|
                                        (SPADCALL |x| (QREFELT $ 18))))
                                 (GO G191)))
                              (SEQ (LETT |x|
                                    (SPADCALL |x| (QREFELT $ 18))
                                    |ILIST;coerce;$Of;21|)
                                   (EXIT
                                    (LETT |z|
                                     (CONS
                                      (SPADCALL
                                       (SPADCALL |x| (QREFELT $ 13))
                                       (QREFELT $ 38))
                                      |z|)
                                     |ILIST;coerce;$Of;21|)))
                              NIL (GO G190) G191 (EXIT NIL))
                         (EXIT (SPADCALL
                                   (SPADCALL |y|
                                    (SPADCALL
                                     (SPADCALL (NREVERSE |z|)
                                      (QREFELT $ 43))
                                     (QREFELT $ 44))
                                    (QREFELT $ 45))
                                   (QREFELT $ 40))))))))))) 

(DEFUN |ILIST;=;2$B;22| (|x| |y| $)
  (PROG (#0=#:G1469)
    (RETURN
      (SEQ (EXIT (COND
                   ((EQ |x| |y|) 'T)
                   ('T
                    (SEQ (SEQ G190
                              (COND
                                ((NULL (COND
                                         ((NULL |x|) 'NIL)
                                         ('T
                                          (SPADCALL (NULL |y|)
                                           (QREFELT $ 33)))))
                                 (GO G191)))
                              (SEQ (EXIT
                                    (COND
                                      ((NULL
                                        (SPADCALL (QCAR |x|) (QCAR |y|)
                                         (QREFELT $ 47)))
                                       (PROGN
                                         (LETT #0# 'NIL
                                          |ILIST;=;2$B;22|)
                                         (GO #0#)))
                                      ('T
                                       (SEQ
                                        (LETT |x| (QCDR |x|)
                                         |ILIST;=;2$B;22|)
                                        (EXIT
                                         (LETT |y| (QCDR |y|)
                                          |ILIST;=;2$B;22|)))))))
                              NIL (GO G190) G191 (EXIT NIL))
                         (EXIT (COND
                                 ((NULL |x|) (NULL |y|))
                                 ('T 'NIL)))))))
           #0# (EXIT #0#))))) 

(DEFUN |ILIST;latex;$S;23| (|x| $)
  (PROG (|s|)
    (RETURN
      (SEQ (LETT |s| "\\left[" |ILIST;latex;$S;23|)
           (SEQ G190
                (COND
                  ((NULL (SPADCALL (NULL |x|) (QREFELT $ 33)))
                   (GO G191)))
                (SEQ (LETT |s|
                           (STRCONC |s|
                                    (SPADCALL (QCAR |x|)
                                     (QREFELT $ 50)))
                           |ILIST;latex;$S;23|)
                     (LETT |x| (QCDR |x|) |ILIST;latex;$S;23|)
                     (EXIT (COND
                             ((NULL (NULL |x|))
                              (LETT |s| (STRCONC |s| ", ")
                                    |ILIST;latex;$S;23|)))))
                NIL (GO G190) G191 (EXIT NIL))
           (EXIT (STRCONC |s| " \\right]")))))) 

(DEFUN |ILIST;member?;S$B;24| (|s| |x| $)
  (PROG (#0=#:G1477)
    (RETURN
      (SEQ (EXIT (SEQ (SEQ G190
                           (COND
                             ((NULL (SPADCALL (NULL |x|)
                                     (QREFELT $ 33)))
                              (GO G191)))
                           (SEQ (EXIT (COND
                                        ((SPADCALL |s| (QCAR |x|)
                                          (QREFELT $ 47))
                                         (PROGN
                                           (LETT #0# 'T
                                            |ILIST;member?;S$B;24|)
                                           (GO #0#)))
                                        ('T
                                         (LETT |x| (QCDR |x|)
                                          |ILIST;member?;S$B;24|)))))
                           NIL (GO G190) G191 (EXIT NIL))
                      (EXIT 'NIL)))
           #0# (EXIT #0#))))) 

(DEFUN |ILIST;concat!;3$;25| (|x| |y| $)
  (PROG (|z|)
    (RETURN
      (SEQ (COND
             ((NULL |x|)
              (COND
                ((NULL |y|) |x|)
                ('T
                 (SEQ (PUSH (SPADCALL |y| (QREFELT $ 13)) |x|)
                      (QRPLACD |x| (SPADCALL |y| (QREFELT $ 18)))
                      (EXIT |x|)))))
             ('T
              (SEQ (LETT |z| |x| |ILIST;concat!;3$;25|)
                   (SEQ G190
                        (COND
                          ((NULL (SPADCALL (NULL (QCDR |z|))
                                     (QREFELT $ 33)))
                           (GO G191)))
                        (SEQ (EXIT (LETT |z| (QCDR |z|)
                                    |ILIST;concat!;3$;25|)))
                        NIL (GO G190) G191 (EXIT NIL))
                   (QRPLACD |z| |y|) (EXIT |x|)))))))) 

(DEFUN |ILIST;removeDuplicates!;2$;26| (|l| $)
  (PROG (|f| |p| |pr| |pp|)
    (RETURN
      (SEQ (LETT |p| |l| |ILIST;removeDuplicates!;2$;26|)
           (SEQ G190
                (COND
                  ((NULL (SPADCALL (NULL |p|) (QREFELT $ 33)))
                   (GO G191)))
                (SEQ (LETT |pp| |p| |ILIST;removeDuplicates!;2$;26|)
                     (LETT |f| (QCAR |p|)
                           |ILIST;removeDuplicates!;2$;26|)
                     (LETT |p| (QCDR |p|)
                           |ILIST;removeDuplicates!;2$;26|)
                     (EXIT (SEQ G190
                                (COND
                                  ((NULL
                                    (SPADCALL
                                     (NULL
                                      (LETT |pr| (QCDR |pp|)
                                       |ILIST;removeDuplicates!;2$;26|))
                                     (QREFELT $ 33)))
                                   (GO G191)))
                                (SEQ (EXIT
                                      (COND
                                        ((SPADCALL (QCAR |pr|) |f|
                                          (QREFELT $ 47))
                                         (QRPLACD |pp| (QCDR |pr|)))
                                        ('T
                                         (LETT |pp| |pr|
                                          |ILIST;removeDuplicates!;2$;26|)))))
                                NIL (GO G190) G191 (EXIT NIL))))
                NIL (GO G190) G191 (EXIT NIL))
           (EXIT |l|))))) 

(DEFUN |ILIST;sort!;M2$;27| (|f| |l| $)
  (|ILIST;mergeSort| |f| |l| (SPADCALL |l| (QREFELT $ 9)) $)) 

(DEFUN |ILIST;merge!;M3$;28| (|f| |p| |q| $)
  (PROG (|r| |t|)
    (RETURN
      (SEQ (COND
             ((NULL |p|) |q|)
             ((NULL |q|) |p|)
             ((EQ |p| |q|) (|error| "cannot merge a list into itself"))
             ('T
              (SEQ (COND
                     ((SPADCALL (QCAR |p|) (QCAR |q|) |f|)
                      (SEQ (LETT |r|
                                 (LETT |t| |p| |ILIST;merge!;M3$;28|)
                                 |ILIST;merge!;M3$;28|)
                           (EXIT (LETT |p| (QCDR |p|)
                                       |ILIST;merge!;M3$;28|))))
                     ('T
                      (SEQ (LETT |r|
                                 (LETT |t| |q| |ILIST;merge!;M3$;28|)
                                 |ILIST;merge!;M3$;28|)
                           (EXIT (LETT |q| (QCDR |q|)
                                       |ILIST;merge!;M3$;28|)))))
                   (SEQ G190
                        (COND
                          ((NULL (COND
                                   ((NULL |p|) 'NIL)
                                   ('T
                                    (SPADCALL (NULL |q|)
                                     (QREFELT $ 33)))))
                           (GO G191)))
                        (SEQ (EXIT (COND
                                     ((SPADCALL (QCAR |p|) (QCAR |q|)
                                       |f|)
                                      (SEQ (QRPLACD |t| |p|)
                                       (LETT |t| |p|
                                        |ILIST;merge!;M3$;28|)
                                       (EXIT
                                        (LETT |p| (QCDR |p|)
                                         |ILIST;merge!;M3$;28|))))
                                     ('T
                                      (SEQ (QRPLACD |t| |q|)
                                       (LETT |t| |q|
                                        |ILIST;merge!;M3$;28|)
                                       (EXIT
                                        (LETT |q| (QCDR |q|)
                                         |ILIST;merge!;M3$;28|)))))))
                        NIL (GO G190) G191 (EXIT NIL))
                   (QRPLACD |t| (COND ((NULL |p|) |q|) ('T |p|)))
                   (EXIT |r|)))))))) 

(DEFUN |ILIST;split!;$I$;29| (|p| |n| $)
  (PROG (#0=#:G1506 |q|)
    (RETURN
      (SEQ (COND
             ((< |n| 1) (|error| "index out of range"))
             ('T
              (SEQ (LETT |p|
                         (SPADCALL |p|
                             (PROG1 (LETT #0# (- |n| 1)
                                     |ILIST;split!;$I$;29|)
                               (|check-subtype| (>= #0# 0)
                                   '(|NonNegativeInteger|) #0#))
                             (QREFELT $ 32))
                         |ILIST;split!;$I$;29|)
                   (LETT |q| (QCDR |p|) |ILIST;split!;$I$;29|)
                   (QRPLACD |p| NIL) (EXIT |q|)))))))) 

(DEFUN |ILIST;mergeSort| (|f| |p| |n| $)
  (PROG (#0=#:G1510 |l| |q|)
    (RETURN
      (SEQ (COND
             ((EQL |n| 2)
              (COND
                ((SPADCALL
                     (SPADCALL (SPADCALL |p| (QREFELT $ 18))
                         (QREFELT $ 13))
                     (SPADCALL |p| (QREFELT $ 13)) |f|)
                 (LETT |p| (SPADCALL |p| (QREFELT $ 28))
                       |ILIST;mergeSort|)))))
           (EXIT (COND
                   ((< |n| 3) |p|)
                   ('T
                    (SEQ (LETT |l|
                               (PROG1 (LETT #0# (QUOTIENT2 |n| 2)
                                       |ILIST;mergeSort|)
                                 (|check-subtype| (>= #0# 0)
                                     '(|NonNegativeInteger|) #0#))
                               |ILIST;mergeSort|)
                         (LETT |q| (SPADCALL |p| |l| (QREFELT $ 58))
                               |ILIST;mergeSort|)
                         (LETT |p| (|ILIST;mergeSort| |f| |p| |l| $)
                               |ILIST;mergeSort|)
                         (LETT |q|
                               (|ILIST;mergeSort| |f| |q| (- |n| |l|)
                                   $)
                               |ILIST;mergeSort|)
                         (EXIT (SPADCALL |f| |p| |q| (QREFELT $ 57))))))))))) 

(DEFUN |IndexedList| (&REST #0=#:G1525 &AUX #1=#:G1523)
  (DSETQ #1# #0#)
  (PROG ()
    (RETURN
      (PROG (#2=#:G1524)
        (RETURN
          (COND
            ((LETT #2#
                   (|lassocShiftWithFunction| (|devaluateList| #1#)
                       (HGET |$ConstructorCache| '|IndexedList|)
                       '|domainEqualList|)
                   |IndexedList|)
             (|CDRwithIncrement| #2#))
            ('T
             (UNWIND-PROTECT
               (PROG1 (APPLY (|function| |IndexedList;|) #1#)
                 (LETT #2# T |IndexedList|))
               (COND
                 ((NOT #2#) (HREM |$ConstructorCache| '|IndexedList|))))))))))) 

(DEFUN |IndexedList;| (|#1| |#2|)
  (PROG (|dv$1| |dv$2| |dv$| $ #0=#:G1522 #1=#:G1520 |pv$|)
    (RETURN
      (PROGN
        (LETT |dv$1| (|devaluate| |#1|) . #2=(|IndexedList|))
        (LETT |dv$2| (|devaluate| |#2|) . #2#)
        (LETT |dv$| (LIST '|IndexedList| |dv$1| |dv$2|) . #2#)
        (LETT $ (GETREFV 72) . #2#)
        (QSETREFV $ 0 |dv$|)
        (QSETREFV $ 3
            (LETT |pv$|
                  (|buildPredVector| 0 0
                      (LIST (|HasCategory| |#1|
                                '(|ConvertibleTo| (|InputForm|)))
                            (|HasCategory| |#1| '(|OrderedSet|))
                            (|HasCategory| (|Integer|) '(|OrderedSet|))
                            (LETT #0#
                                  (|HasCategory| |#1| '(|SetCategory|)) . #2#)
                            (OR (|HasCategory| |#1| '(|OrderedSet|))
                                #0#)
                            (AND #0#
                                 (|HasCategory| |#1|
                                     (LIST '|Evalable|
                                      (|devaluate| |#1|))))
                            (OR (AND (|HasCategory| |#1|
                                      '(|OrderedSet|))
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|))))
                                (AND #0#
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|)))))
                            (LETT #1#
                                  (|HasCategory| |#1|
                                      '(|CoercibleTo| (|OutputForm|))) . #2#)
                            (OR (AND #0#
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|))))
                                #1#))) . #2#))
        (|haddProp| |$ConstructorCache| '|IndexedList|
            (LIST |dv$1| |dv$2|) (CONS 1 $))
        (|stuffDomainSlots| $)
        (QSETREFV $ 6 |#1|)
        (QSETREFV $ 7 |#2|)
        (COND
          ((|testBitVector| |pv$| 8)
           (QSETREFV $ 46
               (CONS (|dispatchFunction| |ILIST;coerce;$Of;21|) $))))
        (COND
          ((|testBitVector| |pv$| 4)
           (PROGN
             (QSETREFV $ 48
                 (CONS (|dispatchFunction| |ILIST;=;2$B;22|) $))
             (QSETREFV $ 51
                 (CONS (|dispatchFunction| |ILIST;latex;$S;23|) $))
             (QSETREFV $ 52
                 (CONS (|dispatchFunction| |ILIST;member?;S$B;24|) $)))))
        (COND
          ((|testBitVector| |pv$| 4)
           (QSETREFV $ 54
               (CONS (|dispatchFunction|
                         |ILIST;removeDuplicates!;2$;26|)
                     $))))
        $)))) 

(MAKEPROP '|IndexedList| '|infovec|
    (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|)
             (|NonNegativeInteger|) |ILIST;#;$Nni;1|
             |ILIST;concat;S2$;2| (|Boolean|) |ILIST;eq?;2$B;3|
             |ILIST;first;$S;4| '"first" |ILIST;elt;$firstS;5|
             |ILIST;empty;$;6| |ILIST;empty?;$B;7| |ILIST;rest;2$;8|
             '"rest" |ILIST;elt;$rest$;9| |ILIST;setfirst!;$2S;10|
             |ILIST;setelt;$first2S;11| |ILIST;setrest!;3$;12|
             |ILIST;setelt;$rest2$;13| (|List| 6)
             |ILIST;construct;L$;14| |ILIST;parts;$L;15|
             |ILIST;reverse!;2$;16| |ILIST;reverse;2$;17| (|Integer|)
             |ILIST;minIndex;$I;18| |ILIST;rest;$Nni$;19| (0 . |not|)
             (5 . |cyclic?|) |ILIST;copy;2$;20| (10 . |cycleEntry|)
             (|OutputForm|) (15 . |coerce|) (|List| $) (20 . |bracket|)
             (|List| 37) (25 . |list|) (30 . |commaSeparate|)
             (35 . |overbar|) (40 . |concat!|) (46 . |coerce|) (51 . =)
             (57 . =) (|String|) (63 . |latex|) (68 . |latex|)
             (73 . |member?|) |ILIST;concat!;3$;25|
             (79 . |removeDuplicates!|) (|Mapping| 11 6 6)
             |ILIST;sort!;M2$;27| |ILIST;merge!;M3$;28|
             |ILIST;split!;$I$;29| (|Mapping| 6 6 6) (|Equation| 6)
             (|List| 60) (|Mapping| 11 6) (|Void|)
             (|UniversalSegment| 30) '"last" '"value" (|Mapping| 6 6)
             (|InputForm|) (|SingleInteger|) (|List| 30)
             (|Union| 6 '"failed"))
          '#(~= 84 |value| 90 |third| 95 |tail| 100 |swap!| 105
             |split!| 112 |sorted?| 118 |sort!| 129 |sort| 140 |size?|
             151 |setvalue!| 157 |setrest!| 163 |setlast!| 169
             |setfirst!| 175 |setelt| 181 |setchildren!| 223 |select!|
             229 |select| 235 |second| 241 |sample| 246 |reverse!| 250
             |reverse| 255 |rest| 260 |removeDuplicates!| 271
             |removeDuplicates| 276 |remove!| 281 |remove| 293 |reduce|
             305 |qsetelt!| 326 |qelt| 333 |possiblyInfinite?| 339
             |position| 344 |parts| 363 |nodes| 368 |node?| 373 |new|
             379 |more?| 385 |minIndex| 391 |min| 396 |merge!| 402
             |merge| 415 |members| 428 |member?| 433 |maxIndex| 439
             |max| 444 |map!| 450 |map| 456 |list| 469 |less?| 474
             |leaves| 480 |leaf?| 485 |latex| 490 |last| 495 |insert!|
             506 |insert| 520 |indices| 534 |index?| 539 |hash| 545
             |first| 550 |find| 561 |fill!| 567 |explicitlyFinite?| 573
             |every?| 578 |eval| 584 |eq?| 610 |entry?| 616 |entries|
             622 |empty?| 627 |empty| 632 |elt| 636 |distance| 679
             |delete!| 685 |delete| 697 |cyclic?| 709 |cycleTail| 714
             |cycleSplit!| 719 |cycleLength| 724 |cycleEntry| 729
             |count| 734 |copyInto!| 746 |copy| 753 |convert| 758
             |construct| 763 |concat!| 768 |concat| 780 |coerce| 803
             |children| 808 |child?| 813 |any?| 819 >= 825 > 831 = 837
             <= 843 < 849 |#| 855)
          '((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
          (CONS (|makeByteWordVec2| 9
                    '(0 0 0 0 0 0 0 0 0 0 2 0 0 7 5 0 0 7 9 1 5))
                (CONS '#(|ListAggregate&| |StreamAggregate&|
                         |ExtensibleLinearAggregate&|
                         |FiniteLinearAggregate&|
                         |UnaryRecursiveAggregate&| |LinearAggregate&|
                         |RecursiveAggregate&| |IndexedAggregate&|
                         |Collection&| |HomogeneousAggregate&|
                         |OrderedSet&| |Aggregate&| |EltableAggregate&|
                         |Evalable&| |SetCategory&| NIL NIL
                         |InnerEvalable&| NIL NIL |BasicType&|)
                      (CONS '#((|ListAggregate| 6)
                               (|StreamAggregate| 6)
                               (|ExtensibleLinearAggregate| 6)
                               (|FiniteLinearAggregate| 6)
                               (|UnaryRecursiveAggregate| 6)
                               (|LinearAggregate| 6)
                               (|RecursiveAggregate| 6)
                               (|IndexedAggregate| 30 6)
                               (|Collection| 6)
                               (|HomogeneousAggregate| 6)
                               (|OrderedSet|) (|Aggregate|)
                               (|EltableAggregate| 30 6) (|Evalable| 6)
                               (|SetCategory|) (|Type|)
                               (|Eltable| 30 6) (|InnerEvalable| 6 6)
                               (|CoercibleTo| 37) (|ConvertibleTo| 68)
                               (|BasicType|))
                            (|makeByteWordVec2| 71
                                '(1 11 0 0 33 1 0 11 0 34 1 0 0 0 36 1
                                  6 37 0 38 1 37 0 39 40 1 41 0 37 42 1
                                  37 0 39 43 1 37 0 0 44 2 41 0 0 37 45
                                  1 0 37 0 46 2 6 11 0 0 47 2 0 11 0 0
                                  48 1 6 49 0 50 1 0 49 0 51 2 0 11 6 0
                                  52 1 0 0 0 54 2 4 11 0 0 1 1 0 6 0 1
                                  1 0 6 0 1 1 0 0 0 1 3 0 63 0 30 30 1
                                  2 0 0 0 30 58 1 2 11 0 1 2 0 11 55 0
                                  1 1 2 0 0 1 2 0 0 55 0 56 1 2 0 0 1 2
                                  0 0 55 0 1 2 0 11 0 8 1 2 0 6 0 6 1 2
                                  0 0 0 0 23 2 0 6 0 6 1 2 0 6 0 6 21 3
                                  0 6 0 30 6 1 3 0 6 0 64 6 1 3 0 6 0
                                  65 6 1 3 0 0 0 19 0 24 3 0 6 0 14 6
                                  22 3 0 6 0 66 6 1 2 0 0 0 39 1 2 0 0
                                  62 0 1 2 0 0 62 0 1 1 0 6 0 1 0 0 0 1
                                  1 0 0 0 28 1 0 0 0 29 2 0 0 0 8 32 1
                                  0 0 0 18 1 4 0 0 54 1 4 0 0 1 2 4 0 6
                                  0 1 2 0 0 62 0 1 2 4 0 6 0 1 2 0 0 62
                                  0 1 4 4 6 59 0 6 6 1 2 0 6 59 0 1 3 0
                                  6 59 0 6 1 3 0 6 0 30 6 1 2 0 6 0 30
                                  1 1 0 11 0 1 2 4 30 6 0 1 3 4 30 6 0
                                  30 1 2 0 30 62 0 1 1 0 25 0 27 1 0 39
                                  0 1 2 4 11 0 0 1 2 0 0 8 6 1 2 0 11 0
                                  8 1 1 3 30 0 31 2 2 0 0 0 1 2 2 0 0 0
                                  1 3 0 0 55 0 0 57 2 2 0 0 0 1 3 0 0
                                  55 0 0 1 1 0 25 0 1 2 4 11 6 0 52 1 3
                                  30 0 1 2 2 0 0 0 1 2 0 0 67 0 1 3 0 0
                                  59 0 0 1 2 0 0 67 0 1 1 0 0 6 1 2 0
                                  11 0 8 1 1 0 25 0 1 1 0 11 0 1 1 4 49
                                  0 51 2 0 0 0 8 1 1 0 6 0 1 3 0 0 6 0
                                  30 1 3 0 0 0 0 30 1 3 0 0 0 0 30 1 3
                                  0 0 6 0 30 1 1 0 70 0 1 2 0 11 30 0 1
                                  1 4 69 0 1 2 0 0 0 8 1 1 0 6 0 13 2 0
                                  71 62 0 1 2 0 0 0 6 1 1 0 11 0 1 2 0
                                  11 62 0 1 3 6 0 0 6 6 1 3 6 0 0 25 25
                                  1 2 6 0 0 60 1 2 6 0 0 61 1 2 0 11 0
                                  0 12 2 4 11 6 0 1 1 0 25 0 1 1 0 11 0
                                  17 0 0 0 16 2 0 6 0 30 1 3 0 6 0 30 6
                                  1 2 0 0 0 64 1 2 0 6 0 65 1 2 0 0 0
                                  19 20 2 0 6 0 14 15 2 0 6 0 66 1 2 0
                                  30 0 0 1 2 0 0 0 64 1 2 0 0 0 30 1 2
                                  0 0 0 64 1 2 0 0 0 30 1 1 0 11 0 34 1
                                  0 0 0 1 1 0 0 0 1 1 0 8 0 1 1 0 0 0
                                  36 2 4 8 6 0 1 2 0 8 62 0 1 3 0 0 0 0
                                  30 1 1 0 0 0 35 1 1 68 0 1 1 0 0 25
                                  26 2 0 0 0 0 53 2 0 0 0 6 1 1 0 0 39
                                  1 2 0 0 0 6 1 2 0 0 6 0 10 2 0 0 0 0
                                  1 1 8 37 0 46 1 0 39 0 1 2 4 11 0 0 1
                                  2 0 11 62 0 1 2 2 11 0 0 1 2 2 11 0 0
                                  1 2 4 11 0 0 48 2 2 11 0 0 1 2 2 11 0
                                  0 1 1 0 8 0 9)))))
          '|lookupComplete|)) 
@
\section{domain LIST List}
<<domain LIST List>>=
)abbrev domain LIST List
++ Author: Michael Monagan
++ Date Created: Sep 1987
++ Change History:
++ Basic Operations:
++   \#, append, concat, concat!, cons, construct, copy, elt, elt,
++   empty, empty?, eq?, first, member?, merge!, mergeSort, minIndex,
++   nil, null, parts, removeDuplicates!, rest, rest, reverse,
++   reverse!, setDifference, setIntersection, setUnion, setelt,
++   setfirst!, setrest!, sort!, split!
++ Related Constructors: ListFunctions2, ListFunctions3, ListToMap
++ Also See: IndexList, ListAggregate
++ AMS Classification:
++ Keywords: list, index, aggregate, lisp
++ Description:
++   \spadtype{List} implements singly-linked lists that are
++   addressable by indices; the index of the first element
++   is 1. In addition to the operations provided by
++   \spadtype{IndexedList}, this constructor provides some
++   LISP-like functions such as \spadfun{null} and \spadfun{cons}.
List(S:Type): Exports == Implementation where 
 LISTMININDEX ==> 1       -- this is the minimum list index

 Exports ==> ListAggregate S with
  nil             : ()     -> %
    ++ nil() returns the empty list.
  null            : %      -> Boolean
    ++ null(u) tests if list \spad{u} is the
    ++ empty list.
  cons            : (S, %) -> %
    ++ cons(element,u) appends \spad{element} onto the front
    ++ of list \spad{u} and returns the new list. This new list
    ++ and the old one will share some structure.
  append          : (%, %) -> %
    ++ append(u1,u2) appends the elements of list \spad{u1}
    ++ onto the front of list \spad{u2}. This new list
    ++ and \spad{u2} will share some structure.
  if S has SetCategory then
    setUnion        : (%, %) -> %
      ++ setUnion(u1,u2) appends the two lists u1 and u2, then
      ++ removes all duplicates. The order of elements in the
      ++ resulting list is unspecified.
    setIntersection : (%, %) -> %
      ++ setIntersection(u1,u2) returns a list of the elements
      ++ that lists \spad{u1} and \spad{u2} have in common.
      ++ The order of elements in the resulting list is unspecified.
    setDifference   : (%, %) -> %
      ++ setDifference(u1,u2) returns a list of the elements
      ++ of \spad{u1} that are not also in \spad{u2}.
      ++ The order of elements in the resulting list is unspecified.
  if S has OpenMath then OpenMath

 Implementation ==>
   IndexedList(S, LISTMININDEX) add
      nil()                    == NIL$Lisp
      null l                   == NULL(l)$Lisp
      cons(s, l)               == CONS(s, l)$Lisp
      append(l:%, t:%)         == APPEND(l, t)$Lisp

      if S has OpenMath then
        writeOMList(dev: OpenMathDevice, x: %): Void ==
          OMputApp(dev)
          OMputSymbol(dev, "list1", "list")
          -- The following didn't compile because the compiler isn't
          -- convinced that `xval' is a S.  Duhhh! MCD.
          --for xval in x repeat
          --  OMwrite(dev, xval, false)
          while not null x repeat
            OMwrite(dev,first x,false)
            x := rest x
          OMputEndApp(dev)

        OMwrite(x: %): String ==
          s: String := ""
          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
          OMputObject(dev)
          writeOMList(dev, x)
          OMputEndObject(dev)
          OMclose(dev)
          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
          s

        OMwrite(x: %, wholeObj: Boolean): String ==
          s: String := ""
          sp := OM_-STRINGTOSTRINGPTR(s)$Lisp
          dev: OpenMathDevice := OMopenString(sp pretend String, OMencodingXML)
          if wholeObj then
            OMputObject(dev)
          writeOMList(dev, x)
          if wholeObj then
            OMputEndObject(dev)
          OMclose(dev)
          s := OM_-STRINGPTRTOSTRING(sp)$Lisp pretend String
          s

        OMwrite(dev: OpenMathDevice, x: %): Void ==
          OMputObject(dev)
          writeOMList(dev, x)
          OMputEndObject(dev)

        OMwrite(dev: OpenMathDevice, x: %, wholeObj: Boolean): Void ==
          if wholeObj then
            OMputObject(dev)
          writeOMList(dev, x)
          if wholeObj then
            OMputEndObject(dev)

      if S has SetCategory then
        setUnion(l1:%,l2:%)      == removeDuplicates concat(l1,l2)

        setIntersection(l1:%,l2:%) ==
          u :% := empty()
          l1 := removeDuplicates l1
          while not empty? l1 repeat
            if member?(first l1,l2) then u := cons(first l1,u)
            l1 := rest l1
          u

        setDifference(l1:%,l2:%) ==
          l1 := removeDuplicates l1
          lu:% := empty()
          while not empty? l1 repeat
            l11:=l1.1
            if not member?(l11,l2) then lu := concat(l11,lu)
            l1 := rest l1
          lu

      if S has ConvertibleTo InputForm then
        convert(x:%):InputForm ==
          convert concat(convert("construct"::Symbol)@InputForm,
                [convert a for a in (x pretend List S)]$List(InputForm))

@
\section{LIST.lsp BOOTSTRAP} 
{\bf LIST} 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 LIST} category which we can write
into the {\bf MID} directory. We compile the lisp code and copy the
{\bf LIST.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.

<<LIST.lsp BOOTSTRAP>>=

(/VERSIONCHECK 2) 

(PUT '|LIST;nil;$;1| '|SPADreplace| '(XLAM NIL NIL)) 

(DEFUN |LIST;nil;$;1| ($) NIL) 

(PUT '|LIST;null;$B;2| '|SPADreplace| 'NULL) 

(DEFUN |LIST;null;$B;2| (|l| $) (NULL |l|)) 

(PUT '|LIST;cons;S2$;3| '|SPADreplace| 'CONS) 

(DEFUN |LIST;cons;S2$;3| (|s| |l| $) (CONS |s| |l|)) 

(PUT '|LIST;append;3$;4| '|SPADreplace| 'APPEND) 

(DEFUN |LIST;append;3$;4| (|l| |t| $) (APPEND |l| |t|)) 

(DEFUN |LIST;writeOMList| (|dev| |x| $)
  (SEQ (SPADCALL |dev| (QREFELT $ 14))
       (SPADCALL |dev| "list1" "list" (QREFELT $ 16))
       (SEQ G190
            (COND
              ((NULL (SPADCALL (NULL |x|) (QREFELT $ 17))) (GO G191)))
            (SEQ (SPADCALL |dev| (|SPADfirst| |x|) 'NIL (QREFELT $ 18))
                 (EXIT (LETT |x| (CDR |x|) |LIST;writeOMList|)))
            NIL (GO G190) G191 (EXIT NIL))
       (EXIT (SPADCALL |dev| (QREFELT $ 19))))) 

(DEFUN |LIST;OMwrite;$S;6| (|x| $)
  (PROG (|sp| |dev| |s|)
    (RETURN
      (SEQ (LETT |s| "" |LIST;OMwrite;$S;6|)
           (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$S;6|)
           (LETT |dev|
                 (SPADCALL |sp| (SPADCALL (QREFELT $ 21))
                     (QREFELT $ 22))
                 |LIST;OMwrite;$S;6|)
           (SPADCALL |dev| (QREFELT $ 23))
           (|LIST;writeOMList| |dev| |x| $)
           (SPADCALL |dev| (QREFELT $ 24))
           (SPADCALL |dev| (QREFELT $ 25))
           (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$S;6|)
           (EXIT |s|))))) 

(DEFUN |LIST;OMwrite;$BS;7| (|x| |wholeObj| $)
  (PROG (|sp| |dev| |s|)
    (RETURN
      (SEQ (LETT |s| "" |LIST;OMwrite;$BS;7|)
           (LETT |sp| (OM-STRINGTOSTRINGPTR |s|) |LIST;OMwrite;$BS;7|)
           (LETT |dev|
                 (SPADCALL |sp| (SPADCALL (QREFELT $ 21))
                     (QREFELT $ 22))
                 |LIST;OMwrite;$BS;7|)
           (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23))))
           (|LIST;writeOMList| |dev| |x| $)
           (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24))))
           (SPADCALL |dev| (QREFELT $ 25))
           (LETT |s| (OM-STRINGPTRTOSTRING |sp|) |LIST;OMwrite;$BS;7|)
           (EXIT |s|))))) 

(DEFUN |LIST;OMwrite;Omd$V;8| (|dev| |x| $)
  (SEQ (SPADCALL |dev| (QREFELT $ 23)) (|LIST;writeOMList| |dev| |x| $)
       (EXIT (SPADCALL |dev| (QREFELT $ 24))))) 

(DEFUN |LIST;OMwrite;Omd$BV;9| (|dev| |x| |wholeObj| $)
  (SEQ (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 23))))
       (|LIST;writeOMList| |dev| |x| $)
       (EXIT (COND (|wholeObj| (SPADCALL |dev| (QREFELT $ 24))))))) 

(DEFUN |LIST;setUnion;3$;10| (|l1| |l2| $)
  (SPADCALL (SPADCALL |l1| |l2| (QREFELT $ 30)) (QREFELT $ 31))) 

(DEFUN |LIST;setIntersection;3$;11| (|l1| |l2| $)
  (PROG (|u|)
    (RETURN
      (SEQ (LETT |u| NIL |LIST;setIntersection;3$;11|)
           (LETT |l1| (SPADCALL |l1| (QREFELT $ 31))
                 |LIST;setIntersection;3$;11|)
           (SEQ G190
                (COND
                  ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17)))
                   (GO G191)))
                (SEQ (COND
                       ((SPADCALL (|SPADfirst| |l1|) |l2|
                            (QREFELT $ 33))
                        (LETT |u| (CONS (|SPADfirst| |l1|) |u|)
                              |LIST;setIntersection;3$;11|)))
                     (EXIT (LETT |l1| (CDR |l1|)
                                 |LIST;setIntersection;3$;11|)))
                NIL (GO G190) G191 (EXIT NIL))
           (EXIT |u|))))) 

(DEFUN |LIST;setDifference;3$;12| (|l1| |l2| $)
  (PROG (|l11| |lu|)
    (RETURN
      (SEQ (LETT |l1| (SPADCALL |l1| (QREFELT $ 31))
                 |LIST;setDifference;3$;12|)
           (LETT |lu| NIL |LIST;setDifference;3$;12|)
           (SEQ G190
                (COND
                  ((NULL (SPADCALL (NULL |l1|) (QREFELT $ 17)))
                   (GO G191)))
                (SEQ (LETT |l11| (SPADCALL |l1| 1 (QREFELT $ 36))
                           |LIST;setDifference;3$;12|)
                     (COND
                       ((NULL (SPADCALL |l11| |l2| (QREFELT $ 33)))
                        (LETT |lu| (CONS |l11| |lu|)
                              |LIST;setDifference;3$;12|)))
                     (EXIT (LETT |l1| (CDR |l1|)
                                 |LIST;setDifference;3$;12|)))
                NIL (GO G190) G191 (EXIT NIL))
           (EXIT |lu|))))) 

(DEFUN |LIST;convert;$If;13| (|x| $)
  (PROG (#0=#:G1440 |a| #1=#:G1441)
    (RETURN
      (SEQ (SPADCALL
               (CONS (SPADCALL (SPADCALL "construct" (QREFELT $ 39))
                         (QREFELT $ 41))
                     (PROGN
                       (LETT #0# NIL |LIST;convert;$If;13|)
                       (SEQ (LETT |a| NIL |LIST;convert;$If;13|)
                            (LETT #1# |x| |LIST;convert;$If;13|) G190
                            (COND
                              ((OR (ATOM #1#)
                                   (PROGN
                                     (LETT |a| (CAR #1#)
                                      |LIST;convert;$If;13|)
                                     NIL))
                               (GO G191)))
                            (SEQ (EXIT (LETT #0#
                                        (CONS
                                         (SPADCALL |a| (QREFELT $ 42))
                                         #0#)
                                        |LIST;convert;$If;13|)))
                            (LETT #1# (CDR #1#) |LIST;convert;$If;13|)
                            (GO G190) G191 (EXIT (NREVERSE0 #0#)))))
               (QREFELT $ 44)))))) 

(DEFUN |List| (#0=#:G1452)
  (PROG ()
    (RETURN
      (PROG (#1=#:G1453)
        (RETURN
          (COND
            ((LETT #1#
                   (|lassocShiftWithFunction| (LIST (|devaluate| #0#))
                       (HGET |$ConstructorCache| '|List|)
                       '|domainEqualList|)
                   |List|)
             (|CDRwithIncrement| #1#))
            ('T
             (UNWIND-PROTECT
               (PROG1 (|List;| #0#) (LETT #1# T |List|))
               (COND ((NOT #1#) (HREM |$ConstructorCache| '|List|))))))))))) 

(DEFUN |List;| (|#1|)
  (PROG (|dv$1| |dv$| $ #0=#:G1451 #1=#:G1449 |pv$|)
    (RETURN
      (PROGN
        (LETT |dv$1| (|devaluate| |#1|) . #2=(|List|))
        (LETT |dv$| (LIST '|List| |dv$1|) . #2#)
        (LETT $ (GETREFV 63) . #2#)
        (QSETREFV $ 0 |dv$|)
        (QSETREFV $ 3
            (LETT |pv$|
                  (|buildPredVector| 0 0
                      (LIST (|HasCategory| |#1|
                                '(|ConvertibleTo| (|InputForm|)))
                            (|HasCategory| |#1| '(|OrderedSet|))
                            (|HasCategory| |#1| '(|OpenMath|))
                            (|HasCategory| (|Integer|) '(|OrderedSet|))
                            (LETT #0#
                                  (|HasCategory| |#1| '(|SetCategory|)) . #2#)
                            (OR (|HasCategory| |#1| '(|OrderedSet|))
                                #0#)
                            (AND #0#
                                 (|HasCategory| |#1|
                                     (LIST '|Evalable|
                                      (|devaluate| |#1|))))
                            (OR (AND (|HasCategory| |#1|
                                      '(|OrderedSet|))
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|))))
                                (AND #0#
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|)))))
                            (LETT #1#
                                  (|HasCategory| |#1|
                                      '(|CoercibleTo| (|OutputForm|))) . #2#)
                            (OR (AND #0#
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|))))
                                #1#))) . #2#))
        (|haddProp| |$ConstructorCache| '|List| (LIST |dv$1|)
            (CONS 1 $))
        (|stuffDomainSlots| $)
        (QSETREFV $ 6 |#1|)
        (COND
          ((|testBitVector| |pv$| 3)
           (PROGN
             (QSETREFV $ 26
                 (CONS (|dispatchFunction| |LIST;OMwrite;$S;6|) $))
             (QSETREFV $ 27
                 (CONS (|dispatchFunction| |LIST;OMwrite;$BS;7|) $))
             (QSETREFV $ 28
                 (CONS (|dispatchFunction| |LIST;OMwrite;Omd$V;8|) $))
             (QSETREFV $ 29
                 (CONS (|dispatchFunction| |LIST;OMwrite;Omd$BV;9|) $)))))
        (COND
          ((|testBitVector| |pv$| 5)
           (PROGN
             (QSETREFV $ 32
                 (CONS (|dispatchFunction| |LIST;setUnion;3$;10|) $))
             (QSETREFV $ 34
                 (CONS (|dispatchFunction|
                           |LIST;setIntersection;3$;11|)
                       $))
             (QSETREFV $ 37
                 (CONS (|dispatchFunction| |LIST;setDifference;3$;12|)
                       $)))))
        (COND
          ((|testBitVector| |pv$| 1)
           (QSETREFV $ 45
               (CONS (|dispatchFunction| |LIST;convert;$If;13|) $))))
        $)))) 

(MAKEPROP '|List| '|infovec|
    (LIST '#(NIL NIL NIL NIL NIL (|IndexedList| 6 (NRTEVAL 1))
             (|local| |#1|) |LIST;nil;$;1| (|Boolean|) |LIST;null;$B;2|
             |LIST;cons;S2$;3| |LIST;append;3$;4| (|Void|)
             (|OpenMathDevice|) (0 . |OMputApp|) (|String|)
             (5 . |OMputSymbol|) (12 . |not|) (17 . |OMwrite|)
             (24 . |OMputEndApp|) (|OpenMathEncoding|)
             (29 . |OMencodingXML|) (33 . |OMopenString|)
             (39 . |OMputObject|) (44 . |OMputEndObject|)
             (49 . |OMclose|) (54 . |OMwrite|) (59 . |OMwrite|)
             (65 . |OMwrite|) (71 . |OMwrite|) (78 . |concat|)
             (84 . |removeDuplicates|) (89 . |setUnion|)
             (95 . |member?|) (101 . |setIntersection|) (|Integer|)
             (107 . |elt|) (113 . |setDifference|) (|Symbol|)
             (119 . |coerce|) (|InputForm|) (124 . |convert|)
             (129 . |convert|) (|List| $) (134 . |convert|)
             (139 . |convert|) (|Mapping| 6 6 6) (|NonNegativeInteger|)
             (|List| 6) (|List| 50) (|Equation| 6) (|Mapping| 8 6)
             (|Mapping| 8 6 6) (|UniversalSegment| 35) '"last" '"rest"
             '"first" '"value" (|Mapping| 6 6) (|OutputForm|)
             (|SingleInteger|) (|List| 35) (|Union| 6 '"failed"))
          '#(|setUnion| 144 |setIntersection| 150 |setDifference| 156
             |removeDuplicates| 162 |null| 167 |nil| 172 |member?| 176
             |elt| 182 |convert| 188 |cons| 193 |concat| 199 |append|
             205 |OMwrite| 211)
          '((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
          (CONS (|makeByteWordVec2| 10
                    '(0 0 0 0 0 0 0 0 0 0 2 0 0 8 6 0 0 8 10 1 6 3))
                (CONS '#(|ListAggregate&| |StreamAggregate&|
                         |ExtensibleLinearAggregate&|
                         |FiniteLinearAggregate&|
                         |UnaryRecursiveAggregate&| |LinearAggregate&|
                         |RecursiveAggregate&| |IndexedAggregate&|
                         |Collection&| |HomogeneousAggregate&|
                         |OrderedSet&| |Aggregate&| |EltableAggregate&|
                         |Evalable&| |SetCategory&| NIL NIL
                         |InnerEvalable&| NIL NIL |BasicType&| NIL)
                      (CONS '#((|ListAggregate| 6)
                               (|StreamAggregate| 6)
                               (|ExtensibleLinearAggregate| 6)
                               (|FiniteLinearAggregate| 6)
                               (|UnaryRecursiveAggregate| 6)
                               (|LinearAggregate| 6)
                               (|RecursiveAggregate| 6)
                               (|IndexedAggregate| 35 6)
                               (|Collection| 6)
                               (|HomogeneousAggregate| 6)
                               (|OrderedSet|) (|Aggregate|)
                               (|EltableAggregate| 35 6) (|Evalable| 6)
                               (|SetCategory|) (|Type|)
                               (|Eltable| 35 6) (|InnerEvalable| 6 6)
                               (|CoercibleTo| 59) (|ConvertibleTo| 40)
                               (|BasicType|) (|OpenMath|))
                            (|makeByteWordVec2| 45
                                '(1 13 12 0 14 3 13 12 0 15 15 16 1 8 0
                                  0 17 3 6 12 13 0 8 18 1 13 12 0 19 0
                                  20 0 21 2 13 0 15 20 22 1 13 12 0 23
                                  1 13 12 0 24 1 13 12 0 25 1 0 15 0 26
                                  2 0 15 0 8 27 2 0 12 13 0 28 3 0 12
                                  13 0 8 29 2 0 0 0 0 30 1 0 0 0 31 2 0
                                  0 0 0 32 2 0 8 6 0 33 2 0 0 0 0 34 2
                                  0 6 0 35 36 2 0 0 0 0 37 1 38 0 15 39
                                  1 40 0 38 41 1 6 40 0 42 1 40 0 43 44
                                  1 0 40 0 45 2 5 0 0 0 32 2 5 0 0 0 34
                                  2 5 0 0 0 37 1 5 0 0 31 1 0 8 0 9 0 0
                                  0 7 2 5 8 6 0 33 2 0 6 0 35 36 1 1 40
                                  0 45 2 0 0 6 0 10 2 0 0 0 0 30 2 0 0
                                  0 0 11 3 3 12 13 0 8 29 2 3 12 13 0
                                  28 1 3 15 0 26 2 3 15 0 8 27)))))
          '|lookupIncomplete|)) 
@
\section{package LIST2 ListFunctions2}
<<package LIST2 ListFunctions2>>=
)abbrev package LIST2 ListFunctions2
++ Author:
++ Date Created:
++ Change History:
++ Basic Operations: map, reduce, scan
++ Related Constructors: List
++ Also See: ListFunctions3
++ AMS Classification:
++ Keywords: list, aggregate, map, reduce
++ Description:
++   \spadtype{ListFunctions2} implements utility functions that
++   operate on two kinds of lists, each with a possibly different
++   type of element.
ListFunctions2(A:Type, B:Type): public == private where
  LA     ==> List A
  LB     ==> List B
  O2     ==> FiniteLinearAggregateFunctions2(A, LA, B, LB)

  public ==> with
    scan:    ((A, B) -> B, LA, B) -> LB
      ++ scan(fn,u,ident) successively uses the binary function
      ++ \spad{fn} to reduce more and more of list \spad{u}.
      ++ \spad{ident} is returned if the \spad{u} is empty.
      ++ The result is a list of the reductions at each step. See
      ++ \spadfun{reduce} for more information. Examples:
      ++ \spad{scan(fn,[1,2],0) = [fn(2,fn(1,0)),fn(1,0)]} and
      ++ \spad{scan(*,[2,3],1) = [2 * 1, 3 * (2 * 1)]}.
    reduce:  ((A, B) -> B, LA, B) -> B
      ++ reduce(fn,u,ident) successively uses the binary function
      ++ \spad{fn} on the elements of list \spad{u} and the result
      ++ of previous applications. \spad{ident} is returned if the
      ++ \spad{u} is empty. Note the order of application in
      ++ the following examples:
      ++ \spad{reduce(fn,[1,2,3],0) = fn(3,fn(2,fn(1,0)))} and
      ++ \spad{reduce(*,[2,3],1) = 3 * (2 * 1)}.
    map:      (A -> B, LA) -> LB
      ++ map(fn,u) applies \spad{fn} to each element of
      ++ list \spad{u} and returns a new list with the results.
      ++ For example \spad{map(square,[1,2,3]) = [1,4,9]}.

  private ==> add
    map(f, l)       == map(f, l)$O2
    scan(f, l, b)   == scan(f, l, b)$O2
    reduce(f, l, b) == reduce(f, l, b)$O2

@
\section{package LIST3 ListFunctions3}
<<package LIST3 ListFunctions3>>=
)abbrev package LIST3 ListFunctions3
++ Author:
++ Date Created:
++ Change History:
++ Basic Operations: map
++ Related Constructors: List
++ Also See: ListFunctions2
++ AMS Classification:
++ Keywords: list, aggregate, map
++ Description:
++   \spadtype{ListFunctions3} implements utility functions that
++   operate on three kinds of lists, each with a possibly different
++   type of element.
ListFunctions3(A:Type, B:Type, C:Type): public == private where
  LA     ==> List A
  LB     ==> List B
  LC     ==> List C

  public ==> with
    map: ( (A,B)->C, LA, LB) -> LC
      ++ map(fn,list1, u2) applies the binary function \spad{fn}
      ++ to corresponding elements of lists \spad{u1} and \spad{u2}
      ++ and returns a list of the results (in the same order). Thus
      ++ \spad{map(/,[1,2,3],[4,5,6]) = [1/4,2/4,1/2]}. The computation
      ++ terminates when the end of either list is reached. That is,
      ++ the length of the result list is equal to the minimum of the
      ++ lengths of \spad{u1} and \spad{u2}.

  private ==> add
    map(fn : (A,B) -> C, la : LA, lb : LB): LC ==
      empty?(la) or empty?(lb) => empty()$LC
      concat(fn(first la, first lb), map(fn, rest la, rest lb))

@
\section{package LIST2MAP ListToMap}
<<package LIST2MAP ListToMap>>=
)abbrev package LIST2MAP ListToMap
++ Author: Manuel Bronstein
++ Date Created: 22 Mar 1988
++ Change History:
++   11 Oct 1989   MB   ?
++ Basic Operations: match
++ Related Constructors: List
++ Also See:
++ AMS Classification:
++ Keywords: mapping, list
++ Description:
++   \spadtype{ListToMap} allows mappings to be described by a pair of
++   lists of equal lengths.  The image of an element \spad{x},
++   which appears in position \spad{n} in the first list, is then
++   the \spad{n}th element of the second list.  A default value or
++   default function can be specified to be used when \spad{x}
++   does not appear in the first list.  In the absence of defaults,
++   an error will occur in that case.
ListToMap(A:SetCategory, B:Type): Exports == Implementation where
  LA  ==> List A
  LB  ==> List B
  AB  ==> (A -> B)

  Exports ==> with
    match: (LA, LB   ) -> AB
      ++ match(la, lb) creates a map with no default source or target values
      ++ defined by lists la and lb of equal length.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index lb.
      ++ Error: if la and lb are not of equal length.
      ++ Note: when this map is applied, an error occurs when
      ++ applied to a value missing from la.
    match: (LA, LB, A) -> B
      ++ match(la, lb, a) creates a map
      ++ defined by lists la and lb of equal length, where \spad{a} is used
      ++ as the default source value if the given one is not in \spad{la}.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index lb.
      ++ Error: if la and lb are not of equal length.
    match: (LA, LB, B)    -> AB
      ++ match(la, lb, b) creates a map
      ++ defined by lists la and lb of equal length, where \spad{b} is used
      ++ as the default target value if the given function argument is
      ++ not in \spad{la}.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index lb.
      ++ Error: if la and lb are not of equal length.
    match: (LA, LB, A, B) -> B
      ++ match(la, lb, a, b) creates a map
      ++ defined by lists la and lb of equal length.
      ++ and applies this map to a.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index lb.
      ++ Argument b is the default target value if a is not in la.
      ++ Error: if la and lb are not of equal length.
    match: (LA, LB, AB)    -> AB
      ++ match(la, lb, f) creates a map
      ++ defined by lists la and lb of equal length.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index lb.
      ++ Argument \spad{f} is used as the
      ++ function to call when the given function argument is not in
      ++ \spad{la}.
      ++ The value returned is f applied to that argument.
    match: (LA, LB, A, AB) -> B
      ++ match(la, lb, a, f) creates a map
      ++ defined by lists la and lb of equal length.
      ++ and applies this map to a.
      ++ The target of a source value \spad{x} in la is the
      ++ value y with the same index lb.
      ++ Argument \spad{f} is a default function to call if a is not in la.
      ++ The value returned is then obtained by applying f to argument a.

  Implementation ==> add
    match(la, lb)             == match(la, lb, #1)
    match(la:LA, lb:LB, a:A)  == lb.position(a, la)
    match(la:LA, lb:LB, b:B)  == match(la, lb, #1, b)
    match(la:LA, lb:LB, f:AB) == match(la, lb, #1, f)

    match(la:LA, lb:LB, a:A, b:B) ==
      (p := position(a, la)) < minIndex(la) => b
      lb.p

    match(la:LA, lb:LB, a:A, f:AB) ==
      (p := position(a, la)) < minIndex(la) => f a
      lb.p

@
\section{domain ALIST AssociationList}
<<domain ALIST AssociationList>>=
)abbrev domain ALIST AssociationList
++ Author:
++ Date Created:
++ Change History:
++ Basic Operations: empty, empty?, keys, \#, concat, first, rest,
++   setrest!, search, setelt, remove!
++ Related Constructors:
++ Also See: List
++ AMS Classification:
++ Keywords: list, association list
++ Description:
++   \spadtype{AssociationList} implements association lists. These
++   may be viewed as lists of pairs where the first part is a key
++   and the second is the stored value. For example, the key might
++   be a string with a persons employee identification number and
++   the value might be a record with personnel data.

AssociationList(Key:SetCategory, Entry:SetCategory):
 AssociationListAggregate(Key, Entry) == add
        Pair ==> Record(key:Key, entry:Entry)
        Rep := Reference List Pair

        dictionary()            == ref empty()
        empty()                 == dictionary()
        empty? t                == empty? deref t
        entries(t:%):List(Pair) == deref t
        parts(t:%):List(Pair)   == deref t
        keys t                  == [k.key for k in deref t]
        # t                     == # deref t
        first(t:%):Pair         == first deref t
        rest t                  == ref rest deref t
        concat(p:Pair, t:%)     == ref concat(p, deref t)
        setrest_!(a:%, b:%)     == ref setrest_!(deref a, deref b)
        setfirst_!(a:%, p:Pair) == setfirst_!(deref a,p)
        minIndex(a:%):Integer   == minIndex(deref a)
        maxIndex(a:%):Integer   == maxIndex(deref a)

        search(k, t) ==
          for r in deref t repeat
            k = r.key => return(r.entry)
          "failed"

        latex(a : %) : String ==
          l : List Pair := entries a
          s : String := "\left["
          while not empty?(l) repeat
            r : Pair := first l
            l        := rest l
            s := concat(s, concat(latex r.key, concat(" = ", latex r.entry)$String)$String)$String
            if not empty?(l) then s := concat(s, ", ")$String
          concat(s, " \right]")$String

--      assoc(k, l) ==
--        (r := find(#1.key=k, l)) case "failed" => "failed"
--        r

        assoc(k, t) ==
          for r in deref t repeat
            k = r.key => return r
          "failed"

        setelt(t:%, k:Key, e:Entry) ==
          (r := assoc(k, t)) case Pair => (r::Pair).entry := e
          setref(t, concat([k, e], deref t))
          e

        remove_!(k:Key, t:%) ==
          empty?(l := deref t) => "failed"
          k = first(l).key =>
            setref(t, rest l)
            first(l).entry
          prev := l
          curr := rest l
          while not empty? curr and first(curr).key ^= k repeat
            prev := curr
            curr := rest curr
          empty? curr => "failed"
          setrest_!(prev, rest curr)
          first(curr).entry

@
\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>>

<<domain ILIST IndexedList>>
<<domain LIST List>>
<<package LIST2 ListFunctions2>>
<<package LIST3 ListFunctions3>>
<<package LIST2MAP ListToMap>>
<<domain ALIST AssociationList>>
@
\eject
\begin{thebibliography}{99}
\bibitem{1} nothing
\end{thebibliography}
\end{document}