<<>>
    <<TJaMArrayImpl.mesa>>
        <<Copyright Ó 1985, 1986, 1991, 1992 by Xerox Corporation.  All rights reserved.>>
        <<Doug Wyatt, November 27, 1992 1:45 pm PST>>

    DIRECTORY
        TJaM;

    TJaMArrayImpl: CEDAR PROGRAM
    IMPORTS TJaM
    EXPORTS TJaM
    ~ BEGIN OPEN TJaM;

    <<Array Operations>>

    maxArrayLength: NAT ~ (LAST[NAT]-SIZE[SequenceRep[0]])/SIZE[Any];

    NewArray: PUBLIC PROC[len: INT] RETURNS[Array] ~ {
        IF len NOT IN[0..maxArrayLength) THEN ProduceError[boundsFault];
        RETURN[NEW[ArrayRep ¬ [start: 0, len: len, base: NEW[SequenceRep[len]]]]];
        };

    ACopy: PUBLIC PROC[array: Array, expand: INT ¬ 0] RETURNS[new: Array] ~ {
        rem: NAT ~ maxArrayLength-array.len;
        IF expand NOT IN[0..rem) THEN ProduceError[boundsFault];
        new ¬ NewArray[array.len+expand];
        FOR i: NAT IN[0..array.len) DO APut[new, i, AGet[array, i]] ENDLOOP;
        };

    AStore: PUBLIC PROC[frame: Frame, array: Array] ~ {
        FOR i: NAT DECREASING IN[0..array.len) DO
            APut[array, i, Pop[frame]];
            ENDLOOP;
        };

    ALoad: PUBLIC PROC[frame: Frame, array: Array] ~ {
        FOR i: NAT IN[0..array.len) DO
            Push[frame, AGet[array, i]];
            ENDLOOP;
        };

    APut: PUBLIC PROC[array: Array, i: INT, val: Any] ~ {
        IF i NOT IN[0..array.len) THEN ProduceError[boundsFault];
        array.base[array.start+i] ¬ val;
        };

    AGet: PUBLIC PROC[array: Array, i: INT] RETURNS[Any] ~ {
        IF i NOT IN[0..array.len) THEN ProduceError[boundsFault];
        RETURN[array.base[array.start+i]];
        };

    ASub: PUBLIC PROC[array: Array, start, len: INT] RETURNS[Array] ~ {
        IF start NOT IN[0..array.len] OR len NOT IN[0..array.len-start] THEN ProduceError[boundsFault];
        RETURN[NEW[ArrayRep ¬ [start: array.start+start, len: len, base: array.base]]];
        };

    AFind: PUBLIC PROC[array: Array, val: Any] RETURNS[INT] ~ {
        FOR i: INT IN[0..array.len) DO
            x: Any ~ AGet[array, i];
            IF Equal[x, val] THEN RETURN[i];
            ENDLOOP;
        RETURN[-1];
        }; -- find object in array

    ABind: PUBLIC PROC[array: Array, dict: Dict] ~ {
        FOR i: INT IN[0..array.len) DO
            x: Any ~ AGet[array, i];
            WITH x SELECT FROM
                x: ATOM => {
                    known: BOOL; value: Any;
                    [known, value] ¬ TryToGet[dict, x];
                    IF known THEN APut[array, i, value];
                    };
                x: Array => ABind[x, dict];
                ENDCASE;
            ENDLOOP;
        }; -- bind names in array to values in dict

    ArrayForAll: PUBLIC PROC[array: Array, action: AnyAction] RETURNS[BOOL] ~ {
        FOR i: INT IN[0..array.len) DO
            IF action[AGet[array, i]] THEN RETURN[TRUE];
            ENDLOOP;
        RETURN[FALSE];
        };

    <<Array Intrinsics>>

    ApplyArray: CommandProc ~ {
        n: INT ~ PopInt[frame];
        PushArray[frame, NewArray[n]];
        };

    ApplyAPut: CommandProc ~ {
        x: Any ~ Pop[frame];
        i: INT ~ PopInt[frame];
        array: Array ~ PopArray[frame];
        APut[array, i, x];
        };

    ApplyAGet: CommandProc ~ {
        i: INT ~ PopInt[frame];
        array: Array ~ PopArray[frame];
        Push[frame, AGet[array, i]];
        };

    ApplySubArray: CommandProc ~ {
        len: INT ~ PopInt[frame];
        start: INT ~ PopInt[frame];
        array: Array ~ PopArray[frame];
        PushArray[frame, ASub[array, start, len]];
        };

    ApplyAFind: CommandProc ~ {
        x: Any ~ Pop[frame];
        array: Array ~ PopArray[frame];
        i: INT ~ AFind[array, x];
        found: BOOL ~ i>=0;
        IF found THEN PushInt[frame, i];
        PushBool[frame, found];
        };

    ApplyAStore: CommandProc ~ {
        array: Array ~ PopArray[frame];
        FOR i: INT DECREASING IN[0..array.len) DO APut[array, i, Pop[frame]] ENDLOOP;
        PushArray[frame, array];
        };

    ApplyALoad: CommandProc ~ {
        array: Array ~ PopArray[frame];
        FOR i: INT IN[0..array.len) DO Push[frame, AGet[array, i]] ENDLOOP;
        PushArray[frame, array];
        };

    ApplyABind: CommandProc ~ {
        dict: Dict ~ PopDict[frame];
        array: Array ~ PopArray[frame];
        ABind[array, dict];
        };

    ApplyArrayForAll: CommandProc ~ {
        action: Any ~ Pop[frame];
        array: Array ~ PopArray[frame];
        proc: PROC[val: Any] RETURNS[quit: BOOL ¬ FALSE] ~ {
            Push[frame, val];
            Execute[frame, action ! Exit => { quit ¬ TRUE; CONTINUE }];
            };
        [] ¬ ArrayForAll[array, proc];
        };

    RegisterPrimitive[".array", ApplyArray];
    RegisterPrimitive[".aget", ApplyAGet];
    RegisterPrimitive[".aput", ApplyAPut];
    RegisterPrimitive[".subarray", ApplySubArray];
<<RegisterPrimitive[".putarray", ApplyPutArray];>>
    RegisterPrimitive[".arrayforall", ApplyArrayForAll];
    RegisterPrimitive[".astore", ApplyAStore];
    RegisterPrimitive[".aload", ApplyALoad];
<<RegisterPrimitive[".acopy", ApplyACopy];>>
    RegisterPrimitive[".abind", ApplyABind];
    RegisterPrimitive[".afind", ApplyAFind];

    END.