SetPrinting.Mesa
Last tweaked by Mike Spreitzer on July 28, 1987 3:32:15 pm PDT
DIRECTORY AMBridge, AMTypes, IO, Collections, IntFunctions, IntStuff, PairCollections, List, PrintTV, Process, Rope, StructuredStreams;
SetPrinting:
CEDAR
PROGRAM
IMPORTS AMBridge, AMTypes, IO, Collections, IntFunctions, IntStuff, 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:
BOOL ←
FALSE]
RETURNS [useOld:
BOOL ←
FALSE]
--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: BOOL ← TRUE;
n: LNAT ← 0;
PrintElt:
PROC [val: Value]
RETURNS [pass:
BOOL ←
FALSE] ~
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:
BOOL ←
FALSE]
RETURNS [useOld:
BOOL ←
FALSE]
--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: BOOL ← TRUE;
n: LNAT ← 0;
PrintElt:
PROC [elt: Pair]
RETURNS [pass:
BOOL ←
FALSE] ~
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:
BOOL ←
FALSE]
RETURNS [useOld:
BOOL ←
FALSE]
--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: BOOL ← TRUE;
n: LNAT ← 0;
prev: INT ← INT.LAST;
PrintElt:
PROC [elt: IVPair]
RETURNS [pass:
BOOL ←
FALSE] ~
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};
PrintEINT:
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 {
refEINT: REF Ints.EINT ~ NEW [Ints.EINT];
refTV: TV ~ AMBridge.TVForReferent[refEINT];
AMTypes.Assign[lhs: refTV, rhs: tv];
stream.PutRope[refEINT^.ToRope];
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];
PrintTV.RegisterTVPrintProc[CODE[Ints.EINT], PrintEINT];
};
Start[];
END.