\documentclass{article}
\usepackage{axiom}
\begin{document}
\title{\$SPAD/src/algebra array1.spad}
\author{Gabriel Dos Reis, 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
   #x == 
     sizeOfSimpleArray(x)$Lisp

   minIndex x == 
     0

   empty() == 
     makeSimpleArray(getVMType(S)$Lisp,0$Lisp)$Lisp

   new(n, x) == 
     makeFilledSimpleArray(getVMType(S)$Lisp,n,x)$Lisp

   qelt(x, i) == 
     getSimpleArrayEntry(x,i)$Lisp

   elt(x:%, i:Integer) == 
     getSimpleArrayEntry(x,i)$Lisp

   qsetelt!(x, i, s) == 
     setSimpleArrayEntry(x,i,s)$Lisp

   setelt(x:%, i:Integer, s:S) == 
     setSimpleArrayEntry(x,i,s)$Lisp
     
   fill!(x, s) == 
     for i in 0..maxIndexOfSimpleArray(x)$Lisp repeat 
       setSimpleArrayEntry(x, i, s)$Lisp
     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 '|PRIMARR;#;$Nni;1| '|SPADreplace| '|sizeOfSimpleArray|) 

(DEFUN |PRIMARR;#;$Nni;1| (|x| $) (|sizeOfSimpleArray| |x|)) 

(PUT '|PRIMARR;minIndex;$I;2| '|SPADreplace| '(XLAM (|x|) 0)) 

(DEFUN |PRIMARR;minIndex;$I;2| (|x| $) 0) 

(DEFUN |PRIMARR;empty;$;3| ($)
  (|makeSimpleArray| (|getVMType| (|getShellEntry| $ 6)) 0)) 

(DEFUN |PRIMARR;new;NniS$;4| (|n| |x| $)
  (|makeFilledSimpleArray| (|getVMType| (|getShellEntry| $ 6)) |n| |x|)) 

(PUT '|PRIMARR;qelt;$IS;5| '|SPADreplace| '|getSimpleArrayEntry|) 

(DEFUN |PRIMARR;qelt;$IS;5| (|x| |i| $)
  (|getSimpleArrayEntry| |x| |i|)) 

(PUT '|PRIMARR;elt;$IS;6| '|SPADreplace| '|getSimpleArrayEntry|) 

(DEFUN |PRIMARR;elt;$IS;6| (|x| |i| $)
  (|getSimpleArrayEntry| |x| |i|)) 

(PUT '|PRIMARR;qsetelt!;$I2S;7| '|SPADreplace| '|setSimpleArrayEntry|) 

(DEFUN |PRIMARR;qsetelt!;$I2S;7| (|x| |i| |s| $)
  (|setSimpleArrayEntry| |x| |i| |s|)) 

(PUT '|PRIMARR;setelt;$I2S;8| '|SPADreplace| '|setSimpleArrayEntry|) 

(DEFUN |PRIMARR;setelt;$I2S;8| (|x| |i| |s| $)
  (|setSimpleArrayEntry| |x| |i| |s|)) 

(DEFUN |PRIMARR;fill!;$S$;9| (|x| |s| $)
  (PROG (|i| #0=#:G1403)
    (RETURN
      (SEQ (SEQ (LETT |i| 0 |PRIMARR;fill!;$S$;9|)
                (LETT #0# (|maxIndexOfSimpleArray| |x|)
                      |PRIMARR;fill!;$S$;9|)
                G190 (COND ((QSGREATERP |i| #0#) (GO G191)))
                (SEQ (EXIT (|setSimpleArrayEntry| |x| |i| |s|)))
                (LETT |i| (QSADD1 |i|) |PRIMARR;fill!;$S$;9|) (GO G190)
                G191 (EXIT NIL))
           (EXIT |x|))))) 

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

(DEFUN |PrimitiveArray;| (|#1|)
  (PROG (|dv$1| |dv$| $ |pv$|)
    (RETURN
      (PROGN
        (LETT |dv$1| (|devaluate| |#1|) . #0=(|PrimitiveArray|))
        (LETT |dv$| (LIST '|PrimitiveArray| |dv$1|) . #0#)
        (LETT $ (|newShell| 35) . #0#)
        (|setShellEntry| $ 0 |dv$|)
        (|setShellEntry| $ 3
            (LETT |pv$|
                  (|buildPredVector| 0 0
                      (LIST (OR (AND (|HasCategory| |#1|
                                      '(|OrderedSet|))
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|))))
                                (AND (|HasCategory| |#1|
                                      '(|SetCategory|))
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|)))))
                            (OR (AND (|HasCategory| |#1|
                                      '(|SetCategory|))
                                     (|HasCategory| |#1|
                                      (LIST '|Evalable|
                                       (|devaluate| |#1|))))
                                (|HasCategory| |#1|
                                    '(|CoercibleTo| (|OutputForm|))))
                            (|HasCategory| |#1|
                                '(|ConvertibleTo| (|InputForm|)))
                            (OR (|HasCategory| |#1| '(|OrderedSet|))
                                (|HasCategory| |#1| '(|SetCategory|)))
                            (|HasCategory| |#1| '(|OrderedSet|))
                            (|HasCategory| (|Integer|) '(|OrderedSet|))
                            (|HasCategory| |#1| '(|SetCategory|))
                            (AND (|HasCategory| |#1| '(|SetCategory|))
                                 (|HasCategory| |#1|
                                     (LIST '|Evalable|
                                      (|devaluate| |#1|))))
                            (|HasCategory| |#1|
                                '(|CoercibleTo| (|OutputForm|))))) . #0#))
        (|haddProp| |$ConstructorCache| '|PrimitiveArray| (LIST |dv$1|)
            (CONS 1 $))
        (|stuffDomainSlots| $)
        (|setShellEntry| $ 6 |#1|)
        $)))) 

(MAKEPROP '|PrimitiveArray| '|infovec|
    (LIST '#(NIL NIL NIL NIL NIL NIL (|local| |#1|)
             (|NonNegativeInteger|) |PRIMARR;#;$Nni;1| (|Integer|)
             |PRIMARR;minIndex;$I;2| |PRIMARR;empty;$;3|
             |PRIMARR;new;NniS$;4| |PRIMARR;qelt;$IS;5|
             |PRIMARR;elt;$IS;6| |PRIMARR;qsetelt!;$I2S;7|
             |PRIMARR;setelt;$I2S;8| |PRIMARR;fill!;$S$;9|
             (|Mapping| 6 6 6) (|Boolean|) (|List| 6) (|Equation| 6)
             (|List| 21) (|Mapping| 19 6) (|Mapping| 19 6 6)
             (|UniversalSegment| 9) (|Void|) (|Mapping| 6 6)
             (|OutputForm|) (|InputForm|) (|String|) (|SingleInteger|)
             (|List| $) (|Union| 6 '"failed") (|List| 9))
          '#(~= 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)
          '((|shallowlyMutable| . 0) (|finiteAggregate| . 0))
          (CONS (|makeByteWordVec2| 5
                    '(0 0 0 0 0 0 5 0 0 1 4 0 0 1 2 3 4))
                (CONS '#(|OneDimensionalArrayAggregate&|
                         |FiniteLinearAggregate&| |LinearAggregate&|
                         |IndexedAggregate&| |Collection&|
                         |HomogeneousAggregate&| |OrderedSet&|
                         |Aggregate&| |EltableAggregate&| |Evalable&|
                         |SetCategory&| NIL NIL |InnerEvalable&| NIL
                         NIL |BasicType&|)
                      (CONS '#((|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| 28)
                               (|ConvertibleTo| 29) (|BasicType|))
                            (|makeByteWordVec2| 34
                                '(2 7 19 0 0 1 3 0 26 0 9 9 1 1 5 19 0
                                  1 2 0 19 24 0 1 1 5 0 0 1 2 0 0 24 0
                                  1 1 5 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 16 2 0 0
                                  23 0 1 0 0 0 1 1 0 0 0 1 1 0 0 0 1 1
                                  7 0 0 1 2 7 0 6 0 1 2 0 0 23 0 1 4 7
                                  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 15 2 0 6 0 9 13 2 7 9
                                  6 0 1 3 7 9 6 0 9 1 2 0 9 23 0 1 1 0
                                  20 0 1 2 0 0 7 6 12 2 0 19 0 7 1 1 6
                                  9 0 10 2 5 0 0 0 1 2 5 0 0 0 1 3 0 0
                                  24 0 0 1 1 0 20 0 1 2 7 19 6 0 1 1 6
                                  9 0 1 2 5 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
                                  7 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 7 31 0 1 1
                                  6 6 0 1 2 0 33 23 0 1 2 0 0 0 6 17 2
                                  0 19 23 0 1 3 8 0 0 20 20 1 2 8 0 0
                                  21 1 3 8 0 0 6 6 1 2 8 0 0 22 1 2 0
                                  19 0 0 1 2 7 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 14 3 0 6 0 9 6 1 2 0 0 0 9 1 2 0 0
                                  0 25 1 2 7 7 6 0 1 2 0 7 23 0 1 3 0 0
                                  0 0 9 1 1 0 0 0 1 1 3 29 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 9 28 0 1 2 0 19 23 0 1
                                  2 5 19 0 0 1 2 5 19 0 0 1 2 7 19 0 0
                                  1 2 5 19 0 0 1 2 5 19 0 0 1 1 0 7 0
                                  8)))))
          '|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 CoercibleTo(OutputForm) then CoercibleTo(OutputForm)
  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)
  if S has CoercibleTo(OutputForm) then
    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}