DIRECTORY
Ascii USING [Upper],
RefID USING [ID, Release, Seal, Unseal],
RegularExpression USING [CreateFromRope, Finder, SearchRope],
Rope USING [Compare, Equal, Fetch, InlineFetch, Length, ROPE, SkipTo, Substr],
Soundex USING [NameToCode],
LoganBerry,
LoganQuery;

LoganQueryImpl: CEDAR PROGRAM
IMPORTS Ascii, RefID, RegularExpression, Rope, Soundx: Soundex, LoganBerry
EXPORTS LoganQuery
~ BEGIN OPEN LoganQuery;

ROPE: TYPE ~ Rope.ROPE;

NextEntry: PUBLIC PROC [cursor: ComplexCursor, dir: CursorDirection _ increasing] RETURNS [entry: LoganBerry.Entry] = {
IF cursor.class.retrieve = NIL THEN RETURN[NIL];
RETURN[cursor.class.retrieve[cursor, dir]];
};

EndGenerate: PUBLIC PROC [cursor: ComplexCursor] RETURNS [] = {
IF cursor.class.destroy = NIL THEN RETURN;
cursor.class.destroy[cursor];
};

SimpleClass: QueryClass = NEW[QueryClassRec _ [$Simple, SimpleRetrieve, SimpleDestroy]];

SimpleRetrieve: RetrieveProc = {
RETURN[LoganBerry.NextEntry[cursor: cursor.data, dir: dir]];
};

SimpleDestroy: DestroyProc = {
LoganBerry.EndGenerate[cursor: cursor.data];
};

GenerateEntries: PUBLIC PROC [db: LoganBerry.OpenDB, key: LoganBerry.AttributeType, start: LoganBerry.AttributeValue _ NIL, end: LoganBerry.AttributeValue _ NIL] RETURNS [cursor: ComplexCursor] = {
cursor.class _ SimpleClass;
cursor.data _ LoganBerry.GenerateEntries[db: db, key: key, start: start, end: end];
};

FilterClass: QueryClass = NEW[QueryClassRec _ [$Filter, FilterRetrieve, FilterDestroy]];
FilterCursor: TYPE = REF FilterCursorRec;
FilterCursorRec: TYPE = RECORD [
input: ComplexCursor,
pattern: ROPE,
filter: FilterProc,
atype: LoganBerry.AttributeType,
stopNG: BOOLEAN _ FALSE
];

FilterRetrieve: RetrieveProc = {
fc: FilterCursor = NARROW[RefID.Unseal[cursor.data]];
match, nothingGreater: BOOLEAN _ FALSE;
numAtypes: INT;
entry _ NextEntry[fc.input, dir];
UNTIL match OR entry = NIL DO
numAtypes _ 0;
FOR e: LoganBerry.Entry _ entry, e.rest WHILE e # NIL DO
IF e.first.type = fc.atype THEN {
numAtypes _ numAtypes + 1;
[match, nothingGreater] _ fc.filter[e.first.value, fc.pattern];
IF match THEN EXIT;
};
ENDLOOP;
IF NOT match THEN
IF nothingGreater AND fc.stopNG AND dir = increasing AND numAtypes = 1 THEN
entry _ NIL  -- can stop before actual end of input
ELSE
entry _ NextEntry[fc.input, dir];
ENDLOOP;
};

FilterDestroy: DestroyProc = {
fc: FilterCursor = NARROW[RefID.Unseal[cursor.data]];
EndGenerate[fc.input];
[] _ RefID.Release[cursor.data];
};

FilterEntries: PUBLIC PROC [input: ComplexCursor, pattern: ROPE, filter: FilterProc, atype: LoganBerry.AttributeType, stopIfNothingGreater: BOOLEAN _ FALSE] RETURNS [output: ComplexCursor] = {
fc: FilterCursor _ NEW[FilterCursorRec];
fc.input _ input;
fc.pattern _ pattern;
fc.filter _ filter;
fc.atype _ atype;
fc.stopNG _ stopIfNothingGreater;
output.class _ FilterClass;
output.data _ RefID.Seal[fc];
};


