IPTypeImpl.mesa
Copyright © 1984 Xerox Corporation. All rights reserved.
Doug Wyatt, November 13, 1984 6:01:38 pm PST
DIRECTORY
Atom USING [MakeAtomFromRefText],
IO USING [PutFR, int, real, rope, STREAM],
IPInterpreter,
Real USING [Fix, RealException],
RefText USING [AppendRope, ObtainScratch, ReleaseScratch],
Rope USING [ROPE, Size, Substr];
IPTypeImpl: CEDAR PROGRAM
IMPORTS Atom, IO, IPInterpreter, Real, RefText, Rope
EXPORTS IPInterpreter
= BEGIN OPEN IPInterpreter;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
NumberFromInteger:
PUBLIC
PROC[i: Integer]
RETURNS[Number] ~ {
RETURN[NEW[NumberRep ← [int[CheckInteger[i]]]]];
};
NumberFromInt:
PUBLIC
PROC[i:
INT]
RETURNS[Number] ~ {
RETURN[NEW[NumberRep ← [int[i]]]];
};
NumberFromReal:
PUBLIC
PROC[r:
REAL]
RETURNS[Number] ~ {
RETURN[NEW[NumberRep ← [real[r]]]];
};
zero: Number ~ NumberFromInteger[0];
NonNIL:
PROC[x: Any]
RETURNS[Any] ~ {
IF x=
NIL
THEN {
MasterWarning[$nullValue, "Used initial zero value."];
x ← zero;
};
IF x#NIL THEN RETURN[x] ELSE ERROR;
};
IntegerFromInt:
PUBLIC
PROC[x:
INT]
RETURNS[Integer] ~ {
IF x IN[0..maxInteger] THEN RETURN[x];
MasterError[$notInteger, IO.PutFR["%g is not an Integer.", IO.int[x]]];
ERROR Error;
};
Fix:
PROC[r:
REAL]
RETURNS[
INT] ~ {
RETURN[Real.Fix[r]] };
Wrap a procedure call around Real.Fix so we can catch RealException
IntegerFromReal:
PUBLIC
PROC[x:
REAL]
RETURNS[Integer] ~ {
i: INT ← 0; ok: BOOL ← TRUE;
i ← Fix[x ! Real.RealException => { ok ← FALSE; CONTINUE }];
IF ok AND i=x AND IsInteger[i] THEN RETURN[i];
MasterError[$notInteger, IO.PutFR["%g is not an Integer.", IO.real[x]]];
ERROR Error;
};
IntFromReal:
PUBLIC
PROC[x:
REAL]
RETURNS[
INT] ~ {
i: INT ← 0; ok: BOOL ← TRUE;
i ← Fix[x ! Real.RealException => { ok ← FALSE; CONTINUE }];
IF ok AND i=x THEN RETURN[i];
MasterError[$notInteger, IO.PutFR["%g is not an INT.", IO.real[x]]];
ERROR Error;
};
RopeFromTypeArray: TYPE ~ ARRAY TypeCode OF ROPE;
ropeFromType: REF RopeFromTypeArray ~ InitRopeFromType[];
InitRopeFromType:
PROC
RETURNS[
REF RopeFromTypeArray] ~ {
ropeFromType: REF RopeFromTypeArray ~ NEW[RopeFromTypeArray ← ALL[NIL]];
ropeFromType[null] ← "null";
ropeFromType[number] ← "number";
ropeFromType[identifier] ← "identifier";
ropeFromType[vector] ← "vector";
ropeFromType[operator] ← "operator";
ropeFromType[transformation] ← "transformation";
ropeFromType[pixelArray] ← "pixelArray";
ropeFromType[color] ← "color";
ropeFromType[trajectory] ← "trajectory";
ropeFromType[outline] ← "outline";
ropeFromType[other] ← "other";
FOR t: TypeCode
IN TypeCode
DO
IF ropeFromType[t]=NIL THEN ropeFromType[t] ← IO.PutFR["[%g]", IO.int[ORD[t]]];
ENDLOOP;
RETURN[ropeFromType];
};
WrongType:
PROC[x: Any, expected: TypeCode] ~ {
is: TypeCode ~ Type[x];
MasterError[$wrongType,
IO.PutFR["Value has wrong type (is %g, expected %g).",
IO.rope[ropeFromType[is]], IO.rope[ropeFromType[expected]]]];
};
IntegerFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Integer] ~ {
WITH x
SELECT
FROM
x: Number =>
WITH x: x
SELECT
FROM
int => RETURN[IntegerFromInt[x.int]];
real => RETURN[IntegerFromReal[x.real]];
ENDCASE;
ENDCASE;
IF x=NIL THEN RETURN[IntegerFromAny[NonNIL[x]]];
WrongType[x, $number]; ERROR Error;
};
IntFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Integer] ~ {
WITH x
SELECT
FROM
x: Number =>
WITH x: x
SELECT
FROM
int => RETURN[x.int];
real => RETURN[IntFromReal[x.real]];
ENDCASE;
ENDCASE;
IF x=NIL THEN RETURN[IntFromAny[NonNIL[x]]];
WrongType[x, $number]; ERROR Error;
};
RealFromAny:
PUBLIC
PROC[x: Any]
RETURNS[
REAL] ~ {
WITH x
SELECT
FROM
x: Number =>
WITH x: x
SELECT
FROM
int => RETURN[REAL[x.int]];
real => RETURN[x.real];
ENDCASE;
ENDCASE;
IF x=NIL THEN RETURN[RealFromAny[NonNIL[x]]];
WrongType[x, $number]; ERROR Error;
};
NumberFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Number] ~ {
WITH x SELECT FROM x: Number => RETURN[x]; ENDCASE;
IF x=NIL THEN RETURN[NumberFromAny[NonNIL[x]]];
WrongType[x, $number]; ERROR Error;
};
IdentifierFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Identifier] ~ {
WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE;
WrongType[x, $identifier]; ERROR Error;
};
VectorFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Vector] ~ {
WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE;
WrongType[x, $vector]; ERROR Error;
};
OperatorFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Operator] ~ {
WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE;
WrongType[x, $operator]; ERROR Error;
};
TransformationFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Transformation] ~ {
WITH x SELECT FROM x: Transformation => RETURN[x]; ENDCASE;
WrongType[x, $transformation]; ERROR Error;
};
PixelArrayFromAny:
PUBLIC
PROC[x: Any]
RETURNS[PixelArray] ~ {
WITH x SELECT FROM x: PixelArray => RETURN[x]; ENDCASE;
WrongType[x, $pixelArray]; ERROR Error;
};
ColorFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Color] ~ {
WITH x SELECT FROM x: Color => RETURN[x]; ENDCASE;
WrongType[x, $color]; ERROR Error;
};
TrajectoryFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Trajectory] ~ {
WITH x SELECT FROM x: Trajectory => RETURN[x]; ENDCASE;
WrongType[x, $trajectory]; ERROR Error;
};
OutlineFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Outline] ~ {
WITH x SELECT FROM x: Outline => RETURN[x]; ENDCASE;
WrongType[x, $outline]; ERROR Error;
};
Eq:
PUBLIC
PROC[a, b: Any]
RETURNS[
BOOL] ~ {
WITH a
SELECT
FROM
a: Number =>
WITH b
SELECT
FROM
b: Number =>
WITH a: a
SELECT
FROM
int =>
WITH b: b
SELECT
FROM
int => RETURN[a.int=b.int];
real => RETURN[a.int=b.real];
ENDCASE;
real =>
WITH b: b
SELECT
FROM
int => RETURN[a.real=b.int];
real => RETURN[a.real=b.real];
ENDCASE;
ENDCASE;
ENDCASE;
a: Identifier =>
WITH b
SELECT
FROM
b: Identifier => RETURN[a.atom=b.atom];
ENDCASE;
ENDCASE;
IF a=NIL OR b=NIL THEN RETURN[Eq[NonNIL[a], NonNIL[b]]]
ELSE RETURN[FALSE];
};
EqVector:
PROC[a, b: Vector]
RETURNS[
BOOL] ~ {
aShape: VectorShape ~ Shape[a];
bShape: VectorShape ~ Shape[b];
IF aShape.l#bShape.l OR aShape.n#bShape.n THEN RETURN[FALSE];
FOR i: Integer
IN[aShape.l..aShape.l+aShape.n)
DO
IF NOT Eq[Get[a, i], Get[b, i]] THEN RETURN[FALSE];
ENDLOOP;
RETURN[TRUE];
};
EqName:
PUBLIC
PROC[a, b: Any]
RETURNS[
BOOL] ~ {
IF Eq[a, b] THEN RETURN[TRUE];
WITH a
SELECT
FROM
a: Vector =>
WITH b
SELECT
FROM
b: Vector => RETURN[EqVector[a, b]];
ENDCASE;
ENDCASE;
RETURN[FALSE];
};
Type:
PUBLIC
PROC[a: Any]
RETURNS[TypeCode] ~ {
WITH a
SELECT
FROM
x: Number => RETURN[$number];
x: Identifier => RETURN[$identifier];
x: Vector => RETURN[$vector];
x: Operator => RETURN[$operator];
x: Transformation => RETURN[$transformation];
x: PixelArray => RETURN[$pixelArray];
x: Color => RETURN[$color];
x: Trajectory => RETURN[$trajectory];
x: Outline => RETURN[$outline];
ENDCASE;
IF a=NIL THEN RETURN[Type[NonNIL[a]]]
ELSE RETURN[$other];
};
maxIdLength: NAT ~ 1000;
IdentifierFromRope:
PUBLIC
PROC[rope:
ROPE]
RETURNS[Identifier] ~ {
size: INT ~ rope.Size[];
IF size>maxIdLength
THEN {
MasterError[$limitExceeded,
IO.PutFR["\"%g...\" is too long for an Identifier.",
IO.rope[rope.Substr[len: 20]]]];
ERROR Error;
}
ELSE {
atom: ATOM ← NIL;
illegal: BOOL ← FALSE;
scratch: REF TEXT ~ RefText.ObtainScratch[size];
{
ENABLE
UNWIND => RefText.ReleaseScratch[scratch];
text: REF TEXT ~ RefText.AppendRope[to: scratch, from: rope];
FOR i:
NAT
IN[0..text.length)
DO
SELECT text[i]
FROM
IN['a..'z] => NULL;
IN['A..'Z] => text[i] ← text[i]+('a-'A); -- map upper case to lower case
IN['0..'9], '- => IF i=0 THEN illegal ← TRUE;
ENDCASE => { illegal ← TRUE; text[i] ← '-; }; -- map illegal chars to "-"
ENDLOOP;
atom ← Atom.MakeAtomFromRefText[text];
};
RefText.ReleaseScratch[scratch];
IF illegal
THEN {
MasterWarning[$illegalIdentifier,
IO.PutFR["\"%g\" is an illegal Identifier.",
IO.rope[rope]]];
};
RETURN[NEW[IdentifierRep ← [atom: atom, rope: rope]]];
};
};
RopeFromIdentifier:
PUBLIC
PROC[id: Identifier]
RETURNS[rope:
ROPE] ~ {
RETURN[id.rope];
};
NameFromVector: PUBLIC PROC[v: Vector] RETURNS[name: Name ← NIL] ~ {
shape: VectorShape ~ Shape[v];
FOR i: Integer DECREASING IN[shape.l .. shape.l+shape.n) DO
name ← CONS[IdentifierFromAny[Get[v, i]], name];
ENDLOOP;
};
VectorFromName: PUBLIC PROC[name: Name] RETURNS[Vector] ~ {
ERROR;
};
END.