
    <<CorePropertiesImpl.mesa>>
        <<Copyright Ó 1985, 1987 by Xerox Corporation.  All rights reserved.>>
        <<Bertrand Serlet, March 28, 1987 11:16:05 pm PST>>
        <<Barth, September 24, 1986 9:49:13 am PDT>>
        <<Spreitzer, August 8, 1985 3:12:59 pm PDT>>
        <<Pradeep Sindhu February 7, 1986 5:06:44 pm PST>>
        <<Last Edited by: Louis Monier January 16, 1987 1:13:09 pm PST>>
        <<Mike Spreitzer March 6, 1987 1:51:08 pm PST>>

    DIRECTORY
        Commander, Core, CoreClasses, CoreOps, CoreProperties, RefTab, IO, ProcessProps, RProperties;

    CorePropertiesImpl: CEDAR PROGRAM 
        IMPORTS CoreOps, RefTab, IO, ProcessProps, ImplementationProperties: RProperties 
        EXPORTS CoreProperties
        SHARES Core =
        BEGIN OPEN CoreProperties;

        CellClass: TYPE = Core.CellClass;
        CellType: TYPE = Core.CellType;
        Wire: TYPE = Core.Wire;
        ROPE: TYPE = Core.ROPE;
        Properties: TYPE = Core.Properties;

        propTable: RefTab.Ref _ RefTab.Create[];
            <<Global table for putting property properties.>>
<<Operations>>
    GetProp: PUBLIC PROC [from: Properties, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        value _ ImplementationProperties.GetProp[from, prop];
        };

    PutProp: PUBLIC PROC [on: Properties, prop: ATOM, value: REF ANY _ NIL] RETURNS [new: Properties] = {
        new _ ImplementationProperties.PutProp[on, prop, value];
        };

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

    PrintProperties: PUBLIC PROC [props: Properties, out: IO.STREAM _ NIL, indent: NAT _ 0, cr: BOOL _ TRUE, level: NAT _ 2] = {
        PrintIt: PROC [prop: ATOM, val: REF ANY _ NIL] = {
            PP: PropPrintProc ~ GetPropPrintProc[prop, val];
            PP[to: out, prop: prop, val: val, indent: indent, level: level, cr: cr];
            };
        IF out=NIL THEN out _ NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out;
        Enumerate[props, PrintIt];
        };

    GetPropPrintProc: PUBLIC PROC [prop: ATOM, val: REF ANY] RETURNS [PropPrintProc] ~ {
        propprops: Properties ~ FetchProperties[prop];
        IF propprops#NIL THEN {
            pp: REF PropPrintProc ~ NARROW[GetProp[propprops, propPrint]];
            IF pp # NIL THEN RETURN [pp^];
            };
        RETURN [WITH val SELECT FROM
            x: ATOM        => PrintByValue,
            x: ROPE        => PrintByValue,
            x: LIST OF ROPE    => PrintByValue,
            x: LIST OF REF TEXT    => PrintByValue,
            x: REF TEXT        => PrintByValue,
            x: REF INT        => PrintByValue,
            x: REF REAL    => PrintByValue,
            ENDCASE => PropDontPrint^];
        };

    PrintByValue: PROC [to: IO.STREAM, prop: ATOM, val: REF ANY, indent, level: NAT, cr: BOOL] --PropPrintProc-- ~ {
        CoreOps.PrintIndent[indent, to, cr];
        IO.PutF[to, "%g: ", IO.atom[prop]];
        WITH val SELECT FROM
            atom: ATOM        => IO.PutF[to, "$%g", IO.atom[atom]];
            rope: ROPE        => IO.PutF[to, "%g", IO.rope[rope]];
            refText: REF TEXT        => IO.PutF[to, "%g", IO.text[refText]];
            lor: LIST OF ROPE        => FOR l: LIST OF ROPE _ lor, l.rest UNTIL l=NIL DO
                IO.PutF[to, "%g ", IO.rope[l.first]];
                ENDLOOP;
            lor: LIST OF REF TEXT    => FOR l: LIST OF REF TEXT _ lor, l.rest UNTIL l=NIL DO
                IO.PutF[to, "%g ", IO.text[l.first]];
                ENDLOOP;
            refInt: REF INT    => IO.PutF[to, "%g", IO.int[refInt^]];
            refReal: REF REAL    => IO.PutF[to, "%g", IO.real[refReal^]];
            ENDCASE        => ERROR;
        };

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

    RegisterUnprintableProperty: PUBLIC PROC [prop: ATOM, properties: Properties _ NIL] RETURNS [sameProp: ATOM] ~ {
        sameProp _ RegisterProperty[prop, PutProp[properties, propPrint, PropDontPrint]];
        };

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

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

    propPrint: PUBLIC ATOM _ $PropPrint;

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

<<Inheritance of Properties>>
    InheritCellTypeProp: PUBLIC PROC [from: CellType, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        DO
            value _ GetProp[from: from.properties, prop: prop];
        IF value=NIL THEN value _ GetProp[from: from.class.properties, prop: prop];
            IF value#NIL OR NOT from.class.layersProps THEN EXIT;
            from _ CoreOps.Recast[from];
        ENDLOOP;
        };
        <<>>
    InheritPublicProp: PUBLIC PROC [cellType: CellType, from: Wire, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        table: RefTab.Ref _ NIL;
        DO
            value _ GetProp[from: from.properties, prop: prop];
            IF value#NIL OR NOT cellType.class.layersProps THEN EXIT;
            table _ CoreOps.RecastBindingTable[cellType];
            IF table=NIL THEN LOOP;
            from _ NARROW [RefTab.Fetch[table, from].val];
            cellType _ CoreOps.Recast[cellType];
        ENDLOOP;
        };

<<Short Cuts>>
    Props: PUBLIC PROC [lit1, lit2, lit3, lit4, lit5, lit6: PropertyLiteral _ []] RETURNS [properties: Properties] = {
        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: Wire, prop: ATOM] RETURNS [value: REF ANY _ NIL] = {
        value _  GetProp[from: from.properties, prop: prop];
        };

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

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

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

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

    PutCellTypeProp: PUBLIC PROC [on: 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.