
<<JaMMiscImpl.mesa>>
<<>>
<<Last edited by:>>
<<Doug Wyatt, November 21, 1983 1:17 pm>>
<<Maureen Stone February 6, 1984 5:07:45 pm PST>>
<<>>
DIRECTORY
Atom USING [GetPName, MakeAtom],
Convert USING [IntFromRope, RealFromRope, Error],
JaM USING [Any, Array, Command, Dict, DictLength, Error, Mark, Op, OpRep, Pop, Push, PushInt, PushReal, ROPE, State, STREAM],
JaMPrimitives USING [],
Real USING [RoundLI],
Rope USING [Equal, Length, Concat];

JaMMiscImpl: CEDAR PROGRAM
IMPORTS Atom, Convert, JaM, Rope, Real
EXPORTS JaM, JaMPrimitives
= BEGIN OPEN JaM;

AtomToRope: PUBLIC PROC[atom: ATOM] RETURNS[ROPE] = { RETURN[Atom.GetPName[atom]] };
RopeToAtom: PUBLIC PROC[rope: ROPE] RETURNS[ATOM] = { RETURN[Atom.MakeAtom[rope]] };
<<>>
Kind: TYPE = {nil, int, real, atom, rope, stream, cmd, op, array, dict, mark, other};

GetKind: PROC[x: Any] RETURNS[Kind] = {
RETURN[IF x=NIL THEN nil
ELSE WITH x SELECT FROM
x: REF INT => int,
x: REF REAL => real,
x: ATOM => atom,
x: ROPE => rope,
x: STREAM => stream,
x: Command => cmd,
x: Op => op,
x: Array => array,
x: Dict => dict,
x: Mark => mark,
ENDCASE => other];
};

TypeArray: TYPE = REF TypeArrayRep;
TypeArrayRep: TYPE = ARRAY Kind OF ATOM;
types: TypeArray _ NEW[TypeArrayRep _ [
nil: RopeToAtom[".nil"],
int: RopeToAtom[".int"],
real: RopeToAtom[".real"],
atom: RopeToAtom[".atom"],
rope: RopeToAtom[".rope"],
stream: RopeToAtom[".stream"],
cmd: RopeToAtom[".cmd"],
op: RopeToAtom[".op"],
array: RopeToAtom[".array"],
dict: RopeToAtom[".dict"],
mark: RopeToAtom[".mark"],
other: RopeToAtom[".other"]
]];

Length: PROC[x: Any] RETURNS[INT] = {
RETURN[WITH x SELECT FROM
x: Array => x.length,
x: Dict => DictLength[x],
x: ROPE => x.Length[],
x: ATOM => AtomToRope[x].Length[],
ENDCASE => 1];
};

Equal: PUBLIC PROC[a, b: Any] RETURNS[BOOL] = {
WITH a SELECT FROM
a: ATOM => WITH b SELECT FROM
b: ATOM => RETURN[a=b];
b: ROPE => RETURN[a=RopeToAtom[b]];
ENDCASE;
a: ROPE => WITH b SELECT FROM
b: ATOM => RETURN[RopeToAtom[a]=b];
b: ROPE => RETURN[Rope.Equal[a, b]];
ENDCASE;
a: REF INT => WITH b SELECT FROM
b: REF INT => RETURN[a^=b^];
b: REF REAL => RETURN[REAL[a^]=b^];
ENDCASE;
a: REF REAL => WITH b SELECT FROM
b: REF INT => RETURN[a^=REAL[b^]];
b: REF REAL => RETURN[a^=b^];
ENDCASE;
ENDCASE;
RETURN[a=b];
};

ApplyType: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
kind: Kind = GetKind[x];
Push[self, types[kind]];
};

ApplyLength: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
PushInt[self, Length[x]];
};

ApplyCvLit: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
WITH x SELECT FROM
x: Op => Push[self, x.body];
ENDCASE => Push[self, x];
};

ApplyCvX: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
WITH x SELECT FROM
x: Op => Push[self, x];
ENDCASE => Push[self, NEW[OpRep _ [body: x]]];
};

ApplyCvI: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
WITH x SELECT FROM
x: REF INT => PushInt[self, x^];
x: REF REAL => PushInt[self, Real.RoundLI[x^]];
x: ROPE => PushInt[self, Real.RoundLI[RealFromRope[x]]];
ENDCASE => ERROR Error[WrongType];
};

ApplyCvR: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
WITH x SELECT FROM
x: REF INT => PushReal[self, x^];
x: REF REAL => PushReal[self, x^];
x: ROPE => PushReal[self, RealFromRope[x]];
ENDCASE => ERROR Error[WrongType];
};

RealFromRope: PROC[rope: ROPE] RETURNS[REAL]= {
r: REAL;
realFailed: BOOLEAN _ FALSE;
{ENABLE Convert.Error =>IF reason=syntax THEN GOTO Hack;
r _ Convert.RealFromRope[rope];
EXITS Hack =>
r _ Convert.RealFromRope[Rope.Concat[rope,"0"] ! Convert.Error =>
{IF reason=syntax THEN realFailed _ TRUE; CONTINUE}];
};
IF realFailed THEN r _ Convert.IntFromRope[rope ! Convert.Error => Error[WrongType]];
RETURN[r];
};

ApplyCommandName: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
WITH x SELECT FROM
x: Command => Push[self, x.name];
ENDCASE => ERROR Error[WrongType];
};

Proc: TYPE = RECORD[proc: PROC[State]];    --to coerce IO.refAny to print our proc 
ApplyCommandProc: PUBLIC PROC[self: State] = {
x: Any = Pop[self];
WITH x SELECT FROM
x: Command => {proc: REF Proc _ NEW[Proc _ [x.proc]]; Push[self, proc]};
ENDCASE => ERROR Error[WrongType];
};

END.