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 September 24, 1987 2:46:38 pm PDT
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,
x: REF BOOL => 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^]];
refBool: REF BOOL => IO.PutF[to, "%g", IO.bool[refBool^]];
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.