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 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. EQT.Mesa Last Edited by: Spreitzer, May 9, 1986 10:26:05 pm PDT Mike Spreitzer July 30, 1986 11:17:57 pm PDT Try to get the right stuff. Κ*– "cedar" style˜codešœ™K™6K™,—K˜KšΟk œEœx˜ΘK˜šΡbkxœœ˜KšœEœi˜·—K˜Kš˜K˜Kšœœœ˜Kšœœ˜Kšœœ œ˜Kšœ œ˜Kšœœ˜!Kšœ œ˜)Kšœ"˜"Kšœœ˜!K˜Kšœœœœ˜ Kš œœœœœœ˜6K˜KšΟnœœœœ ˜,Kš Ÿœœœœœ œ˜KKš Ÿœœœœœ œ ˜AK˜šŸœœœ œœœœΟcœ˜|Kšœ œ˜$Kšœœ˜ Kš œ œœœœ˜"Kšœ ˜ Kšœ œœ˜Kšœ œ0˜VKšœB˜BKšœœ˜"šœœœ˜1Kšœ#˜#K˜—K˜—K˜šŸœœœ œœœœ œ˜{Kšœ œ"˜3Kšœœ˜ Kš œ œœœœ˜"Kšœ ˜ Kšœ œœ˜Kšœ œ0˜VKšœA˜AKšœœ˜"šœœœ˜1Kšœ#˜#K˜—K˜—K˜š Ÿ œœœœœ˜'šœ:œ˜IKšœœ ˜*Kšœœœ˜—K˜—K˜šŸœœ=œœœ œ œ˜™Kš˜Kšœ0˜0KšœZ˜ZK˜Kšœ œ˜Kšœœ˜ Kšœ%œœ˜2K˜#K˜+K˜K˜šœ˜!Kšœ0˜0Kšœœœœ˜Kšœ˜—š œœ œœ˜+Kšœ.˜.KšœœB˜IKšœœ˜!Kšœœ˜%Kšœœ˜%Kšœ œœ˜K˜K˜šœ˜ Kšœ#˜#Kšœœœœ˜8—K˜&Kšœ˜—K˜Kšœ˜—K˜Kšœ˜Kšœ$œ˜0Kšœœ˜J˜š Ÿ œœœ œ œ˜QKšœœ˜ š˜Kšœ™Kšœ2˜2Kšœœœ˜6Kšœœœ˜DKšœF˜FKš˜—K˜—J˜šŸœœ=œœœ œ œ˜‡Kš˜Kšœœœ˜Kšœ'˜'šœœœ˜Kšœe˜eKšœ˜—šœœœœœœœœœ˜dšœœœ˜-Kšœ&˜&KšœD˜DK˜Kšœ˜——šœ˜KšœE˜EK˜—Kšœœœœ˜K˜K˜ Kšœ˜—K˜š Ÿœœœœœ ˜DKšœœœe˜vK˜Kšœ˜K˜K˜—K˜šŸ œœœœ˜,šœœ˜šœœ˜K˜š œ œœœœœ˜DKšœ œ œœ˜)Kšœ˜—Kšœ œœ˜2K˜šœœœ˜"šŸœœ˜K˜Kšœœ˜*K˜—K˜Kšœ˜—K˜K˜—Kšœœœ œ ˜%Kšœœ˜—K˜—K˜š Ÿ œœœœ œ˜0Kšœ)˜)Kšœ˜Kšœœ ˜-Kšœ˜K˜Kšœœ˜—K˜Kšœ œœœ˜)K˜šŸœœ˜Kšœœœ˜1Kšœœ˜ šœ˜ Kšœ-œœ˜:Kš œœœœœ˜2Kšœ#˜#Kšœ˜—šœœ˜-K˜ K˜'Kšœ˜—Kšœ$œ˜)Kšœ6œ˜;KšœRœœ˜^KšœPœœ˜\K˜—K˜K˜K˜Kšœ˜—…—Ξ!ˆ