
    <<CoreFlattenImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Spreitzer, October 2, 1985 5:03:24 pm PDT>>
        <<Barth, October 2, 1985 10:36:40 am PDT>>
        <<Bertrand Serlet October 2, 1985 12:26:07 pm PDT>>

    DIRECTORY Core, CoreFlatten, CoreOps, CoreProperties, CoreRecord, CoreTransistor, IO, Rope;

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

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

    formalToActual: ATOM _ RegProp[$CoreFlattenFormalToActual, FormalToActualPrint];
    templateToCopy: ATOM _ RegProp[$CoreFlattenTemplateToCopy, TemplateToCopyPrint];
    partPublic: ATOM _ RegProp[$CoreFlattenPartPublic, PublicWirePrint];

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

    Start: PROC  = {
        };

    InstanceSourcePrint: PROC [to: STREAM, prop: ATOM, val: REF ANY, depth: NAT] = {
        is: InstanceSource _ NARROW[val];
        InstantiationPathPrint[to, is.instantiationPath];
        to.PutF[" %g:%g", IO.rope[is.instance.name], IO.rope[is.instance.type.name]];
        };

    InstantiationPathPrint: PROC [to: STREAM, instantiationPath: InstantiationPath] = {
        to.PutRope["Instantiation path:"];
        FOR ip: InstantiationPath _ instantiationPath, ip.rest UNTIL ip=NIL DO
            to.PutF[" %g:%g", IO.rope[ip.first.name], IO.rope[ip.first.type.name]];
            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.publicWireFullName]]]];
        };

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

    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.publicWireFullName]]]];
        };

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

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

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

    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: RecordCellType;
        promotions: Promotions _ NEW [PromotionsRec _ []];
        Work: PROC [cl: CellInstanceList, pathPrefix: InstantiationPath] = {
            flat _ flat;
            FOR cl _ cl, cl.rest WHILE cl # NIL DO
                child: 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: RecordCellType _ NARROW[childType.data];
                        AssocWire[key: formalToActual, from: child.type.publicWire, to: child.actualWire];
                        PromotePrivates[parent: flat, parentRec: newRec, child: childType, childRec: childRec, promotions: promotions, path: path];
                        Work[childRec.instances, path];
                        child _ child;
                        };
                    leaf => {
                        newChild: 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 # recordCellClass THEN RETURN [cellType];
        [oldRec, newRec, flat] _ CopyCellType[cellType];
        Work[cl: oldRec.instances, pathPrefix: NIL];
        IF promotions.count # 0 THEN {
            oldIW: Wire _ newRec.internalWire;
            newIW: Wire _ NEW [WireRec _ [
                name: NIL,
                structure: record,
                elements: NEW [WireSequenceRec[oldIW.elements.size + promotions.count]],
                properties: oldIW.properties
                ]];
            i: NAT _ 0;
            IF oldIW.structure # record THEN ERROR;
            THROUGH [0 .. oldIW.elements.size) DO
                newIW.elements[i] _ oldIW.elements[i];
                i _ i + 1;
                ENDLOOP;
            FOR wl: WireList _ promotions.wires, wl.rest WHILE wl # NIL DO
                newIW.elements[i] _ wl.first;
                i _ i + 1;
                ENDLOOP;
            IF i # (oldIW.elements.size + promotions.count) THEN ERROR;
            newRec.internalWire _ newIW;
            };
        };

    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: RecordCellType, new: CellType] = {
        oldRec _ NARROW[old.data];
        newRec _ NEW [RecordCellTypeRec _ [
            internalWire: CoreOps.CopyWire[oldRec.internalWire],
            instances: NIL]];
        NoteWireSource[newWire: newRec.internalWire, source: [instantiationPath: NIL, wire: oldRec.internalWire, instance: NIL], 
        recursively: TRUE];
        AssocWire[key: templateToCopy, from: oldRec.internalWire, to: newRec.internalWire];
        new _ NEW [CellTypeRec _ old^];
        new.data _ newRec;
        new.properties _ CoreProperties.CopyProps[old.properties];
        new.publicWire _ DuplicatePublicWire[old.publicWire];
        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 internalWire-- THEN RETURN;
        newPublicWire _ NEW [WireRec _ [
            name: NIL,
            structure: oldPublicWire.structure,
            elements: NIL,
            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 _ NEW [WireSequenceRec[oldPublicWire.elements.size]];
            FOR i: INT IN [0 .. oldPublicWire.elements.size) DO
                newPublicWire.elements[i] _ DuplicatePublicWire[oldPublicWire.elements[i]];
                ENDLOOP;
            };
        };

    PromotePrivates: PROC [parent: CellType, parentRec: RecordCellType, child: CellType, childRec: RecordCellType, promotions: 
    Promotions, path: InstantiationPath] = {
        FindPublic: PROC [childsInternal: Wire] RETURNS [somePublic: BOOL] = {
            somePublic _ GetWireAssoc[key: formalToActual, from: childsInternal] # NIL;
            IF (NOT somePublic) AND childsInternal.structure # atom THEN {
                FOR i: NAT IN [0 .. childsInternal.elements.size) DO
                    subWire: Wire _ childsInternal.elements[i];
                    subSomePublic: BOOL _ FindPublic[subWire];
                    somePublic _ somePublic OR subSomePublic;
                    ENDLOOP;
                child _ child;
                };
            IF somePublic THEN childsInternal.properties _ CoreProperties.PutProp[on: childsInternal.properties, prop: partPublic, value: $T];
            };
        DoForPrivateCover: PROC [childsInternal: Wire] = {
            allPublic: BOOL _ GetWireAssoc[key: formalToActual, from: childsInternal] # NIL;
            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 allPublic THEN {
                AssocToCopy[childsInternal];
                }
            ELSE {
                FOR i: NAT IN [0 .. childsInternal.elements.size) DO
                    DoForPrivateCover[childsInternal.elements[i]];
                    ENDLOOP;
                };
            };
        AssocToCopy: PROC [childsInternal: Wire] = {
            actual: Wire _ GetWireAssoc[key: formalToActual, from: childsInternal];
            copy: Wire _ GetWireAssoc[key: templateToCopy, from: actual];
            IF copy # NIL
                THEN AssocWire[key: templateToCopy, from: childsInternal, to: copy]
                ELSE {
                    FOR i: NAT IN [0 .. childsInternal.elements.size) DO
                        AssocToCopy[childsInternal.elements[i]];
                        ENDLOOP;
                    };
            };
        [] _ FindPublic[childRec.internalWire];
        DoForPrivateCover[childRec.internalWire];
        };

    CopyInstance: PROC [old: CellInstance, path: InstantiationPath] RETURNS [new: CellInstance] = {
        CopyActual: PROC [oldWire: Wire] RETURNS [new: Wire] = {
            new _ GetWireAssoc[templateToCopy, oldWire];
            IF new # NIL THEN RETURN;
            new _ NEW [WireRec _ [
                name: NIL,
                structure: oldWire.structure,
                elements: NIL,
                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 _ NEW [WireSequenceRec[oldWire.elements.size]];
            FOR i: INT IN [0 .. oldWire.elements.size) DO
                new.elements[i] _ CopyActual[oldWire.elements[i]];
                ENDLOOP;
            new _ new;
            };
        new _ NEW [CellInstanceRec _ [
            name: NIL,
            actualWire: CopyActual[old.actualWire],
            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;
            };
        };

    ControlByFile: PUBLIC PROC [fileName: ROPE] RETURNS [control: FlattenControl] = {ERROR --not yet implemented--};

    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: 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: 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: CellInstance] RETURNS [IRecognizeYou: BOOL] = {
        name: ROPE = NARROW[data];
        IRecognizeYou _ name.Equal[ci.name];
        };

Start[];

END.