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.