PSTypeImpl.mesa
Copyright Ó 1986, 1987 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 15, 1987 1:33:00 pm PDT
PostScript implementation: type and attribute operations.
DIRECTORY
PS,
Real;
PSTypeImpl: CEDAR PROGRAM
IMPORTS PS, Real
EXPORTS PS
~ BEGIN OPEN PS;
Type and Attribute operations
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];
};
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];
};
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];
};
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
]];
};
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]];
};
Comparison 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^]];
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^, 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];
};
Conversion
CharFromInt: PUBLIC PROC [int: INT] RETURNS [CHAR] ~ {
CharRange: TYPE ~ CARDINAL[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];
stack: 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;
stack[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 { stack[length] ← '-; length ← length + 1 };
substring ← StringGetInterval[string, 0, length];
FOR index: INT IN[0..StringLength[substring]) DO
StringPut[substring, index, stack[length ← length-1]];
ENDLOOP;
IF length#0 THEN ERROR Bug;
};
StringFromReal: PUBLIC PROC [real: REAL, string: String] RETURNS [String] ~ {
};
StringFromRope: PUBLIC PROC [rope: ROPE, string: String] RETURNS [String] ~ {
};
END.