IPConvertImpl.mesa
Last edited by:
Doug Wyatt, March 3, 1984 2:39:53 pm PST
DIRECTORY
Atom USING [GetPName, MakeAtomFromRefText],
IO USING [PutFR, int, real, rope, STREAM],
IP USING [Any, CheckInteger, Color, Get, Identifier, Integer, MasterError, MasterWarning, maxInteger, Number, NumberRep, Operator, Outline, PixelArray, RealFromInt, RealFromInteger, Shape, Trajectory, Transformation, TypeCode, Vector, VectorShape],
Real USING [Fix, RealException],
RefText USING [AppendChar, ObtainScratch, ReleaseScratch],
Rope USING [Concat, Fetch, ROPE, Size, Substr];
IPConvertImpl: CEDAR PROGRAM
IMPORTS Atom, IO, IP, Real, RefText, Rope
EXPORTS IP
= BEGIN OPEN IP;
ROPE: TYPE ~ Rope.ROPE;
STREAM: TYPE ~ IO.STREAM;
WrongType:
PROC[expectedType: TypeCode] ~ {
rope: ROPE ~ RopeFromType[expectedType];
MasterError[$wrongType, IO.PutFR["Value has wrong type (%g expected).", IO.rope[rope]]];
};
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]]];
RETURN[0]; -- never actually returns
};
IntegerFromReal:
PUBLIC
PROC[x:
REAL]
RETURNS[Integer] ~ {
Fix:
PROC[r:
REAL]
RETURNS[
INT] ~ {
RETURN[Real.Fix[r]] };
Wrap a procedure call around Real.Fix so we can catch RealException
i: INT ← 0; ok: BOOL ← TRUE;
i ← Fix[x ! Real.RealException => { ok ← FALSE; CONTINUE }];
IF ok AND i=x AND i IN[0..maxInteger] THEN RETURN[i];
MasterError[$notInteger, IO.PutFR["%g is not an Integer.", IO.real[x]]];
RETURN[0]; -- never actually returns
};
NullWarning:
PROC ~ {
MasterWarning[$nullValue, "Used initial zero value."];
};
IntegerFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Integer] ~ {
WITH x SELECT FROM x: Number => RETURN[IntegerFromReal[x.value]]; ENDCASE;
IF x=NIL THEN NullWarning[] ELSE WrongType[$Number]; RETURN[0];
};
RealFromAny:
PUBLIC
PROC[x: Any]
RETURNS[
REAL] ~ {
WITH x SELECT FROM x: Number => RETURN[x.value]; ENDCASE;
IF x=NIL THEN NullWarning[] ELSE WrongType[$Number]; RETURN[0];
};
AnyFromInteger:
PUBLIC
PROC[i: Integer]
RETURNS[Any] ~ {
RETURN[NEW[NumberRep ← [value: RealFromInteger[CheckInteger[i]]]]];
};
AnyFromInt:
PUBLIC
PROC[i:
INT]
RETURNS[Any] ~ {
RETURN[NEW[NumberRep ← [value: RealFromInt[i]]]];
};
AnyFromReal:
PUBLIC
PROC[r:
REAL]
RETURNS[Any] ~ {
RETURN[NEW[NumberRep ← [value: r]]];
};
PrivateCheckInteger:
PUBLIC
PROC[x: Integer]
RETURNS[Integer] ~ {
IF x IN[0..maxInteger] THEN RETURN[x];
MasterError[$bug, IO.PutFR["%g is not a valid Integer.", IO.int[x]]];
RETURN[0]; -- never actually returns
};
zero: Any ~ AnyFromInteger[0];
PrivateCheckAny:
PUBLIC
PROC[x: Any]
RETURNS[Any] ~ {
IF x#NIL THEN RETURN[x];
NullWarning[]; RETURN[zero];
};
IdentifierFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Identifier] ~ {
WITH x SELECT FROM x: Identifier => RETURN[x]; ENDCASE;
WrongType[$Identifier]; RETURN[NIL];
};
VectorFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Vector] ~ {
WITH x SELECT FROM x: Vector => RETURN[x]; ENDCASE;
WrongType[$Vector]; RETURN[NIL];
};
OperatorFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Operator] ~ {
WITH x SELECT FROM x: Operator => RETURN[x]; ENDCASE;
WrongType[$Operator]; RETURN[NIL];
};
TransformationFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Transformation] ~ {
WITH x SELECT FROM x: Transformation => RETURN[x]; ENDCASE;
WrongType[$Transformation]; RETURN[NIL];
};
PixelArrayFromAny:
PUBLIC
PROC[x: Any]
RETURNS[PixelArray] ~ {
WITH x SELECT FROM x: PixelArray => RETURN[x]; ENDCASE;
WrongType[$PixelArray]; RETURN[NIL];
};
ColorFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Color] ~ {
WITH x SELECT FROM x: Color => RETURN[x]; ENDCASE;
WrongType[$Color]; RETURN[NIL];
};
TrajectoryFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Trajectory] ~ {
WITH x SELECT FROM x: Trajectory => RETURN[x]; ENDCASE;
WrongType[$Trajectory]; RETURN[NIL];
};
OutlineFromAny:
PUBLIC
PROC[x: Any]
RETURNS[Outline] ~ {
WITH x SELECT FROM x: Outline => RETURN[x]; ENDCASE;
WrongType[$Outline]; RETURN[NIL];
};
NonDefaultingROPE: TYPE ~ ROPE ←
RopeFromTypeTable: TYPE ~ ARRAY TypeCode OF NonDefaultingROPE;
ropeFromType: REF RopeFromTypeTable ~ NEW[RopeFromTypeTable ← [Null: "Null", Number: "Number", Identifier: "Identifier", Vector: "Vector", Operator: "Operator", Transformation: "Transformation", PixelArray: "PixelArray", Color: "Color", Trajectory: "Trajectory", Outline: "Outline", Other: "Other"]];
RopeFromType:
PUBLIC
PROC[type: TypeCode]
RETURNS[rope:
ROPE] ~ {
RETURN[ropeFromType[type]];
};
IllegalIdentifier:
PROC[id:
ROPE] ~ {
MasterWarning[$illegalIdentifier,
IO.PutFR["\"%g\" is an illegal Identifier.", IO.rope[id]]];
};
IdentifierTooLong:
PROC[id:
ROPE] ~ {
MasterError[$limitExceeded,
IO.PutFR["\"%g...\" is too long for an Identifier.", IO.rope[id.Substr[len: 20]]]];
};
IdentifierFromRope:
PUBLIC
PROC[rope:
ROPE]
RETURNS[id: Identifier] ~ {
size: INT ~ rope.Size[];
IF size<=
NAT.
LAST
THEN {
len: NAT ~ size;
scratch: REF TEXT ~ RefText.ObtainScratch[len];
{
ENABLE
UNWIND => RefText.ReleaseScratch[scratch];
text: REF TEXT ← scratch;
FOR i:
NAT
IN[0..len)
DO
char: CHAR ← rope.Fetch[i];
SELECT char
FROM
IN['a..'z] => NULL;
IN['A..'Z] => char ← char+('a-'A); -- map upper case to lower case
IN['0..'9], '- => IF i=0 THEN IllegalIdentifier[rope];
ENDCASE => IllegalIdentifier[rope];
text ← RefText.AppendChar[text, char];
ENDLOOP;
id ← Atom.MakeAtomFromRefText[text];
};
RefText.ReleaseScratch[scratch];
}
ELSE IdentifierTooLong[rope];
};
RopeFromIdentifier:
PUBLIC
PROC[id: Identifier]
RETURNS[rope:
ROPE] ~ {
RETURN[Atom.GetPName[id]];
};
NameFromVector:
PUBLIC
PROC[v: Vector]
RETURNS[rope:
ROPE ←
NIL] ~ {
shape: VectorShape ~ Shape[v];
FOR i: Integer
IN[shape.l .. shape.l+shape.n)
DO
IF rope#NIL THEN rope ← rope.Concat["/"];
rope ← rope.Concat[RopeFromIdentifier[IdentifierFromAny[Get[v, i]]]];
ENDLOOP;
};
END.