DIRECTORY AbSets, AMBridge, AMTypes, BiRels, IntStuff, IO, PrintTV, Process, Rope, SafeStoragePrivate, SetBasics, StructuredStreams; NewSetsPrinting: CEDAR PROGRAM IMPORTS AbSets, AMBridge, AMTypes, BiRels, IntStuff, IO, PrintTV, Process, Rope, SafeStoragePrivate, 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-- ~ { 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]]; 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] ~ CHECKED { 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-- ~ { biRelTV: TV ~ UnWrap[tv]; classTV: TV ~ AMTypes.IndexToTV[biRelTV, 1]; dataTV: TV ~ AMTypes.IndexToTV[biRelTV, 2]; br: BiRel ~ [NARROW[TVToRef[classTV]], NARROW[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] ~ CHECKED { 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 { 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], 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. ^NewSetsPrinting.Mesa Last tweaked by Mike Spreitzer on December 21, 1987 3:52:23 pm PST สt– "cedar" style˜codešœ™KšœB™B—K˜Kšฯk œ.œK˜„K˜šฯnœœ˜Kšœ.œ?˜vK˜—K˜Kšœœžœœ˜PK˜Kšœœœ˜Kšœœ œ˜Kšœœ˜K˜šžœœ œœ˜,K˜K˜K˜—K˜šžœœœœœ œœ œ œœœœ œœฯcœ˜ฌKšœ˜ Kšœœ˜Kšœ œ˜*Kšœœ˜)Kšœ œ'˜9šœ œœ˜š œœœœœ˜PKšœ˜K˜K˜K˜Kšœ˜—Kšœ˜—K˜Kšœœ6œ˜GKšœ œ,˜;Kšœ œ'˜4˜K˜+šœœ ˜šœœ˜Kšœ˜ Kšœ ˜ —šœœ˜Kšœ ˜Kšœ ˜———šœ œ œ˜Kšœ œ'˜4Kš œœœ œ œ ˜6K˜šœ œ˜K˜Kšœ˜ K˜Kšœ˜Kšœ˜—K˜Kšœ˜ Kšœ/˜/šœ œ œ˜ 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šœ œœ˜@šœ œœ˜š œœœœœ˜SKšœ˜Kšœ˜Kšœ˜Kšœ ˜ Kšœœ˜—Kšœ˜—K˜KšœœBœ˜SKšœ œ)˜8Kšœ œ&˜3K˜%šœœœ˜'Kšœœœ œ ˜@Kšœœœœ ˜D—˜K˜*K˜ šœœ ˜šœœ˜Kšœ˜Kšœ ˜—šœœ˜Kšœ˜Kšœ˜———šœ œ œ˜Kšœ œ&˜3Kš œœœ œ œ ˜5K˜ šœ œ˜K˜Kšœ˜ K˜Kšœ˜Kšœ˜—K˜Kšœ˜ KšœW˜Wšœ œ œ˜ Kšœœœ˜Kšœœ˜ š žœœ œœœœ˜Cšœ˜Kšœ œœ˜0Kšœœ˜<—Kšœ˜Kšœœœœ ˜!šœ˜Kšœ˜šœ˜KšœS˜SK˜Kšœ˜ KšœT˜TKšœ˜——Kšœ˜Kšœ ˜Kšœ˜—K˜Kšœ˜ K˜K˜K˜—K˜—Kšœ˜K˜Kšœ˜—K˜š ž œœ œœœ˜3šœœ˜Kš œœœœœ˜BKš œ œœœœ˜DKšœœœ˜B——K˜šžœœœœœœœ˜8Kšœ˜Kšœ#˜#Kšœ˜—K˜š ž œœœœ œ˜4Kšœœ˜#Kšœœ˜#Kšœ0˜6—K˜š žœœœœ œ˜-K˜ š˜šœ,˜6Kšœ)˜)Kšœœ˜ Kšœœ˜—Kšœ˜—Kšœ˜—K˜šžœœ˜Kšœœ˜1Kšœœ˜:Kšœœ˜8Kšœœ˜>Kšœœ˜5Kšœœ˜>Kšœœ˜