
    <<LichenNestArrays.Mesa>>
<<Last Edited by: Spreitzer, July 11, 1985 9:01:03 pm PDT>>

    DIRECTORY Asserting, Basics, Convert, IO, LichenDataStructure, LichenOps, LichenTransforms, LichenTransformsPrivate, Rope;

    LichenNestArrays: CEDAR PROGRAM
        IMPORTS IO, LichenDataStructure, LichenOps
        EXPORTS LichenOps

        = BEGIN OPEN LichenDataStructure, LichenOps, LichenTransforms, LichenTransformsPrivate;

        <<Array theorems:>>
            <<TA1: Each connection across a boundary involves one port from each of an uninterrupted range of elements on either side, with 
            some overlap, and each pairing in that overlap is represented in the joints.>>
        <<>>
        XForm: TYPE = RECORD [
            mirror: ARRAY Dim OF BOOL,
            shift: ArrayIndex,
            variant: SELECT transpose: BOOL FROM
                FALSE, TRUE => [],
                ENDCASE
            ] _ [[FALSE, FALSE], [0, 0], FALSE[]];

        SimpleXForm: TYPE = XForm[FALSE];

        id: SimpleXForm = [[FALSE, FALSE], [0, 0], FALSE[]];

        NestCellTypes: PROC [outer: CellType] RETURNS [results: Results] = {
            oa: Array _ outer.asArray;
            inner: CellType;
            ia, nested: Array;
            IF oa = NIL THEN RETURN;
            inner _ oa.eltType;
            ia _ inner.asArray;
            IF ia = NIL THEN RETURN;
            [nested, results] _ NestArrays[oa, ia];
            IF nested # NIL THEN outer.asArray _ nested;
            };

        NestArrays: PROC [outer, inner: Array] RETURNS [nested: Array, results: Results] = {
            Try: PROC [t0: XForm] RETURNS [success: BOOL] = {
                ia: Array _ Apply[t0, inner];
                r: Result _ TryToNest[outer, ia];
                results[t0.mirror[Foo]][t0.mirror[Bar]][t0.transpose] _ r;
                IF (success _ r.code = $success) THEN nested _ ia;
                };
            innerSize: ArrayIndex = [
                Foo: inner.shape[Foo].maxPlusOne - inner.shape[Foo].min,
                Bar: inner.shape[Bar].maxPlusOne - inner.shape[Bar].min];
            s00: ArrayIndex = [
                Foo: outer.shape[Foo].min * innerSize[Foo],
                Bar: outer.shape[Bar].min * innerSize[Bar]];
            s01: ArrayIndex = [Foo: s00[Bar], Bar: s00[Foo]];
            FOR mf0: BOOL IN BOOL DO FOR mb0: BOOL IN BOOL DO
                IF Try[[[mf0, mb0], s00, FALSE[]]] THEN RETURN;
                IF Try[[[mf0, mb0], s01, TRUE[]]] THEN RETURN;
                ENDLOOP ENDLOOP;
            nested _ NIL;
            };

        Results: TYPE = ARRAY BOOL--mf-- OF ARRAY BOOL--mb-- OF ARRAY BOOL--t-- OF Result _ ALL[ALL[ALL[nyet]]];

        Result: TYPE = RECORD [code: ATOM, explanation: ROPE];

        ok: Result = [$success, "success"];
        nyet: Result = [$notYet, "notYet"];

        TryToNest: PROC [outer, inner: Array] RETURNS [result: Result] = {
            outerSize: ArrayIndex = [
                Foo: outer.shape[Foo].maxPlusOne - outer.shape[Foo].min,
                Bar: outer.shape[Bar].maxPlusOne - outer.shape[Bar].min];
            innerSize: ArrayIndex = [
                Foo: inner.shape[Foo].maxPlusOne - inner.shape[Foo].min,
                Bar: inner.shape[Bar].maxPlusOne - inner.shape[Bar].min];
            FOR d: Dim IN Dim DO FOR perp: EO IN EO DO FOR parl: EO IN EO DO
                od: Dim = OtherDim[d];
                oj: Joint _ outer.joints[d][perp][parl];
                derive: BOOL _ FALSE;
                EnumerateRelevantMinorJoints: PROC
                    [PerJoint: PROC [mD: Dim, mPerp, mParl: EO, iLow, iHigh: ArrayIndex] RETURNS [r: Result]]
                    RETURNS [r: Result] = {
                    i: ArrayIndex _ [Foo: inner.shape[Foo].min, Bar: inner.shape[Bar].min];
                    nPar: INT _ SELECT parl FROM Odd => 1, Even => 2, ENDCASE => ERROR;
                    nPer: INT _ innerSize[od];
                    r _ ok;
                    i[d] _ i[d] + nPar * innerSize[d];
                    THROUGH [0 .. nPer) DO
                        iLow: ArrayIndex _ i;
                        iLow[d] _ iLow[d] - 1;
                        r _ PerJoint[mD: d, mPerp: EOOfInt[i[od]], mParl: EOOfInt[i[d]], iLow: iLow, iHigh: i];
                        IF r.code # $success THEN RETURN;
                        i[od] _ i[od] + 1;
                        ENDLOOP;
                    r _ r;
                    };
                EnumerateConnectionsFromMajor: PROC
                    [PerConnection: PROC [lopi, hopi: PortIndex, lowRange, highRange: SideConnection] RETURNS [r: Result]]
                    RETURNS [r: Result] = {
                    r _ ok;
                    FOR lopi: PortIndex IN [0 .. oj.eltPorts) DO
                        hopi: PortIndex _ oj[lopi].high;
                        IF hopi = NullPortIndex THEN LOOP;
                        r _ PerConnection[
                            lopi: lopi, hopi: hopi,
                            lowRange: inner.portConnections[lopi][high][d],
                            highRange: inner.portConnections[hopi][low][d]];
                        IF r.code # $success THEN RETURN;
                        ENDLOOP;
                    };
                InnerJointsDefined: PROC RETURNS [defined: BOOL] = {
                    someDefined: BOOL _ FALSE;
                    allDefined: BOOL _ TRUE;
                    PerJoint: PROC [mD: Dim, mPerp, mParl: EO, iLow, iHigh: ArrayIndex] RETURNS [r: Result] = {
                        r _ ok;
                        IF inner.joints[mD][mPerp][mParl] # NIL
                            THEN someDefined _ TRUE
                            ELSE {allDefined _ FALSE; inner.joints[mD][mPerp][mParl] _ NewJoint[]}
                        };
                    NewJoint: PROC RETURNS [j: Joint] = {
                        j _ NEW [JointSeq[inner.eltType.ports.length]];
                        FOR pi: PortIndex IN [0 .. j.eltPorts) DO
                            j[pi] _ [NullPortIndex, NullPortIndex];
                            ENDLOOP;
                        };
                    [] _ EnumerateRelevantMinorJoints[PerJoint];
                    IF someDefined # allDefined THEN ERROR;
                    defined _ someDefined;
                    };
                MinorsFromMajor: PROC RETURNS [result: Result] = {
                    PerConnection: PROC [lopi, hopi: PortIndex, lowRange, highRange: SideConnection] RETURNS [r: Result] = {
                        EnumerateOverlap: PROC
                            [PerPair: PROC [low, high: ArraySocket] RETURNS [r: Result]]
                            RETURNS [r: Result] = {
                            min: INT _ MAX[lowRange.range.min, highRange.range.min];
                            maxPlusOne: INT _ MIN[lowRange.range.maxPlusOne, highRange.range.maxPlusOne];
                            Burn: PROC [sc: SideConnection] RETURNS [asl: ArraySocketList] = {
                                asl _ sc.sockets;
                                THROUGH [sc.range.min .. min) DO asl _ asl.rest ENDLOOP;
                                };
                            lsl, hsl: ArraySocketList;
                            r _ ok;
                            IF min >= maxPlusOne THEN RETURN [[
                                $subtlyWrong,
                                IO.PutFR["no inner overlap in outer connection %g",
                                    IO.rope[DescribeConnection[outer.eltType, lopi, hopi, d, perp, parl]]
                                    ]
                                ]];
                            lsl _ Burn[lowRange];
                            hsl _ Burn[highRange];
                            WHILE min < maxPlusOne DO
                                r _ PerPair[lsl.first, hsl.first];
                                IF r.code # $success THEN RETURN;
                                lsl _ lsl.rest;
                                hsl _ hsl.rest;
                                min _ min + 1;
                                ENDLOOP;
                            };
                        PerPair: PROC [low, high: ArraySocket] RETURNS [r: Result] = {
                            j: Joint;
                            mPerp, mParl: EO;
                            [j, mPerp, mParl] _ ArrayJoint[inner, high.ai, d];
                            SELECT derive FROM
                                FALSE => {
                                    IF j[low.pi].high # high.pi THEN RETURN [[
                                        $subtlyWrong,
                                        IO.PutFR["outer connection %g missing in inner joint %g",
                                            IO.rope[DescribeConnection[outer.eltType, lopi, hopi, d, perp, parl]],
                                            IO.rope[DescribeJointDetails[d, mPerp, mParl]]
                                            ]
                                        ]];
                                    };
                                TRUE => {
                                    j[low.pi].high _ high.pi; j[high.pi].low _ low.pi;
                                    };
                                ENDCASE => ERROR;
                            r _ ok;
                            };
                        r _ EnumerateOverlap[PerPair];
                        };
                    result _ EnumerateConnectionsFromMajor[PerConnection];
                    };
                CheckMinorsInMajor: PROC RETURNS [result: Result] = {
                    PerJoint: PROC [mD: Dim, mPerp, mParl: EO, iLow, iHigh: ArrayIndex] RETURNS [r: Result] = {
                        j: Joint _ inner.joints[mD][mPerp][mParl];
                        r _ ok;
                        FOR lipi: PortIndex--on inner elts-- IN [0 .. j.eltPorts) DO
                            hipi: PortIndex _ j[lopi].high;
                            lopi, hopi: PortIndex--on inner array--;
                            IF hipi = NullPortIndex THEN LOOP;
                            lopi _ GetArrayPort[inner, iLow, lipi];
                            hopi _ GetArrayPort[inner, iHigh, hipi];
                            IF oj[lopi].high # hopi THEN RETURN [[
                                $subtlyWrong,
                                IO.PutFR["inner connection %g missing in outer joint %g",
                                    IO.rope[DescribeConnection[inner.eltType, lipi, hipi, mD, mPerp, mParl]],
                                    IO.rope[DescribeJointDetails[d, perp, parl]]
                                    ]
                                ]];
                            ENDLOOP;
                        };
                    result _ EnumerateRelevantMinorJoints[PerJoint];
                    };
                IF oj = NIL THEN LOOP;
                derive _ NOT InnerJointsDefined[];
                result _ MinorsFromMajor[];
                IF result.code # $success THEN RETURN;
                result _ CheckMinorsInMajor[];
                IF result.code # $success THEN RETURN;
                ENDLOOP ENDLOOP ENDLOOP;
            <<Now we make nested>>
                {
                nested: Array = NEW [ArrayRep[inner.eltType.ports.length]];
                SCUnion: PROC [sc: SideConnection, tail: ArraySocketList, oai: ArrayIndex, isc: SideConnection, od: Dim] RETURNS [usc: 
                SideConnection, uTail: ArraySocketList] = {
                    
                    usc _ sc;
                    uTail _ tail;
                    isc.range _ [
                        min: isc.range.min + 
                        maxPlusOne: isc.range.maxPlusOne + 
                    IF usc.range.min = usc.range.maxPlusOne
                        THEN {
                            usc.range _ isc.range;
                            }
                        ELSE {
                            IF usc.range.maxPlusOne # isc.range.min THEN ERROR;
                            usc.range.maxPlusOne _ isc.range.maxPlusOne;
                            };
                    WHILE isc.sockets # NIL DO
                        this: ArraySocketList _ LIST[isc.sockets.first];
                        this.first.ai[Foo] _ this.first.ai[Foo] + 
                        this.first.ai[Bar] _ this.first.ai[Bar] + 
                        IF uTail = NIL THEN usc.sockets _ this ELSE uTail.rest _ this;
                        uTail _ this;
                        isc.sockets _ isc.sockets.rest;
                        ENDLOOP;
                    };
                nested.eltType _ inner.eltType;
                nested.shape _ [
                    Foo: [
                        min: inner.shape[Foo].min,
                        maxPlusOne: inner.shape[Foo].min + innerSize[Foo]*outerSize[Foo]],
                    Bar: [
                        min: inner.shape[Bar].min,
                        maxPlusOne: inner.shape[Bar].min + innerSize[Bar]*outerSize[Bar]]
                    ];
                nested.joints _ inner.joints;
                nested.portConnections _ NEW [ArrayPortConnectionSeq[outer.portConnections.arrayPorts]];
                FOR epi: PortIndex IN [0 .. nested.eltType.ports.length) DO
                    Check: PROC [f, b: INT] = {
                        oi: ArrayIndex = [
                            Foo: (f-nested.shape[Foo].min)/innerSize[Foo]+outer.shape[Foo].min,
                            Bar: (b-nested.shape[Bar].min)/innerSize[Bar]+outer.shape[Bar].min
                            ];
                        ii: ArrayIndex = [Foo: f - oi[Foo]*innerSize[Foo], Bar: b - oi[Bar]*innerSize[Bar]];
                        mpi: PortIndex _ GetArrayPort[inner, ii, epi];
                        IF mpi # NullPortIndex THEN {
                            api: PortIndex _ GetArrayPort[outer, oi, mpi];
                            IF api # NullPortIndex THEN {
                                IF nested.porting[epi] = notPorted THEN nested.porting[epi] _ NewDetailedPorting[nested.shape];
                                SetArrayPort[nested, [f, b], epi, api];
                                };
                            };
                        };
                    nested.porting[epi] _ notPorted;
                    IF inner.porting[epi] # notPorted THEN {
                        Check[nested.shape[Foo].min, nested.shape[Bar].min];
                        Check[nested.shape[Foo].min, nested.shape[Bar].maxPlusOne-1];
                        Check[nested.shape[Foo].maxPlusOne-1, nested.shape[Bar].min];
                        Check[nested.shape[Foo].maxPlusOne-1, nested.shape[Bar].maxPlusOne-1];
                        FOR e: End IN End DO FOR d: Dim IN Dim DO
                            od: Dim = OtherDim[d];
                            FOR i: INT IN [nested.shape[od].min .. nested.shape[od].maxPlusOne) DO
                                index: ArrayIndex _ ALL[0];
                                index[d] _ SELECT e FROM low => nested.shape[d].min, high => nested.shape[d].maxPlusOne-1, ENDCASE => ERROR;
                                index[od] _ i;
                                Check[index[Foo], index[Bar]];
                                ENDLOOP;
                            ENDLOOP ENDLOOP;
                        };
                    ENDLOOP;
                FOR opi: PortIndex IN [0 .. outer.portConnections.arrayPorts) DO
                    FOR e: End IN End DO FOR d: Dim IN Dim DO
                        sc: SideConnection _ [[0, 0], NIL];
                        tail: ArraySocketList _ NIL;
                        FOR oasl: ArraySocketList _ outer.portConnections[opi][e][d].sockets, oasl.rest WHILE oasl # NIL DO
                            [sc, tail] _ SCUnion[sc, tail, oasl.first.ai, inner.portConnections[oasl.first.pi][e][d], OtherDim[d]];
                            ENDLOOP;
                        nested.portConnections[opi][e][d] _ sc;
                        ENDLOOP ENDLOOP;
                    ENDLOOP;
                };
            };

        ArrayJoint: PROC [a: Array, index: ArrayIndex, d: Dim] RETURNS [j: Joint, perp, parl: EO] = {
            perp _ EOOfInt[index[OtherDim[d]]];
            parl _ EOOfInt[index[d]];
            j _ a.joints[d][perp][parl]};

        GetArrayPort: PUBLIC PROC [a: Array, index: ArrayIndex, eltPortIndex: PortIndex] RETURNS [arrayPortIndex: PortIndex] = {
            Get: PROC [ppi: PortIndexPtr] = TRUSTED {arrayPortIndex _ IF ppi # NIL THEN ppi^ ELSE NullPortIndex};
            ForArrayPort[a, index, eltPortIndex, Get]};

        SetArrayPort: PROC [a: Array, index: ArrayIndex, eltPortIndex, arrayPortIndex: PortIndex] = {
            Set: PROC [ppi: PortIndexPtr] = TRUSTED {IF ppi # NIL THEN ppi^ _ arrayPortIndex ELSE ERROR};
            ForArrayPort[a, index, eltPortIndex, Set]};

        PortIndexPtr: TYPE = LONG POINTER TO PortIndex;

        ForArrayPort: PROC [a: Array, index: ArrayIndex, eltPortIndex: PortIndex, p: PROC [ppi: PortIndexPtr]] = TRUSTED {
            SELECT a.porting[eltPortIndex] FROM
                notPorted => p[NIL];
                unknownPorting => ERROR;
                ENDCASE => {dp: DetailedPorting _ NARROW[a.porting[eltPortIndex]];
                    For: PROC [si: SideIndex, offset: NAT] = TRUSTED {
                        s: NAT _ si.firstSlot;
                        IF NOT si.same THEN s _ s + offset;
                        p[@dp.slots[s]]};
                    wF: Where = WhereIs[index[Foo], a.shape[Foo]];
                    wB: Where = WhereIs[index[Bar], a.shape[Bar]];
                    WITH f: wF SELECT FROM
                        end => WITH b: wB SELECT FROM
                            end => p[@dp.corners[f.end][b.end]];
                            center => For[dp.sideIndices[f.end][Bar], b.offset];
                            ENDCASE => ERROR;
                        center => WITH b: wB SELECT FROM
                            end => For[dp.sideIndices[b.end][Foo], f.offset];
                            center => ERROR;
                            ENDCASE => ERROR;
                        ENDCASE => ERROR;
                    };
            };

        Where: TYPE = RECORD [
            variant: SELECT kind: * FROM
                end => [end: End],
                center => [offset: NAT],
                ENDCASE];

        WhereIs: PROC [i: INT, r: Range] RETURNS [w: Where] = {
            i _ r.min + ((i - r.min) MOD (r.maxPlusOne - r.min));
            SELECT TRUE FROM
                i = r.min => RETURN [[end[low]]];
                i+1 = r.maxPlusOne => RETURN [[end[high]]];
                ENDCASE => RETURN [[center[i - (r.min+1)]]];
            };

        Apply: PROC [x: XForm, a: Array] RETURNS [xa: Array] = {
            xa _ CopyArray[a];
            FOR d: Dim IN Dim DO IF x.mirror[d] THEN Mirror[xa, d] ENDLOOP;
            Shift[xa, x.shift];
            IF x.transpose THEN Transpose[xa];
            };

        Mirror: PROC [a: Array, d: Dim] = {
            od: Dim _ OtherDim[d];
            parlSize: INT _ a.shape[d].maxPlusOne - a.shape[d].min;
            parlEO: EO _ EOOfInt[parlSize];
            MirrorIndex: PROC [i: INT] RETURNS [j: INT] =
                {j _ a.shape[d].maxPlusOne-1 - (i - a.shape[d].min)};
            MirrorJoint: PROC [j: Joint] RETURNS [k: Joint] = {
                IF j = NIL THEN RETURN [j];
                k _ NEW [JointSeq[j.eltPorts]];
                FOR pi: PortIndex IN [0 .. j.eltPorts) DO
                    k[pi] _ [low: j[pi].high, high: j[pi].low];
                    ENDLOOP;
                };
            FOR jd: Dim IN Dim DO FOR eo: EO IN EO DO
                perp2: EO _ eo;
                parl2: EO _ eo;
                MirrorParl: PROC [eo: EO] RETURNS [meo: EO] = {
                    meo _ SELECT parlEO FROM Even => eo, Odd => OtherEO[eo], ENDCASE => ERROR;
                    };
                MirrorPerp: PROC [eo: EO] RETURNS [meo: EO] = {
                    meo _ SELECT parlEO FROM Even => OtherEO[eo], Odd => eo, ENDCASE => ERROR;
                    };
                SELECT jd FROM
                     d => parl2 _ MirrorParl[eo];
                    od => perp2 _ MirrorPerp[eo];
                    ENDCASE => ERROR;
                [a.joints[jd][eo][eo], a.joints[jd][perp2][parl2]] _ JSwap[a.joints[jd][eo][eo], a.joints[jd][perp2][parl2]];
                ENDLOOP ENDLOOP;
            FOR perp: EO IN EO DO FOR parl: EO IN EO DO
                a.joints[d][perp][parl] _ MirrorJoint[a.joints[d][perp][parl]];
                ENDLOOP ENDLOOP;
            FOR api: PortIndex IN [0 .. a.portConnections.arrayPorts) DO
                MirrorSC: PROC [sc: SideConnection] RETURNS [msc: SideConnection] = {
                    msc.range.min _ MirrorIndex[sc.range.maxPlusOne-1];
                    msc.range.maxPlusOne _ MirrorIndex[sc.range.min]+1;
                    msc.sockets _ NIL;
                    WHILE sc.sockets # NIL DO
                        msc.sockets _ CONS[sc.sockets.first, msc.sockets];
                        msc.sockets.first.ai[d] _ MirrorIndex[msc.sockets.first.ai[d]];
                        sc.sockets _ sc.sockets.rest;
                        ENDLOOP;
                    };
                tsc: SideConnection _ a.portConnections[api][low][d];
                a.portConnections[api][low][d] _ a.portConnections[api][high][d];
                a.portConnections[api][high][d] _ tsc;
                a.portConnections[api][low][od] _ MirrorSC[a.portConnections[api][low][od]];
                a.portConnections[api][high][od] _ MirrorSC[a.portConnections[api][high][od]];
                ENDLOOP;
            FOR epi: PortIndex IN [0 .. a.eltType.ports.length) DO
                SELECT a.porting[epi] FROM
                    notPorted => NULL;
                    unknownPorting => NULL;
                    ENDCASE => {dp: DetailedPorting _ NARROW[a.porting[epi]];
                        MirrorSI: PROC [si: SideIndex] = {
                            s0: INT _ si.firstSlot;
                            sf: INT _ s0 + parlSize - 3;
                            IF si.same THEN RETURN;
                            FOR i: INT IN [0 .. parlSize/2 - 1) DO
                                [dp.slots[s0+i], dp.slots[sf-i]] _ PISwap[dp.slots[s0+i], dp.slots[sf-i]];
                                ENDLOOP;
                            };
                        FOR e: End IN End DO
                            ef: End _ e;
                            eb: End _ e;
                            SELECT d FROM
                                Foo => ef _ OtherEnd[e];
                                Bar => eb _ OtherEnd[e];
                                ENDCASE => ERROR;
                            [dp.corners[e][e], dp.corners[ef][eb]] _ PISwap[dp.corners[e][e], dp.corners[ef][eb]];
                            [dp.sideIndices[low][d], dp.sideIndices[high][d]] _ SISwap[dp.sideIndices[low][d], dp.sideIndices[high][d]];
                            MirrorSI[dp.sideIndices[low][od]];
                            MirrorSI[dp.sideIndices[high][od]];
                            ENDLOOP;
                        };
                ENDLOOP;
            };

        JSwap: PROC [a, b: Joint] RETURNS [c, d: Joint] = {c _ b; d _ a};
        SISwap: PROC [a, b: SideIndex] RETURNS [c, d: SideIndex] = {c _ b; d _ a};
        PISwap: PROC [a, b: PortIndex] RETURNS [c, d: PortIndex] = {c _ b; d _ a};

        OffsetRange: PROC [r: Range, 
            {s _ [min: r.min + 

        Shift: PROC [a: Array, 
            eos: ARRAY Dim OF EO = [Foo: EOOfInt[
            a.shape[Foo] _ OffsetRange[a.shape[Foo], 
            a.shape[Bar] _ OffsetRange[a.shape[Bar], 
            FOR d: Dim IN Dim DO FOR eo: EO IN EO DO
                od: Dim = OtherDim[d];
                IF eos[od] = Odd THEN [a.joints[d][Even][eo], a.joints[d][Odd][eo]] _ JSwap[a.joints[d][Even][eo], a.joints[d][Odd][eo]];
                ENDLOOP ENDLOOP;
            FOR d: Dim IN Dim DO FOR eo: EO IN EO DO
                od: Dim = OtherDim[d];
                IF eos[d] = Odd THEN [a.joints[d][eo][Even], a.joints[d][eo][Odd]] _ JSwap[a.joints[d][eo][Even], a.joints[d][eo][Odd]];
                ENDLOOP ENDLOOP;
            FOR api: PortIndex IN [0 .. a.portConnections.arrayPorts) DO
                FOR e: End IN End DO FOR d: Dim IN Dim DO
                    od: Dim = OtherDim[d];
                    a.portConnections[api][e][d].range _ OffsetRange[a.portConnections[api][e][d].range, 
                    FOR asl: ArraySocketList _ a.portConnections[api][e][d].sockets, asl.rest WHILE asl # NIL DO
                        asl.first.ai[Foo] _ asl.first.ai[Foo] + 
                        asl.first.ai[Bar] _ asl.first.ai[Bar] + 
                        ENDLOOP;
                    ENDLOOP ENDLOOP;
                ENDLOOP;
            };

        Transpose: PROC [a: Array] = {
            r: Range _ a.shape[Foo];
            js: ARRAY EO OF ARRAY EO OF Joint _ a.joints[Foo];
            a.shape[Foo] _ a.shape[Bar];
            a.shape[Bar] _ r;
            a.joints[Foo] _ a.joints[Bar];
            a.joints[Bar] _ js;
            FOR api: PortIndex IN [0 .. a.portConnections.arrayPorts) DO
                SCSwapAndTranspose: PROC [a, b: SideConnection] RETURNS [c, d: SideConnection] = {
                    SCTranspose: PROC [sc: SideConnection] = {
                        FOR asl: ArraySocketList _ sc.sockets, asl.rest WHILE asl # NIL DO
                            asl.first.ai _ TransposeIndex[asl.first.ai];
                            ENDLOOP;
                        };
                    SCTranspose[d _ a];
                    SCTranspose[c _ b];
                    };
                FOR e: End IN End DO
                    [a.portConnections[api][e][Foo], a.portConnections[api][e][Bar]] _ SCSwapAndTranspose[a.portConnections[api][e][Foo], 
                    a.portConnections[api][e][Bar]];
                    ENDLOOP;
                ENDLOOP;
            FOR epi: PortIndex IN [0 .. a.eltType.ports.length) DO
                SELECT a.porting[epi] FROM
                    notPorted => NULL;
                    unknownPorting => NULL;
                    ENDCASE => {dp: DetailedPorting _ NARROW[a.porting[epi]];
                        [dp.corners[low][high], dp.corners[high][low]] _ PISwap[dp.corners[low][high], dp.corners[high][low]];
                        FOR e: End IN End DO
                            [dp.sideIndices[e][Foo], dp.sideIndices[e][Bar]] _ SISwap[dp.sideIndices[e][Foo], dp.sideIndices[e][Bar]];
                            ENDLOOP;
                        };
                ENDLOOP;
            };

        TransposeIndex: PROC [ai: ArrayIndex] RETURNS [tai: ArrayIndex] =
            {tai _ [Foo: ai[Bar], Bar: ai[Foo]]};

        CopyArray: PROC [a: Array] RETURNS [xa: Array] = {
            xa _ NEW [ArrayRep[a.eltPorts]];
            xa.eltType _ a.eltType;
            xa.shape _ a.shape;
            FOR d: Dim IN Dim DO FOR eo1: EO IN EO DO FOR eo2: EO IN EO DO
                xa.joints[d][eo1][eo2] _ CopyJoint[a.joints[d][eo1][eo2]];
                ENDLOOP ENDLOOP ENDLOOP;
            FOR pi: PortIndex IN [0 .. a.eltType.ports.length) DO
                xa.porting[pi] _ CopyPorting[a.porting[pi]];
                ENDLOOP;
            xa.portConnections _ NEW [ArrayPortConnectionSeq[a.portConnections.arrayPorts]];
            FOR api: PortIndex IN [0 .. xa.portConnections.arrayPorts) DO
                FOR e: End IN End DO FOR d: Dim IN Dim DO
                    xa.portConnections[api][e][d] _ CopySideConnection[a.portConnections[api][e][d]];
                    ENDLOOP ENDLOOP;
                ENDLOOP;
            };

        CopySideConnection: PROC [sc: SideConnection] RETURNS [csc: SideConnection] = {
            last: ArraySocketList _ NIL;
            csc _ sc;
            WHILE sc.sockets # NIL DO
                this: ArraySocketList _ LIST[sc.sockets.first];
                IF last = NIL THEN csc.sockets _ this ELSE last.rest _ this;
                last _ this;
                sc.sockets _ sc.sockets.rest;
                ENDLOOP;
            };

        CopyJoint: PROC [j: Joint] RETURNS [k: Joint] = {
            IF j = NIL THEN RETURN [NIL];
            k _ NEW [JointSeq[j.eltPorts]];
            FOR pi: PortIndex IN [0 .. j.eltPorts) DO
                k[pi] _ j[pi];
                ENDLOOP;
            };

        CopyPorting: PROC [p: Porting] RETURNS [q: Porting] = {
            dp, dq: DetailedPorting;
            IF p = notPorted OR p = unknownPorting THEN RETURN [p];
            dp _ NARROW[p];
            q _ dq _ NEW [DetailedPortingRep[dp.length]];
            dq.corners _ dp.corners;
            dq.sideIndices _ dp.sideIndices;
            FOR s: NAT IN [0 .. dp.length) DO dq.slots[s] _ dp.slots[s] ENDLOOP;
            };

        DescribeConnection: PROC [eltType: CellType, lpi, hpi: PortIndex, d: Dim, perp, parl: EO] RETURNS [r: ROPE] =
            {r _ IO.PutFR["%g - %g across [%g, %g, %g]",
                IO.refAny[PickAName[eltType.ports[lpi].names]],
                IO.refAny[PickAName[eltType.ports[hpi].names]],
                IO.rope[DimName[d]],
                IO.rope[EOName[perp]],
                IO.rope[EOName[parl]]]};

        DescribeJointDetails: PROC [d: Dim, perp, parl: EO] RETURNS [r: ROPE] =
            {r _ IO.PutFR["[%g, %g, %g]", IO.rope[DimName[d]], IO.rope[EOName[perp]], IO.rope[EOName[parl]]]};

        EOOfInt: PROC [i: INT] RETURNS [eo: EO] =
            {eo _ SELECT i MOD 2 FROM 0 => Even, 1 => Odd, ENDCASE => ERROR};

        Mods: ARRAY EO OF [0 .. 1] _ [Even: 0, Odd: 1];

        END.