DIRECTORY TJaM; TJaMArrayImpl: CEDAR PROGRAM IMPORTS TJaM EXPORTS TJaM ~ BEGIN OPEN TJaM; 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]; }; 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[".arrayforall", ApplyArrayForAll]; RegisterPrimitive[".astore", ApplyAStore]; RegisterPrimitive[".aload", ApplyALoad]; RegisterPrimitive[".abind", ApplyABind]; RegisterPrimitive[".afind", ApplyAFind]; END. ϊTJaMArrayImpl.mesa Copyright c 1985 by Xerox Corporation. All rights reserved. Doug Wyatt, March 26, 1985 9:53:19 am PST Array Operations Array Intrinsics RegisterPrimitive[".putarray", ApplyPutArray]; RegisterPrimitive[".acopy", ApplyACopy]; Κ ˜codešœ™Kšœ Οmœ1™