MergerClass: QueryClass = NEW[QueryClassRec _ [$Merger, MergerRetrieve, MergerDestroy]];
MergerCursor: TYPE = REF MergerCursorRec;
MergerCursorRec: TYPE = RECORD [
input: ARRAY [0..1] OF ComplexCursor,
atype: LoganBerry.AttributeType,
prefetch: BOOLEAN _ FALSE,  -- is there a prefetched entry?
prefetchEntry: LoganBerry.Entry,  -- prefetched entry if one exists
prefetchValue: LoganBerry.AttributeValue,  -- value saved for performance reasons
prefetchInput: [0..1] _ 0,  -- which input the prefetch came from
prefetchDir: CursorDirection _ increasing  -- direction of prefetch
];

MergerRetrieve: RetrieveProc = {
mc: MergerCursor = NARROW[RefID.Unseal[cursor.data]];
newInput: [0..1];
newEntry: LoganBerry.Entry;
newValue: LoganBerry.AttributeValue;
returnNew: BOOLEAN;
IF mc.prefetch AND NOT mc.prefetchDir = dir THEN { -- prefetched in wrong direction
[] _ NextEntry[mc.input[mc.prefetchInput], dir];
mc.prefetch _ FALSE;
};
IF NOT mc.prefetch THEN {  -- go ahead and get an entry
mc.prefetchEntry _ NextEntry[mc.input[0], dir];
mc.prefetchValue _ GetAttributeValue[mc.prefetchEntry, mc.atype];
mc.prefetchInput _ 0;
mc.prefetchDir _ dir;
mc.prefetch _ TRUE;
};
newInput _ ABS[1-mc.prefetchInput];
newEntry _ NextEntry[mc.input[newInput], dir];
IF mc.prefetchEntry = NIL THEN  -- one input already exhausted
RETURN[newEntry];
IF newEntry = NIL THEN {  -- just exhausted input
entry _ mc.prefetchEntry;
mc.prefetchEntry _ NIL;
mc.prefetchInput _ newInput;
RETURN[entry];
};
newValue _ GetAttributeValue[newEntry, mc.atype];
returnNew _ SELECT Rope.Compare[newValue, mc.prefetchValue, FALSE] FROM
less => (dir = increasing),
greater => (dir = decreasing),
ENDCASE => TRUE;
IF returnNew THEN {
entry _ newEntry;
}
ELSE {
entry _ mc.prefetchEntry;
mc.prefetchEntry _ newEntry;
mc.prefetchValue _ newValue;
mc.prefetchInput _ newInput;
};
};

MergerDestroy: DestroyProc = {
mc: MergerCursor = NARROW[RefID.Unseal[cursor.data]];
EndGenerate[mc.input[0]];
EndGenerate[mc.input[1]];
[] _ RefID.Release[cursor.data];
};

MergeEntries: PUBLIC PROC [input1, input2: ComplexCursor, atype: LoganBerry.AttributeType] RETURNS [output: ComplexCursor] = {
mc: MergerCursor _ NEW[MergerCursorRec];
mc.input[0] _ input1;
mc.input[1] _ input2;
mc.atype _ atype;
mc.prefetch _ FALSE;
output.class _ MergerClass;
output.data _ RefID.Seal[mc];
};
Equal: PUBLIC FilterProc = {
SELECT Rope.Compare[s1: value, s2: pattern, case: FALSE] FROM
less => match _ FALSE;
equal => match _ TRUE;
greater => {match _ FALSE; nothingGreater _ TRUE};
ENDCASE => ERROR;
};

Prefix: PUBLIC FilterProc = {
SELECT Rope.Compare[s1: Rope.Substr[value, 0, Rope.Length[pattern]], s2: pattern, case: FALSE] FROM
less => match _ FALSE;
equal => match _ TRUE;
greater => {match _ FALSE; nothingGreater _ TRUE}
ENDCASE => ERROR;
};

