GGPropsImpl.mesa
Copyright Ó 1989 by Xerox Corporation. All rights reserved.
Last edited by Pier on June 16, 1989 10:14:28 am PDT
Contents: General property mechanism for GG slices
Bier, July 17, 1989 5:09:16 pm PDT
DIRECTORY
Convert, GGSlice, GGParent, GGProps, GGSliceOps, IO, Prop, Real, RefTab, Rope;
GGPropsImpl: CEDAR MONITOR
IMPORTS Convert, GGParent, GGSliceOps, IO, Prop, RefTab
EXPORTS GGProps = BEGIN
STREAM: TYPE = IO.STREAM;
Slice: TYPE = GGSlice.Slice;
SliceDescriptor: TYPE = GGSlice.SliceDescriptor;
SliceParts: TYPE = GGSlice.SliceParts;
PropList: TYPE = Prop.PropList;
PropWalkProc: TYPE = GGProps.PropWalkProc;
FileoutProc: TYPE = GGProps.FileoutProc;
FileinProc: TYPE = GGProps.FileinProc;
CopyProc: TYPE = GGProps.CopyProc;
ValFormat: TYPE = GGProps.ValFormat;
Put: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM, val: REF] = {
Add the given property to the children of slice described in parts.
DoPut: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ← FALSE] = {
sliceD.slice.props ← Prop.Put[sliceD.slice.props, key, val];
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] ← GGParent.WalkIncludedChildren[slice, parts, leaf, DoPut]
ELSE slice.props ← Prop.Put[slice.props, key, val];
};
PutAll: PROC [slice: Slice, parts: SliceParts, props: Prop.PropList] = {
Add the given property to the children of slice described in parts.
DoPut: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ← FALSE] = {
sliceD.slice.props ← props;
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN [] ← GGParent.WalkIncludedChildren[slice, parts, leaf, DoPut]
ELSE slice.props ← props;
};
Get: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM] RETURNS [val: REF, isUnique: BOOL ← TRUE] = {
Get the property value matching key from the children of slice described in parts. If the children have more than one value for this property, return one of the values and isUnique = FALSE
found: BOOL ← FALSE;
DoGet: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ← FALSE] = {
thisVal: REF ← Prop.Get[sliceD.slice.props, key]; -- returns NIL if not found
IF thisVal#NIL THEN { -- check the property for uniqueness
IF found AND thisVal#val THEN RETURN[TRUE]
ELSE {
val ← thisVal; -- first found property
found ← TRUE;
};
};
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
isUnique ← NOT GGParent.WalkIncludedChildren[slice, parts, leaf, DoGet]
ELSE val ← Prop.Get[slice.props, key];
};
Rem: PUBLIC PROC [slice: Slice, parts: SliceParts, key: ATOM] RETURNS [isUnique: BOOL ← TRUE] = {
Remove the property value matching key from the children of slice described in parts. If the children have more than one different value for this property, return isUnique = FALSE
val: REF;
found: BOOL ← FALSE;
DoRem: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ← FALSE] = {
thisVal: REF ← Prop.Get[sliceD.slice.props, key]; -- returns NIL if not found
IF thisVal#NIL THEN {
sliceD.slice.props ← Prop.Rem[sliceD.slice.props, key]; -- remove the property
IF found AND thisVal#val THEN isUnique ← FALSE -- check the property for uniqueness
ELSE {
val ← thisVal; -- first found property
found ← TRUE;
};
};
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
[] ← GGParent.WalkIncludedChildren[slice, parts, leaf, DoRem]
ELSE slice.props ← Prop.Rem[slice.props, key];
};
Copy: PUBLIC PROC [key: ATOM, val: REF] RETURNS [copy: REF] = {
tableEntry: REF;
gtEntry: GTEntry;
found: BOOL ← FALSE;
[found, tableEntry] ← RefTab.Fetch[gt, key];
IF found THEN {
gtEntry ← NARROW[tableEntry];
IF gtEntry.copy=NIL THEN copy ← val
ELSE copy ← gtEntry.copy[val];
}
ELSE copy ← val;
};
Walk: PUBLIC PROC [slice: Slice, parts: SliceParts, walkProc: PropWalkProc] RETURNS [aborted: BOOL ← FALSE] = {
For all properties of the children of slice described in parts, call the walkProc. Returns aborted=TRUE and aborts the walk if any call to walkProc returned TRUE.
DoMap: Prop.MapAction = {
RETURN[walkProc[NARROW[key], val]];
};
DoWalk: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ← FALSE] = {
done ← Prop.Map[sliceD.slice.props, DoMap];
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
aborted ← GGParent.WalkIncludedChildren[slice, parts, leaf, DoWalk]
ELSE aborted ← Prop.Map[slice.props, DoMap]
};
Kill: PUBLIC PROC [slice: Slice, parts: SliceParts] = {
Remove all the properties of the children of slice described in parts
DoKill: PROC [sliceD: SliceDescriptor] RETURNS [done: BOOL ← FALSE] = {
sliceD.slice.props ← NIL;
};
IF GGParent.IsParentType[GGSliceOps.GetType[slice]] THEN
[] ← GGParent.WalkIncludedChildren[slice, parts, leaf, DoKill]
ELSE slice.props ← NIL;
};
CopyAll: PUBLIC PROC [fromSlice, toSlice: Slice, fromParts, toParts: SliceParts ← NIL] = {
DoCopyProc: PropWalkProc = {
PROC [key: ATOM, val: REF] RETURNS [done: BOOL ← FALSE];
copyProps ← Prop.Put[copyProps, key, Copy[key, val]];
};
copyProps: Prop.PropList ← NIL;
[] ← Walk[fromSlice, fromParts, DoCopyProc];
PutAll[toSlice, toParts, copyProps];
};
ToRope: PUBLIC ENTRY PROC [key: ATOM, val: REF] RETURNS [r: Rope.ROPE, vf: ValFormat ← delimited] = {
Returns a ROPE describing the property value and the encoding format of that ROPE. Uses a single scratch stream, so needs to be an ENTRY PROC. Returns r=NIL if cannot encode val.
ENABLE UNWIND => NULL; -- releases monitor locks if aborted
found: BOOL ← FALSE;
tableEntry: REF;
gtEntry: GTEntry;
[found, tableEntry] ← RefTab.Fetch[gt, key];
IF NOT found OR tableEntry=NIL THEN {
WITH val SELECT FROM
a: ATOM => RETURN[Convert.RopeFromAtom[from: a]];
rope: Rope.ROPE => RETURN[rope];
int: REF INT => RETURN[Convert.RopeFromInt[from: int^, base: 10, showRadix: FALSE]];
card: REF CARD => RETURN[Convert.RopeFromCard[from: card^, base: 10, showRadix: FALSE]];
real: REF REAL => RETURN[Convert.RopeFromReal[from: real^, precision: Real.MaxSinglePrecision, useE: FALSE]];
bool: REF BOOL => RETURN[Convert.RopeFromBool[from: bool^]];
ENDCASE => RETURN[NIL];
}
ELSE {
gtEntry ← NARROW[tableEntry];
IF gtEntry.out=NIL THEN RETURN[NIL]; -- will implement generic output later
vf ← gtEntry.out[IO.ROS[oldStream: scratchROS], val]; -- fill the stream with a description of val
r ← IO.RopeFromROS[self: scratchROS, close: TRUE];
};
};
FromRope: PUBLIC ENTRY PROC [key: ATOM, r: Rope.ROPE] RETURNS [val: REF] = {
Returns a property derived from the input ROPE. Uses a single scratch stream, so needs to be an ENTRY PROC. Returns r if cannot decode r.
ENABLE UNWIND => NULL; -- releases monitor locks if aborted
found: BOOL ← FALSE;
tableEntry: REF;
gtEntry: GTEntry;
[found, tableEntry] ← RefTab.Fetch[gt, key];
IF NOT found OR tableEntry=NIL THEN {
tokenKind: IO.TokenKind;
token: Rope.ROPE;
charsSkipped: INT;
success: BOOL ← TRUE;
s: IO.STREAM ← IO.RIS[rope: r, oldStream: scratchRIS];
[tokenKind, token, charsSkipped] ← IO.GetCedarTokenRope[s
! IO.EndOfStream, IO.Error => {success ← FALSE; CONTINUE}];
IF NOT success THEN ERROR;
IF IO.EndOf[s] THEN { -- value consists of a single token
SELECT tokenKind FROM
tokenID => val ← token;
tokenDECIMAL => val ← NEW[INT ← Convert.IntFromRope[token, 10]];
tokenOCTAL => val ← NEW[INT ← Convert.IntFromRope[token, 8]];
tokenHEX => val ← NEW[INT ← Convert.IntFromRope[token, 16]];
tokenREAL => val ← NEW[REAL ← Convert.RealFromRope[token]];
tokenROPE => val ← Convert.RopeFromLiteral[token];
tokenCHAR => val ← token;
tokenATOM => val ← Convert.AtomFromRope[token];
ENDCASE => val ← token;
}
ELSE { -- if there are multiple tokens, return the whole rope
val ← r;
};
}
ELSE {
gtEntry ← NARROW[tableEntry];
IF gtEntry.in=NIL THEN RETURN[r];
val ← gtEntry.in[IO.RIS[rope: r, oldStream: scratchRIS]];
};
};
Register: PUBLIC PROC [key: ATOM, in: FileinProc, out: FileoutProc, copy: CopyProc] = {
A global table of [key, fileinProc, fileoutProc] entries is maintained. Clients who wish to have their properties filed in and out are encouraged to register appropriate procs.
gtEntry: GTEntry ← NEW[GTEntryRep ← [in, out, copy] ];
[] ← RefTab.Store[gt, key, gtEntry]; -- overwrites earlier entries with same key
};
Init: PROC = {
bigRope: Rope.ROPE ← "BeKindToYourWebFootedFriendsForADuckMayBeSomebodysMother";
gt ← RefTab.Create[];
scratchRIS ← IO.RIS[rope: bigRope];
scratchROS ← IO.ROS[];
};
IdentityCopy: PUBLIC CopyProc = {
copy ← val;
};
RegisterTestProcs: PROC = {
Register[$int, FileInInt, FileOutInt, IdentityCopy];
Register[$real, FileInReal, FileOutReal, IdentityCopy];
Register[$atom, FileInAtom, FileOutAtom, IdentityCopy];
};
FileInInt: FileinProc = {
ref: REF INT ← NEW[INT];
ref^ ← IO.GetInt[s];
val ← ref;
};
FileOutInt: FileoutProc = {
ref: REF INT ← NARROW[val];
s.Put[ [integer[ref^]] ];
};
FileInReal: FileinProc = {
ref: REF REAL ← NEW[REAL];
ref^ ← IO.GetReal[s];
val ← ref;
};
FileOutReal: FileoutProc = {
ref: REF REAL ← NARROW[val];
s.Put[ [real[ref^]] ];
};
FileInAtom: FileinProc = {
ref: ATOM ← IO.GetAtom[s];
val ← ref;
};
FileOutAtom: FileoutProc = {
ref: ATOM ← NARROW[val];
s.Put[ [atom[ref]] ];
};
FileInRope: FileinProc = {
ref: Rope.ROPE ← IO.GetRope[s];
val ← ref;
};
FileOutRope: FileoutProc = {
ref: Rope.ROPE ← NARROW[val];
s.PutRope[ref];
};
GTEntry: TYPE = REF GTEntryRep;
GTEntryRep: TYPE = RECORD [in: FileinProc, out: FileoutProc, copy: CopyProc];
gt: RefTab.Ref;
scratchRIS: STREAM;
scratchROS: STREAM;
Init[];
RegisterTestProcs[];
END.