JaMMiscImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Maureen Stone February 6, 1984 5:07:45 pm PST
Doug Wyatt, March 18, 1985 3:28:10 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: BOOL ← 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.