Wildcard: PUBLIC FilterProc = {
SubMatch: PROC [pstart: INT, plen: INT, vstart: INT, vlen: INT] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE] = {
pchar, vchar: CHAR;
WHILE plen > 0 DO
pchar _ Ascii.Upper[pattern.Fetch[pstart]];
IF pchar = '* THEN { 
IF plen = 1 THEN RETURN [match: TRUE];
{ -- first, accept the *
newpstart: INT = pstart + 1;
newplen: INT = plen - 1;
newvstart: INT _ vstart;
newvlen: INT _ vlen;
WHILE newvlen >= 0 DO
IF SubMatch[newpstart, newplen, newvstart, newvlen].match THEN RETURN [match: TRUE];
newvstart _ newvstart + 1;
newvlen _ newvlen - 1;
ENDLOOP;
};
RETURN [match: FALSE];
};
IF vlen = 0 THEN RETURN [match: FALSE];
vchar _ Ascii.Upper[value.Fetch[vstart]];
IF pchar # vchar THEN RETURN [match: FALSE, nothingGreater: vchar > pchar];
pstart _ pstart + 1;
plen _ plen - 1;
vstart _ vstart + 1;
vlen _ vlen - 1;
ENDLOOP;
IF vlen = 0 THEN RETURN [match: TRUE] 
ELSE RETURN [match: FALSE, nothingGreater: TRUE];
};
[match, nothingGreater] _ SubMatch [0, pattern.Length[], 0, value.Length[]];
};

finderCache: RECORD[  -- cache last RE finder to improve performance
pattern: ROPE,
finder: RegularExpression.Finder
];

RE: PUBLIC FilterProc = {
finder: RegularExpression.Finder;
purePrefix: ROPE;
i: INT;
IF Rope.Equal[s1: pattern, s2: finderCache.pattern, case: FALSE] THEN  -- get from cache
finder _ finderCache.finder
ELSE {
finder _ RegularExpression.CreateFromRope[pattern: pattern, ignoreCase: TRUE, addBounds: TRUE];
finderCache.pattern _ pattern;
finderCache.finder _ finder;
};
match _ RegularExpression.SearchRope[finder, value].found;
IF NOT match THEN {  -- see if something greater might match
i _ Rope.SkipTo[s: pattern, skip: "\'#[^$*+(\\<{!"];  -- look for special chars
IF NOT i = Rope.Length[pattern] AND Rope.InlineFetch[pattern, i] = '* THEN  -- could be zero of previous char
i _ i-1;
purePrefix _ Rope.Substr[base: pattern, len: i];
IF Rope.Compare[s1: Rope.Substr[value, 0, Rope.Length[purePrefix]], s2: purePrefix, case: FALSE] = greater THEN
nothingGreater _ TRUE;
};
};

Soundex: PUBLIC FilterProc = {
ch: CHAR _ Ascii.Upper[Rope.InlineFetch[pattern,0]];
SELECT Ascii.Upper[Rope.InlineFetch[value,0]] FROM
= ch => match _ Rope.Equal[Soundx.NameToCode[value], Soundx.NameToCode[pattern]];
< ch => match _ FALSE;
> ch => {match _ FALSE; nothingGreater _ TRUE};
ENDCASE => ERROR;
};
GetAttributeValue: PROC [entry: LoganBerry.Entry, type: LoganBerry.AttributeType] RETURNS [LoganBerry.AttributeValue] ~ {
FOR e: LoganBerry.Entry _ entry, e.rest WHILE e # NIL DO
IF e.first.type = type THEN
RETURN[e.first.value];
ENDLOOP;
RETURN[NIL];
};


END.
ΰLoganQueryImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Doug Terry, February 12, 1986 11:29:36 am PST

LoganQuery allows more complicated queries to be performed on a LoganBerry database than the simple retrievals provided by the LoganBerry interface.  Database queries of various classes can be registered; retrieval operations are class-specific.  For instance, the $Filter class returns database entries that match a particular pattern, while the $Merger class merges the entries returned by two independent queries.  Filters can be cascaded to perform multiple-attribute queries.  The predefined $Simple class permits operations identical to those provided by LoganBerry.  Clients are free to create their own class of queries.

