IPTypesImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Doug Wyatt, May 30, 1986 4:51:55 pm PDT
DIRECTORY
IPInterpreter,
Real USING [Fix],
Rope USING [Equal];
IPTypesImpl: CEDAR PROGRAM
IMPORTS IPInterpreter, Real, Rope
EXPORTS IPInterpreter
= BEGIN OPEN IPInterpreter;
zero: Number ~ NEW[NumberRep ← [zero[]]];
CardinalFromReal:
PUBLIC
PROC [real:
REAL]
RETURNS [Cardinal] ~ {
int: INT ← 0;
IF real IN[0..maxCardinal] THEN int ← Real.Fix[real];
IF int=real THEN RETURN[BoundsCheckCardinal[int]];
MasterError[$notCardinal, "Number is not a Cardinal"];
RETURN[0];
};
CardinalFromNum:
PUBLIC
PROC [n: NumberRep]
RETURNS [Cardinal] ~ {
WITH n: n
SELECT
FROM
zero => { MasterWarning[$nullValue, "Used an uninitialized value"]; RETURN[0] };
int => IF n.int IN[0..maxCardinal] THEN RETURN[n.int];
real => RETURN[CardinalFromReal[n.real]];
rational => RETURN[CardinalFromReal[REAL[n.n]/REAL[n.d]]];
ENDCASE => ERROR Bug;
MasterError[$notCardinal, "Number is not a Cardinal"];
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;
};
CardinalFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Cardinal] ~ {
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..maxCardinal] THEN RETURN[n.int];
ENDCASE;
RETURN[CardinalFromNum[n]];
};
ENDCASE;
MasterError[$wrongType, "Wrong type (expected Cardinal)"];
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];
};
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[Rope.Equal[s1: a, s2: b, case: FALSE]];
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: Cardinal
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];
x: Font => RETURN[font];
x: Clipper => RETURN[clipper];
ENDCASE;
RETURN[TypeCode.LAST];
};
END.