
    <<CoreFlattenImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Spreitzer, October 2, 1985 5:03:24 pm PDT>>
        <<Barth, November 6, 1985 4:33:01 pm PST>>
        <<Bertrand Serlet November 12, 1985 2:40:37 pm PST>>

    DIRECTORY Core, CoreClasses, CoreFlatten, CoreOps, CoreProperties, IO, Rope;

    CoreFlattenImpl: CEDAR PROGRAM
        IMPORTS CoreClasses, CoreOps, CoreProperties, IO, Rope
        EXPORTS CoreFlatten =
        BEGIN OPEN Core, CoreFlatten;

    instanceSource: PUBLIC ATOM _ RegProp[$CoreFlattenInstanceSource, InstanceSourcePrint];
    wireSource: PUBLIC ATOM _ RegProp[$CoreFlattenWireSource, WireSourcePrint];

    templateToCopy: ATOM _ RegProp[$CoreFlattenTemplateToCopy, TemplateToCopyPrint];
    partPublic: ATOM _ RegProp[$CoreFlattenPartPublic, PublicWirePrint];
    allArePublic: ATOM _ RegProp[$CoreFlattenAllPublic, PublicWirePrint];

    RegProp: PROC [prop: ATOM, proc: CoreProperties.PropPrintProc] RETURNS [sameProp: ATOM] = {
        sameProp _ CoreProperties.RegisterProperty[prop, CoreProperties.Props[[CoreProperties.propPrint, NEW[CoreProperties.PropPrintProc _ 
        proc]]]];
        };

    InstanceSourcePrint: PROC [to: STREAM, prop: ATOM, val: REF ANY, depth: NAT] = {
        is: InstanceSource _ NARROW [val];
        instName: ROPE _ NARROW [CoreProperties.GetCellInstanceProp[is.instance, CoreClasses.instanceNameProp]];
        InstantiationPathPrint[to, is.instantiationPath];
        to.PutF[" %g:%g", IO.rope[instName], IO.rope[CoreOps.GetCellTypeName[is.instance.type]]];
        };

    InstantiationPathPrint: PROC [to: STREAM, instantiationPath: InstantiationPath] = {
        to.PutRope["Instantiation path:"];
        FOR ip: InstantiationPath _ instantiationPath, ip.rest UNTIL ip=NIL DO
            instName: ROPE _ NARROW [CoreProperties.GetCellInstanceProp[ip.first, CoreClasses.instanceNameProp]];
            to.PutF[" %g:%g", IO.rope[instName], IO.rope[CoreOps.GetCellTypeName[ip.first.type]]];
            ENDLOOP;
        };

    WireSourcePrint: PROC [to: STREAM, prop: ATOM, val: REF ANY, depth: NAT] = {
        ws: WireSource _ NARROW[val];
        InstantiationPathPrint[to: to, instantiationPath: ws.instantiationPath];
        IO.PutF[to, ", wire: %g", IO.rope[NARROW[CoreProperties.GetProp[from: ws.wire.properties, prop: CoreOps.publicFullName]]]];
        };

    TemplateToCopyPrint: PROC [to: STREAM, prop: ATOM, val: REF ANY, depth: NAT] = {
        wire: Wire _ NARROW[val];
        IO.PutF[to, "TemplateToCopy: %g", IO.rope[NARROW[CoreProperties.GetProp[from: wire.properties, prop: CoreOps.publicFullName]]]];
        };

    PublicWirePrint: PROC [to: STREAM, prop: ATOM, val: REF ANY, depth: NAT] = {
        IO.PutRope[to, "PublicWire: $T"];
        };


    Promotions: TYPE = REF PromotionsRec;
    PromotionsRec: TYPE = RECORD [
        count: NAT _ 0,
        wires: WireList _ NIL];

    WireList: TYPE = LIST OF Wire;

    Flatten: PUBLIC PROC [cellType: CellType, control: FlattenControl] RETURNS [flat: CellType] = {
        <<Each descendent is expanded or not, depending on what control says.>>
        oldRec, newRec: CoreClasses.RecordCellType;
        promotions: Promotions _ NEW [PromotionsRec _ []];
        Work: PROC [cl: CoreClasses.CellInstanceList, pathPrefix: InstantiationPath] = {
            flat _ flat;
            FOR cl _ cl, cl.rest WHILE cl # NIL DO
                child: CoreClasses.CellInstance _ cl.first;
                path: InstantiationPath _ CONS[child, pathPrefix];
                SELECT control.Decide[data: control.data, who: path] FROM
                    expand => {
                        childType: CellType _ Recordify[ct: child.type];
                        childRec: CoreClasses.RecordCellType _ NARROW[childType.data];
                        IF CoreOps.VisitBinding[public: childType.public, actual: child.actual, eachWirePair: CopyTemplateMarkPublic] THEN ERROR;
                        PromotePrivates[parent: flat, parentRec: newRec, child: childType, childRec: childRec, promotions: promotions, path: path];
                        Work[childRec.instances, path];
                        child _ child;
                        };
                    leaf => {
                        newChild: CoreClasses.CellInstance _ CopyInstance[old: child, path: pathPrefix];
                        newRec.instances _ CONS[newChild, newRec.instances];
                        };
                    ENDCASE => ERROR;
                child _ child;
                ENDLOOP;
            flat _ flat;
            };
        cellType _ Recordify[cellType];
        IF cellType.class # CoreClasses.recordCellClass THEN RETURN [cellType];
        [oldRec, newRec, flat] _ CopyCellType[cellType];
        Work[cl: oldRec.instances, pathPrefix: NIL];
        IF promotions.count # 0 THEN {
            oldIW: WireSequence _ newRec.internal;
            newIW: WireSequence _ NEW [WireSequenceRec[oldIW.size + promotions.count]];
            i: NAT _ 0;
            IF oldIW=NIL THEN ERROR;
            THROUGH [0 .. oldIW.size) DO
                newIW[i] _ oldIW[i];
                i _ i + 1;
                ENDLOOP;
            FOR wl: WireList _ promotions.wires, wl.rest WHILE wl # NIL DO
                newIW[i] _ wl.first;
                i _ i + 1;
                ENDLOOP;
            IF i # (oldIW.size + promotions.count) THEN ERROR;
            newRec.internal _ newIW;
            };
        };

    CopyTemplateMarkPublic: PROC [actualWire, publicWire: Wire] RETURNS [subWires: BOOL _ TRUE, quit: BOOL _ FALSE] = {
        template: REF ANY _ CoreProperties.GetWireProp[from: actualWire, prop: templateToCopy];
        IF template#NIL THEN CoreProperties.PutWireProp[on: publicWire, prop: templateToCopy, value: template];
        CoreProperties.PutWireProp[on: publicWire, prop: allArePublic, value: $T];
        };

    Recordify: PROC [ct: CellType] RETURNS [rct: CellType] = {
        FOR
            rct _ ct, CoreOps.Recast[rct]
            UNTIL rct.class.recast = NIL
                <<rct.class.recast = NIL exactly when rct is a record or atomic.>>
            DO NULL ENDLOOP;
        rct _ rct
        };

    CopyCellType: PROC [old: CellType] RETURNS [oldRec, newRec: CoreClasses.RecordCellType, new: CellType] = {
        oldRec _ NARROW [old.data];
        newRec _ NEW [CoreClasses.RecordCellTypeRec _ [
            internal: CoreOps.CopyWireSequence[oldRec.internal],
            instances: NIL]];
        FOR i: NAT IN [0 .. newRec.internal.size) DO
            NoteWireSource[newWire: newRec.internal[i], source: [instantiationPath: NIL, wire: oldRec.internal[i], instance: NIL], recursively: 
            TRUE];
            AssocWire[key: templateToCopy, from: oldRec.internal[i], to: newRec.internal[i]];
            ENDLOOP;
        new _ CoreOps.CreateCellType[
            class: old.class,
            public: DuplicatePublicWireSequence[old.public],
            data: newRec,
            props: CoreProperties.CopyProps[old.properties]
            ];
        new _ new
        };

    AssocWire: PROC [key: ATOM, from, to: Wire] = {
        from.properties _ CoreProperties.PutProp[on: from.properties, prop: key, value: to];
        IF from.elements # NIL THEN {
            FOR i: INT IN [0 .. from.elements.size) DO
                AssocWire[key, from.elements[i], to.elements[i]];
                ENDLOOP;
            key _ key
            };
        };

    GetWireAssoc: PROC [key: ATOM, from: Wire] RETURNS [to: Wire] =
        {to _ NARROW[CoreProperties.GetProp[from: from.properties, prop: key]]};

    DuplicatePublicWire: PROC [oldPublicWire: Wire] RETURNS [newPublicWire: Wire] = {
        newPublicWire _ GetWireAssoc[key: templateToCopy, from: oldPublicWire];
        IF newPublicWire # NIL --means this is part of internal-- THEN RETURN;
        newPublicWire _ NEW [WireRec _ [
            properties: CoreProperties.CopyProps[propList: oldPublicWire.properties]
            ]];
        NoteWireSource[newWire: newPublicWire, source: [instantiationPath: NIL, wire: oldPublicWire, instance: NIL], recursively: FALSE];
        IF oldPublicWire.elements # NIL THEN newPublicWire.elements _ DuplicatePublicWireSequence[oldPublicWire.elements];
        };

    DuplicatePublicWireSequence: PROC [oldPublicWire: WireSequence] RETURNS [newPublicWire: WireSequence] = {
        newPublicWire _ NEW [WireSequenceRec[oldPublicWire.size]];
        FOR i: INT IN [0 .. oldPublicWire.size) DO
            newPublicWire[i] _ DuplicatePublicWire[oldPublicWire[i]];
            ENDLOOP;
        };

    PromotePrivates: PROC [parent: CellType, parentRec: CoreClasses.RecordCellType, child: CellType, childRec: 
    CoreClasses.RecordCellType, promotions: Promotions, path: InstantiationPath] = {
        FindPublicSequence: PROC [childsInternal: WireSequence] RETURNS [somePublic: BOOL] = {
            FOR i: NAT IN [0 .. childsInternal.size) DO
                subWire: Wire _ childsInternal[i];
                subSomePublic: BOOL _ FindPublic[subWire];
                somePublic _ somePublic OR subSomePublic;
                ENDLOOP;
            };
        FindPublic: PROC [childsInternal: Wire] RETURNS [somePublic: BOOL] = {
            somePublic _ CoreProperties.GetWireProp[from: childsInternal, prop: allArePublic] = $T;
            IF (NOT somePublic) AND childsInternal.elements # NIL THEN {
                somePublic _ FindPublicSequence[childsInternal.elements];
                child _ child;
                };
            IF somePublic THEN childsInternal.properties _ CoreProperties.PutProp[on: childsInternal.properties, prop: partPublic, value: $T];
            };
        DoForPrivateCoverSequence: PROC [childsInternal: WireSequence] = {
            FOR i: NAT IN [0 .. childsInternal.size) DO
                DoForPrivateCover[childsInternal[i]];
                ENDLOOP;
            };
        DoForPrivateCover: PROC [childsInternal: Wire] = {
            allPublic: BOOL _ CoreProperties.GetWireProp[from: childsInternal, prop: allArePublic] = $T;
            somePublic: BOOL _ allPublic OR (CoreProperties.GetProp[from: childsInternal.properties, prop: partPublic] = $T);
            IF NOT somePublic THEN {
                new: Wire _ CoreOps.CopyWire[childsInternal];
                NoteWireSource[newWire: new, source: [path, childsInternal, NIL], recursively: TRUE];
                AssocWire[key: templateToCopy, from: childsInternal, to: new];
                promotions.count _ promotions.count + 1;
                promotions.wires _ CONS[new, promotions.wires];
                }
            ELSE IF NOT allPublic THEN DoForPrivateCoverSequence[childsInternal.elements];
            };
        [] _ FindPublicSequence[childRec.internal];
        DoForPrivateCoverSequence[childRec.internal];
        };

    CopyInstance: PROC [old: CoreClasses.CellInstance, path: InstantiationPath] RETURNS [new: CoreClasses.CellInstance] = {
        CopyActualSequence: PROC [oldWire: WireSequence] RETURNS [new: WireSequence] = {
            new _ NEW [WireSequenceRec[oldWire.size]];
            FOR i: INT IN [0 .. oldWire.size) DO
                new[i] _ CopyActual[oldWire[i]];
                ENDLOOP;
            };
        CopyActual: PROC [oldWire: Wire] RETURNS [new: Wire] = {
            new _ GetWireAssoc[templateToCopy, oldWire];
            IF new # NIL THEN RETURN;
            new _ NEW [WireRec _ [
                properties: CoreProperties.CopyProps[oldWire.properties]
                ]];
            NoteWireSource[new, [path, oldWire, old], FALSE];
            IF oldWire.elements = NIL THEN ERROR --this recursion must ground out in a piece of already copied template--;
            new.elements _ CopyActualSequence[oldWire.elements];
            new _ new;
            };
        new _ NEW [CoreClasses.CellInstanceRec _ [
            actual: CopyActualSequence[old.actual],
            type: old.type,
            properties: CoreProperties.CopyProps[old.properties]
            ]];
        new.properties _ CoreProperties.PutProp[on: new.properties, prop: instanceSource, value: NEW[InstanceSourceRec _ [path, old]]];
        };

    NoteWireSource: PROC [newWire: Wire, source: WireSourceRec, recursively: BOOL] = {
        newWire.properties _ CoreProperties.PutProp[on: newWire.properties, prop: wireSource, value: NEW [WireSourceRec _ source] ];
        IF recursively AND newWire.elements # NIL THEN {
            FOR i: NAT IN [0 .. newWire.elements.size) DO
                NoteWireSource[newWire.elements[i], [source.instantiationPath, source.wire.elements[i], source.instance], recursively];
                ENDLOOP;
            newWire _ newWire;
            };
        };

    ExpandNonPrimitive: PUBLIC FlattenControl _ NEW[FlattenControlRec _ [Decide: NonPrimitiveDecide, data: NIL]];

    NonPrimitiveDecide: PROC [data: REF ANY, who: InstantiationPath] RETURNS [ExpandDecision] = {
        IF who.first.type.class=CoreClasses.transistorCellClass THEN RETURN [leaf] ELSE RETURN[expand];
        };

    ControlByCutSet: PUBLIC PROC [cutSetName: ROPE] RETURNS [control: FlattenControl] = {
        control _ NEW [FlattenControlRec _ [Decide: DecideByCutSet, data: cutSetName]];
        };

    CoreFlattenCutSets: PUBLIC ATOM _ CoreProperties.RegisterProperty[prop: $CoreFlattenCutSets];

    DecideByCutSet: PROC [data: REF ANY, who: InstantiationPath] RETURNS [ExpandDecision] = {
        cutSetName: ROPE;
        cutSets: LIST OF REF;
        IF who.first.type.class=CoreClasses.transistorCellClass THEN RETURN [leaf];
        IF Rope.Equal[CoreOps.GetCellTypeName[who.first.type], "DataBuffer"] THEN {
            cutSetName _ NARROW[data];
            };
        cutSetName _ NARROW[data];
        cutSets _ NARROW[CoreProperties.GetCellInstanceProp[from: who.first, prop: CoreFlattenCutSets]];
        IF cutSets=NIL THEN cutSets _ NARROW[CoreProperties.GetCellTypeProp[from: who.first.type, prop: CoreFlattenCutSets]];
        IF cutSets=NIL THEN RETURN[expand];
        FOR csl: LIST OF REF _ cutSets, csl.rest UNTIL csl=NIL DO
            IF Rope.Equal[FixStupidRef[csl.first], cutSetName] THEN RETURN[leaf];
            ENDLOOP;
        RETURN[expand];
        };

    FixStupidRef: PROC [ref: REF ANY] RETURNS [rope: ROPE] = {
        rope _ WITH ref SELECT FROM
            r: REF TEXT => Rope.FromRefText[r],
            r: ROPE => r,
            ENDCASE => ERROR;
        };

    ControlByRecognition: PUBLIC PROC [rl: RecognitionList] RETURNS [control: FlattenControl] = {
        control _ NEW [FlattenControlRec _ [Decide: DecideByRecognition, data: rl]];
        };

    DecideByRecognition: PROC [data: REF ANY, who: InstantiationPath] RETURNS [ExpandDecision] = {
        rl: RecognitionList _ NARROW[data];
        shallowest: CoreClasses.CellInstance _ GetShallowest[who];
        FOR rl _ rl, rl.rest WHILE rl # NIL DO
            IF rl.first.recognizer.Recognize[rl.first.recognizer.data, shallowest]
                THEN WITH rl.first SELECT FROM
                    i: Recognition.immediate => RETURN [i.decision];
                    n: Recognition.nest => {
                        subPath: InstantiationPath _ AllButShallowest[who];
                        decision: ExpandDecision _ n.subControl.Decide[n.subControl.data, subPath];
                        RETURN [decision];
                        };
                    ENDCASE => ERROR;
            ENDLOOP;
        ERROR;
        };

    GetShallowest: PUBLIC PROC [path: InstantiationPath] RETURNS [shallowest: CoreClasses.CellInstance] = {
        FOR path _ path, path.rest WHILE path # NIL DO shallowest _ path.first ENDLOOP;
        };

    AllButShallowest: PUBLIC PROC [path: InstantiationPath] RETURNS [allBut: InstantiationPath] = {
        first, last: InstantiationPath _ NIL;
        FOR path _ path, path.rest WHILE path.rest # NIL DO
            this: InstantiationPath _ LIST[path.first];
            IF last # NIL THEN last.rest _ this ELSE first _ this;
            last _ this;
            ENDLOOP;
        allBut _ first;
        };

    RecognizeName: PUBLIC PROC [name: ROPE] RETURNS [r: Recognizer] = {
        r _ NEW [RecognizerRec _ [DoRecognizeName, name]];
        };

    DoRecognizeName: PROC [data: REF ANY, ci: CoreClasses.CellInstance] RETURNS [IRecognizeYou: BOOL] = {
        ciName: ROPE = NARROW [CoreProperties.GetCellInstanceProp[ci, CoreClasses.instanceNameProp]];
        name: ROPE = NARROW [data];
        IRecognizeYou _ name.Equal[ciName];
        };

END.