EQT.Mesa
Last Edited by: Spreitzer, May 9, 1986 10:26:05 pm PDT
Mike Spreitzer July 30, 1986 11:17:57 pm PDT
DIRECTORY AMBridge, AMTypes, BBUrpEval, Commander, EvalQuote, InterpreterOps, IO, List, PPTree, PPTreeOps, PrintTV, ProcessProps, Rope, StatementInterpreter, StructuredStreams, SymTab, UnparserBuffer;
EQT:
CEDAR
PROGRAM
IMPORTS AMBridge, AMTypes, BBUrpEval, Commander, EvalQuote, InterpreterOps, IO, List, PPTreeOps, PrintTV, ProcessProps, Rope, StatementInterpreter, StructuredStreams, UnparserBuffer =
BEGIN
ROPE: TYPE = Rope.ROPE;
Type: TYPE = AMTypes.Type;
TV: TYPE = AMTypes.TV;
SymbolTable: TYPE = SymTab.Ref;
Tree: TYPE = InterpreterOps.Tree;
EvalHead: TYPE = InterpreterOps.EvalHead;
nullType: Type = AMTypes.nullType;
empty: TV ← AMTypes.GetEmptyTV[];
Error: ERROR [msg: ROPE] = CODE;
Signal: SIGNAL [msg: ROPE] RETURNS [ans: ROPE] = CODE;
RaiseErr: PROC [r: ROPE] = {ERROR Error[r]};
RaiseSig: PROC [r: ROPE] RETURNS [s: ROPE] = {s ← SIGNAL Signal[r]; r ← r};
ErrSig: PROC [r: ROPE] RETURNS [s: ROPE] = {s ← ERROR Signal[r]};
ShowModuleParseTree:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- = {
blockAsRope: ROPE ← cmd.commandLine;
len: INT ← blockAsRope.Length[];
errorStream: IO.STREAM ← IO.ROS[];
body: Tree;
IF len < 1 THEN RETURN;
IF blockAsRope.Fetch[len-1] = '\n THEN blockAsRope ← blockAsRope.Substr[len: len - 1];
body ← StatementInterpreter.ParseModule[blockAsRope, errorStream];
msg ← IO.RopeFromROS[errorStream];
IF msg.Length[] > 0
THEN result ← $Failure
ELSE {
PrettyPrintTree[cmd.out, body, 57];
};
};
ShowBlockParseTree:
PROC [cmd: Commander.Handle]
RETURNS [result:
REF ←
NIL, msg:
ROPE ←
NIL]
--Commander.CommandProc-- = {
blockAsRope: ROPE ← Rope.Cat["{", cmd.commandLine];
len: INT ← blockAsRope.Length[];
errorStream: IO.STREAM ← IO.ROS[];
body: Tree;
IF len < 1 THEN RETURN;
IF blockAsRope.Fetch[len-1] = '\n THEN blockAsRope ← blockAsRope.Substr[len: len - 1];
body ← StatementInterpreter.ParseBlock[blockAsRope, errorStream];
msg ← IO.RopeFromROS[errorStream];
IF msg.Length[] > 0
THEN result ← $Failure
ELSE {
PrettyPrintTree[cmd.out, body, 57];
};
};
GetStream:
PROC
RETURNS [
IO.
STREAM] = {
WITH List.Assoc[$CommanderHandle, ProcessProps.GetPropList[]]
SELECT
FROM
cmd: Commander.Handle => RETURN [cmd.out];
ENDCASE => RETURN [NIL];
};
MakeExplicitlyTypedList:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
typeTree: Tree ← InterpreterOps.GetArg[tree, 1];
listType: Type ← ForceType[InterpreterOps.Eval[typeTree, head, typeType], head, typeTree];
consType, carType: Type;
nilIndex: NAT;
tail: TV;
IF AMTypes.UnderClass[listType] # list THEN ERROR;
consType ← AMTypes.Range[listType];
carType ← AMTypes.IndexToType[consType, 1];
tail ← AMTypes.New[listType];
AMTypes.Assign[tail, nil];
FOR nilIndex ← 2, nilIndex + 1
DO
t: Tree ← InterpreterOps.GetArg[tree, nilIndex];
IF t = NIL THEN EXIT;
ENDLOOP;
FOR i:
NAT
DECREASING
IN (1 .. nilIndex)
DO
elTree: Tree ← InterpreterOps.GetArg[tree, i];
elt: TV ← InterpreterOps.Eval[tree: elTree, head: head, target: carType];
cons: TV ← AMTypes.New[consType];
car: TV ← AMTypes.IndexToTV[cons, 1];
cdr: TV ← AMTypes.IndexToTV[cons, 2];
tailRef: REF ANY;
AMTypes.Assign[car, elt];
AMTypes.Assign[cdr, tail];
TRUSTED {
tailRef ← AMBridge.RefFromTV[cons];
tail ← AMBridge.TVForReferent[NEW [REF ANY ← tailRef]]};
tail ← AMTypes.Coerce[tail, listType];
ENDLOOP;
return ← tail;
END;
typeType: Type;
underType: Type ← AMTypes.UnderType[CODE[Type]];
nil: TV;
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
};
Print:
PROC [head: EvalHead, tree: Tree, target: Type ← nullType, data:
REF ←
NIL]
RETURNS [return:
TV]
-- EvalQuote.EvalQuoteProc -- =
BEGIN
out: IO.STREAM ← GetStream[];
args: Tree ← PPTreeOps.NthSon[tree, 2];
IF out #
NIL
THEN {
out ← StructuredStreams.Create[UnparserBuffer.NewInittedHandle[[margin: 60, output: [stream[out]]]]];
};
IF args #
NIL
AND
ISTYPE[args,
REF PPTree.Node]
AND
NARROW[args,
REF PPTree.Node].name = list
THEN {
FOR i:
NAT
IN [1 .. PPTreeOps.NSons[args]]
DO
son: Tree ← PPTreeOps.NthSon[args, i];
return ← InterpreterOps.Eval[tree: son, head: head, target: target];
PrintTV.Print[return, out];
ENDLOOP}
ELSE {
return ← InterpreterOps.Eval[tree: args, head: head, target: target];
PrintTV.Print[return, out]};
IF out = NIL THEN RETURN;
out.PutChar['\n];
out.Close[];
END;
PrettyPrintTree:
PROC [to:
IO.
STREAM, t: Tree, margin:
NAT ← 69] = {
realTo: IO.STREAM = StructuredStreams.Create[UnparserBuffer.NewInittedHandle[[margin: margin, output: [stream[to]]]]];
PrintWork[realTo, t];
realTo.PutRope["\n"];
realTo.Close[];
};
PrintWork:
PROC [to:
IO.
STREAM, t: Tree] = {
WITH t
SELECT
FROM
n:
REF PPTree.Node => {
to.PutRope[nodeNames[n.name]];
IF n.attr #
ALL[
FALSE]
THEN
FOR a: PPTree.AttrId
IN PPTree.AttrId
DO
to.PutChar[IF n.attr[a] THEN 'T ELSE 'F];
ENDLOOP;
IF n.info # 0 THEN to.PutF["%g", IO.card[n.info]];
to.PutRope["["];
FOR i:
NAT
IN [1 .. n.sonLimit)
DO
WriteSon:
PROC = {
PrintWork[to, n.son[i]];
IF i+1 < n.sonLimit THEN to.PutRope[", "];
};
MakePiece[to, WriteSon];
ENDLOOP;
to.PutRope["]"];
};
ra: REF ANY => to.Put[IO.refAny[ra]];
ENDCASE => ERROR;
};
MakePiece:
PROC [to:
IO.
STREAM, write:
PROC] = {
StructuredStreams.Bp[to, united, indent];
StructuredStreams.Begin[to];
write[!UNWIND => StructuredStreams.End[to] ];
StructuredStreams.End[to];
};
indent: INTEGER ← 3;
nodeNames: ARRAY PPTree.NodeName OF ROPE;
Start:
PROC = {
rnn: REF PPTree.NodeName ← NEW [PPTree.NodeName];
tvnn: TV;
TRUSTED {
typeType ← AMTypes.TVType[AMBridge.TVForType[CODE[BOOL]]];
nil ← AMBridge.TVForReferent[NEW [REF ANY ← NIL]];
tvnn ← AMBridge.TVForReferent[rnn];
};
FOR nn: PPTree.NodeName
IN PPTree.NodeName
DO
rnn^ ← nn;
nodeNames[nn] ← AMTypes.TVToName[tvnn];
ENDLOOP;
EvalQuote.Register["&print", Print, NIL];
EvalQuote.Register["&tlist", MakeExplicitlyTypedList, NIL];
Commander.Register["d{", ShowBlockParseTree, "PrettyPrints statement parse tree", NIL, FALSE];
Commander.Register["dm", ShowModuleParseTree, "PrettyPrints module parse tree", NIL, FALSE];
};
Start[];
END.