PSPolyImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 8, 1987 6:32:42 pm PDT
PostScript implementation: polymorphic operations.
DIRECTORY
PS;
PSPolyImpl: CEDAR PROGRAM
IMPORTS PS
~ BEGIN OPEN PS;
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 array1.access<readOnly THEN ERROR Error[invalidaccess];
IF array2.access<unlimited THEN ERROR Error[invalidaccess];
PushArray[self, ArrayCopy[array1, array2]];
};
string => {
string2: String ~ StringFromAny[arg];
string1: String ~ PopString[self];
IF string1.access<readOnly THEN ERROR Error[invalidaccess];
IF string2.access<unlimited THEN ERROR Error[invalidaccess];
PushString[self, StringCopy[string1, string2]];
};
dict => {
dict2: Dict ~ DictFromAny[arg];
dict1: Dict ~ PopDict[self];
IF dict1.ref.access<readOnly THEN ERROR Error[invalidaccess];
IF dict2.ref.access<unlimited THEN ERROR Error[invalidaccess];
PushDict[self, DictCopy[dict1, dict2]];
};
ENDCASE => ERROR Error[typecheck];
};
Plength: PROC [self: Root] ~ {
arg: Any ~ PopAny[self];
length: INT;
SELECT Type[arg] FROM
array => {
array: Array ~ ArrayFromAny[arg];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
length ← ArrayLength[array];
};
string => {
string: String ~ StringFromAny[arg];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
length ← StringLength[string];
};
dict => {
dict: Dict ~ DictFromAny[arg];
IF dict.ref.access<readOnly THEN ERROR Error[invalidaccess];
length ← DictLength[dict];
};
name => length ← NameLength[NameFromAny[arg]];
ENDCASE => ERROR Error[typecheck];
PushInt[self, length];
};
Pget: PROC [self: Root] ~ {
key: Any ~ PopAny[self];
arg: Any ~ PopAny[self];
SELECT Type[arg] FROM
array => {
array: Array ~ ArrayFromAny[arg];
index: INT ~ IntFromAny[key];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
PushAny[self, ArrayGet[array, index]];
};
string => {
string: String ~ StringFromAny[arg];
index: INT ~ IntFromAny[key];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
PushInt[self, IntFromChar[StringGet[string, index]]];
};
dict => {
dict: Dict ~ DictFromAny[arg];
IF dict.ref.access<readOnly THEN ERROR Error[invalidaccess];
PushAny[self, DictGet[dict, key]];
};
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 array.access<unlimited THEN ERROR Error[invalidaccess];
ArrayPut[array, index, arg3];
};
string => {
string: String ~ StringFromAny[arg1];
index: INT ~ IntFromAny[arg2];
int: INT ~ IntFromAny[arg3];
IF string.access<unlimited THEN ERROR Error[invalidaccess];
StringPut[string, index, CharFromInt[int]];
};
dict => {
dict: Dict ~ DictFromAny[arg1];
IF dict.ref.access<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 array.access<readOnly THEN ERROR Error[invalidaccess];
PushArray[self, ArrayGetInterval[array, index, count]];
};
string => {
string: String ~ StringFromAny[arg1];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
PushString[self, StringGetInterval[string, index, count]];
};
ENDCASE => ERROR Error[typecheck];
};
Pputinterval: PROC [self: Root] ~ {
arg2: Any ~ PopAny[self];
index: INT ~ PopInt[self];
arg1: Any ~ PopAny[self];
SELECT Type[arg1] FROM
array => {
array1: Array ~ ArrayFromAny[arg1];
array2: Array ~ ArrayFromAny[arg2];
IF array1.access<unlimited THEN ERROR Error[invalidaccess];
IF array2.access<readOnly THEN ERROR Error[invalidaccess];
ArrayPutInterval[array1, index, array2];
};
string => {
string1: String ~ StringFromAny[arg1];
string2: String ~ StringFromAny[arg2];
IF string1.access<unlimited THEN ERROR Error[invalidaccess];
IF string2.access<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 array.access<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 string.access<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 dict.ref.access<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];
END.