PSLanguageImpl.mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 20, 1987 4:26:43 pm PDT
PostScript implementation: base language.
DIRECTORY
PS,
Basics,
Convert,
Real,
RefText,
Rope;
PSLanguageImpl: CEDAR PROGRAM
IMPORTS PS, Basics, Convert, Real, RefText, Rope
EXPORTS PS
~ BEGIN OPEN PS;
Types and attributes
NameFromTypeArray: TYPE ~ ARRAY TypeCode OF Name;
nameFromType: REF NameFromTypeArray ~ NEW [NameFromTypeArray ← [
null: NameFromRope["nulltype"],
integer: NameFromRope["integertype"],
real: NameFromRope["realtype"],
boolean: NameFromRope["booleantype"],
array: NameFromRope["arraytype"],
string: NameFromRope["stringtype"],
name: NameFromRope["nametype"],
dict: NameFromRope["dicttype"],
operator: NameFromRope["operatortype"],
file: NameFromRope["filetype"],
mark: NameFromRope["marktype"],
save: NameFromRope["savetype"],
font: NameFromRope["fonttype"]
]];
NameFromType: PUBLIC PROC [type: TypeCode] RETURNS [Name] ~ {
RETURN [nameFromType[type]];
};
CvLit: PUBLIC PROC [x: Any] RETURNS [Any] ~ {
x.val.executable ← FALSE;
RETURN [x];
};
CvX: PUBLIC PROC [x: Any] RETURNS [Any] ~ {
x.val.executable ← TRUE;
RETURN [x];
};
ArraySetAccess: PROC [array: Array, access: Access] RETURNS [Array] ~ {
IF array.val.access<access THEN ERROR Error[invalidaccess];
array.val.access ← access;
RETURN [array];
};
StringSetAccess: PROC [string: String, access: Access] RETURNS [String] ~ {
IF string.val.access<access THEN ERROR Error[invalidaccess];
string.val.access ← access;
RETURN [string];
};
DictSetAccess: PROC [dict: Dict, access: Access] RETURNS [Dict] ~ {
IF access=executeOnly THEN ERROR Error[typecheck];
IF dict.ref.access<access THEN ERROR Error[invalidaccess];
dict.ref.access ← access;
RETURN [dict];
};
FileSetAccess: PROC [file: File, access: Access] RETURNS [File] ~ {
IF file.val.access<access THEN ERROR Error[invalidaccess];
file.val.access ← access;
RETURN [file];
};
GetAccess: PUBLIC PROC [x: Any] RETURNS [Access] ~ {
SELECT Type[x] FROM
array => RETURN [ArrayAccess[ArrayFromAny[x]]];
dict => RETURN [DictAccess[DictFromAny[x]]];
file => RETURN [FileAccess[FileFromAny[x]]];
string => RETURN [StringAccess[StringFromAny[x]]];
ENDCASE => ERROR Error[typecheck];
};
SetAccess: PUBLIC PROC [x: Any, access: Access] RETURNS [Any] ~ {
SELECT Type[x] FROM
array => RETURN [AnyFromArray[ArraySetAccess[ArrayFromAny[x], access]]];
dict => RETURN [AnyFromDict[DictSetAccess[DictFromAny[x], access]]];
file => RETURN [AnyFromFile[FileSetAccess[FileFromAny[x], access]]];
string => RETURN [AnyFromString[StringSetAccess[StringFromAny[x], access]]];
ENDCASE => ERROR Error[typecheck];
};
IntFromAny: PUBLIC PROC [x: Any] RETURNS [INT] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [val.int];
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];
};
NumFromAny: PUBLIC PROC [x: Any] RETURNS [Num] ~ {
WITH val: x.val SELECT FROM
integer => RETURN [[int[val.int]]];
real => RETURN [[real[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 => WITH x.ref SELECT FROM
ref: ArrayRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};
StringFromAny: PUBLIC PROC [x: Any] RETURNS [String] ~ {
WITH val: x.val SELECT FROM
string => WITH x.ref SELECT FROM
ref: StringRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};
NameFromAny: PUBLIC PROC [x: Any] RETURNS [Name] ~ {
WITH val: x.val SELECT FROM
name => WITH x.ref SELECT FROM
ref: NameRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};
DictFromAny: PUBLIC PROC [x: Any] RETURNS [Dict] ~ {
WITH val: x.val SELECT FROM
dict => WITH x.ref SELECT FROM
ref: DictRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};
FileFromAny: PUBLIC PROC [x: Any] RETURNS [File] ~ {
WITH val: x.val SELECT FROM
file => WITH x.ref SELECT FROM
ref: FileRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
ENDCASE => ERROR Error[typecheck];
};
OperatorFromAny: PUBLIC PROC [x: Any] RETURNS [Operator] ~ {
WITH val: x.val SELECT FROM
operator => WITH x.ref SELECT FROM
ref: OperatorRef => RETURN [[val: val, ref: ref]];
ENDCASE => ERROR Bug;
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]];
};
AnyFromNum: PUBLIC PROC [num: Num] RETURNS [Any] ~ {
WITH num: num SELECT FROM
int => RETURN [[val: [executable: FALSE, variant: integer[int: num.int]], ref: NIL]];
real => RETURN [[val: [executable: FALSE, variant: real[real: num.real]], ref: NIL]];
ENDCASE => ERROR Bug;
};
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: array.val, ref: array.ref]];
};
AnyFromString: PUBLIC PROC [string: String] RETURNS [Any] ~ {
RETURN [[val: string.val, ref: string.ref]];
};
AnyFromName: PUBLIC PROC [name: Name] RETURNS [Any] ~ {
RETURN [[val: name.val, ref: name.ref]];
};
AnyFromDict: PUBLIC PROC [dict: Dict] RETURNS [Any] ~ {
RETURN [[val: dict.val, ref: dict.ref]];
};
AnyFromFile: PUBLIC PROC [file: File] RETURNS [Any] ~ {
RETURN [[val: file.val, ref: file.ref]];
};
Operand stack
OStack: TYPE ~ REF OStackRep;
OStackRep: PUBLIC TYPE ~ RECORD [
count: ArrayIndex,
array: Array
];
NewOStack: PUBLIC PROC [size: INT] RETURNS [OStack] ~ {
RETURN [NEW[OStackRep ← [count: 0, array: ArrayCreate[size]]]];
};
PushAny: PUBLIC PROC [self: Root, x: Any] ~ {
ostack: OStack ~ self.ostack;
IF NOT ostack.count<ArrayLength[ostack.array] THEN ERROR Error[stackoverflow];
ostack.array.ref[ostack.count] ← x;
ostack.count ← ostack.count+1;
};
PushInt: PUBLIC PROC [self: Root, int: INT] ~ {
PushAny[self, [val: [executable: FALSE, variant: integer[int: int]], ref: NIL]];
};
PushReal: PUBLIC PROC [self: Root, real: REAL] ~ {
PushAny[self, [val: [executable: FALSE, variant: real[real: real]], ref: NIL]];
};
PushNum: PUBLIC PROC [self: Root, num: Num] ~ {
PushAny[self, WITH num: num SELECT FROM
int => [val: [executable: FALSE, variant: integer[int: num.int]], ref: NIL],
real => [val: [executable: FALSE, variant: real[real: num.real]], ref: NIL],
ENDCASE => ERROR Bug];
};
PushBool: PUBLIC PROC [self: Root, bool: BOOL] ~ {
PushAny[self, [val: [executable: FALSE, variant: boolean[bool: bool]], ref: NIL]];
};
PushArray: PUBLIC PROC [self: Root, array: Array] ~ {
PushAny[self, AnyFromArray[array]];
};
PushString: PUBLIC PROC [self: Root, string: String] ~ {
PushAny[self, AnyFromString[string]];
};
PushName: PUBLIC PROC [self: Root, name: Name] ~ {
PushAny[self, AnyFromName[name]];
};
PushDict: PUBLIC PROC [self: Root, dict: Dict] ~ {
PushAny[self, AnyFromDict[dict]];
};
PushFile: PUBLIC PROC [self: Root, file: File] ~ {
PushAny[self, AnyFromFile[file]];
};
PopAny: PUBLIC PROC [self: Root] RETURNS [x: Any] ~ {
ostack: OStack ~ self.ostack;
IF NOT ostack.count>0 THEN ERROR Error[stackunderflow];
ostack.count ← ostack.count-1;
RETURN [ostack.array.ref[ostack.count]];
};
PopInt: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
x: Any ~ PopAny[self];
WITH v: x.val SELECT FROM
integer => RETURN [v.int];
ENDCASE => RETURN [IntFromAny[x]];
};
PopReal: PUBLIC PROC [self: Root] RETURNS [REAL] ~ {
x: Any ~ PopAny[self];
WITH v: x.val SELECT FROM
integer => RETURN [REAL[v.int]];
real => RETURN [v.real];
ENDCASE => RETURN [RealFromAny[x]];
};
PopNum: PUBLIC PROC [self: Root] RETURNS [Num] ~ {
x: Any ~ PopAny[self];
WITH v: x.val SELECT FROM
integer => RETURN [[int[v.int]]];
real => RETURN [[real[v.real]]];
ENDCASE => ERROR Error[typecheck];
};
PopBool: PUBLIC PROC [self: Root] RETURNS [BOOL] ~ {
x: Any ~ PopAny[self];
WITH v: x.val SELECT FROM
boolean => RETURN [v.bool];
ENDCASE => RETURN [BoolFromAny[x]];
};
PopArray: PUBLIC PROC [self: Root] RETURNS [Array] ~ {
RETURN[ArrayFromAny[PopAny[self]]];
};
PopString: PUBLIC PROC [self: Root] RETURNS [String] ~ {
RETURN[StringFromAny[PopAny[self]]];
};
PopName: PUBLIC PROC [self: Root] RETURNS [Name] ~ {
RETURN[NameFromAny[PopAny[self]]];
};
PopDict: PUBLIC PROC [self: Root] RETURNS [Dict] ~ {
RETURN[DictFromAny[PopAny[self]]];
};
PopFile: PUBLIC PROC [self: Root] RETURNS [File] ~ {
RETURN[FileFromAny[PopAny[self]]];
};
PopProc: PUBLIC PROC [self: Root] RETURNS [Any] ~ {
x: Any ~ PopAny[self];
SELECT Type[x] FROM
array => RETURN [x];
ENDCASE => ERROR Error[typecheck];
};
PushMark: PUBLIC PROC [self: Root] ~ {
PushAny[self, [val: [executable: FALSE, variant: mark[]], ref: NIL]];
};
PopMark: PUBLIC PROC [self: Root] ~ {
x: Any ~ PopAny[self];
SELECT Type[x] FROM
mark => NULL;
ENDCASE => ERROR Error[typecheck];
};
TopType: PUBLIC PROC [self: Root] RETURNS [TypeCode] ~ {
ostack: OStack ~ self.ostack;
IF NOT ostack.count>0 THEN ERROR Error[stackunderflow];
RETURN [Type[ostack.array.ref[ostack.count-1]]];
};
Copy: PUBLIC PROC [self: Root, n: INT] ~ {
ostack: OStack ~ self.ostack;
IF n<0 THEN ERROR Error[rangecheck];
IF n>ostack.count THEN ERROR Error[stackunderflow];
IF n>(ArrayLength[ostack.array]-ostack.count) THEN ERROR Error[stackoverflow];
FOR i: ArrayIndex IN [ostack.count..ArrayIndex[ostack.count+n]) DO
ostack.array.ref[i] ← ostack.array.ref[i-n];
ENDLOOP;
ostack.count ← ostack.count+n;
};
Roll: PUBLIC PROC [self: Root, n, j: INT] ~ {
ostack: OStack ~ self.ostack;
IF n<0 THEN ERROR Error[rangecheck];
IF n>ostack.count THEN ERROR Error[stackunderflow];
IF j NOT IN [0..n) THEN { j ← j MOD n; IF j<0 THEN j ← j+n };
IF j#0 THEN {
Reverse: PROC [ref: ArrayRef, m1, m2: ArrayIndex] ~ {
FOR i: ArrayIndex IN[0..(m2-m1)/2) DO
i1: ArrayIndex ~ m1+i;
i2: ArrayIndex ~ m2-1-i;
x1: Any ~ ref[i1];
x2: Any ~ ref[i2];
ref[i1] ← x2;
ref[i2] ← x1;
ENDLOOP;
};
k3: ArrayIndex ~ ostack.count;
k2: ArrayIndex ~ k3-j;
k1: ArrayIndex ~ k3-n;
Reverse[ostack.array.ref, k1, k2];
Reverse[ostack.array.ref, k2, k3];
Reverse[ostack.array.ref, k1, k3];
};
};
Index: PUBLIC PROC [self: Root, n: INT] RETURNS [Any] ~ {
ostack: OStack ~ self.ostack;
IF n<0 THEN ERROR Error[rangecheck];
IF NOT n<ostack.count THEN ERROR Error[stackunderflow];
RETURN [ostack.array.ref[ostack.count-1-n]];
};
Clear: PUBLIC PROC [self: Root] ~ {
ostack: OStack ~ self.ostack;
FOR i: ArrayIndex IN[0..ostack.count) DO ostack.array[i].ref ← NIL ENDLOOP;
ostack.count ← 0;
};
Count: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
ostack: OStack ~ self.ostack;
RETURN [ostack.count];
};
RestoreCount: PUBLIC PROC [self: Root, n: INT] ~ {
ostack: OStack ~ self.ostack;
ostack.count ← n;
};
ClearToMark: PUBLIC PROC [self: Root] ~ {
ostack: OStack ~ self.ostack;
FOR i: ArrayIndex DECREASING IN [0..ostack.count) DO
IF Type[ostack.array.ref[i]]=mark THEN { ostack.count ← i; RETURN };
ENDLOOP;
ERROR Error[unmatchedmark];
};
CountToMark: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
ostack: OStack ~ self.ostack;
IF ostack.count>0 THEN {
last: ArrayIndex ~ ostack.count-1;
FOR i: ArrayIndex DECREASING IN [0..last] DO
IF Type[ostack.array.ref[i]]=mark THEN RETURN [last-i];
ENDLOOP;
};
ERROR Error[unmatchedmark];
};
Array operators
ArrayCreate: PUBLIC PROC [size: INT] RETURNS [Array] ~ {
IF size<0 THEN ERROR Error[rangecheck];
IF size IN ArrayIndex THEN {
ref: ArrayRef ~ NEW[ArrayRep[size]];
FOR i: ArrayIndex IN[0..ref.maxLength) DO ref[i] ← null ENDLOOP;
RETURN[[
val: [executable: FALSE, variant: array[access: unlimited, start: 0, length: size]],
ref: ref
]];
}
ELSE ERROR Error[limitcheck];
};
ArrayGet: PUBLIC PROC [array: Array, index: INT] RETURNS [Any] ~ {
IF index NOT IN [0..array.val.length) THEN ERROR Error[rangecheck];
RETURN [array.ref[array.val.start+index]];
};
ArrayPut: PUBLIC PROC [array: Array, index: INT, x: Any] ~ {
IF index NOT IN[0..array.val.length) THEN ERROR Error[rangecheck];
array.ref[array.val.start+index] ← x;
};
ArrayGetInterval: PUBLIC PROC [array: Array, index, count: INT] RETURNS [Array] ~ {
IF index NOT IN [0..array.val.length] THEN ERROR Error[rangecheck];
IF count NOT IN [0..(array.val.length-index)] THEN ERROR Error[rangecheck];
RETURN[[
val: [executable: array.val.executable, variant: array[
access: array.val.access, start: array.val.start+index, length: count]],
ref: array.ref
]];
};
ArrayPutInterval: PUBLIC PROC [array: Array, index: INT, interval: Array] ~ {
subarray: Array ~ ArrayGetInterval[array, index, ArrayLength[interval]];
FOR i: INT IN[0..ArrayLength[subarray]) DO
ArrayPut[subarray, i, ArrayGet[interval, i]];
ENDLOOP;
};
ArrayCopy: PUBLIC PROC [array1, array2: Array] RETURNS [Array] ~ {
subarray2: Array ~ ArrayGetInterval[array2, 0, ArrayLength[array1]];
ArrayPutInterval[subarray2, 0, array1];
RETURN [subarray2];
};
ArrayForAll: PUBLIC PROC [array: Array, action: PROC [Any]] ~ {
FOR index: INT IN [0..ArrayLength[array]) DO
action[ArrayGet[array, index]];
ENDLOOP;
};
ALoad: PUBLIC PROC [self: Root, array: Array] ~ {
length: INT ~ ArrayLength[array];
FOR index: INT IN [0..length) DO
PushAny[self, ArrayGet[array, index]];
ENDLOOP;
};
AStore: PUBLIC PROC [self: Root, array: Array] ~ {
length: INT ~ ArrayLength[array];
IF Count[self]<length THEN ERROR Error[stackunderflow];
FOR index: INT DECREASING IN [0..length) DO
ArrayPut[array, index, PopAny[self]];
ENDLOOP;
};
String operators
StringCreate: PUBLIC PROC [size: INT] RETURNS [String] ~ {
IF size<0 THEN ERROR Error[rangecheck];
IF size IN StringIndex THEN {
ref: StringRef ~ NEW[TEXT[size]];
FOR i: StringIndex IN[0..ref.maxLength) DO ref[i] ← VAL[0] ENDLOOP;
RETURN[[
val: [executable: FALSE, variant: string[access: unlimited, start: 0, length: size]],
ref: ref
]];
}
ELSE ERROR Error[limitcheck];
};
StringGet: PUBLIC PROC [string: String, index: INT] RETURNS [CHAR] ~ {
IF index NOT IN [0..string.val.length) THEN ERROR Error[rangecheck];
RETURN [string.ref[string.val.start+index]];
};
StringPut: PUBLIC PROC [string: String, index: INT, x: CHAR] ~ {
IF index NOT IN[0..string.val.length) THEN ERROR Error[rangecheck];
string.ref[string.val.start+index] ← x;
};
StringGetInterval: PUBLIC PROC [string: String, index, count: INT] RETURNS [String] ~ {
IF index NOT IN [0..string.val.length] THEN ERROR Error[rangecheck];
IF count NOT IN [0..(string.val.length-index)] THEN ERROR Error[rangecheck];
RETURN[[
val: [executable: string.val.executable, variant: string[
access: string.val.access, start: string.val.start+index, length: count]],
ref: string.ref
]];
};
StringPutInterval: PUBLIC PROC [string: String, index: INT, interval: String] ~ {
substring: String ~ StringGetInterval[string, index, StringLength[interval]];
***** use ByteBlt here? *****
FOR i: INT IN[0..StringLength[substring]) DO
StringPut[substring, i, StringGet[interval, i]];
ENDLOOP;
};
StringCopy: PUBLIC PROC [string1, string2: String] RETURNS [String] ~ {
substring2: String ~ StringGetInterval[string2, 0, StringLength[string1]];
StringPutInterval[substring2, 0, string1];
RETURN [substring2];
};
StringForAll: PUBLIC PROC [string: String, action: PROC [CHAR]] ~ {
FOR index: INT IN [0..StringLength[string]) DO
action[StringGet[string, index]];
ENDLOOP;
};
StringEq: PUBLIC PROC [string1: String, string2: String] RETURNS [BOOL] ~ {
IF StringLength[string1]#StringLength[string2] THEN RETURN [FALSE];
RETURN [StringCompare[string1, string2]=equal];
};
StringCompare: PUBLIC PROC [string1, string2: String] RETURNS [Comparison] ~ {
length1: INT ~ StringLength[string1];
length2: INT ~ StringLength[string2];
FOR index: INT IN[0..MIN[length1, length2]) DO
char1: CHAR ~ StringGet[string1, index];
char2: CHAR ~ StringGet[string2, index];
IF char1=char2 THEN NULL
ELSE RETURN [IF char1<char2 THEN less ELSE greater];
ENDLOOP;
IF length1=length2 THEN RETURN [equal]
ELSE RETURN [IF length1<length2 THEN less ELSE greater];
};
Search: PUBLIC PROC [string, seek: String, anchor: BOOL]
RETURNS [found: BOOL ← FALSE, index: INT ← 0] ~ {
stringLength: INT ~ StringLength[string];
seekLength: INT ~ StringLength[seek];
UNTIL found OR (stringLength-index)<seekLength DO
FOR i: INT IN[0..seekLength) DO
char1: CHAR ~ StringGet[string, index+i];
char2: CHAR ~ StringGet[seek, i];
IF char1#char2 THEN EXIT;
REPEAT FINISHED => found ← TRUE;
ENDLOOP;
IF anchor THEN EXIT ELSE index ← index+1;
ENDLOOP;
};
Dictionary operations
DictImpl: TYPE ~ REF DictImplRep;
DictImplRep: PUBLIC TYPE ~ RECORD [
length: INT,
data: SEQUENCE maxLength: NAT OF DictNode
];
DictNode: TYPE ~ REF DictNodeRep;
DictNodeRep: TYPE ~ RECORD [key: Any, val: Any, next: DictNode];
Hash: PROC [key: Key] RETURNS [CARDINAL] ~ {
HashProc: TYPE = PROC [key: Key] RETURNS [CARDINAL];
Munch: PROC [CARD32] RETURNS [CARD16] ~ TRUSTED MACHINE CODE { PrincOps.zXOR };
hash: CARD ← 0;
WITH v: x.val SELECT FROM
name => hash ← v.hash;
integer => hash ← LOOPHOLE[v.int];
string => RETURN [StringHash[StringFromAny[x]]];
real => --don't try: reals with different bit patterns may be equal!--
boolean => hash ← ORD[v.bool];
operator, array, file, dict, font => hash ← LOOPHOLE[x.ref];
ENDCASE => hash ← 42;
RETURN [Munch[hash]];
};
DictCreate: PUBLIC PROC [size: INT] RETURNS [Dict] ~ {
IF size<0 THEN ERROR Error[rangecheck]
ELSE IF size>NAT.LAST THEN ERROR Error[limitcheck]
ELSE {
impl: DictImpl ~ NEW[DictImplRep[size]];
ref: DictRef ~ NEW[DictRep ← [access: unlimited, impl: impl]];
impl.length ← 0;
RETURN[[executable: FALSE, ref: ref]];
};
};
DictLength: PUBLIC PROC [dict: Dict] RETURNS [INT] ~ {
impl: DictImpl ~ dict.ref.impl;
RETURN [impl.length];
};
DictMaxLength: PUBLIC PROC [dict: Dict] RETURNS [INT] ~ {
impl: DictImpl ~ dict.ref.impl;
RETURN [impl.maxLength];
};
DictFetch: PROC [dict: Dict, key: Any] RETURNS [found: BOOL, val: Any] ~ {
ERROR;
};
DictGet: PUBLIC PROC [dict: Dict, key: Any] RETURNS [Any] ~ {
found: BOOL; val: Any;
[found, val] ← DictFetch[dict, key];
IF found THEN RETURN [val]
ELSE ERROR Error[undefined];
};
DictPut: PUBLIC PROC [dict: Dict, key: Any, val: Any] ~ {
length: INT ~ DictLength[dict];
IF NOT length<dict.maxlength THEN ERROR Error[dictfull];
[] ← RefTab.Store[dict.table, key, val];
};
Known: PUBLIC PROC [dict: Dict, key: Any] RETURNS [BOOL] ~ {
RETURN [DictFetch[dict, key].found];
};
DictCopy: PUBLIC PROC [dict1, dict2: Dict] RETURNS [Dict] ~ {
ERROR;
};
DictForAll: PUBLIC PROC [dict: Dict, action: PROC [key: Any, val: Any]] ~ {
ERROR;
};
DStack: TYPE ~ REF DStackRep;
DStackRep: PUBLIC TYPE ~ RECORD [
count: ArrayIndex,
size: ArrayIndex,
array: DArrayRef
];
DArrayRef: TYPE ~ REF DArrayRep;
DArrayRep: TYPE ~ RECORD [SEQUENCE size: ArrayIndex OF Dict];
Begin: PUBLIC PROC [self: Root, dict: Dict] ~ {
dstack: DStack ~ self.dstack;
IF NOT dstack.count<dstack.size THEN ERROR Error[dictstackoverflow];
dstack.array[dstack.count] ← dict;
dstack.count ← dstack.count+1;
};
End: PUBLIC PROC [self: Root] ~ {
dstack: DStack ~ self.dstack;
IF NOT dstack.count>2 THEN ERROR Error[dictstackunderflow];
dstack.count ← dstack.count-1;
};
CurrentDict: PUBLIC PROC [self: Root] RETURNS [Dict] ~ {
dstack: DStack ~ self.dstack;
IF NOT dstack.count>0 THEN ERROR Bug; -- should always be >=2
RETURN [dstack.array[dstack.count-1]];
};
CountDictStack: PUBLIC PROC [self: Root] RETURNS [INT] ~ {
dstack: DStack ~ self.dstack;
RETURN [dstack.count];
};
DictStack: PUBLIC PROC [self: Root, array: Array] RETURNS [Array] ~ {
dstack: DStack ~ self.dstack;
subarray: Array ~ ArrayGetInterval[array, 0, dstack.count];
FOR i: ArrayIndex IN [0..dstack.count) DO
dict: Dict ~ dstack.array[i];
ArrayPut[subarray, i, AnyFromDict[dict]];
ENDLOOP;
RETURN [subarray];
};
Def: PUBLIC PROC [self: Root, key: Any, val: Any] ~ {
DictPut[CurrentDict[self], key, val];
};
nullDict: Dict ~ [val: [executable: FALSE, variant: dict[]], ref: NIL];
Where: PUBLIC PROC [self: Root, key: Any] RETURNS [found: BOOL, where: Dict] ~ {
dstack: DStack ~ self.dstack;
FOR i: ArrayIndex DECREASING IN [0..dstack.count) DO
dict: Dict ~ dstack.array[i];
IF DictFetch[dict, key].found THEN RETURN [TRUE, dict];
ENDLOOP;
RETURN [FALSE, nullDict];
};
Load: PUBLIC PROC [self: Root, key: Any] RETURNS [Any] ~ {
dstack: DStack ~ self.dstack;
FOR i: ArrayIndex DECREASING IN [0..dstack.count) DO
dict: Dict ~ dstack.array[i];
found: BOOL; val: Any;
[found, val] ← DictFetch[dict, key];
IF found THEN RETURN [val];
ENDLOOP;
ERROR Error[undefined];
};
Store: PUBLIC PROC [self: Root, key: Any, val: Any] ~ {
found: BOOL; dict: Dict;
[found, dict] ← Where[self, key];
IF NOT found THEN dict ← CurrentDict[self];
DictPut[dict, key, val];
};
Relational operators
Eq: PUBLIC PROC [x1, x2: Any] RETURNS [BOOL] ~ {
WITH v1: x1.val SELECT FROM
null => WITH v2: x2.val SELECT FROM
null => RETURN [TRUE];
ENDCASE;
integer => WITH v2: x2.val SELECT FROM
integer => RETURN [v1.int=v2.int];
real => RETURN [v1.int=v2.real];
ENDCASE;
real => WITH v2: x2.val SELECT FROM
integer => RETURN [v1.real=v2.int];
real => RETURN [v1.real=v2.real];
ENDCASE;
boolean => WITH v2: x2.val SELECT FROM
boolean => RETURN [v1.bool=v2.bool];
ENDCASE;
operator => WITH v2: x2.val SELECT FROM
operator => RETURN [x1.ref=x2.ref];
ENDCASE;
array => WITH v2: x2.val SELECT FROM
array => RETURN [x1.ref=x2.ref AND v1.start=v2.start AND v1.length=v2.length];
ENDCASE;
string => WITH v2: x2.val SELECT FROM
string => RETURN [StringEq[StringFromAny[x1], StringFromAny[x2]]];
name => RETURN [StringEq[StringFromAny[x1], NameFromAny[x2].ref.string]];
ENDCASE;
file => WITH v2: x2.val SELECT FROM
file => RETURN [x1.ref=x2.ref];
ENDCASE;
name => WITH v2: x2.val SELECT FROM
name => RETURN [x1.ref=x2.ref];
string => RETURN [StringEq[NameFromAny[x1].ref.string, StringFromAny[x2]]];
ENDCASE;
dict => WITH v2: x2.val SELECT FROM
dict => RETURN [x1.ref=x2.ref];
ENDCASE;
mark => WITH v2: x2.val SELECT FROM
mark => RETURN [TRUE];
ENDCASE;
font => WITH v2: x2.val SELECT FROM
font => RETURN [x1.ref=x2.ref];
ENDCASE;
ENDCASE;
RETURN [FALSE];
};
Compare: PUBLIC PROC [x1, x2: Any] RETURNS [Comparison] ~ {
WITH v1: x1.val SELECT FROM
integer => WITH v2: x2.val SELECT FROM
integer => RETURN [Basics.CompareInt[v1.int, v2.int]];
real => RETURN [Real.CompareREAL[v1.int, v2.real]];
ENDCASE;
real => WITH v2: x2.val SELECT FROM
integer => RETURN [Real.CompareREAL[v1.real, v2.int]];
real => RETURN [Real.CompareREAL[v1.real, v2.real]];
ENDCASE;
string => WITH v2: x2.val SELECT FROM
string => RETURN [StringCompare[StringFromAny[x1], StringFromAny[x2]]];
ENDCASE;
ENDCASE;
ERROR Error[typecheck];
};
Control operators
CurrentFile: PUBLIC SIGNAL RETURNS [File] ~ CODE;
Exit: PUBLIC SIGNAL ~ CODE;
Stop: PUBLIC ERROR ~ CODE;
Quit: PUBLIC ERROR ~ CODE;
NameFromErrorArray: TYPE ~ ARRAY ErrorCode OF Name;
nameFromError: REF NameFromErrorArray ~ NEW [NameFromErrorArray ← [
dictfull: NameFromRope["dictfull"],
dictstackoverflow: NameFromRope["dictstackoverflow"],
dictstackunderflow: NameFromRope["dictstackunderflow"],
execstackoverflow: NameFromRope["execstackoverflow"],
handleerror: NameFromRope["handleerror"],
interrupt: NameFromRope["interrupt"],
invalidaccess: NameFromRope["invalidaccess"],
invalidexit: NameFromRope["invalidexit"],
invalidfileaccess: NameFromRope["invalidfileaccess"],
invalidfont: NameFromRope["invalidfont"],
invalidrestore: NameFromRope["invalidrestore"],
ioerror: NameFromRope["ioerror"],
limitcheck: NameFromRope["limitcheck"],
nocurrentpoint: NameFromRope["nocurrentpoint"],
rangecheck: NameFromRope["rangecheck"],
stackoverflow: NameFromRope["stackoverflow"],
stackunderflow: NameFromRope["stackunderflow"],
syntaxerror: NameFromRope["syntaxerror"],
timeout: NameFromRope["timeout"],
typecheck: NameFromRope["typecheck"],
undefined: NameFromRope["undefined"],
undefinedfilename: NameFromRope["undefinedfilename"],
undefinedresult: NameFromRope["undefinedresult"],
unimplemented: NameFromRope["unimplemented"],
unmatchedmark: NameFromRope["unmatchedmark"],
unregistered: NameFromRope["unregistered"],
VMerror: NameFromRope["VMerror"]
]];
ExecuteError: PROC [self: Root, error: ErrorCode] ~ {
errorName: Name ~ nameFromError[error];
errorHandler: Any ~ DictGet[self.errordict, AnyFromName[errorName]];
Execute[self, errorHandler];
};
ExecuteToken: PROC [self: Root, token: Any] ~ --INLINE-- {
IF token.val.executable AND token.val.type#array
THEN Execute[self, token]
ELSE PushAny[self, token]; -- push literal or defer procedure
};
ExecuteArray: PROC [self: Root, array: Array] ~ {
action: PROC [x: Any] ~ { ExecuteToken[self, x] };
ArrayForAll[array, action];
};
ExecuteString: PROC [self: Root, string: String] ~ {
post: String ← string;
DO found: BOOL; token: Any;
[found, token, post] ← StringToken[post];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
ExecuteFile: PUBLIC PROC [self: Root, file: File] ~ {
ENABLE CurrentFile => RESUME [file];
DO found: BOOL; token: Any;
[found, token] ← FileToken[file];
IF found THEN ExecuteToken[self, token] ELSE EXIT;
ENDLOOP;
};
Execute: PUBLIC PROC [self: Root, x: Any] ~ {
initialCount: INT ~ Count[self];
InnerExecute[self, x !
Error => {
RestoreCount[self, initialCount];
PushAny[self, x]; -- ***** what if stackoverflow here?
ExecuteError[self, error];
};
];
};
InnerExecute: PROC [self: Root, x: Any] ~ {
IF XCheck[x] THEN SELECT Type[x] FROM
name => Execute[self, Load[self, x]];
operator => {
operator: Operator ~ OperatorFromAny[x];
operator.ref.proc[self];
};
array => {
array: Array ~ ArrayFromAny[x];
IF ArrayAccess[array]<executeOnly THEN ERROR Error[invalidaccess];
ExecuteArray[self, array];
};
string => {
string: String ~ StringFromAny[x];
IF StringAccess[string]<executeOnly THEN ERROR Error[invalidaccess];
ExecuteString[self, string];
};
file => {
file: File ~ FileFromAny[x];
IF FileAccess[file]<executeOnly THEN ERROR Error[invalidaccess];
ExecuteFile[self, file !
CurrentFile => RESUME [file];
];
};
null => NULL;
ENDCASE => PushAny[self, x] -- other types are always literal
ELSE PushAny[self, x]; -- literal
};
Main: PROC [self: Root] ~ {
action[self !
CurrentFile => RETURN [nullFile];
Exit => RESUME;
Stop => CONTINUE;
Quit => CONTINUE;
];
};
Conversion
CharFromInt: PUBLIC PROC [int: INT] RETURNS [CHAR] ~ {
CharRange: TYPE ~ [0..CHAR.LAST.ORD];
IF int IN CharRange THEN RETURN [VAL[CharRange[int]]];
ERROR Error[rangecheck];
};
IntFromReal: PUBLIC PROC [real: REAL] RETURNS [INT] ~ {
RETURN [Real.Fix[real ! Real.RealException => CONTINUE]];
ERROR Error[rangecheck];
};
IntFromString: PUBLIC PROC [string: String] RETURNS [INT] ~ {
found: BOOL; token: Any; post: String;
[found, token, post] ← StringToken[string];
IF NOT found THEN ERROR Error[syntaxerror];
IF StringToken[post].found THEN ERROR Error[syntaxerror];
SELECT Type[token] FROM
integer => RETURN [IntFromAny[token]];
real => RETURN [IntFromReal[RealFromAny[token]]];
ENDCASE => ERROR Error[typecheck];
};
RealFromString: PUBLIC PROC [string: String] RETURNS [REAL] ~ {
found: BOOL; token: Any; post: String;
[found, token, post] ← StringToken[string];
IF NOT found THEN ERROR Error[syntaxerror];
IF StringToken[post].found THEN ERROR Error[syntaxerror];
SELECT Type[token] FROM
integer => RETURN [RealFromInt[IntFromAny[token]]];
real => RETURN [RealFromAny[token]];
ENDCASE => ERROR Error[typecheck];
};
StringFromInt: PUBLIC PROC [int, radix: INT, string: String] RETURNS [substring: String] ~ {
negative: BOOL ~ (int<0);
val: CARD ← ABS[int];
ostack: ARRAY [0..32] OF CHAR;
length: NAT ← 0;
base: NAT ← 0;
IF radix IN [2..36] THEN base ← radix ELSE ERROR Error[rangecheck];
DO
digit: NAT ~ val MOD base;
ostack[length] ← IF digit<10 THEN '0+digit ELSE 'A+(digit-10);
length ← length + 1;
IF val<base THEN EXIT ELSE val ← val/base;
ENDLOOP;
IF negative THEN { ostack[length] ← '-; length ← length + 1 };
substring ← StringGetInterval[string, 0, length];
FOR index: INT IN[0..StringLength[substring]) DO
StringPut[substring, index, ostack[length ← length-1]];
ENDLOOP;
IF length#0 THEN ERROR Bug;
};
StringFromReal: PUBLIC PROC [real: REAL, string: String] RETURNS [substring: String] ~ {
scratch: REF TEXT ~ RefText.ObtainScratch[100];
text: REF TEXT ~ Convert.AppendReal[to: scratch, from: real];
substring ← StringFromRefText[text, string];
RefText.ReleaseScratch[scratch];
};
StringFromRope: PUBLIC PROC [rope: ROPE, string: String] RETURNS [substring: String] ~ {
length: INT ~ Rope.Size[rope];
substring ← StringGetInterval[string, 0, length];
FOR index: INT IN [0..length) DO
StringPut[substring, index, Rope.Fetch[rope, index]];
ENDLOOP;
};
StringFromRefText: PUBLIC PROC [text: REF READONLY TEXT, string: String]
RETURNS [substring: String] ~ {
length: NAT ~ text.length;
substring ← StringGetInterval[string, 0, length];
FOR index: NAT IN [0..length) DO
StringPut[substring, index, text[index]];
ENDLOOP;
};
END.