TJaMArrayImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, March 26, 1985 9:53:19 am PST
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:
PUBLIC
PROC[frame: Frame] ~ {
n: INT ~ PopInt[frame];
PushArray[frame, NewArray[n]];
};
ApplyAPut:
PUBLIC
PROC[frame: Frame] ~ {
x: Any ~ Pop[frame];
i: INT ~ PopInt[frame];
array: Array ~ PopArray[frame];
APut[array, i, x];
};
ApplyAGet:
PUBLIC
PROC[frame: Frame] ~ {
i: INT ~ PopInt[frame];
array: Array ~ PopArray[frame];
Push[frame, AGet[array, i]];
};
ApplySubArray:
PUBLIC
PROC[frame: Frame] ~ {
len: INT ~ PopInt[frame];
start: INT ~ PopInt[frame];
array: Array ~ PopArray[frame];
PushArray[frame, ASub[array, start, len]];
};
ApplyAFind:
PUBLIC
PROC[frame: Frame] ~ {
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:
PUBLIC
PROC[frame: Frame] ~ {
array: Array ~ PopArray[frame];
FOR i: INT DECREASING IN[0..array.len) DO APut[array, i, Pop[frame]] ENDLOOP;
PushArray[frame, array];
};
ApplyALoad:
PUBLIC
PROC[frame: Frame] ~ {
array: Array ~ PopArray[frame];
FOR i: INT IN[0..array.len) DO Push[frame, AGet[array, i]] ENDLOOP;
PushArray[frame, array];
};
ApplyABind:
PUBLIC
PROC[frame: Frame] ~ {
dict: Dict ~ PopDict[frame];
array: Array ~ PopArray[frame];
ABind[array, dict];
};
ApplyArrayForAll:
PUBLIC
PROC[frame: Frame] ~ {
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.