
    <<RoseBindImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Barth, August 28, 1985 4:05:21 pm PDT>>
        <<Spreitzer, October 2, 1985 9:23:51 pm PDT>>

    DIRECTORY Basics, BasicTime, Commander, Core, CoreProperties, List, MakeDo, ProcessProps, RedBlackTree, RedBlackTreeExtras, Rope, 
    RoseBehavior, RoseBind, RoseBindPrivate, RoseDeps, RosePrivates, RoseRecognizeTransistors, RoseTranslate, RoseWireTypes, 
    RoseWiring, TimeStamp;

    RoseBindImpl: CEDAR MONITOR
        IMPORTS BasicTime, CP: CoreProperties, List, MakeDo, ProcessProps, RedBlackTree, RedBlackTreeExtras, Rope, RoseDeps, 
        RoseRecognizeTransistors, RoseWiring
        EXPORTS RoseBehavior, RoseBind, RoseBindPrivate, RosePrivates =

    BEGIN OPEN RoseBehavior, RosePrivates, RoseWireTypes, RoseBindPrivate;

    BehaviorClassRec: PUBLIC TYPE = RoseBindPrivate.BehaviorClassRec;

    classKey: PUBLIC ATOM _ CP.RegisterProperty[$RoseClassName];
    argsKey: PUBLIC ATOM _ CP.RegisterProperty[$RoseArgs];

    variableWire: PUBLIC ATOM _ CP.RegisterProperty[$RoseVariableWire];
    switchWire: PUBLIC ATOM _ CP.RegisterProperty[$RoseSwitchWire];
    complexDrive: PUBLIC ATOM _ CP.RegisterProperty[$RoseComplexDrive];
    simpleDrive: PUBLIC ATOM _ CP.RegisterProperty[$RoseSimpleDrive];

    testerSwitchWire
        : PUBLIC ATOM
        _ CP.RegisterProperty[
            $RoseTesterSwitchWire,
            CP.Props[[CP.propCopy, CP.PropDoCopy]]
            ];
    testerComplexDrive
        : PUBLIC ATOM
        _ CP.RegisterProperty[
            $RoseTesterComplexDrive,
            CP.Props[[CP.propCopy, CP.PropDoCopy]]
            ];
    testerSimpleDrive
        : PUBLIC ATOM
        _ CP.RegisterProperty[
            $RoseTesterSimpleDrive,
            CP.Props[[CP.propCopy, CP.PropDoCopy]]
            ];

    typeKey: ATOM _ CP.RegisterProperty[$RoseCoreCellTypeToBehaviorType];

    roots: RedBlackTree.Table _ RedBlackTree.Create[GetModuleRootKey, CompareModuleRoots];

    GetModuleRootKey: PROC [data: REF ANY] RETURNS [ROPE] --RedBlackTree.GetKey-- = {
        mr: ModuleRoot = NARROW[data];
        RETURN [mr.name];
        };

    CompareModuleRoots: PROC [k, data: REF ANY] RETURNS [Basics.Comparison] --RedBlackTree.Compare-- = {
        k1: ROPE = NARROW[k];
        k2: ROPE = GetModuleRootKey[data];
        RETURN [k1.Compare[k2]];
        };

    EnsureModuleRoot: PUBLIC ENTRY PROC [name: ROPE] RETURNS [mr: ModuleRoot] =
        {mr _ InnerEnsureModuleRoot[name]};

    InnerEnsureModuleRoot: INTERNAL PROC [name: ROPE] RETURNS [mr: ModuleRoot] = {
        mr _ NARROW[roots.Lookup[name]];
        IF mr # NIL THEN RETURN;
        mr _ NEW [ModuleRootRec _ [
            name: name,
            classes: RedBlackTreeExtras.NewRefTable[],
            lastUpdate: BasicTime.Now[]
            ]];
        roots.Insert[mr, name];
        };

    classes: RedBlackTree.Table _ RedBlackTree.Create[GetBehaviorClassKey, CompareBehaviorClasses];

    GetBehaviorClassKey: PROC [data: REF ANY] RETURNS [ROPE] --RedBlackTree.GetKey-- = {
        class: BehaviorClass = NARROW[data];
        RETURN [class.name];
        };

    CompareBehaviorClasses: PROC [k, data: REF ANY] RETURNS [Basics.Comparison] --RedBlackTree.Compare-- = {
        k1: ROPE = NARROW[k];
        k2: ROPE = GetBehaviorClassKey[data];
        RETURN [k1.Compare[k2]];
        };

    Insert: PROC [class: BehaviorClass] = {
        classes.Insert[class, class.name];
        };

    Fetch: PUBLIC PROC [name: ROPE] RETURNS [class: BehaviorClass] = {
        class _ NARROW[classes.Lookup[name]];
        };

    EnsureBehaviorClass: PUBLIC PROC [name: ROPE, publicWirePrototype: Core.Wire, moduleNameRoot: ROPE _ NIL] RETURNS [bc: 
    BehaviorClass] = {
        IF publicWirePrototype = NIL THEN ERROR;
        bc _ ReallyEnsureBehaviorClass[name, publicWirePrototype, IF moduleNameRoot # NIL THEN moduleNameRoot ELSE name, FALSE];
        };

    ReallyEnsureBehaviorClass: PROC [name: ROPE, publicWirePrototype: Core.Wire, moduleNameRoot: ROPE, useOld: BOOL] RETURNS [bc: 
    BehaviorClass] = {
        moduleRoot: ModuleRoot;
        bc _ Fetch[name];
        IF bc = NIL
            THEN {
                moduleRoot _ EnsureModuleRoot[moduleNameRoot];
                bc _ NEW [BehaviorClassRec _ [
                    name: name,
                    moduleRoot: moduleRoot,
                    pwpTime: BasicTime.Now[],
                    publicWirePrototype: publicWirePrototype
                    ]];
                Insert[bc];
                moduleRoot.classes.Insert[bc, bc];
                moduleRoot.lastUpdate _ BasicTime.Now[];
                MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassPWPNode[bc]];
                MakeDo.SuspectNodeChange[RoseDeps.GetModuleRootNode[moduleRoot]];
                }
            ELSE {
                IF NOT useOld THEN {
                    moduleRoot _ EnsureModuleRoot[moduleNameRoot];
                    IF moduleRoot # bc.moduleRoot THEN {
                        oldRoot: ModuleRoot = bc.moduleRoot;
                        IF RedBlackTreeExtras.DeleteData[oldRoot.classes, bc] # bc THEN ERROR;
                        moduleRoot.classes.Insert[bc, bc];
                        bc.moduleRoot _ moduleRoot;
                        oldRoot.lastUpdate _ moduleRoot.lastUpdate _ BasicTime.Now[];
                        MakeDo.SuspectNodeChange[RoseDeps.GetModuleRootNode[oldRoot]];
                        MakeDo.SuspectNodeChange[RoseDeps.GetModuleRootNode[moduleRoot]];
                        };
                    IF publicWirePrototype # bc.publicWirePrototype THEN {
                        bc.pwpTime _ BasicTime.Now[];
                        bc.publicWirePrototype _ publicWirePrototype;
                        MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassPWPNode[bc]];
                        };
                    };
                };
        };

    EnsureBCParts: PUBLIC PROC [class: BehaviorClass, details, private, wiring: BOOL _ TRUE] RETURNS [goodDetails, goodPrivate: BOOL _ 
    FALSE] = {
        IF wiring THEN {
            IF class.publicWirePrototypeWiringIsFrom # class.publicWirePrototype THEN {
                class.wiring _ RoseWiring.ComputeWiring[class.publicWirePrototype, class.name];
                class.publicWirePrototypeWiringIsFrom _ class.publicWirePrototype;
                };
            };
        IF private
            THEN {
                ch: Commander.Handle _ GetHandle[];
                nFailed, nSucceeded: NAT;
                goals: MakeDo.RefTable = MakeDo.MakeRefTable[];
                MakeDo.AddToRefTable[
                    RoseDeps.GetBehaviorClassPrivateNode[class],
                    goals];
                [nSucceeded, nFailed] _ MakeDo.Ensure[goals: goals, modifiabilitySpec: NIL];
                IF nFailed + nSucceeded # 1 THEN ERROR--impossible--;
                goodPrivate _ nSucceeded = 1 AND class.private # NIL
                }
            ELSE goodPrivate _ FALSE;
        IF details
            THEN {
                ch: Commander.Handle _ GetHandle[];
                nFailed, nSucceeded: NAT;
                goals: MakeDo.RefTable = MakeDo.MakeRefTable[];
                MakeDo.AddToRefTable[
                    RoseDeps.GetBehaviorClassDetailsNode[class],
                    goals];
                [nSucceeded, nFailed] _ MakeDo.Ensure[goals: goals, modifiabilitySpec: NIL];
                IF nFailed + nSucceeded # 1 THEN ERROR--impossible--;
                goodDetails _ nSucceeded = 1 AND class.details # NIL;
                }
            ELSE goodDetails _ FALSE;
        };

    GetBehaviorClass: PUBLIC PROC [cellType: Core.CellType, details, private, wiring: BOOL _ TRUE] RETURNS [class: BehaviorClass, 
    goodDetails, goodPrivate: BOOL _ FALSE] = {
        class _ NARROW[CP.GetCellTypeProp[cellType, classKey]];
        IF class = NIL THEN {
            class _ RoseRecognizeTransistors.Recognize[cellType];
            IF class = NIL THEN class _ ReallyEnsureBehaviorClass[cellType.name, cellType.publicWire, cellType.name, TRUE];
            CP.PutCellTypeProp[cellType, classKey, class];
            };
        [goodDetails, goodPrivate] _ EnsureBCParts[class, details, private, wiring];
        };

    GetHandle: PROC RETURNS [ch: Commander.Handle] = {
        pp: List.AList _ ProcessProps.GetPropList[];
        ch _ NARROW[List.Assoc[key: $CommanderHandle, aList: pp]];
        IF ch = NIL THEN ERROR;
        };

    GetBehaviorType: PUBLIC PROC [cellType: Core.CellType] RETURNS [behaviorType: BehaviorType] = {
        behaviorType _ NARROW[CP.GetCellTypeProp[cellType, typeKey]];
        IF behaviorType = NIL THEN {
            class: BehaviorClass;
            goodDetails, goodPrivate: BOOL;
            [class, goodDetails, goodPrivate] _ GetBehaviorClass[cellType];
            IF NOT (goodDetails AND goodPrivate) THEN ERROR;
            behaviorType _ NEW [BehaviorTypeRec _ [
                class: class,
                wiring: NEW [BehaviorTypeWiringRep _ ALL[NIL]]
                ]];
            FOR wf: WireFlavor IN WireFlavor DO
                behaviorType.wiring[wf] _ class.wiring[wf].super.GetType[class.wiring[wf], cellType.publicWire];
                ENDLOOP;
            CP.PutCellTypeProp[cellType, typeKey, behaviorType];
            };
        };

    EnumerateModuleClasses: PUBLIC PROC [mr: ModuleRoot, to: PROC [BehaviorClass]] = {
        PerClassNode: PROC [data: REF ANY] RETURNS [stop: BOOL _ FALSE] --RedBlackTree.EachNode-- = {
            to[NARROW[data]];
            };
        mr _ mr;
        RedBlackTreeExtras.StatelessEnumerateIncreasing[mr.classes, PerClassNode, RedBlackTreeExtras.GetIDKey];
        mr _ mr;
        };

    RegisterDetails: PUBLIC PROC [behaviorClassName: ROPE, details: Details, versionStamp: VersionStamp] = {
        class: BehaviorClass = Fetch[behaviorClassName];
        IF class = NIL THEN ERROR;
        class.detailsTime _ BasicTime.Now[];
        class.detailsStamp _ versionStamp;
        class.details _ details;
        MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassDetailsNode[class]];
        };

    RegisterPrivates: PUBLIC PROC [className: ROPE, privates: Privates, versionStamp: VersionStamp] = {
        class: BehaviorClass = Fetch[className];
        IF class = NIL THEN ERROR;
        class.privateTime _ BasicTime.Now[];
        class.privateStamp _ versionStamp;
        class.private _ privates;
        MakeDo.SuspectNodeChange[RoseDeps.GetBehaviorClassPrivateNode[class]];
        };

    END.