AMHacks.Mesa
Last Edited by: Spreitzer, May 10, 1986 0:42:55 am PDT
DIRECTORY AMBridge, AMTypes, BBUrpEval, EvalQuote, InterpreterOps, InterpreterPrivate, List, PPTree, PPTreeOps, ProcessProps, Rope, SymTab;
AMHacks:
CEDAR
PROGRAM
IMPORTS AMBridge, AMTypes, BBUrpEval, EvalQuote, InterpreterOps, InterpreterPrivate, List, PPTreeOps, ProcessProps, SymTab =
BEGIN
ROPE: TYPE = Rope.ROPE;
Type: TYPE = AMTypes.Type;
TV: TYPE = AMTypes.TV;
Tree: TYPE = InterpreterOps.Tree;
EvalHead: TYPE = InterpreterOps.EvalHead;
nullType: Type = AMTypes.nullType;
empty: TV ← AMTypes.GetEmptyTV[];
Reflect:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
TRUSTED {return ← AMBridge.TVForReferent[NEW[Reflection ← latest ← [head, tree, target]]]};
END;
Reflection: TYPE = RECORD [head: EvalHead, tree: Tree, target: Type];
latest: Reflection;
ReturnEmpty:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
latest ← [head, tree, target];
return ← empty;
END;
Up:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
args: Tree ← PPTreeOps.NthSon[tree, 2];
arg: TV ← InterpreterOps.Eval[tree: args, head: head];
TRUSTED {return ← AMBridge.TVForReferent[NEW [TV ← arg]]};
END;
tvType: Type = CODE[TV];
Down:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
args: Tree ← PPTreeOps.NthSon[tree, 2];
arg: TV ← InterpreterOps.Eval[tree: args, head: head, target: tvType];
DO
SELECT AMTypes.TypeClass[AMTypes.UnderType[AMTypes.TVType[arg]]]
FROM
ref => {
ra: REF ANY;
TRUSTED {ra ← AMBridge.TVToRef[arg]};
WITH ra
SELECT
FROM
tv: TV => RETURN [tv];
ENDCASE;
};
ENDCASE;
arg ← BBUrpEval.UrpWrongType[head, args, arg, tvType, "Down takes a TV"];
args ← NIL;
ENDLOOP;
END;
TypeOf:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
args: Tree ← PPTreeOps.NthSon[tree, 2];
arg: TV ← InterpreterOps.Eval[tree: args, head: head];
type: Type ← AMTypes.TVType[arg];
TRUSTED {return ← AMBridge.TVForType[type]};
END;
EnType:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
args: Tree ← PPTreeOps.NthSon[tree, 2];
arg: TV ← InterpreterOps.Eval[tree: args, head: head, target: underType];
type: Type ← ForceType[arg, head, tree];
TRUSTED {return ← AMBridge.TVForType[type]};
END;
UndefineEQ:
PROC [name:
ROPE, table: SymTab.Ref ←
NIL] =
BEGIN
IF table = NIL THEN table ← NARROW[List.Assoc[$EvalHead, ProcessProps.GetPropList[]], EvalHead].specials;
EvalQuote.Register[name, NIL, table];
END;
Undefine:
PROC [name:
ROPE, table: SymTab.Ref ←
NIL]
RETURNS [wasDefined:
BOOL] =
BEGIN
IF table = NIL THEN table ← NARROW[List.Assoc[$EvalHead, ProcessProps.GetPropList[]], EvalHead].specials;
wasDefined ← table.Delete[name];
END;
underType: Type ← AMTypes.UnderType[CODE[Type]];
ropeType: Type ← AMTypes.UnderType[CODE[ROPE]];
ForceType:
PROC [tv:
TV, head: EvalHead, parent: Tree]
RETURNS [Type] =
TRUSTED {
rtn: TV ← tv;
DO
Try to get the right stuff.
ut: Type = AMTypes.UnderType[AMTypes.TVType[rtn]];
IF ut = underType THEN RETURN [AMTypes.TVToType[rtn]];
IF AMTypes.TypeClass[ut] = type THEN RETURN [AMTypes.TVToType[rtn]];
rtn ← BBUrpEval.UrpWrongType[head, parent, rtn, underType, "not Type"]
ENDLOOP
};
Start:
PROC = {
EvalQuote.Register["&reflect", Reflect, NIL];
EvalQuote.Register["&returnEmpty", ReturnEmpty, NIL];
EvalQuote.Register["&up", Up, NIL];
EvalQuote.Register["&down", Down, NIL];
EvalQuote.Register["&typeOf", TypeOf, NIL];
EvalQuote.Register["&unCODE", EnType, NIL];
TRUSTED {
InterpreterOps.RegisterTV["&undefineEQ", AMBridge.TVForProc[UndefineEQ], "Undoes an EvalQuote registration", InterpreterPrivate.GetGlobalSymTab[]];
InterpreterOps.RegisterTV["&undefine", AMBridge.TVForProc[Undefine], "Removes something from the specials table", InterpreterPrivate.GetGlobalSymTab[]];
};
};
Start[];
END.