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: 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};

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.
ZSetPrinting.Mesa
Last tweaked by Mike Spreitzer on November 17, 1987 4:58:46 pm PST
Κ–

"cedar" style˜
codeš
œ™Kš
œB™B—K˜KšΟk	œœh˜‡
K˜šΟnœœ
˜Kšœœ]˜zK˜
—K˜Kšœ
œ
žœž	œžœžœœ˜rK˜Kšœœœ
˜Kšœœœ
˜Kšœœ˜K˜šžœœœ
œ˜2K˜K˜K˜—K˜šžœœœ
œ˜2K˜K˜K˜—K˜š žœœœœ
œ
œ
œ	œ
œœœœ
œœΟcœœ˜»
Kšœ˜Kšœœ˜Kšœ	œ ˜+Kšœœ ˜*Kšœœœ˜Yšœœ
œ˜Kš	œœœ
œœ˜KKšœ˜—K˜Kšœ
œ=œ˜NKšœœ-˜<Kš	œ	œœœœ˜xKšœ	œœ
˜,Kš
œ-˜-˜Kš
œ#˜#K˜,šœœ
˜šœ
œ˜Kšœ
œ	œœ
˜,Kšœ	˜
—šœ
œ˜Kšœ
œ	œœ
˜7Kšœ
˜———šœ	œœ˜Kšœ	œ(˜5Kš
œœœ	œ
œ
œ
œ
˜6K˜šœ	œ˜K˜Kšœ˜ Kš
œ(˜(Kš
œ˜—K˜Kšœ˜ Kš
œ5˜5šœ	œœ˜ Kšœœœ
˜Kšœœ˜šžœœœœœœ˜DKšœœœ˜=Kš
œ˜šœ˜Kšœ
œœ˜0Kšœœ˜<—Kšœ˜Kšœ
œ
œœ
˜!šœ˜Kšœ˜KšœE˜I—Kš
œ˜Kšœ
˜Kšœ˜—K˜Kšœ˜ K˜K˜K˜—K˜—Kš
œ˜K˜Kšœ˜—K˜š ž
œœœœ
œ
œ
œ	œ
œœœœ
œœŸœœ˜Ή
Kšœ˜Kšœœ˜Kšœ	œ ˜+Kšœœ ˜*Kšœœœ˜Wšœœ
œ˜Kš	œœœ
œœ˜TKšœ˜—K˜Kšœ
œBœ˜SKšœœ+˜:Kš	œ	œœœœ˜xKšœ	œœ
˜,K˜'Kš
œ-˜-šœœœ˜'Kšœ
œœ
œ˜@Kšœ
œœœ˜D—˜Kš
œ#˜#K˜,šœœ
˜šœ
œ˜Kšœ
œ	œœ˜=Kšœ˜—šœ
œ˜Kšœ
œ	œœ˜CKšœ˜———šœ	œœ˜Kšœ	œ(˜5Kš
œœœ	œ
œ
œ
œ
˜6K˜"šœ	œ˜K˜Kšœ˜ Kš
œ(˜(Kš
œ˜—K˜Kšœ˜ Kš
œc˜cšœ	œœ˜ Kšœœœ
˜Kšœœ˜šžœœ
œœœœ˜CKšœœœ˜<šœ˜Kšœ
œœ˜0Kšœœ˜<—Kšœ˜Kšœ
œ
œœ
˜!šœ˜Kšœ˜KšœE˜I—Kš
œ˜Kšœ
˜Kšœ˜—K˜Kšœ˜ K˜K˜K˜—K˜—Kš
œ˜K˜Kšœ˜—K˜š ž
œœœœ
œ
œ
œ	œ
œœœœ
œœŸœœ˜Ά
Kšœ ˜$Kšœœ˜Kšœ	œ ˜+Kšœœ ˜*Kšœœœ˜Tšœœ
œ˜Kš	œœœ
œœ˜HKšœ˜—K˜Kšœ
œ?œ˜PKšœœ+˜:Kš	œ	œœ7œœ6˜΄
Kšœ
œ+˜9Kš	œœœœ
œ˜AKš
œ+˜+˜Kšœœœœ˜8Kš
œ#˜#Kš	œœœœœ˜SKšœœœ
œ˜4šœœ
˜šœ
œ˜Kšœ˜	Kšœ˜—šœ
œ˜Kšœ˜Kšœ˜———šœ
œ˜K˜$K˜H—šœ	œœ˜Kšœ	œ(˜5Kš
œœœ	œ
œ
œ
œ
˜6K˜š
œ	œ
œœœ˜;K˜Kšœ˜ Kš
œ(˜(Kš
œ˜—K˜Kšœ˜ Kš
œ:˜:šœ	œœ˜ Kšœœœ
˜Kšœœ˜Kšœœœ
œ
˜šžœœœœœœ˜EKšœœœ˜Cšœ˜Kšœ
œœ˜0Kšœœ˜<—Kšœ˜Kšœ
œ
œœ
˜!šœ˜Kšœ˜šœ˜Kšœœ
œ
œœ
œ*˜UKš
œD˜DK˜K˜——Kš
œ˜Kšœ
˜Kšœ˜—K˜Kšœ˜ K˜K˜K˜—K˜—Kš
œ˜K˜Kšœ˜—K˜šž	œœœœ˜=Kšœœ
œ
œ
˜%šœœ,œ
˜BKšœœ˜
Kšœœ
œ
œ˜,Kšœ˜—Kšœ˜—K˜š
žœœœœ
œ˜.K˜š
˜šœ-˜7Kš
œ+˜+Kšœœ
˜
Kšœœ
˜—Kšœ
˜—Kšœ˜—K˜šžœœ˜Kšœœ%˜EKšœœ(˜HKšœœ&˜FKšœœ,˜LKšœœ%˜EKšœœ.˜NKšœœ,˜LKšœœ2˜RKšœœ˜<Kšœœ%˜EKšœœ#˜CKšœœ)˜IK˜—K˜K˜K˜Kšœ
˜—…—&2‰