CorePropertiesImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Bertrand Serlet, October 2, 1985 12:11:41 pm PDT
Barth, October 2, 1985 11:45:00 am PDT
Spreitzer, August 8, 1985 3:12:59 pm PDT
DIRECTORY
Core, CoreOps, CorePrivate, CoreProperties, CoreRecord, 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 PropPrettyPrintProc;
IF propprops#
NIL
THEN {
pp ← NARROW[GetProp[propprops, propPrettyPrint]];
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]];
};
};
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];
};
propPrettyPrint: PUBLIC ATOM ← $PropPrettyPrint;
propRead: PUBLIC ATOM ← $PropRead;
propWrite: PUBLIC ATOM ← $PropWrite;
propCopy: PUBLIC ATOM ← $PropCopy;
propCompare: PUBLIC ATOM ← $PropCompare;
PropDontPrint:
PUBLIC
PROC [prop:
ATOM] = {
StoreProperties[prop: prop, properties: PutProp[on: FetchProperties[prop: prop], prop: propPrettyPrint, value: NEW[PropPrettyPrintProc ← DontPrintProp]]];
};
DontPrintProp: PropPrettyPrintProc = {};
PropDoCopy: PUBLIC REF PropCopyProc ← NEW [PropCopyProc ← PropDoCopyProc];
PropDoCopyProc: PropCopyProc = {valCopy ← value};
PropRopeCompare:
PUBLIC PropCompareProc = {
equal ← Rope.Equal[NARROW[value1, Rope.ROPE], NARROW[value2, Rope.ROPE]];
};
PropIntCompare:
PUBLIC PropCompareProc = {
equal ← NARROW[value1, REF INT]^=NARROW[value2, REF INT]^;
};
PropRopeWrite: PUBLIC PropWriteProc = {TokenIO.WriteRope[NARROW[val]]};
PropAtomWrite: PUBLIC PropWriteProc = {TokenIO.WriteAtom[NARROW[val]]};
PropIntWrite: PUBLIC PropWriteProc = {TokenIO.WriteInt[NARROW[val, REF INT]^]};
PropRopeRead: PUBLIC PropReadProc = {val ← TokenIO.ReadRope[]};
PropAtomRead: PUBLIC PropReadProc = {val ← TokenIO.ReadRope[]};
PropIntRead: PUBLIC PropReadProc = {val ← TokenIO.ReadRope[]};
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];
};
GetDesignProp:
PUBLIC PROC [from: Core.Design, prop:
ATOM]
RETURNS [value:
REF
ANY ←
NIL] = {
value ← GetProp[from: from.properties, prop: prop];
};
PutDesignProp:
PUBLIC PROC [on: Core.Design, prop:
ATOM, value:
REF
ANY ←
NIL] = {
on.properties ← PutProp[on: on.properties, prop: prop, value: value];
};
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: CoreRecord.CellInstance, prop:
ATOM]
RETURNS [value:
REF
ANY ←
NIL] = {
value ← GetProp[from: from.properties, prop: prop];
};
PutCellInstanceProp:
PUBLIC PROC [on: CoreRecord.CellInstance, prop:
ATOM, value:
REF
ANY ←
NIL] = {
on.properties ← PutProp[on: on.properties, prop: prop, value: value];
};