LoganBerryEntryImpl.mesa
Copyright Ó 1987, 1992 by Xerox Corporation. All rights reserved.
Doug Terry, November 13, 1989 9:22:24 pm PST
Christian Jacobi, April 23, 1992 10:46 am PDT
Routines for manipulating LoganBerry entries.
DIRECTORY
Atom USING [GetProp, PutProp, GetPName, MakeAtom],
BasicTime USING [FromNSTime, GMT, Now, nullGMT, OutOfRange, ToNSTime],
Convert USING [BoolFromRope, CardFromRope, Error, IntFromRope, TimeFromRope, RopeFromBool, RopeFromInt, RopeFromTimeRFC822],
IO USING [card, PutFR1],
LoganBerry USING [AttributeType, AttributeValue, Entry],
RefTab USING [Create, Delete, EachPairAction, Fetch, Pairs, Ref, Store],
Rope USING [Equal, ROPE],
LoganBerryEntry;
LoganBerryEntryImpl: CEDAR PROGRAM
IMPORTS Atom, BasicTime, Convert, IO, RefTab, Rope
EXPORTS LoganBerryEntry
~ BEGIN
ROPE: TYPE ~ Rope.ROPE;
Formatter: TYPE ~ LoganBerryEntry.Formatter;
Entry operations
Operations on attributes within entries:
GetAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LoganBerry.AttributeValue] = {
Look up an attribute value for an attribute type in an entry. Return NIL if not found.
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO
IF e.first.type = type THEN
RETURN[e.first.value];
ENDLOOP;
RETURN[NIL];
};
GetAllAttrs: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LIST OF LoganBerry.AttributeValue] ~ {
Extracts all values of the particular attribute type and returns them as a list. Returns NIL if entry does not contain an attribute of the specified type.
result, lastr: LIST OF LoganBerry.AttributeValue ¬ NIL;
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO
IF e.first.type = type THEN {
IF lastr # NIL
THEN {lastr.rest ¬ LIST[e.first.value]; lastr ¬ lastr.rest}
ELSE result ¬ lastr ¬ LIST[e.first.value];
};
ENDLOOP;
RETURN[result];
};
SetAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [] ~ {
Changes the value of a particular attribute in entry. Does nothing if entry does not contain an attribute of the specified type.
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO
IF e.first.type = type THEN {
e.first.value ¬ value;
};
ENDLOOP;
};
ChangeAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [found: BOOLEAN] ~ {
Like SetAttr but returns found=FALSE if entry does not contain an attribute of the specified type.
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO
IF e.first.type = type THEN {
e.first.value ¬ value;
RETURN[TRUE];
};
ENDLOOP;
RETURN[FALSE];
};
AddAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [new: LoganBerry.Entry] ~ {
Appends an attrribute to the entry. Returns the new entry.
e: LoganBerry.Entry ¬ entry;
new ¬ LIST[[type, value]];
IF e # NIL THEN {
WHILE e.rest # NIL DO
e ¬ e.rest;
ENDLOOP;
e.rest ¬ new;
new ¬ entry;
};
RETURN[new];
};
RemoveAttr: PUBLIC PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType, value: LoganBerry.AttributeValue] RETURNS [new: LoganBerry.Entry] ~ {
Removes the specified attribute from the entry. Returns the new entry, which may be NIL.
prev: LoganBerry.Entry ¬ NIL;
new ¬ entry;
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO
IF (e.first.type = type) AND Rope.Equal[s1: e.first.value, s2: value, case: FALSE] THEN {
IF prev # NIL
THEN prev.rest ¬ e.rest
ELSE new ¬ e.rest;
EXIT;
};
prev ¬ e;
ENDLOOP;
RETURN[new];
};
Operations on whole entries:
CopyEntry: PUBLIC PROC [entry: LoganBerry.Entry] RETURNS [new: LoganBerry.Entry] ~ {
Makes a copy of the given entry.
last: LoganBerry.Entry ¬ NIL;
new ¬ NIL;
FOR e: LoganBerry.Entry ¬ entry, e.rest WHILE e # NIL DO
IF last # NIL
THEN {last.rest ¬ LIST[[e.first.type, e.first.value]]; last ¬ last.rest}
ELSE new ¬ last ¬ LIST[[e.first.type, e.first.value]];
ENDLOOP;
RETURN[new];
};
ReverseEntry: PUBLIC PROC [entry: LoganBerry.Entry] RETURNS [new: LoganBerry.Entry] ~ {
Destructively reverses the order of the entry's attributes. Taken from LispImpl.DReverse.
l1, l2, l3: LoganBerry.Entry ¬ NIL;
IF entry = NIL THEN RETURN[NIL];
l3 ¬ entry;
UNTIL (l1 ¬ l3) = NIL DO
l3 ¬ l3.rest;
l1.rest ¬ l2;
l2 ¬ l1;
ENDLOOP;
RETURN[l2];
};
AppendEntries: PUBLIC PROC [e1, e2: LoganBerry.Entry] RETURNS [new: LoganBerry.Entry] = {
Concatenates two entries together. From Dan Swinehart.
IF e2=NIL THEN RETURN[e1];
IF e1=NIL THEN RETURN[e2];
new ¬ e1;
FOR aL: LoganBerry.Entry ¬ e1, aL.rest WHILE aL#NIL DO
IF aL.rest#NIL THEN LOOP;
aL.rest ¬ e2;
RETURN;
ENDLOOP;
ERROR;
};
EntriesEqual: PUBLIC PROC [e1, e2: LoganBerry.Entry] RETURNS [BOOL] = {
Returns true if two entries are equal up to reordering. From Don Baker.
e2prime: LoganBerry.Entry;
IF e1 = e2 THEN RETURN [TRUE]; -- Quick check
Copy e2 into e2prime.
e2prime ¬ NIL;
FOR tail: LoganBerry.Entry ¬ e2, tail.rest WHILE tail # NIL DO
e2prime ¬ CONS[tail.first, e2prime];
ENDLOOP;
Walk down e1, checking for equality of each attribute value in e1, if so, delete it from e2prime.
FOR tail: LoganBerry.Entry ¬ e1, tail.rest WHILE tail # NIL DO
prev: LoganBerry.Entry ¬ NIL;
FOR e: LoganBerry.Entry ¬ e2prime, e.rest WHILE e # NIL DO
IF e.first.type = tail.first.type THEN { -- These two attribute pairs should compare
IF e.first.value # tail.first.value AND NOT Rope.Equal[e.first.value, tail.first.value] THEN RETURN [FALSE];
IF prev = NIL THEN e2prime ¬ e.rest ELSE prev.rest ¬ e.rest;
EXIT;
};
prev ¬ e;
REPEAT
FINISHED => RETURN [FALSE];
ENDLOOP;
ENDLOOP;
e2prime should be empty at this point.
RETURN [e2prime = NIL];
};
Timestamps
A timestamp is taken to be the maximum of the current time (converted to an integer) and the last timestamp returned plus 1. The current time alone is not sufficient since it has a granularity of seconds. Several timestamps may be created within a second, but the long-term creation rate should be much less than one per second. A timestamp could be returned more than once if this module is rerun before the current time has a chance to catch up to the most recently returned timestamp (or if a machine's clock is reset to an earlier time).
lastTimestamp: CARD ¬ 0;
NewTimestamp: PUBLIC PROC [] RETURNS [ts: LoganBerryEntry.Timestamp] ~ {
Generates a timestamp that is close to the current time and such that subsequent calls to NewTimestamp yield different results provided (1) the calls are performed on the same machine, and (2) the machine has not crashed and been restarted in between calls. Even if NewTimestamp is called on different machines, the results will be unique with a high probability.
lastTimestamp ¬ MAX[lastTimestamp+1, BasicTime.ToNSTime[BasicTime.Now[]]];
ts ¬ IO.PutFR1["%010g", IO.card[lastTimestamp]];
};
Conversions
From various data types to attribute values:
I2V: PUBLIC PROC [i: INT] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ {
v ¬ Convert.RopeFromInt[from: i, showRadix: FALSE ! Convert.Error => CONTINUE];
};
B2V: PUBLIC PROC [b: BOOL] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ {
v ¬ Convert.RopeFromBool[b];
};
S2V: PUBLIC PROC [s: ROPE] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ {
v ¬ s;
};
A2V: PUBLIC PROC [a: ATOM] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ {
v ¬ IF a # NIL THEN Atom.GetPName[a] ELSE NIL;
};
T2V: PUBLIC PROC [t: BasicTime.GMT] RETURNS [v: LoganBerry.AttributeValue ¬ NIL] ~ {
v ¬ Convert.RopeFromTimeRFC822[t ! Convert.Error => CONTINUE; BasicTime.OutOfRange => CONTINUE];
};
T2Ts: PUBLIC PROC [t: BasicTime.GMT] RETURNS [v: LoganBerry.AttributeValue] ~ {
v ¬ IO.PutFR1["%010g", IO.card[BasicTime.ToNSTime[t]]];
};
From attribute values to various data types:
V2B: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [b: BOOL ¬ FALSE] ~ {
b ¬ Convert.BoolFromRope[v ! Convert.Error => CONTINUE];
};
V2I: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [i: INT ¬ -1] ~ {
i ¬ Convert.IntFromRope[v ! Convert.Error => CONTINUE];
};
V2S: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [s: ROPE] ~ {
RETURN[v];
};
V2T: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [t: BasicTime.GMT ¬ BasicTime.nullGMT] ~ {
t ¬ Convert.TimeFromRope[v ! Convert.Error => CONTINUE];
};
V2A: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [a: ATOM] ~ {
a ¬ IF v # NIL THEN Atom.MakeAtom[v] ELSE NIL;
};
Ts2T: PUBLIC PROC [v: LoganBerry.AttributeValue] RETURNS [t: BasicTime.GMT] ~ {
t ¬ BasicTime.FromNSTime[Convert.CardFromRope[v]];
};
Formatters
formatterTable: RefTab.Ref;
ParseError: PUBLIC ERROR [explanation: Rope.ROPE ¬ NIL] = CODE;
RegisterFormatter: PUBLIC PROC [name: ATOM, formatter: Formatter] RETURNS [] ~ {
Register a set of formatting procedures for a named class; if formatter is NIL then the name is unregistered.
IF formatter#NIL
THEN [] ¬ RefTab.Store[formatterTable, name, formatter]
ELSE [] ¬ RefTab.Delete[formatterTable, name];
};
GetFormatterByName: PUBLIC PROC [name: ATOM] RETURNS [formatter: Formatter] ~ {
Get the registered formatter of the specified name or NIL if there is no such formatter.
f: Formatter ¬ NARROW[RefTab.Fetch[formatterTable, name].val];
RETURN[f];
};
EnumerateFormatters: PUBLIC PROC [action: LoganBerryEntry.EachFormatterAction] RETURNS [BOOL] ~ {
Enumerates pairs currently in the formatter registry in unspecified order; applies action to each pair until action returns TRUE or no more pairs; returns TRUE if some action returns TRUE.
Action: RefTab.EachPairAction = {
[key: ROPE, val: RefTab.Val] RETURNS [quit: BOOL ← FALSE]
f: Formatter ¬ NARROW[val];
RETURN[action[f]];
};
RETURN[RefTab.Pairs[formatterTable, Action]];
};
There should be only one formatterTable per machine, whether or not the package is run more than once.
formatterTable ¬ NARROW[Atom.GetProp[$LoganBerryEntry, $formatterTable]];
IF formatterTable = NIL THEN {
formatterTable ¬ RefTab.Create[];
Atom.PutProp[$LoganBerryEntry, $formatterTable, formatterTable];
};
END.