\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} <>= )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. <>= (/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} <>= )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. <>= (/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} <>= )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} <>= )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} <>= )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} <>= )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} <>= --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. @ <<*>>= <> <> <> <> <> <> <> @ \eject \begin{thebibliography}{99} \bibitem{1} nothing \end{thebibliography} \end{document}