Array operations
ArrayNew:
PUBLIC
PROC [size:
INT]
RETURNS [Array] ~ {
IF size
IN ArrayIndex
THEN {
base: ArrayBase ~ NEW[ArrayBaseRep[size]];
RETURN[[executable: FALSE, access: unlimited, start: 0, length: size, base: base]];
}
ELSE ERROR Error[IF size<0 THEN rangecheck ELSE limitcheck];
};
ArrayTransfer:
PUBLIC
PROC [to: ArrayBase, toStart: ArrayIndex,
from: ArrayBase, fromStart: ArrayIndex, length: ArrayIndex] ~ {
FOR i: ArrayIndex
IN[0..length)
DO
to[toStart+i] ← from[fromStart+i];
ENDLOOP;
};
ArrayGet:
PUBLIC
PROC [array: Array, index:
INT]
RETURNS [Any] ~ {
IF index NOT IN[0..array.length) THEN ERROR Error[rangecheck];
RETURN [array.base[array.start+index]];
};
ArrayPut:
PUBLIC
PROC [array: Array, index:
INT, x: Any] ~ {
IF index NOT IN[0..array.length) THEN ERROR Error[rangecheck];
array.base[array.start+index] ← x;
};
ArrayGetInterval:
PUBLIC
PROC [array: Array, index, count:
INT]
RETURNS [Array] ~ {
IF index NOT IN[0..array.length] THEN ERROR Error[rangecheck];
IF count NOT IN[0..array.length-index] THEN ERROR Error[rangecheck];
RETURN [[executable: array.executable, access: array.access,
start: array.start+index, length: count, base: array.base]];
};
ArrayPutInterval:
PUBLIC
PROC [array: Array, index:
INT, interval: Array] ~ {
IF index NOT IN[0..array.length] THEN ERROR Error[rangecheck];
IF interval.length NOT IN[0..array.length-index] THEN ERROR Error[rangecheck];
ArrayTransfer[to: array.base, toStart: array.start+index,
from: interval.base, fromStart: interval.start, length: interval.length];
};
ArrayCopy:
PUBLIC
PROC [array1, array2: Array]
RETURNS [Array] ~ {
subarray2: Array ~ ArrayGetInterval[array2, 0, array1.length];
ArrayPutInterval[subarray2, 0, array1];
RETURN [subarray2];
};
ArrayStore:
PUBLIC
PROC [stack: Stack, array: Array] ~ {
IF stack.count<array.length
THEN
ERROR Error[stack.underflow];
stack.count ← stack.count-array.length;
ArrayTransfer[to: array.base, toStart: array.start,
from: stack.base, fromStart: stack.count, length: array.length];
};
ArrayLoad:
PUBLIC
PROC [stack: Stack, array: Array] ~ {
IF (stack.size-stack.count)<array.length
THEN
ERROR Error[stack.overflow];
ArrayTransfer[to: stack.base, toStart: stack.count,
from: array.base, fromStart: array.start, length: array.length];
stack.count ← stack.count+array.length;
};
String operations
StringNew:
PUBLIC
PROC [size:
INT]
RETURNS [String] ~ {
IF size
IN StringIndex
THEN {
base: StringBase ~ NEW[TEXT[size]];
RETURN[[executable: FALSE, access: unlimited, start: 0, length: size, base: base]];
}
ELSE ERROR Error[IF size<0 THEN rangecheck ELSE limitcheck];
};
StringTransfer:
PROC [to: StringBase, toStart: StringIndex,
from: StringBase, fromStart: StringIndex, length: StringIndex] ~ {
FOR i: StringIndex
IN[0..length)
DO
to[toStart+i] ← from[fromStart+i];
***** use ByteBlt here ? *****
ENDLOOP;
};
StringGet:
PUBLIC
PROC [string: String, index:
INT]
RETURNS [
INT] ~ {
IF index NOT IN[0..string.length) THEN ERROR Error[rangecheck];
RETURN [ORD[string.base[string.start+index]]];
};
StringPut:
PUBLIC
PROC [string: String, index:
INT, x:
INT] ~ {
IF index NOT IN[0..string.length) THEN ERROR Error[rangecheck];
IF x NOT IN[0..256) THEN ERROR Error[rangecheck];
string.base[string.start+index] ← VAL[CARDINAL[x]];
};
StringGetInterval:
PUBLIC
PROC [string: String, index, count:
INT]
RETURNS [String] ~ {
IF index NOT IN[0..string.length] THEN ERROR Error[rangecheck];
IF count NOT IN[0..string.length-index] THEN ERROR Error[rangecheck];
RETURN [[executable: string.executable, access: string.access,
start: string.start+index, length: count, base: string.base]];
};
StringPutInterval:
PUBLIC
PROC [string: String, index:
INT, interval: String] ~ {
IF index NOT IN[0..string.length] THEN ERROR Error[rangecheck];
IF interval.length NOT IN[0..string.length-index] THEN ERROR Error[rangecheck];
StringTransfer[to: string.base, toStart: string.start+index,
from: interval.base, fromStart: interval.start, length: interval.length];
};
StringCopy:
PUBLIC
PROC [string1, string2: String]
RETURNS [String] ~ {
substring2: String ~ StringGetInterval[string2, 0, string1.length];
StringPutInterval[substring2, 0, string1];
RETURN [substring2];
};
StringFromRope:
PROC [rope:
ROPE]
RETURNS [String] ~ {
string: String ~ StringNew[Rope.Size[rope]];
FOR i:
NAT
IN[0..string.length)
DO
string.base[i] ← Rope.Fetch[rope, i];
ENDLOOP;
RETURN [string];
};
AtomFromString:
PROC [string: String]
RETURNS [atom:
ATOM] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[string.length];
text: REF TEXT ← scratch;
text ← RefText.Append[to: text, from: string.base, start: string.start, len: string.length];
atom ← Atom.MakeAtomFromRefText[text];
RefText.ReleaseScratch[scratch];
};
Name operations
NameFromRope:
PROC [rope:
ROPE, executable:
BOOL ←
TRUE]
RETURNS [Name] ~ {
atom: ATOM ~ Atom.MakeAtom[rope];
RETURN [[executable, atom]];
};
NameFromString:
PROC [string: String, executable:
BOOL ←
TRUE]
RETURNS [Name] ~ {
atom: ATOM ~ AtomFromString[string];
RETURN [[executable, atom]];
};
NameToString:
PROC [name: Name, string: String]
RETURNS [String] ~ {
rope: ROPE ~ Atom.GetPName[name.atom];
result: String ~ StringGetInterval[string, 0, Rope.Size[rope]];
FOR i:
NAT
IN[0..result.length)
DO
result.base[result.start+i] ← Rope.Fetch[rope, i];
ENDLOOP;
RETURN [result];
};
Primitives
Parray:
PROC [self: Root] ~ {
size: INT ~ PopInt[self.ostack];
PushArray[self.ostack, ArrayNew[size]];
};
Pstartarray:
PROC [self: Root] ~ {
-- [
PushMark[self.ostack];
};
Pendarray:
PROC [self: Root] ~ {
-- ]
size: INT ~ CountToMark[self.ostack];
array: Array ~ ArrayNew[size];
ArrayStore[self.ostack, array];
PopMark[self.ostack];
PushArray[self.ostack, array];
};
Paload:
PROC [self: Root] ~ {
array: Array ~ PopArray[self.ostack];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
ArrayLoad[self.ostack, array];
PushArray[self.ostack, array];
};
Pastore:
PROC [self: Root] ~ {
array: Array ~ PopArray[self.ostack];
IF array.access<unlimited THEN ERROR Error[invalidaccess];
ArrayStore[self.ostack, array];
PushArray[self.ostack, array];
};
Pstring:
PROC [self: Root] ~ {
size: INT ~ PopInt[self.ostack];
PushString[self.ostack, StringNew[size]];
};
Panchorsearch:
PROC [self: Root] ~ {
seek: String ~ PopString[self.ostack];
string: String ~ PopString[self.ostack];
found: BOOL ← FALSE;
IF string.access<readOnly OR seek.access<readOnly THEN ERROR Error[invalidaccess];
IF seek.length<=string.length
THEN {
FOR i: StringIndex
IN[0..seek.length)
DO
IF string.base[string.start+i]#seek.base[seek.start+i] THEN EXIT;
REPEAT FINISHED => found ← TRUE;
ENDLOOP;
};
IF found
THEN {
match: String ~ StringGetInterval[string, 0, seek.length];
post: String ~ StringGetInterval[string, seek.length, string.length-seek.length];
PushString[self.ostack, post];
PushString[self.ostack, match];
PushBool[self.ostack, TRUE];
}
ELSE {
PushString[self.ostack, string];
PushBool[self.ostack, FALSE];
};
};
Psearch:
PROC [self: Root] ~ {
seek: String ~ PopString[self.ostack];
string: String ~ PopString[self.ostack];
found: BOOL ← FALSE;
skip: StringIndex ← 0;
IF string.access<readOnly OR seek.access<readOnly THEN ERROR Error[invalidaccess];
FOR skip ← 0, skip+1
UNTIL found
OR (string.length-skip)<seek.length
DO
FOR i: StringIndex
IN[0..seek.length)
DO
IF string.base[string.start+skip+i]#seek.base[seek.start+i] THEN EXIT;
REPEAT FINISHED => found ← TRUE;
ENDLOOP;
ENDLOOP;
IF found
THEN {
pre: String ~ StringGetInterval[string, 0, skip];
match: String ~ StringGetInterval[string, skip, seek.length];
post: String ~ StringGetInterval[string, skip+seek.length, string.length-(skip+seek.length)];
PushString[self.ostack, post];
PushString[self.ostack, match];
PushString[self.ostack, pre];
PushBool[self.ostack, TRUE];
}
ELSE {
PushString[self.ostack, string];
PushBool[self.ostack, FALSE];
};
};
Plength:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
length: INT ← 1;
SELECT Type[x]
FROM
array => {
array: Array ~ ArrayFromAny[x];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
length ← array.length;
};
string => {
string: String ~ StringFromAny[x];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
length ← string.length;
};
dict => {
dict: Dict ~ DictFromAny[x];
IF dict.base.access<readOnly THEN ERROR Error[invalidaccess];
length ← dict.base.length;
};
ENDCASE;
PushInt[self.ostack, length];
};
Pget:
PROC [self: Root] ~ {
index: Any ~ Pop[self.ostack];
x: Any ~ Pop[self.ostack];
SELECT Type[x]
FROM
array => {
array: Array ~ ArrayFromAny[x];
i: INT ~ IntFromAny[index];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
Push[self.ostack, ArrayGet[array, i]];
};
string => {
string: String ~ StringFromAny[x];
i: INT ~ IntFromAny[index];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
PushInt[self.ostack, StringGet[string, i]];
};
dict => {
dict: Dict ~ DictFromAny[x];
IF dict.base.access<readOnly THEN ERROR Error[invalidaccess];
Push[self.ostack, DictGet[dict, index]];
};
ENDCASE => ERROR Error[typecheck];
};
Pput:
PROC [self: Root] ~ {
val: Any ~ Pop[self.ostack];
key: Any ~ Pop[self.ostack];
x: Any ~ Pop[self.ostack];
SELECT Type[x]
FROM
array => {
array: Array ~ ArrayFromAny[x];
index: INT ~ IntFromAny[key];
IF array.access<unlimited THEN ERROR Error[invalidaccess];
ArrayPut[array, index, val];
};
string => {
string: String ~ StringFromAny[x];
index: INT ~ IntFromAny[key];
int: INT ~ IntFromAny[val];
IF string.access<unlimited THEN ERROR Error[invalidaccess];
StringPut[string, index, int];
};
dict => {
dict: Dict ~ DictFromAny[x];
IF dict.base.access<unlimited THEN ERROR Error[invalidaccess];
DictPut[dict, key, val];
};
ENDCASE => ERROR Error[typecheck];
};
Pgetinterval:
PROC [self: Root] ~ {
count: INT ~ PopInt[self.ostack];
index: INT ~ PopInt[self.ostack];
x: Any ~ Pop[self.ostack];
SELECT Type[x]
FROM
array => {
array: Array ~ ArrayFromAny[x];
IF array.access<readOnly THEN ERROR Error[invalidaccess];
PushArray[self.ostack, ArrayGetInterval[array, index, count]];
};
string => {
string: String ~ StringFromAny[x];
IF string.access<readOnly THEN ERROR Error[invalidaccess];
PushString[self.ostack, StringGetInterval[string, index, count]];
};
ENDCASE => ERROR Error[typecheck];
};
Pputinterval:
PROC [self: Root] ~ {
x2: Any ~ Pop[self.ostack];
index: INT ~ PopInt[self.ostack];
x1: Any ~ Pop[self.ostack];
SELECT Type[x1]
FROM
array => {
array1: Array ~ ArrayFromAny[x1];
array2: Array ~ ArrayFromAny[x2];
IF array1.access<readOnly THEN ERROR Error[invalidaccess];
IF array2.access<unlimited THEN ERROR Error[invalidaccess];
ArrayPutInterval[array1, index, array2];
};
string => {
string1: String ~ StringFromAny[x1];
string2: String ~ StringFromAny[x2];
IF string1.access<readOnly THEN ERROR Error[invalidaccess];
IF string2.access<unlimited THEN ERROR Error[invalidaccess];
StringPutInterval[string1, index, string2];
};
ENDCASE => ERROR Error[typecheck];
};
Pcopy:
PROC [self: Root] ~ {
x2: Any ~ Pop[self.ostack];
SELECT Type[x2]
FROM
integer => {
n: INT ~ IntFromAny[x2];
Copy[self.ostack, n];
};
array => {
array2: Array ~ ArrayFromAny[x2];
array1: Array ~ PopArray[self.ostack];
IF array1.access<readOnly THEN ERROR Error[invalidaccess];
IF array2.access<unlimited THEN ERROR Error[invalidaccess];
PushArray[self.ostack, ArrayCopy[array1, array2]];
};
string => {
string2: String ~ StringFromAny[x2];
string1: String ~ PopString[self.ostack];
IF string1.access<readOnly THEN ERROR Error[invalidaccess];
IF string2.access<unlimited THEN ERROR Error[invalidaccess];
PushString[self.ostack, StringCopy[string1, string2]];
};
dict => {
dict2: Dict ~ DictFromAny[x2];
dict1: Dict ~ PopDict[self.ostack];
IF dict1.base.access<readOnly THEN ERROR Error[invalidaccess];
IF dict2.base.access<unlimited THEN ERROR Error[invalidaccess];
PushDict[self.ostack, DictCopy[dict1, dict2]];
};
ENDCASE => ERROR Error[typecheck];
};
Register2:
PROC [self: Root] ~ {
Register[self, "array", Parray];
Register[self, "[", Pstartarray];
Register[self, "]", Pendarray];
Register[self, "aload", Paload];
Register[self, "astore", Pastore];
Register[self, "string", Pstring];
Register[self, "anchorsearch", Panchorsearch];
Register[self, "search", Psearch];
Register[self, "length", Plength];
Register[self, "get", Pget];
Register[self, "put", Pput];
Register[self, "getinterval", Pgetinterval];
Register[self, "putinterval", Pputinterval];
Register[self, "copy", Pcopy];
};
RegisterPrimitives[Register2];