Initial population.

1 files changed, 606 insertions, 0 deletions

diff --git a/src/algebra/array1.spad.pamphlet b/src/algebra/array1.spad.pamphlet
new file mode 100644
index 00000000..0812a849
--- /dev/null
+++ b/src/algebra/array1.spad.pamphlet
@@ -0,0 +1,606 @@
+\documentclass{article}
+\usepackage{axiom}
+\begin{document}
+\title{\$SPAD/src/algebra array1.spad}
+\author{Michael Monagan, Stephen Watt}
+\maketitle
+\begin{abstract}
+\end{abstract}
+\eject
+\tableofcontents
+\eject
+\section{domain PRIMARR PrimitiveArray}
+<<domain PRIMARR PrimitiveArray>>=
+)abbrev domain PRIMARR PrimitiveArray
+++ This provides a fast array type with no bound checking on elt's.
+++ Minimum index is 0 in this type, cannot be changed
+PrimitiveArray(S:Type): OneDimensionalArrayAggregate S == add
+   Qmax ==> QVMAXINDEX$Lisp
+   Qsize ==> QVSIZE$Lisp
+--   Qelt ==> QVELT$Lisp
+--   Qsetelt ==> QSETVELT$Lisp
+   Qelt ==> ELT$Lisp
+   Qsetelt ==> SETELT$Lisp
+   Qnew ==> GETREFV$Lisp
+
+   #x                          == Qsize x
+   minIndex x                  == 0
+   empty()                     == Qnew(0$Lisp)
+   new(n, x)                   == fill_!(Qnew n, x)
+   qelt(x, i)                  == Qelt(x, i)
+   elt(x:%, i:Integer)         == Qelt(x, i)
+   qsetelt_!(x, i, s)          == Qsetelt(x, i, s)
+   setelt(x:%, i:Integer, s:S) == Qsetelt(x, i, s)
+   fill_!(x, s)       == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
+
+@
+\section{PRIMARR.lsp BOOTSTRAP} 
+{\bf PRIMARR} depends on itself.
+We need to break this cycle to build the algebra. So we keep a
+cached copy of the translated {\bf PRIMARR} category which we can write
+into the {\bf MID} directory. We compile the lisp code and copy the
+{\bf PRIMARR.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.
+
+<<PRIMARR.lsp BOOTSTRAP>>=
+
+(|/VERSIONCHECK| 2) 
+
+(PUT (QUOTE |PRIMARR;#;$Nni;1|) (QUOTE |SPADreplace|) (QUOTE QVSIZE)) 
+
+(DEFUN |PRIMARR;#;$Nni;1| (|x| |$|) (QVSIZE |x|)) 
+
+(PUT (QUOTE |PRIMARR;minIndex;$I;2|) (QUOTE |SPADreplace|) (QUOTE (XLAM (|x|) 0))) 
+
+(DEFUN |PRIMARR;minIndex;$I;2| (|x| |$|) 0) 
+
+(PUT (QUOTE |PRIMARR;empty;$;3|) (QUOTE |SPADreplace|) (QUOTE (XLAM NIL (GETREFV 0)))) 
+
+(DEFUN |PRIMARR;empty;$;3| (|$|) (GETREFV 0)) 
+
+(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| |$|) (SPADCALL (GETREFV |n|) |x| (QREFELT |$| 12))) 
+
+(PUT (QUOTE |PRIMARR;qelt;$IS;5|) (QUOTE |SPADreplace|) (QUOTE ELT)) 
+
+(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| |$|) (ELT |x| |i|)) 
+
+(PUT (QUOTE |PRIMARR;elt;$IS;6|) (QUOTE |SPADreplace|) (QUOTE ELT)) 
+
+(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| |$|) (ELT |x| |i|)) 
+
+(PUT (QUOTE |PRIMARR;qsetelt!;$I2S;7|) (QUOTE |SPADreplace|) (QUOTE SETELT)) 
+
+(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| |$|) (SETELT |x| |i| |s|)) 
+
+(PUT (QUOTE |PRIMARR;setelt;$I2S;8|) (QUOTE |SPADreplace|) (QUOTE SETELT)) 
+
+(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| |$|) (SETELT |x| |i| |s|)) 
+
+(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| |$|) (PROG (|i| #1=#:G82338) (RETURN (SEQ (SEQ (LETT |i| 0 |PRIMARR;fill!;$S$;9|) (LETT #1# (QVMAXINDEX |x|) |PRIMARR;fill!;$S$;9|) G190 (COND ((QSGREATERP |i| #1#) (GO G191))) (SEQ (EXIT (SETELT |x| |i| |s|))) (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) (GO G190) G191 (EXIT NIL)) (EXIT |x|))))) 
+
+(DEFUN |PrimitiveArray| (#1=#:G82348) (PROG NIL (RETURN (PROG (#2=#:G82349) (RETURN (COND ((LETT #2# (|lassocShiftWithFunction| (LIST (|devaluate| #1#)) (HGET |$ConstructorCache| (QUOTE |PrimitiveArray|)) (QUOTE |domainEqualList|)) |PrimitiveArray|) (|CDRwithIncrement| #2#)) ((QUOTE T) (|UNWIND-PROTECT| (PROG1 (|PrimitiveArray;| #1#) (LETT #2# T |PrimitiveArray|)) (COND ((NOT #2#) (HREM |$ConstructorCache| (QUOTE |PrimitiveArray|)))))))))))) 
+
+(DEFUN |PrimitiveArray;| (|#1|) (PROG (|DV$1| |dv$| |$| #1=#:G82347 |pv$|) (RETURN (PROGN (LETT |DV$1| (|devaluate| |#1|) . #2=(|PrimitiveArray|)) (LETT |dv$| (LIST (QUOTE |PrimitiveArray|) |DV$1|) . #2#) (LETT |$| (GETREFV 35) . #2#) (QSETREFV |$| 0 |dv$|) (QSETREFV |$| 3 (LETT |pv$| (|buildPredVector| 0 0 (LIST (|HasCategory| |#1| (QUOTE (|SetCategory|))) (|HasCategory| |#1| (QUOTE (|ConvertibleTo| (|InputForm|)))) (LETT #1# (|HasCategory| |#1| (QUOTE (|OrderedSet|))) . #2#) (OR #1# (|HasCategory| |#1| (QUOTE (|SetCategory|)))) (|HasCategory| (|Integer|) (QUOTE (|OrderedSet|))) (AND (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) (|HasCategory| |#1| (QUOTE (|SetCategory|)))) (OR (AND (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) #1#) (AND (|HasCategory| |#1| (LIST (QUOTE |Evalable|) (|devaluate| |#1|))) (|HasCategory| |#1| (QUOTE (|SetCategory|))))))) . #2#)) (|haddProp| |$ConstructorCache| (QUOTE |PrimitiveArray|) (LIST |DV$1|) (CONS 1 |$|)) (|stuffDomainSlots| |$|) (QSETREFV |$| 6 |#1|) |$|)))) 
+
+(MAKEPROP (QUOTE |PrimitiveArray|) (QUOTE |infovec|) (LIST (QUOTE #(NIL NIL NIL NIL NIL NIL (|local| |#1|) (|NonNegativeInteger|) |PRIMARR;#;$Nni;1| (|Integer|) |PRIMARR;minIndex;$I;2| |PRIMARR;empty;$;3| |PRIMARR;fill!;$S$;9| |PRIMARR;new;NniS$;4| |PRIMARR;qelt;$IS;5| |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7| |PRIMARR;setelt;$I2S;8| (|Mapping| 6 6 6) (|Boolean|) (|List| 6) (|Equation| 6) (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6) (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6) (|InputForm|) (|OutputForm|) (|String|) (|SingleInteger|) (|List| |$|) (|Union| 6 (QUOTE "failed")) (|List| 9))) (QUOTE #(|~=| 0 |swap!| 6 |sorted?| 13 |sort!| 24 |sort| 35 |size?| 46 |setelt| 52 |select| 66 |sample| 72 |reverse!| 76 |reverse| 81 |removeDuplicates| 86 |remove| 91 |reduce| 103 |qsetelt!| 124 |qelt| 131 |position| 137 |parts| 156 |new| 161 |more?| 167 |minIndex| 173 |min| 178 |merge| 184 |members| 197 |member?| 202 |maxIndex| 208 |max| 213 |map!| 219 |map| 225 |less?| 238 |latex| 244 |insert| 249 |indices| 263 |index?| 268 |hash| 274 |first| 279 |find| 284 |fill!| 290 |every?| 296 |eval| 302 |eq?| 328 |entry?| 334 |entries| 340 |empty?| 345 |empty| 350 |elt| 354 |delete| 373 |count| 385 |copyInto!| 397 |copy| 404 |convert| 409 |construct| 414 |concat| 419 |coerce| 442 |any?| 447 |>=| 453 |>| 459 |=| 465 |<=| 471 |<| 477 |#| 483)) (QUOTE ((|shallowlyMutable| . 0) (|finiteAggregate| . 0))) (CONS (|makeByteWordVec2| 7 (QUOTE (0 0 0 0 0 0 3 0 0 7 4 0 0 7 1 2 4))) (CONS (QUOTE #(|OneDimensionalArrayAggregate&| |FiniteLinearAggregate&| |LinearAggregate&| |IndexedAggregate&| |Collection&| |HomogeneousAggregate&| |OrderedSet&| |Aggregate&| |EltableAggregate&| |Evalable&| |SetCategory&| NIL NIL |InnerEvalable&| NIL NIL |BasicType&|)) (CONS (QUOTE #((|OneDimensionalArrayAggregate| 6) (|FiniteLinearAggregate| 6) (|LinearAggregate| 6) (|IndexedAggregate| 9 6) (|Collection| 6) (|HomogeneousAggregate| 6) (|OrderedSet|) (|Aggregate|) (|EltableAggregate| 9 6) (|Evalable| 6) (|SetCategory|) (|Type|) (|Eltable| 9 6) (|InnerEvalable| 6 6) (|CoercibleTo| 29) (|ConvertibleTo| 28) (|BasicType|))) (|makeByteWordVec2| 34 (QUOTE (2 1 19 0 0 1 3 0 26 0 9 9 1 1 3 19 0 1 2 0 19 24 0 1 1 3 0 0 1 2 0 0 24 0 1 1 3 0 0 1 2 0 0 24 0 1 2 0 19 0 7 1 3 0 6 0 25 6 1 3 0 6 0 9 6 17 2 0 0 23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1 1 0 0 1 2 1 0 6 0 1 2 0 0 23 0 1 4 1 6 18 0 6 6 1 3 0 6 18 0 6 1 2 0 6 18 0 1 3 0 6 0 9 6 16 2 0 6 0 9 14 2 1 9 6 0 1 3 1 9 6 0 9 1 2 0 9 23 0 1 1 0 20 0 1 2 0 0 7 6 13 2 0 19 0 7 1 1 5 9 0 10 2 3 0 0 0 1 2 3 0 0 0 1 3 0 0 24 0 0 1 1 0 20 0 1 2 1 19 6 0 1 1 5 9 0 1 2 3 0 0 0 1 2 0 0 27 0 1 3 0 0 18 0 0 1 2 0 0 27 0 1 2 0 19 0 7 1 1 1 30 0 1 3 0 0 0 0 9 1 3 0 0 6 0 9 1 1 0 34 0 1 2 0 19 9 0 1 1 1 31 0 1 1 5 6 0 1 2 0 33 23 0 1 2 0 0 0 6 12 2 0 19 23 0 1 3 6 0 0 20 20 1 2 6 0 0 21 1 3 6 0 0 6 6 1 2 6 0 0 22 1 2 0 19 0 0 1 2 1 19 6 0 1 1 0 20 0 1 1 0 19 0 1 0 0 0 11 2 0 0 0 25 1 2 0 6 0 9 15 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0 0 25 1 2 1 7 6 0 1 2 0 7 23 0 1 3 0 0 0 0 9 1 1 0 0 0 1 1 2 28 0 1 1 0 0 20 1 1 0 0 32 1 2 0 0 6 0 1 2 0 0 0 0 1 2 0 0 0 6 1 1 1 29 0 1 2 0 19 23 0 1 2 3 19 0 0 1 2 3 19 0 0 1 2 1 19 0 0 1 2 3 19 0 0 1 2 3 19 0 0 1 1 0 7 0 8)))))) (QUOTE |lookupComplete|))) 
+@
+\section{package PRIMARR2 PrimitiveArrayFunctions2}
+<<package PRIMARR2 PrimitiveArrayFunctions2>>=
+)abbrev package PRIMARR2 PrimitiveArrayFunctions2
+++ This package provides tools for operating on primitive arrays
+++ with unary and binary functions involving different underlying types
+PrimitiveArrayFunctions2(A, B): Exports == Implementation where
+  A, B: Type
+
+  VA ==> PrimitiveArray A
+  VB ==> PrimitiveArray B
+  O2 ==> FiniteLinearAggregateFunctions2(A, VA, B, VB)
+  Exports ==> with
+    scan   : ((A, B) -> B, VA, B) -> VB
+	++ scan(f,a,r) successively applies
+	++ \spad{reduce(f,x,r)} to more and more leading sub-arrays
+	++ x of primitive array \spad{a}.
+	++ More precisely, if \spad{a} is \spad{[a1,a2,...]}, then
+	++ \spad{scan(f,a,r)} returns
+	++ \spad{[reduce(f,[a1],r),reduce(f,[a1,a2],r),...]}.
+    reduce : ((A, B) -> B, VA, B) -> B
+	++ reduce(f,a,r) applies function f to each
+	++ successive element of the
+	++ primitive array \spad{a} and an accumulant initialized to r.
+	++ For example,
+	++ \spad{reduce(_+$Integer,[1,2,3],0)}
+	++ does \spad{3+(2+(1+0))}. Note: third argument r
+	++ may be regarded as the
+	++ identity element for the function f.
+    map    : (A -> B, VA) -> VB
+	++ map(f,a) applies function f to each member of primitive array
+	++ \spad{a} resulting in a new primitive array over a
+	++ possibly different underlying domain.
+
+  Implementation ==> add
+    map(f, v)       == map(f, v)$O2
+    scan(f, v, b)   == scan(f, v, b)$O2
+    reduce(f, v, b) == reduce(f, v, b)$O2
+
+@
+\section{domain TUPLE Tuple}
+<<domain TUPLE Tuple>>=
+)abbrev domain TUPLE Tuple
+++ This domain is used to interface with the interpreter's notion
+++ of comma-delimited sequences of values.
+Tuple(S:Type): CoercibleTo(PrimitiveArray S) with
+  coerce: PrimitiveArray S -> %
+	++ coerce(a) makes a tuple from primitive array a
+  select: (%, NonNegativeInteger) -> S
+	++ select(x,n) returns the n-th element of tuple x.
+	++ tuples are 0-based
+  length: % -> NonNegativeInteger
+	++ length(x) returns the number of elements in tuple x
+  if S has SetCategory then SetCategory
+ == add
+  Rep := Record(len : NonNegativeInteger, elts : PrimitiveArray S)
+
+  coerce(x: PrimitiveArray S): %  == [#x, x]
+  coerce(x:%): PrimitiveArray(S) == x.elts
+  length x == x.len
+
+  select(x, n) ==
+    n >= x.len => error "Index out of bounds"
+    x.elts.n
+
+  if S has SetCategory then
+    x = y == (x.len = y.len) and (x.elts =$PrimitiveArray(S) y.elts)
+    coerce(x : %): OutputForm ==
+      paren [(x.elts.i)::OutputForm
+             for i in minIndex x.elts .. maxIndex x.elts]$List(OutputForm)
+
+@
+\section{domain IFARRAY IndexedFlexibleArray}
+<<domain IFARRAY IndexedFlexibleArray>>=
+)abbrev domain IFARRAY IndexedFlexibleArray
+++ Author: Michael Monagan July/87, modified SMW June/91
+++ A FlexibleArray is the notion of an array intended to allow for growth
+++ at the end only.  Hence the following efficient operations
+++   \spad{append(x,a)} meaning append item x at the end of the array \spad{a}
+++   \spad{delete(a,n)} meaning delete the last item from the array \spad{a}
+++ Flexible arrays support the other operations inherited from
+++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient.
+++ Flexible arrays combine the \spad{O(1)} access time property of arrays
+++ with growing and shrinking at the end in \spad{O(1)} (average) time.
+++ This is done by using an ordinary array which may have zero or more
+++ empty slots at the end.  When the array becomes full it is copied
+++ into a new larger (50% larger) array.  Conversely, when the array
+++ becomes less than 1/2 full, it is copied into a smaller array.
+++ Flexible arrays provide for an efficient implementation of many
+++ data structures in particular heaps, stacks and sets.
+
+IndexedFlexibleArray(S:Type, mn: Integer): Exports == Implementation where
+  A ==> PrimitiveArray S
+  I ==> Integer
+  N ==> NonNegativeInteger
+  U ==> UniversalSegment Integer
+  Exports ==
+    Join(OneDimensionalArrayAggregate S,ExtensibleLinearAggregate S) with
+      flexibleArray : List S -> %
+	++ flexibleArray(l) creates a flexible array from the list of elements l
+      physicalLength : % -> NonNegativeInteger
+   	++ physicalLength(x) returns the number of elements x can accomodate before growing
+      physicalLength_!: (%, I) -> %
+	++ physicalLength!(x,n) changes the physical length of x to be n and returns the new array.
+      shrinkable: Boolean -> Boolean
+	++ shrinkable(b) sets the shrinkable attribute of flexible arrays to b and returns the previous value
+  Implementation == add
+    Rep := Record(physLen:I, logLen:I, f:A)
+    shrinkable? : Boolean := true
+    growAndFill : (%, I, S) -> %
+    growWith    : (%, I, S) -> %
+    growAdding  : (%, I, %) -> %
+    shrink: (%, I)    -> %
+    newa  : (N, A) -> A
+
+    physicalLength(r) == (r.physLen) pretend NonNegativeInteger
+    physicalLength_!(r, n) ==
+       r.physLen = 0  => error "flexible array must be non-empty"
+       growWith(r, n, r.f.0)
+
+    empty()      == [0, 0, empty()]
+    #r           == (r.logLen)::N
+    fill_!(r, x) == (fill_!(r.f, x); r)
+    maxIndex r   == r.logLen - 1 + mn
+    minIndex r   == mn
+    new(n, a)    == [n, n, new(n, a)]
+
+    shrinkable(b) ==
+      oldval := shrinkable?
+      shrinkable? := b
+      oldval
+
+    flexibleArray l ==
+       n := #l
+       n = 0 => empty()
+       x := l.1
+       a := new(n,x)
+       for i in mn + 1..mn + n-1 for y in rest l repeat a.i := y
+       a
+
+    -- local utility operations
+    newa(n, a) ==
+       zero? n => empty()
+       new(n, a.0)
+
+    growAdding(r, b, s) ==
+       b = 0 => r
+       #r > 0 => growAndFill(r, b, (r.f).0)
+       #s > 0 => growAndFill(r, b, (s.f).0)
+       error "no default filler element"
+
+    growAndFill(r, b, x) ==
+       (r.logLen := r.logLen + b) <= r.physLen => r
+       -- enlarge by 50% + b
+       n := r.physLen + r.physLen quo 2 + 1
+       if r.logLen > n then n := r.logLen
+       growWith(r, n, x)
+
+    growWith(r, n, x) ==
+       y := new(n::N, x)$PrimitiveArray(S)
+       a := r.f
+       for k in 0 .. r.physLen-1 repeat y.k := a.k
+       r.physLen := n
+       r.f := y
+       r
+
+    shrink(r, i) ==
+       r.logLen := r.logLen - i
+       negative?(n := r.logLen) => error "internal bug in flexible array"
+       2*n+2 > r.physLen => r
+       not shrinkable? => r
+       if n < r.logLen then error "cannot shrink flexible array to indicated size"
+       n = 0 => empty()
+       r.physLen := n
+       y := newa(n::N, a := r.f)
+       for k in 0 .. n-1 repeat y.k := a.k
+       r.f := y
+       r
+
+    copy r ==
+       n := #r
+       a := r.f
+       v := newa(n, a := r.f)
+       for k in 0..n-1 repeat v.k := a.k
+       [n, n, v]
+
+
+    elt(r:%, i:I) ==
+       i < mn or i >= r.logLen + mn =>
+           error "index out of range"
+       r.f.(i-mn)
+
+    setelt(r:%, i:I, x:S) ==
+       i < mn or i >= r.logLen + mn =>
+           error "index out of range"
+       r.f.(i-mn) := x
+
+    -- operations inherited from extensible aggregate
+    merge(g, a, b)   == merge_!(g, copy a, b)
+    concat(x:S, r:%) == insert_!(x, r, mn)
+
+    concat_!(r:%, x:S) ==
+       growAndFill(r, 1, x)
+       r.f.(r.logLen-1) := x
+       r
+
+    concat_!(a:%, b:%) ==
+       if eq?(a, b) then b := copy b
+       n := #a
+       growAdding(a, #b, b)
+       copyInto_!(a, b, n + mn)
+
+    remove_!(g:(S->Boolean), a:%) ==
+       k:I := 0
+       for i in 0..maxIndex a - mn repeat
+          if not g(a.i) then (a.k := a.i; k := k+1)
+       shrink(a, #a - k)
+
+    delete_!(r:%, i1:I) ==
+       i := i1 - mn
+       i < 0 or i > r.logLen => error "index out of range"
+       for k in i..r.logLen-2 repeat r.f.k := r.f.(k+1)
+       shrink(r, 1)
+
+    delete_!(r:%, i:U) ==
+       l := lo i - mn; m := maxIndex r - mn
+       h := (hasHi i => hi i - mn; m)
+       l < 0 or h > m => error "index out of range"
+       for j in l.. for k in h+1..m repeat r.f.j := r.f.k
+       shrink(r, max(0,h-l+1))
+
+    insert_!(x:S, r:%, i1:I):% ==
+       i := i1 - mn
+       n := r.logLen
+       i < 0 or i > n => error "index out of range"
+       growAndFill(r, 1, x)
+       for k in n-1 .. i by -1 repeat r.f.(k+1) := r.f.k
+       r.f.i := x
+       r
+
+    insert_!(a:%, b:%, i1:I):% ==
+       i := i1 - mn
+       if eq?(a, b) then b := copy b
+       m := #a; n := #b
+       i < 0 or i > n => error "index out of range"
+       growAdding(b, m, a)
+       for k in n-1 .. i by -1 repeat b.f.(m+k) := b.f.k
+       for k in m-1 .. 0 by -1 repeat b.f.(i+k) := a.f.k
+       b
+
+    merge_!(g, a, b) ==
+       m := #a; n := #b; growAdding(a, n, b)
+       for i in m-1..0 by -1 for j in m+n-1.. by -1 repeat a.f.j := a.f.i
+       i := n; j := 0
+       for k in 0.. while i < n+m and j < n repeat
+          if g(a.f.i,b.f.j) then (a.f.k := a.f.i; i := i+1)
+          else (a.f.k := b.f.j; j := j+1)
+       for k in k.. for j in j..n-1 repeat a.f.k := b.f.j
+       a
+
+    select_!(g:(S->Boolean), a:%) ==
+       k:I := 0
+       for i in 0..maxIndex a - mn repeat if g(a.f.i) then (a.f.k := a.f.i;k := k+1)
+       shrink(a, #a - k)
+
+    if S has SetCategory then
+      removeDuplicates_! a ==
+         ct := #a
+         ct < 2 => a
+
+         i     := mn
+         nlim  := mn + ct
+         nlim0 := nlim
+         while i < nlim repeat
+            j := i+1
+            for k in j..nlim-1 | a.k ^= a.i repeat
+                a.j := a.k
+                j := j+1
+            nlim := j
+            i := i+1
+         nlim ^= nlim0 => delete_!(a, i..)
+         a
+
+@
+\section{domain FARRAY FlexibleArray}
+<<domain FARRAY FlexibleArray>>=
+)abbrev domain FARRAY FlexibleArray
+++ A FlexibleArray is the notion of an array intended to allow for growth
+++ at the end only.  Hence the following efficient operations
+++   \spad{append(x,a)} meaning append item x at the end of the array \spad{a}
+++   \spad{delete(a,n)} meaning delete the last item from the array \spad{a}
+++ Flexible arrays support the other operations inherited from
+++ \spadtype{ExtensibleLinearAggregate}. However, these are not efficient.
+++ Flexible arrays combine the \spad{O(1)} access time property of arrays
+++ with growing and shrinking at the end in \spad{O(1)} (average) time.
+++ This is done by using an ordinary array which may have zero or more
+++ empty slots at the end.  When the array becomes full it is copied
+++ into a new larger (50% larger) array.  Conversely, when the array
+++ becomes less than 1/2 full, it is copied into a smaller array.
+++ Flexible arrays provide for an efficient implementation of many
+++ data structures in particular heaps, stacks and sets.
+
+FlexibleArray(S: Type) == Implementation where
+  ARRAYMININDEX ==> 1       -- if you want to change this, be my guest
+  Implementation ==> IndexedFlexibleArray(S, ARRAYMININDEX)
+-- Join(OneDimensionalArrayAggregate S, ExtensibleLinearAggregate S)
+
+@
+\section{domain IARRAY1 IndexedOneDimensionalArray}
+<<domain IARRAY1 IndexedOneDimensionalArray>>=
+)abbrev domain IARRAY1 IndexedOneDimensionalArray
+++ Author Micheal Monagan Aug/87
+++ This is the basic one dimensional array data type.
+
+IndexedOneDimensionalArray(S:Type, mn:Integer):
+ OneDimensionalArrayAggregate S == add
+   Qmax ==> QVMAXINDEX$Lisp
+   Qsize ==> QVSIZE$Lisp
+--   Qelt ==> QVELT$Lisp
+--   Qsetelt ==> QSETVELT$Lisp
+   Qelt ==> ELT$Lisp
+   Qsetelt ==> SETELT$Lisp
+--   Qelt1 ==> QVELT_-1$Lisp
+--   Qsetelt1 ==> QSETVELT_-1$Lisp
+   Qnew ==> GETREFV$Lisp
+   I ==> Integer
+
+   #x               == Qsize x
+   fill_!(x, s)     == (for i in 0..Qmax x repeat Qsetelt(x, i, s); x)
+   minIndex x       == mn
+
+   empty()          == Qnew(0$Lisp)
+   new(n, s)        == fill_!(Qnew n,s)
+
+   map_!(f, s1)  ==
+      n:Integer := Qmax(s1)
+      n < 0 => s1
+      for i in 0..n repeat Qsetelt(s1, i, f(Qelt(s1,i)))
+      s1
+
+   map(f, s1)       ==
+      n:Integer := Qmax(s1)
+      n < 0 => s1
+      ss2:% := Qnew(n+1)
+      for i in 0..n repeat Qsetelt(ss2, i, f(Qelt(s1,i)))
+      ss2
+
+   map(f, a, b)   ==
+      maxind:Integer := min(Qmax a, Qmax b)
+      maxind < 0 => empty()
+      c:% := Qnew(maxind+1)
+      for i in 0..maxind repeat
+        Qsetelt(c, i, f(Qelt(a,i),Qelt(b,i)))
+      c
+
+   if zero? mn then
+     qelt(x, i)       == Qelt(x, i)
+     qsetelt_!(x, i, s) == Qsetelt(x, i, s)
+
+     elt(x:%, i:I) ==
+       negative? i or i > maxIndex(x) => error "index out of range"
+       qelt(x, i)
+
+     setelt(x:%, i:I, s:S) ==
+       negative? i or i > maxIndex(x) => error "index out of range"
+       qsetelt_!(x, i, s)
+
+--   else if one? mn then
+   else if (mn = 1) then
+     maxIndex x       == Qsize x
+     qelt(x, i)       == Qelt(x, i-1)
+     qsetelt_!(x, i, s) == Qsetelt(x, i-1, s)
+
+     elt(x:%, i:I) ==
+       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
+         error "index out of range"
+       Qelt(x, i-1)
+
+     setelt(x:%, i:I, s:S) ==
+       QSLESSP(i,1$Lisp)$Lisp or QSLESSP(Qsize x,i)$Lisp =>
+         error "index out of range"
+       Qsetelt(x, i-1, s)
+
+    else
+       qelt(x, i)       == Qelt(x, i - mn)
+       qsetelt_!(x, i, s) == Qsetelt(x, i - mn, s)
+
+       elt(x:%, i:I) ==
+         i < mn or i > maxIndex(x) => error "index out of range"
+         qelt(x, i)
+
+       setelt(x:%, i:I, s:S) ==
+         i < mn or i > maxIndex(x) => error "index out of range"
+         qsetelt_!(x, i, s)
+
+@
+\section{domain ARRAY1 OneDimensionalArray}
+<<domain ARRAY1 OneDimensionalArray>>=
+)abbrev domain ARRAY1 OneDimensionalArray
+++ This is the domain of 1-based one dimensional arrays
+
+OneDimensionalArray(S:Type): Exports == Implementation where
+  ARRAYMININDEX ==> 1       -- if you want to change this, be my guest
+  Exports == OneDimensionalArrayAggregate S with
+    oneDimensionalArray: List S -> %
+	++ oneDimensionalArray(l) creates an array from a list of elements l
+    oneDimensionalArray: (NonNegativeInteger, S) -> %
+	++ oneDimensionalArray(n,s) creates an array from n copies of element s
+  Implementation == IndexedOneDimensionalArray(S, ARRAYMININDEX) add
+    oneDimensionalArray(u) ==
+      n := #u
+      n = 0 => empty()
+      a := new(n, first u)
+      for i in 2..n for x in rest u repeat a.i := x
+      a
+    oneDimensionalArray(n,s) == new(n,s)
+
+@
+\section{package ARRAY12 OneDimensionalArrayFunctions2}
+<<package ARRAY12 OneDimensionalArrayFunctions2>>=
+)abbrev package ARRAY12 OneDimensionalArrayFunctions2
+++ This package provides tools for operating on one-dimensional arrays
+++ with unary and binary functions involving different underlying types
+OneDimensionalArrayFunctions2(A, B): Exports == Implementation where
+  A, B: Type
+
+  VA ==> OneDimensionalArray A
+  VB ==> OneDimensionalArray B
+  O2 ==> FiniteLinearAggregateFunctions2(A, VA, B, VB)
+
+  Exports ==> with
+    scan   : ((A, B) -> B, VA, B) -> VB
+	++ scan(f,a,r) successively applies
+	++ \spad{reduce(f,x,r)} to more and more leading sub-arrays
+	++ x of one-dimensional array \spad{a}.
+	++ More precisely, if \spad{a} is \spad{[a1,a2,...]}, then
+	++ \spad{scan(f,a,r)} returns
+	++ \spad{[reduce(f,[a1],r),reduce(f,[a1,a2],r),...]}.
+    reduce : ((A, B) -> B, VA, B) -> B
+	++ reduce(f,a,r) applies function f to each
+	++ successive element of the
+	++ one-dimensional array \spad{a} and an accumulant initialized to r.
+	++ For example,
+	++ \spad{reduce(_+$Integer,[1,2,3],0)}
+	++ does \spad{3+(2+(1+0))}. Note: third argument r
+	++ may be regarded as the
+	++ identity element for the function f.
+    map    : (A -> B, VA) -> VB
+	++ map(f,a) applies function f to each member of one-dimensional array
+	++ \spad{a} resulting in a new one-dimensional array over a
+	++ possibly different underlying domain.
+
+  Implementation ==> add
+    map(f, v)       == map(f, v)$O2
+    scan(f, v, b)   == scan(f, v, b)$O2
+    reduce(f, v, b) == reduce(f, v, b)$O2
+
+@
+\section{License}
+<<license>>=
+--Copyright (c) 1991-2002, The Numerical ALgorithms Group Ltd.
+--All rights reserved.
+--
+--Redistribution and use in source and binary forms, with or without
+--modification, are permitted provided that the following conditions are
+--met:
+--
+--    - Redistributions of source code must retain the above copyright
+--      notice, this list of conditions and the following disclaimer.
+--
+--    - Redistributions in binary form must reproduce the above copyright
+--      notice, this list of conditions and the following disclaimer in
+--      the documentation and/or other materials provided with the
+--      distribution.
+--
+--    - Neither the name of The Numerical ALgorithms Group Ltd. nor the
+--      names of its contributors may be used to endorse or promote products
+--      derived from this software without specific prior written permission.
+--
+--THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS
+--IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+--TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+--PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
+--OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
+--EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
+--PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR
+--PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
+--LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
+--NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
+--SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+@
+<<*>>=
+<<license>>
+
+<<domain PRIMARR PrimitiveArray>>
+<<package PRIMARR2 PrimitiveArrayFunctions2>>
+<<domain TUPLE Tuple>>
+<<domain IFARRAY IndexedFlexibleArray>>
+<<domain FARRAY FlexibleArray>>
+<<domain IARRAY1 IndexedOneDimensionalArray>>
+<<domain ARRAY1 OneDimensionalArray>>
+<<package ARRAY12 OneDimensionalArrayFunctions2>>
+
+--%% TupleFunctions2
+--TupleFunctions2(A:Type, B:Type): with
+--  map: (A -> B, Tuple A) -> Tuple B
+-- == add
+--  map(f, t) ==
+--    p:PrimitiveArray(B) := new length t
+--    for i in minIndex p .. maxIndex p repeat
+--      p.i := f select(t, i)
+--    p::Tuple(B)
+
+@
+\eject
+\begin{thebibliography}{99}
+\bibitem{1} nothing
+\end{thebibliography}
+\end{document}