Basic operations
The following operations are syntactically and semantically similar to those provided by LoganBerry.  Any errors raised by these operations are generated by LoganBerry.
Retrieves the next entry relative to the given cursor.  The cursor is automatically updated so that NextEntry may be repeatedly called to enumerate entries.  NIL is returned if the cursor is at the end of the sequence and dir=increasing or at the start of the sequence and dir=decreasing.
Errors: IndexNotOpen, BadIndex, LogNotOpen, BadLogEntry
Releases the cursor; no further operations may be performed using the given cursor.  This must be called once for every cursor created.
Predefined query classes
$Simple

SimpleCursor: TYPE = LoganBerry.Cursor;
[cursor: ComplexCursor, dir: CursorDirection _ increasing] RETURNS [entry: LoganBerry.Entry]
[cursor: ComplexCursor] RETURNS []
Identical to the GenerateEntries operation provided by LoganBerry but returns a ComplexCursor with class=$Simple and data=LoganBerry.Cursor.
Errors: LoganBerry.NoIndex

$Filter

[cursor: ComplexCursor, dir: CursorDirection _ increasing] RETURNS [entry: LoganBerry.Entry]
could be multiple attributes of fc.atype per entry so check them all
[cursor: ComplexCursor] RETURNS []
Returns a ComplexCursor of class $Filter.  Retrievals using this new cursor apply the given pattern-matching filter to the appropriate attribute of entries identified by the input cursor.  A retrieval returns NIL if the input is exhausted or stopIfNothingGreater=TRUE and the filter procedure returns nothingGreater=TRUE.
$Merger

[cursor: ComplexCursor, dir: CursorDirection _ increasing] RETURNS [entry: LoganBerry.Entry]
so move cursor back over prefetched entry
[cursor: ComplexCursor] RETURNS []
Returns a ComplexCursor of class $Merger.  Retrievals using this new cursor merge the two input streams.  The input streams should be ordered by the given attribute type.  A retrieval returns NIL only when both inputs are exhausted.
Predefined filters
[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]
Compares the value and pattern for equality.
[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]
Checks if the pattern is a prefix of the value.  Prefix[v, "p"] is the same as Wildcard[v, "p*"], though faster.
[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]
The pattern may contain zero or more wildcards (the character "*") that match anything.
This routine was adapted from FSMainImpl2.Match.
See if there is a match between Rope.Substr[value,vstart,vlen] and Rope.Substr[pattern,pstart,plen].
quick kill for * at end of pattern
else must take all combinations
at this point demand an exact match in both strings
[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]
The pattern is taken to be a regular expression as defined in RegularExpressionDoc.tioga.
[value: ROPE, pattern: ROPE] RETURNS [match: BOOLEAN, nothingGreater: BOOLEAN _ FALSE]
Compares the value and pattern based on their Soundex codes.  The Soundex encoding tends to group together variants of the same name; for instance, Johnson, Jansen, and Johansen have identical Soundex codes.
as an optimization, only compute codes if first characters match
Miscellaneous
Doug Terry November 7, 1985 3:11:59 pm PST
created
 
Doug Terry, November 7, 1985 6:34:25 pm PST
changes to: DIRECTORY, ILQueryImpl, EXPORTS, ~, NextEntry, EndGenerate, SimpleRetrieve, SimpleDestroy, GenerateEntries, FilterEntries, MergeEntries, Equal, SimpleRetrieve, FilterClass, FilterCursorRec, FilterRetrieve, FilterDestroy, FilterEntries, FilterCursor, FilterCursorRec, Soundex, MergerClass, MergerRetrieve, MergerDestroy, Prefix, Wildcard, RE

Doug Terry, November 8, 1985 3:07:48 pm PST
changes to: Wildcard, SubMatch (local of Wildcard), RE, Soundex

Doug Terry, November 8, 1985 7:36:34 pm PST
changes to: Wildcard, SubMatch (local of Wildcard), RE, Soundex, MergerCursorRec, MergerRetrieve, DIRECTORY, IMPORTS, Equal, Prefix, NextEntry, EndGenerate, GenerateEntries, FilterEntries, MergeEntries, FilterRetrieve

