SetPrinting.Mesa
Last tweaked by Mike Spreitzer on November 17, 1987 4:58:46 pm PST
DIRECTORY AMBridge, AMTypes, IO, Collections, IntFunctions, IntStuff, PairCollections, List, PrintTV, Process, Rope, StructuredStreams;
SetPrinting: CEDAR PROGRAM
IMPORTS AMBridge, AMTypes, IO, Collections, IntFunctions, PairCollections, List, PrintTV, Process, Rope, StructuredStreams
=
BEGIN OPEN Colls:Collections, PairColls:PairCollections, IntFns:IntFunctions, Ints:IntStuff, SS:StructuredStreams;
ROPE: TYPE ~ Rope.ROPE;
TV: TYPE ~ AMTypes.TV;
Type: TYPE ~ AMTypes.Type;
OrderStyleName: ARRAY Colls.OrderStyle OF ROPE ~ [
none: "unordered",
client: "client ordered",
value: "value ordered"];
MutabilityName: ARRAY Colls.Mutability OF ROPE ~ [
constant: "const",
variable: "var",
readonly: "r.o."];
PrintCollection: PROC [tv: TV, data: REF ANY, stream: IO.STREAM, depth: INT ← 4, width: INT ← 32, verbose: BOOLFALSE] RETURNS [useOld: BOOLFALSE] --PrintTV.TVPrintProc-- ~ TRUSTED {
OPEN Colls;
collTV: TV ~ ToColl[tv];
classTV: TV ~ AMTypes.IndexToTV[collTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[collTV, 2];
coll: Collection ~ [NARROW[AMBridge.TVToRef[classTV]], NARROW[AMBridge.TVToRef[dataTV]]];
IF coll.class=NIL THEN {
stream.PutRope[IF coll.data=NIL THEN "nilColl" ELSE "{broken collection}"];
RETURN};
stream.PutRope["{"];
{ENABLE Cant => {stream.PutRope[" -- collection printing fumbled"]; CONTINUE};
canFilter: BOOL ~ coll.QualityOf[$HasMember] >= goodDefault;
canScan: BOOL ~ coll.QualityOf[$Scan, LIST[$FALSE]] >= goodDefault OR coll.QualityOf[$Scan, LIST[$TRUE]] >= goodDefault;
setlike: BOOL ~ coll.MayDuplicate[] = FALSE;
orderStyle: OrderStyle ~ coll.OrderStyleOf[];
stream.PutF["%g %g %g",
[rope[OrderStyleName[orderStyle]]],
[rope[MutabilityName[coll.MutabilityOf[]]]],
[rope[IF canFilter
THEN IF canScan
THEN IF setlike THEN "set" ELSE "collection"
ELSE "filter"
ELSE IF canScan
THEN IF setlike THEN "set enumerator" ELSE "enumerator"
ELSE "dimwit"]]];
IF verbose OR depth >= 2 THEN {
canSize: BOOL ~ coll.QualityOf[$Size] >= goodDefault;
size: INT ~ IF canSize THEN coll.Size[] ELSE INT.LAST;
space: Space ~ coll.SpaceOf[];
IF canSize THEN {
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutF["size=%g", [integer[size]]];
};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope[Rope.Cat["space=", SpaceName[space]]];
IF canScan AND depth >= 4 THEN {
first: BOOLTRUE;
n: LNAT ← 0;
PrintElt: PROC [val: Value] RETURNS [pass: BOOLFALSE] ~ TRUSTED {
eltTV: TV ~ AMBridge.TVForReferent[NEW [Value ← val], const];
Process.CheckForAbort[];
IF first
THEN {first ← FALSE; SS.Bp[stream, lookLeft, 3]}
ELSE {stream.PutRope[","]; SS.Bp[stream, lookLeft, 3, " "]};
SS.Begin[stream];
{ENABLE UNWIND => SS.End[stream];
IF (pass ← (n ← n+1) > width)
THEN stream.PutRope["..."]
ELSE PrintTV.Print[tv: eltTV, put: stream, depth: depth-2, width: width];
};
SS.End[stream];
RETURN};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["elts: "];
[] ← coll.Scan[PrintElt];
};
};
};
stream.PutRope["}"];
RETURN};
PrintPairColl: PROC [tv: TV, data: REF ANY, stream: IO.STREAM, depth: INT ← 4, width: INT ← 32, verbose: BOOLFALSE] RETURNS [useOld: BOOLFALSE] --PrintTV.TVPrintProc-- ~ TRUSTED {
OPEN Colls, PairColls;
collTV: TV ~ ToColl[tv];
classTV: TV ~ AMTypes.IndexToTV[collTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[collTV, 2];
coll: PairColl ~ [NARROW[AMBridge.TVToRef[classTV]], NARROW[AMBridge.TVToRef[dataTV]]];
IF coll.class=NIL THEN {
stream.PutRope[IF coll.data=NIL THEN "nilPairColl" ELSE "{broken pair collection}"];
RETURN};
stream.PutRope["{"];
{ENABLE Cant => {stream.PutRope[" -- pair collection printing fumbled"]; CONTINUE};
canFilter: BOOL ~ coll.QualityOf[$HasPair] >= goodDefault;
canScan: BOOL ~ coll.QualityOf[$Scan, LIST[$FALSE]] >= goodDefault OR coll.QualityOf[$Scan, LIST[$TRUE]] >= goodDefault;
setlike: BOOL ~ coll.MayDuplicate[] = FALSE;
functional: BoolPair ~ coll.Functional;
orderStyle: OrderStyle ~ coll.OrderStyleOf[];
type: ROPE ~ IF functional[leftToRight]
THEN IF functional[rightToLeft] THEN "injection" ELSE "function"
ELSE IF functional[rightToLeft] THEN "inv-function" ELSE "relation";
stream.PutF["%g %g %g",
[rope[OrderStyleName[orderStyle]]],
[rope[MutabilityName[coll.MutabilityOf[]]]],
[rope[IF canFilter
THEN IF canScan
THEN IF setlike THEN type ELSE Rope.Cat["duplicating ", type]
ELSE "pair filter"
ELSE IF canScan
THEN IF setlike THEN type.Cat[" enumerator"] ELSE "pair enumerator"
ELSE "pair dimwit"]]];
IF verbose OR depth >= 2 THEN {
canSize: BOOL ~ coll.QualityOf[$Size] >= goodDefault;
size: INT ~ IF canSize THEN coll.Size[] ELSE INT.LAST;
spaces: SpacePair ~ coll.Spaces[];
IF canSize THEN {
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutF["size=%g", [integer[size]]];
};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope[Rope.Cat["spaces=[", SpaceName[spaces[left]], ", ", SpaceName[spaces[right]], "]"]];
IF canScan AND depth >= 4 THEN {
first: BOOLTRUE;
n: LNAT ← 0;
PrintElt: PROC [elt: Pair] RETURNS [pass: BOOLFALSE] ~ TRUSTED {
eltTV: TV ~ AMBridge.TVForReferent[NEW [Pair ← elt], const];
IF first
THEN {first ← FALSE; SS.Bp[stream, lookLeft, 3]}
ELSE {stream.PutRope[","]; SS.Bp[stream, lookLeft, 3, " "]};
SS.Begin[stream];
{ENABLE UNWIND => SS.End[stream];
IF (pass ← (n ← n+1) > width)
THEN stream.PutRope["..."]
ELSE PrintTV.Print[tv: eltTV, put: stream, depth: depth-2, width: width];
};
SS.End[stream];
RETURN};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["elts: "];
[] ← coll.Scan[PrintElt];
};
};
};
stream.PutRope["}"];
RETURN};
PrintIntFn: PROC [tv: TV, data: REF ANY, stream: IO.STREAM, depth: INT ← 4, width: INT ← 32, verbose: BOOLFALSE] RETURNS [useOld: BOOLFALSE] --PrintTV.TVPrintProc-- ~ TRUSTED {
OPEN Colls, PairColls, Ints, IntFns;
collTV: TV ~ ToColl[tv];
classTV: TV ~ AMTypes.IndexToTV[collTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[collTV, 2];
coll: IntFn ~ [NARROW[AMBridge.TVToRef[classTV]], NARROW[AMBridge.TVToRef[dataTV]]];
IF coll.class=NIL THEN {
stream.PutRope[IF coll.data=NIL THEN "nilIntFn" ELSE "{broken int fn}"];
RETURN};
stream.PutRope["{"];
{ENABLE Cant => {stream.PutRope[" -- int function printing fumbled"]; CONTINUE};
canFilter: BOOL ~ coll.QualityOf[$HasPair] >= goodDefault;
canScan: BOOL ~ coll.QualityOf[$Scan, LIST[$unrestricted, $unrestricted, $FALSE]] >= goodDefault OR coll.QualityOf[$Scan, LIST[$unrestricted, $unrestricted, $TRUE]] >= goodDefault;
canBound: BOOL ~ coll.QualityOf[$GetBounds]>=goodDefault;
type: ROPE ~ IF coll.IsOneToOne THEN "injection" ELSE "function";
mutability: Mutability ~ coll.MutabilityOf;
stream.PutF["%g %g%g%g %g",
[rope[IF coll.Ordered THEN "ordered" ELSE "unordered"]],
[rope[MutabilityName[mutability]]],
[rope[IF mutability#constant AND coll.DomainIsFixed THEN " fixed domain" ELSE ""]],
[rope[IF coll.class.isDense THEN " dense" ELSE ""]],
[rope[IF canFilter
THEN IF canScan
THEN type
ELSE type.Cat[" filter"]
ELSE IF canScan
THEN type.Cat[" enumerator"]
ELSE "int-val pair dimwit"]]];
IF canBound THEN {
bounds: Interval ~ coll.GetBounds[];
stream.PutF[" [%g..%g]", [integer[bounds.min]], [integer[bounds.max]]]};
IF verbose OR depth >= 2 THEN {
canSize: BOOL ~ coll.QualityOf[$Size] >= goodDefault;
size: INT ~ IF canSize THEN coll.Size[] ELSE INT.LAST;
right: Space ~ coll.RightSpace;
IF canSize AND NOT (coll.class.isDense AND canBound) THEN {
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutF["size=%g", [integer[size]]];
};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope[Rope.Cat["rightSpace=", SpaceName[right]]];
IF canScan AND depth >= 4 THEN {
first: BOOLTRUE;
n: LNAT ← 0;
prev: INTINT.LAST;
PrintElt: PROC [elt: IVPair] RETURNS [pass: BOOLFALSE] ~ TRUSTED {
valTV: TV ~ AMBridge.TVForReferent[NEW [Value ← elt.right], const];
IF first
THEN {first ← FALSE; SS.Bp[stream, lookLeft, 3]}
ELSE {stream.PutRope[","]; SS.Bp[stream, lookLeft, 3, " "]};
SS.Begin[stream];
{ENABLE UNWIND => SS.End[stream];
IF (pass ← (n ← n+1) > width)
THEN stream.PutRope["..."]
ELSE {
IF prev=INT.LAST OR prev.SUCC#elt.left THEN stream.PutF["%g: ", [integer[elt.left]]];
PrintTV.Print[tv: valTV, put: stream, depth: depth-2, width: width];
prev ← elt.left;
};
};
SS.End[stream];
RETURN};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["elts: "];
[] ← coll.Scan[PrintElt];
};
};
};
stream.PutRope["}"];
RETURN};
SpaceName: PROC [space: Colls.Space] RETURNS [name: ROPE] ~ {
IF space=NIL THEN RETURN ["unknown"];
name ← WITH List.Assoc[key: $Name, aList: space.other] SELECT FROM
x: ROPE => x,
x: REF READONLY TEXT => Rope.FromRefText[x],
ENDCASE => "?strange name?";
RETURN};
ToColl: PROC [tv: TV] RETURNS [collTV: TV] ~ {
collTV ← tv;
DO
SELECT AMTypes.NComponents[AMTypes.TVType[collTV]] FROM
1 => collTV ← AMTypes.IndexToTV[collTV, 1];
2 => EXIT;
ENDCASE => ERROR;
ENDLOOP;
RETURN};
Start: PROC ~ {
PrintTV.RegisterTVPrintProc[CODE[Colls.Collection], PrintCollection];
PrintTV.RegisterTVPrintProc[CODE[Colls.VarColl], PrintCollection, $Var];
PrintTV.RegisterTVPrintProc[CODE[Colls.UWColl], PrintCollection, $UW];
PrintTV.RegisterTVPrintProc[CODE[Colls.ConstColl], PrintCollection, $Const];
PrintTV.RegisterTVPrintProc[CODE[PairColls.PairColl], PrintPairColl];
PrintTV.RegisterTVPrintProc[CODE[PairColls.VarPairColl], PrintPairColl, $Var];
PrintTV.RegisterTVPrintProc[CODE[PairColls.UWPairColl], PrintPairColl, $UW];
PrintTV.RegisterTVPrintProc[CODE[PairColls.ConstPairColl], PrintPairColl, $Const];
PrintTV.RegisterTVPrintProc[CODE[IntFns.IntFn], PrintIntFn];
PrintTV.RegisterTVPrintProc[CODE[IntFns.VarIntFn], PrintIntFn, $Var];
PrintTV.RegisterTVPrintProc[CODE[IntFns.UWIntFn], PrintIntFn, $UW];
PrintTV.RegisterTVPrintProc[CODE[IntFns.ConstIntFn], PrintIntFn, $Const];
};
Start[];
END.