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.