CorePropertiesImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Bertrand Serlet, May 29, 1986 6:23:32 pm PDT
Barth, January 28, 1986 3:32:00 pm PST
Spreitzer, August 8, 1985 3:12:59 pm PDT
Pradeep Sindhu February 7, 1986 5:06:44 pm PST
DIRECTORY
Commander, Core, CoreClasses, CoreOps, CoreProperties, HashTable, IO, ProcessProps, Properties, Rope;
CorePropertiesImpl:
CEDAR
PROGRAM
IMPORTS CoreOps, HashTable, IO, ProcessProps, ImplementationProperties: Properties, Rope
EXPORTS CoreProperties
SHARES Core =
BEGIN OPEN CoreProperties;
Properties: TYPE = Core.Properties;
propTable: HashTable.Table ← HashTable.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];
};
CopyProps:
PUBLIC
PROC [propList: Properties]
RETURNS [copy: Properties] = {
copy ← AppendProps[propList, NIL];
};
AppendProps:
PUBLIC
PROC [winner, loser: Properties]
RETURNS [copy: Properties ←
NIL] = {
CopyItem:
PROC [list: Properties, item: ImplementationProperties.KeyVal]
RETURNS [newList: Properties] =
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 ← ImplementationProperties.PutProp[propList: list, prop: prop, val: newValue];
END;
WHILE loser#
NIL
DO
copy ← CopyItem[copy, loser.first];
loser ← loser.rest;
ENDLOOP;
WHILE winner#
NIL
DO
copy ← CopyItem[copy, winner.first];
winner ← winner.rest;
ENDLOOP;
};
Enumerate:
PUBLIC
PROC [props: Properties, consume:
PROC [prop:
ATOM, val:
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] = {
propprops: Properties ← 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, indent: indent, level: level];
}
};
IF propprops=
NIL
OR pp=
NIL
THEN {
CoreOps.PrintIndent[indent, out, cr];
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 => {};
};
};
IF out=NIL THEN out ← NARROW[ProcessProps.GetProp[$CommanderHandle], Commander.Handle].out;
Enumerate[props, PrintIt];
};
Registration
RegisterProperty:
PUBLIC
PROC [prop:
ATOM, properties: Properties ←
NIL]
RETURNS [sameProp:
ATOM] = {
[] ← HashTable.Store[propTable, prop, properties];
sameProp ← prop;
};
StoreProperties:
PUBLIC
PROC [prop:
ATOM, properties: Properties] = {
[] ← HashTable.Store[propTable, prop, properties];
};
FetchProperties:
PUBLIC
PROC [prop:
ATOM]
RETURNS [properties: Properties] = {
found: BOOL; value: HashTable.Value;
[found, value] ← HashTable.Fetch[propTable, prop];
IF NOT found THEN RETURN[NIL];
properties ← NARROW [value, Properties];
};
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: 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: 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];
};
GetCellClassProp:
PUBLIC PROC [from: Core.CellClass, prop:
ATOM]
RETURNS [value:
REF
ANY ←
NIL] = {
value ← GetProp[from: from.properties, prop: prop];
};
PutCellClassProp:
PUBLIC PROC [on: Core.CellClass, 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];
};