--* From BMT%WATSON.vnet.ibm.com@yktvmv.watson.ibm.com  Tue Aug  9 19:21:15 1994
--* Received: from yktvmv-ob.watson.ibm.com by asharp.watson.ibm.com (AIX 3.2/UCB 5.64/930311)
--*           id AA15586; Tue, 9 Aug 1994 19:21:15 -0400
--* Received: from watson.vnet.ibm.com by yktvmv.watson.ibm.com (IBM VM SMTP V2R3)
--*    with BSMTP id 4079; Tue, 09 Aug 94 19:21:19 EDT
--* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id <A.BMT.NOTE.VAGENT2.9103.Aug.09.19:21:18.-0400>
--*           for asbugs@watson; Tue, 09 Aug 94 19:21:18 -0400
--* Received: from YKTVMV by watson.vnet.ibm.com with "VAGENT.V1.0"
--*           id 9097; Tue, 9 Aug 1994 19:21:18 EDT
--* Received: from spadserv.watson.ibm.com by yktvmv.watson.ibm.com
--*    (IBM VM SMTP V2R3) with TCP; Tue, 09 Aug 94 19:21:17 EDT
--* Received: by spadserv.watson.ibm.com (AIX 3.2/UCB 5.64/900524)
--*           id AA20853; Tue, 9 Aug 1994 19:18:57 -0400
--* Date: Tue, 9 Aug 1994 19:18:57 -0400
--* From: bmt@spadserv.watson.ibm.com
--* X-External-Networks: yes
--* Message-Id: <9408092318.AA20853@spadserv.watson.ibm.com>
--* To: asbugs@watson.ibm.com
--* Subject: [2] compiler takes program fault and complains about 2 meanings for maxIndex (wrong)

--@ Fixed  by:  SSD   Thu Aug 11 18:14:23 EDT 1994 
--@ Tested by:  none 
--@ Summary:    Superceded by bug796 


-- Command line: asharp -O -Fasy -Faso -Flsp -laxiom -Daxiom defaults2.as
-- Version: 0.36.1
-- Original bug file name: defaults2.as

#pile
#include "axiom.as"


+++ Implements exponentiation by repeated squaring
MyRepeatedSquaring (S: SemiGroup): with { expt: (S,PositiveInteger) -> S  }
== add {
        import from Boolean;
        default x: S;
        default n: PositiveInteger;
        expt(x:S,n:PositiveInteger):S == {
                one? n => x;
                odd?(n::Integer)$Integer =>
                  x *
                    expt(x * x,shift(n::NonNegativeInteger,- 1@Integer) pretend
                       PositiveInteger);
                expt(x * x,shift(n::NonNegativeInteger,- 1@Integer) pretend
                  PositiveInteger);
        }

}



+++ Implements multiplication by repeated addition
MyRepeatedDoubling (S: AbelianSemiGroup): with {
        double: (PositiveInteger,S) -> S;
                ++ `double(i, r)' multiplies `r' by `i' using repeated doubling.

}
== add {
        default x: S;
        default n: PositiveInteger;
        double(n:PositiveInteger,x:S):S == {
                one? n => x;
                odd?(n::Integer)$Integer =>
                  x +
                    double(shift(n::NonNegativeInteger,- 1@Integer) pretend
                      PositiveInteger,x + x);
                double(shift(n::NonNegativeInteger,- 1@Integer) pretend
                  PositiveInteger,x + x);
        }

}

B ==> Boolean

I ==> Integer


+++ This package exports 3 sorting algorithms which work over
+++ FiniteLinearAggregates.
MyFiniteLinearAggregateSort(S: Type,V: FiniteLinearAggregate S with {
        shallowlyMutable;
                                  }): with {
        quickSort: ((S,S) -> B,V) -> V;
        heapSort: ((S,S) -> B,V) -> V;
        shellSort: ((S,S) -> B,V) -> V;
}
== add {
        import from S;
        default siftUp: ((S,S) -> B,V,I,I) -> ();
        default partition: ((S,S) -> B,V,I,I,I) -> I;
        default QuickSort: ((S,S) -> B,V,I,I) -> V;
        quickSort(l:(S,S) -> B,r:V):V == QuickSort(l,r,minIndex r,maxIndex r);
        siftUp(l:(S,S) -> B,r:V,i:I,n:I):() == {
                t := qelt(r,i);
                while (j := 2 @ Integer * i + 1) < n repeat {
                        k := j + 1;
                        k < n => {
                                G1092 := l(qelt(r,j),qelt(r,k));
                                if G1092 then j := k;
                        }
                        G1093 := l(t,qelt(r,j));
                        G1093 => {
                                qsetelt!(r,i,qelt(r,j));
                                qsetelt!(r,j,t);
                                i := j;
                        }
                        break;
                }
        }

        heapSort(l:(S,S) -> B,r:V):V == {
                import from Segment I;
                G1094 := zero? minIndex r;
                { G1094 => noBranch; error "not implemented" };
                n := #r::Integer;
                for k in shift(n,(- 1)::Integer) - 1::Integer..0::Integer by
                  (- 1)::Integer repeat siftUp(l,r,k,n);
                for k in n - 1::Integer..1::Integer by (- 1)::Integer repeat {
                        swap!(r,0::Integer,k);
                        siftUp(l,r,0::Integer,k);
                }
                r;
        }

        partition(l:(S,S) -> B,r:V,i:I,j:I,k:I):I == {
                x := qelt(r,k);
                t := qelt(r,i);
                qsetelt!(r,k,qelt(r,j));
                while i < j repeat {
                        G1095 := l(x,t);
                        G1095 => {
                                qsetelt!(r,j,t);
                                j := j - 1;
                                t := qsetelt!(r,i,qelt(r,j));
                        }
                        i := i + 1;
                        t := qelt(r,i);
                }
                qsetelt!(r,j,x);
                j;
        }

        QuickSort(l:(S,S) -> B,r:V,i:I,j:I):V == {
                n := j - i;
                G1096 := one? n;
                G1096 => {
                        G1097 := l(qelt(r,j),qelt(r,i));
                        G1097 => swap!(r,i,j);
                }
                n < 2 @ Integer => return r;
                k := partition(l,r,i,j,i + shift(n,- 1));
                QuickSort(l,r,i,k - 1);
                QuickSort(l,r,k + 1,j);
        }

        shellSort(l:(S,S) -> B,r:V):V == {
                import from Segment I;
                m := minIndex r;
                n := maxIndex r;
                g := 1;
                while ( G1098 := n - m < g; G1098 => false; true ) repeat
                  g := 3 @ Integer * g + 1;
                g := g quo 3 @ Integer;
                while 0 < g repeat {
                        for i in m + g..n by 1 @ Integer repeat {
                                j := i - g;
                                while  (
                                  j < m => false;
                                  l(qelt(r,j + g),qelt(r,j)))  repeat {
                                        swap!(r,j,j + g);
                                        j := j - g;
                                }
                        }
                        g := g quo 3 @ Integer;
                }
                r;
        }

}