IPTypesImpl.mesa
Copyright © 1984, 1985 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 30, 1985 5:16:08 pm PDT
DIRECTORY
IPInterpreter USING [Any, BoundsCheckInteger, Bug, Color, Get, Identifier, Integer, MasterError, MasterWarning, maxInteger, Number, NumberRep, Operator, Outline, PixelArray, Shape, Trajectory, Transformation, TypeCode, Vector, VectorShape],
Real USING [Fix];
IPTypesImpl: CEDAR PROGRAM
IMPORTS IPInterpreter, Real
EXPORTS IPInterpreter
= BEGIN OPEN IPInterpreter;
zero: Number ~ NEW[NumberRep ← [zero[]]];
IntegerFromReal: PUBLIC PROC [real: REAL] RETURNS [Integer] ~ {
int: INT ← 0;
IF real IN[0..maxInteger] THEN int ← Real.Fix[real];
IF int=real THEN RETURN[BoundsCheckInteger[int]];
MasterError[$notInteger, "Number is not an Integer"];
RETURN[0];
};
IntegerFromNum: PUBLIC PROC [n: NumberRep] RETURNS [Integer] ~ {
WITH n: n SELECT FROM
zero => { MasterWarning[$nullValue, "Used an uninitialized value"]; RETURN[0] };
int => IF n.int IN[0..maxInteger] THEN RETURN[n.int];
real => RETURN[IntegerFromReal[n.real]];
rational => RETURN[IntegerFromReal[REAL[n.n]/REAL[n.d]]];
ENDCASE => ERROR Bug;
MasterError[$notInteger, "Number is not an Integer"];
RETURN[0];
};
RealFromNum: PUBLIC PROC [n: NumberRep] RETURNS [REAL] ~ {
WITH n: n SELECT FROM
zero => { MasterWarning[$nullValue, "Used an uninitialized value"]; RETURN[0] };
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
rational => RETURN[REAL[n.n]/REAL[n.d]];
ENDCASE => ERROR Bug;
};
IntegerFromAny: PUBLIC PROC [x: Any] RETURNS [Integer] ~ {
IF x=NIL THEN x ← zero;
WITH x SELECT FROM
x: Number => {
n: NumberRep ~ x^;
WITH n: n SELECT FROM
int => IF n.int IN[0..maxInteger] THEN RETURN[n.int];
ENDCASE;
RETURN[IntegerFromNum[n]];
};
ENDCASE;
MasterError[$wrongType, "Wrong type (expected Integer)"];
RETURN[0];
};
RealFromAny: PUBLIC PROC [x: Any] RETURNS [REAL] ~ {
IF x=NIL THEN x ← zero;
WITH x SELECT FROM
x: Number => {
n: NumberRep ~ x^;
WITH n: n SELECT FROM
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
ENDCASE;
RETURN[RealFromNum[n]];
};
ENDCASE;
MasterError[$wrongType, "Wrong type (expected Number)"];
RETURN[0];
};
NumberFromAny: PUBLIC PROC [x: Any] RETURNS [Number] ~ {
IF x=NIL THEN x ← zero;
WITH x SELECT FROM x: Number => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Number)"];
RETURN[NIL];
};
IdentifierFromAny: PUBLIC PROC [x: Any] RETURNS [Identifier] ~ {
WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Identifier)"];
RETURN[NIL];
};
VectorFromAny: PUBLIC PROC [x: Any] RETURNS [Vector] ~ {
WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Vector)"];
RETURN[NIL];
};
OperatorFromAny: PUBLIC PROC [x: Any] RETURNS [Operator] ~ {
WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Operator)"];
RETURN[NIL];
};
TransformationFromAny: PUBLIC PROC [x: Any] RETURNS [Transformation] ~ {
WITH x SELECT FROM x: Transformation => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Transformation)"];
RETURN[NIL];
};
PixelArrayFromAny: PUBLIC PROC [x: Any] RETURNS [PixelArray] ~ {
WITH x SELECT FROM x: PixelArray => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected PixelArray)"];
RETURN[NIL];
};
ColorFromAny: PUBLIC PROC [x: Any] RETURNS [Color] ~ {
WITH x SELECT FROM x: Color => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Color)"];
RETURN[NIL];
};
TrajectoryFromAny: PUBLIC PROC [x: Any] RETURNS [Trajectory] ~ {
WITH x SELECT FROM x: Trajectory => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Trajectory)"];
RETURN[NIL];
};
OutlineFromAny: PUBLIC PROC [x: Any] RETURNS [Outline] ~ {
WITH x SELECT FROM x: Outline => RETURN[x]; ENDCASE;
MasterError[$wrongType, "Wrong type (expected Outline)"];
RETURN[NIL];
};
Eq: PUBLIC PROC [a, b: Any] RETURNS [BOOL] ~ {
IF a=NIL THEN a ← zero;
IF b=NIL THEN b ← zero;
IF a=b THEN RETURN[TRUE];
WITH a SELECT FROM
a: Number => WITH b SELECT FROM
b: Number => RETURN[RealFromNum[a^]=RealFromNum[b^]];
ENDCASE;
a: Identifier => WITH b SELECT FROM
b: Identifier => RETURN[a.atom=b.atom];
ENDCASE;
ENDCASE;
RETURN[FALSE];
};
EqVector: PROC [a, b: Vector] RETURNS [BOOL] ~ {
shape: VectorShape ~ Shape[a];
bShape: VectorShape ~ Shape[b];
IF NOT bShape.lowerBound=shape.lowerBound THEN RETURN[FALSE];
IF NOT bShape.size=shape.size THEN RETURN[FALSE];
FOR i: Integer IN[shape.lowerBound..shape.lowerBound+shape.size) 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] ~ {
IF a=NIL THEN a ← zero;
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;
RETURN[TypeCode.LAST];
};
END.