PSLanguagePrimitivesImpl.mesa
Copyright Ó 1987 by Xerox Corporation. All rights reserved.
Doug Wyatt, August 20, 1987 5:34:30 pm PDT
PostScript base language primitives.
DIRECTORY
PS,
Basics,
RealFns;
PSLanguagePrimitivesImpl: CEDAR PROGRAM
IMPORTS PS, Basics, RealFns
~ BEGIN OPEN PS;
Polymorphic operators
copy: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
integer => {
n: INT ~ PopInt[self];
Copy[self, n];
};
array => {
array2: Array ~ PopArray[self, unlimited];
array1: Array ~ PopArray[self, readOnly];
PushArray[self, ArrayCopy[self: self, array: array2, from: array1]];
};
string => {
string2: String ~ PopString[self, unlimited];
string1: String ~ PopString[self, readOnly];
PushString[self, StringCopy[self: self, string: string2, from: string1]];
};
dict => {
dict2: Dict ~ PopDict[self, unlimited];
dict1: Dict ~ PopDict[self, readOnly];
PushDict[self, DictCopy[self: self, dict: dict2, from: dict1]];
};
ENDCASE => ERROR Error[typecheck];
};
length: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
array => {
array: Array ~ PopArray[self, readOnly];
PushInt[self, ArrayLength[array]];
};
string => {
string: String ~ PopString[self, readOnly];
PushInt[self, StringLength[string]];
};
dict => {
dict: Dict ~ PopDict[self, readOnly];
PushInt[self, DictLength[dict]];
};
name => {
name: Name ~ PopName[self];
PushInt[self, NameLength[name]];
};
ENDCASE => ERROR Error[typecheck];
};
get: PROC [self: Root] ~ {
SELECT TypeIndex[self, 1] FROM
array => {
index: INT ~ PopInt[self];
array: Array ~ PopArray[self, readOnly];
PushAny[self, ArrayGet[array, index]];
};
string => {
index: INT ~ PopInt[self];
string: String ~ PopString[self, readOnly];
PushInt[self, IntFromChar[StringGet[string, index]]];
};
dict => {
key: Any ~ PopAny[self];
dict: Dict ~ PopDict[self, readOnly];
PushAny[self, DictGet[dict, key]];
};
ENDCASE => ERROR Error[typecheck];
};
put: PROC [self: Root] ~ {
SELECT TypeIndex[self, 2] FROM
array => {
any: Any ~ PopAny[self];
index: INT ~ PopInt[self];
array: Array ~ PopArray[self, unlimited];
ArrayPut[self, array, index, any];
};
string => {
int: INT ~ PopInt[self];
index: INT ~ PopInt[self];
string: String ~ PopString[self, unlimited];
StringPut[self, string, index, CharFromInt[int]];
};
dict => {
any: Any ~ PopAny[self];
key: Any ~ PopAny[self];
dict: Dict ~ PopDict[self, unlimited];
DictPut[self, dict, key, any];
};
ENDCASE => ERROR Error[typecheck];
};
getinterval: PROC [self: Root] ~ {
count: INT ~ PopInt[self];
index: INT ~ PopInt[self];
SELECT TypeIndex[self, 0] FROM
array => {
array: Array ~ PopArray[self, readOnly];
PushArray[self, ArrayGetInterval[array, index, count]];
};
string => {
string: String ~ PopString[self, readOnly];
PushString[self, StringGetInterval[string, index, count]];
};
ENDCASE => ERROR Error[typecheck];
};
putinterval: PROC [self: Root] ~ {
SELECT TypeIndex[self, 2] FROM
array => {
array2: Array ~ PopArray[self, readOnly];
index: INT ~ PopInt[self];
array1: Array ~ PopArray[self, unlimited];
ArrayPutInterval[self, array1, index, array2];
};
string => {
string2: String ~ PopString[self, readOnly];
index: INT ~ PopInt[self];
string1: String ~ PopString[self, unlimited];
StringPutInterval[self, string1, index, string2];
};
ENDCASE => ERROR Error[typecheck];
};
forall: PROC [self: Root] ~ {
proc: Any ~ PopAny[self];
SELECT TypeIndex[self, 0] FROM
array => {
array: Array ~ PopArray[self, readOnly];
action: PROC [x: Any] ~ {
PushAny[self, x];
Execute[self, proc];
};
ArrayForAll[array, action ! Exit => CONTINUE];
};
string => {
string: String ~ PopString[self, readOnly];
action: PROC [c: CHAR] ~ {
PushInt[self, IntFromChar[c]];
Execute[self, proc];
};
StringForAll[string, action ! Exit => CONTINUE];
};
dict => {
dict: Dict ~ PopDict[self, readOnly];
action: PROC [key, val: Any] ~ {
PushAny[self, key];
PushAny[self, val];
Execute[self, proc];
};
DictForAll[dict, action ! Exit => CONTINUE];
};
ENDCASE => ERROR Error[typecheck];
};
token: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
string => {
string: String ~ PopString[self, readOnly];
found: BOOL; token: Any; post: String;
[found, token, post] ← StringToken[self, string];
IF found THEN {
PushString[self, post];
PushAny[self, token];
PushBool[self, TRUE];
}
ELSE {
PushBool[self, FALSE];
};
};
file => {
file: File ~ PopFile[self, readOnly];
found: BOOL; token: Any;
[found, token] ← FileToken[self, file];
IF found THEN {
PushAny[self, token];
PushBool[self, TRUE];
}
ELSE {
PushBool[self, FALSE];
};
};
ENDCASE => ERROR Error[typecheck];
};
Operand stack manipulation operators
pop: PROC [self: Root] ~ {
[] ← PopAny[self];
};
exch: PROC [self: Root] ~ {
Roll[self, 2, 1];
};
dup: PROC [self: Root] ~ {
Copy[self, 1];
};
copy is polymorphic
index: PROC [self: Root] ~ {
n: INT ~ PopInt[self];
PushAny[self, Index[self, n]];
};
roll: PROC [self: Root] ~ {
j: INT ~ PopInt[self];
n: INT ~ PopInt[self];
Roll[self, n, j];
};
clear: PROC [self: Root] ~ {
Clear[self];
};
count: PROC [self: Root] ~ {
PushInt[self, Count[self]];
};
mark: PROC [self: Root] ~ {
PushMark[self];
};
cleartomark: PROC [self: Root] ~ {
ClearToMark[self];
};
counttomark: PROC [self: Root] ~ {
PushInt[self, CountToMark[self]];
};
Arithmetic and math operators
add: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer AND TypeIndex[self, 1]=integer THEN {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
int3: INT ~ int1+int2;
ok: BOOL ~ (int1<0)#(int2<0) OR (int2<0)=(int3<0);
IF ok THEN PushInt[self, int3]
ELSE PushReal[self, REAL[int1]+REAL[int2]];
}
ELSE {
real2: REAL ~ PopReal[self];
real1: REAL ~ PopReal[self];
PushReal[self, real1+real2];
};
};
sub: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer AND TypeIndex[self, 1]=integer THEN {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
int3: INT ~ int1-int2;
ok: BOOL ~ (int1<0)=(int2<0) OR (int2<0)#(int3<0);
IF ok THEN PushInt[self, int3]
ELSE PushReal[self, REAL[int1]-REAL[int2]];
}
ELSE {
real2: REAL ~ PopReal[self];
real1: REAL ~ PopReal[self];
PushReal[self, real1-real2];
};
};
minInt: REAL ← INT.FIRST;
maxInt: REAL ← INT.LAST;
mul: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer AND TypeIndex[self, 1]=integer THEN {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
real3: REAL ~ REAL[int1]*REAL[int2];
ok: BOOL ~ real3 IN [minInt .. maxInt]; -- ***** fix this? *****
IF ok THEN PushInt[self, int1*int2]
ELSE PushReal[self, real3];
}
ELSE {
real2: REAL ~ PopReal[self];
real1: REAL ~ PopReal[self];
PushReal[self, real1*real2];
};
};
div: PROC [self: Root] ~ {
real2: REAL ~ PopReal[self];
real1: REAL ~ PopReal[self];
PushReal[self, real1/real2];
};
idiv: PROC [self: Root] ~ {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, int1/int2];
};
mod: PROC [self: Root] ~ {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, int1 MOD int2];
};
abs: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer THEN {
int: INT ~ PopInt[self];
ok: BOOL ~ (int#INT.FIRST);
IF ok THEN PushInt[self, ABS[int]]
ELSE PushReal[self, ABS[REAL[int]]];
}
ELSE {
real: REAL ~ PopReal[self];
PushReal[self, ABS[real]];
};
};
neg: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer THEN {
int: INT ~ PopInt[self];
ok: BOOL ~ (int#INT.FIRST);
IF ok THEN PushInt[self, -int]
ELSE PushReal[self, -REAL[int]];
}
ELSE {
real: REAL ~ PopReal[self];
PushReal[self, -real];
};
};
ceiling: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer THEN {
int: INT ~ PopInt[self];
PushInt[self, int];
}
ELSE {
real: REAL ~ PopReal[self];
PushReal[self, Ceiling[real]];
};
};
floor: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer THEN {
int: INT ~ PopInt[self];
PushInt[self, int];
}
ELSE {
real: REAL ~ PopReal[self];
PushReal[self, Floor[real]];
};
};
round: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer THEN {
int: INT ~ PopInt[self];
PushInt[self, int];
}
ELSE {
real: REAL ~ PopReal[self];
PushReal[self, Round[real]];
};
};
truncate: PROC [self: Root] ~ {
IF TypeIndex[self, 0]=integer THEN {
int: INT ~ PopInt[self];
PushInt[self, int];
}
ELSE {
real: REAL ~ PopReal[self];
PushReal[self, Truncate[real]];
};
};
sqrt: PROC [self: Root] ~ {
num: REAL ~ PopReal[self];
PushReal[self, RealFns.SqRt[num]];
};
atan: PROC [self: Root] ~ {
den: REAL ~ PopReal[self];
num: REAL ~ PopReal[self];
PushReal[self, RealFns.ArcTanDeg[num, den]];
};
cos: PROC [self: Root] ~ {
angle: REAL ~ PopReal[self];
PushReal[self, RealFns.CosDeg[angle]];
};
sin: PROC [self: Root] ~ {
angle: REAL ~ PopReal[self];
PushReal[self, RealFns.SinDeg[angle]];
};
exp: PROC [self: Root] ~ {
exponent: REAL ~ PopReal[self];
base: REAL ~ PopReal[self];
PushReal[self, RealFns.Power[base, exponent]];
};
ln: PROC [self: Root] ~ {
num: REAL ~ PopReal[self];
PushReal[self, RealFns.Ln[num]];
};
log: PROC [self: Root] ~ {
num: REAL ~ PopReal[self];
PushReal[self, RealFns.Log[10, num]];
};
rand: PROC [self: Root] ~ {
int: INT ~ Rand[self];
PushInt[self, int];
};
srand: PROC [self: Root] ~ {
int: INT ~ PopInt[self];
SRand[self, int];
};
rrand: PROC [self: Root] ~ {
int: INT ~ RRand[self];
PushInt[self, int];
};
Array operators
array: PROC [self: Root] ~ {
size: INT ~ PopInt[self];
PushArray[self, ArrayCreate[self, size]];
};
endarray: PROC [self: Root] ~ { -- ]
size: INT ~ CountToMark[self];
array: Array ~ ArrayCreate[self, size];
AStore[self, array];
PopMark[self];
PushArray[self, array];
};
length is polymorphic
get is polymorphic
put is polymorphic
getinterval is polymorphic
putinterval is polymorphic
aload: PROC [self: Root] ~ {
array: Array ~ PopArray[self, readOnly];
ALoad[self, array];
PushArray[self, array];
};
astore: PROC [self: Root] ~ {
array: Array ~ PopArray[self, unlimited];
AStore[self, array];
PushArray[self, array];
};
copy is polymorphic
forall is polymorphic
Dictionary operators
dict: PROC [self: Root] ~ {
size: INT ~ PopInt[self];
PushDict[self, DictCreate[self, size]];
};
length is polymorphic
maxlength: PROC [self: Root] ~ {
dict: Dict ~ PopDict[self, readOnly];
PushInt[self, DictMaxLength[dict]];
};
begin: PROC [self: Root] ~ {
dict: Dict ~ PopDict[self, readOnly];
Begin[self, dict];
};
end: PROC [self: Root] ~ {
End[self];
};
def: PROC [self: Root] ~ {
value: Any ~ PopAny[self];
key: Any ~ PopAny[self];
Def[self, key, value];
};
load: PROC [self: Root] ~ {
key: Any ~ PopAny[self];
PushAny[self, Load[self, key]];
};
store: PROC [self: Root] ~ {
value: Any ~ PopAny[self];
key: Any ~ PopAny[self];
Store[self, key, value];
};
get is polymorphic
put is polymorphic
known: PROC [self: Root] ~ {
key: Any ~ PopAny[self];
dict: Dict ~ PopDict[self, readOnly];
PushBool[self, Known[dict, key]];
};
where: PROC [self: Root] ~ {
key: Any ~ PopAny[self];
found: BOOL; dict: Dict;
[found, dict] ← Where[self, key];
IF found THEN PushDict[self, dict];
PushBool[self, found];
};
copy is polymorphic
forall is polymorphic
currentdict: PROC [self: Root] ~ {
PushDict[self, CurrentDict[self]];
};
countdictstack: PROC [self: Root] ~ {
PushInt[self, CountDictStack[self]];
};
dictstack: PROC [self: Root] ~ {
array: Array ~ PopArray[self, unlimited];
PushArray[self, DictStack[self, array]];
};
String operators
string: PROC [self: Root] ~ {
size: INT ~ PopInt[self];
PushString[self, StringCreate[self, size]];
};
length is polymorphic
get is polymorphic
put is polymorphic
getinterval is polymorphic
putinterval is polymorphic
copy is polymorphic
forall is polymorphic
anchorsearch: PROC [self: Root] ~ {
seek: String ~ PopString[self, readOnly];
string: String ~ PopString[self, readOnly];
found: BOOL; index: INT;
[found: found, index: index] ← Search[string: string, seek: seek, anchor: TRUE];
IF index#0 THEN ERROR Bug;
IF found THEN {
matchLength: INT ~ StringLength[seek];
match: String ~ StringGetInterval[string, 0, matchLength];
post: String ~ StringGetInterval[string, matchLength, StringLength[string]-matchLength];
PushString[self, post];
PushString[self, match];
PushBool[self, TRUE];
}
ELSE {
PushString[self, string];
PushBool[self, FALSE];
};
};
search: PROC [self: Root] ~ {
seek: String ~ PopString[self, readOnly];
string: String ~ PopString[self, readOnly];
found: BOOL; matchIndex: INT;
[found: found, index: matchIndex] ← Search[string: string, seek: seek, anchor: FALSE];
IF found THEN {
matchLength: INT ~ StringLength[seek];
postIndex: INT ~ matchIndex+matchLength;
pre: String ~ StringGetInterval[string, 0, matchIndex];
match: String ~ StringGetInterval[string, matchIndex, matchLength];
post: String ~ StringGetInterval[string, postIndex, StringLength[string]-postIndex];
PushString[self, post];
PushString[self, match];
PushString[self, pre];
PushBool[self, TRUE];
}
ELSE {
PushString[self, string];
PushBool[self, FALSE];
};
};
token is polymorphic
Relational, boolean, and bitwise operators
eq: PROC [self: Root] ~ {
x2: Any ~ PopAny[self];
x1: Any ~ PopAny[self];
PushBool[self, Eq[x1, x2]];
};
ne: PROC [self: Root] ~ {
x2: Any ~ PopAny[self];
x1: Any ~ PopAny[self];
PushBool[self, NOT Eq[x1, x2]];
};
ge: PROC [self: Root] ~ {
x2: Any ~ PopAny[self];
x1: Any ~ PopAny[self];
PushBool[self, Compare[x1, x2]>=equal];
};
gt: PROC [self: Root] ~ {
x2: Any ~ PopAny[self];
x1: Any ~ PopAny[self];
PushBool[self, Compare[x1, x2]>equal];
};
le: PROC [self: Root] ~ {
x2: Any ~ PopAny[self];
x1: Any ~ PopAny[self];
PushBool[self, Compare[x1, x2]<=equal];
};
lt: PROC [self: Root] ~ {
x2: Any ~ PopAny[self];
x1: Any ~ PopAny[self];
PushBool[self, Compare[x1, x2]<equal];
};
and: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
boolean => {
bool2: BOOL ~ PopBool[self];
bool1: BOOL ~ PopBool[self];
PushBool[self, bool1 AND bool2];
};
integer => {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleAnd[[li[int1]], [li[int2]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
not: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
boolean => {
bool1: BOOL ~ PopBool[self];
PushBool[self, NOT bool1];
};
integer => {
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleNot[[li[int1]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
or: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
boolean => {
bool2: BOOL ~ PopBool[self];
bool1: BOOL ~ PopBool[self];
PushBool[self, bool1 OR bool2];
};
integer => {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleOr[[li[int1]], [li[int2]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
xor: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
boolean => {
bool2: BOOL ~ PopBool[self];
bool1: BOOL ~ PopBool[self];
PushBool[self, bool1 # bool2];
};
integer => {
int2: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
PushInt[self, Basics.DoubleXor[[li[int1]], [li[int2]]].li];
};
ENDCASE => ERROR Error[typecheck];
};
bitshift: PROC [self: Root] ~ {
shift: INT ~ PopInt[self];
int1: INT ~ PopInt[self];
IF shift NOT IN INTEGER THEN PushInt[self, 0]
ELSE PushInt[self, Basics.DoubleShift[[li[int1]], shift].li];
};
Control operators
exec: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
Execute[self, x];
};
if: PROC [self: Root] ~ {
proc: Any ~ PopProc[self];
bool: BOOL ~ PopBool[self];
IF bool THEN Execute[self, proc];
};
ifelse: PROC [self: Root] ~ {
proc2: Any ~ PopProc[self];
proc1: Any ~ PopProc[self];
bool: BOOL ~ PopBool[self];
Execute[self, IF bool THEN proc1 ELSE proc2];
};
for: PROC [self: Root] ~ {
proc: Any ~ PopProc[self];
type0: TypeCode ~ TypeIndex[self, 0];
type1: TypeCode ~ TypeIndex[self, 1];
type2: TypeCode ~ TypeIndex[self, 2];
IF type0=integer AND type1=integer AND type2=integer THEN {
limit: INT ~ PopInt[self];
increment: INT ~ PopInt[self];
initial: INT ~ PopInt[self];
FOR control: INT ← initial, control+increment
UNTIL (IF increment>0 THEN control>limit ELSE control<limit) DO
PushInt[self, control];
Execute[self, proc ! Exit => EXIT];
ENDLOOP;
}
ELSE {
limit: REAL ~ PopReal[self];
increment: REAL ~ PopReal[self];
initial: REAL ~ PopReal[self];
FOR control: REAL ← initial, control+increment
UNTIL (IF increment>0 THEN control>limit ELSE control<limit) DO
PushReal[self, control];
Execute[self, proc ! Exit => EXIT];
ENDLOOP;
};
};
repeat: PROC [self: Root] ~ {
proc: Any ~ PopProc[self];
int: INT ~ PopInt[self];
IF int<0 THEN ERROR Error[rangecheck];
THROUGH [0..int) DO
Execute[self, proc ! Exit => EXIT];
ENDLOOP;
};
loop: PROC [self: Root] ~ {
proc: Any ~ PopProc[self];
DO
Execute[self, proc ! Exit => EXIT];
ENDLOOP;
};
exit: PROC [self: Root] ~ {
SIGNAL Exit;
ERROR Error[invalidexit];
};
stop: PROC [self: Root] ~ {
ERROR Stop;
};
stopped: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
stopped: BOOL ← FALSE;
Execute[self, x !
Stop => { stopped ← TRUE; CONTINUE };
Exit => { RESUME };
];
PushBool[self, stopped];
};
quit: PROC [self: Root] ~ {
ERROR Quit;
};
Type, attribute, and conversion operators
type: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
PushName[self, NameFromType[self, Type[x]]];
};
cvlit: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
PushAny[self, CvLit[x]];
};
cvx: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
PushAny[self, CvX[x]];
};
xcheck: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
PushBool[self, XCheck[x]];
};
DoCheckAccess: PROC [self: Root, check: Access] ~ {
access: Access ~ SELECT TypeIndex[self, 0] FROM
array => ArrayAccess[PopArray[self, none]],
string => StringAccess[PopString[self, none]],
dict => DictAccess[PopDict[self, none]],
file => FileAccess[PopFile[self, none]],
ENDCASE => ERROR Error[typecheck];
PushBool[self, access>=check];
};
DoSetAccess: PROC [self: Root, access: Access] ~ {
SELECT TypeIndex[self, 0] FROM
array => PushArray[self, ArraySetAccess[PopArray[self, access], access]];
string => PushString[self, StringSetAccess[PopString[self, access], access]];
dict => PushDict[self, DictSetAccess[self, PopDict[self, access], access]];
file => PushFile[self, FileSetAccess[PopFile[self, access], access]];
ENDCASE => ERROR Error[typecheck];
};
readonly: PROC [self: Root] ~ { DoSetAccess[self, readOnly] };
executeonly: PROC [self: Root] ~ { DoSetAccess[self, executeOnly] };
noaccess: PROC [self: Root] ~ { DoSetAccess[self, none] };
wcheck: PROC [self: Root] ~ { DoCheckAccess[self, unlimited] };
rcheck: PROC [self: Root] ~ { DoCheckAccess[self, readOnly] };
cvi: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
integer => {
int: INT ~ PopInt[self];
PushInt[self, int];
};
real => {
real: REAL ~ PopReal[self];
PushInt[self, IntFromReal[real]];
};
string => {
string: String ~ PopString[self, readOnly];
PushInt[self, IntFromString[string]];
};
ENDCASE => ERROR Error[typecheck];
};
cvn: PROC [self: Root] ~ {
string: String ~ PopString[self, readOnly];
PushName[self, NameFromString[self, string]];
};
cvr: PROC [self: Root] ~ {
SELECT TypeIndex[self, 0] FROM
integer => {
int: INT ~ PopInt[self];
PushReal[self, RealFromInt[int]];
};
real => {
real: REAL ~ PopReal[self];
PushReal[self, real];
};
string => {
string: String ~ PopString[self, readOnly];
PushReal[self, RealFromString[string]];
};
ENDCASE => ERROR Error[typecheck];
};
cvrs: PROC [self: Root] ~ {
string: String ~ PopString[self, unlimited];
radix: INT ~ PopInt[self];
SELECT TypeIndex[self, 0] FROM
integer => {
int: INT ~ PopInt[self];
PushString[self, StringFromInt[self, string, int, radix]];
};
real => {
real: REAL ~ PopReal[self];
PushString[self, StringFromInt[self, string, IntFromReal[real], radix]];
};
ENDCASE => ERROR Error[typecheck];
};
cvs: PROC [self: Root] ~ {
string: String ~ PopString[self, unlimited];
SELECT TypeIndex[self, 0] FROM
integer => {
int: INT ~ PopInt[self];
PushString[self, StringFromInt[self, string, int]];
};
real => {
real: REAL ~ PopReal[self];
PushString[self, StringFromReal[self, string, real]];
};
boolean => {
bool: BOOL ~ PopBool[self];
PushString[self, StringFromText[self, string, (IF bool THEN "true" ELSE "false")]];
};
string => {
source: String ~ PopString[self, readOnly];
PushString[self, StringCopy[self: self, string: string, from: source]];
};
name => {
name: Name ~ PopName[self];
PushString[self, StringFromName[self, string, name]];
};
operator => {
operator: Operator ~ PopOperator[self];
PushString[self, StringFromOperator[self, string, operator]];
};
ENDCASE => {
x: Any ~ PopAny[self];
PushString[self, StringFromText[self, string, "--nostringval--"]];
};
};
File operators
FileAccessModeFromString: PROC [string: String] RETURNS [FileAccessMode] ~ {
IF StringLength[string]=1 THEN SELECT StringGet[string, 0] FROM
'r => RETURN[$read];
'w => RETURN[$create];
ENDCASE;
ERROR Error[invalidfileaccess];
};
file: PROC [self: Root] ~ {
string2: String ~ PopString[self, readOnly];
string1: String ~ PopString[self, readOnly];
PushFile[self, FileCreate[self, string1, FileAccessModeFromString[string2]]];
};
closefile: PROC [self: Root] ~ {
file: File ~ PopFile[self, readOnly];
CloseFile[file];
};
read: PROC [self: Root] ~ {
file: File ~ PopFile[self, readOnly];
found: BOOL ← TRUE;
char: CHAR;
char ← Read[file ! EndOfFile => { found ← FALSE; CONTINUE }];
IF found THEN PushInt[self, IntFromChar[char]];
PushBool[self, found];
};
write: PROC [self: Root] ~ {
int: INT ~ PopInt[self];
file: File ~ PopFile[self, unlimited];
Write[file, VAL[LOOPHOLE[int, Basics.LongNumber].ll]];
};
ReadStringProc: TYPE ~ PROC [self: Root, file: File, string: String] RETURNS [String, BOOL];
DoReadString: PROC [self: Root, readString: ReadStringProc] ~ {
string: String ~ PopString[self, unlimited];
file: File ~ PopFile[self, readOnly];
substring: String; bool: BOOL;
[substring, bool] ← readString[self, file, string];
PushString[self, substring];
PushBool[self, bool];
};
WriteStringProc: TYPE ~ PROC [file: File, string: String];
DoWriteString: PROC [self: Root, writeString: WriteStringProc] ~ {
string: String ~ PopString[self, readOnly];
file: File ~ PopFile[self, unlimited];
writeString[file, string];
};
readhexstring: PROC [self: Root] ~ {
DoReadString[self, ReadHexString];
};
writehexstring: PROC [self: Root] ~ {
DoWriteString[self, WriteHexString];
};
readstring: PROC [self: Root] ~ {
DoReadString[self, ReadString];
};
writestring: PROC [self: Root] ~ {
DoWriteString[self, WriteString];
};
readline: PROC [self: Root] ~ {
DoReadString[self, ReadLine];
};
token is polymorphic
bytesavailable: PROC [self: Root] ~ {
file: File ~ PopFile[self, readOnly];
PushInt[self, BytesAvailable[file]];
};
flush: PROC [self: Root] ~ {
FlushFile[self.stdout];
};
flushfile: PROC [self: Root] ~ {
file: File ~ PopFile[self, readOnly];
FlushFile[file];
};
resetfile: PROC [self: Root] ~ {
file: File ~ PopFile[self, readOnly];
ResetFile[file];
};
status: PROC [self: Root] ~ {
file: File ~ PopFile[self, readOnly];
PushBool[self, Status[file]];
};
run: PROC [self: Root] ~ {
string: String ~ PopString[self, readOnly];
file: File ~ FileCreate[self, string, $read];
Execute[self, CvX[AnyFromFile[file]] !
UNWIND => CloseFile[file];
Exit => RESUME; -- invalidexit
];
CloseFile[file];
};
currentfile: PROC [self: Root] ~ {
file: File ~ SIGNAL CurrentFile[];
PushFile[self, file];
};
print: PROC [self: Root] ~ {
string: String ~ PopString[self, readOnly];
WriteString[self.stdout, string];
};
echo: PROC [self: Root] ~ {
bool: BOOL ~ PopBool[self];
Echo[self, bool];
};
Virtual memory operators
save: PROC [self: Root] ~ {
IF self.level<Level.LAST THEN {
level: Level ~ self.level;
self.level ← level+1;
PushAny[self, [[FALSE, save[level]], NIL]];
}
ELSE ERROR Error[limitcheck];
};
restore: PROC [self: Root] ~ {
x: Any ~ PopAny[self];
WITH val: x.val SELECT FROM
save => {
level: Level ~ val.level;
IF NOT level<self.level THEN ERROR Error[invalidrestore];
should check the stacks here
WHILE self.level>level DO
self.level ← self.level-1;
UNTIL self.restore[self.level]=NIL DO
item: RestoreItem ~ self.restore[self.level];
WITH item SELECT FROM
item: REF RestoreItemRep.array => {
};
item: REF RestoreItemRep.string => {
};
item: REF RestoreItemRep.dict => {
};
ENDCASE => ERROR Bug;
self.restore[self.level] ← item.next;
ENDLOOP;
ENDLOOP;
};
ENDCASE => ERROR Error[typecheck];
};
Miscellaneous operators
bind: PROC [self: Root] ~ {
proc: Array ~ PopArray[self, unlimited];
PushArray[self, Bind[proc]];
};
usertime: PROC [self: Root] ~ {
PushInt[self, UserTime[self]];
};
Registration
InitializeLanguagePrimitives: PROC [self: Root] ~ {
RegisterOperator[self, "copy", copy];
RegisterOperator[self, "length", length];
RegisterOperator[self, "get", get];
RegisterOperator[self, "put", put];
RegisterOperator[self, "getinterval", getinterval];
RegisterOperator[self, "putinterval", putinterval];
RegisterOperator[self, "forall", forall];
RegisterOperator[self, "token", token];
RegisterOperator[self, "pop", pop];
RegisterOperator[self, "exch", exch];
RegisterOperator[self, "dup", dup];
RegisterOperator[self, "index", index];
RegisterOperator[self, "roll", roll];
RegisterOperator[self, "clear", clear];
RegisterOperator[self, "count", count];
RegisterOperator[self, "mark", mark];
RegisterOperator[self, "cleartomark", cleartomark];
RegisterOperator[self, "counttomark", counttomark];
RegisterOperator[self, "add", add];
RegisterOperator[self, "div", div];
RegisterOperator[self, "idiv", idiv];
RegisterOperator[self, "mod", mod];
RegisterOperator[self, "mul", mul];
RegisterOperator[self, "sub", sub];
RegisterOperator[self, "abs", abs];
RegisterOperator[self, "neg", neg];
RegisterOperator[self, "ceiling", ceiling];
RegisterOperator[self, "floor", floor];
RegisterOperator[self, "round", round];
RegisterOperator[self, "truncate", truncate];
RegisterOperator[self, "sqrt", sqrt];
RegisterOperator[self, "atan", atan];
RegisterOperator[self, "cos", cos];
RegisterOperator[self, "sin", sin];
RegisterOperator[self, "exp", exp];
RegisterOperator[self, "ln", ln];
RegisterOperator[self, "log", log];
RegisterOperator[self, "rand", rand];
RegisterOperator[self, "srand", srand];
RegisterOperator[self, "rrand", rrand];
RegisterOperator[self, "array", array];
RegisterOperator[self, "[", mark];
RegisterOperator[self, "]", endarray];
RegisterOperator[self, "aload", aload];
RegisterOperator[self, "astore", astore];
RegisterOperator[self, "dict", dict];
RegisterOperator[self, "maxlength", maxlength];
RegisterOperator[self, "begin", begin];
RegisterOperator[self, "end", end];
RegisterOperator[self, "def", def];
RegisterOperator[self, "load", load];
RegisterOperator[self, "store", store];
RegisterOperator[self, "known", known];
RegisterOperator[self, "where", where];
RegisterOperator[self, "currentdict", currentdict];
RegisterOperator[self, "countdictstack", countdictstack];
RegisterOperator[self, "dictstack", dictstack];
RegisterOperator[self, "string", string];
RegisterOperator[self, "anchorsearch", anchorsearch];
RegisterOperator[self, "search", search];
RegisterOperator[self, "eq", eq];
RegisterOperator[self, "ne", ne];
RegisterOperator[self, "ge", ge];
RegisterOperator[self, "gt", gt];
RegisterOperator[self, "le", le];
RegisterOperator[self, "lt", lt];
RegisterOperator[self, "and", and];
RegisterOperator[self, "not", not];
RegisterOperator[self, "or", or];
RegisterOperator[self, "xor", xor];
RegisterOperator[self, "bitshift", bitshift];
RegisterOperator[self, "exec", exec];
RegisterOperator[self, "if", if];
RegisterOperator[self, "ifelse", ifelse];
RegisterOperator[self, "for", for];
RegisterOperator[self, "repeat", repeat];
RegisterOperator[self, "loop", loop];
RegisterOperator[self, "exit", exit];
RegisterOperator[self, "stop", stop];
RegisterOperator[self, "stopped", stopped];
RegisterOperator[self, "countexecstack", countexecstack];
RegisterOperator[self, "execstack", execstack];
RegisterOperator[self, "quit", quit];
RegisterOperator[self, "type", type];
RegisterOperator[self, "cvlit", cvlit];
RegisterOperator[self, "cvx", cvx];
RegisterOperator[self, "xcheck", xcheck];
RegisterOperator[self, "executeonly", executeonly];
RegisterOperator[self, "noaccess", noaccess];
RegisterOperator[self, "readonly", readonly];
RegisterOperator[self, "rcheck", rcheck];
RegisterOperator[self, "wcheck", wcheck];
RegisterOperator[self, "cvi", cvi];
RegisterOperator[self, "cvn", cvn];
RegisterOperator[self, "cvr", cvr];
RegisterOperator[self, "cvrs", cvrs];
RegisterOperator[self, "cvs", cvs];
RegisterOperator[self, "file", file];
RegisterOperator[self, "closefile", closefile];
RegisterOperator[self, "read", read];
RegisterOperator[self, "write", write];
RegisterOperator[self, "readhexstring", readhexstring];
RegisterOperator[self, "writehexstring", writehexstring];
RegisterOperator[self, "readstring", readstring];
RegisterOperator[self, "writestring", writestring];
RegisterOperator[self, "readline", readline];
RegisterOperator[self, "bytesavailable", bytesavailable];
RegisterOperator[self, "flush", flush];
RegisterOperator[self, "flushfile", flushfile];
RegisterOperator[self, "resetfile", resetfile];
RegisterOperator[self, "status", status];
RegisterOperator[self, "run", run];
RegisterOperator[self, "currentfile", currentfile];
RegisterOperator[self, "print", print];
RegisterOperator[self, "echo", echo];
RegisterOperator[self, "save", save];
RegisterOperator[self, "restore", restore];
RegisterOperator[self, "vmstatus", vmstatus];
RegisterOperator[self, "bind", bind];
RegisterOperator[self, "usertime", usertime];
};
NoteInitialization[InitializeLanguagePrimitives];
END.