NewSetsPrinting.Mesa
Last tweaked by Mike Spreitzer on February 27, 1988 3:56:31 pm PST
DIRECTORY AbSets, AMBridge, AMTypes, BiRelBasics, BiRels, IntStuff, IO, PrintTV, Process, Rope, SafeStoragePrivate, SetBasics, StructuredStreams;
NewSetsPrinting: CEDAR PROGRAM
IMPORTS AbSets, AMBridge, AMTypes, BiRelBasics, BiRels, IntStuff, IO, PrintTV, Process, Rope, SafeStoragePrivate, SetBasics, StructuredStreams
EXPORTS AbSets, BiRels
=
BEGIN OPEN IntStuff, BiRelBasics, SetBasics, Sets:AbSets, Sets, BiRels, SS:StructuredStreams;
ROPE: TYPE ~ Rope.ROPE;
TV: TYPE ~ AMTypes.TV;
Type: TYPE ~ AMTypes.Type;
MutabilityName: ARRAY Mutability OF ROPE ~ [
constant: "const",
variable: "var",
readonly: "r.o."];
SetPrint: PROC [tv: TV, data: REF ANY, stream: IO.STREAM, depth: INT ← 4, width: INT ← 32, verbose: BOOL ← FALSE] RETURNS [useOld: BOOL ← FALSE] --PrintTV.TVPrintProc-- ~ {
OPEN Sets;
setTV: TV ~ UnWrap[tv];
classTV: TV ~ AMTypes.IndexToTV[setTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[setTV, 2];
set: Set ~ [NARROW[TVToRef[classTV]], TVToValue[dataTV]];
PrintSet[set, stream, depth, width, verbose];
RETURN};
PrintSet: PUBLIC PROC [set: Set, to: IO.STREAM, depth: INT ← 4, length: INT ← 32, verbose: BOOL ← FALSE] ~ {
IF set.class=NIL THEN {
to.PutRope[IF set.data#nilSet.data THEN "{broken set}" ELSE "AbSets.nilSet"];
RETURN};
to.PutRope["{"];
{ENABLE Cant => {to.PutRope[" -- set printing fumbled"]; CONTINUE};
canFilter: BOOL ~ set.QualityOf[$HasMember] >= goodDefault;
canScan: BOOL ~ set.QualityOf[$Scan] >= goodDefault;
IF verbose OR depth<2 THEN {
to.PutF["%g %g",
[rope[MutabilityName[set.MutabilityOf[]]]],
[rope[IF canFilter
THEN IF canScan
THEN "set"
ELSE "filter"
ELSE IF canScan
THEN "enumerator"
ELSE "dimwit"]]];
IF depth>=2 THEN {
canSize: BOOL ~ set.QualityOf[$Size] >= goodDefault;
size: EINT ~ IF canSize THEN set.Size[] ELSE lastEINT;
space: Space ~ set.SpaceOf[];
IF canSize THEN {
to.PutRope[","];
SS.Bp[to, lookLeft, 3, " "];
to.PutRope["size="];
to.PutRope[size.ToRope];
};
to.PutRope[","];
SS.Bp[to, lookLeft, 3, " "];
to.PutRope[Rope.Cat["space=", space.name]];
};
};
IF depth>=2 THEN {
IF canScan THEN {
space: Space ~ set.SpaceOf[];
first: BOOL ← TRUE;
n: LNAT ← 0;
PrintElt: PROC [val: Value] RETURNS [pass: BOOL] ~ CHECKED {
Process.CheckForAbort[];
IF first
THEN {first ← FALSE; SS.Bp[to, lookLeft, 3]}
ELSE {to.PutRope[","]; SS.Bp[to, lookLeft, 3, " "]};
SS.Begin[to];
{ENABLE UNWIND => SS.End[to];
IF (pass ← (n ← n+1) > length)
THEN to.PutRope["..."]
ELSE space.SPrint[v: val, to: to, depth: depth-1, length: length];
};
SS.End[to];
RETURN};
IF verbose THEN {to.PutRope[","]; SS.Bp[to, lookLeft, 3, " "]; to.PutRope["elts: "]};
[] ← set.Scan[PrintElt];
}
ELSE to.PutRope["can't enumerate"];
};
};
to.PutRope["}"];
RETURN};
BiRelPrint: PROC [tv: TV, data: REF ANY, stream: IO.STREAM, depth: INT ← 4, width: INT ← 32, verbose: BOOL ← FALSE] RETURNS [useOld: BOOL ← FALSE] --PrintTV.TVPrintProc-- ~ {
biRelTV: TV ~ UnWrap[tv];
classTV: TV ~ AMTypes.IndexToTV[biRelTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[biRelTV, 2];
br: BiRel ~ [NARROW[TVToRef[classTV]], NARROW[TVToRef[dataTV]]];
PrintBiRel[br, stream, depth, width, verbose];
RETURN};
PrintBiRel: PUBLIC PROC [br: BiRel, to: IO.STREAM, depth: INT ← 4, length: INT ← 32, verbose: BOOL ← FALSE] ~ {
IF br.class=NIL THEN {
to.PutRope[IF br.data#nilBiRel.data THEN "{broken BiRel}" ELSE "BiRels.nilBiRel"];
RETURN};
to.PutRope["{"];
{ENABLE Cant => {to.PutRope[" -- binary relation printing fumbled"]; CONTINUE};
canFilter: BOOL ~ br.QualityOf[$HasPair] >= goodDefault;
canScan: BOOL ~ br.QualityOf[$Scan] >= goodDefault;
functional: BoolPair ~ br.Functional;
type: ROPE ~ IF functional[leftToRight]
THEN IF functional[rightToLeft] THEN "injection" ELSE "function"
ELSE IF functional[rightToLeft] THEN "inv-function" ELSE "relation";
IF verbose OR depth <= 2 THEN {
to.PutF["%g %g%g",
[rope[MutabilityName[br.MutabilityOf[]]]],
[rope[type]],
[rope[IF canFilter
THEN IF canScan
THEN ""
ELSE " filter"
ELSE IF canScan
THEN " enumerator"
ELSE " dimwit"]]];
IF depth >= 2 THEN {
canSize: BOOL ~ br.QualityOf[$Size] >= goodDefault;
size: EINT ~ IF canSize THEN br.Size[] ELSE lastEINT;
spaces: SpacePair ~ br.Spaces[];
IF canSize THEN {
to.PutRope[","];
SS.Bp[to, lookLeft, 3, " "];
to.PutRope["size="];
to.PutRope[size.ToRope];
};
to.PutRope[","];
SS.Bp[to, lookLeft, 3, " "];
to.PutRope[Rope.Cat["spaces=[", spaces[left].name, ", ", spaces[right].name, "]"]];
};
};
IF depth>2 THEN {
IF canScan THEN {
spaces: SpacePair ~ br.Spaces[];
first: BOOL ← TRUE;
n: LNAT ← 0;
PrintElt: PROC [elt: Pair] RETURNS [pass: BOOL ← FALSE] ~ CHECKED {
IF first
THEN {first ← FALSE; SS.Bp[to, lookLeft, 3]}
ELSE {to.PutRope[","]; SS.Bp[to, lookLeft, 3, " "]};
SS.Begin[to];
{ENABLE UNWIND => SS.End[to];
IF (pass ← (n ← n+1) > length)
THEN to.PutRope["..."]
ELSE PrintPair[elt, spaces, to, depth-1, length];
};
SS.End[to];
RETURN};
IF verbose THEN {to.PutRope[","]; SS.Bp[to, lookLeft, 3, " "]; to.PutRope["elts: "]};
[] ← br.Scan[PrintElt];
}
ELSE to.PutRope["can't enumerate"];
};
};
to.PutRope["}"];
RETURN};
ValueToTV: PROC [v: Value] RETURNS [TV] ~ TRUSTED {
SELECT TRUE FROM
v.ra=NIL => RETURN AMBridge.TVForReferent[NEW [INT ← v.i], const];
v.i=0 => RETURN AMBridge.TVForReferent[NEW [REF ANY ← v.ra], const];
ENDCASE => RETURN AMBridge.TVForReferent[NEW [Value ← v], const]};
TVToRef: PROC [tv: TV] RETURNS [ra: REF ANY] ~ TRUSTED {
ra ← AMBridge.TVToRef[tv];
SafeStoragePrivate.ValidateRef[ra];
RETURN};
TVToValue: PROC [tv: TV] RETURNS [Value] ~ TRUSTED {
atv: TV ~ AMTypes.IndexToTV[tv, 1];
itv: TV ~ AMTypes.IndexToTV[tv, 2];
RETURN [[ra: TVToRef[atv], i: AMBridge.TVToLI[itv]]]};
UnWrap: PROC [tv: TV] RETURNS [inner: TV] ~ {
inner ← tv;
DO
SELECT AMTypes.NComponents[AMTypes.TVType[inner]] FROM
1 => inner ← AMTypes.IndexToTV[inner, 1];
2 => EXIT;
ENDCASE => ERROR;
ENDLOOP;
RETURN};
Start: PROC ~ {
PrintTV.RegisterTVPrintProc[CODE[Set], SetPrint];
PrintTV.RegisterTVPrintProc[CODE[VarSet], SetPrint, $Var];
PrintTV.RegisterTVPrintProc[CODE[UWSet], SetPrint, $UW];
PrintTV.RegisterTVPrintProc[CODE[ConstSet], SetPrint, $Const];
PrintTV.RegisterTVPrintProc[CODE[BiRel], BiRelPrint];
PrintTV.RegisterTVPrintProc[CODE[VarBiRel], BiRelPrint, $Var];
PrintTV.RegisterTVPrintProc[CODE[UWBiRel], BiRelPrint, $UW];
PrintTV.RegisterTVPrintProc[CODE[ConstBiRel], BiRelPrint, $Const];
};
Start[];
END.