diff --git a/books/bookvol10.pamphlet b/books/bookvol10.pamphlet index 5cc8067..9a74854 100644 --- a/books/bookvol10.pamphlet +++ b/books/bookvol10.pamphlet @@ -5,27 +5,16 @@ \usepackage{makeidx} \makeindex \usepackage{graphicx} -% struggle with latex figure-floating behavior -\renewcommand\floatpagefraction{.9} -\renewcommand\topfraction{.9} -\renewcommand\bottomfraction{.9} -\renewcommand\textfraction{.1} -\setcounter{totalnumber}{50} -\setcounter{topnumber}{50} -\setcounter{bottomnumber}{50} - - -%% spadgraph are the actual text that you type at the axiom prompt for draw -\providecommand{\spadgraph}[1]% -{\begin{flushleft}{\tt #1}\end{flushleft}\vskip .1cm } - -% spadfunFrom records the function name and domain in the index -\providecommand{\spadfunFrom}[2]% -{{\bf #1}\index{#1 @\begingroup \string\bf{} #1 \endgroup}\index{#2}} - -%% spadsig gives the standard -> notation for signatures -\providecommand{\spadsig}[2]{{\sf #1 $\rightarrow$ #2}} - +%% +%% pagehead consolidates standard page indexing +%% +\newcommand{\pagehead}[3]{% e.g. \pagehead{page}{file.ht}{title} +\subsection{#3}% +\label{#1} +\index{pages!#1!#2}% +\index{#1!#2!pages}% +\index{#2!pages!#1}} +%% % special meanings for math characters \providecommand{\N}{\mbox{\bbold N}} \providecommand{\Natural}{\mbox{\bbold N}} @@ -38,70 +27,6 @@ \providecommand{\Real}{\mbox{\bbold R}} \providecommand{\F}{{\mathcal F}} \providecommand{\R}{{\mathcal R}} - -% draw a box around a text block -\providecommand\boxed[2]{% -\begin{center} -\begin{tabular}{|c|} -\hline -\begin{minipage}{#1} -\normalsize -{#2} -\end{minipage}\\ -\hline -\end{tabular} -\end{center}} - -\providecommand{\optArg}[1]{{{\tt [}{#1}{\tt ]}}} -\providecommand{\argDef}[1]{{\tt ({#1})}} -\providecommand{\funSyntax}[2]{{\bf #1}{\tt ({\small\it{#2}})}} -\providecommand{\funArgs}[1]{{\tt ({\small\it {#1}})}\newline} -\providecommand{\condata}[4]{{\bf #1} {\bf #2} {\bf #3} {\bf #4}} - -\def\glossaryTerm#1{{\bf #1}\index{#1}} -\def\glossaryTermNoIndex#1{{\bf #1}} -\def\glossarySyntaxTerm#1{{\tt #1}\index{#1}} -\long\def\ourGloss#1#2{\par\pagebreak[3]{#1}\newline{#2}} -\def\csch{\mathop{\rm csch}\nolimits} - -\def\erf{\mathop{\rm erf}\nolimits} - -\def\zag#1#2{ - {{\hfill \left. {#1} \right|} - \over - {\left| {#2} \right. \hfill} - } -} - - -% these bitmaps are used by HyperDoc -\newdimen\commentWidth -\commentWidth=11pc -\newdimen\colGutterWidth -\colGutterWidth=1pc -\newdimen\baseLeftSkip -\baseLeftSkip=\commentWidth \advance\baseLeftSkip by \colGutterWidth - -\providecommand\ExitBitmap% -{{\setlength{\unitlength}{0.01in}% -\begin{picture}(50,16)(0,0)\special{psfile=ps/exit.ps}\end{picture}}} - -\providecommand\ReturnBitmap% -{{\setlength{\unitlength}{0.01in}% -\begin{picture}(50,16)(0,0)\special{psfile=ps/home.ps}\end{picture}}} - -\providecommand\HelpBitmap% -{{\setlength{\unitlength}{0.01in}% -\begin{picture}(50,16)(0,0)\special{psfile=ps/help.ps}\end{picture}}} - -\providecommand\UpBitmap% -{{\setlength{\unitlength}{0.01in}% -\begin{picture}(50,16)(0,0)\special{psfile=ps/up.ps}\end{picture}}} - -\providecommand{\tpd}[5]% -{{\setlength{\unitlength}{0.01in}% -\begin{picture}(#1,#2)(#3,#4)\special{psfile=#5}\end{picture}}} - \begin{document} \begin{titlepage} \center{\includegraphics{ps/axiomfront.ps}} @@ -2057,6 +1982,3772 @@ constructing the divisors $\delta_j$ and the $u_j$'s as in that case. Again, the details are quite technical and can be found in \cite{2,12,13}. +\chapter{Categories Layers} +\section{category AGG Aggregate} +<>= +)abbrev category AGG Aggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The notion of aggregate serves to model any data structure aggregate, +++ designating any collection of objects, +++ with heterogenous or homogeneous members, +++ with a finite or infinite number +++ of members, explicitly or implicitly represented. +++ An aggregate can in principle +++ represent everything from a string of characters to abstract sets such +++ as "the set of x satisfying relation {\em r(x)}" +++ An attribute \spadatt{finiteAggregate} is used to assert that a domain +++ has a finite number of elements. +Aggregate: Category == Type with + eq?: (%,%) -> Boolean + ++ eq?(u,v) tests if u and v are same objects. + copy: % -> % + ++ copy(u) returns a top-level (non-recursive) copy of u. + ++ Note: for collections, \axiom{copy(u) == [x for x in u]}. + empty: () -> % + ++ empty()$D creates an aggregate of type D with 0 elements. + ++ Note: The {\em $D} can be dropped if understood by context, + ++ e.g. \axiom{u: D := empty()}. + empty?: % -> Boolean + ++ empty?(u) tests if u has 0 elements. + less?: (%,NonNegativeInteger) -> Boolean + ++ less?(u,n) tests if u has less than n elements. + more?: (%,NonNegativeInteger) -> Boolean + ++ more?(u,n) tests if u has greater than n elements. + size?: (%,NonNegativeInteger) -> Boolean + ++ size?(u,n) tests if u has exactly n elements. + sample: constant -> % ++ sample yields a value of type % + if % has finiteAggregate then + "#": % -> NonNegativeInteger ++ # u returns the number of items in u. + add + eq?(a,b) == EQ(a,b)$Lisp + sample() == empty() + if % has finiteAggregate then + empty? a == #a = 0 + less?(a,n) == #a < n + more?(a,n) == #a > n + size?(a,n) == #a = n + +@ +<>= +"AGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"AGG" -> "TYPE" + +@ +<>= +"Aggregate()" [color=lightblue,href="books/bookvol10.pamphlet"]; +"Aggregate()" -> "Type()" + +@ +\section{category ALAGG AssociationListAggregate} +<>= +)abbrev category ALAGG AssociationListAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An association list is a list of key entry pairs which may be viewed +++ as a table. It is a poor mans version of a table: +++ searching for a key is a linear operation. +AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category == + Join(TableAggregate(Key, Entry), ListAggregate Record(key:Key,entry:Entry)) with + assoc: (Key, %) -> Union(Record(key:Key,entry:Entry), "failed") + ++ assoc(k,u) returns the element x in association list u stored + ++ with key k, or "failed" if u has no key k. + +@ +<>= +"ALAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"ALAGG" -> "TBAGG" +"ALAGG" -> "LSAGG" + +@ +<>= +"AssociationListAggregate(a:SetCategory,b:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"AssociationListAggregate(a:SetCategory,b:SetCategory)" -> + "TableAggregate(a:SetCategory,b:SetCategory)" +"AssociationListAggregate(a:SetCategory,b:SetCategory)" -> + "ListAggregate(Record(a:SetCategory,b:SetCategory))" + +@ +\section{ALAGG.lsp BOOTSTRAP} +{\bf ALAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf ALAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf ALAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |AssociationListAggregate;CAT| (QUOTE NIL)) + +(SETQ |AssociationListAggregate;AL| (QUOTE NIL)) + +(DEFUN |AssociationListAggregate| + (|&REST| #1=#:G88404 |&AUX| #2=#:G88402) + (DSETQ #2# #1#) + (LET (#3=#:G88403) + (COND + ((SETQ #3# (|assoc| (|devaluateList| #2#) |AssociationListAggregate;AL|)) + (CDR #3#)) + (T + (SETQ |AssociationListAggregate;AL| + (|cons5| + (CONS + (|devaluateList| #2#) + (SETQ #3# (APPLY (FUNCTION |AssociationListAggregate;|) #2#))) + |AssociationListAggregate;AL|)) #3#)))) + +(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) + (PROG (#1=#:G88401) + (RETURN + (PROG1 + (LETT #1# + (|sublisV| + (PAIR + (QUOTE (|t#1| |t#2|)) (LIST (|devaluate| |t#1|) (|devaluate| |t#2|))) + (|sublisV| + (PAIR + (QUOTE (#2=#:G88400)) + (LIST (QUOTE (|Record| (|:| |key| |t#1|) (|:| |entry| |t#2|))))) + (COND + (|AssociationListAggregate;CAT|) + ((QUOTE T) + (LETT |AssociationListAggregate;CAT| + (|Join| + (|TableAggregate| (QUOTE |t#1|) (QUOTE |t#2|)) + (|ListAggregate| (QUOTE #2#)) + (|mkCategory| + (QUOTE |domain|) + (QUOTE + (((|assoc| + ((|Union| + (|Record| (|:| |key| |t#1|) (|:| |entry| |t#2|)) "failed") + |t#1| |$|)) + T))) + NIL (QUOTE NIL) NIL)) + . #3=(|AssociationListAggregate|)))))) + . #3#) + (SETELT #1# 0 + (LIST + (QUOTE |AssociationListAggregate|) + (|devaluate| |t#1|) + (|devaluate| |t#2|))))))) +@ +\section{category A1AGG OneDimensionalArrayAggregate} +<>= +)abbrev category A1AGG OneDimensionalArrayAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ One-dimensional-array aggregates serves as models for one-dimensional arrays. +++ Categorically, these aggregates are finite linear aggregates +++ with the \spadatt{shallowlyMutable} property, that is, any component of +++ the array may be changed without affecting the +++ identity of the overall array. +++ Array data structures are typically represented by a fixed area in storage and +++ therefore cannot efficiently grow or shrink on demand as can list structures +++ (see however \spadtype{FlexibleArray} for a data structure which +++ is a cross between a list and an array). +++ Iteration over, and access to, elements of arrays is extremely fast +++ (and often can be optimized to open-code). +++ Insertion and deletion however is generally slow since an entirely new +++ data structure must be created for the result. +OneDimensionalArrayAggregate(S:Type): Category == + FiniteLinearAggregate S with shallowlyMutable + add + parts x == [qelt(x, i) for i in minIndex x .. maxIndex x] + sort_!(f, a) == quickSort(f, a)$FiniteLinearAggregateSort(S, %) + + any?(f, a) == + for i in minIndex a .. maxIndex a repeat + f qelt(a, i) => return true + false + + every?(f, a) == + for i in minIndex a .. maxIndex a repeat + not(f qelt(a, i)) => return false + true + + position(f:S -> Boolean, a:%) == + for i in minIndex a .. maxIndex a repeat + f qelt(a, i) => return i + minIndex(a) - 1 + + find(f, a) == + for i in minIndex a .. maxIndex a repeat + f qelt(a, i) => return qelt(a, i) + "failed" + + count(f:S->Boolean, a:%) == + n:NonNegativeInteger := 0 + for i in minIndex a .. maxIndex a repeat + if f(qelt(a, i)) then n := n+1 + n + + map_!(f, a) == + for i in minIndex a .. maxIndex a repeat + qsetelt_!(a, i, f qelt(a, i)) + a + + setelt(a:%, s:UniversalSegment(Integer), x:S) == + l := lo s; h := if hasHi s then hi s else maxIndex a + l < minIndex a or h > maxIndex a => error "index out of range" + for k in l..h repeat qsetelt_!(a, k, x) + x + + reduce(f, a) == + empty? a => error "cannot reduce an empty aggregate" + r := qelt(a, m := minIndex a) + for k in m+1 .. maxIndex a repeat r := f(r, qelt(a, k)) + r + + reduce(f, a, identity) == + for k in minIndex a .. maxIndex a repeat + identity := f(identity, qelt(a, k)) + identity + + if S has SetCategory then + reduce(f, a, identity,absorber) == + for k in minIndex a .. maxIndex a while identity ^= absorber + repeat identity := f(identity, qelt(a, k)) + identity + +-- this is necessary since new has disappeared. + stupidnew: (NonNegativeInteger, %, %) -> % + stupidget: List % -> S +-- a and b are not both empty if n > 0 + stupidnew(n, a, b) == + zero? n => empty() + new(n, (empty? a => qelt(b, minIndex b); qelt(a, minIndex a))) +-- at least one element of l must be non-empty + stupidget l == + for a in l repeat + not empty? a => return first a + error "Should not happen" + + map(f, a, b) == + m := max(minIndex a, minIndex b) + n := min(maxIndex a, maxIndex b) + l := max(0, n - m + 1)::NonNegativeInteger + c := stupidnew(l, a, b) + for i in minIndex(c).. for j in m..n repeat + qsetelt_!(c, i, f(qelt(a, j), qelt(b, j))) + c + +-- map(f, a, b, x) == +-- m := min(minIndex a, minIndex b) +-- n := max(maxIndex a, maxIndex b) +-- l := (n - m + 1)::NonNegativeInteger +-- c := new l +-- for i in minIndex(c).. for j in m..n repeat +-- qsetelt_!(c, i, f(a(j, x), b(j, x))) +-- c + + merge(f, a, b) == + r := stupidnew(#a + #b, a, b) + i := minIndex a + m := maxIndex a + j := minIndex b + n := maxIndex b + for k in minIndex(r).. while i <= m and j <= n repeat + if f(qelt(a, i), qelt(b, j)) then + qsetelt_!(r, k, qelt(a, i)) + i := i+1 + else + qsetelt_!(r, k, qelt(b, j)) + j := j+1 + for k in k.. for i in i..m repeat qsetelt_!(r, k, elt(a, i)) + for k in k.. for j in j..n repeat qsetelt_!(r, k, elt(b, j)) + r + + elt(a:%, s:UniversalSegment(Integer)) == + l := lo s + h := if hasHi s then hi s else maxIndex a + l < minIndex a or h > maxIndex a => error "index out of range" + r := stupidnew(max(0, h - l + 1)::NonNegativeInteger, a, a) + for k in minIndex r.. for i in l..h repeat + qsetelt_!(r, k, qelt(a, i)) + r + + insert(a:%, b:%, i:Integer) == + m := minIndex b + n := maxIndex b + i < m or i > n => error "index out of range" + y := stupidnew(#a + #b, a, b) + for k in minIndex y.. for j in m..i-1 repeat + qsetelt_!(y, k, qelt(b, j)) + for k in k.. for j in minIndex a .. maxIndex a repeat + qsetelt_!(y, k, qelt(a, j)) + for k in k.. for j in i..n repeat qsetelt_!(y, k, qelt(b, j)) + y + + copy x == + y := stupidnew(#x, x, x) + for i in minIndex x .. maxIndex x for j in minIndex y .. repeat + qsetelt_!(y, j, qelt(x, i)) + y + + copyInto_!(y, x, s) == + s < minIndex y or s + #x > maxIndex y + 1 => + error "index out of range" + for i in minIndex x .. maxIndex x for j in s.. repeat + qsetelt_!(y, j, qelt(x, i)) + y + + construct l == +-- a := new(#l) + empty? l => empty() + a := new(#l, first l) + for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x) + a + + delete(a:%, s:UniversalSegment(Integer)) == + l := lo s; h := if hasHi s then hi s else maxIndex a + l < minIndex a or h > maxIndex a => error "index out of range" + h < l => copy a + r := stupidnew((#a - h + l - 1)::NonNegativeInteger, a, a) + for k in minIndex(r).. for i in minIndex a..l-1 repeat + qsetelt_!(r, k, qelt(a, i)) + for k in k.. for i in h+1 .. maxIndex a repeat + qsetelt_!(r, k, qelt(a, i)) + r + + delete(x:%, i:Integer) == + i < minIndex x or i > maxIndex x => error "index out of range" + y := stupidnew((#x - 1)::NonNegativeInteger, x, x) + for i in minIndex(y).. for j in minIndex x..i-1 repeat + qsetelt_!(y, i, qelt(x, j)) + for i in i .. for j in i+1 .. maxIndex x repeat + qsetelt_!(y, i, qelt(x, j)) + y + + reverse_! x == + m := minIndex x + n := maxIndex x + for i in 0..((n-m) quo 2) repeat swap_!(x, m+i, n-i) + x + + concat l == + empty? l => empty() + n := _+/[#a for a in l] + i := minIndex(r := new(n, stupidget l)) + for a in l repeat + copyInto_!(r, a, i) + i := i + #a + r + + sorted?(f, a) == + for i in minIndex(a)..maxIndex(a)-1 repeat + not f(qelt(a, i), qelt(a, i + 1)) => return false + true + + concat(x:%, y:%) == + z := stupidnew(#x + #y, x, y) + copyInto_!(z, x, i := minIndex z) + copyInto_!(z, y, i + #x) + z + + if S has SetCategory then + x = y == + #x ^= #y => false + for i in minIndex x .. maxIndex x repeat + not(qelt(x, i) = qelt(y, i)) => return false + true + + coerce(r:%):OutputForm == + bracket commaSeparate + [qelt(r, k)::OutputForm for k in minIndex r .. maxIndex r] + + position(x:S, t:%, s:Integer) == + n := maxIndex t + s < minIndex t or s > n => error "index out of range" + for k in s..n repeat + qelt(t, k) = x => return k + minIndex(t) - 1 + + if S has OrderedSet then + a < b == + for i in minIndex a .. maxIndex a + for j in minIndex b .. maxIndex b repeat + qelt(a, i) ^= qelt(b, j) => return a.i < b.j + #a < #b + + +@ +<>= +"A1AGG" [color=lightblue,style=filled]; +"A1AGG" -> "FLAGG" + +@ +<>= +"OneDimensionalArrayAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"OneDimensionalArrayAggregate(a:Type)" -> + "FiniteLinearAggregate(a:Type)" + +"OneDimensionalArrayAggregate(Character)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"OneDimensionalArrayAggregate(Character)" -> + "OneDimensionalArrayAggregate(a:Type)" + +"OneDimensionalArrayAggregate(Boolean)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"OneDimensionalArrayAggregate(Boolean)" -> + "OneDimensionalArrayAggregate(a:Type)" + +@ +\section{category BGAGG BagAggregate} +<>= +)abbrev category BGAGG BagAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A bag aggregate is an aggregate for which one can insert and extract objects, +++ and where the order in which objects are inserted determines the order +++ of extraction. +++ Examples of bags are stacks, queues, and dequeues. +BagAggregate(S:Type): Category == HomogeneousAggregate S with + shallowlyMutable + ++ shallowlyMutable means that elements of bags may be destructively changed. + bag: List S -> % + ++ bag([x,y,...,z]) creates a bag with elements x,y,...,z. + extract_!: % -> S + ++ extract!(u) destructively removes a (random) item from bag u. + insert_!: (S,%) -> % + ++ insert!(x,u) inserts item x into bag u. + inspect: % -> S + ++ inspect(u) returns an (random) element from a bag. + add + bag(l) == + x:=empty() + for s in l repeat x:=insert_!(s,x) + x + +@ +<>= +"BGAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"BGAGG" -> "HOAGG" + +@ +<>= +"BagAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"BagAggregate(a:Type)" -> "HomogeneousAggregate(a:Type)" + +"BagAggregate(a:SetCategory)" [color=seagreen,href="books/bookvol10.pamphlet"]; +"BagAggregate(a:SetCategory)" -> "BagAggregate(a:Type)" + +@ +\section{category BRAGG BinaryRecursiveAggregate} +<>= +)abbrev category BRAGG BinaryRecursiveAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A binary-recursive aggregate has 0, 1 or 2 children and +++ serves as a model for a binary tree or a doubly-linked aggregate structure +BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with + -- needs preorder, inorder and postorder iterators + left: % -> % + ++ left(u) returns the left child. + elt: (%,"left") -> % + ++ elt(u,"left") (also written: \axiom{a . left}) is + ++ equivalent to \axiom{left(a)}. + right: % -> % + ++ right(a) returns the right child. + elt: (%,"right") -> % + ++ elt(a,"right") (also written: \axiom{a . right}) + ++ is equivalent to \axiom{right(a)}. + if % has shallowlyMutable then + setelt: (%,"left",%) -> % + ++ setelt(a,"left",b) (also written \axiom{a . left := b}) is equivalent + ++ to \axiom{setleft!(a,b)}. + setleft_!: (%,%) -> % + ++ setleft!(a,b) sets the left child of \axiom{a} to be b. + setelt: (%,"right",%) -> % + ++ setelt(a,"right",b) (also written \axiom{b . right := b}) + ++ is equivalent to \axiom{setright!(a,b)}. + setright_!: (%,%) -> % + ++ setright!(a,x) sets the right child of t to be x. + add + cycleMax ==> 1000 + + elt(x,"left") == left x + elt(x,"right") == right x + leaf? x == empty? x or empty? left x and empty? right x + leaves t == + empty? t => empty()$List(S) + leaf? t => [value t] + concat(leaves left t,leaves right t) + nodes x == + l := empty()$List(%) + empty? x => l + concat(nodes left x,concat([x],nodes right x)) + children x == + l := empty()$List(%) + empty? x => l + empty? left x => [right x] + empty? right x => [left x] + [left x, right x] + if % has SetAggregate(S) and S has SetCategory then + node?(u,v) == + empty? v => false + u = v => true + for y in children v repeat node?(u,y) => return true + false + x = y == + empty?(x) => empty?(y) + empty?(y) => false + value x = value y and left x = left y and right x = right y + if % has finiteAggregate then + member?(x,u) == + empty? u => false + x = value u => true + member?(x,left u) or member?(x,right u) + + if S has SetCategory then + coerce(t:%): OutputForm == + empty? t => "[]"::OutputForm + v := value(t):: OutputForm + empty? left t => + empty? right t => v + r := coerce(right t)@OutputForm + bracket ["."::OutputForm, v, r] + l := coerce(left t)@OutputForm + r := + empty? right t => "."::OutputForm + coerce(right t)@OutputForm + bracket [l, v, r] + + if % has finiteAggregate then + aggCount: (%,NonNegativeInteger) -> NonNegativeInteger + #x == aggCount(x,0) + aggCount(x,k) == + empty? x => 0 + k := k + 1 + k = cycleMax and cyclic? x => error "cyclic tree" + for y in children x repeat k := aggCount(y,k) + k + + isCycle?: (%, List %) -> Boolean + eqMember?: (%, List %) -> Boolean + cyclic? x == not empty? x and isCycle?(x,empty()$(List %)) + isCycle?(x,acc) == + empty? x => false + eqMember?(x,acc) => true + for y in children x | not empty? y repeat + isCycle?(y,acc) => return true + false + eqMember?(y,l) == + for x in l repeat eq?(x,y) => return true + false + if % has shallowlyMutable then + setelt(x,"left",b) == setleft_!(x,b) + setelt(x,"right",b) == setright_!(x,b) + +@ +<>= +"BRAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"BRAGG" -> "RCAGG" + +@ +<>= +"BinaryRecursiveAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"BinaryRecursiveAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" + +@ +\section{category BTAGG BitAggregate} +<>= +)abbrev category BTAGG BitAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ The bit aggregate category models aggregates representing large +++ quantities of Boolean data. +BitAggregate(): Category == + Join(OrderedSet, Logic, OneDimensionalArrayAggregate Boolean) with + "not": % -> % + ++ not(b) returns the logical {\em not} of bit aggregate + ++ \axiom{b}. + "^" : % -> % + ++ ^ b returns the logical {\em not} of bit aggregate + ++ \axiom{b}. + nand : (%, %) -> % + ++ nand(a,b) returns the logical {\em nand} of bit aggregates \axiom{a} + ++ and \axiom{b}. + nor : (%, %) -> % + ++ nor(a,b) returns the logical {\em nor} of bit aggregates \axiom{a} and + ++ \axiom{b}. + _and : (%, %) -> % + ++ a and b returns the logical {\em and} of bit aggregates \axiom{a} and + ++ \axiom{b}. + _or : (%, %) -> % + ++ a or b returns the logical {\em or} of bit aggregates \axiom{a} and + ++ \axiom{b}. + xor : (%, %) -> % + ++ xor(a,b) returns the logical {\em exclusive-or} of bit aggregates + ++ \axiom{a} and \axiom{b}. + + add + not v == map(_not, v) + _^ v == map(_not, v) + _~(v) == map(_~, v) + _/_\(v, u) == map(_/_\, v, u) + _\_/(v, u) == map(_\_/, v, u) + nand(v, u) == map(nand, v, u) + nor(v, u) == map(nor, v, u) + +@ +<>= +"BTAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"BTAGG" -> "ORDSET" +"BTAGG" -> "LOGIC" +"BTAGG" -> "A1AGG" + +@ +<>= +"BitAggregate()" [color=lightblue,href="books/bookvol10.pamphlet"]; +"BitAggregate()" -> "OrderedSet()" +"BitAggregate()" -> "Logic()" +"BitAggregate()" -> "OneDimensionalArrayAggregate(Boolean)" + +@ +\section{category CLAGG Collection} +<>= +)abbrev category CLAGG Collection +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A collection is a homogeneous aggregate which can built from +++ list of members. The operation used to build the aggregate is +++ generically named \spadfun{construct}. However, each collection +++ provides its own special function with the same name as the +++ data type, except with an initial lower case letter, e.g. +++ \spadfun{list} for \spadtype{List}, +++ \spadfun{flexibleArray} for \spadtype{FlexibleArray}, and so on. +Collection(S:Type): Category == HomogeneousAggregate(S) with + construct: List S -> % + ++ \axiom{construct(x,y,...,z)} returns the collection of elements \axiom{x,y,...,z} + ++ ordered as given. Equivalently written as \axiom{[x,y,...,z]$D}, where + ++ D is the domain. D may be omitted for those of type List. + find: (S->Boolean, %) -> Union(S, "failed") + ++ find(p,u) returns the first x in u such that \axiom{p(x)} is true, and + ++ "failed" otherwise. + if % has finiteAggregate then + reduce: ((S,S)->S,%) -> S + ++ reduce(f,u) reduces the binary operation f across u. For example, + ++ if u is \axiom{[x,y,...,z]} then \axiom{reduce(f,u)} + ++ returns \axiom{f(..f(f(x,y),...),z)}. + ++ Note: if u has one element x, \axiom{reduce(f,u)} returns x. + ++ Error: if u is empty. + ++ + ++C )clear all + ++X reduce(+,[C[i]*x**i for i in 1..5]) + + reduce: ((S,S)->S,%,S) -> S + ++ reduce(f,u,x) reduces the binary operation f across u, where x is + ++ the identity operation of f. + ++ Same as \axiom{reduce(f,u)} if u has 2 or more elements. + ++ Returns \axiom{f(x,y)} if u has one element y, + ++ x if u is empty. + ++ For example, \axiom{reduce(+,u,0)} returns the + ++ sum of the elements of u. + remove: (S->Boolean,%) -> % + ++ remove(p,u) returns a copy of u removing all elements x such that + ++ \axiom{p(x)} is true. + ++ Note: \axiom{remove(p,u) == [x for x in u | not p(x)]}. + select: (S->Boolean,%) -> % + ++ select(p,u) returns a copy of u containing only those elements such + ++ \axiom{p(x)} is true. + ++ Note: \axiom{select(p,u) == [x for x in u | p(x)]}. + if S has SetCategory then + reduce: ((S,S)->S,%,S,S) -> S + ++ reduce(f,u,x,z) reduces the binary operation f across u, stopping + ++ when an "absorbing element" z is encountered. + ++ As for \axiom{reduce(f,u,x)}, x is the identity operation of f. + ++ Same as \axiom{reduce(f,u,x)} when u contains no element z. + ++ Thus the third argument x is returned when u is empty. + remove: (S,%) -> % + ++ remove(x,u) returns a copy of u with all + ++ elements \axiom{y = x} removed. + ++ Note: \axiom{remove(y,c) == [x for x in c | x ^= y]}. + removeDuplicates: % -> % + ++ removeDuplicates(u) returns a copy of u with all duplicates removed. + if S has ConvertibleTo InputForm then ConvertibleTo InputForm + add + if % has finiteAggregate then + #c == # parts c + count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x] + any?(f, c) == _or/[f x for x in parts c] + every?(f, c) == _and/[f x for x in parts c] + find(f:S -> Boolean, c:%) == find(f, parts c) + reduce(f:(S,S)->S, x:%) == reduce(f, parts x) + reduce(f:(S,S)->S, x:%, s:S) == reduce(f, parts x, s) + remove(f:S->Boolean, x:%) == + construct remove(f, parts x) + select(f:S->Boolean, x:%) == + construct select(f, parts x) + + if S has SetCategory then + remove(s:S, x:%) == remove(#1 = s, x) + reduce(f:(S,S)->S, x:%, s1:S, s2:S) == reduce(f, parts x, s1, s2) + removeDuplicates(x) == construct removeDuplicates parts x + +@ +<>= +"CLAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"CLAGG" -> "HOAGG" + +@ +<>= +"Collection(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"Collection(a:Type)" -> "HomogeneousAggregate(a:Type)" + +"Collection(a:SetCategory)" [color=seagreen,href="books/bookvol10.pamphlet"]; +"Collection(a:SetCategory)" -> "Collection(a:Type)" +@ +\section{CLAGG.lsp BOOTSTRAP} +{\bf CLAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf CLAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf CLAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |Collection;CAT| (QUOTE NIL)) + +(SETQ |Collection;AL| (QUOTE NIL)) + +(DEFUN |Collection| (#1=#:G82618) (LET (#2=#:G82619) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |Collection;AL|)) (CDR #2#)) (T (SETQ |Collection;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|Collection;| #1#))) |Collection;AL|)) #2#)))) + +(DEFUN |Collection;| (|t#1|) (PROG (#1=#:G82617) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|Collection;CAT|) ((QUOTE T) (LETT |Collection;CAT| (|Join| (|HomogeneousAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|construct| (|$| (|List| |t#1|))) T) ((|find| ((|Union| |t#1| "failed") (|Mapping| (|Boolean|) |t#1|) |$|)) T) ((|reduce| (|t#1| (|Mapping| |t#1| |t#1| |t#1|) |$|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|reduce| (|t#1| (|Mapping| |t#1| |t#1| |t#1|) |$| |t#1|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|remove| (|$| (|Mapping| (|Boolean|) |t#1|) |$|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|select| (|$| (|Mapping| (|Boolean|) |t#1|) |$|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|reduce| (|t#1| (|Mapping| |t#1| |t#1| |t#1|) |$| |t#1| |t#1|)) (AND (|has| |t#1| (|SetCategory|)) (|has| |$| (ATTRIBUTE |finiteAggregate|)))) ((|remove| (|$| |t#1| |$|)) (AND (|has| |t#1| (|SetCategory|)) (|has| |$| (ATTRIBUTE |finiteAggregate|)))) ((|removeDuplicates| (|$| |$|)) (AND (|has| |t#1| (|SetCategory|)) (|has| |$| (ATTRIBUTE |finiteAggregate|)))))) (QUOTE (((|ConvertibleTo| (|InputForm|)) (|has| |t#1| (|ConvertibleTo| (|InputForm|)))))) (QUOTE ((|List| |t#1|))) NIL)) . #2=(|Collection|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |Collection|) (|devaluate| |t#1|))))))) +@ +\section{CLAGG-.lsp BOOTSTRAP} +{\bf CLAGG-} depends on {\bf CLAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf CLAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf CLAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |CLAGG-;#;ANni;1| (|c| |$|) (LENGTH (SPADCALL |c| (QREFELT |$| 9)))) + +(DEFUN |CLAGG-;count;MANni;2| (|f| |c| |$|) (PROG (|x| #1=#:G82637 #2=#:G82634 #3=#:G82632 #4=#:G82633) (RETURN (SEQ (PROGN (LETT #4# NIL |CLAGG-;count;MANni;2|) (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|) (LETT #1# (SPADCALL |c| (QREFELT |$| 9)) |CLAGG-;count;MANni;2|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |CLAGG-;count;MANni;2|) NIL)) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |x| |f|) (PROGN (LETT #2# 1 |CLAGG-;count;MANni;2|) (COND (#4# (LETT #3# (|+| #3# #2#) |CLAGG-;count;MANni;2|)) ((QUOTE T) (PROGN (LETT #3# #2# |CLAGG-;count;MANni;2|) (LETT #4# (QUOTE T) |CLAGG-;count;MANni;2|))))))))) (LETT #1# (CDR #1#) |CLAGG-;count;MANni;2|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) 0))))))) + +(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| |$|) (PROG (|x| #1=#:G82642 #2=#:G82640 #3=#:G82638 #4=#:G82639) (RETURN (SEQ (PROGN (LETT #4# NIL |CLAGG-;any?;MAB;3|) (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) (LETT #1# (SPADCALL |c| (QREFELT |$| 9)) |CLAGG-;any?;MAB;3|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |CLAGG-;any?;MAB;3|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |CLAGG-;any?;MAB;3|) (COND (#4# (LETT #3# (COND (#3# (QUOTE T)) ((QUOTE T) #2#)) |CLAGG-;any?;MAB;3|)) ((QUOTE T) (PROGN (LETT #3# #2# |CLAGG-;any?;MAB;3|) (LETT #4# (QUOTE T) |CLAGG-;any?;MAB;3|))))))) (LETT #1# (CDR #1#) |CLAGG-;any?;MAB;3|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE NIL)))))))) + +(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| |$|) (PROG (|x| #1=#:G82647 #2=#:G82645 #3=#:G82643 #4=#:G82644) (RETURN (SEQ (PROGN (LETT #4# NIL |CLAGG-;every?;MAB;4|) (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) (LETT #1# (SPADCALL |c| (QREFELT |$| 9)) |CLAGG-;every?;MAB;4|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |CLAGG-;every?;MAB;4|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |CLAGG-;every?;MAB;4|) (COND (#4# (LETT #3# (COND (#3# #2#) ((QUOTE T) (QUOTE NIL))) |CLAGG-;every?;MAB;4|)) ((QUOTE T) (PROGN (LETT #3# #2# |CLAGG-;every?;MAB;4|) (LETT #4# (QUOTE T) |CLAGG-;every?;MAB;4|))))))) (LETT #1# (CDR #1#) |CLAGG-;every?;MAB;4|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE T)))))))) + +(DEFUN |CLAGG-;find;MAU;5| (|f| |c| |$|) (SPADCALL |f| (SPADCALL |c| (QREFELT |$| 9)) (QREFELT |$| 18))) + +(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| |$|) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 21))) + +(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| |$|) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) |s| (QREFELT |$| 23))) + +(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| |$|) (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 25)) (QREFELT |$| 26))) + +(DEFUN |CLAGG-;select;M2A;9| (|f| |x| |$|) (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 28)) (QREFELT |$| 26))) + +(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| |$|) (SPADCALL (CONS (FUNCTION |CLAGG-;remove;S2A;10!0|) (VECTOR |$| |s|)) |x| (QREFELT |$| 31))) + +(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| |$$|) (SPADCALL |#1| (QREFELT |$$| 1) (QREFELT (QREFELT |$$| 0) 30))) + +(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| |$|) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) |s1| |s2| (QREFELT |$| 33))) + +(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 35)) (QREFELT |$| 26))) + +(DEFUN |Collection&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|Collection&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |Collection&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 37) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#2| (QUOTE (|ConvertibleTo| (|InputForm|)))) (|HasCategory| |#2| (QUOTE (|SetCategory|))) (|HasAttribute| |#1| (QUOTE |finiteAggregate|)))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 3) (PROGN (QSETREFV |$| 11 (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) |$|)) (QSETREFV |$| 13 (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) |$|)) (QSETREFV |$| 15 (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) |$|)) (QSETREFV |$| 16 (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) |$|)) (QSETREFV |$| 19 (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) |$|)) (QSETREFV |$| 22 (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) |$|)) (QSETREFV |$| 24 (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) |$|)) (QSETREFV |$| 27 (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) |$|)) (QSETREFV |$| 29 (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) |$|)) (COND ((|testBitVector| |pv$| 2) (PROGN (QSETREFV |$| 32 (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) |$|)) (QSETREFV |$| 34 (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) |$|)) (QSETREFV |$| 36 (CONS (|dispatchFunction| |CLAGG-;removeDuplicates;2A;12|) |$|)))))))) |$|)))) + +(MAKEPROP (QUOTE |Collection&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) (|Mapping| 14 7) (10 . |count|) (|Boolean|) (16 . |any?|) (22 . |every?|) (|Union| 7 (QUOTE "failed")) (28 . |find|) (34 . |find|) (|Mapping| 7 7 7) (40 . |reduce|) (46 . |reduce|) (52 . |reduce|) (59 . |reduce|) (66 . |remove|) (72 . |construct|) (77 . |remove|) (83 . |select|) (89 . |select|) (95 . |=|) (101 . |remove|) (107 . |remove|) (113 . |reduce|) (121 . |reduce|) (129 . |removeDuplicates|) (134 . |removeDuplicates|))) (QUOTE #(|select| 139 |removeDuplicates| 145 |remove| 150 |reduce| 162 |find| 183 |every?| 189 |count| 195 |any?| 201 |#| 207)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 36 (QUOTE (1 6 8 0 9 1 0 10 0 11 2 0 10 12 0 13 2 0 14 12 0 15 2 0 14 12 0 16 2 8 17 12 0 18 2 0 17 12 0 19 2 8 7 20 0 21 2 0 7 20 0 22 3 8 7 20 0 7 23 3 0 7 20 0 7 24 2 8 0 12 0 25 1 6 0 8 26 2 0 0 12 0 27 2 8 0 12 0 28 2 0 0 12 0 29 2 7 14 0 0 30 2 6 0 12 0 31 2 0 0 7 0 32 4 8 7 20 0 7 7 33 4 0 7 20 0 7 7 34 1 8 0 0 35 1 0 0 0 36 2 0 0 12 0 29 1 0 0 0 36 2 0 0 7 0 32 2 0 0 12 0 27 4 0 7 20 0 7 7 34 3 0 7 20 0 7 24 2 0 7 20 0 22 2 0 17 12 0 19 2 0 14 12 0 16 2 0 10 12 0 13 2 0 14 12 0 15 1 0 10 0 11)))))) (QUOTE |lookupComplete|))) +@ +\section{category DIAGG Dictionary} +<>= +)abbrev category DIAGG Dictionary +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A dictionary is an aggregate in which entries can be inserted, +++ searched for and removed. Duplicates are thrown away on insertion. +++ This category models the usual notion of dictionary which involves +++ large amounts of data where copying is impractical. +++ Principal operations are thus destructive (non-copying) ones. +Dictionary(S:SetCategory): Category == + DictionaryOperations S add + dictionary l == + d := dictionary() + for x in l repeat insert_!(x, d) + d + + if % has finiteAggregate then + -- remove(f:S->Boolean,t:%) == remove_!(f, copy t) + -- select(f, t) == select_!(f, copy t) + select_!(f, t) == remove_!(not f #1, t) + + --extract_! d == + -- empty? d => error "empty dictionary" + -- remove_!(x := first parts d, d, 1) + -- x + + s = t == + eq?(s,t) => true + #s ^= #t => false + _and/[member?(x, t) for x in parts s] + + remove_!(f:S->Boolean, t:%) == + for m in parts t repeat if f m then remove_!(m, t) + t + +@ +<>= +"DIAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"DIAGG" -> "DIOPS" + +@ +<>= +"Dictionary(a:SetCategory)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"Dictionary(a:SetCategory)" -> "DictionaryOperations(a:SetCategory)" + +"Dictionary(Record(a:SetCategory,b:SetCategory))" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"Dictionary(Record(a:SetCategory,b:SetCategory))" -> + "Dictionary(a:SetCategory)" + +@ +\section{category DIOPS DictionaryOperations} +<>= +)abbrev category DIOPS DictionaryOperations +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ This category is a collection of operations common to both +++ categories \spadtype{Dictionary} and \spadtype{MultiDictionary} +DictionaryOperations(S:SetCategory): Category == + Join(BagAggregate S, Collection(S)) with + dictionary: () -> % + ++ dictionary()$D creates an empty dictionary of type D. + dictionary: List S -> % + ++ dictionary([x,y,...,z]) creates a dictionary consisting of + ++ entries \axiom{x,y,...,z}. +-- insert: (S,%) -> S ++ insert an entry +-- member?: (S,%) -> Boolean ++ search for an entry +-- remove_!: (S,%,NonNegativeInteger) -> % +-- ++ remove!(x,d,n) destructively changes dictionary d by removing +-- ++ up to n entries y such that \axiom{y = x}. +-- remove_!: (S->Boolean,%,NonNegativeInteger) -> % +-- ++ remove!(p,d,n) destructively changes dictionary d by removing +-- ++ up to n entries x such that \axiom{p(x)} is true. + if % has finiteAggregate then + remove_!: (S,%) -> % + ++ remove!(x,d) destructively changes dictionary d by removing + ++ all entries y such that \axiom{y = x}. + remove_!: (S->Boolean,%) -> % + ++ remove!(p,d) destructively changes dictionary d by removeing + ++ all entries x such that \axiom{p(x)} is true. + select_!: (S->Boolean,%) -> % + ++ select!(p,d) destructively changes dictionary d by removing + ++ all entries x such that \axiom{p(x)} is not true. + add + construct l == dictionary l + dictionary() == empty() + if % has finiteAggregate then + copy d == dictionary parts d + coerce(s:%):OutputForm == + prefix("dictionary"@String :: OutputForm, + [x::OutputForm for x in parts s]) + +@ +<>= +"DIOPS" [color=lightblue,href="books/bookvol10.pamphlet"]; +"DIOPS" -> "BGAGG" +"DIOPS" -> "CLAGG" + +@ +<>= +"DictionaryOperations(a:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"DictionaryOperations(a:SetCategory)" -> "BagAggregate(a:SetCategory)" +"DictionaryOperations(a:SetCategory)" -> "Collection(a:SetCategory)" + +@ +\section{category DLAGG DoublyLinkedAggregate} +<>= +)abbrev category DLAGG DoublyLinkedAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A doubly-linked aggregate serves as a model for a doubly-linked +++ list, that is, a list which can has links to both next and previous +++ nodes and thus can be efficiently traversed in both directions. +DoublyLinkedAggregate(S:Type): Category == RecursiveAggregate S with + last: % -> S + ++ last(l) returns the last element of a doubly-linked aggregate l. + ++ Error: if l is empty. + head: % -> % + ++ head(l) returns the first element of a doubly-linked aggregate l. + ++ Error: if l is empty. + tail: % -> % + ++ tail(l) returns the doubly-linked aggregate l starting at + ++ its second element. + ++ Error: if l is empty. + previous: % -> % + ++ previous(l) returns the doubly-link list beginning with its previous + ++ element. + ++ Error: if l has no previous element. + ++ Note: \axiom{next(previous(l)) = l}. + next: % -> % + ++ next(l) returns the doubly-linked aggregate beginning with its next + ++ element. + ++ Error: if l has no next element. + ++ Note: \axiom{next(l) = rest(l)} and \axiom{previous(next(l)) = l}. + if % has shallowlyMutable then + concat_!: (%,%) -> % + ++ concat!(u,v) destructively concatenates doubly-linked aggregate v to the end of doubly-linked aggregate u. + setprevious_!: (%,%) -> % + ++ setprevious!(u,v) destructively sets the previous node of doubly-linked aggregate u to v, returning v. + setnext_!: (%,%) -> % + ++ setnext!(u,v) destructively sets the next node of doubly-linked aggregate u to v, returning v. + +@ +<>= +"DLAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"DLAGG" -> "RCAGG" + +@ +<>= +"DoublyLinkedAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"DoublyLinkedAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" + +@ +\section{category DQAGG DequeueAggregate} +<>= +)abbrev category DQAGG DequeueAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A dequeue is a doubly ended stack, that is, a bag where first items +++ inserted are the first items extracted, at either the front or the back end +++ of the data structure. +DequeueAggregate(S:Type): + Category == Join(StackAggregate S,QueueAggregate S) with + dequeue: () -> % + ++ dequeue()$D creates an empty dequeue of type D. + dequeue: List S -> % + ++ dequeue([x,y,...,z]) creates a dequeue with first (top or front) + ++ element x, second element y,...,and last (bottom or back) element z. + height: % -> NonNegativeInteger + ++ height(d) returns the number of elements in dequeue d. + ++ Note: \axiom{height(d) = # d}. + top_!: % -> S + ++ top!(d) returns the element at the top (front) of the dequeue. + bottom_!: % -> S + ++ bottom!(d) returns the element at the bottom (back) of the dequeue. + insertTop_!: (S,%) -> S + ++ insertTop!(x,d) destructively inserts x into the dequeue d, that is, + ++ at the top (front) of the dequeue. + ++ The element previously at the top of the dequeue becomes the + ++ second in the dequeue, and so on. + insertBottom_!: (S,%) -> S + ++ insertBottom!(x,d) destructively inserts x into the dequeue d + ++ at the bottom (back) of the dequeue. + extractTop_!: % -> S + ++ extractTop!(d) destructively extracts the top (front) element + ++ from the dequeue d. + ++ Error: if d is empty. + extractBottom_!: % -> S + ++ extractBottom!(d) destructively extracts the bottom (back) element + ++ from the dequeue d. + ++ Error: if d is empty. + reverse_!: % -> % + ++ reverse!(d) destructively replaces d by its reverse dequeue, i.e. + ++ the top (front) element is now the bottom (back) element, and so on. + +@ +<>= +"DQAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"DQAGG" -> "SKAGG" +"DQAGG" -> "QUAGG" + +@ +<>= +"DequeueAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"DequeueAggregate(a:Type)" -> "StackAggregate(a:Type)" +"DequeueAggregate(a:Type)" -> "QueueAggregate(a:Type)" + +"DequeueAggregate(a:SetCategory)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"DequeueAggregate(a:SetCategory)" -> "DequeueAggregate(a:Type)" + +@ +\section{category ELAGG ExtensibleLinearAggregate} +<>= +)abbrev category ELAGG ExtensibleLinearAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An extensible aggregate is one which allows insertion and deletion of entries. +++ These aggregates are models of lists and streams which are represented +++ by linked structures so as to make insertion, deletion, and +++ concatenation efficient. However, access to elements of these +++ extensible aggregates is generally slow since access is made from the end. +++ See \spadtype{FlexibleArray} for an exception. +ExtensibleLinearAggregate(S:Type):Category == LinearAggregate S with + shallowlyMutable + concat_!: (%,S) -> % + ++ concat!(u,x) destructively adds element x to the end of u. + concat_!: (%,%) -> % + ++ concat!(u,v) destructively appends v to the end of u. + ++ v is unchanged + delete_!: (%,Integer) -> % + ++ delete!(u,i) destructively deletes the \axiom{i}th element of u. + ++ + ++E Data:=Record(age:Integer,gender:String) + ++E a1:AssociationList(String,Data):=table() + ++E a1."tim":=[55,"male"]$Data + ++E delete!(a1,1) + + delete_!: (%,UniversalSegment(Integer)) -> % + ++ delete!(u,i..j) destructively deletes elements u.i through u.j. + remove_!: (S->Boolean,%) -> % + ++ remove!(p,u) destructively removes all elements x of + ++ u such that \axiom{p(x)} is true. + insert_!: (S,%,Integer) -> % + ++ insert!(x,u,i) destructively inserts x into u at position i. + insert_!: (%,%,Integer) -> % + ++ insert!(v,u,i) destructively inserts aggregate v into u at position i. + merge_!: ((S,S)->Boolean,%,%) -> % + ++ merge!(p,u,v) destructively merges u and v using predicate p. + select_!: (S->Boolean,%) -> % + ++ select!(p,u) destructively changes u by keeping only values x such that + ++ \axiom{p(x)}. + if S has SetCategory then + remove_!: (S,%) -> % + ++ remove!(x,u) destructively removes all values x from u. + removeDuplicates_!: % -> % + ++ removeDuplicates!(u) destructively removes duplicates from u. + if S has OrderedSet then merge_!: (%,%) -> % + ++ merge!(u,v) destructively merges u and v in ascending order. + add + delete(x:%, i:Integer) == delete_!(copy x, i) + delete(x:%, i:UniversalSegment(Integer)) == delete_!(copy x, i) + remove(f:S -> Boolean, x:%) == remove_!(f, copy x) + insert(s:S, x:%, i:Integer) == insert_!(s, copy x, i) + insert(w:%, x:%, i:Integer) == insert_!(copy w, copy x, i) + select(f, x) == select_!(f, copy x) + concat(x:%, y:%) == concat_!(copy x, y) + concat(x:%, y:S) == concat_!(copy x, new(1, y)) + concat_!(x:%, y:S) == concat_!(x, new(1, y)) + if S has SetCategory then + remove(s:S, x:%) == remove_!(s, copy x) + remove_!(s:S, x:%) == remove_!(#1 = s, x) + removeDuplicates(x:%) == removeDuplicates_!(copy x) + + if S has OrderedSet then + merge_!(x, y) == merge_!(_<$S, x, y) + +@ +<>= +"ELAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"ELAGG" -> "LNAGG" + +@ +<>= +"ExtensibleLinearAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"ExtensibleLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)" + +@ +\section{category ELTAB Eltable} +<>= +)abbrev category ELTAB Eltable +++ Author: Michael Monagan; revised by Manuel Bronstein and Manuel Bronstein +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An eltable over domains D and I is a structure which can be viewed +++ as a function from D to I. +++ Examples of eltable structures range from data structures, e.g. those +++ of type \spadtype{List}, to algebraic structures, e.g. \spadtype{Polynomial}. +Eltable(S:SetCategory, Index:Type): Category == with + elt : (%, S) -> Index + ++ elt(u,i) (also written: u . i) returns the element of u indexed by i. + ++ Error: if i is not an index of u. + +@ +<>= +"ELTAB" [color=lightblue,href="books/bookvol10.pamphlet"]; +"ELTAB" -> "CATEGORY" + +@ +<>= +"Eltable(a:SetCategory,b:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"Eltable(a:SetCategory,b:Type)" -> "Category" + +@ +\section{category ELTAGG EltableAggregate} +<>= +)abbrev category ELTAGG EltableAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An eltable aggregate is one which can be viewed as a function. +++ For example, the list \axiom{[1,7,4]} can applied to 0,1, and 2 respectively +++ will return the integers 1,7, and 4; thus this list may be viewed +++ as mapping 0 to 1, 1 to 7 and 2 to 4. In general, an aggregate +++ can map members of a domain {\em Dom} to an image domain {\em Im}. +EltableAggregate(Dom:SetCategory, Im:Type): Category == +-- This is separated from Eltable +-- and series won't have to support qelt's and setelt's. + Eltable(Dom, Im) with + elt : (%, Dom, Im) -> Im + ++ elt(u, x, y) applies u to x if x is in the domain of u, + ++ and returns y otherwise. + ++ For example, if u is a polynomial in \axiom{x} over the rationals, + ++ \axiom{elt(u,n,0)} may define the coefficient of \axiom{x} + ++ to the power n, returning 0 when n is out of range. + qelt: (%, Dom) -> Im + ++ qelt(u, x) applies \axiom{u} to \axiom{x} without checking whether + ++ \axiom{x} is in the domain of \axiom{u}. If \axiom{x} is not in the + ++ domain of \axiom{u} a memory-access violation may occur. If a check + ++ on whether \axiom{x} is in the domain of \axiom{u} is required, use + ++ the function \axiom{elt}. + if % has shallowlyMutable then + setelt : (%, Dom, Im) -> Im + ++ setelt(u,x,y) sets the image of x to be y under u, + ++ assuming x is in the domain of u. + ++ Error: if x is not in the domain of u. + -- this function will soon be renamed as setelt!. + qsetelt_!: (%, Dom, Im) -> Im + ++ qsetelt!(u,x,y) sets the image of \axiom{x} to be \axiom{y} under + ++ \axiom{u}, without checking that \axiom{x} is in the domain of + ++ \axiom{u}. + ++ If such a check is required use the function \axiom{setelt}. + add + qelt(a, x) == elt(a, x) + if % has shallowlyMutable then + qsetelt_!(a, x, y) == (a.x := y) + +@ +<>= +"ELTAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"ELTAGG" -> "ELTAB" + +@ +<>= +"EltableAggregate(a:SetCategory,b:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"EltableAggregate(a:SetCategory,b:Type)" -> "Eltable(a:SetCategory,b:Type)" + +@ +\section{category FLAGG FiniteLinearAggregate} +<>= +)abbrev category FLAGG FiniteLinearAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A finite linear aggregate is a linear aggregate of finite length. +++ The finite property of the aggregate adds several exports to the +++ list of exports from \spadtype{LinearAggregate} such as +++ \spadfun{reverse}, \spadfun{sort}, and so on. +FiniteLinearAggregate(S:Type): Category == LinearAggregate S with + finiteAggregate + merge: ((S,S)->Boolean,%,%) -> % + ++ merge(p,a,b) returns an aggregate c which merges \axiom{a} and b. + ++ The result is produced by examining each element x of \axiom{a} and y + ++ of b successively. If \axiom{p(x,y)} is true, then x is inserted into + ++ the result; otherwise y is inserted. If x is chosen, the next element + ++ of \axiom{a} is examined, and so on. When all the elements of one + ++ aggregate are examined, the remaining elements of the other + ++ are appended. + ++ For example, \axiom{merge(<,[1,3],[2,7,5])} returns \axiom{[1,2,3,7,5]}. + reverse: % -> % + ++ reverse(a) returns a copy of \axiom{a} with elements in reverse order. + sort: ((S,S)->Boolean,%) -> % + ++ sort(p,a) returns a copy of \axiom{a} sorted using total ordering predicate p. + sorted?: ((S,S)->Boolean,%) -> Boolean + ++ sorted?(p,a) tests if \axiom{a} is sorted according to predicate p. + position: (S->Boolean, %) -> Integer + ++ position(p,a) returns the index i of the first x in \axiom{a} such that + ++ \axiom{p(x)} is true, and \axiom{minIndex(a) - 1} if there is no such x. + if S has SetCategory then + position: (S, %) -> Integer + ++ position(x,a) returns the index i of the first occurrence of x in a, + ++ and \axiom{minIndex(a) - 1} if there is no such x. + position: (S,%,Integer) -> Integer + ++ position(x,a,n) returns the index i of the first occurrence of x in + ++ \axiom{a} where \axiom{i >= n}, and \axiom{minIndex(a) - 1} if no such x is found. + if S has OrderedSet then + OrderedSet + merge: (%,%) -> % + ++ merge(u,v) merges u and v in ascending order. + ++ Note: \axiom{merge(u,v) = merge(<=,u,v)}. + sort: % -> % + ++ sort(u) returns an u with elements in ascending order. + ++ Note: \axiom{sort(u) = sort(<=,u)}. + sorted?: % -> Boolean + ++ sorted?(u) tests if the elements of u are in ascending order. + if % has shallowlyMutable then + copyInto_!: (%,%,Integer) -> % + ++ copyInto!(u,v,i) returns aggregate u containing a copy of + ++ v inserted at element i. + reverse_!: % -> % + ++ reverse!(u) returns u with its elements in reverse order. + sort_!: ((S,S)->Boolean,%) -> % + ++ sort!(p,u) returns u with its elements ordered by p. + if S has OrderedSet then sort_!: % -> % + ++ sort!(u) returns u with its elements in ascending order. + add + if S has SetCategory then + position(x:S, t:%) == position(x, t, minIndex t) + + if S has OrderedSet then +-- sorted? l == sorted?(_<$S, l) + sorted? l == sorted?(#1 < #2 or #1 = #2, l) + merge(x, y) == merge(_<$S, x, y) + sort l == sort(_<$S, l) + + if % has shallowlyMutable then + reverse x == reverse_! copy x + sort(f, l) == sort_!(f, copy l) + reverse x == reverse_! copy x + + if S has OrderedSet then + sort_! l == sort_!(_<$S, l) + +@ +<>= +"FLAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"FLAGG" -> "LNAGG" + +@ +<>= +"FiniteLinearAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"FiniteLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)" + +@ +\section{category FSAGG FiniteSetAggregate} +<>= +)abbrev category FSAGG FiniteSetAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: 14 Oct, 1993 by RSS +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A finite-set aggregate models the notion of a finite set, that is, +++ a collection of elements characterized by membership, but not +++ by order or multiplicity. +++ See \spadtype{Set} for an example. +FiniteSetAggregate(S:SetCategory): Category == + Join(Dictionary S, SetAggregate S) with + finiteAggregate + cardinality: % -> NonNegativeInteger + ++ cardinality(u) returns the number of elements of u. + ++ Note: \axiom{cardinality(u) = #u}. + if S has Finite then + Finite + complement: % -> % + ++ complement(u) returns the complement of the set u, + ++ i.e. the set of all values not in u. + universe: () -> % + ++ universe()$D returns the universal set for finite set aggregate D. + if S has OrderedSet then + max: % -> S + ++ max(u) returns the largest element of aggregate u. + min: % -> S + ++ min(u) returns the smallest element of aggregate u. + + add + s < t == #s < #t and s = intersect(s,t) + s = t == #s = #t and empty? difference(s,t) + brace l == construct l + set l == construct l + cardinality s == #s + construct l == (s := set(); for x in l repeat insert_!(x,s); s) + count(x:S, s:%) == (member?(x, s) => 1; 0) + subset?(s, t) == #s < #t and _and/[member?(x, t) for x in parts s] + + coerce(s:%):OutputForm == + brace [x::OutputForm for x in parts s]$List(OutputForm) + + intersect(s, t) == + i := {} + for x in parts s | member?(x, t) repeat insert_!(x, i) + i + + difference(s:%, t:%) == + m := copy s + for x in parts t repeat remove_!(x, m) + m + + symmetricDifference(s, t) == + d := copy s + for x in parts t repeat + if member?(x, s) then remove_!(x, d) else insert_!(x, d) + d + + union(s:%, t:%) == + u := copy s + for x in parts t repeat insert_!(x, u) + u + + if S has Finite then + universe() == {index(i::PositiveInteger) for i in 1..size()$S} + complement s == difference(universe(), s ) + size() == 2 ** size()$S + index i == {index(j::PositiveInteger)$S for j in 1..size()$S | bit?(i-1,j-1)} + random() == index((random()$Integer rem (size()$% + 1))::PositiveInteger) + + lookup s == + n:PositiveInteger := 1 + for x in parts s repeat n := n + 2 ** ((lookup(x) - 1)::NonNegativeInteger) + n + + if S has OrderedSet then + max s == + empty?(l := parts s) => error "Empty set" + reduce("max", l) + + min s == + empty?(l := parts s) => error "Empty set" + reduce("min", l) + +@ +<>= +"FSAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"FSAGG" -> "DIAGG" +"FSAGG" -> "SETAGG" + +@ +<>= +"FiniteSetAggregate(a:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"FiniteSetAggregate(a:SetCategory)" -> "Dictionary(a:SetCategory)" +"FiniteSetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)" + +@ +\section{category HOAGG HomogeneousAggregate} +<>= +)abbrev category HOAGG HomogeneousAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991, May 1995 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A homogeneous aggregate is an aggregate of elements all of the +++ same type. +++ In the current system, all aggregates are homogeneous. +++ Two attributes characterize classes of aggregates. +++ Aggregates from domains with attribute \spadatt{finiteAggregate} +++ have a finite number of members. +++ Those with attribute \spadatt{shallowlyMutable} allow an element +++ to be modified or updated without changing its overall value. +HomogeneousAggregate(S:Type): Category == Aggregate with + if S has SetCategory then SetCategory + if S has SetCategory then + if S has Evalable S then Evalable S + map : (S->S,%) -> % + ++ map(f,u) returns a copy of u with each element x replaced by f(x). + ++ For collections, \axiom{map(f,u) = [f(x) for x in u]}. + if % has shallowlyMutable then + map_!: (S->S,%) -> % + ++ map!(f,u) destructively replaces each element x of u by \axiom{f(x)}. + if % has finiteAggregate then + any?: (S->Boolean,%) -> Boolean + ++ any?(p,u) tests if \axiom{p(x)} is true for any element x of u. + ++ Note: for collections, + ++ \axiom{any?(p,u) = reduce(or,map(f,u),false,true)}. + every?: (S->Boolean,%) -> Boolean + ++ every?(f,u) tests if p(x) is true for all elements x of u. + ++ Note: for collections, + ++ \axiom{every?(p,u) = reduce(and,map(f,u),true,false)}. + count: (S->Boolean,%) -> NonNegativeInteger + ++ count(p,u) returns the number of elements x in u + ++ such that \axiom{p(x)} is true. For collections, + ++ \axiom{count(p,u) = reduce(+,[1 for x in u | p(x)],0)}. + parts: % -> List S + ++ parts(u) returns a list of the consecutive elements of u. + ++ For collections, \axiom{parts([x,y,...,z]) = (x,y,...,z)}. + members: % -> List S + ++ members(u) returns a list of the consecutive elements of u. + ++ For collections, \axiom{parts([x,y,...,z]) = (x,y,...,z)}. + if S has SetCategory then + count: (S,%) -> NonNegativeInteger + ++ count(x,u) returns the number of occurrences of x in u. + ++ For collections, \axiom{count(x,u) = reduce(+,[x=y for y in u],0)}. + member?: (S,%) -> Boolean + ++ member?(x,u) tests if x is a member of u. + ++ For collections, + ++ \axiom{member?(x,u) = reduce(or,[x=y for y in u],false)}. + add + if S has Evalable S then + eval(u:%,l:List Equation S):% == map(eval(#1,l),u) + if % has finiteAggregate then + #c == # parts c + any?(f, c) == _or/[f x for x in parts c] + every?(f, c) == _and/[f x for x in parts c] + count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x] + members x == parts x + if S has SetCategory then + count(s:S, x:%) == count(s = #1, x) + member?(e, c) == any?(e = #1,c) + x = y == + size?(x, #y) and _and/[a = b for a in parts x for b in parts y] + coerce(x:%):OutputForm == + bracket + commaSeparate [a::OutputForm for a in parts x]$List(OutputForm) + +@ +<>= +"HOAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"HOAGG" -> "AGG" + +@ +<>= +"HomogeneousAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"HomogeneousAggregate(a:Type)" -> "Aggregate()" + +@ +\section{HOAGG.lsp BOOTSTRAP} +{\bf HOAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf HOAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf HOAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |HomogeneousAggregate;CAT| (QUOTE NIL)) + +(SETQ |HomogeneousAggregate;AL| (QUOTE NIL)) + +(DEFUN |HomogeneousAggregate| (#1=#:G82375) + (LET (#2=#:G82376) + (COND + ((SETQ #2# (|assoc| (|devaluate| #1#) |HomogeneousAggregate;AL|)) + (CDR #2#)) + (T + (SETQ |HomogeneousAggregate;AL| + (|cons5| + (CONS (|devaluate| #1#) (SETQ #2# (|HomogeneousAggregate;| #1#))) + |HomogeneousAggregate;AL|)) + #2#)))) + +(DEFUN |HomogeneousAggregate;| (|t#1|) + (PROG (#1=#:G82374) + (RETURN + (PROG1 + (LETT #1# + (|sublisV| + (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) + (COND + (|HomogeneousAggregate;CAT|) + ((QUOTE T) + (LETT |HomogeneousAggregate;CAT| + (|Join| + (|Aggregate|) + (|mkCategory| + (QUOTE |domain|) + (QUOTE ( + ((|map| (|$| (|Mapping| |t#1| |t#1|) |$|)) T) + ((|map!| (|$| (|Mapping| |t#1| |t#1|) |$|)) + (|has| |$| (ATTRIBUTE |shallowlyMutable|))) + ((|any?| + ((|Boolean|) (|Mapping| (|Boolean|) |t#1|) |$|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|))) + ((|every?| + ((|Boolean|) (|Mapping| (|Boolean|) |t#1|) |$|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|))) + ((|count| + ((|NonNegativeInteger|) + (|Mapping| (|Boolean|) |t#1|) |$|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|))) + ((|parts| ((|List| |t#1|) |$|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|))) + ((|members| ((|List| |t#1|) |$|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|))) + ((|count| ((|NonNegativeInteger|) |t#1| |$|)) + (AND + (|has| |t#1| (|SetCategory|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|)))) + ((|member?| ((|Boolean|) |t#1| |$|)) + (AND + (|has| |t#1| (|SetCategory|)) + (|has| |$| (ATTRIBUTE |finiteAggregate|)))))) + (QUOTE ( + ((|SetCategory|) (|has| |t#1| (|SetCategory|))) + ((|Evalable| |t#1|) + (AND + (|has| |t#1| (|Evalable| |t#1|)) + (|has| |t#1| (|SetCategory|)))))) + (QUOTE ( + (|Boolean|) + (|NonNegativeInteger|) + (|List| |t#1|))) + NIL)) + . #2=(|HomogeneousAggregate|))))) . #2#) + (SETELT #1# 0 + (LIST (QUOTE |HomogeneousAggregate|) (|devaluate| |t#1|))))))) + +@ +\section{HOAGG-.lsp BOOTSTRAP} +{\bf HOAGG-} depends on {\bf HOAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf HOAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf HOAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| |$|) (SPADCALL (CONS (FUNCTION |HOAGG-;eval;ALA;1!0|) (VECTOR |$| |l|)) |u| (QREFELT |$| 11))) + +(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| |$$|) (SPADCALL |#1| (QREFELT |$$| 1) (QREFELT (QREFELT |$$| 0) 9))) + +(DEFUN |HOAGG-;#;ANni;2| (|c| |$|) (LENGTH (SPADCALL |c| (QREFELT |$| 14)))) + +(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| |$|) (PROG (|x| #1=#:G82396 #2=#:G82393 #3=#:G82391 #4=#:G82392) (RETURN (SEQ (PROGN (LETT #4# NIL |HOAGG-;any?;MAB;3|) (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|) (LETT #1# (SPADCALL |c| (QREFELT |$| 14)) |HOAGG-;any?;MAB;3|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |HOAGG-;any?;MAB;3|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |HOAGG-;any?;MAB;3|) (COND (#4# (LETT #3# (COND (#3# (QUOTE T)) ((QUOTE T) #2#)) |HOAGG-;any?;MAB;3|)) ((QUOTE T) (PROGN (LETT #3# #2# |HOAGG-;any?;MAB;3|) (LETT #4# (QUOTE T) |HOAGG-;any?;MAB;3|))))))) (LETT #1# (CDR #1#) |HOAGG-;any?;MAB;3|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE NIL)))))))) + +(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| |$|) (PROG (|x| #1=#:G82401 #2=#:G82399 #3=#:G82397 #4=#:G82398) (RETURN (SEQ (PROGN (LETT #4# NIL |HOAGG-;every?;MAB;4|) (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|) (LETT #1# (SPADCALL |c| (QREFELT |$| 14)) |HOAGG-;every?;MAB;4|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |HOAGG-;every?;MAB;4|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |HOAGG-;every?;MAB;4|) (COND (#4# (LETT #3# (COND (#3# #2#) ((QUOTE T) (QUOTE NIL))) |HOAGG-;every?;MAB;4|)) ((QUOTE T) (PROGN (LETT #3# #2# |HOAGG-;every?;MAB;4|) (LETT #4# (QUOTE T) |HOAGG-;every?;MAB;4|))))))) (LETT #1# (CDR #1#) |HOAGG-;every?;MAB;4|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE T)))))))) + +(DEFUN |HOAGG-;count;MANni;5| (|f| |c| |$|) (PROG (|x| #1=#:G82406 #2=#:G82404 #3=#:G82402 #4=#:G82403) (RETURN (SEQ (PROGN (LETT #4# NIL |HOAGG-;count;MANni;5|) (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|) (LETT #1# (SPADCALL |c| (QREFELT |$| 14)) |HOAGG-;count;MANni;5|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |HOAGG-;count;MANni;5|) NIL)) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |x| |f|) (PROGN (LETT #2# 1 |HOAGG-;count;MANni;5|) (COND (#4# (LETT #3# (|+| #3# #2#) |HOAGG-;count;MANni;5|)) ((QUOTE T) (PROGN (LETT #3# #2# |HOAGG-;count;MANni;5|) (LETT #4# (QUOTE T) |HOAGG-;count;MANni;5|))))))))) (LETT #1# (CDR #1#) |HOAGG-;count;MANni;5|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) 0))))))) + +(DEFUN |HOAGG-;members;AL;6| (|x| |$|) (SPADCALL |x| (QREFELT |$| 14))) + +(DEFUN |HOAGG-;count;SANni;7| (|s| |x| |$|) (SPADCALL (CONS (FUNCTION |HOAGG-;count;SANni;7!0|) (VECTOR |$| |s|)) |x| (QREFELT |$| 24))) + +(DEFUN |HOAGG-;count;SANni;7!0| (|#1| |$$|) (SPADCALL (QREFELT |$$| 1) |#1| (QREFELT (QREFELT |$$| 0) 23))) + +(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| |$|) (SPADCALL (CONS (FUNCTION |HOAGG-;member?;SAB;8!0|) (VECTOR |$| |e|)) |c| (QREFELT |$| 26))) + +(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| |$$|) (SPADCALL (QREFELT |$$| 1) |#1| (QREFELT (QREFELT |$$| 0) 23))) + +(DEFUN |HOAGG-;=;2AB;9| (|x| |y| |$|) (PROG (|b| #1=#:G82416 |a| #2=#:G82415 #3=#:G82412 #4=#:G82410 #5=#:G82411) (RETURN (SEQ (COND ((SPADCALL |x| (SPADCALL |y| (QREFELT |$| 28)) (QREFELT |$| 29)) (PROGN (LETT #5# NIL |HOAGG-;=;2AB;9|) (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|) (LETT #1# (SPADCALL |y| (QREFELT |$| 14)) |HOAGG-;=;2AB;9|) (LETT |a| NIL |HOAGG-;=;2AB;9|) (LETT #2# (SPADCALL |x| (QREFELT |$| 14)) |HOAGG-;=;2AB;9|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |a| (CAR #2#) |HOAGG-;=;2AB;9|) NIL) (ATOM #1#) (PROGN (LETT |b| (CAR #1#) |HOAGG-;=;2AB;9|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #3# (SPADCALL |a| |b| (QREFELT |$| 23)) |HOAGG-;=;2AB;9|) (COND (#5# (LETT #4# (COND (#4# #3#) ((QUOTE T) (QUOTE NIL))) |HOAGG-;=;2AB;9|)) ((QUOTE T) (PROGN (LETT #4# #3# |HOAGG-;=;2AB;9|) (LETT #5# (QUOTE T) |HOAGG-;=;2AB;9|))))))) (LETT #2# (PROG1 (CDR #2#) (LETT #1# (CDR #1#) |HOAGG-;=;2AB;9|)) |HOAGG-;=;2AB;9|) (GO G190) G191 (EXIT NIL)) (COND (#5# #4#) ((QUOTE T) (QUOTE T))))) ((QUOTE T) (QUOTE NIL))))))) + +(DEFUN |HOAGG-;coerce;AOf;10| (|x| |$|) (PROG (#1=#:G82420 |a| #2=#:G82421) (RETURN (SEQ (SPADCALL (SPADCALL (PROGN (LETT #1# NIL |HOAGG-;coerce;AOf;10|) (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|) (LETT #2# (SPADCALL |x| (QREFELT |$| 14)) |HOAGG-;coerce;AOf;10|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |a| (CAR #2#) |HOAGG-;coerce;AOf;10|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (SPADCALL |a| (QREFELT |$| 32)) #1#) |HOAGG-;coerce;AOf;10|))) (LETT #2# (CDR #2#) |HOAGG-;coerce;AOf;10|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) (QREFELT |$| 34)) (QREFELT |$| 35)))))) + +(DEFUN |HomogeneousAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|HomogeneousAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |HomogeneousAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 38) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |finiteAggregate|)) (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)) (|HasCategory| |#2| (LIST (QUOTE |Evalable|) (|devaluate| |#2|))) (|HasCategory| |#2| (QUOTE (|SetCategory|))))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 3) (QSETREFV |$| 12 (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) |$|)))) (COND ((|testBitVector| |pv$| 1) (PROGN (QSETREFV |$| 16 (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) |$|)) (QSETREFV |$| 19 (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) |$|)) (QSETREFV |$| 20 (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) |$|)) (QSETREFV |$| 21 (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) |$|)) (QSETREFV |$| 22 (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) |$|)) (COND ((|testBitVector| |pv$| 4) (PROGN (QSETREFV |$| 25 (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) |$|)) (QSETREFV |$| 27 (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) |$|)) (QSETREFV |$| 30 (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) |$|)) (QSETREFV |$| 36 (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) |$|)))))))) |$|)))) + +(MAKEPROP (QUOTE |HomogeneousAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|List| 37) (0 . |eval|) (|Mapping| 7 7) (6 . |map|) (12 . |eval|) (|List| 7) (18 . |parts|) (|NonNegativeInteger|) (23 . |#|) (|Boolean|) (|Mapping| 17 7) (28 . |any?|) (34 . |every?|) (40 . |count|) (46 . |members|) (51 . |=|) (57 . |count|) (63 . |count|) (69 . |any?|) (75 . |member?|) (81 . |#|) (86 . |size?|) (92 . |=|) (|OutputForm|) (98 . |coerce|) (|List| |$|) (103 . |commaSeparate|) (108 . |bracket|) (113 . |coerce|) (|Equation| 7))) (QUOTE #(|members| 118 |member?| 123 |every?| 129 |eval| 135 |count| 141 |coerce| 153 |any?| 158 |=| 164 |#| 170)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 36 (QUOTE (2 7 0 0 8 9 2 6 0 10 0 11 2 0 0 0 8 12 1 6 13 0 14 1 0 15 0 16 2 0 17 18 0 19 2 0 17 18 0 20 2 0 15 18 0 21 1 0 13 0 22 2 7 17 0 0 23 2 6 15 18 0 24 2 0 15 7 0 25 2 6 17 18 0 26 2 0 17 7 0 27 1 6 15 0 28 2 6 17 0 15 29 2 0 17 0 0 30 1 7 31 0 32 1 31 0 33 34 1 31 0 0 35 1 0 31 0 36 1 0 13 0 22 2 0 17 7 0 27 2 0 17 18 0 20 2 0 0 0 8 12 2 0 15 7 0 25 2 0 15 18 0 21 1 0 31 0 36 2 0 17 18 0 19 2 0 17 0 0 30 1 0 15 0 16)))))) (QUOTE |lookupComplete|))) +@ +\section{category IXAGG IndexedAggregate} +<>= +)abbrev category IXAGG IndexedAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An indexed aggregate is a many-to-one mapping of indices to entries. +++ For example, a one-dimensional-array is an indexed aggregate where +++ the index is an integer. Also, a table is an indexed aggregate +++ where the indices and entries may have any type. +IndexedAggregate(Index: SetCategory, Entry: Type): Category == + Join(HomogeneousAggregate(Entry), EltableAggregate(Index, Entry)) with + entries: % -> List Entry + ++ entries(u) returns a list of all the entries of aggregate u + ++ in no assumed order. + -- to become entries: % -> Entry* and entries: % -> Iterator(Entry,Entry) + index?: (Index,%) -> Boolean + ++ index?(i,u) tests if i is an index of aggregate u. + indices: % -> List Index + ++ indices(u) returns a list of indices of aggregate u in no + ++ particular order. + -- to become indices: % -> Index* and indices: % -> Iterator(Index,Index). +-- map: ((Entry,Entry)->Entry,%,%,Entry) -> % +-- ++ exists c = map(f,a,b,x), i:Index where +-- ++ c.i = f(a(i,x),b(i,x)) | index?(i,a) or index?(i,b) + if Entry has SetCategory and % has finiteAggregate then + entry?: (Entry,%) -> Boolean + ++ entry?(x,u) tests if x equals \axiom{u . i} for some index i. + if Index has OrderedSet then + maxIndex: % -> Index + ++ maxIndex(u) returns the maximum index i of aggregate u. + ++ Note: in general, + ++ \axiom{maxIndex(u) = reduce(max,[i for i in indices u])}; + ++ if u is a list, \axiom{maxIndex(u) = #u}. + minIndex: % -> Index + ++ minIndex(u) returns the minimum index i of aggregate u. + ++ Note: in general, + ++ \axiom{minIndex(a) = reduce(min,[i for i in indices a])}; + ++ for lists, \axiom{minIndex(a) = 1}. + first : % -> Entry + ++ first(u) returns the first element x of u. + ++ Note: for collections, \axiom{first([x,y,...,z]) = x}. + ++ Error: if u is empty. + + if % has shallowlyMutable then + fill_!: (%,Entry) -> % + ++ fill!(u,x) replaces each entry in aggregate u by x. + ++ The modified u is returned as value. + swap_!: (%,Index,Index) -> Void + ++ swap!(u,i,j) interchanges elements i and j of aggregate u. + ++ No meaningful value is returned. + add + elt(a, i, x) == (index?(i, a) => qelt(a, i); x) + + if % has finiteAggregate then + entries x == parts x + if Entry has SetCategory then + entry?(x, a) == member?(x, a) + + if Index has OrderedSet then + maxIndex a == "max"/indices(a) + minIndex a == "min"/indices(a) + first a == a minIndex a + + if % has shallowlyMutable then + map(f, a) == map_!(f, copy a) + + map_!(f, a) == + for i in indices a repeat qsetelt_!(a, i, f qelt(a, i)) + a + + fill_!(a, x) == + for i in indices a repeat qsetelt_!(a, i, x) + a + + swap_!(a, i, j) == + t := a.i + qsetelt_!(a, i, a.j) + qsetelt_!(a, j, t) + void + +@ +<>= +"IXAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"IXAGG" -> "HOAGG" +"IXAGG" -> "ELTAGG" + +@ +<>= +"IndexedAggregate(a:SetCategory,b:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"IndexedAggregate(a:SetCategory,b:Type)" -> + "HomogeneousAggregate(a:Type)" +"IndexedAggregate(a:SetCategory,b:Type)" -> + "EltableAggregate(a:SetCategory,b:Type)" + +"IndexedAggregate(a:SetCategory,b:SetCategory)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"IndexedAggregate(a:SetCategory,b:SetCategory)" -> + "IndexedAggregate(a:SetCategory,b:Type)" + +"IndexedAggregate(b:Integer,a:Type)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"IndexedAggregate(b:Integer,a:Type)" -> + "IndexedAggregate(a:SetCategory,b:Type)" + +@ +\section{category KDAGG KeyedDictionary} +<>= +)abbrev category KDAGG KeyedDictionary +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A keyed dictionary is a dictionary of key-entry pairs for which there is +++ a unique entry for each key. +KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category == + Dictionary Record(key:Key,entry:Entry) with + key?: (Key, %) -> Boolean + ++ key?(k,t) tests if k is a key in table t. + keys: % -> List Key + ++ keys(t) returns the list the keys in table t. + -- to become keys: % -> Key* and keys: % -> Iterator(Entry,Entry) + remove_!: (Key, %) -> Union(Entry,"failed") + ++ remove!(k,t) searches the table t for the key k removing + ++ (and return) the entry if there. + ++ If t has no such key, \axiom{remove!(k,t)} returns "failed". + search: (Key, %) -> Union(Entry,"failed") + ++ search(k,t) searches the table t for the key k, + ++ returning the entry stored in t for key k. + ++ If t has no such key, \axiom{search(k,t)} returns "failed". + add + key?(k, t) == search(k, t) case Entry + + member?(p, t) == + r := search(p.key, t) + r case Entry and r::Entry = p.entry + + if % has finiteAggregate then + keys t == [x.key for x in parts t] + +@ +<>= +"KDAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"KDAGG" -> "DIAGG" + +@ +<>= +"KeyedDictionary(a:SetCategory,b:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"KeyedDictionary(a:SetCategory,b:SetCategory)" -> + "Dictionary(Record(a:SetCategory,b:SetCategory))" + +@ +\section{category LNAGG LinearAggregate} +<>= +)abbrev category LNAGG LinearAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A linear aggregate is an aggregate whose elements are indexed by integers. +++ Examples of linear aggregates are strings, lists, and +++ arrays. +++ Most of the exported operations for linear aggregates are non-destructive +++ but are not always efficient for a particular aggregate. +++ For example, \spadfun{concat} of two lists needs only to copy its first +++ argument, whereas \spadfun{concat} of two arrays needs to copy both arguments. +++ Most of the operations exported here apply to infinite objects (e.g. streams) +++ as well to finite ones. +++ For finite linear aggregates, see \spadtype{FiniteLinearAggregate}. +LinearAggregate(S:Type): Category == + Join(IndexedAggregate(Integer, S), Collection(S)) with + new : (NonNegativeInteger,S) -> % + ++ new(n,x) returns \axiom{fill!(new n,x)}. + concat: (%,S) -> % + ++ concat(u,x) returns aggregate u with additional element x at the end. + ++ Note: for lists, \axiom{concat(u,x) == concat(u,[x])} + concat: (S,%) -> % + ++ concat(x,u) returns aggregate u with additional element at the front. + ++ Note: for lists: \axiom{concat(x,u) == concat([x],u)}. + concat: (%,%) -> % + ++ concat(u,v) returns an aggregate consisting of the elements of u + ++ followed by the elements of v. + ++ Note: if \axiom{w = concat(u,v)} then \axiom{w.i = u.i for i in indices u} + ++ and \axiom{w.(j + maxIndex u) = v.j for j in indices v}. + concat: List % -> % + ++ concat(u), where u is a lists of aggregates \axiom{[a,b,...,c]}, returns + ++ a single aggregate consisting of the elements of \axiom{a} + ++ followed by those + ++ of b followed ... by the elements of c. + ++ Note: \axiom{concat(a,b,...,c) = concat(a,concat(b,...,c))}. + map: ((S,S)->S,%,%) -> % + ++ map(f,u,v) returns a new collection w with elements \axiom{z = f(x,y)} + ++ for corresponding elements x and y from u and v. + ++ Note: for linear aggregates, \axiom{w.i = f(u.i,v.i)}. + elt: (%,UniversalSegment(Integer)) -> % + ++ elt(u,i..j) (also written: \axiom{a(i..j)}) returns the aggregate of + ++ elements \axiom{u} for k from i to j in that order. + ++ Note: in general, \axiom{a.s = [a.k for i in s]}. + delete: (%,Integer) -> % + ++ delete(u,i) returns a copy of u with the \axiom{i}th element deleted. + ++ Note: for lists, \axiom{delete(a,i) == concat(a(0..i - 1),a(i + 1,..))}. + delete: (%,UniversalSegment(Integer)) -> % + ++ delete(u,i..j) returns a copy of u with the \axiom{i}th through + ++ \axiom{j}th element deleted. + ++ Note: \axiom{delete(a,i..j) = concat(a(0..i-1),a(j+1..))}. + insert: (S,%,Integer) -> % + ++ insert(x,u,i) returns a copy of u having x as its \axiom{i}th element. + ++ Note: \axiom{insert(x,a,k) = concat(concat(a(0..k-1),x),a(k..))}. + insert: (%,%,Integer) -> % + ++ insert(v,u,k) returns a copy of u having v inserted beginning at the + ++ \axiom{i}th element. + ++ Note: \axiom{insert(v,u,k) = concat( u(0..k-1), v, u(k..) )}. + if % has shallowlyMutable then setelt: (%,UniversalSegment(Integer),S) -> S + ++ setelt(u,i..j,x) (also written: \axiom{u(i..j) := x}) destructively + ++ replaces each element in the segment \axiom{u(i..j)} by x. + ++ The value x is returned. + ++ Note: u is destructively change so + ++ that \axiom{u.k := x for k in i..j}; + ++ its length remains unchanged. + add + indices a == [i for i in minIndex a .. maxIndex a] + index?(i, a) == i >= minIndex a and i <= maxIndex a + concat(a:%, x:S) == concat(a, new(1, x)) + concat(x:S, y:%) == concat(new(1, x), y) + insert(x:S, a:%, i:Integer) == insert(new(1, x), a, i) + if % has finiteAggregate then + maxIndex l == #l - 1 + minIndex l + +--if % has shallowlyMutable then new(n, s) == fill_!(new n, s) + +@ +<>= +"LNAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"LNAGG" -> "IXAGG" +"LNAGG" -> "CLAGG" + +@ +<>= +"LinearAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"LinearAggregate(a:Type)" -> "IndexedAggregate(b:Integer,a:Type)" +"LinearAggregate(a:Type)" -> "Collection(a:Type)" + +@ +\section{LNAGG.lsp BOOTSTRAP} +{\bf LNAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf LNAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf LNAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |LinearAggregate;CAT| (QUOTE NIL)) + +(SETQ |LinearAggregate;AL| (QUOTE NIL)) + +(DEFUN |LinearAggregate| (#1=#:G85818) (LET (#2=#:G85819) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |LinearAggregate;AL|)) (CDR #2#)) (T (SETQ |LinearAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|LinearAggregate;| #1#))) |LinearAggregate;AL|)) #2#)))) + +(DEFUN |LinearAggregate;| (|t#1|) (PROG (#1=#:G85817) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (|sublisV| (PAIR (QUOTE (#2=#:G85816)) (LIST (QUOTE (|Integer|)))) (COND (|LinearAggregate;CAT|) ((QUOTE T) (LETT |LinearAggregate;CAT| (|Join| (|IndexedAggregate| (QUOTE #2#) (QUOTE |t#1|)) (|Collection| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|new| (|$| (|NonNegativeInteger|) |t#1|)) T) ((|concat| (|$| |$| |t#1|)) T) ((|concat| (|$| |t#1| |$|)) T) ((|concat| (|$| |$| |$|)) T) ((|concat| (|$| (|List| |$|))) T) ((|map| (|$| (|Mapping| |t#1| |t#1| |t#1|) |$| |$|)) T) ((|elt| (|$| |$| (|UniversalSegment| (|Integer|)))) T) ((|delete| (|$| |$| (|Integer|))) T) ((|delete| (|$| |$| (|UniversalSegment| (|Integer|)))) T) ((|insert| (|$| |t#1| |$| (|Integer|))) T) ((|insert| (|$| |$| |$| (|Integer|))) T) ((|setelt| (|t#1| |$| (|UniversalSegment| (|Integer|)) |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))))) NIL (QUOTE ((|UniversalSegment| (|Integer|)) (|Integer|) (|List| |$|) (|NonNegativeInteger|))) NIL)) . #3=(|LinearAggregate|)))))) . #3#) (SETELT #1# 0 (LIST (QUOTE |LinearAggregate|) (|devaluate| |t#1|))))))) +@ +\section{LNAGG-.lsp BOOTSTRAP} +{\bf LNAGG-} depends on {\bf LNAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf LNAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf LNAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |LNAGG-;indices;AL;1| (|a| |$|) (PROG (#1=#:G85833 |i| #2=#:G85834) (RETURN (SEQ (PROGN (LETT #1# NIL |LNAGG-;indices;AL;1|) (SEQ (LETT |i| (SPADCALL |a| (QREFELT |$| 9)) |LNAGG-;indices;AL;1|) (LETT #2# (SPADCALL |a| (QREFELT |$| 10)) |LNAGG-;indices;AL;1|) G190 (COND ((|>| |i| #2#) (GO G191))) (SEQ (EXIT (LETT #1# (CONS |i| #1#) |LNAGG-;indices;AL;1|))) (LETT |i| (|+| |i| 1) |LNAGG-;indices;AL;1|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))))))) + +(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| |$|) (COND ((OR (|<| |i| (SPADCALL |a| (QREFELT |$| 9))) (|<| (SPADCALL |a| (QREFELT |$| 10)) |i|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) + +(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| |$|) (SPADCALL |a| (SPADCALL 1 |x| (QREFELT |$| 16)) (QREFELT |$| 17))) + +(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| |$|) (SPADCALL (SPADCALL 1 |x| (QREFELT |$| 16)) |y| (QREFELT |$| 17))) + +(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| |$|) (SPADCALL (SPADCALL 1 |x| (QREFELT |$| 16)) |a| |i| (QREFELT |$| 20))) + +(DEFUN |LNAGG-;maxIndex;AI;6| (|l| |$|) (|+| (|-| (SPADCALL |l| (QREFELT |$| 22)) 1) (SPADCALL |l| (QREFELT |$| 9)))) + +(DEFUN |LinearAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|LinearAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |LinearAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 25) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasAttribute| |#1| (QUOTE |finiteAggregate|)) (QSETREFV |$| 23 (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) |$|)))) |$|)))) + +(MAKEPROP (QUOTE |LinearAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|Integer|) (0 . |minIndex|) (5 . |maxIndex|) (|List| 8) |LNAGG-;indices;AL;1| (|Boolean|) |LNAGG-;index?;IAB;2| (|NonNegativeInteger|) (10 . |new|) (16 . |concat|) |LNAGG-;concat;ASA;3| |LNAGG-;concat;S2A;4| (22 . |insert|) |LNAGG-;insert;SAIA;5| (29 . |#|) (34 . |maxIndex|) (|List| |$|))) (QUOTE #(|maxIndex| 39 |insert| 44 |indices| 51 |index?| 56 |concat| 62)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 23 (QUOTE (1 6 8 0 9 1 6 8 0 10 2 6 0 15 7 16 2 6 0 0 0 17 3 6 0 0 0 8 20 1 6 15 0 22 1 0 8 0 23 1 0 8 0 23 3 0 0 7 0 8 21 1 0 11 0 12 2 0 13 8 0 14 2 0 0 0 7 18 2 0 0 7 0 19)))))) (QUOTE |lookupComplete|))) +@ +\section{category LSAGG ListAggregate} +<>= +)abbrev category LSAGG ListAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A list aggregate is a model for a linked list data structure. +++ A linked list is a versatile +++ data structure. Insertion and deletion are efficient and +++ searching is a linear operation. +ListAggregate(S:Type): Category == Join(StreamAggregate S, + FiniteLinearAggregate S, ExtensibleLinearAggregate S) with + list: S -> % + ++ list(x) returns the list of one element x. + add + cycleMax ==> 1000 + + mergeSort: ((S, S) -> Boolean, %, Integer) -> % + + sort_!(f, l) == mergeSort(f, l, #l) + list x == concat(x, empty()) + reduce(f, x) == + empty? x => error "reducing over an empty list needs the 3 argument form" + reduce(f, rest x, first x) + merge(f, p, q) == merge_!(f, copy p, copy q) + + select_!(f, x) == + while not empty? x and not f first x repeat x := rest x + empty? x => x + y := x + z := rest y + while not empty? z repeat + if f first z then (y := z; z := rest z) + else (z := rest z; setrest_!(y, z)) + x + + merge_!(f, p, q) == + empty? p => q + empty? q => p + eq?(p, q) => error "cannot merge a list into itself" + if f(first p, first q) + then (r := t := p; p := rest p) + else (r := t := q; q := rest q) + while not empty? p and not empty? q repeat + if f(first p, first q) + then (setrest_!(t, p); t := p; p := rest p) + else (setrest_!(t, q); t := q; q := rest q) + setrest_!(t, if empty? p then q else p) + r + + insert_!(s:S, x:%, i:Integer) == + i < (m := minIndex x) => error "index out of range" + i = m => concat(s, x) + y := rest(x, (i - 1 - m)::NonNegativeInteger) + z := rest y + setrest_!(y, concat(s, z)) + x + + insert_!(w:%, x:%, i:Integer) == + i < (m := minIndex x) => error "index out of range" + i = m => concat_!(w, x) + y := rest(x, (i - 1 - m)::NonNegativeInteger) + z := rest y + setrest_!(y, w) + concat_!(y, z) + x + + remove_!(f:S -> Boolean, x:%) == + while not empty? x and f first x repeat x := rest x + empty? x => x + p := x + q := rest x + while not empty? q repeat + if f first q then q := setrest_!(p, rest q) + else (p := q; q := rest q) + x + + delete_!(x:%, i:Integer) == + i < (m := minIndex x) => error "index out of range" + i = m => rest x + y := rest(x, (i - 1 - m)::NonNegativeInteger) + setrest_!(y, rest(y, 2)) + x + + delete_!(x:%, i:UniversalSegment(Integer)) == + (l := lo i) < (m := minIndex x) => error "index out of range" + h := if hasHi i then hi i else maxIndex x + h < l => x + l = m => rest(x, (h + 1 - m)::NonNegativeInteger) + t := rest(x, (l - 1 - m)::NonNegativeInteger) + setrest_!(t, rest(t, (h - l + 2)::NonNegativeInteger)) + x + + find(f, x) == + while not empty? x and not f first x repeat x := rest x + empty? x => "failed" + first x + + position(f:S -> Boolean, x:%) == + for k in minIndex(x).. while not empty? x and not f first x repeat + x := rest x + empty? x => minIndex(x) - 1 + k + + mergeSort(f, p, n) == + if n = 2 and f(first rest p, first p) then p := reverse_! p + n < 3 => p + l := (n quo 2)::NonNegativeInteger + q := split_!(p, l) + p := mergeSort(f, p, l) + q := mergeSort(f, q, n - l) + merge_!(f, p, q) + + sorted?(f, l) == + empty? l => true + p := rest l + while not empty? p repeat + not f(first l, first p) => return false + p := rest(l := p) + true + + reduce(f, x, i) == + r := i + while not empty? x repeat (r := f(r, first x); x := rest x) + r + + if S has SetCategory then + reduce(f, x, i,a) == + r := i + while not empty? x and r ^= a repeat + r := f(r, first x) + x := rest x + r + + new(n, s) == + l := empty() + for k in 1..n repeat l := concat(s, l) + l + + map(f, x, y) == + z := empty() + while not empty? x and not empty? y repeat + z := concat(f(first x, first y), z) + x := rest x + y := rest y + reverse_! z + +-- map(f, x, y, d) == +-- z := empty() +-- while not empty? x and not empty? y repeat +-- z := concat(f(first x, first y), z) +-- x := rest x +-- y := rest y +-- z := reverseInPlace z +-- if not empty? x then +-- z := concat_!(z, map(f(#1, d), x)) +-- if not empty? y then +-- z := concat_!(z, map(f(d, #1), y)) +-- z + + reverse_! x == + empty? x => x + empty?(y := rest x) => x + setrest_!(x, empty()) + while not empty? y repeat + z := rest y + setrest_!(y, x) + x := y + y := z + x + + copy x == + y := empty() + for k in 0.. while not empty? x repeat + k = cycleMax and cyclic? x => error "cyclic list" + y := concat(first x, y) + x := rest x + reverse_! y + + copyInto_!(y, x, s) == + s < (m := minIndex y) => error "index out of range" + z := rest(y, (s - m)::NonNegativeInteger) + while not empty? z and not empty? x repeat + setfirst_!(z, first x) + x := rest x + z := rest z + y + + if S has SetCategory then + position(w, x, s) == + s < (m := minIndex x) => error "index out of range" + x := rest(x, (s - m)::NonNegativeInteger) + for k in s.. while not empty? x and w ^= first x repeat + x := rest x + empty? x => minIndex x - 1 + k + + removeDuplicates_! l == + p := l + while not empty? p repeat + p := setrest_!(p, remove_!(#1 = first p, rest p)) + l + + if S has OrderedSet then + x < y == + while not empty? x and not empty? y repeat + first x ^= first y => return(first x < first y) + x := rest x + y := rest y + empty? x => not empty? y + false + +@ +<>= +"LSAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"LSAGG" -> "FLAGG" +"LSAGG" -> "ELAGG" + +@ +<>= +"ListAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"ListAggregate(a:Type)" -> "FiniteLinearAggregate(a:Type)" +"ListAggregate(a:Type)" -> "ExtensibleLinearAggregate(a:Type)" + +@ +\section{LSAGG.lsp BOOTSTRAP} +{\bf LSAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf LSAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf LSAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |ListAggregate;CAT| (QUOTE NIL)) + +(SETQ |ListAggregate;AL| (QUOTE NIL)) + +(DEFUN |ListAggregate| (#1=#:G87500) (LET (#2=#:G87501) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |ListAggregate;AL|)) (CDR #2#)) (T (SETQ |ListAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|ListAggregate;| #1#))) |ListAggregate;AL|)) #2#)))) + +(DEFUN |ListAggregate;| (|t#1|) (PROG (#1=#:G87499) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|ListAggregate;CAT|) ((QUOTE T) (LETT |ListAggregate;CAT| (|Join| (|StreamAggregate| (QUOTE |t#1|)) (|FiniteLinearAggregate| (QUOTE |t#1|)) (|ExtensibleLinearAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|list| (|$| |t#1|)) T))) NIL (QUOTE NIL) NIL)) . #2=(|ListAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |ListAggregate|) (|devaluate| |t#1|))))))) +@ +\section{LSAGG-.lsp BOOTSTRAP} +{\bf LSAGG-} depends on {\bf LSAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf LSAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf LSAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| |$|) (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (QREFELT |$| 9)) |$|)) + +(DEFUN |LSAGG-;list;SA;2| (|x| |$|) (SPADCALL |x| (SPADCALL (QREFELT |$| 12)) (QREFELT |$| 13))) + +(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 16)) (|error| "reducing over an empty list needs the 3 argument form")) ((QUOTE T) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 17)) (SPADCALL |x| (QREFELT |$| 18)) (QREFELT |$| 20))))) + +(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| |$|) (SPADCALL |f| (SPADCALL |p| (QREFELT |$| 22)) (SPADCALL |q| (QREFELT |$| 22)) (QREFELT |$| 23))) + +(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| |$|) (PROG (|y| |z|) (RETURN (SEQ (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) |x|) ((QUOTE T) (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |z| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (SPADCALL |z| (QREFELT |$| 18)) |f|) (SEQ (LETT |y| |z| |LSAGG-;select!;M2A;5|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|)))) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |z| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|) (EXIT (SPADCALL |y| |z| (QREFELT |$| 25)))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| |$|) (PROG (|r| |t|) (RETURN (SEQ (COND ((SPADCALL |p| (QREFELT |$| 16)) |q|) ((SPADCALL |q| (QREFELT |$| 16)) |p|) ((SPADCALL |p| |q| (QREFELT |$| 28)) (|error| "cannot merge a list into itself")) ((QUOTE T) (SEQ (COND ((SPADCALL (SPADCALL |p| (QREFELT |$| 18)) (SPADCALL |q| (QREFELT |$| 18)) |f|) (SEQ (LETT |r| (LETT |t| |p| |LSAGG-;merge!;M3A;6|) |LSAGG-;merge!;M3A;6|) (EXIT (LETT |p| (SPADCALL |p| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|)))) ((QUOTE T) (SEQ (LETT |r| (LETT |t| |q| |LSAGG-;merge!;M3A;6|) |LSAGG-;merge!;M3A;6|) (EXIT (LETT |q| (SPADCALL |q| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|))))) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |p| (QREFELT |$| 16)) (SPADCALL |q| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (SPADCALL |p| (QREFELT |$| 18)) (SPADCALL |q| (QREFELT |$| 18)) |f|) (SEQ (SPADCALL |t| |p| (QREFELT |$| 25)) (LETT |t| |p| |LSAGG-;merge!;M3A;6|) (EXIT (LETT |p| (SPADCALL |p| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|)))) ((QUOTE T) (SEQ (SPADCALL |t| |q| (QREFELT |$| 25)) (LETT |t| |q| |LSAGG-;merge!;M3A;6|) (EXIT (LETT |q| (SPADCALL |q| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|))))))) NIL (GO G190) G191 (EXIT NIL)) (SPADCALL |t| (COND ((SPADCALL |p| (QREFELT |$| 16)) |q|) ((QUOTE T) |p|)) (QREFELT |$| 25)) (EXIT |r|)))))))) + +(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| |$|) (PROG (|m| #1=#:G87547 |y| |z|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;insert!;SAIA;7|) (EXIT (COND ((|<| |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |s| |x| (QREFELT |$| 13))) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# (|-| (|-| |i| 1) |m|) |LSAGG-;insert!;SAIA;7|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;insert!;SAIA;7|) (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;insert!;SAIA;7|) (SPADCALL |y| (SPADCALL |s| |z| (QREFELT |$| 13)) (QREFELT |$| 25)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| |$|) (PROG (|m| #1=#:G87551 |y| |z|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;insert!;2AIA;8|) (EXIT (COND ((|<| |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |w| |x| (QREFELT |$| 34))) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# (|-| (|-| |i| 1) |m|) |LSAGG-;insert!;2AIA;8|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;insert!;2AIA;8|) (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;insert!;2AIA;8|) (SPADCALL |y| |w| (QREFELT |$| 25)) (SPADCALL |y| |z| (QREFELT |$| 34)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| |$|) (PROG (|p| |q|) (RETURN (SEQ (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;remove!;M2A;9|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) |x|) ((QUOTE T) (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) (LETT |q| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;remove!;M2A;9|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |q| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (SPADCALL |q| (QREFELT |$| 18)) |f|) (LETT |q| (SPADCALL |p| (SPADCALL |q| (QREFELT |$| 17)) (QREFELT |$| 25)) |LSAGG-;remove!;M2A;9|)) ((QUOTE T) (SEQ (LETT |p| |q| |LSAGG-;remove!;M2A;9|) (EXIT (LETT |q| (SPADCALL |q| (QREFELT |$| 17)) |LSAGG-;remove!;M2A;9|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| |$|) (PROG (|m| #1=#:G87564 |y|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;delete!;AIA;10|) (EXIT (COND ((|<| |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |x| (QREFELT |$| 17))) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# (|-| (|-| |i| 1) |m|) |LSAGG-;delete!;AIA;10|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;delete!;AIA;10|) (SPADCALL |y| (SPADCALL |y| 2 (QREFELT |$| 32)) (QREFELT |$| 25)) (EXIT |x|))))))))) + +(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| |$|) (PROG (|l| |m| |h| #1=#:G87569 #2=#:G87570 |t| #3=#:G87571) (RETURN (SEQ (LETT |l| (SPADCALL |i| (QREFELT |$| 39)) |LSAGG-;delete!;AUsA;11|) (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;delete!;AUsA;11|) (EXIT (COND ((|<| |l| |m|) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |h| (COND ((SPADCALL |i| (QREFELT |$| 40)) (SPADCALL |i| (QREFELT |$| 41))) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 42)))) |LSAGG-;delete!;AUsA;11|) (EXIT (COND ((|<| |h| |l|) |x|) ((EQL |l| |m|) (SPADCALL |x| (PROG1 (LETT #1# (|-| (|+| |h| 1) |m|) |LSAGG-;delete!;AUsA;11|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32))) ((QUOTE T) (SEQ (LETT |t| (SPADCALL |x| (PROG1 (LETT #2# (|-| (|-| |l| 1) |m|) |LSAGG-;delete!;AUsA;11|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) (QREFELT |$| 32)) |LSAGG-;delete!;AUsA;11|) (SPADCALL |t| (SPADCALL |t| (PROG1 (LETT #3# (|+| (|-| |h| |l|) 2) |LSAGG-;delete!;AUsA;11|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)) (QREFELT |$| 32)) (QREFELT |$| 25)) (EXIT |x|))))))))))))) + +(DEFUN |LSAGG-;find;MAU;12| (|f| |x| |$|) (SEQ (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;find;MAU;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (CONS 1 "failed")) ((QUOTE T) (CONS 0 (SPADCALL |x| (QREFELT |$| 18)))))))) + +(DEFUN |LSAGG-;position;MAI;13| (|f| |x| |$|) (PROG (|k|) (RETURN (SEQ (SEQ (LETT |k| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;position;MAI;13|) G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;position;MAI;13|))) (LETT |k| (|+| |k| 1) |LSAGG-;position;MAI;13|) (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (|-| (SPADCALL |x| (QREFELT |$| 31)) 1)) ((QUOTE T) |k|))))))) + +(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| |$|) (PROG (#1=#:G87593 |l| |q|) (RETURN (SEQ (COND ((EQL |n| 2) (COND ((SPADCALL (SPADCALL (SPADCALL |p| (QREFELT |$| 17)) (QREFELT |$| 18)) (SPADCALL |p| (QREFELT |$| 18)) |f|) (LETT |p| (SPADCALL |p| (QREFELT |$| 47)) |LSAGG-;mergeSort|))))) (EXIT (COND ((|<| |n| 3) |p|) ((QUOTE T) (SEQ (LETT |l| (PROG1 (LETT #1# (QUOTIENT2 |n| 2) |LSAGG-;mergeSort|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) |LSAGG-;mergeSort|) (LETT |q| (SPADCALL |p| |l| (QREFELT |$| 48)) |LSAGG-;mergeSort|) (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| |$|) |LSAGG-;mergeSort|) (LETT |q| (|LSAGG-;mergeSort| |f| |q| (|-| |n| |l|) |$|) |LSAGG-;mergeSort|) (EXIT (SPADCALL |f| |p| |q| (QREFELT |$| 23))))))))))) + +(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| |$|) (PROG (#1=#:G87603 |p|) (RETURN (SEQ (EXIT (COND ((SPADCALL |l| (QREFELT |$| 16)) (QUOTE T)) ((QUOTE T) (SEQ (LETT |p| (SPADCALL |l| (QREFELT |$| 17)) |LSAGG-;sorted?;MAB;15|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |p| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((NULL (SPADCALL (SPADCALL |l| (QREFELT |$| 18)) (SPADCALL |p| (QREFELT |$| 18)) |f|)) (PROGN (LETT #1# (QUOTE NIL) |LSAGG-;sorted?;MAB;15|) (GO #1#))) ((QUOTE T) (LETT |p| (SPADCALL (LETT |l| |p| |LSAGG-;sorted?;MAB;15|) (QREFELT |$| 17)) |LSAGG-;sorted?;MAB;15|))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (QUOTE T)))))) #1# (EXIT #1#))))) + +(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| |$|) (PROG (|r|) (RETURN (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |r| (SPADCALL |r| (SPADCALL |x| (QREFELT |$| 18)) |f|) |LSAGG-;reduce;MA2S;16|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;reduce;MA2S;16|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |r|))))) + +(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| |$|) (PROG (|r|) (RETURN (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |r| |a| (QREFELT |$| 51))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |r| (SPADCALL |r| (SPADCALL |x| (QREFELT |$| 18)) |f|) |LSAGG-;reduce;MA3S;17|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;reduce;MA3S;17|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |r|))))) + +(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| |$|) (PROG (|k| |l|) (RETURN (SEQ (LETT |l| (SPADCALL (QREFELT |$| 12)) |LSAGG-;new;NniSA;18|) (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 (COND ((QSGREATERP |k| |n|) (GO G191))) (SEQ (EXIT (LETT |l| (SPADCALL |s| |l| (QREFELT |$| 13)) |LSAGG-;new;NniSA;18|))) (LETT |k| (QSADD1 |k|) |LSAGG-;new;NniSA;18|) (GO G190) G191 (EXIT NIL)) (EXIT |l|))))) + +(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| |$|) (PROG (|z|) (RETURN (SEQ (LETT |z| (SPADCALL (QREFELT |$| 12)) |LSAGG-;map;M3A;19|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |y| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |z| (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) (SPADCALL |y| (QREFELT |$| 18)) |f|) |z| (QREFELT |$| 13)) |LSAGG-;map;M3A;19|) (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;map;M3A;19|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;map;M3A;19|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |z| (QREFELT |$| 47))))))) + +(DEFUN |LSAGG-;reverse!;2A;20| (|x| |$|) (PROG (|z| |y|) (RETURN (SEQ (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (LETT |y| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;reverse!;2A;20|) (QREFELT |$| 16))) |x|) ((QUOTE T) (SEQ (SPADCALL |x| (SPADCALL (QREFELT |$| 12)) (QREFELT |$| 25)) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;reverse!;2A;20|) (SPADCALL |y| |x| (QREFELT |$| 25)) (LETT |x| |y| |LSAGG-;reverse!;2A;20|) (EXIT (LETT |y| |z| |LSAGG-;reverse!;2A;20|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|)))))))) + +(DEFUN |LSAGG-;copy;2A;21| (|x| |$|) (PROG (|k| |y|) (RETURN (SEQ (LETT |y| (SPADCALL (QREFELT |$| 12)) |LSAGG-;copy;2A;21|) (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 56)) (EXIT (|error| "cyclic list")))))) (LETT |y| (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |y| (QREFELT |$| 13)) |LSAGG-;copy;2A;21|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;copy;2A;21|))) (LETT |k| (QSADD1 |k|) |LSAGG-;copy;2A;21|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |y| (QREFELT |$| 47))))))) + +(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| |$|) (PROG (|m| #1=#:G87636 |z|) (RETURN (SEQ (LETT |m| (SPADCALL |y| (QREFELT |$| 31)) |LSAGG-;copyInto!;2AIA;22|) (EXIT (COND ((|<| |s| |m|) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |y| (PROG1 (LETT #1# (|-| |s| |m|) |LSAGG-;copyInto!;2AIA;22|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;copyInto!;2AIA;22|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |z| (QREFELT |$| 16)) (SPADCALL |x| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |z| (SPADCALL |x| (QREFELT |$| 18)) (QREFELT |$| 58)) (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;copyInto!;2AIA;22|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 17)) |LSAGG-;copyInto!;2AIA;22|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))))))))) + +(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| |$|) (PROG (|m| #1=#:G87644 |k|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;position;SA2I;23|) (EXIT (COND ((|<| |s| |m|) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |x| (SPADCALL |x| (PROG1 (LETT #1# (|-| |s| |m|) |LSAGG-;position;SA2I;23|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;position;SA2I;23|) (SEQ (LETT |k| |s| |LSAGG-;position;SA2I;23|) G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |w| (SPADCALL |x| (QREFELT |$| 18)) (QREFELT |$| 51))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;position;SA2I;23|))) (LETT |k| (|+| |k| 1) |LSAGG-;position;SA2I;23|) (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (|-| (SPADCALL |x| (QREFELT |$| 31)) 1)) ((QUOTE T) |k|))))))))))) + +(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| |$|) (PROG (|p|) (RETURN (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |p| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |p| (SPADCALL |p| (SPADCALL (CONS (FUNCTION |LSAGG-;removeDuplicates!;2A;24!0|) (VECTOR |$| |p|)) (SPADCALL |p| (QREFELT |$| 17)) (QREFELT |$| 61)) (QREFELT |$| 25)) |LSAGG-;removeDuplicates!;2A;24|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |l|))))) + +(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| |$$|) (PROG (|$|) (LETT |$| (QREFELT |$$| 0) |LSAGG-;removeDuplicates!;2A;24|) (RETURN (PROGN (SPADCALL |#1| (SPADCALL (QREFELT |$$| 1) (QREFELT |$| 18)) (QREFELT |$| 51)))))) + +(DEFUN |LSAGG-;<;2AB;25| (|x| |y| |$|) (PROG (#1=#:G87662) (RETURN (SEQ (EXIT (SEQ (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |y| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((NULL (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) (SPADCALL |y| (QREFELT |$| 18)) (QREFELT |$| 51))) (PROGN (LETT #1# (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) (SPADCALL |y| (QREFELT |$| 18)) (QREFELT |$| 63)) |LSAGG-;<;2AB;25|) (GO #1#))) ((QUOTE T) (SEQ (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;<;2AB;25|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;<;2AB;25|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (COND ((SPADCALL |y| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))))) #1# (EXIT #1#))))) + +(DEFUN |ListAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|ListAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |ListAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 66) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasCategory| |#2| (QUOTE (|SetCategory|))) (QSETREFV |$| 52 (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) |$|)))) (COND ((|HasCategory| |#2| (QUOTE (|SetCategory|))) (PROGN (QSETREFV |$| 60 (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) |$|)) (QSETREFV |$| 62 (CONS (|dispatchFunction| |LSAGG-;removeDuplicates!;2A;24|) |$|))))) (COND ((|HasCategory| |#2| (QUOTE (|OrderedSet|))) (QSETREFV |$| 64 (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) |$|)))) |$|)))) + +(MAKEPROP (QUOTE |ListAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|NonNegativeInteger|) (0 . |#|) (|Mapping| 15 7 7) |LSAGG-;sort!;M2A;1| (5 . |empty|) (9 . |concat|) |LSAGG-;list;SA;2| (|Boolean|) (15 . |empty?|) (20 . |rest|) (25 . |first|) (|Mapping| 7 7 7) (30 . |reduce|) |LSAGG-;reduce;MAS;3| (37 . |copy|) (42 . |merge!|) |LSAGG-;merge;M3A;4| (49 . |setrest!|) (|Mapping| 15 7) |LSAGG-;select!;M2A;5| (55 . |eq?|) |LSAGG-;merge!;M3A;6| (|Integer|) (61 . |minIndex|) (66 . |rest|) |LSAGG-;insert!;SAIA;7| (72 . |concat!|) |LSAGG-;insert!;2AIA;8| |LSAGG-;remove!;M2A;9| |LSAGG-;delete!;AIA;10| (|UniversalSegment| 30) (78 . |lo|) (83 . |hasHi|) (88 . |hi|) (93 . |maxIndex|) |LSAGG-;delete!;AUsA;11| (|Union| 7 (QUOTE "failed")) |LSAGG-;find;MAU;12| |LSAGG-;position;MAI;13| (98 . |reverse!|) (103 . |split!|) |LSAGG-;sorted?;MAB;15| |LSAGG-;reduce;MA2S;16| (109 . |=|) (115 . |reduce|) |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| |LSAGG-;reverse!;2A;20| (123 . |cyclic?|) |LSAGG-;copy;2A;21| (128 . |setfirst!|) |LSAGG-;copyInto!;2AIA;22| (134 . |position|) (141 . |remove!|) (147 . |removeDuplicates!|) (152 . |<|) (158 . |<|) (|Mapping| 7 7))) (QUOTE #(|sorted?| 164 |sort!| 170 |select!| 176 |reverse!| 182 |removeDuplicates!| 187 |remove!| 192 |reduce| 198 |position| 219 |new| 232 |merge!| 238 |merge| 245 |map| 252 |list| 259 |insert!| 264 |find| 278 |delete!| 284 |copyInto!| 296 |copy| 303 |<| 308)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 64 (QUOTE (1 6 8 0 9 0 6 0 12 2 6 0 7 0 13 1 6 15 0 16 1 6 0 0 17 1 6 7 0 18 3 6 7 19 0 7 20 1 6 0 0 22 3 6 0 10 0 0 23 2 6 0 0 0 25 2 6 15 0 0 28 1 6 30 0 31 2 6 0 0 8 32 2 6 0 0 0 34 1 38 30 0 39 1 38 15 0 40 1 38 30 0 41 1 6 30 0 42 1 6 0 0 47 2 6 0 0 30 48 2 7 15 0 0 51 4 0 7 19 0 7 7 52 1 6 15 0 56 2 6 7 0 7 58 3 0 30 7 0 30 60 2 6 0 26 0 61 1 0 0 0 62 2 7 15 0 0 63 2 0 15 0 0 64 2 0 15 10 0 49 2 0 0 10 0 11 2 0 0 26 0 27 1 0 0 0 55 1 0 0 0 62 2 0 0 26 0 36 3 0 7 19 0 7 50 4 0 7 19 0 7 7 52 2 0 7 19 0 21 2 0 30 26 0 46 3 0 30 7 0 30 60 2 0 0 8 7 53 3 0 0 10 0 0 29 3 0 0 10 0 0 24 3 0 0 19 0 0 54 1 0 0 7 14 3 0 0 7 0 30 33 3 0 0 0 0 30 35 2 0 44 26 0 45 2 0 0 0 38 43 2 0 0 0 30 37 3 0 0 0 0 30 59 1 0 0 0 57 2 0 15 0 0 64)))))) (QUOTE |lookupComplete|))) +@ +\section{category MDAGG MultiDictionary} +<>= +)abbrev category MDAGG MultiDictionary +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A multi-dictionary is a dictionary which may contain duplicates. +++ As for any dictionary, its size is assumed large so that +++ copying (non-destructive) operations are generally to be avoided. +MultiDictionary(S:SetCategory): Category == DictionaryOperations S with +-- count: (S,%) -> NonNegativeInteger ++ multiplicity count + insert_!: (S,%,NonNegativeInteger) -> % + ++ insert!(x,d,n) destructively inserts n copies of x into dictionary d. +-- remove_!: (S,%,NonNegativeInteger) -> % +-- ++ remove!(x,d,n) destructively removes (up to) n copies of x from +-- ++ dictionary d. + removeDuplicates_!: % -> % + ++ removeDuplicates!(d) destructively removes any duplicate values + ++ in dictionary d. + duplicates: % -> List Record(entry:S,count:NonNegativeInteger) + ++ duplicates(d) returns a list of values which have duplicates in d +-- ++ duplicates(d) returns a list of ++ duplicates iterator +-- to become duplicates: % -> Iterator(D,D) + +@ +<>= +"MDAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"MDAGG" -> "DIOPS" + +@ +<>= +"MultiDictionary(a:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"MultiDictionary(a:SetCategory)" -> "DictionaryOperations(a:SetCategory)" + +@ +\section{category MSETAGG MultisetAggregate} +<>= +)abbrev category MSETAGG MultisetAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A multi-set aggregate is a set which keeps track of the multiplicity +++ of its elements. +MultisetAggregate(S:SetCategory): + Category == Join(MultiDictionary S, SetAggregate S) + +@ +<>= +"MSETAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"MSETAGG" -> "MDAGG" +"MSETAGG" -> "SETAGG" + +@ +<>= +"MultisetAggregate(a:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"MultisetAggregate(a:SetCategory)" -> "MultiDictionary(a:SetCategory)" +"MultisetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)" + +@ +\section{category OMSAGG OrderedMultisetAggregate} +<>= +)abbrev category OMSAGG OrderedMultisetAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ An ordered-multiset aggregate is a multiset built over an ordered set S +++ so that the relative sizes of its entries can be assessed. +++ These aggregates serve as models for priority queues. +OrderedMultisetAggregate(S:OrderedSet): Category == + Join(MultisetAggregate S,PriorityQueueAggregate S) with + -- max: % -> S ++ smallest entry in the set + -- duplicates: % -> List Record(entry:S,count:NonNegativeInteger) + ++ to become an in order iterator + -- parts: % -> List S ++ in order iterator + min: % -> S + ++ min(u) returns the smallest entry in the multiset aggregate u. + +@ +<>= +"OMSAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"OMSAGG" -> "MSETAGG" +"OMSAGG" -> "PRQAGG" + +@ +<>= +"OrderedMultisetAggregate(a:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"OrderedMultisetAggregate(a:SetCategory)" -> "MultisetAggregate(a:SetCategory)" +"OrderedMultisetAggregate(a:SetCategory)" -> + "PriorityQueueAggregate(a:SetCategory)" + +@ +\section{category PRQAGG PriorityQueueAggregate} +<>= +)abbrev category PRQAGG PriorityQueueAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A priority queue is a bag of items from an ordered set where the item +++ extracted is always the maximum element. +PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with + finiteAggregate + max: % -> S + ++ max(q) returns the maximum element of priority queue q. + merge: (%,%) -> % + ++ merge(q1,q2) returns combines priority queues q1 and q2 to return + ++ a single priority queue q. + merge_!: (%,%) -> % + ++ merge!(q,q1) destructively changes priority queue q to include the + ++ values from priority queue q1. + +@ +<>= +"PRQAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"PRQAGG" -> "BGAGG" + +@ +<>= +"PriorityQueueAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"PriorityQueueAggregate(a:Type)" -> "BagAggregate(a:Type)" + +"PriorityQueueAggregate(a:SetCategory)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"PriorityQueueAggregate(a:SetCategory)" -> "PriorityQueueAggregate(a:Type)" + +"PriorityQueueAggregate(a:OrderedSet)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"PriorityQueueAggregate(a:OrderedSet)" -> + "PriorityQueueAggregate(a:SetCategory)" + +@ +\section{category QUAGG QueueAggregate} +<>= +)abbrev category QUAGG QueueAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A queue is a bag where the first item inserted is the first item extracted. +QueueAggregate(S:Type): Category == BagAggregate S with + finiteAggregate + enqueue_!: (S, %) -> S + ++ enqueue!(x,q) inserts x into the queue q at the back end. + dequeue_!: % -> S + ++ dequeue! s destructively extracts the first (top) element from queue q. + ++ The element previously second in the queue becomes the first element. + ++ Error: if q is empty. + rotate_!: % -> % + ++ rotate! q rotates queue q so that the element at the front of + ++ the queue goes to the back of the queue. + ++ Note: rotate! q is equivalent to enqueue!(dequeue!(q)). + length: % -> NonNegativeInteger + ++ length(q) returns the number of elements in the queue. + ++ Note: \axiom{length(q) = #q}. + front: % -> S + ++ front(q) returns the element at the front of the queue. + ++ The queue q is unchanged by this operation. + ++ Error: if q is empty. + back: % -> S + ++ back(q) returns the element at the back of the queue. + ++ The queue q is unchanged by this operation. + ++ Error: if q is empty. + +@ +<>= +"QUAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"QUAGG" -> "BGAGG" + +@ +<>= +"QueueAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"QueueAggregate(a:Type)" -> "BagAggregate(a:Type)" + +"QueueAggregate(a:SetCategory)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"QueueAggregate(a:SetCategory)" -> "QueueAggregate(a:Type)" + +@ +\section{category RCAGG RecursiveAggregate} +<>= +)abbrev category RCAGG RecursiveAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A recursive aggregate over a type S is a model for a +++ a directed graph containing values of type S. +++ Recursively, a recursive aggregate is a {\em node} +++ consisting of a \spadfun{value} from S and 0 or more \spadfun{children} +++ which are recursive aggregates. +++ A node with no children is called a \spadfun{leaf} node. +++ A recursive aggregate may be cyclic for which some operations as noted +++ may go into an infinite loop. +RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with + children: % -> List % + ++ children(u) returns a list of the children of aggregate u. + -- should be % -> %* and also needs children: % -> Iterator(S,S) + nodes: % -> List % + ++ nodes(u) returns a list of all of the nodes of aggregate u. + -- to become % -> %* and also nodes: % -> Iterator(S,S) + leaf?: % -> Boolean + ++ leaf?(u) tests if u is a terminal node. + value: % -> S + ++ value(u) returns the value of the node u. + elt: (%,"value") -> S + ++ elt(u,"value") (also written: \axiom{a. value}) is + ++ equivalent to \axiom{value(a)}. + cyclic?: % -> Boolean + ++ cyclic?(u) tests if u has a cycle. + leaves: % -> List S + ++ leaves(t) returns the list of values in obtained by visiting the + ++ nodes of tree \axiom{t} in left-to-right order. + distance: (%,%) -> Integer + ++ distance(u,v) returns the path length (an integer) from node u to v. + if S has SetCategory then + child?: (%,%) -> Boolean + ++ child?(u,v) tests if node u is a child of node v. + node?: (%,%) -> Boolean + ++ node?(u,v) tests if node u is contained in node v + ++ (either as a child, a child of a child, etc.). + if % has shallowlyMutable then + setchildren_!: (%,List %)->% + ++ setchildren!(u,v) replaces the current children of node u + ++ with the members of v in left-to-right order. + setelt: (%,"value",S) -> S + ++ setelt(a,"value",x) (also written \axiom{a . value := x}) + ++ is equivalent to \axiom{setvalue!(a,x)} + setvalue_!: (%,S) -> S + ++ setvalue!(u,x) sets the value of node u to x. + add + elt(x,"value") == value x + if % has shallowlyMutable then + setelt(x,"value",y) == setvalue_!(x,y) + if S has SetCategory then + child?(x,l) == member?(x,children(l)) + +@ +<>= +"RCAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"RCAGG" -> "HOAGG" + +@ +<>= +"RecursiveAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"RecursiveAggregate(a:Type)" -> "HomogeneousAggregate(a:Type)" + +@ +\section{RCAGG.lsp BOOTSTRAP} +{\bf RCAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf RCAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf RCAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |RecursiveAggregate;CAT| (QUOTE NIL)) + +(SETQ |RecursiveAggregate;AL| (QUOTE NIL)) + +(DEFUN |RecursiveAggregate| (#1=#:G84501) (LET (#2=#:G84502) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |RecursiveAggregate;AL|)) (CDR #2#)) (T (SETQ |RecursiveAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|RecursiveAggregate;| #1#))) |RecursiveAggregate;AL|)) #2#)))) + +(DEFUN |RecursiveAggregate;| (|t#1|) (PROG (#1=#:G84500) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|RecursiveAggregate;CAT|) ((QUOTE T) (LETT |RecursiveAggregate;CAT| (|Join| (|HomogeneousAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|children| ((|List| |$|) |$|)) T) ((|nodes| ((|List| |$|) |$|)) T) ((|leaf?| ((|Boolean|) |$|)) T) ((|value| (|t#1| |$|)) T) ((|elt| (|t#1| |$| "value")) T) ((|cyclic?| ((|Boolean|) |$|)) T) ((|leaves| ((|List| |t#1|) |$|)) T) ((|distance| ((|Integer|) |$| |$|)) T) ((|child?| ((|Boolean|) |$| |$|)) (|has| |t#1| (|SetCategory|))) ((|node?| ((|Boolean|) |$| |$|)) (|has| |t#1| (|SetCategory|))) ((|setchildren!| (|$| |$| (|List| |$|))) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|t#1| |$| "value" |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setvalue!| (|t#1| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))))) NIL (QUOTE ((|List| |$|) (|Boolean|) (|Integer|) (|List| |t#1|))) NIL)) . #2=(|RecursiveAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |RecursiveAggregate|) (|devaluate| |t#1|))))))) +@ +\section{RCAGG-.lsp BOOTSTRAP} +{\bf RCAGG-} depends on {\bf RCAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf RCAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf RCAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |RCAGG-;elt;AvalueS;1| (|x| G84515 |$|) (SPADCALL |x| (QREFELT |$| 8))) + +(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| G84517 |y| |$|) (SPADCALL |x| |y| (QREFELT |$| 11))) + +(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| |$|) (SPADCALL |x| (SPADCALL |l| (QREFELT |$| 14)) (QREFELT |$| 17))) + +(DEFUN |RecursiveAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|RecursiveAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |RecursiveAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 19) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)) (|HasCategory| |#2| (QUOTE (|SetCategory|))))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 1) (QSETREFV |$| 12 (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) |$|)))) (COND ((|testBitVector| |pv$| 2) (QSETREFV |$| 18 (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) |$|)))) |$|)))) + +(MAKEPROP (QUOTE |RecursiveAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |value|) (QUOTE "value") |RCAGG-;elt;AvalueS;1| (5 . |setvalue!|) (11 . |setelt|) (|List| |$|) (18 . |children|) (|Boolean|) (|List| 6) (23 . |member?|) (29 . |child?|))) (QUOTE #(|setelt| 35 |elt| 42 |child?| 48)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 18 (QUOTE (1 6 7 0 8 2 6 7 0 7 11 3 0 7 0 9 7 12 1 6 13 0 14 2 16 15 6 0 17 2 0 15 0 0 18 3 0 7 0 9 7 12 2 0 7 0 9 10 2 0 15 0 0 18)))))) (QUOTE |lookupComplete|))) +@ +\section{category SETAGG SetAggregate} +<>= +)abbrev category SETAGG SetAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: 14 Oct, 1993 by RSS +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A set category lists a collection of set-theoretic operations +++ useful for both finite sets and multisets. +++ Note however that finite sets are distinct from multisets. +++ Although the operations defined for set categories are +++ common to both, the relationship between the two cannot +++ be described by inclusion or inheritance. +SetAggregate(S:SetCategory): + Category == Join(SetCategory, Collection(S)) with + partiallyOrderedSet + "<" : (%, %) -> Boolean + ++ s < t returns true if all elements of set aggregate s are also + ++ elements of set aggregate t. + brace : () -> % + ++ brace()$D (otherwise written {}$D) + ++ creates an empty set aggregate of type D. + ++ This form is considered obsolete. Use \axiomFun{set} instead. + brace : List S -> % + ++ brace([x,y,...,z]) + ++ creates a set aggregate containing items x,y,...,z. + ++ This form is considered obsolete. Use \axiomFun{set} instead. + set : () -> % + ++ set()$D creates an empty set aggregate of type D. + set : List S -> % + ++ set([x,y,...,z]) creates a set aggregate containing items x,y,...,z. + intersect: (%, %) -> % + ++ intersect(u,v) returns the set aggregate w consisting of + ++ elements common to both set aggregates u and v. + ++ Note: equivalent to the notation (not currently supported) + ++ {x for x in u | member?(x,v)}. + difference : (%, %) -> % + ++ difference(u,v) returns the set aggregate w consisting of + ++ elements in set aggregate u but not in set aggregate v. + ++ If u and v have no elements in common, \axiom{difference(u,v)} + ++ returns a copy of u. + ++ Note: equivalent to the notation (not currently supported) + ++ \axiom{{x for x in u | not member?(x,v)}}. + difference : (%, S) -> % + ++ difference(u,x) returns the set aggregate u with element x removed. + ++ If u does not contain x, a copy of u is returned. + ++ Note: \axiom{difference(s, x) = difference(s, {x})}. + symmetricDifference : (%, %) -> % + ++ symmetricDifference(u,v) returns the set aggregate of elements x which + ++ are members of set aggregate u or set aggregate v but not both. + ++ If u and v have no elements in common, \axiom{symmetricDifference(u,v)} + ++ returns a copy of u. + ++ Note: \axiom{symmetricDifference(u,v) = union(difference(u,v),difference(v,u))} + subset? : (%, %) -> Boolean + ++ subset?(u,v) tests if u is a subset of v. + ++ Note: equivalent to + ++ \axiom{reduce(and,{member?(x,v) for x in u},true,false)}. + union : (%, %) -> % + ++ union(u,v) returns the set aggregate of elements which are members + ++ of either set aggregate u or v. + union : (%, S) -> % + ++ union(u,x) returns the set aggregate u with the element x added. + ++ If u already contains x, \axiom{union(u,x)} returns a copy of u. + union : (S, %) -> % + ++ union(x,u) returns the set aggregate u with the element x added. + ++ If u already contains x, \axiom{union(x,u)} returns a copy of u. + add + symmetricDifference(x, y) == union(difference(x, y), difference(y, x)) + union(s:%, x:S) == union(s, {x}) + union(x:S, s:%) == union(s, {x}) + difference(s:%, x:S) == difference(s, {x}) + +@ +<>= +"SETAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"SETAGG" -> "SETCAT" +"SETAGG" -> "CLAGG" + +@ +<>= +"SetAggregate(a:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"SetAggregate(a:SetCategory)" -> "SetCategory()" +"SetAggregate(a:SetCategory)" -> "Collection(a:SetCategory)" + +@ +\section{SETAGG.lsp BOOTSTRAP} +{\bf SETAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf SETAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf SETAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |SetAggregate;CAT| (QUOTE NIL)) + +(SETQ |SetAggregate;AL| (QUOTE NIL)) + +(DEFUN |SetAggregate| (#1=#:G83200) (LET (#2=#:G83201) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |SetAggregate;AL|)) (CDR #2#)) (T (SETQ |SetAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|SetAggregate;| #1#))) |SetAggregate;AL|)) #2#)))) + +(DEFUN |SetAggregate;| (|t#1|) (PROG (#1=#:G83199) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|SetAggregate;CAT|) ((QUOTE T) (LETT |SetAggregate;CAT| (|Join| (|SetCategory|) (|Collection| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|<| ((|Boolean|) |$| |$|)) T) ((|brace| (|$|)) T) ((|brace| (|$| (|List| |t#1|))) T) ((|set| (|$|)) T) ((|set| (|$| (|List| |t#1|))) T) ((|intersect| (|$| |$| |$|)) T) ((|difference| (|$| |$| |$|)) T) ((|difference| (|$| |$| |t#1|)) T) ((|symmetricDifference| (|$| |$| |$|)) T) ((|subset?| ((|Boolean|) |$| |$|)) T) ((|union| (|$| |$| |$|)) T) ((|union| (|$| |$| |t#1|)) T) ((|union| (|$| |t#1| |$|)) T))) (QUOTE ((|partiallyOrderedSet| T))) (QUOTE ((|Boolean|) (|List| |t#1|))) NIL)) . #2=(|SetAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |SetAggregate|) (|devaluate| |t#1|))))))) +@ +\section{SETAGG-.lsp BOOTSTRAP} +{\bf SETAGG-} depends on {\bf SETAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf SETAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf SETAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| |$|) (SPADCALL (SPADCALL |x| |y| (QREFELT |$| 8)) (SPADCALL |y| |x| (QREFELT |$| 8)) (QREFELT |$| 9))) + +(DEFUN |SETAGG-;union;ASA;2| (|s| |x| |$|) (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT |$| 12)) (QREFELT |$| 9))) + +(DEFUN |SETAGG-;union;S2A;3| (|x| |s| |$|) (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT |$| 12)) (QREFELT |$| 9))) + +(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| |$|) (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT |$| 12)) (QREFELT |$| 8))) + +(DEFUN |SetAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|SetAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |SetAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 16) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) |$|)))) + +(MAKEPROP (QUOTE |SetAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |difference|) (6 . |union|) |SETAGG-;symmetricDifference;3A;1| (|List| 7) (12 . |brace|) |SETAGG-;union;ASA;2| |SETAGG-;union;S2A;3| |SETAGG-;difference;ASA;4|)) (QUOTE #(|union| 17 |symmetricDifference| 29 |difference| 35)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 15 (QUOTE (2 6 0 0 0 8 2 6 0 0 0 9 1 6 0 11 12 2 0 0 7 0 14 2 0 0 0 7 13 2 0 0 0 0 10 2 0 0 0 7 15)))))) (QUOTE |lookupComplete|))) +@ +\section{category SKAGG StackAggregate} +<>= +)abbrev category SKAGG StackAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A stack is a bag where the last item inserted is the first item extracted. +StackAggregate(S:Type): Category == BagAggregate S with + finiteAggregate + push_!: (S,%) -> S + ++ push!(x,s) pushes x onto stack s, i.e. destructively changing s + ++ so as to have a new first (top) element x. + ++ Afterwards, pop!(s) produces x and pop!(s) produces the original s. + pop_!: % -> S + ++ pop!(s) returns the top element x, destructively removing x from s. + ++ Note: Use \axiom{top(s)} to obtain x without removing it from s. + ++ Error: if s is empty. + top: % -> S + ++ top(s) returns the top element x from s; s remains unchanged. + ++ Note: Use \axiom{pop!(s)} to obtain x and remove it from s. + depth: % -> NonNegativeInteger + ++ depth(s) returns the number of elements of stack s. + ++ Note: \axiom{depth(s) = #s}. + + +@ +<>= +"SKAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"SKAGG" -> "BGAGG" + +@ +<>= +"StackAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"StackAggregate(a:Type)" -> "BagAggregate(a:Type)" + +"StackAggregate(a:SetCategory)" + [color=seagreen,href="books/bookvol10.pamphlet"]; +"StackAggregate(a:SetCategory)" -> "StackAggregate(a:Type)" + +@ +\section{category SRAGG StringAggregate} +<>= +)abbrev category SRAGG StringAggregate +++ Author: Stephen Watt and Michael Monagan. +++ revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A string aggregate is a category for strings, that is, +++ one dimensional arrays of characters. +StringAggregate: Category == OneDimensionalArrayAggregate Character with + lowerCase : % -> % + ++ lowerCase(s) returns the string with all characters in lower case. + lowerCase_!: % -> % + ++ lowerCase!(s) destructively replaces the alphabetic characters + ++ in s by lower case. + upperCase : % -> % + ++ upperCase(s) returns the string with all characters in upper case. + upperCase_!: % -> % + ++ upperCase!(s) destructively replaces the alphabetic characters + ++ in s by upper case characters. + prefix? : (%, %) -> Boolean + ++ prefix?(s,t) tests if the string s is the initial substring of t. + ++ Note: \axiom{prefix?(s,t) == reduce(and,[s.i = t.i for i in 0..maxIndex s])}. + suffix? : (%, %) -> Boolean + ++ suffix?(s,t) tests if the string s is the final substring of t. + ++ Note: \axiom{suffix?(s,t) == reduce(and,[s.i = t.(n - m + i) for i in 0..maxIndex s])} + ++ where m and n denote the maxIndex of s and t respectively. + substring?: (%, %, Integer) -> Boolean + ++ substring?(s,t,i) tests if s is a substring of t beginning at + ++ index i. + ++ Note: \axiom{substring?(s,t,0) = prefix?(s,t)}. + match: (%, %, Character) -> NonNegativeInteger + ++ match(p,s,wc) tests if pattern \axiom{p} matches subject \axiom{s} + ++ where \axiom{wc} is a wild card character. If no match occurs, + ++ the index \axiom{0} is returned; otheriwse, the value returned + ++ is the first index of the first character in the subject matching + ++ the subject (excluding that matched by an initial wild-card). + ++ For example, \axiom{match("*to*","yorktown","*")} returns \axiom{5} + ++ indicating a successful match starting at index \axiom{5} of + ++ \axiom{"yorktown"}. + match?: (%, %, Character) -> Boolean + ++ match?(s,t,c) tests if s matches t except perhaps for + ++ multiple and consecutive occurrences of character c. + ++ Typically c is the blank character. + replace : (%, UniversalSegment(Integer), %) -> % + ++ replace(s,i..j,t) replaces the substring \axiom{s(i..j)} of s by string t. + position : (%, %, Integer) -> Integer + ++ position(s,t,i) returns the position j of the substring s in string t, + ++ where \axiom{j >= i} is required. + position : (CharacterClass, %, Integer) -> Integer + ++ position(cc,t,i) returns the position \axiom{j >= i} in t of + ++ the first character belonging to cc. + coerce : Character -> % + ++ coerce(c) returns c as a string s with the character c. + + split: (%, Character) -> List % + ++ split(s,c) returns a list of substrings delimited by character c. + split: (%, CharacterClass) -> List % + ++ split(s,cc) returns a list of substrings delimited by characters in cc. + + trim: (%, Character) -> % + ++ trim(s,c) returns s with all characters c deleted from right + ++ and left ends. + ++ For example, \axiom{trim(" abc ", char " ")} returns \axiom{"abc"}. + trim: (%, CharacterClass) -> % + ++ trim(s,cc) returns s with all characters in cc deleted from right + ++ and left ends. + ++ For example, \axiom{trim("(abc)", charClass "()")} returns \axiom{"abc"}. + leftTrim: (%, Character) -> % + ++ leftTrim(s,c) returns s with all leading characters c deleted. + ++ For example, \axiom{leftTrim(" abc ", char " ")} returns \axiom{"abc "}. + leftTrim: (%, CharacterClass) -> % + ++ leftTrim(s,cc) returns s with all leading characters in cc deleted. + ++ For example, \axiom{leftTrim("(abc)", charClass "()")} returns \axiom{"abc)"}. + rightTrim: (%, Character) -> % + ++ rightTrim(s,c) returns s with all trailing occurrences of c deleted. + ++ For example, \axiom{rightTrim(" abc ", char " ")} returns \axiom{" abc"}. + rightTrim: (%, CharacterClass) -> % + ++ rightTrim(s,cc) returns s with all trailing occurences of + ++ characters in cc deleted. + ++ For example, \axiom{rightTrim("(abc)", charClass "()")} returns \axiom{"(abc"}. + elt: (%, %) -> % + ++ elt(s,t) returns the concatenation of s and t. It is provided to + ++ allow juxtaposition of strings to work as concatenation. + ++ For example, \axiom{"smoo" "shed"} returns \axiom{"smooshed"}. + add + trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) + trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc) + + lowerCase s == lowerCase_! copy s + upperCase s == upperCase_! copy s + prefix?(s, t) == substring?(s, t, minIndex t) + coerce(c:Character):% == new(1, c) + elt(s:%, t:%): % == concat(s,t)$% + +@ +<>= +"SRAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"SRAGG" -> "A1AGG" + +@ +<>= +"StringAggregate()" [color=lightblue,href="books/bookvol10.pamphlet"]; +"StringAggregate()" -> "OneDimensionalArrayAggregate(Character)" + +@ +\section{category STAGG StreamAggregate} +<>= +)abbrev category STAGG StreamAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A stream aggregate is a linear aggregate which possibly has an infinite +++ number of elements. A basic domain constructor which builds stream +++ aggregates is \spadtype{Stream}. From streams, a number of infinite +++ structures such power series can be built. A stream aggregate may +++ also be infinite since it may be cyclic. +++ For example, see \spadtype{DecimalExpansion}. +StreamAggregate(S:Type): Category == + Join(UnaryRecursiveAggregate S, LinearAggregate S) with + explicitlyFinite?: % -> Boolean + ++ explicitlyFinite?(s) tests if the stream has a finite + ++ number of elements, and false otherwise. + ++ Note: for many datatypes, \axiom{explicitlyFinite?(s) = not possiblyInfinite?(s)}. + possiblyInfinite?: % -> Boolean + ++ possiblyInfinite?(s) tests if the stream s could possibly + ++ have an infinite number of elements. + ++ Note: for many datatypes, \axiom{possiblyInfinite?(s) = not explictlyFinite?(s)}. + add + c2: (%, %) -> S + + explicitlyFinite? x == not cyclic? x + possiblyInfinite? x == cyclic? x + first(x, n) == construct [c2(x, x := rest x) for i in 1..n] + + c2(x, r) == + empty? x => error "Index out of range" + first x + + elt(x:%, i:Integer) == + i := i - minIndex x + (i < 0) or empty?(x := rest(x, i::NonNegativeInteger)) => error "index out of range" + first x + + elt(x:%, i:UniversalSegment(Integer)) == + l := lo(i) - minIndex x + l < 0 => error "index out of range" + not hasHi i => copy(rest(x, l::NonNegativeInteger)) + (h := hi(i) - minIndex x) < l => empty() + first(rest(x, l::NonNegativeInteger), (h - l + 1)::NonNegativeInteger) + + if % has shallowlyMutable then + concat(x:%, y:%) == concat_!(copy x, y) + + concat l == + empty? l => empty() + concat_!(copy first l, concat rest l) + + map_!(f, l) == + y := l + while not empty? l repeat + setfirst_!(l, f first l) + l := rest l + y + + fill_!(x, s) == + y := x + while not empty? y repeat (setfirst_!(y, s); y := rest y) + x + + setelt(x:%, i:Integer, s:S) == + i := i - minIndex x + (i < 0) or empty?(x := rest(x,i::NonNegativeInteger)) => error "index out of range" + setfirst_!(x, s) + + setelt(x:%, i:UniversalSegment(Integer), s:S) == + (l := lo(i) - minIndex x) < 0 => error "index out of range" + h := if hasHi i then hi(i) - minIndex x else maxIndex x + h < l => s + y := rest(x, l::NonNegativeInteger) + z := rest(y, (h - l + 1)::NonNegativeInteger) + while not eq?(y, z) repeat (setfirst_!(y, s); y := rest y) + s + + concat_!(x:%, y:%) == + empty? x => y + setrest_!(tail x, y) + x + +@ +<>= +"STAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"STAGG" -> "RCAGG" +"STAGG" -> "LNAGG" + +@ +<>= +"StreamAggregate(a:Type)" [color=lightblue,href="books/bookvol10.pamphlet"]; +"StreamAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" +"StreamAggregate(a:Type)" -> "LinearAggregate(a:Type)" + +@ +\section{STAGG.lsp BOOTSTRAP} +{\bf STAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf STAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf STAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |StreamAggregate;CAT| (QUOTE NIL)) + +(SETQ |StreamAggregate;AL| (QUOTE NIL)) + +(DEFUN |StreamAggregate| (#1=#:G87035) (LET (#2=#:G87036) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |StreamAggregate;AL|)) (CDR #2#)) (T (SETQ |StreamAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|StreamAggregate;| #1#))) |StreamAggregate;AL|)) #2#)))) + +(DEFUN |StreamAggregate;| (|t#1|) (PROG (#1=#:G87034) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|StreamAggregate;CAT|) ((QUOTE T) (LETT |StreamAggregate;CAT| (|Join| (|UnaryRecursiveAggregate| (QUOTE |t#1|)) (|LinearAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|explicitlyFinite?| ((|Boolean|) |$|)) T) ((|possiblyInfinite?| ((|Boolean|) |$|)) T))) NIL (QUOTE ((|Boolean|))) NIL)) . #2=(|StreamAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |StreamAggregate|) (|devaluate| |t#1|))))))) +@ +\section{STAGG-.lsp BOOTSTRAP} +{\bf STAGG-} depends on {\bf STAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf STAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf STAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 9)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) + +(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| |$|) (SPADCALL |x| (QREFELT |$| 9))) + +(DEFUN |STAGG-;first;ANniA;3| (|x| |n| |$|) (PROG (#1=#:G87053 |i|) (RETURN (SEQ (SPADCALL (PROGN (LETT #1# NIL |STAGG-;first;ANniA;3|) (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 (COND ((QSGREATERP |i| |n|) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (|STAGG-;c2| |x| (LETT |x| (SPADCALL |x| (QREFELT |$| 12)) |STAGG-;first;ANniA;3|) |$|) #1#) |STAGG-;first;ANniA;3|))) (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) (QREFELT |$| 14)))))) + +(DEFUN |STAGG-;c2| (|x| |r| |$|) (COND ((SPADCALL |x| (QREFELT |$| 17)) (|error| "Index out of range")) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 18))))) + +(DEFUN |STAGG-;elt;AIS;5| (|x| |i| |$|) (PROG (#1=#:G87056) (RETURN (SEQ (LETT |i| (|-| |i| (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;elt;AIS;5|) (COND ((OR (|<| |i| 0) (SPADCALL (LETT |x| (SPADCALL |x| (PROG1 (LETT #1# |i| |STAGG-;elt;AIS;5|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) |STAGG-;elt;AIS;5|) (QREFELT |$| 17))) (EXIT (|error| "index out of range")))) (EXIT (SPADCALL |x| (QREFELT |$| 18))))))) + +(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| |$|) (PROG (|l| #1=#:G87060 |h| #2=#:G87062 #3=#:G87063) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |i| (QREFELT |$| 24)) (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;elt;AUsA;6|) (EXIT (COND ((|<| |l| 0) (|error| "index out of range")) ((NULL (SPADCALL |i| (QREFELT |$| 25))) (SPADCALL (SPADCALL |x| (PROG1 (LETT #1# |l| |STAGG-;elt;AUsA;6|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) (QREFELT |$| 26))) ((QUOTE T) (SEQ (LETT |h| (|-| (SPADCALL |i| (QREFELT |$| 27)) (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;elt;AUsA;6|) (EXIT (COND ((|<| |h| |l|) (SPADCALL (QREFELT |$| 28))) ((QUOTE T) (SPADCALL (SPADCALL |x| (PROG1 (LETT #2# |l| |STAGG-;elt;AUsA;6|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) (QREFELT |$| 21)) (PROG1 (LETT #3# (|+| (|-| |h| |l|) 1) |STAGG-;elt;AUsA;6|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)) (QREFELT |$| 29))))))))))))) + +(DEFUN |STAGG-;concat;3A;7| (|x| |y| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 26)) |y| (QREFELT |$| 31))) + +(DEFUN |STAGG-;concat;LA;8| (|l| |$|) (COND ((NULL |l|) (SPADCALL (QREFELT |$| 28))) ((QUOTE T) (SPADCALL (SPADCALL (|SPADfirst| |l|) (QREFELT |$| 26)) (SPADCALL (CDR |l|) (QREFELT |$| 34)) (QREFELT |$| 31))))) + +(DEFUN |STAGG-;map!;M2A;9| (|f| |l| |$|) (PROG (|y|) (RETURN (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |l| (QREFELT |$| 17)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |l| (SPADCALL (SPADCALL |l| (QREFELT |$| 18)) |f|) (QREFELT |$| 36)) (EXIT (LETT |l| (SPADCALL |l| (QREFELT |$| 12)) |STAGG-;map!;M2A;9|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))))) + +(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| |$|) (PROG (|y|) (RETURN (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 17)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |y| |s| (QREFELT |$| 36)) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 12)) |STAGG-;fill!;ASA;10|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) + +(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| |$|) (PROG (#1=#:G87081) (RETURN (SEQ (LETT |i| (|-| |i| (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;setelt;AI2S;11|) (COND ((OR (|<| |i| 0) (SPADCALL (LETT |x| (SPADCALL |x| (PROG1 (LETT #1# |i| |STAGG-;setelt;AI2S;11|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) |STAGG-;setelt;AI2S;11|) (QREFELT |$| 17))) (EXIT (|error| "index out of range")))) (EXIT (SPADCALL |x| |s| (QREFELT |$| 36))))))) + +(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| |$|) (PROG (|l| |h| #1=#:G87086 #2=#:G87087 |z| |y|) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |i| (QREFELT |$| 24)) (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;setelt;AUs2S;12|) (EXIT (COND ((|<| |l| 0) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |h| (COND ((SPADCALL |i| (QREFELT |$| 25)) (|-| (SPADCALL |i| (QREFELT |$| 27)) (SPADCALL |x| (QREFELT |$| 20)))) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 41)))) |STAGG-;setelt;AUs2S;12|) (EXIT (COND ((|<| |h| |l|) |s|) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# |l| |STAGG-;setelt;AUs2S;12|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) |STAGG-;setelt;AUs2S;12|) (LETT |z| (SPADCALL |y| (PROG1 (LETT #2# (|+| (|-| |h| |l|) 1) |STAGG-;setelt;AUs2S;12|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) (QREFELT |$| 21)) |STAGG-;setelt;AUs2S;12|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| |z| (QREFELT |$| 42)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |y| |s| (QREFELT |$| 36)) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 12)) |STAGG-;setelt;AUs2S;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |s|))))))))))))) + +(DEFUN |STAGG-;concat!;3A;13| (|x| |y| |$|) (SEQ (COND ((SPADCALL |x| (QREFELT |$| 17)) |y|) ((QUOTE T) (SEQ (SPADCALL (SPADCALL |x| (QREFELT |$| 44)) |y| (QREFELT |$| 45)) (EXIT |x|)))))) + +(DEFUN |StreamAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|StreamAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |StreamAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 51) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasAttribute| |#1| (QUOTE |shallowlyMutable|)) (PROGN (QSETREFV |$| 32 (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) |$|)) (QSETREFV |$| 35 (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) |$|)) (QSETREFV |$| 38 (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) |$|)) (QSETREFV |$| 39 (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) |$|)) (QSETREFV |$| 40 (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) |$|)) (QSETREFV |$| 43 (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) |$|)) (QSETREFV |$| 46 (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) |$|))))) |$|)))) + +(MAKEPROP (QUOTE |StreamAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|Boolean|) (0 . |cyclic?|) |STAGG-;explicitlyFinite?;AB;1| |STAGG-;possiblyInfinite?;AB;2| (5 . |rest|) (|List| 7) (10 . |construct|) (|NonNegativeInteger|) |STAGG-;first;ANniA;3| (15 . |empty?|) (20 . |first|) (|Integer|) (25 . |minIndex|) (30 . |rest|) |STAGG-;elt;AIS;5| (|UniversalSegment| 19) (36 . |lo|) (41 . |hasHi|) (46 . |copy|) (51 . |hi|) (56 . |empty|) (60 . |first|) |STAGG-;elt;AUsA;6| (66 . |concat!|) (72 . |concat|) (|List| |$|) (78 . |concat|) (83 . |concat|) (88 . |setfirst!|) (|Mapping| 7 7) (94 . |map!|) (100 . |fill!|) (106 . |setelt|) (113 . |maxIndex|) (118 . |eq?|) (124 . |setelt|) (131 . |tail|) (136 . |setrest!|) (142 . |concat!|) (QUOTE "rest") (QUOTE "last") (QUOTE "first") (QUOTE "value"))) (QUOTE #(|setelt| 148 |possiblyInfinite?| 162 |map!| 167 |first| 173 |fill!| 179 |explicitlyFinite?| 185 |elt| 190 |concat!| 202 |concat| 208)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 46 (QUOTE (1 6 8 0 9 1 6 0 0 12 1 6 0 13 14 1 6 8 0 17 1 6 7 0 18 1 6 19 0 20 2 6 0 0 15 21 1 23 19 0 24 1 23 8 0 25 1 6 0 0 26 1 23 19 0 27 0 6 0 28 2 6 0 0 15 29 2 6 0 0 0 31 2 0 0 0 0 32 1 6 0 33 34 1 0 0 33 35 2 6 7 0 7 36 2 0 0 37 0 38 2 0 0 0 7 39 3 0 7 0 19 7 40 1 6 19 0 41 2 6 8 0 0 42 3 0 7 0 23 7 43 1 6 0 0 44 2 6 0 0 0 45 2 0 0 0 0 46 3 0 7 0 19 7 40 3 0 7 0 23 7 43 1 0 8 0 11 2 0 0 37 0 38 2 0 0 0 15 16 2 0 0 0 7 39 1 0 8 0 10 2 0 7 0 19 22 2 0 0 0 23 30 2 0 0 0 0 46 1 0 0 33 35 2 0 0 0 0 32)))))) (QUOTE |lookupComplete|))) +@ +\section{category TBAGG TableAggregate} +<>= +)abbrev category TBAGG TableAggregate +++ Author: Michael Monagan, Stephen Watt; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A table aggregate is a model of a table, i.e. a discrete many-to-one +++ mapping from keys to entries. +TableAggregate(Key:SetCategory, Entry:SetCategory): Category == + Join(KeyedDictionary(Key,Entry),IndexedAggregate(Key,Entry)) with + setelt: (%,Key,Entry) -> Entry -- setelt_! later + ++ setelt(t,k,e) (also written \axiom{t.k := e}) is equivalent + ++ to \axiom{(insert([k,e],t); e)}. + table: () -> % + ++ table()$T creates an empty table of type T. + ++ + ++E Data:=Record(age:Integer,gender:String) + ++E a1:AssociationList(String,Data):=table() + ++E a1."tim":=[55,"male"]$Data + + table: List Record(key:Key,entry:Entry) -> % + ++ table([x,y,...,z]) creates a table consisting of entries + ++ \axiom{x,y,...,z}. + -- to become table: Record(key:Key,entry:Entry)* -> % + map: ((Entry, Entry) -> Entry, %, %) -> % + ++ map(fn,t1,t2) creates a new table t from given tables t1 and t2 with + ++ elements fn(x,y) where x and y are corresponding elements from t1 + ++ and t2 respectively. + add + table() == empty() + table l == dictionary l +-- empty() == dictionary() + + insert_!(p, t) == (t(p.key) := p.entry; t) + indices t == keys t + + coerce(t:%):OutputForm == + prefix("table"::OutputForm, + [k::OutputForm = (t.k)::OutputForm for k in keys t]) + + elt(t, k) == + (r := search(k, t)) case Entry => r::Entry + error "key not in table" + + elt(t, k, e) == + (r := search(k, t)) case Entry => r::Entry + e + + map_!(f, t) == + for k in keys t repeat t.k := f t.k + t + + map(f:(Entry, Entry) -> Entry, s:%, t:%) == + z := table() + for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k) + z + +-- map(f, s, t, x) == +-- z := table() +-- for k in keys s repeat z.k := f(s.k, t(k, x)) +-- for k in keys t | not key?(k, s) repeat z.k := f(t.k, x) +-- z + + if % has finiteAggregate then + parts(t:%):List Record(key:Key,entry:Entry) == [[k, t.k] for k in keys t] + parts(t:%):List Entry == [t.k for k in keys t] + entries(t:%):List Entry == parts(t) + + s:% = t:% == + eq?(s,t) => true + #s ^= #t => false + for k in keys s repeat + (e := search(k, t)) case "failed" or (e::Entry) ^= s.k => return false + true + + map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry), t: %): % == + z := table() + for k in keys t repeat + ke: Record(key:Key,entry:Entry) := f [k, t.k] + z ke.key := ke.entry + z + map_!(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry), t: %): % == + lke: List Record(key:Key,entry:Entry) := nil() + for k in keys t repeat + lke := cons(f [k, remove_!(k,t)::Entry], lke) + for ke in lke repeat + t ke.key := ke.entry + t + + inspect(t: %): Record(key:Key,entry:Entry) == + ks := keys t + empty? ks => error "Cannot extract from an empty aggregate" + [first ks, t first ks] + + find(f: Record(key:Key,entry:Entry)->Boolean, t:%): Union(Record(key:Key,entry:Entry), "failed") == + for ke in parts(t)@List(Record(key:Key,entry:Entry)) repeat if f ke then return ke + "failed" + + index?(k: Key, t: %): Boolean == + search(k,t) case Entry + + remove_!(x:Record(key:Key,entry:Entry), t:%) == + if member?(x, t) then remove_!(x.key, t) + t + extract_!(t: %): Record(key:Key,entry:Entry) == + k: Record(key:Key,entry:Entry) := inspect t + remove_!(k.key, t) + k + + any?(f: Entry->Boolean, t: %): Boolean == + for k in keys t | f t k repeat return true + false + every?(f: Entry->Boolean, t: %): Boolean == + for k in keys t | not f t k repeat return false + true + count(f: Entry->Boolean, t: %): NonNegativeInteger == + tally: NonNegativeInteger := 0 + for k in keys t | f t k repeat tally := tally + 1 + tally + +@ +<>= +"TBAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"TBAGG" -> "KDAGG" +"TBAGG" -> "IXAGG" + +@ +<>= +"TableAggregate(a:SetCategory,b:SetCategory)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"TableAggregate(a:SetCategory,b:SetCategory)" -> + "KeyedDictionary(a:SetCategory,b:SetCategory)" +"TableAggregate(a:SetCategory,b:SetCategory)" -> + "IndexedAggregate(a:SetCategory,b:SetCategory)" + +@ +\section{category URAGG UnaryRecursiveAggregate} +<>= +)abbrev category URAGG UnaryRecursiveAggregate +++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks +++ Date Created: August 87 through August 88 +++ Date Last Updated: April 1991 +++ Basic Operations: +++ Related Constructors: +++ Also See: +++ AMS Classifications: +++ Keywords: +++ References: +++ Description: +++ A unary-recursive aggregate is a one where nodes may have either +++ 0 or 1 children. +++ This aggregate models, though not precisely, a linked +++ list possibly with a single cycle. +++ A node with one children models a non-empty list, with the +++ \spadfun{value} of the list designating the head, or \spadfun{first}, of the +++ list, and the child designating the tail, or \spadfun{rest}, of the list. +++ A node with no child then designates the empty list. +++ Since these aggregates are recursive aggregates, they may be cyclic. +UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with + concat: (%,%) -> % + ++ concat(u,v) returns an aggregate w consisting of the elements of u + ++ followed by the elements of v. + ++ Note: \axiom{v = rest(w,#a)}. + concat: (S,%) -> % + ++ concat(x,u) returns aggregate consisting of x followed by + ++ the elements of u. + ++ Note: if \axiom{v = concat(x,u)} then \axiom{x = first v} + ++ and \axiom{u = rest v}. + first: % -> S + ++ first(u) returns the first element of u + ++ (equivalently, the value at the current node). + elt: (%,"first") -> S + ++ elt(u,"first") (also written: \axiom{u . first}) is equivalent to first u. + first: (%,NonNegativeInteger) -> % + ++ first(u,n) returns a copy of the first n (\axiom{n >= 0}) elements of u. + rest: % -> % + ++ rest(u) returns an aggregate consisting of all but the first + ++ element of u + ++ (equivalently, the next node of u). + elt: (%,"rest") -> % + ++ elt(%,"rest") (also written: \axiom{u.rest}) is + ++ equivalent to \axiom{rest u}. + rest: (%,NonNegativeInteger) -> % + ++ rest(u,n) returns the \axiom{n}th (n >= 0) node of u. + ++ Note: \axiom{rest(u,0) = u}. + last: % -> S + ++ last(u) resturn the last element of u. + ++ Note: for lists, \axiom{last(u) = u . (maxIndex u) = u . (# u - 1)}. + elt: (%,"last") -> S + ++ elt(u,"last") (also written: \axiom{u . last}) is equivalent to last u. + last: (%,NonNegativeInteger) -> % + ++ last(u,n) returns a copy of the last n (\axiom{n >= 0}) nodes of u. + ++ Note: \axiom{last(u,n)} is a list of n elements. + tail: % -> % + ++ tail(u) returns the last node of u. + ++ Note: if u is \axiom{shallowlyMutable}, + ++ \axiom{setrest(tail(u),v) = concat(u,v)}. + second: % -> S + ++ second(u) returns the second element of u. + ++ Note: \axiom{second(u) = first(rest(u))}. + third: % -> S + ++ third(u) returns the third element of u. + ++ Note: \axiom{third(u) = first(rest(rest(u)))}. + cycleEntry: % -> % + ++ cycleEntry(u) returns the head of a top-level cycle contained in + ++ aggregate u, or \axiom{empty()} if none exists. + cycleLength: % -> NonNegativeInteger + ++ cycleLength(u) returns the length of a top-level cycle + ++ contained in aggregate u, or 0 is u has no such cycle. + cycleTail: % -> % + ++ cycleTail(u) returns the last node in the cycle, or + ++ empty if none exists. + if % has shallowlyMutable then + concat_!: (%,%) -> % + ++ concat!(u,v) destructively concatenates v to the end of u. + ++ Note: \axiom{concat!(u,v) = setlast_!(u,v)}. + concat_!: (%,S) -> % + ++ concat!(u,x) destructively adds element x to the end of u. + ++ Note: \axiom{concat!(a,x) = setlast!(a,[x])}. + cycleSplit_!: % -> % + ++ cycleSplit!(u) splits the aggregate by dropping off the cycle. + ++ The value returned is the cycle entry, or nil if none exists. + ++ For example, if \axiom{w = concat(u,v)} is the cyclic list where v is + ++ the head of the cycle, \axiom{cycleSplit!(w)} will drop v off w thus + ++ destructively changing w to u, and returning v. + setfirst_!: (%,S) -> S + ++ setfirst!(u,x) destructively changes the first element of a to x. + setelt: (%,"first",S) -> S + ++ setelt(u,"first",x) (also written: \axiom{u.first := x}) is + ++ equivalent to \axiom{setfirst!(u,x)}. + setrest_!: (%,%) -> % + ++ setrest!(u,v) destructively changes the rest of u to v. + setelt: (%,"rest",%) -> % + ++ setelt(u,"rest",v) (also written: \axiom{u.rest := v}) is equivalent to + ++ \axiom{setrest!(u,v)}. + setlast_!: (%,S) -> S + ++ setlast!(u,x) destructively changes the last element of u to x. + setelt: (%,"last",S) -> S + ++ setelt(u,"last",x) (also written: \axiom{u.last := b}) + ++ is equivalent to \axiom{setlast!(u,v)}. + split_!: (%,Integer) -> % + ++ split!(u,n) splits u into two aggregates: \axiom{v = rest(u,n)} + ++ and \axiom{w = first(u,n)}, returning \axiom{v}. + ++ Note: afterwards \axiom{rest(u,n)} returns \axiom{empty()}. + add + cycleMax ==> 1000 + + findCycle: % -> % + + elt(x, "first") == first x + elt(x, "last") == last x + elt(x, "rest") == rest x + second x == first rest x + third x == first rest rest x + cyclic? x == not empty? x and not empty? findCycle x + last x == first tail x + + nodes x == + l := empty()$List(%) + while not empty? x repeat + l := concat(x, l) + x := rest x + reverse_! l + + children x == + l := empty()$List(%) + empty? x => l + concat(rest x,l) + + leaf? x == empty? x + + value x == + empty? x => error "value of empty object" + first x + + less?(l, n) == + i := n::Integer + while i > 0 and not empty? l repeat (l := rest l; i := i - 1) + i > 0 + + more?(l, n) == + i := n::Integer + while i > 0 and not empty? l repeat (l := rest l; i := i - 1) + zero?(i) and not empty? l + + size?(l, n) == + i := n::Integer + while not empty? l and i > 0 repeat (l := rest l; i := i - 1) + empty? l and zero? i + + #x == + for k in 0.. while not empty? x repeat + k = cycleMax and cyclic? x => error "cyclic list" + x := rest x + k + + tail x == + empty? x => error "empty list" + y := rest x + for k in 0.. while not empty? y repeat + k = cycleMax and cyclic? x => error "cyclic list" + y := rest(x := y) + x + + findCycle x == + y := rest x + while not empty? y repeat + if eq?(x, y) then return x + x := rest x + y := rest y + if empty? y then return y + if eq?(x, y) then return y + y := rest y + y + + cycleTail x == + empty?(y := x := cycleEntry x) => x + z := rest x + while not eq?(x,z) repeat (y := z; z := rest z) + y + + cycleEntry x == + empty? x => x + empty?(y := findCycle x) => y + z := rest y + for l in 1.. while not eq?(y,z) repeat z := rest z + y := x + for k in 1..l repeat y := rest y + while not eq?(x,y) repeat (x := rest x; y := rest y) + x + + cycleLength x == + empty? x => 0 + empty?(x := findCycle x) => 0 + y := rest x + for k in 1.. while not eq?(x,y) repeat y := rest y + k + + rest(x, n) == + for i in 1..n repeat + empty? x => error "Index out of range" + x := rest x + x + + if % has finiteAggregate then + last(x, n) == + n > (m := #x) => error "index out of range" + copy rest(x, (m - n)::NonNegativeInteger) + + if S has SetCategory then + x = y == + eq?(x, y) => true + for k in 0.. while not empty? x and not empty? y repeat + k = cycleMax and cyclic? x => error "cyclic list" + first x ^= first y => return false + x := rest x + y := rest y + empty? x and empty? y + + node?(u, v) == + for k in 0.. while not empty? v repeat + u = v => return true + k = cycleMax and cyclic? v => error "cyclic list" + v := rest v + u=v + + if % has shallowlyMutable then + setelt(x, "first", a) == setfirst_!(x, a) + setelt(x, "last", a) == setlast_!(x, a) + setelt(x, "rest", a) == setrest_!(x, a) + concat(x:%, y:%) == concat_!(copy x, y) + + setlast_!(x, s) == + empty? x => error "setlast: empty list" + setfirst_!(tail x, s) + s + + setchildren_!(u,lv) == + #lv=1 => setrest_!(u, first lv) + error "wrong number of children specified" + + setvalue_!(u,s) == setfirst_!(u,s) + + split_!(p, n) == + n < 1 => error "index out of range" + p := rest(p, (n - 1)::NonNegativeInteger) + q := rest p + setrest_!(p, empty()) + q + + cycleSplit_! x == + empty?(y := cycleEntry x) or eq?(x, y) => y + z := rest x + while not eq?(z, y) repeat (x := z; z := rest z) + setrest_!(x, empty()) + y + +@ +<>= +"URAGG" [color=lightblue,href="books/bookvol10.pamphlet"]; +"URAGG" -> "RCAGG" + +@ +<>= +"UnaryRecursiveAggregate(a:Type)" + [color=lightblue,href="books/bookvol10.pamphlet"]; +"UnaryRecursiveAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" + +@ +\section{URAGG.lsp BOOTSTRAP} +{\bf URAGG} depends on a chain of files. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf URAGG} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf URAGG.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(SETQ |UnaryRecursiveAggregate;CAT| (QUOTE NIL)) + +(SETQ |UnaryRecursiveAggregate;AL| (QUOTE NIL)) + +(DEFUN |UnaryRecursiveAggregate| (#1=#:G84596) (LET (#2=#:G84597) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |UnaryRecursiveAggregate;AL|)) (CDR #2#)) (T (SETQ |UnaryRecursiveAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|UnaryRecursiveAggregate;| #1#))) |UnaryRecursiveAggregate;AL|)) #2#)))) + +(DEFUN |UnaryRecursiveAggregate;| (|t#1|) (PROG (#1=#:G84595) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|UnaryRecursiveAggregate;CAT|) ((QUOTE T) (LETT |UnaryRecursiveAggregate;CAT| (|Join| (|RecursiveAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|concat| (|$| |$| |$|)) T) ((|concat| (|$| |t#1| |$|)) T) ((|first| (|t#1| |$|)) T) ((|elt| (|t#1| |$| "first")) T) ((|first| (|$| |$| (|NonNegativeInteger|))) T) ((|rest| (|$| |$|)) T) ((|elt| (|$| |$| "rest")) T) ((|rest| (|$| |$| (|NonNegativeInteger|))) T) ((|last| (|t#1| |$|)) T) ((|elt| (|t#1| |$| "last")) T) ((|last| (|$| |$| (|NonNegativeInteger|))) T) ((|tail| (|$| |$|)) T) ((|second| (|t#1| |$|)) T) ((|third| (|t#1| |$|)) T) ((|cycleEntry| (|$| |$|)) T) ((|cycleLength| ((|NonNegativeInteger|) |$|)) T) ((|cycleTail| (|$| |$|)) T) ((|concat!| (|$| |$| |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|concat!| (|$| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|cycleSplit!| (|$| |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setfirst!| (|t#1| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|t#1| |$| "first" |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setrest!| (|$| |$| |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|$| |$| "rest" |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setlast!| (|t#1| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|t#1| |$| "last" |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|split!| (|$| |$| (|Integer|))) (|has| |$| (ATTRIBUTE |shallowlyMutable|))))) NIL (QUOTE ((|Integer|) (|NonNegativeInteger|))) NIL)) . #2=(|UnaryRecursiveAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |UnaryRecursiveAggregate|) (|devaluate| |t#1|))))))) +@ +\section{URAGG-.lsp BOOTSTRAP} +{\bf URAGG-} depends on {\bf URAGG}. We need to break this cycle to build +the algebra. So we keep a cached copy of the translated {\bf URAGG-} +category which we can write into the {\bf MID} directory. We compile +the lisp code and copy the {\bf URAGG-.o} file to the {\bf OUT} directory. +This is eventually forcibly replaced by a recompiled version. + +Note that this code is not included in the generated catdef.spad file. + +<>= + +(|/VERSIONCHECK| 2) + +(DEFUN |URAGG-;elt;AfirstS;1| (|x| G84610 |$|) (SPADCALL |x| (QREFELT |$| 8))) + +(DEFUN |URAGG-;elt;AlastS;2| (|x| G84612 |$|) (SPADCALL |x| (QREFELT |$| 11))) + +(DEFUN |URAGG-;elt;ArestA;3| (|x| G84614 |$|) (SPADCALL |x| (QREFELT |$| 14))) + +(DEFUN |URAGG-;second;AS;4| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 14)) (QREFELT |$| 8))) + +(DEFUN |URAGG-;third;AS;5| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 14)) (QREFELT |$| 14)) (QREFELT |$| 8))) + +(DEFUN |URAGG-;cyclic?;AB;6| (|x| |$|) (COND ((OR (SPADCALL |x| (QREFELT |$| 20)) (SPADCALL (|URAGG-;findCycle| |x| |$|) (QREFELT |$| 20))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) + +(DEFUN |URAGG-;last;AS;7| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 22)) (QREFELT |$| 8))) + +(DEFUN |URAGG-;nodes;AL;8| (|x| |$|) (PROG (|l|) (RETURN (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;nodes;AL;8|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (NREVERSE |l|)))))) + +(DEFUN |URAGG-;children;AL;9| (|x| |$|) (PROG (|l|) (RETURN (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 20)) |l|) ((QUOTE T) (CONS (SPADCALL |x| (QREFELT |$| 14)) |l|)))))))) + +(DEFUN |URAGG-;leaf?;AB;10| (|x| |$|) (SPADCALL |x| (QREFELT |$| 20))) + +(DEFUN |URAGG-;value;AS;11| (|x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "value of empty object")) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 8))))) + +(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| |$|) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) (SEQ G190 (COND ((NULL (COND ((|<| 0 |i|) (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))) (GO G191))) (SEQ (LETT |l| (SPADCALL |l| (QREFELT |$| 14)) |URAGG-;less?;ANniB;12|) (EXIT (LETT |i| (|-| |i| 1) |URAGG-;less?;ANniB;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (|<| 0 |i|)))))) + +(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| |$|) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) (SEQ G190 (COND ((NULL (COND ((|<| 0 |i|) (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))) (GO G191))) (SEQ (LETT |l| (SPADCALL |l| (QREFELT |$| 14)) |URAGG-;more?;ANniB;13|) (EXIT (LETT |i| (|-| |i| 1) |URAGG-;more?;ANniB;13|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((ZEROP |i|) (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))))))) + +(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| |$|) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (|<| 0 |i|)))) (GO G191))) (SEQ (LETT |l| (SPADCALL |l| (QREFELT |$| 14)) |URAGG-;size?;ANniB;14|) (EXIT (LETT |i| (|-| |i| 1) |URAGG-;size?;ANniB;14|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |l| (QREFELT |$| 20)) (ZEROP |i|)) ((QUOTE T) (QUOTE NIL)))))))) + +(DEFUN |URAGG-;#;ANni;15| (|x| |$|) (PROG (|k|) (RETURN (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;#;ANni;15|))) (LETT |k| (QSADD1 |k|) |URAGG-;#;ANni;15|) (GO G190) G191 (EXIT NIL)) (EXIT |k|))))) + +(DEFUN |URAGG-;tail;2A;16| (|x| |$|) (PROG (|k| |y|) (RETURN (SEQ (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "empty list")) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;tail;2A;16|) (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (EXIT (LETT |y| (SPADCALL (LETT |x| |y| |URAGG-;tail;2A;16|) (QREFELT |$| 14)) |URAGG-;tail;2A;16|))) (LETT |k| (QSADD1 |k|) |URAGG-;tail;2A;16|) (GO G190) G191 (EXIT NIL)) (EXIT |x|)))))))) + +(DEFUN |URAGG-;findCycle| (|x| |$|) (PROG (#1=#:G84667 |y|) (RETURN (SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;findCycle|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (PROGN (LETT #1# |x| |URAGG-;findCycle|) (GO #1#)))) (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;findCycle|) (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;findCycle|) (COND ((SPADCALL |y| (QREFELT |$| 20)) (PROGN (LETT #1# |y| |URAGG-;findCycle|) (GO #1#)))) (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (PROGN (LETT #1# |y| |URAGG-;findCycle|) (GO #1#)))) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;findCycle|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))) #1# (EXIT #1#))))) + +(DEFUN |URAGG-;cycleTail;2A;18| (|x| |$|) (PROG (|y| |z|) (RETURN (SEQ (COND ((SPADCALL (LETT |y| (LETT |x| (SPADCALL |x| (QREFELT |$| 37)) |URAGG-;cycleTail;2A;18|) |URAGG-;cycleTail;2A;18|) (QREFELT |$| 20)) |x|) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleTail;2A;18|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| |z| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 14)) |URAGG-;cycleTail;2A;18|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|)))))))) + +(DEFUN |URAGG-;cycleEntry;2A;19| (|x| |$|) (PROG (|l| |z| |k| |y|) (RETURN (SEQ (COND ((SPADCALL |x| (QREFELT |$| 20)) |x|) ((SPADCALL (LETT |y| (|URAGG-;findCycle| |x| |$|) |URAGG-;cycleEntry;2A;19|) (QREFELT |$| 20)) |y|) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|) (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 (COND ((NULL (COND ((SPADCALL |y| |z| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|))) (LETT |l| (QSADD1 |l|) |URAGG-;cycleEntry;2A;19|) (GO G190) G191 (EXIT NIL)) (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 (COND ((QSGREATERP |k| |l|) (GO G191))) (SEQ (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|))) (LETT |k| (QSADD1 |k|) |URAGG-;cycleEntry;2A;19|) (GO G190) G191 (EXIT NIL)) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|)))))))) + +(DEFUN |URAGG-;cycleLength;ANni;20| (|x| |$|) (PROG (|k| |y|) (RETURN (SEQ (COND ((OR (SPADCALL |x| (QREFELT |$| 20)) (SPADCALL (LETT |x| (|URAGG-;findCycle| |x| |$|) |URAGG-;cycleLength;ANni;20|) (QREFELT |$| 20))) 0) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleLength;ANni;20|) (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 (COND ((NULL (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleLength;ANni;20|))) (LETT |k| (QSADD1 |k|) |URAGG-;cycleLength;ANni;20|) (GO G190) G191 (EXIT NIL)) (EXIT |k|)))))))) + +(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| |$|) (PROG (|i|) (RETURN (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 (COND ((QSGREATERP |i| |n|) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "Index out of range")) ((QUOTE T) (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;rest;ANniA;21|))))) (LETT |i| (QSADD1 |i|) |URAGG-;rest;ANniA;21|) (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) + +(DEFUN |URAGG-;last;ANniA;22| (|x| |n| |$|) (PROG (|m| #1=#:G84694) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 42)) |URAGG-;last;ANniA;22|) (EXIT (COND ((|<| |m| |n|) (|error| "index out of range")) ((QUOTE T) (SPADCALL (SPADCALL |x| (PROG1 (LETT #1# (|-| |m| |n|) |URAGG-;last;ANniA;22|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 43)) (QREFELT |$| 44))))))))) + +(DEFUN |URAGG-;=;2AB;23| (|x| |y| |$|) (PROG (|k| #1=#:G84705) (RETURN (SEQ (EXIT (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (QUOTE T)) ((QUOTE T) (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 20)) (SPADCALL |y| (QREFELT |$| 20))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (COND ((NULL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (SPADCALL |y| (QREFELT |$| 8)) (QREFELT |$| 46))) (EXIT (PROGN (LETT #1# (QUOTE NIL) |URAGG-;=;2AB;23|) (GO #1#))))) (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;=;2AB;23|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;=;2AB;23|))) (LETT |k| (QSADD1 |k|) |URAGG-;=;2AB;23|) (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 20)) (SPADCALL |y| (QREFELT |$| 20))) ((QUOTE T) (QUOTE NIL)))))))) #1# (EXIT #1#))))) + +(DEFUN |URAGG-;node?;2AB;24| (|u| |v| |$|) (PROG (|k| #1=#:G84711) (RETURN (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 (COND ((NULL (COND ((SPADCALL |v| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |u| |v| (QREFELT |$| 48)) (PROGN (LETT #1# (QUOTE T) |URAGG-;node?;2AB;24|) (GO #1#))) ((QUOTE T) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |v| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (EXIT (LETT |v| (SPADCALL |v| (QREFELT |$| 14)) |URAGG-;node?;2AB;24|))))))) (LETT |k| (QSADD1 |k|) |URAGG-;node?;2AB;24|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |u| |v| (QREFELT |$| 48))))) #1# (EXIT #1#))))) + +(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| G84713 |a| |$|) (SPADCALL |x| |a| (QREFELT |$| 50))) + +(DEFUN |URAGG-;setelt;Alast2S;26| (|x| G84715 |a| |$|) (SPADCALL |x| |a| (QREFELT |$| 52))) + +(DEFUN |URAGG-;setelt;Arest2A;27| (|x| G84717 |a| |$|) (SPADCALL |x| |a| (QREFELT |$| 54))) + +(DEFUN |URAGG-;concat;3A;28| (|x| |y| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 44)) |y| (QREFELT |$| 56))) + +(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| |$|) (SEQ (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "setlast: empty list")) ((QUOTE T) (SEQ (SPADCALL (SPADCALL |x| (QREFELT |$| 22)) |s| (QREFELT |$| 50)) (EXIT |s|)))))) + +(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| |$|) (COND ((EQL (LENGTH |lv|) 1) (SPADCALL |u| (|SPADfirst| |lv|) (QREFELT |$| 54))) ((QUOTE T) (|error| "wrong number of children specified")))) + +(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| |$|) (SPADCALL |u| |s| (QREFELT |$| 50))) + +(DEFUN |URAGG-;split!;AIA;32| (|p| |n| |$|) (PROG (#1=#:G84725 |q|) (RETURN (SEQ (COND ((|<| |n| 1) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |p| (SPADCALL |p| (PROG1 (LETT #1# (|-| |n| 1) |URAGG-;split!;AIA;32|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 43)) |URAGG-;split!;AIA;32|) (LETT |q| (SPADCALL |p| (QREFELT |$| 14)) |URAGG-;split!;AIA;32|) (SPADCALL |p| (SPADCALL (QREFELT |$| 61)) (QREFELT |$| 54)) (EXIT |q|)))))))) + +(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| |$|) (PROG (|y| |z|) (RETURN (SEQ (COND ((OR (SPADCALL (LETT |y| (SPADCALL |x| (QREFELT |$| 37)) |URAGG-;cycleSplit!;2A;33|) (QREFELT |$| 20)) (SPADCALL |x| |y| (QREFELT |$| 36))) |y|) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleSplit!;2A;33|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |z| |y| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 14)) |URAGG-;cycleSplit!;2A;33|))) NIL (GO G190) G191 (EXIT NIL)) (SPADCALL |x| (SPADCALL (QREFELT |$| 61)) (QREFELT |$| 54)) (EXIT |y|)))))))) + +(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|UnaryRecursiveAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |UnaryRecursiveAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 66) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasAttribute| |#1| (QUOTE |finiteAggregate|)) (QSETREFV |$| 45 (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) |$|)))) (COND ((|HasCategory| |#2| (QUOTE (|SetCategory|))) (PROGN (QSETREFV |$| 47 (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) |$|)) (QSETREFV |$| 49 (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) |$|))))) (COND ((|testBitVector| |pv$| 1) (PROGN (QSETREFV |$| 51 (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) |$|)) (QSETREFV |$| 53 (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) |$|)) (QSETREFV |$| 55 (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) |$|)) (QSETREFV |$| 57 (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) |$|)) (QSETREFV |$| 58 (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) |$|)) (QSETREFV |$| 59 (CONS (|dispatchFunction| |URAGG-;setchildren!;ALA;30|) |$|)) (QSETREFV |$| 60 (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) |$|)) (QSETREFV |$| 63 (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) |$|)) (QSETREFV |$| 64 (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) |$|))))) |$|)))) + +(MAKEPROP (QUOTE |UnaryRecursiveAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |first|) (QUOTE "first") |URAGG-;elt;AfirstS;1| (5 . |last|) (QUOTE "last") |URAGG-;elt;AlastS;2| (10 . |rest|) (QUOTE "rest") |URAGG-;elt;ArestA;3| |URAGG-;second;AS;4| |URAGG-;third;AS;5| (|Boolean|) (15 . |empty?|) |URAGG-;cyclic?;AB;6| (20 . |tail|) |URAGG-;last;AS;7| (|List| |$|) |URAGG-;nodes;AL;8| |URAGG-;children;AL;9| |URAGG-;leaf?;AB;10| |URAGG-;value;AS;11| (|NonNegativeInteger|) |URAGG-;less?;ANniB;12| |URAGG-;more?;ANniB;13| |URAGG-;size?;ANniB;14| (25 . |cyclic?|) |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (30 . |eq?|) (36 . |cycleEntry|) |URAGG-;cycleTail;2A;18| |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| |URAGG-;rest;ANniA;21| (41 . |#|) (46 . |rest|) (52 . |copy|) (57 . |last|) (63 . |=|) (69 . |=|) (75 . |=|) (81 . |node?|) (87 . |setfirst!|) (93 . |setelt|) (100 . |setlast!|) (106 . |setelt|) (113 . |setrest!|) (119 . |setelt|) (126 . |concat!|) (132 . |concat|) (138 . |setlast!|) (144 . |setchildren!|) (150 . |setvalue!|) (156 . |empty|) (|Integer|) (160 . |split!|) (166 . |cycleSplit!|) (QUOTE "value"))) (QUOTE #(|value| 171 |third| 176 |tail| 181 |split!| 186 |size?| 192 |setvalue!| 198 |setlast!| 204 |setelt| 210 |setchildren!| 231 |second| 237 |rest| 242 |nodes| 248 |node?| 253 |more?| 259 |less?| 265 |leaf?| 271 |last| 276 |elt| 287 |cyclic?| 305 |cycleTail| 310 |cycleSplit!| 315 |cycleLength| 320 |cycleEntry| 325 |concat| 330 |children| 336 |=| 341 |#| 347)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 64 (QUOTE (1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 19 0 20 1 6 0 0 22 1 6 19 0 33 2 6 19 0 0 36 1 6 0 0 37 1 6 29 0 42 2 6 0 0 29 43 1 6 0 0 44 2 0 0 0 29 45 2 7 19 0 0 46 2 0 19 0 0 47 2 6 19 0 0 48 2 0 19 0 0 49 2 6 7 0 7 50 3 0 7 0 9 7 51 2 6 7 0 7 52 3 0 7 0 12 7 53 2 6 0 0 0 54 3 0 0 0 15 0 55 2 6 0 0 0 56 2 0 0 0 0 57 2 0 7 0 7 58 2 0 0 0 24 59 2 0 7 0 7 60 0 6 0 61 2 0 0 0 62 63 1 0 0 0 64 1 0 7 0 28 1 0 7 0 18 1 0 0 0 35 2 0 0 0 62 63 2 0 19 0 29 32 2 0 7 0 7 60 2 0 7 0 7 58 3 0 7 0 12 7 53 3 0 0 0 15 0 55 3 0 7 0 9 7 51 2 0 0 0 24 59 1 0 7 0 17 2 0 0 0 29 41 1 0 24 0 25 2 0 19 0 0 49 2 0 19 0 29 31 2 0 19 0 29 30 1 0 19 0 27 2 0 0 0 29 45 1 0 7 0 23 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 10 1 0 19 0 21 1 0 0 0 38 1 0 0 0 64 1 0 29 0 40 1 0 0 0 39 2 0 0 0 0 57 1 0 24 0 26 2 0 19 0 0 47 1 0 29 0 34)))))) (QUOTE |lookupComplete|))) +@ +<>= +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +@ +<>= +digraph dotabb { + ranksep=1.25; + bgcolor="#FFFF66" + node [shape=box, color=white, style=filled]; + +"CATEGORY" [color=lightblue,href="books/bookvol10.pamphlet"]; + +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +} +@ +<>= +digraph dotfull { + ranksep=1.25; + nodesep=1.5; + fontsize=10; + bgcolor="#FFFF66" + node [shape=box, color=white, style=filled]; + +"Category" [color=lightblue,href="books/bookvol10.pamphlet"]; + +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +<> +} +@ \section{Makefile} <<*>>= BOOK=${SPD}/books/bookvol10.pamphlet diff --git a/changelog b/changelog index ec35f67..283d330 100644 --- a/changelog +++ b/changelog @@ -1,3 +1,21 @@ +20080906 tpd src/algebra/aggcat.spad removed, merged into bookvol10 +20080906 tpd src/algebra/Makefile merge aggcat.spad +20080906 tpd src/Makefile merge aggcat.spad +20080906 tpd books/bookvol10 merge aggcat.spad +20080905 tpd src/algebra/cra.spad graphviz dotfile decoration +20080905 tpd src/algebra/coordsys.spad graphviz dotfile decoration +20080905 tpd src/algebra/cont.spad graphviz dotfile decoration +20080905 tpd src/algebra/contfrac.spad graphviz dotfile decoration +20080905 tpd src/algebra/constant.spad graphviz dotfile decoration +20080905 tpd src/algebra/complet.spad graphviz dotfile decoration +20080905 tpd src/algebra/retract.spad graphviz dotfile decoration +20080905 tpd src/algebra/combinat.spad graphviz dotfile decoration +20080905 tpd src/algebra/combfunc.spad graphviz dotfile decoration +20080905 tpd src/algebra/color.spad graphviz dotfile decoration +20080905 tpd src/algebra/cmplxrt.spad graphviz dotfile decoration +20080905 tpd src/algebra/clip.spad graphviz dotfile decoration +20080905 tpd src/algebra/clifford.spad graphviz dotfile decoration +20080905 tpd src/algebra/catdef.spad graphviz dotfile decoration 20080904 tpd src/algebra/retract.spad graphviz dotfile decoration 20080904 tpd src/algebra/equation1.spad graphviz dotfile decoration 20080904 tpd src/algebra/carten.spad graphviz dotfile decoration diff --git a/src/Makefile.pamphlet b/src/Makefile.pamphlet index 3d7a1b2..3e83d9d 100644 --- a/src/Makefile.pamphlet +++ b/src/Makefile.pamphlet @@ -466,6 +466,8 @@ that can be shown from these commands. We need to make the int/input file here because the algebra Makefile will extract input files for regression testing from the algebra pamphlets. +We copy bookvol10 to the src/algebra + \subsection{Volume 10: Axiom Algebra book} <>= algebradir: ${SRC}/algebra/Makefile ${SPD}/books/bookvol10.pamphlet @@ -488,6 +490,7 @@ ${SRC}/algebra/Makefile: ${SRC}/algebra/Makefile.pamphlet ${SRC}/algebra/Makefile.pamphlet @( cd algebra ; ${DOCUMENT} ${NOISE} Makefile ; \ cp Makefile.dvi ${MNT}/${SYS}/doc/src/algebra.Makefile.dvi ; \ + cp ${SPD}/books/bookvol10.pamphlet bookvol10.spad.pamphlet ; \ echo 30a extracting findAlgebraFiles from \ ${SRC}/algebra/Makefile.pamphlet ; \ ${TANGLE} -t8 -RfindAlgebraFiles Makefile.pamphlet \ diff --git a/src/algebra/Makefile.pamphlet b/src/algebra/Makefile.pamphlet index 7ea5dea..7ac4e51 100644 --- a/src/algebra/Makefile.pamphlet +++ b/src/algebra/Makefile.pamphlet @@ -1190,7 +1190,7 @@ We need to figure out which mlift.spad to keep. <>= SPADFILES= \ - ${OUTSRC}/acplot.spad ${OUTSRC}/aggcat2.spad ${OUTSRC}/aggcat.spad \ + ${OUTSRC}/acplot.spad ${OUTSRC}/aggcat2.spad \ ${OUTSRC}/algcat.spad ${OUTSRC}/algext.spad ${OUTSRC}/algfact.spad \ ${OUTSRC}/algfunc.spad ${OUTSRC}/allfact.spad ${OUTSRC}/alql.spad \ ${OUTSRC}/annacat.spad ${OUTSRC}/any.spad ${OUTSRC}/array1.spad \ @@ -1350,7 +1350,7 @@ ALDORFILES= \ <>= DOCFILES= \ - ${DOC}/acplot.spad.dvi ${DOC}/aggcat2.spad.dvi ${DOC}/aggcat.spad.dvi \ + ${DOC}/acplot.spad.dvi ${DOC}/aggcat2.spad.dvi \ ${DOC}/algcat.spad.dvi ${DOC}/algext.spad.dvi ${DOC}/algfact.spad.dvi \ ${DOC}/algfunc.spad.dvi ${DOC}/allfact.spad.dvi ${DOC}/alql.spad.dvi \ ${DOC}/annacat.spad.dvi ${DOC}/any.spad.dvi ${DOC}/array1.spad.dvi \ diff --git a/src/algebra/aggcat.spad.pamphlet b/src/algebra/aggcat.spad.pamphlet deleted file mode 100644 index d137a42..0000000 --- a/src/algebra/aggcat.spad.pamphlet +++ /dev/null @@ -1,3430 +0,0 @@ -\documentclass{article} -\usepackage{axiom} -\begin{document} -\title{\$SPAD/src/algebra aggcat.spad} -\author{Michael Monagan, Manuel Bronstein, Richard Jenks, Stephen Watt} -\maketitle -\begin{abstract} -\end{abstract} -\eject -\tableofcontents -\eject -\section{category AGG Aggregate} -<>= -"AGG" -> "TYPE" -"Aggregate()" -> "Type()" -@ -<>= -)abbrev category AGG Aggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ The notion of aggregate serves to model any data structure aggregate, -++ designating any collection of objects, -++ with heterogenous or homogeneous members, -++ with a finite or infinite number -++ of members, explicitly or implicitly represented. -++ An aggregate can in principle -++ represent everything from a string of characters to abstract sets such -++ as "the set of x satisfying relation {\em r(x)}" -++ An attribute \spadatt{finiteAggregate} is used to assert that a domain -++ has a finite number of elements. -Aggregate: Category == Type with - eq?: (%,%) -> Boolean - ++ eq?(u,v) tests if u and v are same objects. - copy: % -> % - ++ copy(u) returns a top-level (non-recursive) copy of u. - ++ Note: for collections, \axiom{copy(u) == [x for x in u]}. - empty: () -> % - ++ empty()$D creates an aggregate of type D with 0 elements. - ++ Note: The {\em $D} can be dropped if understood by context, - ++ e.g. \axiom{u: D := empty()}. - empty?: % -> Boolean - ++ empty?(u) tests if u has 0 elements. - less?: (%,NonNegativeInteger) -> Boolean - ++ less?(u,n) tests if u has less than n elements. - more?: (%,NonNegativeInteger) -> Boolean - ++ more?(u,n) tests if u has greater than n elements. - size?: (%,NonNegativeInteger) -> Boolean - ++ size?(u,n) tests if u has exactly n elements. - sample: constant -> % ++ sample yields a value of type % - if % has finiteAggregate then - "#": % -> NonNegativeInteger ++ # u returns the number of items in u. - add - eq?(a,b) == EQ(a,b)$Lisp - sample() == empty() - if % has finiteAggregate then - empty? a == #a = 0 - less?(a,n) == #a < n - more?(a,n) == #a > n - size?(a,n) == #a = n - -@ -\section{category HOAGG HomogeneousAggregate} -<>= -"HOAGG" -> "AGG" -"HomogeneousAggregate(a:Type)" -> "Aggregate()" -@ -<>= -)abbrev category HOAGG HomogeneousAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991, May 1995 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A homogeneous aggregate is an aggregate of elements all of the -++ same type. -++ In the current system, all aggregates are homogeneous. -++ Two attributes characterize classes of aggregates. -++ Aggregates from domains with attribute \spadatt{finiteAggregate} -++ have a finite number of members. -++ Those with attribute \spadatt{shallowlyMutable} allow an element -++ to be modified or updated without changing its overall value. -HomogeneousAggregate(S:Type): Category == Aggregate with - if S has SetCategory then SetCategory - if S has SetCategory then - if S has Evalable S then Evalable S - map : (S->S,%) -> % - ++ map(f,u) returns a copy of u with each element x replaced by f(x). - ++ For collections, \axiom{map(f,u) = [f(x) for x in u]}. - if % has shallowlyMutable then - map_!: (S->S,%) -> % - ++ map!(f,u) destructively replaces each element x of u by \axiom{f(x)}. - if % has finiteAggregate then - any?: (S->Boolean,%) -> Boolean - ++ any?(p,u) tests if \axiom{p(x)} is true for any element x of u. - ++ Note: for collections, - ++ \axiom{any?(p,u) = reduce(or,map(f,u),false,true)}. - every?: (S->Boolean,%) -> Boolean - ++ every?(f,u) tests if p(x) is true for all elements x of u. - ++ Note: for collections, - ++ \axiom{every?(p,u) = reduce(and,map(f,u),true,false)}. - count: (S->Boolean,%) -> NonNegativeInteger - ++ count(p,u) returns the number of elements x in u - ++ such that \axiom{p(x)} is true. For collections, - ++ \axiom{count(p,u) = reduce(+,[1 for x in u | p(x)],0)}. - parts: % -> List S - ++ parts(u) returns a list of the consecutive elements of u. - ++ For collections, \axiom{parts([x,y,...,z]) = (x,y,...,z)}. - members: % -> List S - ++ members(u) returns a list of the consecutive elements of u. - ++ For collections, \axiom{parts([x,y,...,z]) = (x,y,...,z)}. - if S has SetCategory then - count: (S,%) -> NonNegativeInteger - ++ count(x,u) returns the number of occurrences of x in u. - ++ For collections, \axiom{count(x,u) = reduce(+,[x=y for y in u],0)}. - member?: (S,%) -> Boolean - ++ member?(x,u) tests if x is a member of u. - ++ For collections, - ++ \axiom{member?(x,u) = reduce(or,[x=y for y in u],false)}. - add - if S has Evalable S then - eval(u:%,l:List Equation S):% == map(eval(#1,l),u) - if % has finiteAggregate then - #c == # parts c - any?(f, c) == _or/[f x for x in parts c] - every?(f, c) == _and/[f x for x in parts c] - count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x] - members x == parts x - if S has SetCategory then - count(s:S, x:%) == count(s = #1, x) - member?(e, c) == any?(e = #1,c) - x = y == - size?(x, #y) and _and/[a = b for a in parts x for b in parts y] - coerce(x:%):OutputForm == - bracket - commaSeparate [a::OutputForm for a in parts x]$List(OutputForm) - -@ -\section{HOAGG.lsp BOOTSTRAP} -{\bf HOAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf HOAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf HOAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |HomogeneousAggregate;CAT| (QUOTE NIL)) - -(SETQ |HomogeneousAggregate;AL| (QUOTE NIL)) - -(DEFUN |HomogeneousAggregate| (#1=#:G82375) - (LET (#2=#:G82376) - (COND - ((SETQ #2# (|assoc| (|devaluate| #1#) |HomogeneousAggregate;AL|)) - (CDR #2#)) - (T - (SETQ |HomogeneousAggregate;AL| - (|cons5| - (CONS (|devaluate| #1#) (SETQ #2# (|HomogeneousAggregate;| #1#))) - |HomogeneousAggregate;AL|)) - #2#)))) - -(DEFUN |HomogeneousAggregate;| (|t#1|) - (PROG (#1=#:G82374) - (RETURN - (PROG1 - (LETT #1# - (|sublisV| - (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) - (COND - (|HomogeneousAggregate;CAT|) - ((QUOTE T) - (LETT |HomogeneousAggregate;CAT| - (|Join| - (|Aggregate|) - (|mkCategory| - (QUOTE |domain|) - (QUOTE ( - ((|map| (|$| (|Mapping| |t#1| |t#1|) |$|)) T) - ((|map!| (|$| (|Mapping| |t#1| |t#1|) |$|)) - (|has| |$| (ATTRIBUTE |shallowlyMutable|))) - ((|any?| - ((|Boolean|) (|Mapping| (|Boolean|) |t#1|) |$|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|))) - ((|every?| - ((|Boolean|) (|Mapping| (|Boolean|) |t#1|) |$|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|))) - ((|count| - ((|NonNegativeInteger|) - (|Mapping| (|Boolean|) |t#1|) |$|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|))) - ((|parts| ((|List| |t#1|) |$|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|))) - ((|members| ((|List| |t#1|) |$|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|))) - ((|count| ((|NonNegativeInteger|) |t#1| |$|)) - (AND - (|has| |t#1| (|SetCategory|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|)))) - ((|member?| ((|Boolean|) |t#1| |$|)) - (AND - (|has| |t#1| (|SetCategory|)) - (|has| |$| (ATTRIBUTE |finiteAggregate|)))))) - (QUOTE ( - ((|SetCategory|) (|has| |t#1| (|SetCategory|))) - ((|Evalable| |t#1|) - (AND - (|has| |t#1| (|Evalable| |t#1|)) - (|has| |t#1| (|SetCategory|)))))) - (QUOTE ( - (|Boolean|) - (|NonNegativeInteger|) - (|List| |t#1|))) - NIL)) - . #2=(|HomogeneousAggregate|))))) . #2#) - (SETELT #1# 0 - (LIST (QUOTE |HomogeneousAggregate|) (|devaluate| |t#1|))))))) - -@ -\section{HOAGG-.lsp BOOTSTRAP} -{\bf HOAGG-} depends on {\bf HOAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf HOAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf HOAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |HOAGG-;eval;ALA;1| (|u| |l| |$|) (SPADCALL (CONS (FUNCTION |HOAGG-;eval;ALA;1!0|) (VECTOR |$| |l|)) |u| (QREFELT |$| 11))) - -(DEFUN |HOAGG-;eval;ALA;1!0| (|#1| |$$|) (SPADCALL |#1| (QREFELT |$$| 1) (QREFELT (QREFELT |$$| 0) 9))) - -(DEFUN |HOAGG-;#;ANni;2| (|c| |$|) (LENGTH (SPADCALL |c| (QREFELT |$| 14)))) - -(DEFUN |HOAGG-;any?;MAB;3| (|f| |c| |$|) (PROG (|x| #1=#:G82396 #2=#:G82393 #3=#:G82391 #4=#:G82392) (RETURN (SEQ (PROGN (LETT #4# NIL |HOAGG-;any?;MAB;3|) (SEQ (LETT |x| NIL |HOAGG-;any?;MAB;3|) (LETT #1# (SPADCALL |c| (QREFELT |$| 14)) |HOAGG-;any?;MAB;3|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |HOAGG-;any?;MAB;3|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |HOAGG-;any?;MAB;3|) (COND (#4# (LETT #3# (COND (#3# (QUOTE T)) ((QUOTE T) #2#)) |HOAGG-;any?;MAB;3|)) ((QUOTE T) (PROGN (LETT #3# #2# |HOAGG-;any?;MAB;3|) (LETT #4# (QUOTE T) |HOAGG-;any?;MAB;3|))))))) (LETT #1# (CDR #1#) |HOAGG-;any?;MAB;3|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE NIL)))))))) - -(DEFUN |HOAGG-;every?;MAB;4| (|f| |c| |$|) (PROG (|x| #1=#:G82401 #2=#:G82399 #3=#:G82397 #4=#:G82398) (RETURN (SEQ (PROGN (LETT #4# NIL |HOAGG-;every?;MAB;4|) (SEQ (LETT |x| NIL |HOAGG-;every?;MAB;4|) (LETT #1# (SPADCALL |c| (QREFELT |$| 14)) |HOAGG-;every?;MAB;4|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |HOAGG-;every?;MAB;4|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |HOAGG-;every?;MAB;4|) (COND (#4# (LETT #3# (COND (#3# #2#) ((QUOTE T) (QUOTE NIL))) |HOAGG-;every?;MAB;4|)) ((QUOTE T) (PROGN (LETT #3# #2# |HOAGG-;every?;MAB;4|) (LETT #4# (QUOTE T) |HOAGG-;every?;MAB;4|))))))) (LETT #1# (CDR #1#) |HOAGG-;every?;MAB;4|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE T)))))))) - -(DEFUN |HOAGG-;count;MANni;5| (|f| |c| |$|) (PROG (|x| #1=#:G82406 #2=#:G82404 #3=#:G82402 #4=#:G82403) (RETURN (SEQ (PROGN (LETT #4# NIL |HOAGG-;count;MANni;5|) (SEQ (LETT |x| NIL |HOAGG-;count;MANni;5|) (LETT #1# (SPADCALL |c| (QREFELT |$| 14)) |HOAGG-;count;MANni;5|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |HOAGG-;count;MANni;5|) NIL)) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |x| |f|) (PROGN (LETT #2# 1 |HOAGG-;count;MANni;5|) (COND (#4# (LETT #3# (|+| #3# #2#) |HOAGG-;count;MANni;5|)) ((QUOTE T) (PROGN (LETT #3# #2# |HOAGG-;count;MANni;5|) (LETT #4# (QUOTE T) |HOAGG-;count;MANni;5|))))))))) (LETT #1# (CDR #1#) |HOAGG-;count;MANni;5|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) 0))))))) - -(DEFUN |HOAGG-;members;AL;6| (|x| |$|) (SPADCALL |x| (QREFELT |$| 14))) - -(DEFUN |HOAGG-;count;SANni;7| (|s| |x| |$|) (SPADCALL (CONS (FUNCTION |HOAGG-;count;SANni;7!0|) (VECTOR |$| |s|)) |x| (QREFELT |$| 24))) - -(DEFUN |HOAGG-;count;SANni;7!0| (|#1| |$$|) (SPADCALL (QREFELT |$$| 1) |#1| (QREFELT (QREFELT |$$| 0) 23))) - -(DEFUN |HOAGG-;member?;SAB;8| (|e| |c| |$|) (SPADCALL (CONS (FUNCTION |HOAGG-;member?;SAB;8!0|) (VECTOR |$| |e|)) |c| (QREFELT |$| 26))) - -(DEFUN |HOAGG-;member?;SAB;8!0| (|#1| |$$|) (SPADCALL (QREFELT |$$| 1) |#1| (QREFELT (QREFELT |$$| 0) 23))) - -(DEFUN |HOAGG-;=;2AB;9| (|x| |y| |$|) (PROG (|b| #1=#:G82416 |a| #2=#:G82415 #3=#:G82412 #4=#:G82410 #5=#:G82411) (RETURN (SEQ (COND ((SPADCALL |x| (SPADCALL |y| (QREFELT |$| 28)) (QREFELT |$| 29)) (PROGN (LETT #5# NIL |HOAGG-;=;2AB;9|) (SEQ (LETT |b| NIL |HOAGG-;=;2AB;9|) (LETT #1# (SPADCALL |y| (QREFELT |$| 14)) |HOAGG-;=;2AB;9|) (LETT |a| NIL |HOAGG-;=;2AB;9|) (LETT #2# (SPADCALL |x| (QREFELT |$| 14)) |HOAGG-;=;2AB;9|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |a| (CAR #2#) |HOAGG-;=;2AB;9|) NIL) (ATOM #1#) (PROGN (LETT |b| (CAR #1#) |HOAGG-;=;2AB;9|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #3# (SPADCALL |a| |b| (QREFELT |$| 23)) |HOAGG-;=;2AB;9|) (COND (#5# (LETT #4# (COND (#4# #3#) ((QUOTE T) (QUOTE NIL))) |HOAGG-;=;2AB;9|)) ((QUOTE T) (PROGN (LETT #4# #3# |HOAGG-;=;2AB;9|) (LETT #5# (QUOTE T) |HOAGG-;=;2AB;9|))))))) (LETT #2# (PROG1 (CDR #2#) (LETT #1# (CDR #1#) |HOAGG-;=;2AB;9|)) |HOAGG-;=;2AB;9|) (GO G190) G191 (EXIT NIL)) (COND (#5# #4#) ((QUOTE T) (QUOTE T))))) ((QUOTE T) (QUOTE NIL))))))) - -(DEFUN |HOAGG-;coerce;AOf;10| (|x| |$|) (PROG (#1=#:G82420 |a| #2=#:G82421) (RETURN (SEQ (SPADCALL (SPADCALL (PROGN (LETT #1# NIL |HOAGG-;coerce;AOf;10|) (SEQ (LETT |a| NIL |HOAGG-;coerce;AOf;10|) (LETT #2# (SPADCALL |x| (QREFELT |$| 14)) |HOAGG-;coerce;AOf;10|) G190 (COND ((OR (ATOM #2#) (PROGN (LETT |a| (CAR #2#) |HOAGG-;coerce;AOf;10|) NIL)) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (SPADCALL |a| (QREFELT |$| 32)) #1#) |HOAGG-;coerce;AOf;10|))) (LETT #2# (CDR #2#) |HOAGG-;coerce;AOf;10|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) (QREFELT |$| 34)) (QREFELT |$| 35)))))) - -(DEFUN |HomogeneousAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|HomogeneousAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |HomogeneousAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 38) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |finiteAggregate|)) (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)) (|HasCategory| |#2| (LIST (QUOTE |Evalable|) (|devaluate| |#2|))) (|HasCategory| |#2| (QUOTE (|SetCategory|))))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 3) (QSETREFV |$| 12 (CONS (|dispatchFunction| |HOAGG-;eval;ALA;1|) |$|)))) (COND ((|testBitVector| |pv$| 1) (PROGN (QSETREFV |$| 16 (CONS (|dispatchFunction| |HOAGG-;#;ANni;2|) |$|)) (QSETREFV |$| 19 (CONS (|dispatchFunction| |HOAGG-;any?;MAB;3|) |$|)) (QSETREFV |$| 20 (CONS (|dispatchFunction| |HOAGG-;every?;MAB;4|) |$|)) (QSETREFV |$| 21 (CONS (|dispatchFunction| |HOAGG-;count;MANni;5|) |$|)) (QSETREFV |$| 22 (CONS (|dispatchFunction| |HOAGG-;members;AL;6|) |$|)) (COND ((|testBitVector| |pv$| 4) (PROGN (QSETREFV |$| 25 (CONS (|dispatchFunction| |HOAGG-;count;SANni;7|) |$|)) (QSETREFV |$| 27 (CONS (|dispatchFunction| |HOAGG-;member?;SAB;8|) |$|)) (QSETREFV |$| 30 (CONS (|dispatchFunction| |HOAGG-;=;2AB;9|) |$|)) (QSETREFV |$| 36 (CONS (|dispatchFunction| |HOAGG-;coerce;AOf;10|) |$|)))))))) |$|)))) - -(MAKEPROP (QUOTE |HomogeneousAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|List| 37) (0 . |eval|) (|Mapping| 7 7) (6 . |map|) (12 . |eval|) (|List| 7) (18 . |parts|) (|NonNegativeInteger|) (23 . |#|) (|Boolean|) (|Mapping| 17 7) (28 . |any?|) (34 . |every?|) (40 . |count|) (46 . |members|) (51 . |=|) (57 . |count|) (63 . |count|) (69 . |any?|) (75 . |member?|) (81 . |#|) (86 . |size?|) (92 . |=|) (|OutputForm|) (98 . |coerce|) (|List| |$|) (103 . |commaSeparate|) (108 . |bracket|) (113 . |coerce|) (|Equation| 7))) (QUOTE #(|members| 118 |member?| 123 |every?| 129 |eval| 135 |count| 141 |coerce| 153 |any?| 158 |=| 164 |#| 170)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 36 (QUOTE (2 7 0 0 8 9 2 6 0 10 0 11 2 0 0 0 8 12 1 6 13 0 14 1 0 15 0 16 2 0 17 18 0 19 2 0 17 18 0 20 2 0 15 18 0 21 1 0 13 0 22 2 7 17 0 0 23 2 6 15 18 0 24 2 0 15 7 0 25 2 6 17 18 0 26 2 0 17 7 0 27 1 6 15 0 28 2 6 17 0 15 29 2 0 17 0 0 30 1 7 31 0 32 1 31 0 33 34 1 31 0 0 35 1 0 31 0 36 1 0 13 0 22 2 0 17 7 0 27 2 0 17 18 0 20 2 0 0 0 8 12 2 0 15 7 0 25 2 0 15 18 0 21 1 0 31 0 36 2 0 17 18 0 19 2 0 17 0 0 30 1 0 15 0 16)))))) (QUOTE |lookupComplete|))) -@ -\section{category CLAGG Collection} -<>= -"CLAGG" -> "HOAGG" -"Collection(a:Type)" -> "HomogeneousAggregate(a:Type)" -"Collection(a:SetCategory)" -> "Collection(a:Type)" -@ -<>= -)abbrev category CLAGG Collection -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A collection is a homogeneous aggregate which can built from -++ list of members. The operation used to build the aggregate is -++ generically named \spadfun{construct}. However, each collection -++ provides its own special function with the same name as the -++ data type, except with an initial lower case letter, e.g. -++ \spadfun{list} for \spadtype{List}, -++ \spadfun{flexibleArray} for \spadtype{FlexibleArray}, and so on. -Collection(S:Type): Category == HomogeneousAggregate(S) with - construct: List S -> % - ++ \axiom{construct(x,y,...,z)} returns the collection of elements \axiom{x,y,...,z} - ++ ordered as given. Equivalently written as \axiom{[x,y,...,z]$D}, where - ++ D is the domain. D may be omitted for those of type List. - find: (S->Boolean, %) -> Union(S, "failed") - ++ find(p,u) returns the first x in u such that \axiom{p(x)} is true, and - ++ "failed" otherwise. - if % has finiteAggregate then - reduce: ((S,S)->S,%) -> S - ++ reduce(f,u) reduces the binary operation f across u. For example, - ++ if u is \axiom{[x,y,...,z]} then \axiom{reduce(f,u)} - ++ returns \axiom{f(..f(f(x,y),...),z)}. - ++ Note: if u has one element x, \axiom{reduce(f,u)} returns x. - ++ Error: if u is empty. - ++ - ++C )clear all - ++X reduce(+,[C[i]*x**i for i in 1..5]) - - reduce: ((S,S)->S,%,S) -> S - ++ reduce(f,u,x) reduces the binary operation f across u, where x is - ++ the identity operation of f. - ++ Same as \axiom{reduce(f,u)} if u has 2 or more elements. - ++ Returns \axiom{f(x,y)} if u has one element y, - ++ x if u is empty. - ++ For example, \axiom{reduce(+,u,0)} returns the - ++ sum of the elements of u. - remove: (S->Boolean,%) -> % - ++ remove(p,u) returns a copy of u removing all elements x such that - ++ \axiom{p(x)} is true. - ++ Note: \axiom{remove(p,u) == [x for x in u | not p(x)]}. - select: (S->Boolean,%) -> % - ++ select(p,u) returns a copy of u containing only those elements such - ++ \axiom{p(x)} is true. - ++ Note: \axiom{select(p,u) == [x for x in u | p(x)]}. - if S has SetCategory then - reduce: ((S,S)->S,%,S,S) -> S - ++ reduce(f,u,x,z) reduces the binary operation f across u, stopping - ++ when an "absorbing element" z is encountered. - ++ As for \axiom{reduce(f,u,x)}, x is the identity operation of f. - ++ Same as \axiom{reduce(f,u,x)} when u contains no element z. - ++ Thus the third argument x is returned when u is empty. - remove: (S,%) -> % - ++ remove(x,u) returns a copy of u with all - ++ elements \axiom{y = x} removed. - ++ Note: \axiom{remove(y,c) == [x for x in c | x ^= y]}. - removeDuplicates: % -> % - ++ removeDuplicates(u) returns a copy of u with all duplicates removed. - if S has ConvertibleTo InputForm then ConvertibleTo InputForm - add - if % has finiteAggregate then - #c == # parts c - count(f:S -> Boolean, c:%) == _+/[1 for x in parts c | f x] - any?(f, c) == _or/[f x for x in parts c] - every?(f, c) == _and/[f x for x in parts c] - find(f:S -> Boolean, c:%) == find(f, parts c) - reduce(f:(S,S)->S, x:%) == reduce(f, parts x) - reduce(f:(S,S)->S, x:%, s:S) == reduce(f, parts x, s) - remove(f:S->Boolean, x:%) == - construct remove(f, parts x) - select(f:S->Boolean, x:%) == - construct select(f, parts x) - - if S has SetCategory then - remove(s:S, x:%) == remove(#1 = s, x) - reduce(f:(S,S)->S, x:%, s1:S, s2:S) == reduce(f, parts x, s1, s2) - removeDuplicates(x) == construct removeDuplicates parts x - -@ -\section{CLAGG.lsp BOOTSTRAP} -{\bf CLAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CLAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CLAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |Collection;CAT| (QUOTE NIL)) - -(SETQ |Collection;AL| (QUOTE NIL)) - -(DEFUN |Collection| (#1=#:G82618) (LET (#2=#:G82619) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |Collection;AL|)) (CDR #2#)) (T (SETQ |Collection;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|Collection;| #1#))) |Collection;AL|)) #2#)))) - -(DEFUN |Collection;| (|t#1|) (PROG (#1=#:G82617) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|Collection;CAT|) ((QUOTE T) (LETT |Collection;CAT| (|Join| (|HomogeneousAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|construct| (|$| (|List| |t#1|))) T) ((|find| ((|Union| |t#1| "failed") (|Mapping| (|Boolean|) |t#1|) |$|)) T) ((|reduce| (|t#1| (|Mapping| |t#1| |t#1| |t#1|) |$|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|reduce| (|t#1| (|Mapping| |t#1| |t#1| |t#1|) |$| |t#1|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|remove| (|$| (|Mapping| (|Boolean|) |t#1|) |$|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|select| (|$| (|Mapping| (|Boolean|) |t#1|) |$|)) (|has| |$| (ATTRIBUTE |finiteAggregate|))) ((|reduce| (|t#1| (|Mapping| |t#1| |t#1| |t#1|) |$| |t#1| |t#1|)) (AND (|has| |t#1| (|SetCategory|)) (|has| |$| (ATTRIBUTE |finiteAggregate|)))) ((|remove| (|$| |t#1| |$|)) (AND (|has| |t#1| (|SetCategory|)) (|has| |$| (ATTRIBUTE |finiteAggregate|)))) ((|removeDuplicates| (|$| |$|)) (AND (|has| |t#1| (|SetCategory|)) (|has| |$| (ATTRIBUTE |finiteAggregate|)))))) (QUOTE (((|ConvertibleTo| (|InputForm|)) (|has| |t#1| (|ConvertibleTo| (|InputForm|)))))) (QUOTE ((|List| |t#1|))) NIL)) . #2=(|Collection|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |Collection|) (|devaluate| |t#1|))))))) -@ -\section{CLAGG-.lsp BOOTSTRAP} -{\bf CLAGG-} depends on {\bf CLAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf CLAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf CLAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |CLAGG-;#;ANni;1| (|c| |$|) (LENGTH (SPADCALL |c| (QREFELT |$| 9)))) - -(DEFUN |CLAGG-;count;MANni;2| (|f| |c| |$|) (PROG (|x| #1=#:G82637 #2=#:G82634 #3=#:G82632 #4=#:G82633) (RETURN (SEQ (PROGN (LETT #4# NIL |CLAGG-;count;MANni;2|) (SEQ (LETT |x| NIL |CLAGG-;count;MANni;2|) (LETT #1# (SPADCALL |c| (QREFELT |$| 9)) |CLAGG-;count;MANni;2|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |CLAGG-;count;MANni;2|) NIL)) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |x| |f|) (PROGN (LETT #2# 1 |CLAGG-;count;MANni;2|) (COND (#4# (LETT #3# (|+| #3# #2#) |CLAGG-;count;MANni;2|)) ((QUOTE T) (PROGN (LETT #3# #2# |CLAGG-;count;MANni;2|) (LETT #4# (QUOTE T) |CLAGG-;count;MANni;2|))))))))) (LETT #1# (CDR #1#) |CLAGG-;count;MANni;2|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) 0))))))) - -(DEFUN |CLAGG-;any?;MAB;3| (|f| |c| |$|) (PROG (|x| #1=#:G82642 #2=#:G82640 #3=#:G82638 #4=#:G82639) (RETURN (SEQ (PROGN (LETT #4# NIL |CLAGG-;any?;MAB;3|) (SEQ (LETT |x| NIL |CLAGG-;any?;MAB;3|) (LETT #1# (SPADCALL |c| (QREFELT |$| 9)) |CLAGG-;any?;MAB;3|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |CLAGG-;any?;MAB;3|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |CLAGG-;any?;MAB;3|) (COND (#4# (LETT #3# (COND (#3# (QUOTE T)) ((QUOTE T) #2#)) |CLAGG-;any?;MAB;3|)) ((QUOTE T) (PROGN (LETT #3# #2# |CLAGG-;any?;MAB;3|) (LETT #4# (QUOTE T) |CLAGG-;any?;MAB;3|))))))) (LETT #1# (CDR #1#) |CLAGG-;any?;MAB;3|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE NIL)))))))) - -(DEFUN |CLAGG-;every?;MAB;4| (|f| |c| |$|) (PROG (|x| #1=#:G82647 #2=#:G82645 #3=#:G82643 #4=#:G82644) (RETURN (SEQ (PROGN (LETT #4# NIL |CLAGG-;every?;MAB;4|) (SEQ (LETT |x| NIL |CLAGG-;every?;MAB;4|) (LETT #1# (SPADCALL |c| (QREFELT |$| 9)) |CLAGG-;every?;MAB;4|) G190 (COND ((OR (ATOM #1#) (PROGN (LETT |x| (CAR #1#) |CLAGG-;every?;MAB;4|) NIL)) (GO G191))) (SEQ (EXIT (PROGN (LETT #2# (SPADCALL |x| |f|) |CLAGG-;every?;MAB;4|) (COND (#4# (LETT #3# (COND (#3# #2#) ((QUOTE T) (QUOTE NIL))) |CLAGG-;every?;MAB;4|)) ((QUOTE T) (PROGN (LETT #3# #2# |CLAGG-;every?;MAB;4|) (LETT #4# (QUOTE T) |CLAGG-;every?;MAB;4|))))))) (LETT #1# (CDR #1#) |CLAGG-;every?;MAB;4|) (GO G190) G191 (EXIT NIL)) (COND (#4# #3#) ((QUOTE T) (QUOTE T)))))))) - -(DEFUN |CLAGG-;find;MAU;5| (|f| |c| |$|) (SPADCALL |f| (SPADCALL |c| (QREFELT |$| 9)) (QREFELT |$| 18))) - -(DEFUN |CLAGG-;reduce;MAS;6| (|f| |x| |$|) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 21))) - -(DEFUN |CLAGG-;reduce;MA2S;7| (|f| |x| |s| |$|) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) |s| (QREFELT |$| 23))) - -(DEFUN |CLAGG-;remove;M2A;8| (|f| |x| |$|) (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 25)) (QREFELT |$| 26))) - -(DEFUN |CLAGG-;select;M2A;9| (|f| |x| |$|) (SPADCALL (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 28)) (QREFELT |$| 26))) - -(DEFUN |CLAGG-;remove;S2A;10| (|s| |x| |$|) (SPADCALL (CONS (FUNCTION |CLAGG-;remove;S2A;10!0|) (VECTOR |$| |s|)) |x| (QREFELT |$| 31))) - -(DEFUN |CLAGG-;remove;S2A;10!0| (|#1| |$$|) (SPADCALL |#1| (QREFELT |$$| 1) (QREFELT (QREFELT |$$| 0) 30))) - -(DEFUN |CLAGG-;reduce;MA3S;11| (|f| |x| |s1| |s2| |$|) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 9)) |s1| |s2| (QREFELT |$| 33))) - -(DEFUN |CLAGG-;removeDuplicates;2A;12| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 9)) (QREFELT |$| 35)) (QREFELT |$| 26))) - -(DEFUN |Collection&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|Collection&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |Collection&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 37) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#2| (QUOTE (|ConvertibleTo| (|InputForm|)))) (|HasCategory| |#2| (QUOTE (|SetCategory|))) (|HasAttribute| |#1| (QUOTE |finiteAggregate|)))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 3) (PROGN (QSETREFV |$| 11 (CONS (|dispatchFunction| |CLAGG-;#;ANni;1|) |$|)) (QSETREFV |$| 13 (CONS (|dispatchFunction| |CLAGG-;count;MANni;2|) |$|)) (QSETREFV |$| 15 (CONS (|dispatchFunction| |CLAGG-;any?;MAB;3|) |$|)) (QSETREFV |$| 16 (CONS (|dispatchFunction| |CLAGG-;every?;MAB;4|) |$|)) (QSETREFV |$| 19 (CONS (|dispatchFunction| |CLAGG-;find;MAU;5|) |$|)) (QSETREFV |$| 22 (CONS (|dispatchFunction| |CLAGG-;reduce;MAS;6|) |$|)) (QSETREFV |$| 24 (CONS (|dispatchFunction| |CLAGG-;reduce;MA2S;7|) |$|)) (QSETREFV |$| 27 (CONS (|dispatchFunction| |CLAGG-;remove;M2A;8|) |$|)) (QSETREFV |$| 29 (CONS (|dispatchFunction| |CLAGG-;select;M2A;9|) |$|)) (COND ((|testBitVector| |pv$| 2) (PROGN (QSETREFV |$| 32 (CONS (|dispatchFunction| |CLAGG-;remove;S2A;10|) |$|)) (QSETREFV |$| 34 (CONS (|dispatchFunction| |CLAGG-;reduce;MA3S;11|) |$|)) (QSETREFV |$| 36 (CONS (|dispatchFunction| |CLAGG-;removeDuplicates;2A;12|) |$|)))))))) |$|)))) - -(MAKEPROP (QUOTE |Collection&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|List| 7) (0 . |parts|) (|NonNegativeInteger|) (5 . |#|) (|Mapping| 14 7) (10 . |count|) (|Boolean|) (16 . |any?|) (22 . |every?|) (|Union| 7 (QUOTE "failed")) (28 . |find|) (34 . |find|) (|Mapping| 7 7 7) (40 . |reduce|) (46 . |reduce|) (52 . |reduce|) (59 . |reduce|) (66 . |remove|) (72 . |construct|) (77 . |remove|) (83 . |select|) (89 . |select|) (95 . |=|) (101 . |remove|) (107 . |remove|) (113 . |reduce|) (121 . |reduce|) (129 . |removeDuplicates|) (134 . |removeDuplicates|))) (QUOTE #(|select| 139 |removeDuplicates| 145 |remove| 150 |reduce| 162 |find| 183 |every?| 189 |count| 195 |any?| 201 |#| 207)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 36 (QUOTE (1 6 8 0 9 1 0 10 0 11 2 0 10 12 0 13 2 0 14 12 0 15 2 0 14 12 0 16 2 8 17 12 0 18 2 0 17 12 0 19 2 8 7 20 0 21 2 0 7 20 0 22 3 8 7 20 0 7 23 3 0 7 20 0 7 24 2 8 0 12 0 25 1 6 0 8 26 2 0 0 12 0 27 2 8 0 12 0 28 2 0 0 12 0 29 2 7 14 0 0 30 2 6 0 12 0 31 2 0 0 7 0 32 4 8 7 20 0 7 7 33 4 0 7 20 0 7 7 34 1 8 0 0 35 1 0 0 0 36 2 0 0 12 0 29 1 0 0 0 36 2 0 0 7 0 32 2 0 0 12 0 27 4 0 7 20 0 7 7 34 3 0 7 20 0 7 24 2 0 7 20 0 22 2 0 17 12 0 19 2 0 14 12 0 16 2 0 10 12 0 13 2 0 14 12 0 15 1 0 10 0 11)))))) (QUOTE |lookupComplete|))) -@ -\section{category BGAGG BagAggregate} -<>= -"BGAGG" -> "HOAGG" -"BagAggregate(a:Type)" -> "HomogeneousAggregate(a:Type)" -"BagAggregate(a:SetCategory)" -> "BagAggregate(a:Type)" -@ -<>= -)abbrev category BGAGG BagAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A bag aggregate is an aggregate for which one can insert and extract objects, -++ and where the order in which objects are inserted determines the order -++ of extraction. -++ Examples of bags are stacks, queues, and dequeues. -BagAggregate(S:Type): Category == HomogeneousAggregate S with - shallowlyMutable - ++ shallowlyMutable means that elements of bags may be destructively changed. - bag: List S -> % - ++ bag([x,y,...,z]) creates a bag with elements x,y,...,z. - extract_!: % -> S - ++ extract!(u) destructively removes a (random) item from bag u. - insert_!: (S,%) -> % - ++ insert!(x,u) inserts item x into bag u. - inspect: % -> S - ++ inspect(u) returns an (random) element from a bag. - add - bag(l) == - x:=empty() - for s in l repeat x:=insert_!(s,x) - x - -@ -\section{category SKAGG StackAggregate} -<>= -"SKAGG" -> "BGAGG" -"StackAggregate(a:Type)" -> "BagAggregate(a:Type)" -"StackAggregate(a:SetCategory)" -> "StackAggregate(a:Type)" -@ -<>= -)abbrev category SKAGG StackAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A stack is a bag where the last item inserted is the first item extracted. -StackAggregate(S:Type): Category == BagAggregate S with - finiteAggregate - push_!: (S,%) -> S - ++ push!(x,s) pushes x onto stack s, i.e. destructively changing s - ++ so as to have a new first (top) element x. - ++ Afterwards, pop!(s) produces x and pop!(s) produces the original s. - pop_!: % -> S - ++ pop!(s) returns the top element x, destructively removing x from s. - ++ Note: Use \axiom{top(s)} to obtain x without removing it from s. - ++ Error: if s is empty. - top: % -> S - ++ top(s) returns the top element x from s; s remains unchanged. - ++ Note: Use \axiom{pop!(s)} to obtain x and remove it from s. - depth: % -> NonNegativeInteger - ++ depth(s) returns the number of elements of stack s. - ++ Note: \axiom{depth(s) = #s}. - - -@ -\section{category QUAGG QueueAggregate} -<>= -"QUAGG" -> "BGAGG" -"QueueAggregate(a:Type)" -> "BagAggregate(a:Type)" -"QueueAggregate(a:SetCategory)" -> "QueueAggregate(a:Type)" -@ -<>= -)abbrev category QUAGG QueueAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A queue is a bag where the first item inserted is the first item extracted. -QueueAggregate(S:Type): Category == BagAggregate S with - finiteAggregate - enqueue_!: (S, %) -> S - ++ enqueue!(x,q) inserts x into the queue q at the back end. - dequeue_!: % -> S - ++ dequeue! s destructively extracts the first (top) element from queue q. - ++ The element previously second in the queue becomes the first element. - ++ Error: if q is empty. - rotate_!: % -> % - ++ rotate! q rotates queue q so that the element at the front of - ++ the queue goes to the back of the queue. - ++ Note: rotate! q is equivalent to enqueue!(dequeue!(q)). - length: % -> NonNegativeInteger - ++ length(q) returns the number of elements in the queue. - ++ Note: \axiom{length(q) = #q}. - front: % -> S - ++ front(q) returns the element at the front of the queue. - ++ The queue q is unchanged by this operation. - ++ Error: if q is empty. - back: % -> S - ++ back(q) returns the element at the back of the queue. - ++ The queue q is unchanged by this operation. - ++ Error: if q is empty. - -@ -\section{category DQAGG DequeueAggregate} -<>= -"DQAGG" -> "SKAGG" -"DequeueAggregate(a:Type)" -> "StackAggregate(a:Type)" -"DQAGG" -> "QUAGG" -"DequeueAggregate(a:Type)" -> "QueueAggregate(a:Type)" -"DequeueAggregate(a:SetCategory)" -> "DequeueAggregate(a:Type)" -@ -<>= -)abbrev category DQAGG DequeueAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A dequeue is a doubly ended stack, that is, a bag where first items -++ inserted are the first items extracted, at either the front or the back end -++ of the data structure. -DequeueAggregate(S:Type): - Category == Join(StackAggregate S,QueueAggregate S) with - dequeue: () -> % - ++ dequeue()$D creates an empty dequeue of type D. - dequeue: List S -> % - ++ dequeue([x,y,...,z]) creates a dequeue with first (top or front) - ++ element x, second element y,...,and last (bottom or back) element z. - height: % -> NonNegativeInteger - ++ height(d) returns the number of elements in dequeue d. - ++ Note: \axiom{height(d) = # d}. - top_!: % -> S - ++ top!(d) returns the element at the top (front) of the dequeue. - bottom_!: % -> S - ++ bottom!(d) returns the element at the bottom (back) of the dequeue. - insertTop_!: (S,%) -> S - ++ insertTop!(x,d) destructively inserts x into the dequeue d, that is, - ++ at the top (front) of the dequeue. - ++ The element previously at the top of the dequeue becomes the - ++ second in the dequeue, and so on. - insertBottom_!: (S,%) -> S - ++ insertBottom!(x,d) destructively inserts x into the dequeue d - ++ at the bottom (back) of the dequeue. - extractTop_!: % -> S - ++ extractTop!(d) destructively extracts the top (front) element - ++ from the dequeue d. - ++ Error: if d is empty. - extractBottom_!: % -> S - ++ extractBottom!(d) destructively extracts the bottom (back) element - ++ from the dequeue d. - ++ Error: if d is empty. - reverse_!: % -> % - ++ reverse!(d) destructively replaces d by its reverse dequeue, i.e. - ++ the top (front) element is now the bottom (back) element, and so on. - -@ -\section{category PRQAGG PriorityQueueAggregate} -<>= -"PRQAGG" -> "BGAGG" -"PriorityQueueAggregate(a:Type)" -> "BagAggregate(a:Type)" -"PriorityQueueAggregate(a:SetCategory)" -> "PriorityQueueAggregate(a:Type)" -"PriorityQueueAggregate(a:OrderedSet)" -> - "PriorityQueueAggregate(a:SetCategory)" -@ -<>= -)abbrev category PRQAGG PriorityQueueAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A priority queue is a bag of items from an ordered set where the item -++ extracted is always the maximum element. -PriorityQueueAggregate(S:OrderedSet): Category == BagAggregate S with - finiteAggregate - max: % -> S - ++ max(q) returns the maximum element of priority queue q. - merge: (%,%) -> % - ++ merge(q1,q2) returns combines priority queues q1 and q2 to return - ++ a single priority queue q. - merge_!: (%,%) -> % - ++ merge!(q,q1) destructively changes priority queue q to include the - ++ values from priority queue q1. - -@ -\section{category DIOPS DictionaryOperations} -<>= -"DIOPS" -> "BGAGG" -"DictionaryOperations(a:SetCategory)" -> "BagAggregate(a:SetCategory)" -"DIOPS" -> "CLAGG" -"DictionaryOperations(a:SetCategory)" -> "Collection(a:SetCategory)" -@ -<>= -)abbrev category DIOPS DictionaryOperations -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ This category is a collection of operations common to both -++ categories \spadtype{Dictionary} and \spadtype{MultiDictionary} -DictionaryOperations(S:SetCategory): Category == - Join(BagAggregate S, Collection(S)) with - dictionary: () -> % - ++ dictionary()$D creates an empty dictionary of type D. - dictionary: List S -> % - ++ dictionary([x,y,...,z]) creates a dictionary consisting of - ++ entries \axiom{x,y,...,z}. --- insert: (S,%) -> S ++ insert an entry --- member?: (S,%) -> Boolean ++ search for an entry --- remove_!: (S,%,NonNegativeInteger) -> % --- ++ remove!(x,d,n) destructively changes dictionary d by removing --- ++ up to n entries y such that \axiom{y = x}. --- remove_!: (S->Boolean,%,NonNegativeInteger) -> % --- ++ remove!(p,d,n) destructively changes dictionary d by removing --- ++ up to n entries x such that \axiom{p(x)} is true. - if % has finiteAggregate then - remove_!: (S,%) -> % - ++ remove!(x,d) destructively changes dictionary d by removing - ++ all entries y such that \axiom{y = x}. - remove_!: (S->Boolean,%) -> % - ++ remove!(p,d) destructively changes dictionary d by removeing - ++ all entries x such that \axiom{p(x)} is true. - select_!: (S->Boolean,%) -> % - ++ select!(p,d) destructively changes dictionary d by removing - ++ all entries x such that \axiom{p(x)} is not true. - add - construct l == dictionary l - dictionary() == empty() - if % has finiteAggregate then - copy d == dictionary parts d - coerce(s:%):OutputForm == - prefix("dictionary"@String :: OutputForm, - [x::OutputForm for x in parts s]) - -@ -\section{category DIAGG Dictionary} -<>= -"DIAGG" -> "DIOPS" -"Dictionary(a:SetCategory)" -> "DictionaryOperations(a:SetCategory)" -"Dictionary(Record(a:SetCategory,b:SetCategory)" -> - "Dictionary(a:SetCategory)" -@ -<>= -)abbrev category DIAGG Dictionary -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A dictionary is an aggregate in which entries can be inserted, -++ searched for and removed. Duplicates are thrown away on insertion. -++ This category models the usual notion of dictionary which involves -++ large amounts of data where copying is impractical. -++ Principal operations are thus destructive (non-copying) ones. -Dictionary(S:SetCategory): Category == - DictionaryOperations S add - dictionary l == - d := dictionary() - for x in l repeat insert_!(x, d) - d - - if % has finiteAggregate then - -- remove(f:S->Boolean,t:%) == remove_!(f, copy t) - -- select(f, t) == select_!(f, copy t) - select_!(f, t) == remove_!(not f #1, t) - - --extract_! d == - -- empty? d => error "empty dictionary" - -- remove_!(x := first parts d, d, 1) - -- x - - s = t == - eq?(s,t) => true - #s ^= #t => false - _and/[member?(x, t) for x in parts s] - - remove_!(f:S->Boolean, t:%) == - for m in parts t repeat if f m then remove_!(m, t) - t - -@ -\section{category MDAGG MultiDictionary} -<>= -"MDAGG" -> "DIOPS" -"MultiDictionary(a:SetCategory)" -> "DictionaryOperations(a:SetCategory)" -@ -<>= -)abbrev category MDAGG MultiDictionary -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A multi-dictionary is a dictionary which may contain duplicates. -++ As for any dictionary, its size is assumed large so that -++ copying (non-destructive) operations are generally to be avoided. -MultiDictionary(S:SetCategory): Category == DictionaryOperations S with --- count: (S,%) -> NonNegativeInteger ++ multiplicity count - insert_!: (S,%,NonNegativeInteger) -> % - ++ insert!(x,d,n) destructively inserts n copies of x into dictionary d. --- remove_!: (S,%,NonNegativeInteger) -> % --- ++ remove!(x,d,n) destructively removes (up to) n copies of x from --- ++ dictionary d. - removeDuplicates_!: % -> % - ++ removeDuplicates!(d) destructively removes any duplicate values - ++ in dictionary d. - duplicates: % -> List Record(entry:S,count:NonNegativeInteger) - ++ duplicates(d) returns a list of values which have duplicates in d --- ++ duplicates(d) returns a list of ++ duplicates iterator --- to become duplicates: % -> Iterator(D,D) - -@ -\section{category SETAGG SetAggregate} -<>= -"SETAGG" -> "SETCAT" -"SetAggregate(a:SetCategory)" -> "SetCategory()" -"SETAGG" -> "CLAGG" -"SetAggregate(a:SetCategory)" -> "Collection(a:SetCategory)" -@ -<>= -)abbrev category SETAGG SetAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: 14 Oct, 1993 by RSS -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A set category lists a collection of set-theoretic operations -++ useful for both finite sets and multisets. -++ Note however that finite sets are distinct from multisets. -++ Although the operations defined for set categories are -++ common to both, the relationship between the two cannot -++ be described by inclusion or inheritance. -SetAggregate(S:SetCategory): - Category == Join(SetCategory, Collection(S)) with - partiallyOrderedSet - "<" : (%, %) -> Boolean - ++ s < t returns true if all elements of set aggregate s are also - ++ elements of set aggregate t. - brace : () -> % - ++ brace()$D (otherwise written {}$D) - ++ creates an empty set aggregate of type D. - ++ This form is considered obsolete. Use \axiomFun{set} instead. - brace : List S -> % - ++ brace([x,y,...,z]) - ++ creates a set aggregate containing items x,y,...,z. - ++ This form is considered obsolete. Use \axiomFun{set} instead. - set : () -> % - ++ set()$D creates an empty set aggregate of type D. - set : List S -> % - ++ set([x,y,...,z]) creates a set aggregate containing items x,y,...,z. - intersect: (%, %) -> % - ++ intersect(u,v) returns the set aggregate w consisting of - ++ elements common to both set aggregates u and v. - ++ Note: equivalent to the notation (not currently supported) - ++ {x for x in u | member?(x,v)}. - difference : (%, %) -> % - ++ difference(u,v) returns the set aggregate w consisting of - ++ elements in set aggregate u but not in set aggregate v. - ++ If u and v have no elements in common, \axiom{difference(u,v)} - ++ returns a copy of u. - ++ Note: equivalent to the notation (not currently supported) - ++ \axiom{{x for x in u | not member?(x,v)}}. - difference : (%, S) -> % - ++ difference(u,x) returns the set aggregate u with element x removed. - ++ If u does not contain x, a copy of u is returned. - ++ Note: \axiom{difference(s, x) = difference(s, {x})}. - symmetricDifference : (%, %) -> % - ++ symmetricDifference(u,v) returns the set aggregate of elements x which - ++ are members of set aggregate u or set aggregate v but not both. - ++ If u and v have no elements in common, \axiom{symmetricDifference(u,v)} - ++ returns a copy of u. - ++ Note: \axiom{symmetricDifference(u,v) = union(difference(u,v),difference(v,u))} - subset? : (%, %) -> Boolean - ++ subset?(u,v) tests if u is a subset of v. - ++ Note: equivalent to - ++ \axiom{reduce(and,{member?(x,v) for x in u},true,false)}. - union : (%, %) -> % - ++ union(u,v) returns the set aggregate of elements which are members - ++ of either set aggregate u or v. - union : (%, S) -> % - ++ union(u,x) returns the set aggregate u with the element x added. - ++ If u already contains x, \axiom{union(u,x)} returns a copy of u. - union : (S, %) -> % - ++ union(x,u) returns the set aggregate u with the element x added. - ++ If u already contains x, \axiom{union(x,u)} returns a copy of u. - add - symmetricDifference(x, y) == union(difference(x, y), difference(y, x)) - union(s:%, x:S) == union(s, {x}) - union(x:S, s:%) == union(s, {x}) - difference(s:%, x:S) == difference(s, {x}) - -@ -\section{SETAGG.lsp BOOTSTRAP} -{\bf SETAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |SetAggregate;CAT| (QUOTE NIL)) - -(SETQ |SetAggregate;AL| (QUOTE NIL)) - -(DEFUN |SetAggregate| (#1=#:G83200) (LET (#2=#:G83201) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |SetAggregate;AL|)) (CDR #2#)) (T (SETQ |SetAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|SetAggregate;| #1#))) |SetAggregate;AL|)) #2#)))) - -(DEFUN |SetAggregate;| (|t#1|) (PROG (#1=#:G83199) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|SetAggregate;CAT|) ((QUOTE T) (LETT |SetAggregate;CAT| (|Join| (|SetCategory|) (|Collection| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|<| ((|Boolean|) |$| |$|)) T) ((|brace| (|$|)) T) ((|brace| (|$| (|List| |t#1|))) T) ((|set| (|$|)) T) ((|set| (|$| (|List| |t#1|))) T) ((|intersect| (|$| |$| |$|)) T) ((|difference| (|$| |$| |$|)) T) ((|difference| (|$| |$| |t#1|)) T) ((|symmetricDifference| (|$| |$| |$|)) T) ((|subset?| ((|Boolean|) |$| |$|)) T) ((|union| (|$| |$| |$|)) T) ((|union| (|$| |$| |t#1|)) T) ((|union| (|$| |t#1| |$|)) T))) (QUOTE ((|partiallyOrderedSet| T))) (QUOTE ((|Boolean|) (|List| |t#1|))) NIL)) . #2=(|SetAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |SetAggregate|) (|devaluate| |t#1|))))))) -@ -\section{SETAGG-.lsp BOOTSTRAP} -{\bf SETAGG-} depends on {\bf SETAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf SETAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf SETAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |SETAGG-;symmetricDifference;3A;1| (|x| |y| |$|) (SPADCALL (SPADCALL |x| |y| (QREFELT |$| 8)) (SPADCALL |y| |x| (QREFELT |$| 8)) (QREFELT |$| 9))) - -(DEFUN |SETAGG-;union;ASA;2| (|s| |x| |$|) (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT |$| 12)) (QREFELT |$| 9))) - -(DEFUN |SETAGG-;union;S2A;3| (|x| |s| |$|) (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT |$| 12)) (QREFELT |$| 9))) - -(DEFUN |SETAGG-;difference;ASA;4| (|s| |x| |$|) (SPADCALL |s| (SPADCALL (LIST |x|) (QREFELT |$| 12)) (QREFELT |$| 8))) - -(DEFUN |SetAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|SetAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |SetAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 16) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) |$|)))) - -(MAKEPROP (QUOTE |SetAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |difference|) (6 . |union|) |SETAGG-;symmetricDifference;3A;1| (|List| 7) (12 . |brace|) |SETAGG-;union;ASA;2| |SETAGG-;union;S2A;3| |SETAGG-;difference;ASA;4|)) (QUOTE #(|union| 17 |symmetricDifference| 29 |difference| 35)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 15 (QUOTE (2 6 0 0 0 8 2 6 0 0 0 9 1 6 0 11 12 2 0 0 7 0 14 2 0 0 0 7 13 2 0 0 0 0 10 2 0 0 0 7 15)))))) (QUOTE |lookupComplete|))) -@ -\section{category FSAGG FiniteSetAggregate} -<>= -"FSAGG" -> "DIAGG" -"FiniteSetAggregate(a:SetCategory)" -> "Dictionary(a:SetCategory)" -"FSAGG" -> "SETAGG" -"FiniteSetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)" -@ -<>= -)abbrev category FSAGG FiniteSetAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: 14 Oct, 1993 by RSS -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A finite-set aggregate models the notion of a finite set, that is, -++ a collection of elements characterized by membership, but not -++ by order or multiplicity. -++ See \spadtype{Set} for an example. -FiniteSetAggregate(S:SetCategory): Category == - Join(Dictionary S, SetAggregate S) with - finiteAggregate - cardinality: % -> NonNegativeInteger - ++ cardinality(u) returns the number of elements of u. - ++ Note: \axiom{cardinality(u) = #u}. - if S has Finite then - Finite - complement: % -> % - ++ complement(u) returns the complement of the set u, - ++ i.e. the set of all values not in u. - universe: () -> % - ++ universe()$D returns the universal set for finite set aggregate D. - if S has OrderedSet then - max: % -> S - ++ max(u) returns the largest element of aggregate u. - min: % -> S - ++ min(u) returns the smallest element of aggregate u. - - add - s < t == #s < #t and s = intersect(s,t) - s = t == #s = #t and empty? difference(s,t) - brace l == construct l - set l == construct l - cardinality s == #s - construct l == (s := set(); for x in l repeat insert_!(x,s); s) - count(x:S, s:%) == (member?(x, s) => 1; 0) - subset?(s, t) == #s < #t and _and/[member?(x, t) for x in parts s] - - coerce(s:%):OutputForm == - brace [x::OutputForm for x in parts s]$List(OutputForm) - - intersect(s, t) == - i := {} - for x in parts s | member?(x, t) repeat insert_!(x, i) - i - - difference(s:%, t:%) == - m := copy s - for x in parts t repeat remove_!(x, m) - m - - symmetricDifference(s, t) == - d := copy s - for x in parts t repeat - if member?(x, s) then remove_!(x, d) else insert_!(x, d) - d - - union(s:%, t:%) == - u := copy s - for x in parts t repeat insert_!(x, u) - u - - if S has Finite then - universe() == {index(i::PositiveInteger) for i in 1..size()$S} - complement s == difference(universe(), s ) - size() == 2 ** size()$S - index i == {index(j::PositiveInteger)$S for j in 1..size()$S | bit?(i-1,j-1)} - random() == index((random()$Integer rem (size()$% + 1))::PositiveInteger) - - lookup s == - n:PositiveInteger := 1 - for x in parts s repeat n := n + 2 ** ((lookup(x) - 1)::NonNegativeInteger) - n - - if S has OrderedSet then - max s == - empty?(l := parts s) => error "Empty set" - reduce("max", l) - - min s == - empty?(l := parts s) => error "Empty set" - reduce("min", l) - -@ -\section{category MSETAGG MultisetAggregate} -<>= -"MSETAGG" -> "MDAGG" -"MultisetAggregate(a:SetCategory)" -> "MultiDictionary(a:SetCategory)" -"MSETAGG" -> "SETAGG" -"MultisetAggregate(a:SetCategory)" -> "SetAggregate(a:SetCategory)" -@ -<>= -)abbrev category MSETAGG MultisetAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A multi-set aggregate is a set which keeps track of the multiplicity -++ of its elements. -MultisetAggregate(S:SetCategory): - Category == Join(MultiDictionary S, SetAggregate S) - -@ -\section{category OMSAGG OrderedMultisetAggregate} -<>= -"OMSAGG" -> "MSETAGG" -"OrderedMultisetAggregate(a:SetCategory)" -> - "MultisetAggregate(a:SetCategory)" -"OMSAGG" -> "PRQAGG" -"OrderedMultisetAggregate(a:SetCategory)" -> - "PriorityQueueAggregate(a:SetCategory)" -@ -<>= -)abbrev category OMSAGG OrderedMultisetAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ An ordered-multiset aggregate is a multiset built over an ordered set S -++ so that the relative sizes of its entries can be assessed. -++ These aggregates serve as models for priority queues. -OrderedMultisetAggregate(S:OrderedSet): Category == - Join(MultisetAggregate S,PriorityQueueAggregate S) with - -- max: % -> S ++ smallest entry in the set - -- duplicates: % -> List Record(entry:S,count:NonNegativeInteger) - ++ to become an in order iterator - -- parts: % -> List S ++ in order iterator - min: % -> S - ++ min(u) returns the smallest entry in the multiset aggregate u. - -@ -\section{category KDAGG KeyedDictionary} -<>= -"KDAGG" -> "DIAGG" -"KeyedDictionary(a:SetCategory,b:SetCategory)" -> - "Dictionary(Record(a:SetCategory,b:SetCategory)" -@ -<>= -)abbrev category KDAGG KeyedDictionary -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A keyed dictionary is a dictionary of key-entry pairs for which there is -++ a unique entry for each key. -KeyedDictionary(Key:SetCategory, Entry:SetCategory): Category == - Dictionary Record(key:Key,entry:Entry) with - key?: (Key, %) -> Boolean - ++ key?(k,t) tests if k is a key in table t. - keys: % -> List Key - ++ keys(t) returns the list the keys in table t. - -- to become keys: % -> Key* and keys: % -> Iterator(Entry,Entry) - remove_!: (Key, %) -> Union(Entry,"failed") - ++ remove!(k,t) searches the table t for the key k removing - ++ (and return) the entry if there. - ++ If t has no such key, \axiom{remove!(k,t)} returns "failed". - search: (Key, %) -> Union(Entry,"failed") - ++ search(k,t) searches the table t for the key k, - ++ returning the entry stored in t for key k. - ++ If t has no such key, \axiom{search(k,t)} returns "failed". - add - key?(k, t) == search(k, t) case Entry - - member?(p, t) == - r := search(p.key, t) - r case Entry and r::Entry = p.entry - - if % has finiteAggregate then - keys t == [x.key for x in parts t] - -@ -\section{category ELTAB Eltable} -<>= -"ELTAB" -> "CATEGORY" -"Eltable(a:SetCategory,b:Type)" -> "Category" -@ -<>= -)abbrev category ELTAB Eltable -++ Author: Michael Monagan; revised by Manuel Bronstein and Manuel Bronstein -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ An eltable over domains D and I is a structure which can be viewed -++ as a function from D to I. -++ Examples of eltable structures range from data structures, e.g. those -++ of type \spadtype{List}, to algebraic structures, e.g. \spadtype{Polynomial}. -Eltable(S:SetCategory, Index:Type): Category == with - elt : (%, S) -> Index - ++ elt(u,i) (also written: u . i) returns the element of u indexed by i. - ++ Error: if i is not an index of u. - -@ -\section{category ELTAGG EltableAggregate} -<>= -"ELTAGG" -> "ELTAB" -"EltableAggregate(a:SetCategory,b:Type)"-> "Eltable(a:SetCategory,b:Type)" -@ -<>= -)abbrev category ELTAGG EltableAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ An eltable aggregate is one which can be viewed as a function. -++ For example, the list \axiom{[1,7,4]} can applied to 0,1, and 2 respectively -++ will return the integers 1,7, and 4; thus this list may be viewed -++ as mapping 0 to 1, 1 to 7 and 2 to 4. In general, an aggregate -++ can map members of a domain {\em Dom} to an image domain {\em Im}. -EltableAggregate(Dom:SetCategory, Im:Type): Category == --- This is separated from Eltable --- and series won't have to support qelt's and setelt's. - Eltable(Dom, Im) with - elt : (%, Dom, Im) -> Im - ++ elt(u, x, y) applies u to x if x is in the domain of u, - ++ and returns y otherwise. - ++ For example, if u is a polynomial in \axiom{x} over the rationals, - ++ \axiom{elt(u,n,0)} may define the coefficient of \axiom{x} - ++ to the power n, returning 0 when n is out of range. - qelt: (%, Dom) -> Im - ++ qelt(u, x) applies \axiom{u} to \axiom{x} without checking whether - ++ \axiom{x} is in the domain of \axiom{u}. If \axiom{x} is not in the - ++ domain of \axiom{u} a memory-access violation may occur. If a check - ++ on whether \axiom{x} is in the domain of \axiom{u} is required, use - ++ the function \axiom{elt}. - if % has shallowlyMutable then - setelt : (%, Dom, Im) -> Im - ++ setelt(u,x,y) sets the image of x to be y under u, - ++ assuming x is in the domain of u. - ++ Error: if x is not in the domain of u. - -- this function will soon be renamed as setelt!. - qsetelt_!: (%, Dom, Im) -> Im - ++ qsetelt!(u,x,y) sets the image of \axiom{x} to be \axiom{y} under - ++ \axiom{u}, without checking that \axiom{x} is in the domain of - ++ \axiom{u}. - ++ If such a check is required use the function \axiom{setelt}. - add - qelt(a, x) == elt(a, x) - if % has shallowlyMutable then - qsetelt_!(a, x, y) == (a.x := y) - -@ -\section{category IXAGG IndexedAggregate} -<>= -"IXAGG" -> "HOAGG" -"IndexedAggregate(a:SetCategory,b:Type)" -> - "HomogeneousAggregate(a:Type)" -"IXAGG" -> "ELTAGG" -"IndexedAggregate(a:SetCategory,b:Type)" -> - "EltableAggregate(a:SetCategory,b:Type)" -"IndexedAggregate(a:SetCategory,b:SetCategory)" -> - "IndexedAggregate(a:SetCategory,b:Type)" -"IndexedAggregate(b:Integer,a:Type)" -> - "IndexedAggregate(a:SetCategory,b:Type)" -@ -<>= -)abbrev category IXAGG IndexedAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ An indexed aggregate is a many-to-one mapping of indices to entries. -++ For example, a one-dimensional-array is an indexed aggregate where -++ the index is an integer. Also, a table is an indexed aggregate -++ where the indices and entries may have any type. -IndexedAggregate(Index: SetCategory, Entry: Type): Category == - Join(HomogeneousAggregate(Entry), EltableAggregate(Index, Entry)) with - entries: % -> List Entry - ++ entries(u) returns a list of all the entries of aggregate u - ++ in no assumed order. - -- to become entries: % -> Entry* and entries: % -> Iterator(Entry,Entry) - index?: (Index,%) -> Boolean - ++ index?(i,u) tests if i is an index of aggregate u. - indices: % -> List Index - ++ indices(u) returns a list of indices of aggregate u in no - ++ particular order. - -- to become indices: % -> Index* and indices: % -> Iterator(Index,Index). --- map: ((Entry,Entry)->Entry,%,%,Entry) -> % --- ++ exists c = map(f,a,b,x), i:Index where --- ++ c.i = f(a(i,x),b(i,x)) | index?(i,a) or index?(i,b) - if Entry has SetCategory and % has finiteAggregate then - entry?: (Entry,%) -> Boolean - ++ entry?(x,u) tests if x equals \axiom{u . i} for some index i. - if Index has OrderedSet then - maxIndex: % -> Index - ++ maxIndex(u) returns the maximum index i of aggregate u. - ++ Note: in general, - ++ \axiom{maxIndex(u) = reduce(max,[i for i in indices u])}; - ++ if u is a list, \axiom{maxIndex(u) = #u}. - minIndex: % -> Index - ++ minIndex(u) returns the minimum index i of aggregate u. - ++ Note: in general, - ++ \axiom{minIndex(a) = reduce(min,[i for i in indices a])}; - ++ for lists, \axiom{minIndex(a) = 1}. - first : % -> Entry - ++ first(u) returns the first element x of u. - ++ Note: for collections, \axiom{first([x,y,...,z]) = x}. - ++ Error: if u is empty. - - if % has shallowlyMutable then - fill_!: (%,Entry) -> % - ++ fill!(u,x) replaces each entry in aggregate u by x. - ++ The modified u is returned as value. - swap_!: (%,Index,Index) -> Void - ++ swap!(u,i,j) interchanges elements i and j of aggregate u. - ++ No meaningful value is returned. - add - elt(a, i, x) == (index?(i, a) => qelt(a, i); x) - - if % has finiteAggregate then - entries x == parts x - if Entry has SetCategory then - entry?(x, a) == member?(x, a) - - if Index has OrderedSet then - maxIndex a == "max"/indices(a) - minIndex a == "min"/indices(a) - first a == a minIndex a - - if % has shallowlyMutable then - map(f, a) == map_!(f, copy a) - - map_!(f, a) == - for i in indices a repeat qsetelt_!(a, i, f qelt(a, i)) - a - - fill_!(a, x) == - for i in indices a repeat qsetelt_!(a, i, x) - a - - swap_!(a, i, j) == - t := a.i - qsetelt_!(a, i, a.j) - qsetelt_!(a, j, t) - void - -@ -\section{category TBAGG TableAggregate} -<>= -"TBAGG" -> "KDAGG" -"TableAggregate(a:SetCategory,b:SetCategory)" -> - "KeyedDictionary(a:SetCategory,b:SetCategory)" -"TBAGG" -> "IXAGG" -"TableAggregate(a:SetCategory,b:SetCategory)" -> - "IndexedAggregate(a:SetCategory,b:SetCategory)" -@ -<>= -)abbrev category TBAGG TableAggregate -++ Author: Michael Monagan, Stephen Watt; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A table aggregate is a model of a table, i.e. a discrete many-to-one -++ mapping from keys to entries. -TableAggregate(Key:SetCategory, Entry:SetCategory): Category == - Join(KeyedDictionary(Key,Entry),IndexedAggregate(Key,Entry)) with - setelt: (%,Key,Entry) -> Entry -- setelt_! later - ++ setelt(t,k,e) (also written \axiom{t.k := e}) is equivalent - ++ to \axiom{(insert([k,e],t); e)}. - table: () -> % - ++ table()$T creates an empty table of type T. - ++ - ++E Data:=Record(age:Integer,gender:String) - ++E a1:AssociationList(String,Data):=table() - ++E a1."tim":=[55,"male"]$Data - - table: List Record(key:Key,entry:Entry) -> % - ++ table([x,y,...,z]) creates a table consisting of entries - ++ \axiom{x,y,...,z}. - -- to become table: Record(key:Key,entry:Entry)* -> % - map: ((Entry, Entry) -> Entry, %, %) -> % - ++ map(fn,t1,t2) creates a new table t from given tables t1 and t2 with - ++ elements fn(x,y) where x and y are corresponding elements from t1 - ++ and t2 respectively. - add - table() == empty() - table l == dictionary l --- empty() == dictionary() - - insert_!(p, t) == (t(p.key) := p.entry; t) - indices t == keys t - - coerce(t:%):OutputForm == - prefix("table"::OutputForm, - [k::OutputForm = (t.k)::OutputForm for k in keys t]) - - elt(t, k) == - (r := search(k, t)) case Entry => r::Entry - error "key not in table" - - elt(t, k, e) == - (r := search(k, t)) case Entry => r::Entry - e - - map_!(f, t) == - for k in keys t repeat t.k := f t.k - t - - map(f:(Entry, Entry) -> Entry, s:%, t:%) == - z := table() - for k in keys s | key?(k, t) repeat z.k := f(s.k, t.k) - z - --- map(f, s, t, x) == --- z := table() --- for k in keys s repeat z.k := f(s.k, t(k, x)) --- for k in keys t | not key?(k, s) repeat z.k := f(t.k, x) --- z - - if % has finiteAggregate then - parts(t:%):List Record(key:Key,entry:Entry) == [[k, t.k] for k in keys t] - parts(t:%):List Entry == [t.k for k in keys t] - entries(t:%):List Entry == parts(t) - - s:% = t:% == - eq?(s,t) => true - #s ^= #t => false - for k in keys s repeat - (e := search(k, t)) case "failed" or (e::Entry) ^= s.k => return false - true - - map(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry), t: %): % == - z := table() - for k in keys t repeat - ke: Record(key:Key,entry:Entry) := f [k, t.k] - z ke.key := ke.entry - z - map_!(f: Record(key:Key,entry:Entry)->Record(key:Key,entry:Entry), t: %): % == - lke: List Record(key:Key,entry:Entry) := nil() - for k in keys t repeat - lke := cons(f [k, remove_!(k,t)::Entry], lke) - for ke in lke repeat - t ke.key := ke.entry - t - - inspect(t: %): Record(key:Key,entry:Entry) == - ks := keys t - empty? ks => error "Cannot extract from an empty aggregate" - [first ks, t first ks] - - find(f: Record(key:Key,entry:Entry)->Boolean, t:%): Union(Record(key:Key,entry:Entry), "failed") == - for ke in parts(t)@List(Record(key:Key,entry:Entry)) repeat if f ke then return ke - "failed" - - index?(k: Key, t: %): Boolean == - search(k,t) case Entry - - remove_!(x:Record(key:Key,entry:Entry), t:%) == - if member?(x, t) then remove_!(x.key, t) - t - extract_!(t: %): Record(key:Key,entry:Entry) == - k: Record(key:Key,entry:Entry) := inspect t - remove_!(k.key, t) - k - - any?(f: Entry->Boolean, t: %): Boolean == - for k in keys t | f t k repeat return true - false - every?(f: Entry->Boolean, t: %): Boolean == - for k in keys t | not f t k repeat return false - true - count(f: Entry->Boolean, t: %): NonNegativeInteger == - tally: NonNegativeInteger := 0 - for k in keys t | f t k repeat tally := tally + 1 - tally - -@ -\section{category RCAGG RecursiveAggregate} -<>= -"RCAGG" -> "HOAGG" -"RecursiveAggregate(a:Type)" -> "HomogeneousAggregate(a:Type)" -@ -<>= -)abbrev category RCAGG RecursiveAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A recursive aggregate over a type S is a model for a -++ a directed graph containing values of type S. -++ Recursively, a recursive aggregate is a {\em node} -++ consisting of a \spadfun{value} from S and 0 or more \spadfun{children} -++ which are recursive aggregates. -++ A node with no children is called a \spadfun{leaf} node. -++ A recursive aggregate may be cyclic for which some operations as noted -++ may go into an infinite loop. -RecursiveAggregate(S:Type): Category == HomogeneousAggregate(S) with - children: % -> List % - ++ children(u) returns a list of the children of aggregate u. - -- should be % -> %* and also needs children: % -> Iterator(S,S) - nodes: % -> List % - ++ nodes(u) returns a list of all of the nodes of aggregate u. - -- to become % -> %* and also nodes: % -> Iterator(S,S) - leaf?: % -> Boolean - ++ leaf?(u) tests if u is a terminal node. - value: % -> S - ++ value(u) returns the value of the node u. - elt: (%,"value") -> S - ++ elt(u,"value") (also written: \axiom{a. value}) is - ++ equivalent to \axiom{value(a)}. - cyclic?: % -> Boolean - ++ cyclic?(u) tests if u has a cycle. - leaves: % -> List S - ++ leaves(t) returns the list of values in obtained by visiting the - ++ nodes of tree \axiom{t} in left-to-right order. - distance: (%,%) -> Integer - ++ distance(u,v) returns the path length (an integer) from node u to v. - if S has SetCategory then - child?: (%,%) -> Boolean - ++ child?(u,v) tests if node u is a child of node v. - node?: (%,%) -> Boolean - ++ node?(u,v) tests if node u is contained in node v - ++ (either as a child, a child of a child, etc.). - if % has shallowlyMutable then - setchildren_!: (%,List %)->% - ++ setchildren!(u,v) replaces the current children of node u - ++ with the members of v in left-to-right order. - setelt: (%,"value",S) -> S - ++ setelt(a,"value",x) (also written \axiom{a . value := x}) - ++ is equivalent to \axiom{setvalue!(a,x)} - setvalue_!: (%,S) -> S - ++ setvalue!(u,x) sets the value of node u to x. - add - elt(x,"value") == value x - if % has shallowlyMutable then - setelt(x,"value",y) == setvalue_!(x,y) - if S has SetCategory then - child?(x,l) == member?(x,children(l)) - -@ -\section{RCAGG.lsp BOOTSTRAP} -{\bf RCAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RCAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RCAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |RecursiveAggregate;CAT| (QUOTE NIL)) - -(SETQ |RecursiveAggregate;AL| (QUOTE NIL)) - -(DEFUN |RecursiveAggregate| (#1=#:G84501) (LET (#2=#:G84502) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |RecursiveAggregate;AL|)) (CDR #2#)) (T (SETQ |RecursiveAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|RecursiveAggregate;| #1#))) |RecursiveAggregate;AL|)) #2#)))) - -(DEFUN |RecursiveAggregate;| (|t#1|) (PROG (#1=#:G84500) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|RecursiveAggregate;CAT|) ((QUOTE T) (LETT |RecursiveAggregate;CAT| (|Join| (|HomogeneousAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|children| ((|List| |$|) |$|)) T) ((|nodes| ((|List| |$|) |$|)) T) ((|leaf?| ((|Boolean|) |$|)) T) ((|value| (|t#1| |$|)) T) ((|elt| (|t#1| |$| "value")) T) ((|cyclic?| ((|Boolean|) |$|)) T) ((|leaves| ((|List| |t#1|) |$|)) T) ((|distance| ((|Integer|) |$| |$|)) T) ((|child?| ((|Boolean|) |$| |$|)) (|has| |t#1| (|SetCategory|))) ((|node?| ((|Boolean|) |$| |$|)) (|has| |t#1| (|SetCategory|))) ((|setchildren!| (|$| |$| (|List| |$|))) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|t#1| |$| "value" |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setvalue!| (|t#1| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))))) NIL (QUOTE ((|List| |$|) (|Boolean|) (|Integer|) (|List| |t#1|))) NIL)) . #2=(|RecursiveAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |RecursiveAggregate|) (|devaluate| |t#1|))))))) -@ -\section{RCAGG-.lsp BOOTSTRAP} -{\bf RCAGG-} depends on {\bf RCAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf RCAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf RCAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |RCAGG-;elt;AvalueS;1| (|x| G84515 |$|) (SPADCALL |x| (QREFELT |$| 8))) - -(DEFUN |RCAGG-;setelt;Avalue2S;2| (|x| G84517 |y| |$|) (SPADCALL |x| |y| (QREFELT |$| 11))) - -(DEFUN |RCAGG-;child?;2AB;3| (|x| |l| |$|) (SPADCALL |x| (SPADCALL |l| (QREFELT |$| 14)) (QREFELT |$| 17))) - -(DEFUN |RecursiveAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|RecursiveAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |RecursiveAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 19) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)) (|HasCategory| |#2| (QUOTE (|SetCategory|))))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|testBitVector| |pv$| 1) (QSETREFV |$| 12 (CONS (|dispatchFunction| |RCAGG-;setelt;Avalue2S;2|) |$|)))) (COND ((|testBitVector| |pv$| 2) (QSETREFV |$| 18 (CONS (|dispatchFunction| |RCAGG-;child?;2AB;3|) |$|)))) |$|)))) - -(MAKEPROP (QUOTE |RecursiveAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |value|) (QUOTE "value") |RCAGG-;elt;AvalueS;1| (5 . |setvalue!|) (11 . |setelt|) (|List| |$|) (18 . |children|) (|Boolean|) (|List| 6) (23 . |member?|) (29 . |child?|))) (QUOTE #(|setelt| 35 |elt| 42 |child?| 48)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 18 (QUOTE (1 6 7 0 8 2 6 7 0 7 11 3 0 7 0 9 7 12 1 6 13 0 14 2 16 15 6 0 17 2 0 15 0 0 18 3 0 7 0 9 7 12 2 0 7 0 9 10 2 0 15 0 0 18)))))) (QUOTE |lookupComplete|))) -@ -\section{category BRAGG BinaryRecursiveAggregate} -<>= -"BRAGG" -> "RCAGG" -"BinaryRecursiveAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" -@ -<>= -)abbrev category BRAGG BinaryRecursiveAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A binary-recursive aggregate has 0, 1 or 2 children and -++ serves as a model for a binary tree or a doubly-linked aggregate structure -BinaryRecursiveAggregate(S:Type):Category == RecursiveAggregate S with - -- needs preorder, inorder and postorder iterators - left: % -> % - ++ left(u) returns the left child. - elt: (%,"left") -> % - ++ elt(u,"left") (also written: \axiom{a . left}) is - ++ equivalent to \axiom{left(a)}. - right: % -> % - ++ right(a) returns the right child. - elt: (%,"right") -> % - ++ elt(a,"right") (also written: \axiom{a . right}) - ++ is equivalent to \axiom{right(a)}. - if % has shallowlyMutable then - setelt: (%,"left",%) -> % - ++ setelt(a,"left",b) (also written \axiom{a . left := b}) is equivalent - ++ to \axiom{setleft!(a,b)}. - setleft_!: (%,%) -> % - ++ setleft!(a,b) sets the left child of \axiom{a} to be b. - setelt: (%,"right",%) -> % - ++ setelt(a,"right",b) (also written \axiom{b . right := b}) - ++ is equivalent to \axiom{setright!(a,b)}. - setright_!: (%,%) -> % - ++ setright!(a,x) sets the right child of t to be x. - add - cycleMax ==> 1000 - - elt(x,"left") == left x - elt(x,"right") == right x - leaf? x == empty? x or empty? left x and empty? right x - leaves t == - empty? t => empty()$List(S) - leaf? t => [value t] - concat(leaves left t,leaves right t) - nodes x == - l := empty()$List(%) - empty? x => l - concat(nodes left x,concat([x],nodes right x)) - children x == - l := empty()$List(%) - empty? x => l - empty? left x => [right x] - empty? right x => [left x] - [left x, right x] - if % has SetAggregate(S) and S has SetCategory then - node?(u,v) == - empty? v => false - u = v => true - for y in children v repeat node?(u,y) => return true - false - x = y == - empty?(x) => empty?(y) - empty?(y) => false - value x = value y and left x = left y and right x = right y - if % has finiteAggregate then - member?(x,u) == - empty? u => false - x = value u => true - member?(x,left u) or member?(x,right u) - - if S has SetCategory then - coerce(t:%): OutputForm == - empty? t => "[]"::OutputForm - v := value(t):: OutputForm - empty? left t => - empty? right t => v - r := coerce(right t)@OutputForm - bracket ["."::OutputForm, v, r] - l := coerce(left t)@OutputForm - r := - empty? right t => "."::OutputForm - coerce(right t)@OutputForm - bracket [l, v, r] - - if % has finiteAggregate then - aggCount: (%,NonNegativeInteger) -> NonNegativeInteger - #x == aggCount(x,0) - aggCount(x,k) == - empty? x => 0 - k := k + 1 - k = cycleMax and cyclic? x => error "cyclic tree" - for y in children x repeat k := aggCount(y,k) - k - - isCycle?: (%, List %) -> Boolean - eqMember?: (%, List %) -> Boolean - cyclic? x == not empty? x and isCycle?(x,empty()$(List %)) - isCycle?(x,acc) == - empty? x => false - eqMember?(x,acc) => true - for y in children x | not empty? y repeat - isCycle?(y,acc) => return true - false - eqMember?(y,l) == - for x in l repeat eq?(x,y) => return true - false - if % has shallowlyMutable then - setelt(x,"left",b) == setleft_!(x,b) - setelt(x,"right",b) == setright_!(x,b) - -@ -\section{category DLAGG DoublyLinkedAggregate} -<>= -"DLAGG" -> "RCAGG" -"DoublyLinkedAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" -@ -<>= -)abbrev category DLAGG DoublyLinkedAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A doubly-linked aggregate serves as a model for a doubly-linked -++ list, that is, a list which can has links to both next and previous -++ nodes and thus can be efficiently traversed in both directions. -DoublyLinkedAggregate(S:Type): Category == RecursiveAggregate S with - last: % -> S - ++ last(l) returns the last element of a doubly-linked aggregate l. - ++ Error: if l is empty. - head: % -> % - ++ head(l) returns the first element of a doubly-linked aggregate l. - ++ Error: if l is empty. - tail: % -> % - ++ tail(l) returns the doubly-linked aggregate l starting at - ++ its second element. - ++ Error: if l is empty. - previous: % -> % - ++ previous(l) returns the doubly-link list beginning with its previous - ++ element. - ++ Error: if l has no previous element. - ++ Note: \axiom{next(previous(l)) = l}. - next: % -> % - ++ next(l) returns the doubly-linked aggregate beginning with its next - ++ element. - ++ Error: if l has no next element. - ++ Note: \axiom{next(l) = rest(l)} and \axiom{previous(next(l)) = l}. - if % has shallowlyMutable then - concat_!: (%,%) -> % - ++ concat!(u,v) destructively concatenates doubly-linked aggregate v to the end of doubly-linked aggregate u. - setprevious_!: (%,%) -> % - ++ setprevious!(u,v) destructively sets the previous node of doubly-linked aggregate u to v, returning v. - setnext_!: (%,%) -> % - ++ setnext!(u,v) destructively sets the next node of doubly-linked aggregate u to v, returning v. - -@ -\section{category URAGG UnaryRecursiveAggregate} -<>= -"URAGG" -> "RCAGG" -"UnaryRecursiveAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" -@ -<>= -)abbrev category URAGG UnaryRecursiveAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A unary-recursive aggregate is a one where nodes may have either -++ 0 or 1 children. -++ This aggregate models, though not precisely, a linked -++ list possibly with a single cycle. -++ A node with one children models a non-empty list, with the -++ \spadfun{value} of the list designating the head, or \spadfun{first}, of the -++ list, and the child designating the tail, or \spadfun{rest}, of the list. -++ A node with no child then designates the empty list. -++ Since these aggregates are recursive aggregates, they may be cyclic. -UnaryRecursiveAggregate(S:Type): Category == RecursiveAggregate S with - concat: (%,%) -> % - ++ concat(u,v) returns an aggregate w consisting of the elements of u - ++ followed by the elements of v. - ++ Note: \axiom{v = rest(w,#a)}. - concat: (S,%) -> % - ++ concat(x,u) returns aggregate consisting of x followed by - ++ the elements of u. - ++ Note: if \axiom{v = concat(x,u)} then \axiom{x = first v} - ++ and \axiom{u = rest v}. - first: % -> S - ++ first(u) returns the first element of u - ++ (equivalently, the value at the current node). - elt: (%,"first") -> S - ++ elt(u,"first") (also written: \axiom{u . first}) is equivalent to first u. - first: (%,NonNegativeInteger) -> % - ++ first(u,n) returns a copy of the first n (\axiom{n >= 0}) elements of u. - rest: % -> % - ++ rest(u) returns an aggregate consisting of all but the first - ++ element of u - ++ (equivalently, the next node of u). - elt: (%,"rest") -> % - ++ elt(%,"rest") (also written: \axiom{u.rest}) is - ++ equivalent to \axiom{rest u}. - rest: (%,NonNegativeInteger) -> % - ++ rest(u,n) returns the \axiom{n}th (n >= 0) node of u. - ++ Note: \axiom{rest(u,0) = u}. - last: % -> S - ++ last(u) resturn the last element of u. - ++ Note: for lists, \axiom{last(u) = u . (maxIndex u) = u . (# u - 1)}. - elt: (%,"last") -> S - ++ elt(u,"last") (also written: \axiom{u . last}) is equivalent to last u. - last: (%,NonNegativeInteger) -> % - ++ last(u,n) returns a copy of the last n (\axiom{n >= 0}) nodes of u. - ++ Note: \axiom{last(u,n)} is a list of n elements. - tail: % -> % - ++ tail(u) returns the last node of u. - ++ Note: if u is \axiom{shallowlyMutable}, - ++ \axiom{setrest(tail(u),v) = concat(u,v)}. - second: % -> S - ++ second(u) returns the second element of u. - ++ Note: \axiom{second(u) = first(rest(u))}. - third: % -> S - ++ third(u) returns the third element of u. - ++ Note: \axiom{third(u) = first(rest(rest(u)))}. - cycleEntry: % -> % - ++ cycleEntry(u) returns the head of a top-level cycle contained in - ++ aggregate u, or \axiom{empty()} if none exists. - cycleLength: % -> NonNegativeInteger - ++ cycleLength(u) returns the length of a top-level cycle - ++ contained in aggregate u, or 0 is u has no such cycle. - cycleTail: % -> % - ++ cycleTail(u) returns the last node in the cycle, or - ++ empty if none exists. - if % has shallowlyMutable then - concat_!: (%,%) -> % - ++ concat!(u,v) destructively concatenates v to the end of u. - ++ Note: \axiom{concat!(u,v) = setlast_!(u,v)}. - concat_!: (%,S) -> % - ++ concat!(u,x) destructively adds element x to the end of u. - ++ Note: \axiom{concat!(a,x) = setlast!(a,[x])}. - cycleSplit_!: % -> % - ++ cycleSplit!(u) splits the aggregate by dropping off the cycle. - ++ The value returned is the cycle entry, or nil if none exists. - ++ For example, if \axiom{w = concat(u,v)} is the cyclic list where v is - ++ the head of the cycle, \axiom{cycleSplit!(w)} will drop v off w thus - ++ destructively changing w to u, and returning v. - setfirst_!: (%,S) -> S - ++ setfirst!(u,x) destructively changes the first element of a to x. - setelt: (%,"first",S) -> S - ++ setelt(u,"first",x) (also written: \axiom{u.first := x}) is - ++ equivalent to \axiom{setfirst!(u,x)}. - setrest_!: (%,%) -> % - ++ setrest!(u,v) destructively changes the rest of u to v. - setelt: (%,"rest",%) -> % - ++ setelt(u,"rest",v) (also written: \axiom{u.rest := v}) is equivalent to - ++ \axiom{setrest!(u,v)}. - setlast_!: (%,S) -> S - ++ setlast!(u,x) destructively changes the last element of u to x. - setelt: (%,"last",S) -> S - ++ setelt(u,"last",x) (also written: \axiom{u.last := b}) - ++ is equivalent to \axiom{setlast!(u,v)}. - split_!: (%,Integer) -> % - ++ split!(u,n) splits u into two aggregates: \axiom{v = rest(u,n)} - ++ and \axiom{w = first(u,n)}, returning \axiom{v}. - ++ Note: afterwards \axiom{rest(u,n)} returns \axiom{empty()}. - add - cycleMax ==> 1000 - - findCycle: % -> % - - elt(x, "first") == first x - elt(x, "last") == last x - elt(x, "rest") == rest x - second x == first rest x - third x == first rest rest x - cyclic? x == not empty? x and not empty? findCycle x - last x == first tail x - - nodes x == - l := empty()$List(%) - while not empty? x repeat - l := concat(x, l) - x := rest x - reverse_! l - - children x == - l := empty()$List(%) - empty? x => l - concat(rest x,l) - - leaf? x == empty? x - - value x == - empty? x => error "value of empty object" - first x - - less?(l, n) == - i := n::Integer - while i > 0 and not empty? l repeat (l := rest l; i := i - 1) - i > 0 - - more?(l, n) == - i := n::Integer - while i > 0 and not empty? l repeat (l := rest l; i := i - 1) - zero?(i) and not empty? l - - size?(l, n) == - i := n::Integer - while not empty? l and i > 0 repeat (l := rest l; i := i - 1) - empty? l and zero? i - - #x == - for k in 0.. while not empty? x repeat - k = cycleMax and cyclic? x => error "cyclic list" - x := rest x - k - - tail x == - empty? x => error "empty list" - y := rest x - for k in 0.. while not empty? y repeat - k = cycleMax and cyclic? x => error "cyclic list" - y := rest(x := y) - x - - findCycle x == - y := rest x - while not empty? y repeat - if eq?(x, y) then return x - x := rest x - y := rest y - if empty? y then return y - if eq?(x, y) then return y - y := rest y - y - - cycleTail x == - empty?(y := x := cycleEntry x) => x - z := rest x - while not eq?(x,z) repeat (y := z; z := rest z) - y - - cycleEntry x == - empty? x => x - empty?(y := findCycle x) => y - z := rest y - for l in 1.. while not eq?(y,z) repeat z := rest z - y := x - for k in 1..l repeat y := rest y - while not eq?(x,y) repeat (x := rest x; y := rest y) - x - - cycleLength x == - empty? x => 0 - empty?(x := findCycle x) => 0 - y := rest x - for k in 1.. while not eq?(x,y) repeat y := rest y - k - - rest(x, n) == - for i in 1..n repeat - empty? x => error "Index out of range" - x := rest x - x - - if % has finiteAggregate then - last(x, n) == - n > (m := #x) => error "index out of range" - copy rest(x, (m - n)::NonNegativeInteger) - - if S has SetCategory then - x = y == - eq?(x, y) => true - for k in 0.. while not empty? x and not empty? y repeat - k = cycleMax and cyclic? x => error "cyclic list" - first x ^= first y => return false - x := rest x - y := rest y - empty? x and empty? y - - node?(u, v) == - for k in 0.. while not empty? v repeat - u = v => return true - k = cycleMax and cyclic? v => error "cyclic list" - v := rest v - u=v - - if % has shallowlyMutable then - setelt(x, "first", a) == setfirst_!(x, a) - setelt(x, "last", a) == setlast_!(x, a) - setelt(x, "rest", a) == setrest_!(x, a) - concat(x:%, y:%) == concat_!(copy x, y) - - setlast_!(x, s) == - empty? x => error "setlast: empty list" - setfirst_!(tail x, s) - s - - setchildren_!(u,lv) == - #lv=1 => setrest_!(u, first lv) - error "wrong number of children specified" - - setvalue_!(u,s) == setfirst_!(u,s) - - split_!(p, n) == - n < 1 => error "index out of range" - p := rest(p, (n - 1)::NonNegativeInteger) - q := rest p - setrest_!(p, empty()) - q - - cycleSplit_! x == - empty?(y := cycleEntry x) or eq?(x, y) => y - z := rest x - while not eq?(z, y) repeat (x := z; z := rest z) - setrest_!(x, empty()) - y - -@ -\section{URAGG.lsp BOOTSTRAP} -{\bf URAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf URAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf URAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |UnaryRecursiveAggregate;CAT| (QUOTE NIL)) - -(SETQ |UnaryRecursiveAggregate;AL| (QUOTE NIL)) - -(DEFUN |UnaryRecursiveAggregate| (#1=#:G84596) (LET (#2=#:G84597) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |UnaryRecursiveAggregate;AL|)) (CDR #2#)) (T (SETQ |UnaryRecursiveAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|UnaryRecursiveAggregate;| #1#))) |UnaryRecursiveAggregate;AL|)) #2#)))) - -(DEFUN |UnaryRecursiveAggregate;| (|t#1|) (PROG (#1=#:G84595) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|UnaryRecursiveAggregate;CAT|) ((QUOTE T) (LETT |UnaryRecursiveAggregate;CAT| (|Join| (|RecursiveAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|concat| (|$| |$| |$|)) T) ((|concat| (|$| |t#1| |$|)) T) ((|first| (|t#1| |$|)) T) ((|elt| (|t#1| |$| "first")) T) ((|first| (|$| |$| (|NonNegativeInteger|))) T) ((|rest| (|$| |$|)) T) ((|elt| (|$| |$| "rest")) T) ((|rest| (|$| |$| (|NonNegativeInteger|))) T) ((|last| (|t#1| |$|)) T) ((|elt| (|t#1| |$| "last")) T) ((|last| (|$| |$| (|NonNegativeInteger|))) T) ((|tail| (|$| |$|)) T) ((|second| (|t#1| |$|)) T) ((|third| (|t#1| |$|)) T) ((|cycleEntry| (|$| |$|)) T) ((|cycleLength| ((|NonNegativeInteger|) |$|)) T) ((|cycleTail| (|$| |$|)) T) ((|concat!| (|$| |$| |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|concat!| (|$| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|cycleSplit!| (|$| |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setfirst!| (|t#1| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|t#1| |$| "first" |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setrest!| (|$| |$| |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|$| |$| "rest" |$|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setlast!| (|t#1| |$| |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|setelt| (|t#1| |$| "last" |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))) ((|split!| (|$| |$| (|Integer|))) (|has| |$| (ATTRIBUTE |shallowlyMutable|))))) NIL (QUOTE ((|Integer|) (|NonNegativeInteger|))) NIL)) . #2=(|UnaryRecursiveAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |UnaryRecursiveAggregate|) (|devaluate| |t#1|))))))) -@ -\section{URAGG-.lsp BOOTSTRAP} -{\bf URAGG-} depends on {\bf URAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf URAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf URAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |URAGG-;elt;AfirstS;1| (|x| G84610 |$|) (SPADCALL |x| (QREFELT |$| 8))) - -(DEFUN |URAGG-;elt;AlastS;2| (|x| G84612 |$|) (SPADCALL |x| (QREFELT |$| 11))) - -(DEFUN |URAGG-;elt;ArestA;3| (|x| G84614 |$|) (SPADCALL |x| (QREFELT |$| 14))) - -(DEFUN |URAGG-;second;AS;4| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 14)) (QREFELT |$| 8))) - -(DEFUN |URAGG-;third;AS;5| (|x| |$|) (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 14)) (QREFELT |$| 14)) (QREFELT |$| 8))) - -(DEFUN |URAGG-;cyclic?;AB;6| (|x| |$|) (COND ((OR (SPADCALL |x| (QREFELT |$| 20)) (SPADCALL (|URAGG-;findCycle| |x| |$|) (QREFELT |$| 20))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) - -(DEFUN |URAGG-;last;AS;7| (|x| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 22)) (QREFELT |$| 8))) - -(DEFUN |URAGG-;nodes;AL;8| (|x| |$|) (PROG (|l|) (RETURN (SEQ (LETT |l| NIL |URAGG-;nodes;AL;8|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |l| (CONS |x| |l|) |URAGG-;nodes;AL;8|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;nodes;AL;8|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (NREVERSE |l|)))))) - -(DEFUN |URAGG-;children;AL;9| (|x| |$|) (PROG (|l|) (RETURN (SEQ (LETT |l| NIL |URAGG-;children;AL;9|) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 20)) |l|) ((QUOTE T) (CONS (SPADCALL |x| (QREFELT |$| 14)) |l|)))))))) - -(DEFUN |URAGG-;leaf?;AB;10| (|x| |$|) (SPADCALL |x| (QREFELT |$| 20))) - -(DEFUN |URAGG-;value;AS;11| (|x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "value of empty object")) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 8))))) - -(DEFUN |URAGG-;less?;ANniB;12| (|l| |n| |$|) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;less?;ANniB;12|) (SEQ G190 (COND ((NULL (COND ((|<| 0 |i|) (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))) (GO G191))) (SEQ (LETT |l| (SPADCALL |l| (QREFELT |$| 14)) |URAGG-;less?;ANniB;12|) (EXIT (LETT |i| (|-| |i| 1) |URAGG-;less?;ANniB;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (|<| 0 |i|)))))) - -(DEFUN |URAGG-;more?;ANniB;13| (|l| |n| |$|) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;more?;ANniB;13|) (SEQ G190 (COND ((NULL (COND ((|<| 0 |i|) (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))) (GO G191))) (SEQ (LETT |l| (SPADCALL |l| (QREFELT |$| 14)) |URAGG-;more?;ANniB;13|) (EXIT (LETT |i| (|-| |i| 1) |URAGG-;more?;ANniB;13|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((ZEROP |i|) (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))))))) - -(DEFUN |URAGG-;size?;ANniB;14| (|l| |n| |$|) (PROG (|i|) (RETURN (SEQ (LETT |i| |n| |URAGG-;size?;ANniB;14|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |l| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (|<| 0 |i|)))) (GO G191))) (SEQ (LETT |l| (SPADCALL |l| (QREFELT |$| 14)) |URAGG-;size?;ANniB;14|) (EXIT (LETT |i| (|-| |i| 1) |URAGG-;size?;ANniB;14|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |l| (QREFELT |$| 20)) (ZEROP |i|)) ((QUOTE T) (QUOTE NIL)))))))) - -(DEFUN |URAGG-;#;ANni;15| (|x| |$|) (PROG (|k|) (RETURN (SEQ (SEQ (LETT |k| 0 |URAGG-;#;ANni;15|) G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;#;ANni;15|))) (LETT |k| (QSADD1 |k|) |URAGG-;#;ANni;15|) (GO G190) G191 (EXIT NIL)) (EXIT |k|))))) - -(DEFUN |URAGG-;tail;2A;16| (|x| |$|) (PROG (|k| |y|) (RETURN (SEQ (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "empty list")) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;tail;2A;16|) (SEQ (LETT |k| 0 |URAGG-;tail;2A;16|) G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (EXIT (LETT |y| (SPADCALL (LETT |x| |y| |URAGG-;tail;2A;16|) (QREFELT |$| 14)) |URAGG-;tail;2A;16|))) (LETT |k| (QSADD1 |k|) |URAGG-;tail;2A;16|) (GO G190) G191 (EXIT NIL)) (EXIT |x|)))))))) - -(DEFUN |URAGG-;findCycle| (|x| |$|) (PROG (#1=#:G84667 |y|) (RETURN (SEQ (EXIT (SEQ (LETT |y| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;findCycle|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (PROGN (LETT #1# |x| |URAGG-;findCycle|) (GO #1#)))) (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;findCycle|) (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;findCycle|) (COND ((SPADCALL |y| (QREFELT |$| 20)) (PROGN (LETT #1# |y| |URAGG-;findCycle|) (GO #1#)))) (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (PROGN (LETT #1# |y| |URAGG-;findCycle|) (GO #1#)))) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;findCycle|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))) #1# (EXIT #1#))))) - -(DEFUN |URAGG-;cycleTail;2A;18| (|x| |$|) (PROG (|y| |z|) (RETURN (SEQ (COND ((SPADCALL (LETT |y| (LETT |x| (SPADCALL |x| (QREFELT |$| 37)) |URAGG-;cycleTail;2A;18|) |URAGG-;cycleTail;2A;18|) (QREFELT |$| 20)) |x|) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleTail;2A;18|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| |z| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |y| |z| |URAGG-;cycleTail;2A;18|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 14)) |URAGG-;cycleTail;2A;18|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|)))))))) - -(DEFUN |URAGG-;cycleEntry;2A;19| (|x| |$|) (PROG (|l| |z| |k| |y|) (RETURN (SEQ (COND ((SPADCALL |x| (QREFELT |$| 20)) |x|) ((SPADCALL (LETT |y| (|URAGG-;findCycle| |x| |$|) |URAGG-;cycleEntry;2A;19|) (QREFELT |$| 20)) |y|) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|) (SEQ (LETT |l| 1 |URAGG-;cycleEntry;2A;19|) G190 (COND ((NULL (COND ((SPADCALL |y| |z| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|))) (LETT |l| (QSADD1 |l|) |URAGG-;cycleEntry;2A;19|) (GO G190) G191 (EXIT NIL)) (LETT |y| |x| |URAGG-;cycleEntry;2A;19|) (SEQ (LETT |k| 1 |URAGG-;cycleEntry;2A;19|) G190 (COND ((QSGREATERP |k| |l|) (GO G191))) (SEQ (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|))) (LETT |k| (QSADD1 |k|) |URAGG-;cycleEntry;2A;19|) (GO G190) G191 (EXIT NIL)) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleEntry;2A;19|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|)))))))) - -(DEFUN |URAGG-;cycleLength;ANni;20| (|x| |$|) (PROG (|k| |y|) (RETURN (SEQ (COND ((OR (SPADCALL |x| (QREFELT |$| 20)) (SPADCALL (LETT |x| (|URAGG-;findCycle| |x| |$|) |URAGG-;cycleLength;ANni;20|) (QREFELT |$| 20))) 0) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleLength;ANni;20|) (SEQ (LETT |k| 1 |URAGG-;cycleLength;ANni;20|) G190 (COND ((NULL (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;cycleLength;ANni;20|))) (LETT |k| (QSADD1 |k|) |URAGG-;cycleLength;ANni;20|) (GO G190) G191 (EXIT NIL)) (EXIT |k|)))))))) - -(DEFUN |URAGG-;rest;ANniA;21| (|x| |n| |$|) (PROG (|i|) (RETURN (SEQ (SEQ (LETT |i| 1 |URAGG-;rest;ANniA;21|) G190 (COND ((QSGREATERP |i| |n|) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "Index out of range")) ((QUOTE T) (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;rest;ANniA;21|))))) (LETT |i| (QSADD1 |i|) |URAGG-;rest;ANniA;21|) (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) - -(DEFUN |URAGG-;last;ANniA;22| (|x| |n| |$|) (PROG (|m| #1=#:G84694) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 42)) |URAGG-;last;ANniA;22|) (EXIT (COND ((|<| |m| |n|) (|error| "index out of range")) ((QUOTE T) (SPADCALL (SPADCALL |x| (PROG1 (LETT #1# (|-| |m| |n|) |URAGG-;last;ANniA;22|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 43)) (QREFELT |$| 44))))))))) - -(DEFUN |URAGG-;=;2AB;23| (|x| |y| |$|) (PROG (|k| #1=#:G84705) (RETURN (SEQ (EXIT (COND ((SPADCALL |x| |y| (QREFELT |$| 36)) (QUOTE T)) ((QUOTE T) (SEQ (SEQ (LETT |k| 0 |URAGG-;=;2AB;23|) G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 20)) (SPADCALL |y| (QREFELT |$| 20))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (COND ((NULL (SPADCALL (SPADCALL |x| (QREFELT |$| 8)) (SPADCALL |y| (QREFELT |$| 8)) (QREFELT |$| 46))) (EXIT (PROGN (LETT #1# (QUOTE NIL) |URAGG-;=;2AB;23|) (GO #1#))))) (LETT |x| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;=;2AB;23|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 14)) |URAGG-;=;2AB;23|))) (LETT |k| (QSADD1 |k|) |URAGG-;=;2AB;23|) (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 20)) (SPADCALL |y| (QREFELT |$| 20))) ((QUOTE T) (QUOTE NIL)))))))) #1# (EXIT #1#))))) - -(DEFUN |URAGG-;node?;2AB;24| (|u| |v| |$|) (PROG (|k| #1=#:G84711) (RETURN (SEQ (EXIT (SEQ (SEQ (LETT |k| 0 |URAGG-;node?;2AB;24|) G190 (COND ((NULL (COND ((SPADCALL |v| (QREFELT |$| 20)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL |u| |v| (QREFELT |$| 48)) (PROGN (LETT #1# (QUOTE T) |URAGG-;node?;2AB;24|) (GO #1#))) ((QUOTE T) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |v| (QREFELT |$| 33)) (EXIT (|error| "cyclic list")))))) (EXIT (LETT |v| (SPADCALL |v| (QREFELT |$| 14)) |URAGG-;node?;2AB;24|))))))) (LETT |k| (QSADD1 |k|) |URAGG-;node?;2AB;24|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |u| |v| (QREFELT |$| 48))))) #1# (EXIT #1#))))) - -(DEFUN |URAGG-;setelt;Afirst2S;25| (|x| G84713 |a| |$|) (SPADCALL |x| |a| (QREFELT |$| 50))) - -(DEFUN |URAGG-;setelt;Alast2S;26| (|x| G84715 |a| |$|) (SPADCALL |x| |a| (QREFELT |$| 52))) - -(DEFUN |URAGG-;setelt;Arest2A;27| (|x| G84717 |a| |$|) (SPADCALL |x| |a| (QREFELT |$| 54))) - -(DEFUN |URAGG-;concat;3A;28| (|x| |y| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 44)) |y| (QREFELT |$| 56))) - -(DEFUN |URAGG-;setlast!;A2S;29| (|x| |s| |$|) (SEQ (COND ((SPADCALL |x| (QREFELT |$| 20)) (|error| "setlast: empty list")) ((QUOTE T) (SEQ (SPADCALL (SPADCALL |x| (QREFELT |$| 22)) |s| (QREFELT |$| 50)) (EXIT |s|)))))) - -(DEFUN |URAGG-;setchildren!;ALA;30| (|u| |lv| |$|) (COND ((EQL (LENGTH |lv|) 1) (SPADCALL |u| (|SPADfirst| |lv|) (QREFELT |$| 54))) ((QUOTE T) (|error| "wrong number of children specified")))) - -(DEFUN |URAGG-;setvalue!;A2S;31| (|u| |s| |$|) (SPADCALL |u| |s| (QREFELT |$| 50))) - -(DEFUN |URAGG-;split!;AIA;32| (|p| |n| |$|) (PROG (#1=#:G84725 |q|) (RETURN (SEQ (COND ((|<| |n| 1) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |p| (SPADCALL |p| (PROG1 (LETT #1# (|-| |n| 1) |URAGG-;split!;AIA;32|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 43)) |URAGG-;split!;AIA;32|) (LETT |q| (SPADCALL |p| (QREFELT |$| 14)) |URAGG-;split!;AIA;32|) (SPADCALL |p| (SPADCALL (QREFELT |$| 61)) (QREFELT |$| 54)) (EXIT |q|)))))))) - -(DEFUN |URAGG-;cycleSplit!;2A;33| (|x| |$|) (PROG (|y| |z|) (RETURN (SEQ (COND ((OR (SPADCALL (LETT |y| (SPADCALL |x| (QREFELT |$| 37)) |URAGG-;cycleSplit!;2A;33|) (QREFELT |$| 20)) (SPADCALL |x| |y| (QREFELT |$| 36))) |y|) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |x| (QREFELT |$| 14)) |URAGG-;cycleSplit!;2A;33|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |z| |y| (QREFELT |$| 36)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |x| |z| |URAGG-;cycleSplit!;2A;33|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 14)) |URAGG-;cycleSplit!;2A;33|))) NIL (GO G190) G191 (EXIT NIL)) (SPADCALL |x| (SPADCALL (QREFELT |$| 61)) (QREFELT |$| 54)) (EXIT |y|)))))))) - -(DEFUN |UnaryRecursiveAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|UnaryRecursiveAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |UnaryRecursiveAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 66) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasAttribute| |#1| (QUOTE |finiteAggregate|)) (QSETREFV |$| 45 (CONS (|dispatchFunction| |URAGG-;last;ANniA;22|) |$|)))) (COND ((|HasCategory| |#2| (QUOTE (|SetCategory|))) (PROGN (QSETREFV |$| 47 (CONS (|dispatchFunction| |URAGG-;=;2AB;23|) |$|)) (QSETREFV |$| 49 (CONS (|dispatchFunction| |URAGG-;node?;2AB;24|) |$|))))) (COND ((|testBitVector| |pv$| 1) (PROGN (QSETREFV |$| 51 (CONS (|dispatchFunction| |URAGG-;setelt;Afirst2S;25|) |$|)) (QSETREFV |$| 53 (CONS (|dispatchFunction| |URAGG-;setelt;Alast2S;26|) |$|)) (QSETREFV |$| 55 (CONS (|dispatchFunction| |URAGG-;setelt;Arest2A;27|) |$|)) (QSETREFV |$| 57 (CONS (|dispatchFunction| |URAGG-;concat;3A;28|) |$|)) (QSETREFV |$| 58 (CONS (|dispatchFunction| |URAGG-;setlast!;A2S;29|) |$|)) (QSETREFV |$| 59 (CONS (|dispatchFunction| |URAGG-;setchildren!;ALA;30|) |$|)) (QSETREFV |$| 60 (CONS (|dispatchFunction| |URAGG-;setvalue!;A2S;31|) |$|)) (QSETREFV |$| 63 (CONS (|dispatchFunction| |URAGG-;split!;AIA;32|) |$|)) (QSETREFV |$| 64 (CONS (|dispatchFunction| |URAGG-;cycleSplit!;2A;33|) |$|))))) |$|)))) - -(MAKEPROP (QUOTE |UnaryRecursiveAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (0 . |first|) (QUOTE "first") |URAGG-;elt;AfirstS;1| (5 . |last|) (QUOTE "last") |URAGG-;elt;AlastS;2| (10 . |rest|) (QUOTE "rest") |URAGG-;elt;ArestA;3| |URAGG-;second;AS;4| |URAGG-;third;AS;5| (|Boolean|) (15 . |empty?|) |URAGG-;cyclic?;AB;6| (20 . |tail|) |URAGG-;last;AS;7| (|List| |$|) |URAGG-;nodes;AL;8| |URAGG-;children;AL;9| |URAGG-;leaf?;AB;10| |URAGG-;value;AS;11| (|NonNegativeInteger|) |URAGG-;less?;ANniB;12| |URAGG-;more?;ANniB;13| |URAGG-;size?;ANniB;14| (25 . |cyclic?|) |URAGG-;#;ANni;15| |URAGG-;tail;2A;16| (30 . |eq?|) (36 . |cycleEntry|) |URAGG-;cycleTail;2A;18| |URAGG-;cycleEntry;2A;19| |URAGG-;cycleLength;ANni;20| |URAGG-;rest;ANniA;21| (41 . |#|) (46 . |rest|) (52 . |copy|) (57 . |last|) (63 . |=|) (69 . |=|) (75 . |=|) (81 . |node?|) (87 . |setfirst!|) (93 . |setelt|) (100 . |setlast!|) (106 . |setelt|) (113 . |setrest!|) (119 . |setelt|) (126 . |concat!|) (132 . |concat|) (138 . |setlast!|) (144 . |setchildren!|) (150 . |setvalue!|) (156 . |empty|) (|Integer|) (160 . |split!|) (166 . |cycleSplit!|) (QUOTE "value"))) (QUOTE #(|value| 171 |third| 176 |tail| 181 |split!| 186 |size?| 192 |setvalue!| 198 |setlast!| 204 |setelt| 210 |setchildren!| 231 |second| 237 |rest| 242 |nodes| 248 |node?| 253 |more?| 259 |less?| 265 |leaf?| 271 |last| 276 |elt| 287 |cyclic?| 305 |cycleTail| 310 |cycleSplit!| 315 |cycleLength| 320 |cycleEntry| 325 |concat| 330 |children| 336 |=| 341 |#| 347)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 64 (QUOTE (1 6 7 0 8 1 6 7 0 11 1 6 0 0 14 1 6 19 0 20 1 6 0 0 22 1 6 19 0 33 2 6 19 0 0 36 1 6 0 0 37 1 6 29 0 42 2 6 0 0 29 43 1 6 0 0 44 2 0 0 0 29 45 2 7 19 0 0 46 2 0 19 0 0 47 2 6 19 0 0 48 2 0 19 0 0 49 2 6 7 0 7 50 3 0 7 0 9 7 51 2 6 7 0 7 52 3 0 7 0 12 7 53 2 6 0 0 0 54 3 0 0 0 15 0 55 2 6 0 0 0 56 2 0 0 0 0 57 2 0 7 0 7 58 2 0 0 0 24 59 2 0 7 0 7 60 0 6 0 61 2 0 0 0 62 63 1 0 0 0 64 1 0 7 0 28 1 0 7 0 18 1 0 0 0 35 2 0 0 0 62 63 2 0 19 0 29 32 2 0 7 0 7 60 2 0 7 0 7 58 3 0 7 0 12 7 53 3 0 0 0 15 0 55 3 0 7 0 9 7 51 2 0 0 0 24 59 1 0 7 0 17 2 0 0 0 29 41 1 0 24 0 25 2 0 19 0 0 49 2 0 19 0 29 31 2 0 19 0 29 30 1 0 19 0 27 2 0 0 0 29 45 1 0 7 0 23 2 0 7 0 12 13 2 0 0 0 15 16 2 0 7 0 9 10 1 0 19 0 21 1 0 0 0 38 1 0 0 0 64 1 0 29 0 40 1 0 0 0 39 2 0 0 0 0 57 1 0 24 0 26 2 0 19 0 0 47 1 0 29 0 34)))))) (QUOTE |lookupComplete|))) -@ -\section{category STAGG StreamAggregate} -<>= -"STAGG" -> "RCAGG" -"StreamAggregate(a:Type)" -> "RecursiveAggregate(a:Type)" -"STAGG" -> "LNAGG" -"StreamAggregate(a:Type)" -> "LinearAggregate(a:Type)" -@ -<>= -)abbrev category STAGG StreamAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A stream aggregate is a linear aggregate which possibly has an infinite -++ number of elements. A basic domain constructor which builds stream -++ aggregates is \spadtype{Stream}. From streams, a number of infinite -++ structures such power series can be built. A stream aggregate may -++ also be infinite since it may be cyclic. -++ For example, see \spadtype{DecimalExpansion}. -StreamAggregate(S:Type): Category == - Join(UnaryRecursiveAggregate S, LinearAggregate S) with - explicitlyFinite?: % -> Boolean - ++ explicitlyFinite?(s) tests if the stream has a finite - ++ number of elements, and false otherwise. - ++ Note: for many datatypes, \axiom{explicitlyFinite?(s) = not possiblyInfinite?(s)}. - possiblyInfinite?: % -> Boolean - ++ possiblyInfinite?(s) tests if the stream s could possibly - ++ have an infinite number of elements. - ++ Note: for many datatypes, \axiom{possiblyInfinite?(s) = not explictlyFinite?(s)}. - add - c2: (%, %) -> S - - explicitlyFinite? x == not cyclic? x - possiblyInfinite? x == cyclic? x - first(x, n) == construct [c2(x, x := rest x) for i in 1..n] - - c2(x, r) == - empty? x => error "Index out of range" - first x - - elt(x:%, i:Integer) == - i := i - minIndex x - (i < 0) or empty?(x := rest(x, i::NonNegativeInteger)) => error "index out of range" - first x - - elt(x:%, i:UniversalSegment(Integer)) == - l := lo(i) - minIndex x - l < 0 => error "index out of range" - not hasHi i => copy(rest(x, l::NonNegativeInteger)) - (h := hi(i) - minIndex x) < l => empty() - first(rest(x, l::NonNegativeInteger), (h - l + 1)::NonNegativeInteger) - - if % has shallowlyMutable then - concat(x:%, y:%) == concat_!(copy x, y) - - concat l == - empty? l => empty() - concat_!(copy first l, concat rest l) - - map_!(f, l) == - y := l - while not empty? l repeat - setfirst_!(l, f first l) - l := rest l - y - - fill_!(x, s) == - y := x - while not empty? y repeat (setfirst_!(y, s); y := rest y) - x - - setelt(x:%, i:Integer, s:S) == - i := i - minIndex x - (i < 0) or empty?(x := rest(x,i::NonNegativeInteger)) => error "index out of range" - setfirst_!(x, s) - - setelt(x:%, i:UniversalSegment(Integer), s:S) == - (l := lo(i) - minIndex x) < 0 => error "index out of range" - h := if hasHi i then hi(i) - minIndex x else maxIndex x - h < l => s - y := rest(x, l::NonNegativeInteger) - z := rest(y, (h - l + 1)::NonNegativeInteger) - while not eq?(y, z) repeat (setfirst_!(y, s); y := rest y) - s - - concat_!(x:%, y:%) == - empty? x => y - setrest_!(tail x, y) - x - -@ -\section{STAGG.lsp BOOTSTRAP} -{\bf STAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf STAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf STAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |StreamAggregate;CAT| (QUOTE NIL)) - -(SETQ |StreamAggregate;AL| (QUOTE NIL)) - -(DEFUN |StreamAggregate| (#1=#:G87035) (LET (#2=#:G87036) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |StreamAggregate;AL|)) (CDR #2#)) (T (SETQ |StreamAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|StreamAggregate;| #1#))) |StreamAggregate;AL|)) #2#)))) - -(DEFUN |StreamAggregate;| (|t#1|) (PROG (#1=#:G87034) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|StreamAggregate;CAT|) ((QUOTE T) (LETT |StreamAggregate;CAT| (|Join| (|UnaryRecursiveAggregate| (QUOTE |t#1|)) (|LinearAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|explicitlyFinite?| ((|Boolean|) |$|)) T) ((|possiblyInfinite?| ((|Boolean|) |$|)) T))) NIL (QUOTE ((|Boolean|))) NIL)) . #2=(|StreamAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |StreamAggregate|) (|devaluate| |t#1|))))))) -@ -\section{STAGG-.lsp BOOTSTRAP} -{\bf STAGG-} depends on {\bf STAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf STAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf STAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |STAGG-;explicitlyFinite?;AB;1| (|x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 9)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) - -(DEFUN |STAGG-;possiblyInfinite?;AB;2| (|x| |$|) (SPADCALL |x| (QREFELT |$| 9))) - -(DEFUN |STAGG-;first;ANniA;3| (|x| |n| |$|) (PROG (#1=#:G87053 |i|) (RETURN (SEQ (SPADCALL (PROGN (LETT #1# NIL |STAGG-;first;ANniA;3|) (SEQ (LETT |i| 1 |STAGG-;first;ANniA;3|) G190 (COND ((QSGREATERP |i| |n|) (GO G191))) (SEQ (EXIT (LETT #1# (CONS (|STAGG-;c2| |x| (LETT |x| (SPADCALL |x| (QREFELT |$| 12)) |STAGG-;first;ANniA;3|) |$|) #1#) |STAGG-;first;ANniA;3|))) (LETT |i| (QSADD1 |i|) |STAGG-;first;ANniA;3|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))) (QREFELT |$| 14)))))) - -(DEFUN |STAGG-;c2| (|x| |r| |$|) (COND ((SPADCALL |x| (QREFELT |$| 17)) (|error| "Index out of range")) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 18))))) - -(DEFUN |STAGG-;elt;AIS;5| (|x| |i| |$|) (PROG (#1=#:G87056) (RETURN (SEQ (LETT |i| (|-| |i| (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;elt;AIS;5|) (COND ((OR (|<| |i| 0) (SPADCALL (LETT |x| (SPADCALL |x| (PROG1 (LETT #1# |i| |STAGG-;elt;AIS;5|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) |STAGG-;elt;AIS;5|) (QREFELT |$| 17))) (EXIT (|error| "index out of range")))) (EXIT (SPADCALL |x| (QREFELT |$| 18))))))) - -(DEFUN |STAGG-;elt;AUsA;6| (|x| |i| |$|) (PROG (|l| #1=#:G87060 |h| #2=#:G87062 #3=#:G87063) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |i| (QREFELT |$| 24)) (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;elt;AUsA;6|) (EXIT (COND ((|<| |l| 0) (|error| "index out of range")) ((NULL (SPADCALL |i| (QREFELT |$| 25))) (SPADCALL (SPADCALL |x| (PROG1 (LETT #1# |l| |STAGG-;elt;AUsA;6|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) (QREFELT |$| 26))) ((QUOTE T) (SEQ (LETT |h| (|-| (SPADCALL |i| (QREFELT |$| 27)) (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;elt;AUsA;6|) (EXIT (COND ((|<| |h| |l|) (SPADCALL (QREFELT |$| 28))) ((QUOTE T) (SPADCALL (SPADCALL |x| (PROG1 (LETT #2# |l| |STAGG-;elt;AUsA;6|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) (QREFELT |$| 21)) (PROG1 (LETT #3# (|+| (|-| |h| |l|) 1) |STAGG-;elt;AUsA;6|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)) (QREFELT |$| 29))))))))))))) - -(DEFUN |STAGG-;concat;3A;7| (|x| |y| |$|) (SPADCALL (SPADCALL |x| (QREFELT |$| 26)) |y| (QREFELT |$| 31))) - -(DEFUN |STAGG-;concat;LA;8| (|l| |$|) (COND ((NULL |l|) (SPADCALL (QREFELT |$| 28))) ((QUOTE T) (SPADCALL (SPADCALL (|SPADfirst| |l|) (QREFELT |$| 26)) (SPADCALL (CDR |l|) (QREFELT |$| 34)) (QREFELT |$| 31))))) - -(DEFUN |STAGG-;map!;M2A;9| (|f| |l| |$|) (PROG (|y|) (RETURN (SEQ (LETT |y| |l| |STAGG-;map!;M2A;9|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |l| (QREFELT |$| 17)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |l| (SPADCALL (SPADCALL |l| (QREFELT |$| 18)) |f|) (QREFELT |$| 36)) (EXIT (LETT |l| (SPADCALL |l| (QREFELT |$| 12)) |STAGG-;map!;M2A;9|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))))) - -(DEFUN |STAGG-;fill!;ASA;10| (|x| |s| |$|) (PROG (|y|) (RETURN (SEQ (LETT |y| |x| |STAGG-;fill!;ASA;10|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 17)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |y| |s| (QREFELT |$| 36)) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 12)) |STAGG-;fill!;ASA;10|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) - -(DEFUN |STAGG-;setelt;AI2S;11| (|x| |i| |s| |$|) (PROG (#1=#:G87081) (RETURN (SEQ (LETT |i| (|-| |i| (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;setelt;AI2S;11|) (COND ((OR (|<| |i| 0) (SPADCALL (LETT |x| (SPADCALL |x| (PROG1 (LETT #1# |i| |STAGG-;setelt;AI2S;11|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) |STAGG-;setelt;AI2S;11|) (QREFELT |$| 17))) (EXIT (|error| "index out of range")))) (EXIT (SPADCALL |x| |s| (QREFELT |$| 36))))))) - -(DEFUN |STAGG-;setelt;AUs2S;12| (|x| |i| |s| |$|) (PROG (|l| |h| #1=#:G87086 #2=#:G87087 |z| |y|) (RETURN (SEQ (LETT |l| (|-| (SPADCALL |i| (QREFELT |$| 24)) (SPADCALL |x| (QREFELT |$| 20))) |STAGG-;setelt;AUs2S;12|) (EXIT (COND ((|<| |l| 0) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |h| (COND ((SPADCALL |i| (QREFELT |$| 25)) (|-| (SPADCALL |i| (QREFELT |$| 27)) (SPADCALL |x| (QREFELT |$| 20)))) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 41)))) |STAGG-;setelt;AUs2S;12|) (EXIT (COND ((|<| |h| |l|) |s|) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# |l| |STAGG-;setelt;AUs2S;12|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 21)) |STAGG-;setelt;AUs2S;12|) (LETT |z| (SPADCALL |y| (PROG1 (LETT #2# (|+| (|-| |h| |l|) 1) |STAGG-;setelt;AUs2S;12|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) (QREFELT |$| 21)) |STAGG-;setelt;AUs2S;12|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| |z| (QREFELT |$| 42)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |y| |s| (QREFELT |$| 36)) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 12)) |STAGG-;setelt;AUs2S;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |s|))))))))))))) - -(DEFUN |STAGG-;concat!;3A;13| (|x| |y| |$|) (SEQ (COND ((SPADCALL |x| (QREFELT |$| 17)) |y|) ((QUOTE T) (SEQ (SPADCALL (SPADCALL |x| (QREFELT |$| 44)) |y| (QREFELT |$| 45)) (EXIT |x|)))))) - -(DEFUN |StreamAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|StreamAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |StreamAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 51) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasAttribute| |#1| (QUOTE |shallowlyMutable|)) (PROGN (QSETREFV |$| 32 (CONS (|dispatchFunction| |STAGG-;concat;3A;7|) |$|)) (QSETREFV |$| 35 (CONS (|dispatchFunction| |STAGG-;concat;LA;8|) |$|)) (QSETREFV |$| 38 (CONS (|dispatchFunction| |STAGG-;map!;M2A;9|) |$|)) (QSETREFV |$| 39 (CONS (|dispatchFunction| |STAGG-;fill!;ASA;10|) |$|)) (QSETREFV |$| 40 (CONS (|dispatchFunction| |STAGG-;setelt;AI2S;11|) |$|)) (QSETREFV |$| 43 (CONS (|dispatchFunction| |STAGG-;setelt;AUs2S;12|) |$|)) (QSETREFV |$| 46 (CONS (|dispatchFunction| |STAGG-;concat!;3A;13|) |$|))))) |$|)))) - -(MAKEPROP (QUOTE |StreamAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|Boolean|) (0 . |cyclic?|) |STAGG-;explicitlyFinite?;AB;1| |STAGG-;possiblyInfinite?;AB;2| (5 . |rest|) (|List| 7) (10 . |construct|) (|NonNegativeInteger|) |STAGG-;first;ANniA;3| (15 . |empty?|) (20 . |first|) (|Integer|) (25 . |minIndex|) (30 . |rest|) |STAGG-;elt;AIS;5| (|UniversalSegment| 19) (36 . |lo|) (41 . |hasHi|) (46 . |copy|) (51 . |hi|) (56 . |empty|) (60 . |first|) |STAGG-;elt;AUsA;6| (66 . |concat!|) (72 . |concat|) (|List| |$|) (78 . |concat|) (83 . |concat|) (88 . |setfirst!|) (|Mapping| 7 7) (94 . |map!|) (100 . |fill!|) (106 . |setelt|) (113 . |maxIndex|) (118 . |eq?|) (124 . |setelt|) (131 . |tail|) (136 . |setrest!|) (142 . |concat!|) (QUOTE "rest") (QUOTE "last") (QUOTE "first") (QUOTE "value"))) (QUOTE #(|setelt| 148 |possiblyInfinite?| 162 |map!| 167 |first| 173 |fill!| 179 |explicitlyFinite?| 185 |elt| 190 |concat!| 202 |concat| 208)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 46 (QUOTE (1 6 8 0 9 1 6 0 0 12 1 6 0 13 14 1 6 8 0 17 1 6 7 0 18 1 6 19 0 20 2 6 0 0 15 21 1 23 19 0 24 1 23 8 0 25 1 6 0 0 26 1 23 19 0 27 0 6 0 28 2 6 0 0 15 29 2 6 0 0 0 31 2 0 0 0 0 32 1 6 0 33 34 1 0 0 33 35 2 6 7 0 7 36 2 0 0 37 0 38 2 0 0 0 7 39 3 0 7 0 19 7 40 1 6 19 0 41 2 6 8 0 0 42 3 0 7 0 23 7 43 1 6 0 0 44 2 6 0 0 0 45 2 0 0 0 0 46 3 0 7 0 19 7 40 3 0 7 0 23 7 43 1 0 8 0 11 2 0 0 37 0 38 2 0 0 0 15 16 2 0 0 0 7 39 1 0 8 0 10 2 0 7 0 19 22 2 0 0 0 23 30 2 0 0 0 0 46 1 0 0 33 35 2 0 0 0 0 32)))))) (QUOTE |lookupComplete|))) -@ -\section{category LNAGG LinearAggregate} -<>= -"LNAGG" -> "IXAGG" -"LinearAggregate(a:Type)" -> "IndexedAggregate(b:Integer,a:Type)" -"LNAGG" -> "CLAGG" -"LinearAggregate(a:Type)" -> "Collection(a:Type)" -@ -<>= -)abbrev category LNAGG LinearAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A linear aggregate is an aggregate whose elements are indexed by integers. -++ Examples of linear aggregates are strings, lists, and -++ arrays. -++ Most of the exported operations for linear aggregates are non-destructive -++ but are not always efficient for a particular aggregate. -++ For example, \spadfun{concat} of two lists needs only to copy its first -++ argument, whereas \spadfun{concat} of two arrays needs to copy both arguments. -++ Most of the operations exported here apply to infinite objects (e.g. streams) -++ as well to finite ones. -++ For finite linear aggregates, see \spadtype{FiniteLinearAggregate}. -LinearAggregate(S:Type): Category == - Join(IndexedAggregate(Integer, S), Collection(S)) with - new : (NonNegativeInteger,S) -> % - ++ new(n,x) returns \axiom{fill!(new n,x)}. - concat: (%,S) -> % - ++ concat(u,x) returns aggregate u with additional element x at the end. - ++ Note: for lists, \axiom{concat(u,x) == concat(u,[x])} - concat: (S,%) -> % - ++ concat(x,u) returns aggregate u with additional element at the front. - ++ Note: for lists: \axiom{concat(x,u) == concat([x],u)}. - concat: (%,%) -> % - ++ concat(u,v) returns an aggregate consisting of the elements of u - ++ followed by the elements of v. - ++ Note: if \axiom{w = concat(u,v)} then \axiom{w.i = u.i for i in indices u} - ++ and \axiom{w.(j + maxIndex u) = v.j for j in indices v}. - concat: List % -> % - ++ concat(u), where u is a lists of aggregates \axiom{[a,b,...,c]}, returns - ++ a single aggregate consisting of the elements of \axiom{a} - ++ followed by those - ++ of b followed ... by the elements of c. - ++ Note: \axiom{concat(a,b,...,c) = concat(a,concat(b,...,c))}. - map: ((S,S)->S,%,%) -> % - ++ map(f,u,v) returns a new collection w with elements \axiom{z = f(x,y)} - ++ for corresponding elements x and y from u and v. - ++ Note: for linear aggregates, \axiom{w.i = f(u.i,v.i)}. - elt: (%,UniversalSegment(Integer)) -> % - ++ elt(u,i..j) (also written: \axiom{a(i..j)}) returns the aggregate of - ++ elements \axiom{u} for k from i to j in that order. - ++ Note: in general, \axiom{a.s = [a.k for i in s]}. - delete: (%,Integer) -> % - ++ delete(u,i) returns a copy of u with the \axiom{i}th element deleted. - ++ Note: for lists, \axiom{delete(a,i) == concat(a(0..i - 1),a(i + 1,..))}. - delete: (%,UniversalSegment(Integer)) -> % - ++ delete(u,i..j) returns a copy of u with the \axiom{i}th through - ++ \axiom{j}th element deleted. - ++ Note: \axiom{delete(a,i..j) = concat(a(0..i-1),a(j+1..))}. - insert: (S,%,Integer) -> % - ++ insert(x,u,i) returns a copy of u having x as its \axiom{i}th element. - ++ Note: \axiom{insert(x,a,k) = concat(concat(a(0..k-1),x),a(k..))}. - insert: (%,%,Integer) -> % - ++ insert(v,u,k) returns a copy of u having v inserted beginning at the - ++ \axiom{i}th element. - ++ Note: \axiom{insert(v,u,k) = concat( u(0..k-1), v, u(k..) )}. - if % has shallowlyMutable then setelt: (%,UniversalSegment(Integer),S) -> S - ++ setelt(u,i..j,x) (also written: \axiom{u(i..j) := x}) destructively - ++ replaces each element in the segment \axiom{u(i..j)} by x. - ++ The value x is returned. - ++ Note: u is destructively change so - ++ that \axiom{u.k := x for k in i..j}; - ++ its length remains unchanged. - add - indices a == [i for i in minIndex a .. maxIndex a] - index?(i, a) == i >= minIndex a and i <= maxIndex a - concat(a:%, x:S) == concat(a, new(1, x)) - concat(x:S, y:%) == concat(new(1, x), y) - insert(x:S, a:%, i:Integer) == insert(new(1, x), a, i) - if % has finiteAggregate then - maxIndex l == #l - 1 + minIndex l - ---if % has shallowlyMutable then new(n, s) == fill_!(new n, s) - -@ -\section{LNAGG.lsp BOOTSTRAP} -{\bf LNAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LNAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LNAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |LinearAggregate;CAT| (QUOTE NIL)) - -(SETQ |LinearAggregate;AL| (QUOTE NIL)) - -(DEFUN |LinearAggregate| (#1=#:G85818) (LET (#2=#:G85819) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |LinearAggregate;AL|)) (CDR #2#)) (T (SETQ |LinearAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|LinearAggregate;| #1#))) |LinearAggregate;AL|)) #2#)))) - -(DEFUN |LinearAggregate;| (|t#1|) (PROG (#1=#:G85817) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (|sublisV| (PAIR (QUOTE (#2=#:G85816)) (LIST (QUOTE (|Integer|)))) (COND (|LinearAggregate;CAT|) ((QUOTE T) (LETT |LinearAggregate;CAT| (|Join| (|IndexedAggregate| (QUOTE #2#) (QUOTE |t#1|)) (|Collection| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|new| (|$| (|NonNegativeInteger|) |t#1|)) T) ((|concat| (|$| |$| |t#1|)) T) ((|concat| (|$| |t#1| |$|)) T) ((|concat| (|$| |$| |$|)) T) ((|concat| (|$| (|List| |$|))) T) ((|map| (|$| (|Mapping| |t#1| |t#1| |t#1|) |$| |$|)) T) ((|elt| (|$| |$| (|UniversalSegment| (|Integer|)))) T) ((|delete| (|$| |$| (|Integer|))) T) ((|delete| (|$| |$| (|UniversalSegment| (|Integer|)))) T) ((|insert| (|$| |t#1| |$| (|Integer|))) T) ((|insert| (|$| |$| |$| (|Integer|))) T) ((|setelt| (|t#1| |$| (|UniversalSegment| (|Integer|)) |t#1|)) (|has| |$| (ATTRIBUTE |shallowlyMutable|))))) NIL (QUOTE ((|UniversalSegment| (|Integer|)) (|Integer|) (|List| |$|) (|NonNegativeInteger|))) NIL)) . #3=(|LinearAggregate|)))))) . #3#) (SETELT #1# 0 (LIST (QUOTE |LinearAggregate|) (|devaluate| |t#1|))))))) -@ -\section{LNAGG-.lsp BOOTSTRAP} -{\bf LNAGG-} depends on {\bf LNAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LNAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LNAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |LNAGG-;indices;AL;1| (|a| |$|) (PROG (#1=#:G85833 |i| #2=#:G85834) (RETURN (SEQ (PROGN (LETT #1# NIL |LNAGG-;indices;AL;1|) (SEQ (LETT |i| (SPADCALL |a| (QREFELT |$| 9)) |LNAGG-;indices;AL;1|) (LETT #2# (SPADCALL |a| (QREFELT |$| 10)) |LNAGG-;indices;AL;1|) G190 (COND ((|>| |i| #2#) (GO G191))) (SEQ (EXIT (LETT #1# (CONS |i| #1#) |LNAGG-;indices;AL;1|))) (LETT |i| (|+| |i| 1) |LNAGG-;indices;AL;1|) (GO G190) G191 (EXIT (NREVERSE0 #1#)))))))) - -(DEFUN |LNAGG-;index?;IAB;2| (|i| |a| |$|) (COND ((OR (|<| |i| (SPADCALL |a| (QREFELT |$| 9))) (|<| (SPADCALL |a| (QREFELT |$| 10)) |i|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) - -(DEFUN |LNAGG-;concat;ASA;3| (|a| |x| |$|) (SPADCALL |a| (SPADCALL 1 |x| (QREFELT |$| 16)) (QREFELT |$| 17))) - -(DEFUN |LNAGG-;concat;S2A;4| (|x| |y| |$|) (SPADCALL (SPADCALL 1 |x| (QREFELT |$| 16)) |y| (QREFELT |$| 17))) - -(DEFUN |LNAGG-;insert;SAIA;5| (|x| |a| |i| |$|) (SPADCALL (SPADCALL 1 |x| (QREFELT |$| 16)) |a| |i| (QREFELT |$| 20))) - -(DEFUN |LNAGG-;maxIndex;AI;6| (|l| |$|) (|+| (|-| (SPADCALL |l| (QREFELT |$| 22)) 1) (SPADCALL |l| (QREFELT |$| 9)))) - -(DEFUN |LinearAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|LinearAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |LinearAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 25) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasAttribute| |#1| (QUOTE |shallowlyMutable|)))) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasAttribute| |#1| (QUOTE |finiteAggregate|)) (QSETREFV |$| 23 (CONS (|dispatchFunction| |LNAGG-;maxIndex;AI;6|) |$|)))) |$|)))) - -(MAKEPROP (QUOTE |LinearAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|Integer|) (0 . |minIndex|) (5 . |maxIndex|) (|List| 8) |LNAGG-;indices;AL;1| (|Boolean|) |LNAGG-;index?;IAB;2| (|NonNegativeInteger|) (10 . |new|) (16 . |concat|) |LNAGG-;concat;ASA;3| |LNAGG-;concat;S2A;4| (22 . |insert|) |LNAGG-;insert;SAIA;5| (29 . |#|) (34 . |maxIndex|) (|List| |$|))) (QUOTE #(|maxIndex| 39 |insert| 44 |indices| 51 |index?| 56 |concat| 62)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 23 (QUOTE (1 6 8 0 9 1 6 8 0 10 2 6 0 15 7 16 2 6 0 0 0 17 3 6 0 0 0 8 20 1 6 15 0 22 1 0 8 0 23 1 0 8 0 23 3 0 0 7 0 8 21 1 0 11 0 12 2 0 13 8 0 14 2 0 0 0 7 18 2 0 0 7 0 19)))))) (QUOTE |lookupComplete|))) -@ -\section{category FLAGG FiniteLinearAggregate} -<>= -"FLAGG" -> "LNAGG" -"FiniteLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)" -@ -<>= -)abbrev category FLAGG FiniteLinearAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A finite linear aggregate is a linear aggregate of finite length. -++ The finite property of the aggregate adds several exports to the -++ list of exports from \spadtype{LinearAggregate} such as -++ \spadfun{reverse}, \spadfun{sort}, and so on. -FiniteLinearAggregate(S:Type): Category == LinearAggregate S with - finiteAggregate - merge: ((S,S)->Boolean,%,%) -> % - ++ merge(p,a,b) returns an aggregate c which merges \axiom{a} and b. - ++ The result is produced by examining each element x of \axiom{a} and y - ++ of b successively. If \axiom{p(x,y)} is true, then x is inserted into - ++ the result; otherwise y is inserted. If x is chosen, the next element - ++ of \axiom{a} is examined, and so on. When all the elements of one - ++ aggregate are examined, the remaining elements of the other - ++ are appended. - ++ For example, \axiom{merge(<,[1,3],[2,7,5])} returns \axiom{[1,2,3,7,5]}. - reverse: % -> % - ++ reverse(a) returns a copy of \axiom{a} with elements in reverse order. - sort: ((S,S)->Boolean,%) -> % - ++ sort(p,a) returns a copy of \axiom{a} sorted using total ordering predicate p. - sorted?: ((S,S)->Boolean,%) -> Boolean - ++ sorted?(p,a) tests if \axiom{a} is sorted according to predicate p. - position: (S->Boolean, %) -> Integer - ++ position(p,a) returns the index i of the first x in \axiom{a} such that - ++ \axiom{p(x)} is true, and \axiom{minIndex(a) - 1} if there is no such x. - if S has SetCategory then - position: (S, %) -> Integer - ++ position(x,a) returns the index i of the first occurrence of x in a, - ++ and \axiom{minIndex(a) - 1} if there is no such x. - position: (S,%,Integer) -> Integer - ++ position(x,a,n) returns the index i of the first occurrence of x in - ++ \axiom{a} where \axiom{i >= n}, and \axiom{minIndex(a) - 1} if no such x is found. - if S has OrderedSet then - OrderedSet - merge: (%,%) -> % - ++ merge(u,v) merges u and v in ascending order. - ++ Note: \axiom{merge(u,v) = merge(<=,u,v)}. - sort: % -> % - ++ sort(u) returns an u with elements in ascending order. - ++ Note: \axiom{sort(u) = sort(<=,u)}. - sorted?: % -> Boolean - ++ sorted?(u) tests if the elements of u are in ascending order. - if % has shallowlyMutable then - copyInto_!: (%,%,Integer) -> % - ++ copyInto!(u,v,i) returns aggregate u containing a copy of - ++ v inserted at element i. - reverse_!: % -> % - ++ reverse!(u) returns u with its elements in reverse order. - sort_!: ((S,S)->Boolean,%) -> % - ++ sort!(p,u) returns u with its elements ordered by p. - if S has OrderedSet then sort_!: % -> % - ++ sort!(u) returns u with its elements in ascending order. - add - if S has SetCategory then - position(x:S, t:%) == position(x, t, minIndex t) - - if S has OrderedSet then --- sorted? l == sorted?(_<$S, l) - sorted? l == sorted?(#1 < #2 or #1 = #2, l) - merge(x, y) == merge(_<$S, x, y) - sort l == sort(_<$S, l) - - if % has shallowlyMutable then - reverse x == reverse_! copy x - sort(f, l) == sort_!(f, copy l) - reverse x == reverse_! copy x - - if S has OrderedSet then - sort_! l == sort_!(_<$S, l) - -@ -\section{category A1AGG OneDimensionalArrayAggregate} -<>= -"A1AGG" -> "FLAGG" -"OneDimensionalArrayAggregate(a:Type)" -> - "FiniteLinearAggregate(a:Type)" -"OneDimensionalArrayAggregate(Character)" -> - "OneDimensionalArrayAggregate(a:Type)" -"OneDimensionalArrayAggregate(Boolean)" -> - "OneDimensionalArrayAggregate(a:Type)" -@ -<>= -)abbrev category A1AGG OneDimensionalArrayAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ One-dimensional-array aggregates serves as models for one-dimensional arrays. -++ Categorically, these aggregates are finite linear aggregates -++ with the \spadatt{shallowlyMutable} property, that is, any component of -++ the array may be changed without affecting the -++ identity of the overall array. -++ Array data structures are typically represented by a fixed area in storage and -++ therefore cannot efficiently grow or shrink on demand as can list structures -++ (see however \spadtype{FlexibleArray} for a data structure which -++ is a cross between a list and an array). -++ Iteration over, and access to, elements of arrays is extremely fast -++ (and often can be optimized to open-code). -++ Insertion and deletion however is generally slow since an entirely new -++ data structure must be created for the result. -OneDimensionalArrayAggregate(S:Type): Category == - FiniteLinearAggregate S with shallowlyMutable - add - parts x == [qelt(x, i) for i in minIndex x .. maxIndex x] - sort_!(f, a) == quickSort(f, a)$FiniteLinearAggregateSort(S, %) - - any?(f, a) == - for i in minIndex a .. maxIndex a repeat - f qelt(a, i) => return true - false - - every?(f, a) == - for i in minIndex a .. maxIndex a repeat - not(f qelt(a, i)) => return false - true - - position(f:S -> Boolean, a:%) == - for i in minIndex a .. maxIndex a repeat - f qelt(a, i) => return i - minIndex(a) - 1 - - find(f, a) == - for i in minIndex a .. maxIndex a repeat - f qelt(a, i) => return qelt(a, i) - "failed" - - count(f:S->Boolean, a:%) == - n:NonNegativeInteger := 0 - for i in minIndex a .. maxIndex a repeat - if f(qelt(a, i)) then n := n+1 - n - - map_!(f, a) == - for i in minIndex a .. maxIndex a repeat - qsetelt_!(a, i, f qelt(a, i)) - a - - setelt(a:%, s:UniversalSegment(Integer), x:S) == - l := lo s; h := if hasHi s then hi s else maxIndex a - l < minIndex a or h > maxIndex a => error "index out of range" - for k in l..h repeat qsetelt_!(a, k, x) - x - - reduce(f, a) == - empty? a => error "cannot reduce an empty aggregate" - r := qelt(a, m := minIndex a) - for k in m+1 .. maxIndex a repeat r := f(r, qelt(a, k)) - r - - reduce(f, a, identity) == - for k in minIndex a .. maxIndex a repeat - identity := f(identity, qelt(a, k)) - identity - - if S has SetCategory then - reduce(f, a, identity,absorber) == - for k in minIndex a .. maxIndex a while identity ^= absorber - repeat identity := f(identity, qelt(a, k)) - identity - --- this is necessary since new has disappeared. - stupidnew: (NonNegativeInteger, %, %) -> % - stupidget: List % -> S --- a and b are not both empty if n > 0 - stupidnew(n, a, b) == - zero? n => empty() - new(n, (empty? a => qelt(b, minIndex b); qelt(a, minIndex a))) --- at least one element of l must be non-empty - stupidget l == - for a in l repeat - not empty? a => return first a - error "Should not happen" - - map(f, a, b) == - m := max(minIndex a, minIndex b) - n := min(maxIndex a, maxIndex b) - l := max(0, n - m + 1)::NonNegativeInteger - c := stupidnew(l, a, b) - for i in minIndex(c).. for j in m..n repeat - qsetelt_!(c, i, f(qelt(a, j), qelt(b, j))) - c - --- map(f, a, b, x) == --- m := min(minIndex a, minIndex b) --- n := max(maxIndex a, maxIndex b) --- l := (n - m + 1)::NonNegativeInteger --- c := new l --- for i in minIndex(c).. for j in m..n repeat --- qsetelt_!(c, i, f(a(j, x), b(j, x))) --- c - - merge(f, a, b) == - r := stupidnew(#a + #b, a, b) - i := minIndex a - m := maxIndex a - j := minIndex b - n := maxIndex b - for k in minIndex(r).. while i <= m and j <= n repeat - if f(qelt(a, i), qelt(b, j)) then - qsetelt_!(r, k, qelt(a, i)) - i := i+1 - else - qsetelt_!(r, k, qelt(b, j)) - j := j+1 - for k in k.. for i in i..m repeat qsetelt_!(r, k, elt(a, i)) - for k in k.. for j in j..n repeat qsetelt_!(r, k, elt(b, j)) - r - - elt(a:%, s:UniversalSegment(Integer)) == - l := lo s - h := if hasHi s then hi s else maxIndex a - l < minIndex a or h > maxIndex a => error "index out of range" - r := stupidnew(max(0, h - l + 1)::NonNegativeInteger, a, a) - for k in minIndex r.. for i in l..h repeat - qsetelt_!(r, k, qelt(a, i)) - r - - insert(a:%, b:%, i:Integer) == - m := minIndex b - n := maxIndex b - i < m or i > n => error "index out of range" - y := stupidnew(#a + #b, a, b) - for k in minIndex y.. for j in m..i-1 repeat - qsetelt_!(y, k, qelt(b, j)) - for k in k.. for j in minIndex a .. maxIndex a repeat - qsetelt_!(y, k, qelt(a, j)) - for k in k.. for j in i..n repeat qsetelt_!(y, k, qelt(b, j)) - y - - copy x == - y := stupidnew(#x, x, x) - for i in minIndex x .. maxIndex x for j in minIndex y .. repeat - qsetelt_!(y, j, qelt(x, i)) - y - - copyInto_!(y, x, s) == - s < minIndex y or s + #x > maxIndex y + 1 => - error "index out of range" - for i in minIndex x .. maxIndex x for j in s.. repeat - qsetelt_!(y, j, qelt(x, i)) - y - - construct l == --- a := new(#l) - empty? l => empty() - a := new(#l, first l) - for i in minIndex(a).. for x in l repeat qsetelt_!(a, i, x) - a - - delete(a:%, s:UniversalSegment(Integer)) == - l := lo s; h := if hasHi s then hi s else maxIndex a - l < minIndex a or h > maxIndex a => error "index out of range" - h < l => copy a - r := stupidnew((#a - h + l - 1)::NonNegativeInteger, a, a) - for k in minIndex(r).. for i in minIndex a..l-1 repeat - qsetelt_!(r, k, qelt(a, i)) - for k in k.. for i in h+1 .. maxIndex a repeat - qsetelt_!(r, k, qelt(a, i)) - r - - delete(x:%, i:Integer) == - i < minIndex x or i > maxIndex x => error "index out of range" - y := stupidnew((#x - 1)::NonNegativeInteger, x, x) - for i in minIndex(y).. for j in minIndex x..i-1 repeat - qsetelt_!(y, i, qelt(x, j)) - for i in i .. for j in i+1 .. maxIndex x repeat - qsetelt_!(y, i, qelt(x, j)) - y - - reverse_! x == - m := minIndex x - n := maxIndex x - for i in 0..((n-m) quo 2) repeat swap_!(x, m+i, n-i) - x - - concat l == - empty? l => empty() - n := _+/[#a for a in l] - i := minIndex(r := new(n, stupidget l)) - for a in l repeat - copyInto_!(r, a, i) - i := i + #a - r - - sorted?(f, a) == - for i in minIndex(a)..maxIndex(a)-1 repeat - not f(qelt(a, i), qelt(a, i + 1)) => return false - true - - concat(x:%, y:%) == - z := stupidnew(#x + #y, x, y) - copyInto_!(z, x, i := minIndex z) - copyInto_!(z, y, i + #x) - z - - if S has SetCategory then - x = y == - #x ^= #y => false - for i in minIndex x .. maxIndex x repeat - not(qelt(x, i) = qelt(y, i)) => return false - true - - coerce(r:%):OutputForm == - bracket commaSeparate - [qelt(r, k)::OutputForm for k in minIndex r .. maxIndex r] - - position(x:S, t:%, s:Integer) == - n := maxIndex t - s < minIndex t or s > n => error "index out of range" - for k in s..n repeat - qelt(t, k) = x => return k - minIndex(t) - 1 - - if S has OrderedSet then - a < b == - for i in minIndex a .. maxIndex a - for j in minIndex b .. maxIndex b repeat - qelt(a, i) ^= qelt(b, j) => return a.i < b.j - #a < #b - - -@ -\section{category ELAGG ExtensibleLinearAggregate} -<>= -"ELAGG" -> "LNAGG" -"ExtensibleLinearAggregate(a:Type)" -> "LinearAggregate(a:Type)" -@ -<>= -)abbrev category ELAGG ExtensibleLinearAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ An extensible aggregate is one which allows insertion and deletion of entries. -++ These aggregates are models of lists and streams which are represented -++ by linked structures so as to make insertion, deletion, and -++ concatenation efficient. However, access to elements of these -++ extensible aggregates is generally slow since access is made from the end. -++ See \spadtype{FlexibleArray} for an exception. -ExtensibleLinearAggregate(S:Type):Category == LinearAggregate S with - shallowlyMutable - concat_!: (%,S) -> % - ++ concat!(u,x) destructively adds element x to the end of u. - concat_!: (%,%) -> % - ++ concat!(u,v) destructively appends v to the end of u. - ++ v is unchanged - delete_!: (%,Integer) -> % - ++ delete!(u,i) destructively deletes the \axiom{i}th element of u. - ++ - ++E Data:=Record(age:Integer,gender:String) - ++E a1:AssociationList(String,Data):=table() - ++E a1."tim":=[55,"male"]$Data - ++E delete!(a1,1) - - delete_!: (%,UniversalSegment(Integer)) -> % - ++ delete!(u,i..j) destructively deletes elements u.i through u.j. - remove_!: (S->Boolean,%) -> % - ++ remove!(p,u) destructively removes all elements x of - ++ u such that \axiom{p(x)} is true. - insert_!: (S,%,Integer) -> % - ++ insert!(x,u,i) destructively inserts x into u at position i. - insert_!: (%,%,Integer) -> % - ++ insert!(v,u,i) destructively inserts aggregate v into u at position i. - merge_!: ((S,S)->Boolean,%,%) -> % - ++ merge!(p,u,v) destructively merges u and v using predicate p. - select_!: (S->Boolean,%) -> % - ++ select!(p,u) destructively changes u by keeping only values x such that - ++ \axiom{p(x)}. - if S has SetCategory then - remove_!: (S,%) -> % - ++ remove!(x,u) destructively removes all values x from u. - removeDuplicates_!: % -> % - ++ removeDuplicates!(u) destructively removes duplicates from u. - if S has OrderedSet then merge_!: (%,%) -> % - ++ merge!(u,v) destructively merges u and v in ascending order. - add - delete(x:%, i:Integer) == delete_!(copy x, i) - delete(x:%, i:UniversalSegment(Integer)) == delete_!(copy x, i) - remove(f:S -> Boolean, x:%) == remove_!(f, copy x) - insert(s:S, x:%, i:Integer) == insert_!(s, copy x, i) - insert(w:%, x:%, i:Integer) == insert_!(copy w, copy x, i) - select(f, x) == select_!(f, copy x) - concat(x:%, y:%) == concat_!(copy x, y) - concat(x:%, y:S) == concat_!(copy x, new(1, y)) - concat_!(x:%, y:S) == concat_!(x, new(1, y)) - if S has SetCategory then - remove(s:S, x:%) == remove_!(s, copy x) - remove_!(s:S, x:%) == remove_!(#1 = s, x) - removeDuplicates(x:%) == removeDuplicates_!(copy x) - - if S has OrderedSet then - merge_!(x, y) == merge_!(_<$S, x, y) - -@ -\section{category LSAGG ListAggregate} -<>= -"LSAGG" -> "FLAGG" -"ListAggregate(a:Type)" -> "FiniteLinearAggregate(a:Type)" -"LSAGG" -> "ELAGG" -"ListAggregate(a:Type)" -> "ExtensibleLinearAggregate(a:Type)" -@ -<>= -)abbrev category LSAGG ListAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A list aggregate is a model for a linked list data structure. -++ A linked list is a versatile -++ data structure. Insertion and deletion are efficient and -++ searching is a linear operation. -ListAggregate(S:Type): Category == Join(StreamAggregate S, - FiniteLinearAggregate S, ExtensibleLinearAggregate S) with - list: S -> % - ++ list(x) returns the list of one element x. - add - cycleMax ==> 1000 - - mergeSort: ((S, S) -> Boolean, %, Integer) -> % - - sort_!(f, l) == mergeSort(f, l, #l) - list x == concat(x, empty()) - reduce(f, x) == - empty? x => error "reducing over an empty list needs the 3 argument form" - reduce(f, rest x, first x) - merge(f, p, q) == merge_!(f, copy p, copy q) - - select_!(f, x) == - while not empty? x and not f first x repeat x := rest x - empty? x => x - y := x - z := rest y - while not empty? z repeat - if f first z then (y := z; z := rest z) - else (z := rest z; setrest_!(y, z)) - x - - merge_!(f, p, q) == - empty? p => q - empty? q => p - eq?(p, q) => error "cannot merge a list into itself" - if f(first p, first q) - then (r := t := p; p := rest p) - else (r := t := q; q := rest q) - while not empty? p and not empty? q repeat - if f(first p, first q) - then (setrest_!(t, p); t := p; p := rest p) - else (setrest_!(t, q); t := q; q := rest q) - setrest_!(t, if empty? p then q else p) - r - - insert_!(s:S, x:%, i:Integer) == - i < (m := minIndex x) => error "index out of range" - i = m => concat(s, x) - y := rest(x, (i - 1 - m)::NonNegativeInteger) - z := rest y - setrest_!(y, concat(s, z)) - x - - insert_!(w:%, x:%, i:Integer) == - i < (m := minIndex x) => error "index out of range" - i = m => concat_!(w, x) - y := rest(x, (i - 1 - m)::NonNegativeInteger) - z := rest y - setrest_!(y, w) - concat_!(y, z) - x - - remove_!(f:S -> Boolean, x:%) == - while not empty? x and f first x repeat x := rest x - empty? x => x - p := x - q := rest x - while not empty? q repeat - if f first q then q := setrest_!(p, rest q) - else (p := q; q := rest q) - x - - delete_!(x:%, i:Integer) == - i < (m := minIndex x) => error "index out of range" - i = m => rest x - y := rest(x, (i - 1 - m)::NonNegativeInteger) - setrest_!(y, rest(y, 2)) - x - - delete_!(x:%, i:UniversalSegment(Integer)) == - (l := lo i) < (m := minIndex x) => error "index out of range" - h := if hasHi i then hi i else maxIndex x - h < l => x - l = m => rest(x, (h + 1 - m)::NonNegativeInteger) - t := rest(x, (l - 1 - m)::NonNegativeInteger) - setrest_!(t, rest(t, (h - l + 2)::NonNegativeInteger)) - x - - find(f, x) == - while not empty? x and not f first x repeat x := rest x - empty? x => "failed" - first x - - position(f:S -> Boolean, x:%) == - for k in minIndex(x).. while not empty? x and not f first x repeat - x := rest x - empty? x => minIndex(x) - 1 - k - - mergeSort(f, p, n) == - if n = 2 and f(first rest p, first p) then p := reverse_! p - n < 3 => p - l := (n quo 2)::NonNegativeInteger - q := split_!(p, l) - p := mergeSort(f, p, l) - q := mergeSort(f, q, n - l) - merge_!(f, p, q) - - sorted?(f, l) == - empty? l => true - p := rest l - while not empty? p repeat - not f(first l, first p) => return false - p := rest(l := p) - true - - reduce(f, x, i) == - r := i - while not empty? x repeat (r := f(r, first x); x := rest x) - r - - if S has SetCategory then - reduce(f, x, i,a) == - r := i - while not empty? x and r ^= a repeat - r := f(r, first x) - x := rest x - r - - new(n, s) == - l := empty() - for k in 1..n repeat l := concat(s, l) - l - - map(f, x, y) == - z := empty() - while not empty? x and not empty? y repeat - z := concat(f(first x, first y), z) - x := rest x - y := rest y - reverse_! z - --- map(f, x, y, d) == --- z := empty() --- while not empty? x and not empty? y repeat --- z := concat(f(first x, first y), z) --- x := rest x --- y := rest y --- z := reverseInPlace z --- if not empty? x then --- z := concat_!(z, map(f(#1, d), x)) --- if not empty? y then --- z := concat_!(z, map(f(d, #1), y)) --- z - - reverse_! x == - empty? x => x - empty?(y := rest x) => x - setrest_!(x, empty()) - while not empty? y repeat - z := rest y - setrest_!(y, x) - x := y - y := z - x - - copy x == - y := empty() - for k in 0.. while not empty? x repeat - k = cycleMax and cyclic? x => error "cyclic list" - y := concat(first x, y) - x := rest x - reverse_! y - - copyInto_!(y, x, s) == - s < (m := minIndex y) => error "index out of range" - z := rest(y, (s - m)::NonNegativeInteger) - while not empty? z and not empty? x repeat - setfirst_!(z, first x) - x := rest x - z := rest z - y - - if S has SetCategory then - position(w, x, s) == - s < (m := minIndex x) => error "index out of range" - x := rest(x, (s - m)::NonNegativeInteger) - for k in s.. while not empty? x and w ^= first x repeat - x := rest x - empty? x => minIndex x - 1 - k - - removeDuplicates_! l == - p := l - while not empty? p repeat - p := setrest_!(p, remove_!(#1 = first p, rest p)) - l - - if S has OrderedSet then - x < y == - while not empty? x and not empty? y repeat - first x ^= first y => return(first x < first y) - x := rest x - y := rest y - empty? x => not empty? y - false - -@ -\section{LSAGG.lsp BOOTSTRAP} -{\bf LSAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LSAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LSAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |ListAggregate;CAT| (QUOTE NIL)) - -(SETQ |ListAggregate;AL| (QUOTE NIL)) - -(DEFUN |ListAggregate| (#1=#:G87500) (LET (#2=#:G87501) (COND ((SETQ #2# (|assoc| (|devaluate| #1#) |ListAggregate;AL|)) (CDR #2#)) (T (SETQ |ListAggregate;AL| (|cons5| (CONS (|devaluate| #1#) (SETQ #2# (|ListAggregate;| #1#))) |ListAggregate;AL|)) #2#)))) - -(DEFUN |ListAggregate;| (|t#1|) (PROG (#1=#:G87499) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1|)) (LIST (|devaluate| |t#1|))) (COND (|ListAggregate;CAT|) ((QUOTE T) (LETT |ListAggregate;CAT| (|Join| (|StreamAggregate| (QUOTE |t#1|)) (|FiniteLinearAggregate| (QUOTE |t#1|)) (|ExtensibleLinearAggregate| (QUOTE |t#1|)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|list| (|$| |t#1|)) T))) NIL (QUOTE NIL) NIL)) . #2=(|ListAggregate|))))) . #2#) (SETELT #1# 0 (LIST (QUOTE |ListAggregate|) (|devaluate| |t#1|))))))) -@ -\section{LSAGG-.lsp BOOTSTRAP} -{\bf LSAGG-} depends on {\bf LSAGG}. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf LSAGG-} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf LSAGG-.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(DEFUN |LSAGG-;sort!;M2A;1| (|f| |l| |$|) (|LSAGG-;mergeSort| |f| |l| (SPADCALL |l| (QREFELT |$| 9)) |$|)) - -(DEFUN |LSAGG-;list;SA;2| (|x| |$|) (SPADCALL |x| (SPADCALL (QREFELT |$| 12)) (QREFELT |$| 13))) - -(DEFUN |LSAGG-;reduce;MAS;3| (|f| |x| |$|) (COND ((SPADCALL |x| (QREFELT |$| 16)) (|error| "reducing over an empty list needs the 3 argument form")) ((QUOTE T) (SPADCALL |f| (SPADCALL |x| (QREFELT |$| 17)) (SPADCALL |x| (QREFELT |$| 18)) (QREFELT |$| 20))))) - -(DEFUN |LSAGG-;merge;M3A;4| (|f| |p| |q| |$|) (SPADCALL |f| (SPADCALL |p| (QREFELT |$| 22)) (SPADCALL |q| (QREFELT |$| 22)) (QREFELT |$| 23))) - -(DEFUN |LSAGG-;select!;M2A;5| (|f| |x| |$|) (PROG (|y| |z|) (RETURN (SEQ (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) |x|) ((QUOTE T) (SEQ (LETT |y| |x| |LSAGG-;select!;M2A;5|) (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |z| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (SPADCALL |z| (QREFELT |$| 18)) |f|) (SEQ (LETT |y| |z| |LSAGG-;select!;M2A;5|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|)))) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |z| (QREFELT |$| 17)) |LSAGG-;select!;M2A;5|) (EXIT (SPADCALL |y| |z| (QREFELT |$| 25)))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;merge!;M3A;6| (|f| |p| |q| |$|) (PROG (|r| |t|) (RETURN (SEQ (COND ((SPADCALL |p| (QREFELT |$| 16)) |q|) ((SPADCALL |q| (QREFELT |$| 16)) |p|) ((SPADCALL |p| |q| (QREFELT |$| 28)) (|error| "cannot merge a list into itself")) ((QUOTE T) (SEQ (COND ((SPADCALL (SPADCALL |p| (QREFELT |$| 18)) (SPADCALL |q| (QREFELT |$| 18)) |f|) (SEQ (LETT |r| (LETT |t| |p| |LSAGG-;merge!;M3A;6|) |LSAGG-;merge!;M3A;6|) (EXIT (LETT |p| (SPADCALL |p| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|)))) ((QUOTE T) (SEQ (LETT |r| (LETT |t| |q| |LSAGG-;merge!;M3A;6|) |LSAGG-;merge!;M3A;6|) (EXIT (LETT |q| (SPADCALL |q| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|))))) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |p| (QREFELT |$| 16)) (SPADCALL |q| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (SPADCALL |p| (QREFELT |$| 18)) (SPADCALL |q| (QREFELT |$| 18)) |f|) (SEQ (SPADCALL |t| |p| (QREFELT |$| 25)) (LETT |t| |p| |LSAGG-;merge!;M3A;6|) (EXIT (LETT |p| (SPADCALL |p| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|)))) ((QUOTE T) (SEQ (SPADCALL |t| |q| (QREFELT |$| 25)) (LETT |t| |q| |LSAGG-;merge!;M3A;6|) (EXIT (LETT |q| (SPADCALL |q| (QREFELT |$| 17)) |LSAGG-;merge!;M3A;6|))))))) NIL (GO G190) G191 (EXIT NIL)) (SPADCALL |t| (COND ((SPADCALL |p| (QREFELT |$| 16)) |q|) ((QUOTE T) |p|)) (QREFELT |$| 25)) (EXIT |r|)))))))) - -(DEFUN |LSAGG-;insert!;SAIA;7| (|s| |x| |i| |$|) (PROG (|m| #1=#:G87547 |y| |z|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;insert!;SAIA;7|) (EXIT (COND ((|<| |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |s| |x| (QREFELT |$| 13))) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# (|-| (|-| |i| 1) |m|) |LSAGG-;insert!;SAIA;7|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;insert!;SAIA;7|) (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;insert!;SAIA;7|) (SPADCALL |y| (SPADCALL |s| |z| (QREFELT |$| 13)) (QREFELT |$| 25)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;insert!;2AIA;8| (|w| |x| |i| |$|) (PROG (|m| #1=#:G87551 |y| |z|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;insert!;2AIA;8|) (EXIT (COND ((|<| |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |w| |x| (QREFELT |$| 34))) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# (|-| (|-| |i| 1) |m|) |LSAGG-;insert!;2AIA;8|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;insert!;2AIA;8|) (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;insert!;2AIA;8|) (SPADCALL |y| |w| (QREFELT |$| 25)) (SPADCALL |y| |z| (QREFELT |$| 34)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;remove!;M2A;9| (|f| |x| |$|) (PROG (|p| |q|) (RETURN (SEQ (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;remove!;M2A;9|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) |x|) ((QUOTE T) (SEQ (LETT |p| |x| |LSAGG-;remove!;M2A;9|) (LETT |q| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;remove!;M2A;9|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |q| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((SPADCALL (SPADCALL |q| (QREFELT |$| 18)) |f|) (LETT |q| (SPADCALL |p| (SPADCALL |q| (QREFELT |$| 17)) (QREFELT |$| 25)) |LSAGG-;remove!;M2A;9|)) ((QUOTE T) (SEQ (LETT |p| |q| |LSAGG-;remove!;M2A;9|) (EXIT (LETT |q| (SPADCALL |q| (QREFELT |$| 17)) |LSAGG-;remove!;M2A;9|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AIA;10| (|x| |i| |$|) (PROG (|m| #1=#:G87564 |y|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;delete!;AIA;10|) (EXIT (COND ((|<| |i| |m|) (|error| "index out of range")) ((EQL |i| |m|) (SPADCALL |x| (QREFELT |$| 17))) ((QUOTE T) (SEQ (LETT |y| (SPADCALL |x| (PROG1 (LETT #1# (|-| (|-| |i| 1) |m|) |LSAGG-;delete!;AIA;10|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;delete!;AIA;10|) (SPADCALL |y| (SPADCALL |y| 2 (QREFELT |$| 32)) (QREFELT |$| 25)) (EXIT |x|))))))))) - -(DEFUN |LSAGG-;delete!;AUsA;11| (|x| |i| |$|) (PROG (|l| |m| |h| #1=#:G87569 #2=#:G87570 |t| #3=#:G87571) (RETURN (SEQ (LETT |l| (SPADCALL |i| (QREFELT |$| 39)) |LSAGG-;delete!;AUsA;11|) (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;delete!;AUsA;11|) (EXIT (COND ((|<| |l| |m|) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |h| (COND ((SPADCALL |i| (QREFELT |$| 40)) (SPADCALL |i| (QREFELT |$| 41))) ((QUOTE T) (SPADCALL |x| (QREFELT |$| 42)))) |LSAGG-;delete!;AUsA;11|) (EXIT (COND ((|<| |h| |l|) |x|) ((EQL |l| |m|) (SPADCALL |x| (PROG1 (LETT #1# (|-| (|+| |h| 1) |m|) |LSAGG-;delete!;AUsA;11|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32))) ((QUOTE T) (SEQ (LETT |t| (SPADCALL |x| (PROG1 (LETT #2# (|-| (|-| |l| 1) |m|) |LSAGG-;delete!;AUsA;11|) (|check-subtype| (|>=| #2# 0) (QUOTE (|NonNegativeInteger|)) #2#)) (QREFELT |$| 32)) |LSAGG-;delete!;AUsA;11|) (SPADCALL |t| (SPADCALL |t| (PROG1 (LETT #3# (|+| (|-| |h| |l|) 2) |LSAGG-;delete!;AUsA;11|) (|check-subtype| (|>=| #3# 0) (QUOTE (|NonNegativeInteger|)) #3#)) (QREFELT |$| 32)) (QREFELT |$| 25)) (EXIT |x|))))))))))))) - -(DEFUN |LSAGG-;find;MAU;12| (|f| |x| |$|) (SEQ (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;find;MAU;12|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (CONS 1 "failed")) ((QUOTE T) (CONS 0 (SPADCALL |x| (QREFELT |$| 18)))))))) - -(DEFUN |LSAGG-;position;MAI;13| (|f| |x| |$|) (PROG (|k|) (RETURN (SEQ (SEQ (LETT |k| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;position;MAI;13|) G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |f|)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;position;MAI;13|))) (LETT |k| (|+| |k| 1) |LSAGG-;position;MAI;13|) (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (|-| (SPADCALL |x| (QREFELT |$| 31)) 1)) ((QUOTE T) |k|))))))) - -(DEFUN |LSAGG-;mergeSort| (|f| |p| |n| |$|) (PROG (#1=#:G87593 |l| |q|) (RETURN (SEQ (COND ((EQL |n| 2) (COND ((SPADCALL (SPADCALL (SPADCALL |p| (QREFELT |$| 17)) (QREFELT |$| 18)) (SPADCALL |p| (QREFELT |$| 18)) |f|) (LETT |p| (SPADCALL |p| (QREFELT |$| 47)) |LSAGG-;mergeSort|))))) (EXIT (COND ((|<| |n| 3) |p|) ((QUOTE T) (SEQ (LETT |l| (PROG1 (LETT #1# (QUOTIENT2 |n| 2) |LSAGG-;mergeSort|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) |LSAGG-;mergeSort|) (LETT |q| (SPADCALL |p| |l| (QREFELT |$| 48)) |LSAGG-;mergeSort|) (LETT |p| (|LSAGG-;mergeSort| |f| |p| |l| |$|) |LSAGG-;mergeSort|) (LETT |q| (|LSAGG-;mergeSort| |f| |q| (|-| |n| |l|) |$|) |LSAGG-;mergeSort|) (EXIT (SPADCALL |f| |p| |q| (QREFELT |$| 23))))))))))) - -(DEFUN |LSAGG-;sorted?;MAB;15| (|f| |l| |$|) (PROG (#1=#:G87603 |p|) (RETURN (SEQ (EXIT (COND ((SPADCALL |l| (QREFELT |$| 16)) (QUOTE T)) ((QUOTE T) (SEQ (LETT |p| (SPADCALL |l| (QREFELT |$| 17)) |LSAGG-;sorted?;MAB;15|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |p| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((NULL (SPADCALL (SPADCALL |l| (QREFELT |$| 18)) (SPADCALL |p| (QREFELT |$| 18)) |f|)) (PROGN (LETT #1# (QUOTE NIL) |LSAGG-;sorted?;MAB;15|) (GO #1#))) ((QUOTE T) (LETT |p| (SPADCALL (LETT |l| |p| |LSAGG-;sorted?;MAB;15|) (QREFELT |$| 17)) |LSAGG-;sorted?;MAB;15|))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (QUOTE T)))))) #1# (EXIT #1#))))) - -(DEFUN |LSAGG-;reduce;MA2S;16| (|f| |x| |i| |$|) (PROG (|r|) (RETURN (SEQ (LETT |r| |i| |LSAGG-;reduce;MA2S;16|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |r| (SPADCALL |r| (SPADCALL |x| (QREFELT |$| 18)) |f|) |LSAGG-;reduce;MA2S;16|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;reduce;MA2S;16|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |r|))))) - -(DEFUN |LSAGG-;reduce;MA3S;17| (|f| |x| |i| |a| |$|) (PROG (|r|) (RETURN (SEQ (LETT |r| |i| |LSAGG-;reduce;MA3S;17|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |r| |a| (QREFELT |$| 51))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |r| (SPADCALL |r| (SPADCALL |x| (QREFELT |$| 18)) |f|) |LSAGG-;reduce;MA3S;17|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;reduce;MA3S;17|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |r|))))) - -(DEFUN |LSAGG-;new;NniSA;18| (|n| |s| |$|) (PROG (|k| |l|) (RETURN (SEQ (LETT |l| (SPADCALL (QREFELT |$| 12)) |LSAGG-;new;NniSA;18|) (SEQ (LETT |k| 1 |LSAGG-;new;NniSA;18|) G190 (COND ((QSGREATERP |k| |n|) (GO G191))) (SEQ (EXIT (LETT |l| (SPADCALL |s| |l| (QREFELT |$| 13)) |LSAGG-;new;NniSA;18|))) (LETT |k| (QSADD1 |k|) |LSAGG-;new;NniSA;18|) (GO G190) G191 (EXIT NIL)) (EXIT |l|))))) - -(DEFUN |LSAGG-;map;M3A;19| (|f| |x| |y| |$|) (PROG (|z|) (RETURN (SEQ (LETT |z| (SPADCALL (QREFELT |$| 12)) |LSAGG-;map;M3A;19|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |y| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |z| (SPADCALL (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) (SPADCALL |y| (QREFELT |$| 18)) |f|) |z| (QREFELT |$| 13)) |LSAGG-;map;M3A;19|) (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;map;M3A;19|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;map;M3A;19|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |z| (QREFELT |$| 47))))))) - -(DEFUN |LSAGG-;reverse!;2A;20| (|x| |$|) (PROG (|z| |y|) (RETURN (SEQ (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL (LETT |y| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;reverse!;2A;20|) (QREFELT |$| 16))) |x|) ((QUOTE T) (SEQ (SPADCALL |x| (SPADCALL (QREFELT |$| 12)) (QREFELT |$| 25)) (SEQ G190 (COND ((NULL (COND ((SPADCALL |y| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (LETT |z| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;reverse!;2A;20|) (SPADCALL |y| |x| (QREFELT |$| 25)) (LETT |x| |y| |LSAGG-;reverse!;2A;20|) (EXIT (LETT |y| |z| |LSAGG-;reverse!;2A;20|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |x|)))))))) - -(DEFUN |LSAGG-;copy;2A;21| (|x| |$|) (PROG (|k| |y|) (RETURN (SEQ (LETT |y| (SPADCALL (QREFELT |$| 12)) |LSAGG-;copy;2A;21|) (SEQ (LETT |k| 0 |LSAGG-;copy;2A;21|) G190 (COND ((NULL (COND ((SPADCALL |x| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (COND ((EQL |k| 1000) (COND ((SPADCALL |x| (QREFELT |$| 56)) (EXIT (|error| "cyclic list")))))) (LETT |y| (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) |y| (QREFELT |$| 13)) |LSAGG-;copy;2A;21|) (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;copy;2A;21|))) (LETT |k| (QSADD1 |k|) |LSAGG-;copy;2A;21|) (GO G190) G191 (EXIT NIL)) (EXIT (SPADCALL |y| (QREFELT |$| 47))))))) - -(DEFUN |LSAGG-;copyInto!;2AIA;22| (|y| |x| |s| |$|) (PROG (|m| #1=#:G87636 |z|) (RETURN (SEQ (LETT |m| (SPADCALL |y| (QREFELT |$| 31)) |LSAGG-;copyInto!;2AIA;22|) (EXIT (COND ((|<| |s| |m|) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |z| (SPADCALL |y| (PROG1 (LETT #1# (|-| |s| |m|) |LSAGG-;copyInto!;2AIA;22|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;copyInto!;2AIA;22|) (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |z| (QREFELT |$| 16)) (SPADCALL |x| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (SPADCALL |z| (SPADCALL |x| (QREFELT |$| 18)) (QREFELT |$| 58)) (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;copyInto!;2AIA;22|) (EXIT (LETT |z| (SPADCALL |z| (QREFELT |$| 17)) |LSAGG-;copyInto!;2AIA;22|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |y|))))))))) - -(DEFUN |LSAGG-;position;SA2I;23| (|w| |x| |s| |$|) (PROG (|m| #1=#:G87644 |k|) (RETURN (SEQ (LETT |m| (SPADCALL |x| (QREFELT |$| 31)) |LSAGG-;position;SA2I;23|) (EXIT (COND ((|<| |s| |m|) (|error| "index out of range")) ((QUOTE T) (SEQ (LETT |x| (SPADCALL |x| (PROG1 (LETT #1# (|-| |s| |m|) |LSAGG-;position;SA2I;23|) (|check-subtype| (|>=| #1# 0) (QUOTE (|NonNegativeInteger|)) #1#)) (QREFELT |$| 32)) |LSAGG-;position;SA2I;23|) (SEQ (LETT |k| |s| |LSAGG-;position;SA2I;23|) G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |w| (SPADCALL |x| (QREFELT |$| 18)) (QREFELT |$| 51))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;position;SA2I;23|))) (LETT |k| (|+| |k| 1) |LSAGG-;position;SA2I;23|) (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (|-| (SPADCALL |x| (QREFELT |$| 31)) 1)) ((QUOTE T) |k|))))))))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24| (|l| |$|) (PROG (|p|) (RETURN (SEQ (LETT |p| |l| |LSAGG-;removeDuplicates!;2A;24|) (SEQ G190 (COND ((NULL (COND ((SPADCALL |p| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (LETT |p| (SPADCALL |p| (SPADCALL (CONS (FUNCTION |LSAGG-;removeDuplicates!;2A;24!0|) (VECTOR |$| |p|)) (SPADCALL |p| (QREFELT |$| 17)) (QREFELT |$| 61)) (QREFELT |$| 25)) |LSAGG-;removeDuplicates!;2A;24|))) NIL (GO G190) G191 (EXIT NIL)) (EXIT |l|))))) - -(DEFUN |LSAGG-;removeDuplicates!;2A;24!0| (|#1| |$$|) (PROG (|$|) (LETT |$| (QREFELT |$$| 0) |LSAGG-;removeDuplicates!;2A;24|) (RETURN (PROGN (SPADCALL |#1| (SPADCALL (QREFELT |$$| 1) (QREFELT |$| 18)) (QREFELT |$| 51)))))) - -(DEFUN |LSAGG-;<;2AB;25| (|x| |y| |$|) (PROG (#1=#:G87662) (RETURN (SEQ (EXIT (SEQ (SEQ G190 (COND ((NULL (COND ((OR (SPADCALL |x| (QREFELT |$| 16)) (SPADCALL |y| (QREFELT |$| 16))) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) (GO G191))) (SEQ (EXIT (COND ((NULL (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) (SPADCALL |y| (QREFELT |$| 18)) (QREFELT |$| 51))) (PROGN (LETT #1# (SPADCALL (SPADCALL |x| (QREFELT |$| 18)) (SPADCALL |y| (QREFELT |$| 18)) (QREFELT |$| 63)) |LSAGG-;<;2AB;25|) (GO #1#))) ((QUOTE T) (SEQ (LETT |x| (SPADCALL |x| (QREFELT |$| 17)) |LSAGG-;<;2AB;25|) (EXIT (LETT |y| (SPADCALL |y| (QREFELT |$| 17)) |LSAGG-;<;2AB;25|))))))) NIL (GO G190) G191 (EXIT NIL)) (EXIT (COND ((SPADCALL |x| (QREFELT |$| 16)) (COND ((SPADCALL |y| (QREFELT |$| 16)) (QUOTE NIL)) ((QUOTE T) (QUOTE T)))) ((QUOTE T) (QUOTE NIL)))))) #1# (EXIT #1#))))) - -(DEFUN |ListAggregate&| (|#1| |#2|) (PROG (|DV$1| |DV$2| |dv$| |$| |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #1=(|ListAggregate&|)) (LETT |DV$2| (|devaluate| |#2|) . #1#) (LETT |dv$| (LIST (QUOTE |ListAggregate&|) |DV$1| |DV$2|) . #1#) (LETT |$| (GETREFV 66) . #1#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 NIL) . #1#)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) (QSETREFV |$| 7 |#2|) (COND ((|HasCategory| |#2| (QUOTE (|SetCategory|))) (QSETREFV |$| 52 (CONS (|dispatchFunction| |LSAGG-;reduce;MA3S;17|) |$|)))) (COND ((|HasCategory| |#2| (QUOTE (|SetCategory|))) (PROGN (QSETREFV |$| 60 (CONS (|dispatchFunction| |LSAGG-;position;SA2I;23|) |$|)) (QSETREFV |$| 62 (CONS (|dispatchFunction| |LSAGG-;removeDuplicates!;2A;24|) |$|))))) (COND ((|HasCategory| |#2| (QUOTE (|OrderedSet|))) (QSETREFV |$| 64 (CONS (|dispatchFunction| |LSAGG-;<;2AB;25|) |$|)))) |$|)))) - -(MAKEPROP (QUOTE |ListAggregate&|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|local| |#2|) (|NonNegativeInteger|) (0 . |#|) (|Mapping| 15 7 7) |LSAGG-;sort!;M2A;1| (5 . |empty|) (9 . |concat|) |LSAGG-;list;SA;2| (|Boolean|) (15 . |empty?|) (20 . |rest|) (25 . |first|) (|Mapping| 7 7 7) (30 . |reduce|) |LSAGG-;reduce;MAS;3| (37 . |copy|) (42 . |merge!|) |LSAGG-;merge;M3A;4| (49 . |setrest!|) (|Mapping| 15 7) |LSAGG-;select!;M2A;5| (55 . |eq?|) |LSAGG-;merge!;M3A;6| (|Integer|) (61 . |minIndex|) (66 . |rest|) |LSAGG-;insert!;SAIA;7| (72 . |concat!|) |LSAGG-;insert!;2AIA;8| |LSAGG-;remove!;M2A;9| |LSAGG-;delete!;AIA;10| (|UniversalSegment| 30) (78 . |lo|) (83 . |hasHi|) (88 . |hi|) (93 . |maxIndex|) |LSAGG-;delete!;AUsA;11| (|Union| 7 (QUOTE "failed")) |LSAGG-;find;MAU;12| |LSAGG-;position;MAI;13| (98 . |reverse!|) (103 . |split!|) |LSAGG-;sorted?;MAB;15| |LSAGG-;reduce;MA2S;16| (109 . |=|) (115 . |reduce|) |LSAGG-;new;NniSA;18| |LSAGG-;map;M3A;19| |LSAGG-;reverse!;2A;20| (123 . |cyclic?|) |LSAGG-;copy;2A;21| (128 . |setfirst!|) |LSAGG-;copyInto!;2AIA;22| (134 . |position|) (141 . |remove!|) (147 . |removeDuplicates!|) (152 . |<|) (158 . |<|) (|Mapping| 7 7))) (QUOTE #(|sorted?| 164 |sort!| 170 |select!| 176 |reverse!| 182 |removeDuplicates!| 187 |remove!| 192 |reduce| 198 |position| 219 |new| 232 |merge!| 238 |merge| 245 |map| 252 |list| 259 |insert!| 264 |find| 278 |delete!| 284 |copyInto!| 296 |copy| 303 |<| 308)) (QUOTE NIL) (CONS (|makeByteWordVec2| 1 (QUOTE NIL)) (CONS (QUOTE #()) (CONS (QUOTE #()) (|makeByteWordVec2| 64 (QUOTE (1 6 8 0 9 0 6 0 12 2 6 0 7 0 13 1 6 15 0 16 1 6 0 0 17 1 6 7 0 18 3 6 7 19 0 7 20 1 6 0 0 22 3 6 0 10 0 0 23 2 6 0 0 0 25 2 6 15 0 0 28 1 6 30 0 31 2 6 0 0 8 32 2 6 0 0 0 34 1 38 30 0 39 1 38 15 0 40 1 38 30 0 41 1 6 30 0 42 1 6 0 0 47 2 6 0 0 30 48 2 7 15 0 0 51 4 0 7 19 0 7 7 52 1 6 15 0 56 2 6 7 0 7 58 3 0 30 7 0 30 60 2 6 0 26 0 61 1 0 0 0 62 2 7 15 0 0 63 2 0 15 0 0 64 2 0 15 10 0 49 2 0 0 10 0 11 2 0 0 26 0 27 1 0 0 0 55 1 0 0 0 62 2 0 0 26 0 36 3 0 7 19 0 7 50 4 0 7 19 0 7 7 52 2 0 7 19 0 21 2 0 30 26 0 46 3 0 30 7 0 30 60 2 0 0 8 7 53 3 0 0 10 0 0 29 3 0 0 10 0 0 24 3 0 0 19 0 0 54 1 0 0 7 14 3 0 0 7 0 30 33 3 0 0 0 0 30 35 2 0 44 26 0 45 2 0 0 0 38 43 2 0 0 0 30 37 3 0 0 0 0 30 59 1 0 0 0 57 2 0 15 0 0 64)))))) (QUOTE |lookupComplete|))) -@ -\section{category ALAGG AssociationListAggregate} -<>= -"ALAGG" -> "TBAGG" -"AssociationListAggregate(a:SetCategory,b:SetCategory)" -> - "TableAggregate(a:SetCategory,b:SetCategory)" -"ALAGG" -> "LSAGG" -"AssociationListAggregate(a:SetCategory,b:SetCategory)" -> - "ListAggregate(Record(a:SetCategory,b:SetCategory))" -@ -<>= -)abbrev category ALAGG AssociationListAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ An association list is a list of key entry pairs which may be viewed -++ as a table. It is a poor mans version of a table: -++ searching for a key is a linear operation. -AssociationListAggregate(Key:SetCategory,Entry:SetCategory): Category == - Join(TableAggregate(Key, Entry), ListAggregate Record(key:Key,entry:Entry)) with - assoc: (Key, %) -> Union(Record(key:Key,entry:Entry), "failed") - ++ assoc(k,u) returns the element x in association list u stored - ++ with key k, or "failed" if u has no key k. - -@ -\section{ALAGG.lsp BOOTSTRAP} -{\bf ALAGG} depends on a chain of files. We need to break this cycle to build -the algebra. So we keep a cached copy of the translated {\bf ALAGG} -category which we can write into the {\bf MID} directory. We compile -the lisp code and copy the {\bf ALAGG.o} file to the {\bf OUT} directory. -This is eventually forcibly replaced by a recompiled version. - -Note that this code is not included in the generated catdef.spad file. - -<>= - -(|/VERSIONCHECK| 2) - -(SETQ |AssociationListAggregate;CAT| (QUOTE NIL)) - -(SETQ |AssociationListAggregate;AL| (QUOTE NIL)) - -(DEFUN |AssociationListAggregate| (|&REST| #1=#:G88404 |&AUX| #2=#:G88402) (DSETQ #2# #1#) (LET (#3=#:G88403) (COND ((SETQ #3# (|assoc| (|devaluateList| #2#) |AssociationListAggregate;AL|)) (CDR #3#)) (T (SETQ |AssociationListAggregate;AL| (|cons5| (CONS (|devaluateList| #2#) (SETQ #3# (APPLY (FUNCTION |AssociationListAggregate;|) #2#))) |AssociationListAggregate;AL|)) #3#)))) - -(DEFUN |AssociationListAggregate;| (|t#1| |t#2|) (PROG (#1=#:G88401) (RETURN (PROG1 (LETT #1# (|sublisV| (PAIR (QUOTE (|t#1| |t#2|)) (LIST (|devaluate| |t#1|) (|devaluate| |t#2|))) (|sublisV| (PAIR (QUOTE (#2=#:G88400)) (LIST (QUOTE (|Record| (|:| |key| |t#1|) (|:| |entry| |t#2|))))) (COND (|AssociationListAggregate;CAT|) ((QUOTE T) (LETT |AssociationListAggregate;CAT| (|Join| (|TableAggregate| (QUOTE |t#1|) (QUOTE |t#2|)) (|ListAggregate| (QUOTE #2#)) (|mkCategory| (QUOTE |domain|) (QUOTE (((|assoc| ((|Union| (|Record| (|:| |key| |t#1|) (|:| |entry| |t#2|)) "failed") |t#1| |$|)) T))) NIL (QUOTE NIL) NIL)) . #3=(|AssociationListAggregate|)))))) . #3#) (SETELT #1# 0 (LIST (QUOTE |AssociationListAggregate|) (|devaluate| |t#1|) (|devaluate| |t#2|))))))) -@ -\section{category SRAGG StringAggregate} -<>= -"SRAGG" -> "A1AGG" -"StringAggregate()" -> "OneDimensionalArrayAggregate(Character)" -@ -<>= -)abbrev category SRAGG StringAggregate -++ Author: Stephen Watt and Michael Monagan. revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ A string aggregate is a category for strings, that is, -++ one dimensional arrays of characters. -StringAggregate: Category == OneDimensionalArrayAggregate Character with - lowerCase : % -> % - ++ lowerCase(s) returns the string with all characters in lower case. - lowerCase_!: % -> % - ++ lowerCase!(s) destructively replaces the alphabetic characters - ++ in s by lower case. - upperCase : % -> % - ++ upperCase(s) returns the string with all characters in upper case. - upperCase_!: % -> % - ++ upperCase!(s) destructively replaces the alphabetic characters - ++ in s by upper case characters. - prefix? : (%, %) -> Boolean - ++ prefix?(s,t) tests if the string s is the initial substring of t. - ++ Note: \axiom{prefix?(s,t) == reduce(and,[s.i = t.i for i in 0..maxIndex s])}. - suffix? : (%, %) -> Boolean - ++ suffix?(s,t) tests if the string s is the final substring of t. - ++ Note: \axiom{suffix?(s,t) == reduce(and,[s.i = t.(n - m + i) for i in 0..maxIndex s])} - ++ where m and n denote the maxIndex of s and t respectively. - substring?: (%, %, Integer) -> Boolean - ++ substring?(s,t,i) tests if s is a substring of t beginning at - ++ index i. - ++ Note: \axiom{substring?(s,t,0) = prefix?(s,t)}. - match: (%, %, Character) -> NonNegativeInteger - ++ match(p,s,wc) tests if pattern \axiom{p} matches subject \axiom{s} - ++ where \axiom{wc} is a wild card character. If no match occurs, - ++ the index \axiom{0} is returned; otheriwse, the value returned - ++ is the first index of the first character in the subject matching - ++ the subject (excluding that matched by an initial wild-card). - ++ For example, \axiom{match("*to*","yorktown","*")} returns \axiom{5} - ++ indicating a successful match starting at index \axiom{5} of - ++ \axiom{"yorktown"}. - match?: (%, %, Character) -> Boolean - ++ match?(s,t,c) tests if s matches t except perhaps for - ++ multiple and consecutive occurrences of character c. - ++ Typically c is the blank character. - replace : (%, UniversalSegment(Integer), %) -> % - ++ replace(s,i..j,t) replaces the substring \axiom{s(i..j)} of s by string t. - position : (%, %, Integer) -> Integer - ++ position(s,t,i) returns the position j of the substring s in string t, - ++ where \axiom{j >= i} is required. - position : (CharacterClass, %, Integer) -> Integer - ++ position(cc,t,i) returns the position \axiom{j >= i} in t of - ++ the first character belonging to cc. - coerce : Character -> % - ++ coerce(c) returns c as a string s with the character c. - - split: (%, Character) -> List % - ++ split(s,c) returns a list of substrings delimited by character c. - split: (%, CharacterClass) -> List % - ++ split(s,cc) returns a list of substrings delimited by characters in cc. - - trim: (%, Character) -> % - ++ trim(s,c) returns s with all characters c deleted from right - ++ and left ends. - ++ For example, \axiom{trim(" abc ", char " ")} returns \axiom{"abc"}. - trim: (%, CharacterClass) -> % - ++ trim(s,cc) returns s with all characters in cc deleted from right - ++ and left ends. - ++ For example, \axiom{trim("(abc)", charClass "()")} returns \axiom{"abc"}. - leftTrim: (%, Character) -> % - ++ leftTrim(s,c) returns s with all leading characters c deleted. - ++ For example, \axiom{leftTrim(" abc ", char " ")} returns \axiom{"abc "}. - leftTrim: (%, CharacterClass) -> % - ++ leftTrim(s,cc) returns s with all leading characters in cc deleted. - ++ For example, \axiom{leftTrim("(abc)", charClass "()")} returns \axiom{"abc)"}. - rightTrim: (%, Character) -> % - ++ rightTrim(s,c) returns s with all trailing occurrences of c deleted. - ++ For example, \axiom{rightTrim(" abc ", char " ")} returns \axiom{" abc"}. - rightTrim: (%, CharacterClass) -> % - ++ rightTrim(s,cc) returns s with all trailing occurences of - ++ characters in cc deleted. - ++ For example, \axiom{rightTrim("(abc)", charClass "()")} returns \axiom{"(abc"}. - elt: (%, %) -> % - ++ elt(s,t) returns the concatenation of s and t. It is provided to - ++ allow juxtaposition of strings to work as concatenation. - ++ For example, \axiom{"smoo" "shed"} returns \axiom{"smooshed"}. - add - trim(s: %, c: Character) == leftTrim(rightTrim(s, c), c) - trim(s: %, cc: CharacterClass) == leftTrim(rightTrim(s, cc), cc) - - lowerCase s == lowerCase_! copy s - upperCase s == upperCase_! copy s - prefix?(s, t) == substring?(s, t, minIndex t) - coerce(c:Character):% == new(1, c) - elt(s:%, t:%): % == concat(s,t)$% - -@ -\section{category BTAGG BitAggregate} -<>= -"BTAGG" -> "ORDSET" -"BitAggregate()" -> "OrderedSet()" -"BTAGG" -> "LOGIC" -"BitAggregate()" -> "Logic()" -"BTAGG" -> "A1AGG" -"BitAggregate()" -> "OneDimensionalArrayAggregate(Boolean)" -@ -<>= -)abbrev category BTAGG BitAggregate -++ Author: Michael Monagan; revised by Manuel Bronstein and Richard Jenks -++ Date Created: August 87 through August 88 -++ Date Last Updated: April 1991 -++ Basic Operations: -++ Related Constructors: -++ Also See: -++ AMS Classifications: -++ Keywords: -++ References: -++ Description: -++ The bit aggregate category models aggregates representing large -++ quantities of Boolean data. -BitAggregate(): Category == - Join(OrderedSet, Logic, OneDimensionalArrayAggregate Boolean) with - "not": % -> % - ++ not(b) returns the logical {\em not} of bit aggregate - ++ \axiom{b}. - "^" : % -> % - ++ ^ b returns the logical {\em not} of bit aggregate - ++ \axiom{b}. - nand : (%, %) -> % - ++ nand(a,b) returns the logical {\em nand} of bit aggregates \axiom{a} - ++ and \axiom{b}. - nor : (%, %) -> % - ++ nor(a,b) returns the logical {\em nor} of bit aggregates \axiom{a} and - ++ \axiom{b}. - _and : (%, %) -> % - ++ a and b returns the logical {\em and} of bit aggregates \axiom{a} and - ++ \axiom{b}. - _or : (%, %) -> % - ++ a or b returns the logical {\em or} of bit aggregates \axiom{a} and - ++ \axiom{b}. - xor : (%, %) -> % - ++ xor(a,b) returns the logical {\em exclusive-or} of bit aggregates - ++ \axiom{a} and \axiom{b}. - - add - not v == map(_not, v) - _^ v == map(_not, v) - _~(v) == map(_~, v) - _/_\(v, u) == map(_/_\, v, u) - _\_/(v, u) == map(_\_/, v, u) - nand(v, u) == map(nand, v, u) - nor(v, u) == map(nor, v, u) - -@ -\section{License} -<>= ---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}