
    <<CoreRecordImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Barth, October 2, 1985 10:36:07 am PDT>>
        <<Spreitzer, October 3, 1985 4:47:45 pm PDT>>
        <<Serlet, July 23, 1985 7:28:37 pm PDT>>
        <<>>
    DIRECTORY Core, CoreOps, CoreProperties, CoreRecord, IO;

    CoreRecordImpl: CEDAR PROGRAM
        IMPORTS CoreOps, CoreProperties, IO
        EXPORTS CoreRecord = 
        BEGIN OPEN Core, CoreRecord;

    recordCellClass: PUBLIC CellClass _ NEW[CellClassRec _ [name: "Record", recast: NIL, write: WriteRecord, read: ReadRecord]];

Start: PROC = {
CoreOps.RegisterCellClass[recordCellClass];
recordCellClass.properties _ CoreProperties.PutProp[on: recordCellClass.properties, prop: CoreOps.printClassProcProp, value: 
NEW[CoreOps.PrintClassProc _ PropPrint]];
recordCellClass.properties _ CoreProperties.PutProp[on: recordCellClass.properties, prop: CoreOps.nameClassWireProcProp, value: 
NEW[CoreOps.NameWireProc _ NameInternalWire]];
    CoreProperties.PropDontPrint[internalWireFullName];
};

WriteRecord: WriteProc = {
};

ReadRecord: ReadProc = {
};

PropPrint: CoreOps.PrintClassProc = {
Print[NARROW[data], out];
};

Print: PUBLIC PROC [recordCellType: RecordCellType, out: STREAM] = {
    IO.PutRope[out, "\nInternal wire:"];
    CoreOps.NameWire[wire: recordCellType.internalWire, name: recordCellType.internalWire.name, prop: internalWireFullName];
    CoreOps.PrintWire[recordCellType.internalWire, out];
    FOR instList: CellInstanceList _ recordCellType.instances, instList.rest UNTIL instList=NIL DO
        firstActual: BOOL _ TRUE;
        RecurseOnWires: PROC [actual, public: Wire] = {
            internalName: ROPE;
            IF (internalName _ NARROW[CoreProperties.GetProp[from: actual.properties, prop: internalWireFullName]]) # NIL THEN {
                IF NOT firstActual THEN out.PutChar[',];
                firstActual _ FALSE;
                out.PutF[" %g: %g", IO.rope[NARROW[CoreProperties.GetProp[from: public.properties, prop: CoreOps.publicWireFullName]]], 
                IO.rope[internalName]];
                }
            ELSE IF actual.elements#NIL THEN FOR i:NAT IN [0..actual.elements.size) DO
            RecurseOnWires[actual.elements[i], public.elements[i]];
            ENDLOOP;
            };
        IO.PutF[out, "\nCellInstance: %g, type: %g", IO.rope[instList.first.name], IO.rope[instList.first.type.name]];
    CoreProperties.PrintProperties[props: instList.first.properties, out: out, depth: 1];
        IO.PutRope[out, "\n  Actual wire:"];
        CoreOps.NameWire[wire: instList.first.type.publicWire, name: instList.first.type.publicWire.name, prop: CoreOps.publicWireFullName];
        RecurseOnWires[actual: instList.first.actualWire, public: instList.first.type.publicWire];
        ENDLOOP;
};

    Conform: PUBLIC PROC [w1, w2: Wire] RETURNS [c: BOOL] = {
        IF NOT (c _ w1.structure = w2.structure) THEN RETURN;
        IF w1.structure = atom THEN RETURN;
        IF NOT (c _ w1.elements.size = w2.elements.size) THEN RETURN;
        FOR i: NAT IN [0 .. w1.elements.size) DO
            IF NOT Conform[w1.elements[i], w2.elements[i]] THEN RETURN [FALSE];
            ENDLOOP;
        c _ TRUE;
        };

    Bound: PUBLIC PROC [instance1, instance2: CellInstance, public1, public2: Wire] RETURNS [b: BOOL] = {
        matchActual, matchPublic: Wire;
        MatchWire: PROC [actual, public: Wire] RETURNS [quit: BOOL _ FALSE] = {
            IF matchPublic=public THEN {matchActual _ actual; quit _ TRUE}
            ELSE IF actual.elements#NIL THEN FOR i:NAT IN [0..actual.elements.size) DO
            IF MatchWire[actual.elements[i], public.elements[i]] THEN EXIT;
            ENDLOOP;
            };
        actual1: Wire;
        matchPublic _ public1;
        [] _ MatchWire[instance1.actualWire, instance1.type.publicWire];
        actual1 _ matchActual;
        matchPublic _ public2;
        [] _ MatchWire[instance2.actualWire, instance2.type.publicWire];
        b _ actual1=matchActual;
        };

    internalWireFullName: PUBLIC ATOM _ CoreProperties.RegisterProperty[$CoreInternalWireFullName];

NameInternalWire: CoreOps.NameWireProc = {
rct: RecordCellType _ NARROW[data];
CoreOps.NameWire[wire: rct.internalWire, name: rct.internalWire.name, prop: internalWireFullName];
};

    Start[];

    END.