Type and Attribute operations
Fix:
PROC [real:
REAL]
RETURNS [
INT] ~ {
RETURN [Real.Fix[real]] };
IntFromReal:
PUBLIC
PROC [real:
REAL]
RETURNS [int:
INT ← 0] ~ {
int ← Fix[real ! Real.RealException => CONTINUE];
IF int#real THEN ERROR Error[rangecheck];
};
IntFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
INT] ~ {
WITH val: x.val
SELECT
FROM
integer => RETURN [val.int];
real => RETURN [IntFromReal[val.real]];
ENDCASE => ERROR Error[typecheck];
};
RealFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
REAL] ~ {
WITH val: x.val
SELECT
FROM
integer => RETURN [REAL[val.int]];
real => RETURN [val.real];
ENDCASE => ERROR Error[typecheck];
};
BoolFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
BOOL] ~ {
WITH val: x.val
SELECT
FROM
boolean => RETURN [val.bool];
ENDCASE => ERROR Error[typecheck];
};
ArrayFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Array] ~ {
WITH val: x.val
SELECT
FROM
array =>
RETURN [[
executable: val.executable, access: val.access,
start: val.start, length: val.length, base: NARROW[x.ref]
]];
ENDCASE => ERROR Error[typecheck];
};
StringFromAny:
PUBLIC
PROC [x: Any]
RETURNS [String] ~ {
WITH val: x.val
SELECT
FROM
string =>
RETURN [[
executable: val.executable, access: val.access,
start: val.start, length: val.length, base: NARROW[x.ref]
]];
ENDCASE => ERROR Error[typecheck];
};
DictFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Dict] ~ {
WITH val: x.val
SELECT
FROM
dict => RETURN [[executable: val.executable, base: NARROW[x.ref]]];
ENDCASE => ERROR Error[typecheck];
};
AnyFromInt:
PUBLIC
PROC [int:
INT]
RETURNS [Any] ~ {
RETURN[[val: [executable: FALSE, variant: integer[int: int]], ref: NIL]];
};
AnyFromReal:
PUBLIC
PROC [real:
REAL]
RETURNS [Any] ~ {
RETURN[[val: [executable: FALSE, variant: real[real: real]], ref: NIL]];
};
AnyFromBool:
PUBLIC
PROC [bool:
BOOL]
RETURNS [Any] ~ {
RETURN[[val: [executable: FALSE, variant: boolean[bool: bool]], ref: NIL]];
};
AnyFromArray:
PUBLIC
PROC [array: Array]
RETURNS [Any] ~ {
RETURN[[val: [executable: array.executable, variant: array[access: array.access,
start: array.start, length: array.length]], ref: array.base]];
};
AnyFromString:
PUBLIC
PROC [string: String]
RETURNS [Any] ~ {
RETURN[[val: [executable: string.executable, variant: string[access: string.access,
start: string.start, length: string.length]], ref: string.base]];
};
AnyFromFile:
PUBLIC
PROC [file: File]
RETURNS [Any] ~ {
RETURN[[val: [executable: file.executable, variant: file[access: file.access]], ref: file.stream]];
};
AnyFromDict:
PUBLIC
PROC [dict: Dict]
RETURNS [Any] ~ {
RETURN[[val: [executable: dict.executable, variant: dict[]], ref: dict.base]];
};
AnyFromName:
PUBLIC
PROC [name: Name]
RETURNS [Any] ~ {
RETURN[[val: [executable: name.executable, variant: name[]], ref: name.atom]];
};
Stack operations
Push:
PROC [stack: Stack, x: Any] ~ {
count: ArrayIndex ~ stack.count;
IF count<stack.size THEN { stack.base[count] ← x; stack.count ← count+1 }
ELSE ERROR Error[stack.overflow];
};
Pop:
PROC [stack: Stack]
RETURNS [x: Any] ~ {
count: ArrayIndex ~ stack.count;
IF count>0 THEN RETURN [stack.base[stack.count ← count-1]]
ELSE ERROR Error[stack.underflow];
};
Top:
PROC [stack: Stack]
RETURNS [x: Any] ~ {
count: ArrayIndex ~ stack.count;
IF count>0 THEN RETURN [stack.base[count-1]]
ELSE ERROR Error[stack.underflow];
};
PushInt:
PROC [stack: Stack, int:
INT] ~ {
Push[stack, AnyFromInt[int]];
};
PushReal:
PROC [stack: Stack, real:
REAL] ~ {
Push[stack, AnyFromReal[real]];
};
PushBool:
PROC [stack: Stack, bool:
BOOL] ~ {
Push[stack, AnyFromBool[bool]];
};
PushArray:
PROC [stack: Stack, array: Array] ~ {
Push[stack, AnyFromArray[array]];
};
PushString:
PROC [stack: Stack, string: String] ~ {
Push[stack, AnyFromString[string]];
};
PushFile:
PROC [stack: Stack, file: File] ~ {
Push[stack, AnyFromFile[file]];
};
PushDict:
PROC [stack: Stack, dict: Dict] ~ {
Push[stack, AnyFromDict[dict]];
};
PushName:
PROC [stack: Stack, name: Name] ~ {
Push[stack, AnyFromName[name]];
};
PopInt:
PROC [stack: Stack]
RETURNS [
INT] ~ {
x: Any ~ Pop[stack];
WITH val: x.val
SELECT
FROM
integer => RETURN [val.int];
ENDCASE => RETURN [IntFromAny[x]];
};
PopReal:
PROC [stack: Stack]
RETURNS [
REAL] ~ {
x: Any ~ Pop[stack];
WITH val: x.val
SELECT
FROM
integer => RETURN [REAL[val.int]];
real => RETURN [val.real];
ENDCASE => RETURN [RealFromAny[x]];
};
PopBool:
PROC [stack: Stack]
RETURNS [
BOOL] ~ {
x: Any ~ Pop[stack];
WITH val: x.val
SELECT
FROM
boolean => RETURN [val.bool];
ENDCASE => RETURN [BoolFromAny[x]];
};
PopNum:
PROC [stack: Stack]
RETURNS [Any] ~ {
x: Any ~ Pop[stack];
SELECT Type[x]
FROM
integer, real => RETURN [x];
ENDCASE => ERROR Error[typecheck];
};
PopArray:
PROC [stack: Stack]
RETURNS [Array] ~ {
RETURN[ArrayFromAny[Pop[stack]]];
};
PopString:
PROC [stack: Stack]
RETURNS [String] ~ {
RETURN[StringFromAny[Pop[stack]]];
};
PopFile:
PROC [stack: Stack]
RETURNS [File] ~ {
RETURN[FileFromAny[Pop[stack]]];
};
PopDict:
PROC [stack: Stack]
RETURNS [Dict] ~ {
RETURN[DictFromAny[Pop[stack]]];
};
mark: Any ~ [val: [executable:
FALSE, variant: mark[]], ref:
NIL];
PushMark:
PROC [stack: Stack] ~ {
Push[stack, mark];
};
PopMark:
PROC [stack: Stack] ~ {
x: Any ~ Pop[stack];
IF Type[x]#mark THEN ERROR Error[typecheck];
};
Copy:
PROC [stack: Stack, n:
INT] ~ {
IF n
IN ArrayIndex
THEN {
count: ArrayIndex ~ stack.count;
depth: ArrayIndex ~ n;
IF depth>count THEN ERROR Error[stack.underflow];
IF depth>(stack.size-count) THEN ERROR Error[stack.overflow];
ArrayTransfer[to: stack.base, toStart: count,
from: stack.base, fromStart: count-depth, length: depth];
stack.count ← stack.count+depth;
}
ELSE ERROR Error[rangecheck];
};
Roll:
PROC [stack: Stack, n, j:
INT] ~ {
count: ArrayIndex ~ stack.count;
IF n<0 THEN ERROR Error[rangecheck];
IF n>count THEN ERROR Error[stack.underflow];
WHILE j<0 DO j ← j+n ENDLOOP;
UNTIL j<n DO j ← j-n ENDLOOP;
IF j#0
THEN {
Reverse:
PROC [start, stop: ArrayIndex] ~
INLINE {
FOR i: ArrayIndex
IN[0..(stop-start)/2)
DO
i1: ArrayIndex ~ start+i;
i2: ArrayIndex ~ stop-1-i;
temp: Any ~ stack.base[i1];
stack.base[i1] ← stack.base[i2];
stack.base[i2] ← temp;
ENDLOOP;
};
Reverse[count-n, count-j];
Reverse[count-j, count];
Reverse[count-n, count];
};
};
Index:
PROC [stack: Stack, n:
INT]
RETURNS [Any] ~ {
IF n<0 THEN ERROR Error[rangecheck]
ELSE {
count: ArrayIndex ~ stack.count;
IF n<count THEN RETURN[stack.base[count-1-n]]
ELSE ERROR Error[stack.underflow];
};
};
Clear:
PROC [stack: Stack] ~ {
stack.count ← 0;
};
Count:
PROC [stack: Stack]
RETURNS [
INT] ~ {
RETURN [stack.count];
};
ClearToMark:
PROC [stack: Stack] ~ {
count: ArrayIndex ~ stack.count;
FOR i: ArrayIndex
DECREASING
IN [0..count)
DO
IF Type[stack.base[i]]=mark THEN stack.count ← i;
ENDLOOP;
ERROR Error[unmatchedmark];
};
CountToMark:
PROC [stack: Stack]
RETURNS [
INT] ~ {
count: ArrayIndex ~ stack.count;
FOR i: ArrayIndex
DECREASING
IN [0..count)
DO
IF Type[stack.base[i]]=mark THEN RETURN [count-(i+1)];
ENDLOOP;
ERROR Error[unmatchedmark];
};
Primitives
Ptype:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
PushName[self.ostack, [executable: TRUE, atom: atomFromType[Type[x]]]];
};
Pcvlit:
PROC [self: Root] ~ {
x: Any ← Pop[self.ostack];
x.val.executable ← FALSE;
Push[self.ostack, x];
};
Pcvx:
PROC [self: Root] ~ {
x: Any ← Pop[self.ostack];
x.val.executable ← TRUE;
Push[self.ostack, x];
};
Pxcheck:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
PushBool[self.ostack, x.val.executable];
};
ChangeAccess:
PROC [x: Any, access: Access]
RETURNS [Any] ~ {
WITH val: x.val
SELECT
FROM
array => {
IF val.access<access
THEN
ERROR Error[invalidaccess];
val.access ← access;
};
string => {
IF val.access<access
THEN
ERROR Error[invalidaccess];
val.access ← access;
};
file => {
IF val.access<access
THEN
ERROR Error[invalidaccess];
val.access ← access;
};
dict => {
base: DictBase ~ NARROW[x.ref];
IF access=executeOnly THEN ERROR Error[typecheck];
IF base.access<access
THEN
ERROR Error[invalidaccess];
base.access ← access;
};
ENDCASE => ERROR Error[typecheck];
RETURN [x];
};
Preadonly:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
Push[self.ostack, ChangeAccess[x, readOnly]];
};
Pexecuteonly:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
Push[self.ostack, ChangeAccess[x, executeOnly]];
};
Pnoaccess:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
Push[self.ostack, ChangeAccess[x, none]];
};
Prcheck:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
bool: BOOL ← FALSE;
SELECT Type[x]
FROM
array => bool ← ArrayFromAny[x].access>=readOnly;
string => bool ← StringFromAny[x].access>=readOnly;
dict => bool ← DictFromAny[x].base.access>=readOnly;
file => bool ← FileFromAny[x].access>=readOnly;
ENDCASE => ERROR Error[typecheck];
PushBool[self.ostack, bool];
};
Pwcheck:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
bool: BOOL ← FALSE;
SELECT Type[x]
FROM
array => bool ← ArrayFromAny[x].access=unlimited;
string => bool ← StringFromAny[x].access=unlimited;
dict => bool ← DictFromAny[x].base.access=unlimited;
file => bool ← FileFromAny[x].access=unlimited;
ENDCASE => ERROR Error[typecheck];
PushBool[self.ostack, bool];
};
Pcvi: PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
PushInt[self.ostack, CvI[x]];
};
Pcvn: PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
WITH x: x SELECT FROM
string => Push[self.ostack, CvN[x]];
ENDCASE => ERROR Error[typecheck];
};
Pcvr: PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
PushReal[self.ostack, CvR[x]];
};
Pcvrs: PROC [self: Root] ~ {
string: String ~ PopString[self.ostack];
radix: INT ~ PopInt[self.ostack];
num: Any ~ PopNum[self.ostack];
int: INT ~ CvI[num];
ERROR Error[unimplemented];
};
Pcvs: PROC [self: Root] ~ {
};
Ppop:
PROC [self: Root] ~ {
[] ← Pop[self.ostack];
};
Pexch:
PROC [self: Root] ~ {
Roll[self.ostack, 2, 1];
};
Pdup:
PROC [self: Root] ~ {
Copy[self.ostack, 2];
};
Pindex:
PROC [self: Root] ~ {
n: INT ~ PopInt[self.ostack];
Push[self.ostack, Index[self.ostack, n]];
};
Proll:
PROC [self: Root] ~ {
j: INT ~ PopInt[self.ostack];
n: INT ~ PopInt[self.ostack];
Roll[self.ostack, n, j];
};
Pclear:
PROC [self: Root] ~ {
Clear[self.ostack];
};
Pcount:
PROC [self: Root] ~ {
PushInt[self.ostack, Count[self.ostack]];
};
Pmark:
PROC [self: Root] ~ {
PushMark[self.ostack];
};
Pcleartomark:
PROC [self: Root] ~ {
ClearToMark[self.ostack];
};
Pcounttomark:
PROC [self: Root] ~ {
PushInt[self.ostack, CountToMark[self.ostack]];
};
Register1:
PROC [self: Root] ~ {
Register[self, "pop", Ppop];
Register[self, "exch", Pexch];
Register[self, "dup", Pdup];
Register[self, "index", Pindex];
Register[self, "roll", Proll];
Register[self, "clear", Pclear];
Register[self, "count", Pcount];
Register[self, "mark", Pmark];
Register[self, "cleartomark", Pcleartomark];
Register[self, "counttomark", Pcounttomark];
};
RegisterPrimitives[Register1];