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: 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[".arrayforall", ApplyArrayForAll]; RegisterPrimitive[".astore", ApplyAStore]; RegisterPrimitive[".aload", ApplyALoad]; RegisterPrimitive[".abind", ApplyABind]; RegisterPrimitive[".afind", ApplyAFind]; END.  TJaMArrayImpl.mesa Copyright Σ 1985, 1986, 1991, 1992 by Xerox Corporation. All rights reserved. Doug Wyatt, November 27, 1992 1:45 pm PST Array Operations Array Intrinsics RegisterPrimitive[".putarray", ApplyPutArray]; RegisterPrimitive[".acopy", ApplyACopy]; Κψ–(cedarcode) style•NewlineDelimiter ™codešœ™Kšœ ΟeœC™NK™)—K˜šΟk ˜ Kšœ˜—K˜KšΠbl œžœž˜Kšžœ˜ Kšžœ˜ Kšœžœžœ˜K˜Kšœ™K˜Kš œžœžœžœžœžœ˜AK˜š Οnœžœžœžœžœ ˜2Kšžœžœžœžœ˜@Kšžœžœ'žœ˜JK˜K˜—š  œžœžœžœžœ˜IKšœžœ˜$Kšžœžœžœ žœ˜8Kšœ!˜!Kš žœžœžœžœžœ˜DK˜K˜—š œžœžœ ˜3š žœžœž œžœž˜)Kšœ˜Kšžœ˜—K˜K˜—š œžœžœ ˜2šžœžœžœž˜Kšœ˜Kšžœ˜—K˜K˜—š œžœžœžœ˜5Kšžœžœžœžœ˜9Kšœ ˜ K˜K˜—š  œžœžœžœžœ ˜8Kšžœžœžœžœ˜9Kšžœ˜"K˜K˜—š  œžœžœžœžœ ˜CKšžœžœžœžœžœžœžœ˜_KšžœžœE˜OK˜K˜—š  œžœžœžœžœ˜;šžœžœžœž˜Kšœ˜Kšžœžœžœ˜ Kšžœ˜—Kšžœ˜ KšœΟc˜K˜—š œžœžœ˜0šžœžœžœž˜Kšœ˜šžœžœž˜šœžœ˜ Kšœžœ ˜K˜#Kšžœžœ˜$K˜—K˜Kšžœ˜—Kšžœ˜—Kšœ‘(˜+K˜—š   œžœžœ"žœžœ˜Kšžœžœžœž˜Kšžœžœžœžœ˜,Kšžœ˜—Kšžœžœ˜K˜K˜—Kšœ™K˜š  œœ˜Kšœžœ˜Kšœ˜K˜K˜—š  œœ˜Kšœ˜Kšœžœ˜K˜K˜K˜K˜—š  œœ˜Kšœžœ˜K˜K˜K˜K˜—š  œœ˜Kšœžœ˜Kšœžœ˜K˜K˜*K˜K˜—š  œœ˜Kšœ˜K˜Kšœžœ˜Kšœžœ˜Kšžœžœ˜ Kšœ˜K˜K˜—š  œœ˜K˜Kš žœžœž œžœžœžœ˜MK˜K˜K˜—š  œœ˜K˜Kš žœžœžœžœžœ˜CK˜K˜K˜—š  œœ˜Kšœ˜Kšœ˜K˜K˜K˜—š œœ˜!Kšœ˜K˜š œžœ žœžœžœ˜4K˜Kšœ)žœžœ˜;K˜—Kšœ˜K˜K˜—K˜(K˜&K˜&K˜.J™.K˜4K˜*K˜(J™(K˜(K˜(K˜Kšžœ˜—…—RX