TJaMTypeImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Maureen Stone February 6, 1984 5:07:45 pm PST
Doug Wyatt, March 25, 1985 4:43:29 pm PST
DIRECTORY
Atom USING [GetPName, MakeAtom],
Convert USING [IntFromRope, RealFromRope],
TJaM,
Real USING [Round],
Rope USING [Equal, Length];
TJaMTypeImpl: CEDAR PROGRAM
IMPORTS Atom, Convert, TJaM, Rope, Real
EXPORTS TJaM
~ BEGIN OPEN TJaM;
firstInt: REAL ← INT.FIRST;
lastInt: REAL ← INT.LAST;
IntFromReal:
PUBLIC
PROC [real:
REAL]
RETURNS [
INT] ~ {
int: INT ← 0;
IF real IN[firstInt..lastInt] THEN int ← Real.Round[real];
IF int#real THEN ProduceError[wrongType];
RETURN[int];
};
IntFromNum:
PUBLIC
PROC [n: NumberRep]
RETURNS [
INT] ~ {
WITH n: n
SELECT
FROM
int => RETURN[n.int];
real => RETURN[IntFromReal[n.real]];
ENDCASE => ERROR;
};
RealFromNum:
PUBLIC
PROC [n: NumberRep]
RETURNS [
REAL] ~ {
WITH n: n
SELECT
FROM
int => RETURN[REAL[n.int]];
real => RETURN[n.real];
ENDCASE => ERROR;
};
IntFromAny:
PUBLIC
PROC [x:
REF]
RETURNS [
INT] ~ {
WITH x
SELECT
FROM
x: Number => {
n: NumberRep ~ x^;
WITH n: n
SELECT
FROM
int => RETURN[n.int];
ENDCASE;
RETURN[IntFromNum[n]];
};
ENDCASE;
ProduceError[wrongType]; RETURN[0];
};
RealFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
REAL] ~ {
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;
ProduceError[wrongType]; RETURN[0];
};
NumberFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Number] ~ {
WITH x
SELECT
FROM
x: Number => RETURN[x];
x: Ob => RETURN[NumberFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
AtomFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
ATOM] ~ {
WITH x
SELECT
FROM
x: ATOM => RETURN[x];
x: Ob => RETURN[AtomFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
RopeFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
ROPE] ~ {
WITH x
SELECT
FROM
x: ROPE => RETURN[x];
x: Ob => RETURN[RopeFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
StreamFromAny:
PUBLIC
PROC [x: Any]
RETURNS [
STREAM] ~ {
WITH x
SELECT
FROM
x: STREAM => RETURN[x];
x: Ob => RETURN[StreamFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
CmdFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Cmd] ~ {
WITH x
SELECT
FROM
x: Cmd => RETURN[x];
x: Ob => RETURN[CmdFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
ArrayFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Array] ~ {
WITH x
SELECT
FROM
x: Array => RETURN[x];
x: Ob => RETURN[ArrayFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
DictFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Dict] ~ {
WITH x
SELECT
FROM
x: Dict => RETURN[x];
x: Ob => RETURN[DictFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
MarkFromAny:
PUBLIC
PROC [x: Any]
RETURNS [Mark] ~ {
WITH x
SELECT
FROM
x: Mark => RETURN[x];
x: Ob => RETURN[MarkFromAny[x.body]];
ENDCASE;
ProduceError[wrongType]; RETURN[NIL];
};
RopeFromAtom:
PUBLIC
PROC [atom:
ATOM]
RETURNS [
ROPE] ~ {
RETURN[Atom.GetPName[atom]];
};
AtomFromRope:
PUBLIC
PROC [rope:
ROPE]
RETURNS [
ATOM] ~ {
RETURN[Atom.MakeAtom[rope]];
};
Type:
PUBLIC
PROC [x: Any]
RETURNS [TypeCode] ~ {
IF x=NIL THEN RETURN[nil];
RETURN[
WITH x
SELECT
FROM
x: Number => number,
x: ATOM => atom,
x: ROPE => rope,
x: STREAM => stream,
x: Cmd => cmd,
x: Dict => dict,
x: Array => array,
x: Mark => mark,
x: Ob => Type[x.body],
ENDCASE => other];
};
TypeAtomArray: TYPE ~ REF TypeAtomArrayRep;
TypeAtomArrayRep: TYPE ~ ARRAY TypeCode OF ATOM;
typeAtom: TypeAtomArray ~
NEW[TypeAtomArrayRep ← [
nil: AtomFromRope[".nil"],
number: AtomFromRope[".number"],
atom: AtomFromRope[".atom"],
rope: AtomFromRope[".rope"],
stream: AtomFromRope[".stream"],
cmd: AtomFromRope[".cmd"],
dict: AtomFromRope[".dict"],
array: AtomFromRope[".array"],
mark: AtomFromRope[".mark"],
other: AtomFromRope[".other"]
]];
Length:
PUBLIC
PROC [x: Any]
RETURNS [
INT] ~ {
WITH x
SELECT
FROM
x: Array => RETURN[x.len];
x: Dict => RETURN[DictLength[x]];
x: ROPE => RETURN[Rope.Length[x]];
x: Ob => RETURN[Length[x.body]];
ENDCASE;
RETURN[1];
};
Equal:
PUBLIC
PROC [a, b: Any]
RETURNS [
BOOL] ~ {
IF a=b THEN RETURN[TRUE];
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 => ERROR;
real =>
WITH b: b
SELECT
FROM
int => RETURN[a.real=b.int];
real => RETURN[a.real=b.real];
ENDCASE => ERROR;
ENDCASE => ERROR;
ENDCASE;
a:
ATOM =>
WITH b
SELECT
FROM
b: ATOM => RETURN[a=b];
b: ROPE => RETURN[a=AtomFromRope[b]];
ENDCASE;
a:
ROPE =>
WITH b
SELECT
FROM
b: ATOM => RETURN[AtomFromRope[a]=b];
b: ROPE => RETURN[Rope.Equal[a, b]];
ENDCASE;
ENDCASE;
WITH a
SELECT
FROM
a: Ob => RETURN[Equal[a.body, b]];
ENDCASE;
WITH b
SELECT
FROM
b: Ob => RETURN[Equal[a, b.body]];
ENDCASE;
RETURN[FALSE];
};
CvX:
PUBLIC
PROC [x: Any]
RETURNS [Any] ~ {
WITH x
SELECT
FROM
x: Ob => RETURN[IF x.tag=executable THEN x ELSE CvX[x.body]];
ENDCASE => RETURN[NEW[ObRep ← [tag: executable, body: x]]];
};
CvLit:
PUBLIC
PROC [x: Any]
RETURNS [Any] ~ {
WITH x
SELECT
FROM
x: Ob => RETURN[IF x.tag=literal THEN x ELSE CvLit[x.body]];
ENDCASE => RETURN[NEW[ObRep ← [tag: literal, body: x]]];
};
CvI:
PUBLIC
PROC [x: Any]
RETURNS [
INT] ~ {
WITH x
SELECT
FROM
x: Number =>
WITH x: x
SELECT
FROM
int => RETURN[x.int];
real => RETURN[Real.Round[x.real]];
ENDCASE => ProduceError[bug];
x: ROPE => RETURN[Convert.IntFromRope[x]];
x: Ob => RETURN[CvI[x.body]];
ENDCASE => ProduceError[wrongType];
RETURN[0];
};
CvR:
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 => ProduceError[bug];
x: ROPE => RETURN[Convert.RealFromRope[x]];
x: Ob => RETURN[CvR[x.body]];
ENDCASE => ProduceError[wrongType];
RETURN[0];
};
ApplyType:
PUBLIC
PROC [frame: Frame] ~ {
x: Any ~ Pop[frame];
type: TypeCode ~ Type[x];
PushAtom[frame, typeAtom[type]];
};
ApplyLength:
PUBLIC
PROC [frame: Frame] ~ {
x: Any ~ Pop[frame];
PushInt[frame, Length[x]];
};
ApplyCvLit:
PUBLIC
PROC [frame: Frame] ~ {
x: Any ~ Pop[frame];
Push[frame, CvLit[x]];
};
ApplyCvX:
PUBLIC
PROC [frame: Frame] ~ {
x: Any ~ Pop[frame];
Push[frame, CvX[x]];
};
ApplyCvI:
PUBLIC
PROC [frame: Frame] ~ {
x: Any ~ Pop[frame];
PushInt[frame, CvI[x]];
};
ApplyCvR:
PUBLIC
PROC [frame: Frame] ~ {
x: Any ~ Pop[frame];
PushReal[frame, CvR[x]];
};
ApplyCommandName:
PUBLIC
PROC [frame: Frame] ~ {
cmd: Cmd ~ PopCmd[frame];
PushAtom[frame, cmd.name];
};
RegisterPrimitive[".type", ApplyType];
RegisterPrimitive[".length", ApplyLength];
RegisterPrimitive[".cvlit", ApplyCvLit];
RegisterPrimitive[".cvx", ApplyCvX];
RegisterPrimitive[".cvi", ApplyCvI];
RegisterPrimitive[".cvr", ApplyCvR];
RegisterPrimitive[".commandname", ApplyCommandName];
END.