Doug Terry, November 26, 1985 6:15:38 pm PST
changes to: DIRECTORY, LoganQueryImpl, IMPORTS, EXPORTS, ~, NextEntry, SimpleRetrieve, SimpleDestroy, GenerateEntries, FilterCursorRec, FilterRetrieve, FilterEntries, MergerCursorRec, MergerRetrieve, MergeEntries, GetAttributeValue, FilterDestroy, MergerDestroy

Doug Terry, December 17, 1985 11:15:09 am PST
changes to: FilterRetrieve, finderCache, RE

Doug Terry, December 23, 1985 1:58:05 pm PST
changes to: SubMatch (local of Wildcard), finderCache
Doug Terry, January 23, 1986 8:38:31 pm PST
changes to: SimpleRetrieve, SimpleDestroy, GenerateEntries
Doug Terry, February 12, 1986 11:06:34 am PST
changes to: SubMatch (local of Wildcard)

Κ2˜
codeš
œ™Kšœ
Οm
œ1™<Kš
œ-™-—K™Kš
œτ™τK™š
Οk	˜	Kšœžœ	˜Kšœžœžœ˜(Kšœžœ&˜=Kšœžœ.žœ˜NKšœžœ˜Kš
œ˜Kš
œ˜—K˜KšΠblœžœ
ž˜KšžœC˜JKšžœ˜šœžœ
ž
˜K˜Kšžœžœžœ
˜—
headš
œ™Kš
Ϭ
™¨
K˜šΟn	œžœ
žœ<žœ˜wKš
œ ™ Kš
œ7™7Kš
žœžœ
žœ
žœ
žœ˜0Kšžœ%˜+K˜—K˜š œžœ
žœžœ˜?Kš
œ‡
™‡
Kšžœžœ
žœ
žœ
˜*Kš
œ˜K˜——™K™K˜Kšœžœ;˜XK™Kšœžœ™'K˜šΟbœ˜ Kš
Πck\™\Kšžœ6˜<K˜—K˜š‘
œ˜Kš
’"™"Kš
œ,˜,K˜—K˜š œžœ
žœ[žœ#žœžœ˜Ε
Kš
œŒ
™Œ
Kš
œ™Kš
œ˜Kš
œS˜SK˜—K™K™K˜Kšœžœ;˜XK™Kšœžœžœ˜)šœžœžœ˜ Kš
œ˜Kšœ	žœ
˜Kš
œ˜Kš
œ ˜ Kšœžœž˜K˜—K˜š‘œ˜ Kš
’\™\Kšœžœ˜5Kšœžœžœ
˜'Kšœžœ
˜Kš
œ!˜!šžœžœ	žœ
ž˜Kš
œD™DKš
œ˜šžœ%žœžœ
ž˜8šžœž˜!Kš
œ˜Kš
œ?˜?Kšžœžœ
žœ
˜K˜—Kšžœ
˜—šžœ
žœž˜š	žœžœžœžœž˜KKšœžœΟc&˜3—š
ž˜Kš
œ!˜!——Kšžœ
˜—K˜—K˜š‘
œ˜Kš
’"™"Kšœžœ˜5Kš
œ˜Kš
œ ˜ K˜—K˜š 
œžœ
žœ!žœMžœžœžœ˜ΐ
Kš
œΑ™ΑKšœžœ˜(Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ˜Kš
œ!˜!Kš
œ˜Kš
œ˜K˜—K˜K™K˜Kšœžœ;˜XK™Kšœžœžœ˜)šœžœžœ˜ Kšœžœžœ˜%Kš
œ ˜ Kšœ
žœžœ£˜;Kšœ"£!˜CKšœ+£&˜QKšœ£%˜AKšœ+£˜CK˜—K˜š‘œ˜ Kš
’\™\Kšœžœ˜5Kš
œ˜Kš
œ˜Kš
œ$˜$Kšœžœ
˜š	žœ
žœ
žœžœ£ ˜SKš
œ)™)Kš
œ0˜0Kšœžœ
˜Kš
œ˜—šžœ
žœ
žœ£˜7Kš
œ/˜/Kš
œA˜AKš
œ˜Kš
œ˜Kšœžœ
˜K˜—Kšœžœ˜#Kš
œ.˜.šžœžœ
žœ£˜>Kšžœ˜—šžœžœ
žœ£˜1Kš
œ˜Kšœžœ
˜Kš
œ˜Kšžœ˜K˜—Kš
œ1˜1šœžœ*žœž˜GKš
œ˜Kš
œ˜Kšžœžœ
˜—šžœžœ˜Kš
œ˜K˜
—šžœ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜K˜—K˜—K˜š‘
œ˜Kš
’"™"Kšœžœ˜5Kš
œ˜Kš
œ˜Kš
œ ˜ K˜—K˜š œžœ
žœBžœ˜~Kš
œθ
™θ
Kšœžœ˜(Kš
œ˜Kš
œ˜Kš
œ˜Kšœžœ
˜Kš
œ˜Kš
œ˜K˜——™š‘œžœ˜Kš
’V™VK™,šžœ,žœž˜=Kšœžœ
˜Kšœžœ
˜Kšœžœžœ˜2Kšžœžœ
˜—K˜—K˜š‘œžœ˜Kš
’V™VK™pšžœRžœž˜cKšœžœ
˜Kšœžœ
˜Kšœžœžœ
˜1Kšžœžœ
˜—K˜—K˜š‘œžœ˜Kš
’V™VKš
œW™WKš
œ0™0
code2š œžœ
žœžœ
žœžœžœ	žœžœ˜}Mš
œd™dMšœžœ
˜šžœ
ž˜Mš
œ+˜+šžœžœ˜Mš
œ"™"Mšžœ
žœ
žœ	žœ˜&Mš
œ™šœ£˜Mšœžœ˜Mšœ	žœ˜Mšœžœ
˜Mšœ	žœ˜šžœž˜Mšžœ8žœ
žœ	žœ˜TMš
œ˜Mš
œ˜Mšžœ
˜—Mš
œ˜—Mšžœ	žœ˜Mš
œ˜—Mšžœ
žœ
žœ	žœ˜'Mš
œ3™3Mš
œ)˜)Mšžœžœ
žœ	žœ!˜KMš
œ˜Mš
œ˜Mš
œ˜Mš
œ˜Mšžœ
˜—šžœ
žœ
žœ	žœ˜&Mšžœ
žœ	žœžœ˜1—Mš
œ˜—Mš
œL˜LK˜—K˜šœ
žœ£.˜DKšœ	žœ
˜Kš
œ ˜ K˜K˜—šΠbkœžœ˜Kš
’V™VKš
œY™YKš
œ!˜!Kšœžœ
˜Kšœžœ
˜•StartOfExpansion-[s1: 
ROPE, s2: 
ROPE, case: 
BOOL _ TRUE]šžœ8žœžœ£˜XKš
œ˜—šžœ˜KšœHžœ
žœ˜_Kš
œ˜Kš
œ˜K˜—Kš
œ:˜:šžœ
žœžœ£'˜<Kšœ#Οoœ£˜Oš	žœ
žœžœ#žœ£!˜mK˜—Kš
œ0˜0šžœXžœž˜oKšœžœ
˜—K˜—K˜—K˜š‘œžœ˜Kš
’V™VK™Ο
Kšœžœ,˜4Kš
œ@™@šžœ(ž˜2Kš
œQ˜QKšœžœ
˜Kšœžœžœ˜/Kšžœžœ
˜—K˜——™
š œžœ;žœ ˜yšžœ%žœžœ
ž˜8šžœž˜Kšžœ˜—Kšžœ
˜—Kšžœ
žœ˜K˜K˜——K˜Kšžœ
˜™*K™—K™
™+KšœΟrΤ™ΰ—K™™+Kšœ¦œ¦
™?—K™™+Kšœ¦œ¦§
™Ω
—K™™,Kšœ¦ω
™…—K™™-Kšœ¦™+—K™™,Kšœ¦œ¦
™5—™+Kšœ¦.™:—™-Kšœ¦œ™(—K™—…— 8BJ