Control operators
null: Any ~ [val: [executable:
FALSE, variant: null[]], ref:
NIL];
nullArray: Array ~ [executable:
FALSE, access: none, start: 0, length: 0, base:
NIL];
ArrayToken:
PROC [array: Array]
RETURNS [found:
BOOL, token: Any, post: Array] ~ {
IF array.length>0
THEN {
found ← TRUE;
token ← ArrayGet[array, 0];
post ← ArrayGetInterval[array, 1, array.length-1];
}
ELSE {
found ← FALSE;
token ← null;
post ← nullArray;
};
};
ExecToken:
PROC [self: Root, token: Any] ~ {
IF Executable[token] AND Type[token]#array THEN Push[self.estack, token]
ELSE Push[self.ostack, token]; -- push literal or defer procedure
};
Execute:
PROC [self: Root, x: Any] ~ {
IF Executable[x]
THEN
SELECT Type[x]
FROM
array => {
array: Array ~ ArrayFromAny[x];
found: BOOL; token: Any; post: Array;
IF array.access<executeOnly THEN ERROR Error[invalidaccess];
[found, token, post] ← ArrayToken[array];
IF found
THEN {
IF post.length>0 THEN PushArray[self.estack, post];
ExecToken[self, token];
};
};
string => {
string: String ~ StringFromAny[x];
found: BOOL; token: Any; post: String;
IF string.access<executeOnly THEN ERROR Error[invalidaccess];
[found, token, post] ← StringToken[string];
IF found
THEN {
IF post.length>0 THEN PushString[self.estack, post];
ExecToken[self, token];
};
};
file => {
file: File ~ FileFromAny[x];
found: BOOL; token: Any;
IF file.access<executeOnly THEN ERROR Error[invalidaccess];
[found, token] ← FileToken[file];
IF found
THEN {
PushFile[self.estack, file];
ExecToken[self, token];
};
};
name => {
Push[self.estack, Load[self, x]];
};
operator => {
operator: Operator ~ OperatorFromAny[x];
operator.proc[self];
};
null => NULL;
ENDCASE => Push[self.ostack, x] -- other types are always literal
ELSE Push[self.ostack, x]; -- literal
};
GetError:
PROC [self: Root, errorType: ErrorType]
RETURNS [Any] ~ {
RETURN [null];
};
ExecutionLoop:
PROC [self: Root] ~ {
WHILE self.estack.count>0
DO
x: Any ~ Pop[self.estack];
restoreCount: ArrayIndex ~ self.ostack.count;
Execute[self, x ! Error => {
self.ostack.count ← restoreCount;
Push[self.ostack, x];
Push[self.estack, GetError[self, errorType]];
CONTINUE;
}];
***** set popped stack elements to NIL here? *****
ENDLOOP;
};
Primitives
Pexec:
PROC [self: Root] ~ {
x: Any ~ Pop[self.ostack];
Push[self.estack, x];
};
Pif:
PROC [self: Root] ~ {
proc: Array ~ PopArray[self.ostack];
bool: BOOL ~ PopBool[self.ostack];
IF bool THEN PushArray[self.estack, proc];
};
Pifelse:
PROC [self: Root] ~ {
proc2: Array ~ PopArray[self.ostack];
proc1: Array ~ PopArray[self.ostack];
bool: BOOL ~ PopBool[self.ostack];
PushArray[self.estack, IF bool THEN proc1 ELSE proc2];
};
ifor: Operator ~ RegisterInternal["@ifor", Xifor];
rfor: Operator ~ RegisterInternal["@rfor", Xrfor];
Xifor:
PROC [self: Root] ~ {
control: INT ~ PopInt[self.estack];
increment: INT ~ PopInt[self.estack];
limit: INT ~ PopInt[self.estack];
proc: Any ~ Top[self.estack];
IF (
IF increment<0
THEN control<limit
ELSE control>limit)
THEN {
[--proc--] ← Pop[self.estack];
PopMark[self.estack];
}
ELSE {
PushInt[self.estack, limit];
PushInt[self.estack, increment];
PushInt[self.estack, control+increment];
PushOperator[self.estack, ifor];
PushInt[self.ostack, control];
Push[self.estack, proc];
};
};
Xrfor:
PROC [self: Root] ~ {
control: REAL ~ PopReal[self.estack];
increment: REAL ~ PopReal[self.estack];
limit: REAL ~ PopReal[self.estack];
proc: Any ~ Top[self.estack];
IF (
IF increment<0
THEN control<limit
ELSE control>limit)
THEN {
[--proc--] ← Pop[self.estack];
PopMark[self.estack];
}
ELSE {
PushReal[self.estack, limit];
PushReal[self.estack, increment];
PushReal[self.estack, control+increment];
PushOperator[self.estack, rfor];
PushReal[self.ostack, control];
Push[self.estack, proc];
};
};
Pfor:
PROC [self: Root] ~ {
proc: Array ~ PopArray[self.ostack];
limit: Num ~ PopNum[self.ostack];
incr: Num ~ PopNum[self.ostack];
initial: Num ~ PopNum[self.ostack];
allInteger: BOOL ~ (limit.tag=int AND incr.tag=int AND initial.tag=int);
PushMark[self.estack];
PushArray[self.estack, proc];
PushNum[self.estack, limit];
PushNum[self.estack, incr];
PushNum[self.estack, initial];
PushOperator[self.estack, IF allInteger THEN ifor ELSE rfor];
};
repeat: Operator ~ RegisterInternal["@repeat", Xrepeat];
Xrepeat:
PROC [self: Root] ~ {
n: INT ~ PopInt[self.estack];
proc: Any ~ Top[self.estack];
IF n=0
THEN {
[--proc--] ← Pop[self.estack];
PopMark[self.estack];
}
ELSE {
PushInt[self.estack, n-1];
PushOperator[self.estack, repeat];
Push[self.estack, proc];
};
};
Prepeat:
PROC [self: Root] ~ {
proc: Array ~ PopArray[self.estack];
int: INT ~ PopInt[self.estack];
IF int<0 THEN ERROR Error[rangecheck];
PushMark[self.estack];
PushArray[self.estack, proc];
PushInt[self.estack, int];
PushOperator[self.estack, repeat];
};
loop: Operator ~ RegisterInternal["@loop", Xloop];
Xloop:
PROC [self: Root] ~ {
proc: Any ~ Top[self.estack];
PushOperator[self.estack, loop];
Push[self.estack, proc];
};
Ploop:
PROC [self: Root] ~ {
proc: Array ~ PopArray[self.ostack];
PushMark[self.estack];
PushArray[self.estack, proc];
PushOperator[self.estack, loop];
};
Pexit:
PROC [self: Root] ~ {
base: ArrayBase ~ self.estack.base;
FOR i: ArrayIndex
DECREASING
IN [0..self.estack.count)
DO
x: Any ~ base[i];
SELECT Type[x]
FROM
mark => {
***** IF x.stop THEN ERROR Error[invalidexit] ELSE *****
self.estack.count ← i;
RETURN;
};
ENDCASE;
ENDLOOP;
};
Pstop: PROC [self: Root] ~ {
WHILE self.estack.count>0 DO
x: Any ~ Pop[self.estack];
WITH x: x SELECT FROM
mark => IF x.stop THEN { PushBool[self.ostack, TRUE]; RETURN };
ENDCASE;
ENDLOOP;
Punt[self];
};
Pstopped: PROC [self: Root] ~ {
proc: Array ~ PopArray[self.ostack];
Push[self.estack, [executable: TRUE, variant: mark[TRUE]]];
PushBool[self.estack, FALSE];
Push[self.estack, proc];
};
Pcountexecstack:
PROC [self: Root] ~ {
PushInt[self.ostack, self.estack.count];
};
Pexecstack:
PROC [self: Root] ~ {
array: Array ~ PopArray[self.ostack];
count: ArrayIndex ~ self.estack.count;
subarray: Array ~ ArrayGetInterval[array, 0, count];
ArrayStore[self.estack, subarray];
self.estack.count ← count;
PushArray[self.ostack, subarray];
};
Pquit:
PROC [self: Root] ~ {
};
Pstart:
PROC [self: Root] ~ {
};
Register3:
PROC [self: Root] ~ {
Register[self, "exec", Pexec];
Register[self, "if", Pif];
Register[self, "ifelse", Pifelse];
Register[self, "for", Pfor];
Register[self, "repeat", Prepeat];
Register[self, "loop", Ploop];
Register[self, "exit", Pexit];
Register[self, "stop", Pstop];
Register[self, "stopped", Pstopped];
Register[self, "countexecstack", Pcountexecstack];
Register[self, "execstack", Pexecstack];
Register[self, "quit", Pquit];
Register[self, "start", Pstart];
};
RegisterPrimitives[Register3];