-- Hack.mesa
-- Last Modified On December 16, 1983 11:22 am By Paul Rovner
DIRECTORY
AMTypes USING[TypeClass, Class, Error],
IO USING[STREAM, int, char, PutRope, Put],
PrintTV USING[PrintType],
RTTypesBasicPrivate USING[GetLastTypeIndex, MapTiTd],
SafeStorage USING[GetCanonicalType, Type],
ViewerIO USING[CreateViewerStreams],
Set USING[Handle, New, In, Put, Nth, Cardinality];

Hack: PROGRAM
IMPORTS AMTypes, IO, PrintTV, RTTypesBasicPrivate, SafeStorage, Set, ViewerIO
= {
DoIt: PROC[showTypeNames: BOOL ← FALSE] =
{ UCA: TYPE = ARRAY [1..10000] OF REF CARDINAL;
cTypeList: LIST OF Set.Handle ← NIL;
uniqueCardinals: REF UCA ← NEW[UCA];
out: IO.STREAM = ViewerIO.CreateViewerStreams["Hack Output"].out;

FOR i: CARDINAL IN [1..10000] DO uniqueCardinals[i] ← NEW[CARDINAL ← i] ENDLOOP;
FOR i: CARDINAL IN [7..RTTypesBasicPrivate.GetLastTypeIndex[]] -- for each type
DO ct: REF CARDINAL = uniqueCardinals[SafeStorage.GetCanonicalType[LOOPHOLE[i]]];
set: Set.Handle;
found: BOOLEAN ← FALSE;

FOR l: LIST OF Set.Handle ← cTypeList, l.rest UNTIL l = NIL
DO IF Set.In[l.first, ct]
THEN {[] ← Set.Put[l.first, uniqueCardinals[i]];
found ← TRUE;
EXIT};
ENDLOOP;

IF NOT found
THEN-- here if canonical type has not been seen yet
{set ← Set.New[];
[] ← Set.Put[set, ct];
[] ← Set.Put[set, uniqueCardinals[i]];
cTypeList ← CONS[set, cTypeList]};
ENDLOOP;
out.PutRope["The set of Type equivalence classes: \n"];
FOR l: LIST OF Set.Handle ← cTypeList, l.rest UNTIL l = NIL
DO typeNotPrinted: BOOL ← TRUE;
finalized: BOOL ← FALSE;
cardinality: LONG CARDINAL ← l.first.Cardinality[];
inconsistentFinalization: BOOL ← FALSE;
nPackageRefs: NAT ← 0;
out.PutRope["{ "];
FOR i: LONG CARDINAL IN [1..cardinality]
DO type: SafeStorage.Type = [NARROW[Set.Nth[l.first, i], REF CARDINAL]^];
class: AMTypes.Class ← nil;
IF showTypeNames THEN class ← AMTypes.TypeClass[type ! ANY => CONTINUE];
IF RTTypesBasicPrivate.MapTiTd[type].numberPackageRefs > 0
THEN {IF finalized
AND RTTypesBasicPrivate.MapTiTd[type].numberPackageRefs # nPackageRefs
THEN inconsistentFinalization ← TRUE
ELSE {finalized ← TRUE;
nPackageRefs ← RTTypesBasicPrivate.MapTiTd[type].numberPackageRefs}};
out.Put[IO.int[type], IO.char[' ]];
IF showTypeNames AND class = definition AND typeNotPrinted
THEN {typeNotPrinted ← FALSE;
out.Put[IO.char['[]];
PrintTV.PrintType[ [NARROW[Set.Nth[l.first, 1], REF CARDINAL]^], out
! AMTypes.Error => CONTINUE];
out.Put[IO.char[']]];
out.Put[IO.char[' ]];
};
ENDLOOP;
IF inconsistentFinalization THEN out.PutRope[" INCONSISTENTFINALIZATION"];
IF finalized
THEN {out.PutRope[" FINALIZED ("];
out.Put[IO.int[nPackageRefs], IO.char[')]]};
out.PutRope["}\n"];
ENDLOOP;
};
}.