NewSetsPrinting.Mesa
Last tweaked by Mike Spreitzer on December 12, 1987 4:57:42 pm PST
DIRECTORY AMBridge, AMTypes, BiRels, IntStuff, IO, PrintTV, Process, Rope, SetBasics, AbSets, StructuredStreams;
NewSetsPrinting:
CEDAR
PROGRAM
IMPORTS AMBridge, AMTypes, BiRels, IntStuff, IO, PrintTV, Process, Rope, AbSets, StructuredStreams
=
BEGIN OPEN IntStuff, 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."];
PrintSet:
PROC [tv:
TV, data:
REF
ANY, stream:
IO.
STREAM, depth:
INT ← 4, width:
INT ← 32, verbose:
BOOL ←
FALSE]
RETURNS [useOld:
BOOL ←
FALSE]
--PrintTV.TVPrintProc-- ~
TRUSTED {
OPEN Sets;
setTV: TV ~ UnWrap[tv];
classTV: TV ~ AMTypes.IndexToTV[setTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[setTV, 2];
set: Set ~ [NARROW[AMBridge.TVToRef[classTV]], TVToValue[dataTV]];
IF set.class=
NIL
THEN {
stream.PutRope[
IF set.data#nilSet.data
THEN "{broken set}"
ELSE
SELECT data
FROM
NIL => "AbSets.nilSet",
$Var => "AbSets.nilVarSet",
$UW => "AbSets.nilUWSet",
$Const => "AbSets.nilConstSet",
ENDCASE => ERROR];
RETURN};
stream.PutRope["{"];
{ENABLE Cant => {stream.PutRope[" -- set printing fumbled"]; CONTINUE};
canFilter: BOOL ~ set.QualityOf[$HasMember] >= goodDefault;
canScan: BOOL ~ set.QualityOf[$Scan] >= goodDefault;
stream.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 verbose
OR 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 {
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["size="];
stream.PutRope[size.ToRope];
};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope[Rope.Cat["space=", space.name]];
IF canScan
AND depth >= 3
THEN {
first: BOOL ← TRUE;
n: LNAT ← 0;
PrintElt:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~
TRUSTED {
eltTV: TV ~ ValueToTV[val];
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-1, width: width];
};
SS.End[stream];
RETURN};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["elts: "];
[] ← set.Scan[PrintElt];
};
};
};
stream.PutRope["}"];
RETURN};
PrintBiRel:
PROC [tv:
TV, data:
REF
ANY, stream:
IO.
STREAM, depth:
INT ← 4, width:
INT ← 32, verbose:
BOOL ←
FALSE]
RETURNS [useOld:
BOOL ←
FALSE]
--PrintTV.TVPrintProc-- ~
TRUSTED {
biRelTV: TV ~ UnWrap[tv];
classTV: TV ~ AMTypes.IndexToTV[biRelTV, 1];
dataTV: TV ~ AMTypes.IndexToTV[biRelTV, 2];
br: BiRel ~ [NARROW[AMBridge.TVToRef[classTV]], NARROW[AMBridge.TVToRef[dataTV]]];
IF br.class=
NIL
THEN {
stream.PutRope[
IF br.data#nilBiRel.data
THEN "{broken BiRel}"
ELSE
SELECT data
FROM
NIL => "BiRels.nilBiRel",
$Var => "[BiRels.nilBiRel]",
$UW => "[BiRels.nilBiRel]",
$Const => "[[BiRels.nilBiRel]]",
ENDCASE => ERROR];
RETURN};
stream.PutRope["{"];
{ENABLE Cant => {stream.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";
stream.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 verbose
OR 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 {
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["size="];
stream.PutRope[size.ToRope];
};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope[Rope.Cat["spaces=[", spaces[left].name, ", ", spaces[right].name, "]"]];
IF canScan
AND depth >= 3
THEN {
first: BOOL ← TRUE;
n: LNAT ← 0;
PrintElt:
PROC [elt: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~
TRUSTED {
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: ValueToTV[elt[left]], put: stream, depth: depth-2, width: width];
stream.PutRope[" *"];
SS.Bp[stream, lookLeft, 3, " "];
PrintTV.Print[tv: ValueToTV[elt[right]], put: stream, depth: depth-2, width: width];
};
};
SS.End[stream];
RETURN};
stream.PutRope[","];
SS.Bp[stream, lookLeft, 3, " "];
stream.PutRope["elts: "];
[] ← br.Scan[PrintElt];
};
};
};
stream.PutRope["}"];
RETURN};
ValueToTV:
PROC [v: Value]
RETURNS [
TV] ~
TRUSTED {
WITH v
SELECT
FROM
x: RefAnyValue => RETURN AMBridge.TVForReferent[NEW [REF ANY ← x.a], const];
x: IntValue => RETURN AMBridge.TVForReferent[NEW [INT ← x.i], const];
x: NotAValue => ERROR;
ENDCASE => ERROR};
TVToValue:
PROC [tv:
TV]
RETURNS [Value] ~
TRUSTED {
union: TV ~ AMTypes.IndexToTV[tv, 1];
tag: TV ~ AMTypes.Tag[union];
bound: TV ~ AMTypes.Variant[union];
it: TV ~ AMTypes.IndexToTV[bound, 1];
SELECT AMBridge.TVToCardinal[tag]
FROM
ORD[SetBasics.ValueKind[no]] => RETURN [[no[AMBridge.TVToLI[it]]]];
ORD[SetBasics.ValueKind[a]] => RETURN [[a[AMBridge.TVToRef[it]]]];
ORD[SetBasics.ValueKind[i]] => RETURN [[i[AMBridge.TVToLI[it]]]];
ENDCASE => ERROR;
};
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], PrintSet];
PrintTV.RegisterTVPrintProc[CODE[VarSet], PrintSet, $Var];
PrintTV.RegisterTVPrintProc[CODE[UWSet], PrintSet, $UW];
PrintTV.RegisterTVPrintProc[CODE[ConstSet], PrintSet, $Const];
PrintTV.RegisterTVPrintProc[CODE[BiRel], PrintBiRel];
PrintTV.RegisterTVPrintProc[CODE[VarBiRel], PrintBiRel, $Var];
PrintTV.RegisterTVPrintProc[CODE[UWBiRel], PrintBiRel, $UW];
PrintTV.RegisterTVPrintProc[CODE[ConstBiRel], PrintBiRel, $Const];
};
Start[];
END.