PSPolyImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 11, 1987 2:20:23 pm PDT
Primitives
Pcopy:
PROC [self: Root] ~ {
arg: Any ~ PopAny[self];
SELECT Type[arg]
FROM
integer => {
n: INT ~ IntFromAny[arg];
Copy[self, n];
};
array => {
array2: Array ~ ArrayFromAny[arg];
array1: Array ~ PopArray[self];
IF ArrayAccess[array1]<readOnly THEN ERROR Error[invalidaccess];
IF ArrayAccess[array2]<unlimited THEN ERROR Error[invalidaccess];
PushArray[self, ArrayCopy[array1, array2]];
};
string => {
string2: String ~ StringFromAny[arg];
string1: String ~ PopString[self];
IF StringAccess[string1]<readOnly THEN ERROR Error[invalidaccess];
IF StringAccess[string2]<unlimited THEN ERROR Error[invalidaccess];
PushString[self, StringCopy[string1, string2]];
};
dict => {
dict2: Dict ~ DictFromAny[arg];
dict1: Dict ~ PopDict[self];
IF DictAccess[dict1]<readOnly THEN ERROR Error[invalidaccess];
IF DictAccess[dict2]<unlimited THEN ERROR Error[invalidaccess];
PushDict[self, DictCopy[dict1, dict2]];
};
ENDCASE => ERROR Error[typecheck];
};
Plength:
PROC [self: Root] ~ {
arg: Any ~ PopAny[self];
SELECT Type[arg]
FROM
array => {
array: Array ~ ArrayFromAny[arg];
IF ArrayAccess[array]<readOnly THEN ERROR Error[invalidaccess];
PushInt[self, ArrayLength[array]];
};
string => {
string: String ~ StringFromAny[arg];
IF StringAccess[string]<readOnly THEN ERROR Error[invalidaccess];
PushInt[self, StringLength[string]];
};
dict => {
dict: Dict ~ DictFromAny[arg];
IF DictAccess[dict]<readOnly THEN ERROR Error[invalidaccess];
PushInt[self, DictLength[dict]];
};
name => {
name: Name ~ NameFromAny[arg];
PushInt[self, NameLength[name]];
};
ENDCASE => ERROR Error[typecheck];
};
Pget:
PROC [self: Root] ~ {
arg2: Any ~ PopAny[self];
arg1: Any ~ PopAny[self];
SELECT Type[arg1]
FROM
array => {
array: Array ~ ArrayFromAny[arg1];
index: INT ~ IntFromAny[arg2];
IF ArrayAccess[array]<readOnly THEN ERROR Error[invalidaccess];
PushAny[self, ArrayGet[array, index]];
};
string => {
string: String ~ StringFromAny[arg1];
index: INT ~ IntFromAny[arg2];
IF StringAccess[string]<readOnly THEN ERROR Error[invalidaccess];
PushInt[self, IntFromChar[StringGet[string, index]]];
};
dict => {
dict: Dict ~ DictFromAny[arg1];
IF DictAccess[dict]<readOnly THEN ERROR Error[invalidaccess];
PushAny[self, DictGet[dict, arg2]];
};
ENDCASE => ERROR Error[typecheck];
};
Pput:
PROC [self: Root] ~ {
arg3: Any ~ PopAny[self];
arg2: Any ~ PopAny[self];
arg1: Any ~ PopAny[self];
SELECT Type[arg1]
FROM
array => {
array: Array ~ ArrayFromAny[arg1];
index: INT ~ IntFromAny[arg2];
IF ArrayAccess[array]<unlimited THEN ERROR Error[invalidaccess];
ArrayPut[array, index, arg3];
};
string => {
string: String ~ StringFromAny[arg1];
index: INT ~ IntFromAny[arg2];
int: INT ~ IntFromAny[arg3];
IF StringAccess[string]<unlimited THEN ERROR Error[invalidaccess];
StringPut[string, index, CharFromInt[int]];
};
dict => {
dict: Dict ~ DictFromAny[arg1];
IF DictAccess[dict]<unlimited THEN ERROR Error[invalidaccess];
DictPut[dict, arg2, arg3];
};
ENDCASE => ERROR Error[typecheck];
};
Pgetinterval:
PROC [self: Root] ~ {
count: INT ~ PopInt[self];
index: INT ~ PopInt[self];
arg1: Any ~ PopAny[self];
SELECT Type[arg1]
FROM
array => {
array: Array ~ ArrayFromAny[arg1];
IF ArrayAccess[array]<readOnly THEN ERROR Error[invalidaccess];
PushArray[self, ArrayGetInterval[array, index, count]];
};
string => {
string: String ~ StringFromAny[arg1];
IF StringAccess[string]<readOnly THEN ERROR Error[invalidaccess];
PushString[self, StringGetInterval[string, index, count]];
};
ENDCASE => ERROR Error[typecheck];
};
Pputinterval:
PROC [self: Root] ~ {
arg3: Any ~ PopAny[self];
index: INT ~ PopInt[self];
arg1: Any ~ PopAny[self];
SELECT Type[arg1]
FROM
array => {
array1: Array ~ ArrayFromAny[arg1];
array2: Array ~ ArrayFromAny[arg3];
IF ArrayAccess[array1]<unlimited THEN ERROR Error[invalidaccess];
IF ArrayAccess[array2]<readOnly THEN ERROR Error[invalidaccess];
ArrayPutInterval[array1, index, array2];
};
string => {
string1: String ~ StringFromAny[arg1];
string2: String ~ StringFromAny[arg3];
IF StringAccess[string1]<unlimited THEN ERROR Error[invalidaccess];
IF StringAccess[string2]<readOnly THEN ERROR Error[invalidaccess];
StringPutInterval[string1, index, string2];
};
ENDCASE => ERROR Error[typecheck];
};
Pforall:
PROC [self: Root] ~ {
proc: Any ~ PopAny[self];
arg: Any ~ PopAny[self];
SELECT Type[arg]
FROM
array => {
array: Array ~ ArrayFromAny[arg];
action:
PROC [x: Any] ~ {
PushAny[self, x];
Execute[self, proc];
};
IF ArrayAccess[array]<readOnly THEN ERROR Error[invalidaccess];
ArrayForAll[array, action ! Exit => CONTINUE];
};
string => {
string: String ~ StringFromAny[arg];
action:
PROC [c:
CHAR] ~ {
PushInt[self, IntFromChar[c]];
Execute[self, proc];
};
IF StringAccess[string]<readOnly THEN ERROR Error[invalidaccess];
StringForAll[string, action ! Exit => CONTINUE];
};
dict => {
dict: Dict ~ DictFromAny[arg];
action:
PROC [key, val: Any] ~ {
PushAny[self, key];
PushAny[self, val];
Execute[self, proc];
};
IF DictAccess[dict]<readOnly THEN ERROR Error[invalidaccess];
DictForAll[dict, action ! Exit => CONTINUE];
};
ENDCASE => ERROR Error[typecheck];
};
PolyPrimitives:
PROC [self: Root] ~ {
Register[self, "copy", Pcopy];
Register[self, "length", Plength];
Register[self, "get", Pget];
Register[self, "put", Pput];
Register[self, "getinterval", Pgetinterval];
Register[self, "putinterval", Pputinterval];
Register[self, "forall", Pforall];
};
RegisterPrimitives[PolyPrimitives];