
    <<CorePropertiesImpl.mesa>>
        <<Copyright © 1985 by Xerox Corporation.  All rights reserved.>>
        <<Bertrand Serlet, November 9, 1985 5:43:50 pm PST>>
        <<Barth, October 2, 1985 11:45:00 am PDT>>
        <<Spreitzer, August 8, 1985 3:12:59 pm PDT>>

    DIRECTORY
        Core, CoreClasses, CoreOps, CoreProperties, IO, RefTab, Properties, Rope;

    CorePropertiesImpl: CEDAR PROGRAM 
        IMPORTS CoreOps, IO, RefTab, Properties, Rope 
        EXPORTS Core, CoreProperties =
        BEGIN OPEN CoreProperties;

        propTable: RefTab.Ref _ RefTab.Create[];

        PropertyRec: PUBLIC TYPE = RECORD [c: Properties.PropList _ NIL];
        ConcreteProperties: TYPE = REF PropertyRec;
<<Operations>>
    GetProp: PUBLIC PROC [from: ConcreteProperties, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        IF from=NIL THEN RETURN;
        value _ Properties.GetProp[from.c, prop];
        };

    PutProp: PUBLIC PROC [on: ConcreteProperties, prop: ATOM, value: REF ANY _ NIL] RETURNS [new: ConcreteProperties] = {
        IF on=NIL THEN on _ NEW [PropertyRec];
        on.c _ Properties.PutProp[on.c, prop, value];
        new _ on;
        };

    CopyProps: PUBLIC PROC [propList: ConcreteProperties] RETURNS [copy: Core.Properties] = {
        copy _ AppendProps[propList, NIL];
        };

    AppendProps: PUBLIC PROC [winner, loser: ConcreteProperties] RETURNS [copy: ConcreteProperties] = {
        CopyItem: PROC [list: Properties.PropList, item: Properties.KeyVal] RETURNS [newList: Properties.PropList] =
            BEGIN
            prop: ATOM = NARROW [item.key];
            propCopyProc: REF _ GetProp[FetchProperties[prop], propCopy];
            newValue: REF _ IF propCopyProc=NIL THEN NIL ELSE (NARROW [propCopyProc, REF PropCopyProc])^[prop: prop, value: item.val];
            IF newValue=NIL 
                THEN newList _ list
                ELSE 
                    newList _ Properties.PutProp[propList: list, prop: prop, val: newValue];
            END;
        copyRec: Properties.PropList _ NIL;
        winnerPropList: Properties.PropList _ IF winner=NIL THEN NIL ELSE winner.c;
        loserPropList: Properties.PropList _ IF loser=NIL THEN NIL ELSE loser.c;
        WHILE loserPropList#NIL DO 
            copyRec _ CopyItem[copyRec, loserPropList.first]; 
            loserPropList _ loserPropList.rest;
            ENDLOOP;
        WHILE winnerPropList#NIL DO 
            copyRec _ CopyItem[copyRec, winnerPropList.first]; 
            winnerPropList _ winnerPropList.rest;
            ENDLOOP;
        copy _ NEW[PropertyRec _ [copyRec]];
        };

    Enumerate: PUBLIC PROC [props: ConcreteProperties, consume: PROC [prop: ATOM, val: REF ANY]] = {
        IF props = NIL THEN RETURN;
        FOR pl: Properties.PropList _ props.c, pl.rest WHILE pl # NIL DO
            consume[NARROW[pl.first.key], pl.first.val];
            ENDLOOP;
        props _ props;
        };

    PrintProperties: PUBLIC PROC [props: ConcreteProperties, out: IO.STREAM, depth: NAT _ 0] = {
        PrintIt: PROC [prop: ATOM, val: REF ANY _ NIL] = {
            propprops: ConcreteProperties _ FetchProperties[prop];
            pp: REF PropPrintProc;
            IF propprops#NIL THEN {
                pp _ NARROW [GetProp[propprops, propPrint]];
                IF pp # NIL THEN {
                    pp^[to: out, prop: prop, val: val, depth: depth];
                    }
                };
            IF propprops=NIL OR pp=NIL THEN {
            CoreOps.PrintIndent[depth, out];
                IO.PutF[out, "%g", IO.atom[prop]];
                WITH val SELECT FROM
                    atom: ATOM        => IO.PutF[out, ": %g", IO.atom[atom]];
                    rope: Core.ROPE    => IO.PutF[out, ": %g", IO.rope[rope]];
                    refInt: REF INT    => IO.PutF[out, ": %g", IO.int[refInt^]];
                    ENDCASE            => {};
                };
            };
        Enumerate[props, PrintIt];
        };

