
<<LichenOtherTransforms.Mesa>>
    <<Last tweaked by Mike Spreitzer on August 28, 1987 11:18:00 am PDT>>

    DIRECTORY IO, LichenCollections, LichenDataOps, LichenDataStructure, LichenIntFunctions, LichenPairCollections, LichenTransforms, 
    LichenTransformsPrivate;

    LichenOtherTransforms: CEDAR PROGRAM
        IMPORTS IO, LichenCollections, LichenDataOps, LichenDataStructure, LichenIntFunctions, LichenPairCollections, LichenTransforms
        EXPORTS LichenTransforms
        =

    BEGIN OPEN LichenDataStructure, LichenTransforms, LichenDataOps, LichenTransformsPrivate, Colls:LichenCollections, 
    PCs:LichenPairCollections, IntFns:LichenIntFunctions;

    CellTypeList: TYPE ~ LIST OF CellType;

    GroupUnorganized: PUBLIC PROC
        [
            design: Design,
            mapper: ConstFunction--any 
        RETURNS [newType: CellType,
            pairs: PCs.ConstOneToOne--domain of mapper 
            gcs: Seq--role 
        ComputeName: PROC [] RETURNS [r: ROPE] ~ {
            pair: PCs.Pair ~ mapper.First[].P;
            r _ IO.PutFR["#gen%g", [integer[nGen _ nGen+1]]];
            RETURN};
        newTypeName: ROPE ~ ComputeName[];
        pairsV: PCs.OneToOne ~ PCs.CreateHashOTO[];
        Seed: PROC [pair: PCs.Pair] ~ {
            <<>>
            seq: Seq--role 
            ci0: CellInstance ~ NARROW[seq.Apply[0].val];
            ti: CellInstance ~ FullyInstantiate[newType, ci0.containingCT];
            IF NOT pairsV.Store[[pair[left], ti]] THEN ERROR;
            RETURN};
        newType _ CreateCellType[design, newTypeName, NIL, TRUE, NIL, NIL];
        mapper.Enumerate[Seed];
        pairs _ pairsV.Freeze;
        gcs _ LowerChildren[design, newType, PCs.Compose[[pairs.Invert, mapper]].AsConst];
        RETURN};
        nGen: NATURAL _ 0;

    SimpleGrouper: PROC [design: Design, cellTypes: Set--of CellType--] RETURNS [grouper: ConstFunction--any     instance of array* of cellTypes[role])--] ~ {
        roles: NATURAL ~ cellTypes.Size[];
        ctSeq: Seq--role 
        grouperV: PCs.OneToOne ~ PCs.CreateHashOTO[];
        PerCellType: PROC [ra: REF ANY] ~ {
            ct: CellType ~ NARROW[ra];
            IF ct.asUnorganized#NIL THEN {
                sibs: Seq--role 
                PerInstance: PROC [ra: REF ANY] ~ {
                    ci: CellInstance ~ NARROW[ra];
                    cit: CellType _ ci.type;
                    DO
                        mr: IntFns.MaybeInt ~ ctSeq.InvApply[cit];
                        IF mr.found THEN {
                            role: NAT ~ mr.i;
                            IF sibs.AddPair[[role, ci], PCs.addIfNew][leftToRight]#new THEN ERROR;
                            RETURN};
                        IF cit.asArray=NIL THEN EXIT;
                        cit _ cit.asArray.eltType;
                        ENDLOOP;
                    RETURN};
                ct.asUnorganized.containedInstances.Enumerate[PerInstance];
                SELECT sibs.Size[] FROM
                    0 => NULL;
                    roles => IF NOT grouperV.Store[[ct, sibs.Freeze.Refify]] THEN ERROR;
                    ENDCASE => ERROR;
                };
            RETURN};
        design.cellTypes.Enumerate[PerCellType];
        grouper _ grouperV.Freeze;
        RETURN};

    CellTypeListLength: PROC [cellTypes: CellTypeList] RETURNS [length: NATURAL] ~ {
        length _ 0;
        FOR cellTypes _ cellTypes, cellTypes.rest WHILE cellTypes # NIL DO length _ length + 1 ENDLOOP;
        RETURN};

    BaseStar: PROC [ct: CellType] RETURNS [CellType] ~ {
        WHILE ct.asArray#NIL DO ct _ ct.asArray.eltType ENDLOOP;
        RETURN [ct]};

    END.