<<Registration>>
    RegisterProperty: PUBLIC PROC [prop: ATOM, properties: ConcreteProperties _ NIL] RETURNS [sameProp: ATOM] = {
        [] _  RefTab.Store[propTable, prop, properties];
        sameProp _ prop;
        };

    StoreProperties: PUBLIC PROC [prop: ATOM, properties: ConcreteProperties] = {
        [] _  RefTab.Store[propTable, prop, properties];
        };

    FetchProperties: PUBLIC PROC [prop: ATOM] RETURNS [properties: ConcreteProperties] = {
        found: BOOL; val: RefTab.Val;
        [found, val] _ RefTab.Fetch[propTable, prop];
        IF NOT found THEN RETURN[NIL];
        properties _ NARROW [val, ConcreteProperties];
        };

    propPrint: PUBLIC ATOM _ $PropPrint;
    propCopy: PUBLIC ATOM _ $PropCopy;
    propCompare: PUBLIC ATOM _ $PropCompare;

    DoCopy: PropCopyProc = {valCopy _ value};
    PropDoCopy: PUBLIC REF PropCopyProc _ NEW [PropCopyProc _ DoCopy];

    DontPrint: PropPrintProc = {};
    PropDontPrint: PUBLIC REF PropPrintProc _ NEW [PropPrintProc _ DontPrint];

    RopeCompare: PUBLIC PropCompareProc = {
        equal _ Rope.Equal[NARROW [value1, Rope.ROPE], NARROW [value2, Rope.ROPE]];
        };
    PropRopeCompare: PUBLIC REF PropCompareProc _ NEW [PropCompareProc _ RopeCompare];

    IntCompare: PUBLIC PropCompareProc = {
        equal _ NARROW [value1, REF INT]^=NARROW [value2, REF INT]^;
        };
    PropIntCompare: PUBLIC REF PropCompareProc _ NEW [PropCompareProc _ IntCompare];

<<Short Cuts>>
    Props: PUBLIC PROC [lit1, lit2, lit3, lit4, lit5, lit6: PropertyLiteral _ []] RETURNS [properties: ConcreteProperties] = {
        properties _ PutProp[on: NIL, prop: lit1.key, value: lit1.val];
        properties _ PutProp[on: properties, prop: lit2.key, value: lit2.val];
        properties _ PutProp[on: properties, prop: lit3.key, value: lit3.val];
        properties _ PutProp[on: properties, prop: lit4.key, value: lit4.val];
        properties _ PutProp[on: properties, prop: lit5.key, value: lit5.val];
        properties _ PutProp[on: properties, prop: lit6.key, value: lit6.val];
        };

    GetWireProp: PUBLIC PROC [from: Core.Wire, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        value _  GetProp[from: from.properties, prop: prop];
        };

    PutWireProp: PUBLIC PROC [on: Core.Wire, prop: ATOM, value: REF ANY _ NIL] = {
        on.properties _  PutProp[on: on.properties, prop: prop, value: value];
        };

    GetCellTypeProp: PUBLIC PROC [from: Core.CellType, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        value _  GetProp[from: from.properties, prop: prop];
        };

    PutCellTypeProp: PUBLIC PROC [on: Core.CellType, prop: ATOM, value: REF ANY _ NIL] = {
        on.properties _  PutProp[on: on.properties, prop: prop, value: value];
        };

    GetCellInstanceProp: PUBLIC PROC [from: CoreClasses.CellInstance, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        value _  GetProp[from: from.properties, prop: prop];
        };

    PutCellInstanceProp: PUBLIC PROC [on: CoreClasses.CellInstance, prop: ATOM, value: REF ANY _ NIL] = {
        on.properties _  PutProp[on: on.properties, prop: prop, value: value];
        };

    END.