<> <> <> <> <> <<>> DIRECTORY Ascii USING [Lower, Upper, NUL, SP], Atom USING [GetPName, MakeAtom], BasicTime USING [GMT, Period], IO USING [BreakProc, EndOfStream, GetTokenRope, GetLineRope, TokenProc, GetChar, SkipWhitespace, PeekChar, GetRopeLiteral, Error, STREAM, PutRope, PutF1, RIS, rope], PatternMatch USING [CheckPattern, DWIM, Lookup, MatchProc], Rope USING [Cat, Concat, Equal, Fetch, FromChar, Index, Length, Replace, ROPE, Run, SkipTo, Substr, Translate, TranslatorType], Tempus USING [Adjust, Parse, Precision, MakeRope, Unintelligible], LoganBerry, LoganQueryClass, LoganQuery; LoganQueryImpl: CEDAR PROGRAM IMPORTS Ascii, Atom, BasicTime, IO, PatternMatch, Rope, Tempus, LoganBerry, LoganQueryClass EXPORTS LoganQuery ~ BEGIN OPEN LoganQuery; ROPE: TYPE ~ Rope.ROPE; STREAM: TYPE ~ IO.STREAM; <> <> NextEntry: PUBLIC PROC [cursor: Cursor, 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: Cursor] RETURNS [] = { <> IF cursor.class.destroy = NIL THEN RETURN; cursor.class.destroy[cursor]; }; <> <> QueryEntries: PUBLIC PROC [db: LoganBerry.OpenDB, patterns: AttributePatterns, baseIndex: LoganBerry.AttributeType Ź NIL, defaultPattern: PatternType Ź "DWIM", planOnly: BOOLEAN Ź FALSE] RETURNS [cursor: Cursor, plan: QueryPlan] ~ { <> dbInfo: LoganBerry.SchemaInfo Ź LoganBerry.Describe[db: db]; base: SubPlan Ź NIL; <

> FOR p: AttributePatterns Ź patterns, p.rest WHILE p # NIL DO possibleBase: BOOLEAN = baseIndex=NIL OR baseIndex=p.first.attr.type; new: SubPlan Ź AnalyzeSubPlan[p.first, dbInfo, possibleBase, defaultPattern]; SELECT TRUE FROM NOT possibleBase, new.itype = $notAnIndex => plan Ź CONS[new, plan]; baseIndex = p.first.attr.type, base = NIL => base Ź new; new.cost <= base.cost => { -- new best base plan Ź CONS[base, plan]; base Ź new; }; ENDCASE => plan Ź CONS[new, plan]; -- new plan not best ENDLOOP; IF base = NIL THEN { -- no attribute pattern for base IF baseIndex = NIL THEN baseIndex Ź dbInfo.indices.first.key; -- pick arbitrary base base Ź AnalyzeSubPlan[NEW[AttributePatternRec Ź [attr: [baseIndex, NIL], ptype: NIL]], dbInfo, TRUE, defaultPattern]; }; IF base.itype = $notAnIndex THEN ERROR LoganBerry.Error[$NoIndex, "No suitable base index"]; plan Ź CONS[base, plan]; IF planOnly THEN RETURN; <> cursor Ź LoganQueryClass.GenerateEntries[db: db, key: base.attr.type, start: base.start, end: base.end]; <> FOR p: QueryPlan Ź plan, p.rest WHILE p # NIL DO IF NOT Rope.Equal[p.first.attr.value, ""] AND p.first.filter#NIL THEN cursor Ź LoganQueryClass.FilterEntries[input: cursor, pattern: p.first.attr.value, filter: p.first.filter, atype: p.first.attr.type, stopIfNothingGreater: FALSE]; ENDLOOP; cursor Ź LoganQueryClass.EnableAborts[input: cursor]; }; AnalyzeSubPlan: PROC [p: AttributePattern, dbInfo: LoganBerry.SchemaInfo, computeCost: BOOLEAN Ź TRUE, defaultPattern: PatternType] RETURNS [plan: SubPlan] ~ { okPattern: BOOLEAN; plan Ź NEW[SubPlanRec Ź [attr: p.attr, ptype: p.ptype]]; IF plan.ptype=NIL THEN plan.ptype Ź defaultPattern; IF Rope.Equal[plan.ptype, "DWIM", FALSE] THEN { plan.wasDWIM Ź TRUE; plan.ptype Ź PatternMatch.DWIM[plan.attr.value]; }; plan.filter Ź PatternMatch.Lookup[plan.ptype]; IF plan.filter=NIL THEN plan.errMsg Ź "INVALID PATTERN MATCHING"; [okPattern, plan.infoMsg] Ź PatternMatch.CheckPattern[plan.attr.value, plan.filter]; IF NOT okPattern THEN plan.errMsg Ź "BAD PATTERN"; IF plan.wasDWIM THEN plan.infoMsg Ź Rope.Cat["using ", plan.ptype, "...", plan.infoMsg]; IF NOT computeCost THEN RETURN; FOR i: LIST OF LoganBerry.IndexInfo Ź dbInfo.indices, i.rest WHILE i#NIL DO IF i.first.key = plan.attr.type THEN { plan.itype Ź i.first.order; EXIT; }; ENDLOOP; IF plan.itype = $notAnIndex THEN RETURN; [plan.start, plan.end] Ź BaseStartEnd[plan.attr.value, plan.ptype, plan.itype]; plan.cost Ź QueryCost[plan.start, plan.end, plan.itype]; }; QueryCost: PROC [start, end: ROPE, itype: ATOM Ź $lex] RETURNS [est: REAL Ź 1.0] ~ { <> N: NAT = 5; run: INT; sChar, eChar: CHAR; IF end=NIL THEN RETURN[1.0]; IF start=NIL THEN start Ź " "; SELECT itype FROM $lex, $ascii => { run Ź Rope.Run[s1: start, s2: end, case: itype=$ascii]; IF run > N THEN RETURN[0.0]; -- the query has negligible cost est Ź 1.0; THROUGH [1..run] DO est Ź est*0.01; ENDLOOP; -- est Ź 1/100run sChar Ź IF Rope.Length[start] <= run THEN ' ELSE Rope.Fetch[start, run]; eChar Ź IF Rope.Length[end] <= run THEN ' ELSE Rope.Fetch[end, run]; IF itype=$lex THEN { sChar Ź Ascii.Upper[sChar]; eChar Ź Ascii.Upper[eChar]; }; est Ź est*MIN[eChar-sChar,100]*0.01; }; $gmt => { startDate, endDate: BasicTime.GMT; year: REAL Ź 31536000.0; startDate Ź Tempus.Parse[rope: start, search: TRUE ! Tempus.Unintelligible => GOTO BadPattern].time; endDate Ź Tempus.Parse[rope: end, search: TRUE ! Tempus.Unintelligible => GOTO BadPattern].time; est Ź BasicTime.Period[from: startDate, to: endDate]/year; -- assume one year is complete database IF est < 0 OR est > 1.0 THEN est Ź 1.0; EXITS BadPattern => RETURN[1.0]; }; ENDCASE => RETURN[0.5]; -- don't know the index layout so assume half the index will be needed on average }; BaseStartEnd: PROC [pattern: ROPE, ptype: ROPE, itype: ATOM Ź $lex] RETURNS [start, end: ROPE] ~ { <> ENABLE SyntaxError => {start Ź end Ź NIL; CONTINUE;}; -- raised by ParseSubrange Bump: PROC [old: ROPE] RETURNS [new: ROPE] ~ INLINE { last: INT = Rope.Length[old] - 1; new Ź IF last >= 0 THEN Rope.Replace[base: old, start: last, len: 1, with: Rope.FromChar[SUCC[Ascii.Lower[Rope.Fetch[old, last]]]]] ELSE NIL; }; Upper: Rope.TranslatorType = { <<[old: CHAR] RETURNS [new: CHAR] -- old Cedar7.0 impl>> <<[old: CHAR] RETURNS [CHAR]>> new: CHAR Ź Ascii.Upper[old]; RETURN[new]; }; Lower: Rope.TranslatorType = { <<[old: CHAR] RETURNS [new: CHAR] --old Cedar7.0 impl>> <<[old: CHAR] RETURNS [CHAR]>> new: CHAR Ź Ascii.Lower[old]; RETURN[new]; }; SELECT itype FROM $lex => { SELECT TRUE FROM Rope.Equal[ptype, "exact", FALSE] => { start Ź pattern; end Ź pattern; }; Rope.Equal[ptype, "prefix", FALSE] => { start Ź pattern; end Ź Bump[start]; }; Rope.Equal[ptype, "wildcard", FALSE] => { start Ź Rope.Substr[base: pattern, len: Rope.Index[s1: pattern, s2: "*"]]; end Ź Bump[start]; }; Rope.Equal[ptype, "re", FALSE] => { i: INT Ź Rope.SkipTo[s: pattern, skip: "\'#[^$*+(\\<{!"]; -- look for special chars IF NOT i = Rope.Length[pattern] AND Rope.Fetch[pattern, i] = '* THEN -- could be zero of previous char i Ź i-1; start Ź Rope.Substr[base: pattern, len: i]; end Ź Bump[start]; }; Rope.Equal[ptype, "soundex", FALSE] => { start Ź Rope.FromChar[Rope.Fetch[base: pattern, index: 0]]; end Ź Bump[start]; }; Rope.Equal[ptype, "subrange", FALSE] => { [start, end] Ź ParseSubrange[pattern]; }; Rope.Equal[ptype, "numrange", FALSE] => { <> s, e: ROPE; [s, e] Ź ParseSubrange[pattern ! SyntaxError => {start Ź NIL; CONTINUE}]; IF Rope.Length[s] = Rope.Length[e] THEN { start Ź Rope.Substr[base: s, len: Rope.Run[s1: s, s2: e]]; end Ź Bump[start]; } ELSE start Ź end Ź NIL; -- can do nothing intelligent, e.g. 300-3000 }; Rope.Equal[ptype, "daterange", FALSE] => { start Ź end Ź NIL; -- can do nothing intelligent }; Rope.Equal[ptype, "date", FALSE] => { start Ź end Ź NIL; -- can do nothing intelligent }; ENDCASE => start Ź end Ź NIL; }; $ascii => { start Ź BaseStartEnd[Rope.Translate[base: pattern, translator: Upper], ptype, $lex].start; end Ź BaseStartEnd[Rope.Translate[base: pattern, translator: Lower], ptype, $lex].end; }; $gmt => { SELECT TRUE FROM Rope.Equal[ptype, "date", FALSE] => { patternDate: BasicTime.GMT; patternPrecision: Tempus.Precision; [patternDate, patternPrecision] Ź Tempus.Parse[rope: pattern, search: TRUE ! Tempus.Unintelligible => GOTO BadPattern]; start Ź Tempus.MakeRope[time: patternDate, precision: patternPrecision]; [patternDate, patternPrecision] Ź SELECT patternPrecision FROM years => Tempus.Adjust[years: 1, baseTime: patternDate], months => Tempus.Adjust[months: 1, baseTime: patternDate], days => Tempus.Adjust[days: 1, baseTime: patternDate], hours => Tempus.Adjust[hours: 1, baseTime: patternDate], minutes => Tempus.Adjust[minutes: 1, baseTime: patternDate], seconds => Tempus.Adjust[seconds: 1, baseTime: patternDate], ENDCASE => Tempus.Adjust[seconds: 1, baseTime: patternDate]; end Ź Tempus.MakeRope[time: patternDate, precision: patternPrecision]; EXITS BadPattern => start Ź end Ź NIL; }; Rope.Equal[ptype, "daterange", FALSE] => { patternDate: BasicTime.GMT; patternPrecision: Tempus.Precision; [start, end] Ź ParseSubrange[pattern]; [patternDate, patternPrecision] Ź Tempus.Parse[rope: start, search: TRUE ! Tempus.Unintelligible => GOTO BadPattern]; start Ź Tempus.MakeRope[time: patternDate, precision: patternPrecision]; [patternDate, patternPrecision] Ź Tempus.Parse[rope: end, search: TRUE ! Tempus.Unintelligible => GOTO BadPattern]; patternDate Ź SELECT patternPrecision FROM years => Tempus.Adjust[baseTime: patternDate, years: 1, seconds: -1].time, months => Tempus.Adjust[baseTime: patternDate, months: 1, seconds: -1].time, days => Tempus.Adjust[baseTime: patternDate, days: 1, seconds: -1].time, hours => Tempus.Adjust[baseTime: patternDate, hours: 1, seconds: -1].time, minutes => Tempus.Adjust[baseTime: patternDate, minutes: 1, seconds: -1].time, ENDCASE => Tempus.Adjust[baseTime: patternDate, seconds: 1].time; end Ź Tempus.MakeRope[time: patternDate, precision: seconds]; EXITS BadPattern => start Ź end Ź NIL; }; ENDCASE => start Ź end Ź NIL; }; $int => { SELECT TRUE FROM Rope.Equal[ptype, "exact", FALSE] => start Ź end Ź pattern; Rope.Equal[ptype, "intrange", FALSE] => [start, end] Ź ParseSubrange[pattern]; ENDCASE => start Ź end Ź NIL; }; ENDCASE => start Ź end Ź NIL; -- search complete database }; <> SyntaxError: PUBLIC ERROR [explanation: ROPE Ź NIL] = CODE; ReadAttributePattern: PROC [s: STREAM, prefetch: ROPE Ź NIL] RETURNS [a: AttributePattern] ~ { <> ENABLE IO.EndOfStream => ERROR SyntaxError["unexpected end of input"]; ch: CHAR; token: ROPE Ź prefetch; IF token = NIL THEN token Ź IO.GetTokenRope[s, IO.TokenProc ! IO.EndOfStream => GOTO none].token; a Ź NEW[AttributePatternRec]; a.attr.type Ź Atom.MakeAtom[token]; ch Ź IO.GetChar[s]; -- attribute separation char or "(" IF ch = '( THEN { -- read pattern type a.ptype Ź IO.GetTokenRope[s, IO.TokenProc].token; ch Ź IO.GetChar[s]; IF ch # ') THEN ERROR SyntaxError[Rope.Concat["unmatched ()'s: last read ", a.ptype]]; ch Ź IO.GetChar[s]; }; IF ch # ': THEN ERROR SyntaxError[Rope.Concat["missing colon: last read ", a.ptype]]; [] Ź IO.SkipWhitespace[stream: s, flushComments: FALSE]; IF IO.PeekChar[s] = '" THEN { a.attr.value Ź IO.GetRopeLiteral[s ! IO.Error => ERROR SyntaxError["Malformed rope literal"]]; } ELSE a.attr.value Ź IO.GetTokenRope[s, TokenProc].token; EXITS none => RETURN[NIL]; }; ReadAttributePatterns: PUBLIC PROC [s: IO.STREAM] RETURNS [ap: AttributePatterns] ~ { <> a: AttributePattern; endOfAp: AttributePatterns Ź NIL; a Ź ReadAttributePattern[s]; WHILE a # NIL DO IF endOfAp = NIL THEN ap Ź endOfAp Ź LIST[a] ELSE { endOfAp.rest Ź LIST[a]; endOfAp Ź endOfAp.rest; }; a Ź ReadAttributePattern[s]; ENDLOOP; }; WriteAttributePattern: PROC [s: IO.STREAM, a: AttributePattern] RETURNS [] ~ { IO.PutRope[s, Atom.GetPName[a.attr.type]]; IF a.ptype # NIL THEN IO.PutF1[s, "(%g)", IO.rope[a.ptype]]; IO.PutF1[s, ": ""%g"" ", IO.rope[a.attr.value]]; }; WriteAttributePatterns: PUBLIC PROC [s: IO.STREAM, ap: AttributePatterns] RETURNS [] ~ { FOR p: AttributePatterns Ź ap, p.rest WHILE p # NIL DO WriteAttributePattern[s, p.first]; ENDLOOP; }; PatternsToEntry: PUBLIC PROC [ap: AttributePatterns] RETURNS [entry: LoganBerry.Entry] ~ { endOfEntry: LoganBerry.Entry Ź NIL; FOR p: AttributePatterns Ź ap, p.rest WHILE p # NIL DO IF endOfEntry = NIL THEN entry Ź endOfEntry Ź LIST[p.first.attr] ELSE { endOfEntry.rest Ź LIST[p.first.attr]; endOfEntry Ź endOfEntry.rest; }; ENDLOOP; }; EntryToPatterns: PUBLIC PROC [entry: LoganBerry.Entry] RETURNS [ap: AttributePatterns] ~ { pattern: AttributePattern; endOfPattern: AttributePatterns Ź NIL; FOR e: LoganBerry.Entry Ź entry, e.rest WHILE e # NIL DO pattern Ź NEW[AttributePatternRec Ź [attr: e.first]]; IF endOfPattern = NIL THEN ap Ź endOfPattern Ź LIST[pattern] ELSE { endOfPattern.rest Ź LIST[pattern]; endOfPattern Ź endOfPattern.rest; }; ENDLOOP; }; <> <> <<>> BooleanFilterEntries: PUBLIC PROC [input: Cursor, query: ParseTree, inputOrder: LoganBerry.AttributeType, primaryKey: LoganBerry.AttributeType, defaultPattern: PatternType Ź "DWIM"] RETURNS [output: Cursor] ~ { <> <> output Ź CursorForSubtree[input, query, inputOrder, primaryKey, defaultPattern]; output Ź LoganQueryClass.EnableAborts[input: output]; }; CursorForSubtree: PROC [input: Cursor, node: ParseNode, order, key: LoganBerry.AttributeType, dp: PatternType] RETURNS [output: Cursor] ~ { <> LookupFilter: PROC [ap: AttributePattern, default: PatternType] RETURNS [proc: PatternMatch.MatchProc] ~ { IF ap.ptype=NIL THEN ap.ptype Ź default; IF Rope.Equal[ap.ptype, "DWIM", FALSE] THEN ap.ptype Ź PatternMatch.DWIM[ap.attr.value]; proc Ź PatternMatch.Lookup[ap.ptype]; }; SELECT node.tag FROM $and => { <> output1: Cursor Ź CursorForSubtree[input, node.child1, order, key, dp]; output Ź CursorForSubtree[output1, node.child2, order, key, dp]; }; $or => { <> input1, input2, output1, output2: Cursor; [input1, input2] Ź LoganQueryClass.DuplicateEntries[input]; output1 Ź CursorForSubtree[input1, node.child1, order, key, dp]; output2 Ź CursorForSubtree[input2, node.child2, order, key, dp]; output Ź LoganQueryClass.MergeEntries[output1, output2, order]; IF order = key THEN output Ź LoganQueryClass.UnDuplicateEntries[output, order]; <> }; $not => { <> input1, fullinput, output1: Cursor; IF node.child1.tag = $ap THEN { -- simple case output Ź LoganQueryClass.AntiFilterEntries[input: input, pattern: node.child1.ap.attr.value, filter: LookupFilter[node.child1.ap, dp], atype: node.child1.ap.attr.type]; RETURN [output]; }; [input1, fullinput] Ź LoganQueryClass.DuplicateEntries[input]; output1 Ź CursorForSubtree[input1, node.child1, order, key, dp]; output Ź LoganQueryClass.SubtractEntries[fullinput, output1, key, order]; }; $ap => { <> output Ź LoganQueryClass.FilterEntries[input: input, pattern: node.ap.attr.value, filter: LookupFilter[node.ap, dp], atype: node.ap.attr.type]; }; ENDCASE; }; <<>> <> <> <<>> <> <> <> <> <> <<>> <> <<>> TokenStream: TYPE = REF TokenStreamRec; TokenStreamRec: TYPE = RECORD [ stream: STREAM, prefetch: ROPE _ NIL ]; ParseBooleanQuery: PUBLIC PROC [s: IO.STREAM] RETURNS [tree: ParseTree] ~ { <> ts: TokenStream Ź NEW[TokenStreamRec Ź [s]]; tree Ź GetQuery[ts]; }; <<>> GetQuery: PROC [ts: TokenStream] RETURNS [tree: ParseTree] ~ { <> subTree: ParseTree Ź GetBoolexpr[ts]; IF PeekToken[ts] # NIL THEN { tree Ź NEW[ParseNodeRec Ź [tag: $and]]; tree.child1 Ź subTree; tree.child2 Ź GetQuery[ts]; } ELSE { tree Ź subTree; }; }; GetBoolexpr: PROC [ts: TokenStream] RETURNS [tree: ParseTree] ~ { <> subTree: ParseTree Ź GetTerm[ts]; IF Rope.Equal[PeekToken[ts], "OR", FALSE] THEN { [] Ź NextToken[ts]; tree Ź NEW[ParseNodeRec Ź [tag: $or]]; tree.child1 Ź subTree; tree.child2 Ź GetBoolexpr[ts]; } ELSE { tree Ź subTree; }; }; GetTerm: PROC [ts: TokenStream] RETURNS [tree: ParseTree] ~ { <> subTree: ParseTree Ź GetFactor[ts]; IF Rope.Equal[PeekToken[ts], "AND", FALSE] THEN { [] Ź NextToken[ts]; tree Ź NEW[ParseNodeRec Ź [tag: $and]]; tree.child1 Ź subTree; tree.child2 Ź GetTerm[ts]; } ELSE { tree Ź subTree; }; }; GetFactor: PROC [ts: TokenStream] RETURNS [tree: ParseTree] ~ { <> token: ROPE Ź PeekToken[ts]; SELECT TRUE FROM Rope.Equal[token, "NOT", FALSE] => { token Ź NextToken[ts]; tree Ź NEW[ParseNodeRec Ź [tag: $not]]; tree.child1 Ź GetFactor[ts]; }; Rope.Equal[token, "("] => { token Ź NextToken[ts]; tree Ź GetBoolexpr[ts]; token Ź NextToken[ts]; IF NOT Rope.Equal[token, ")"] THEN ERROR SyntaxError["Unmatched parenthesis"]; }; ENDCASE => { -- attribute-pattern tree Ź GetAttrributePattern[ts]; }; }; GetAttrributePattern: PROC [ts: TokenStream] RETURNS [tree: ParseTree] ~ { <> tree Ź NEW[ParseNodeRec Ź [tag: $ap]]; tree.ap Ź ReadAttributePattern[ts.stream, ts.prefetch]; IF tree.ap = NIL THEN ERROR SyntaxError["Unexpected end of input"]; ts.prefetch Ź NIL; }; TokenProc: IO.BreakProc ~ { RETURN[SELECT char FROM IN [Ascii.NUL .. Ascii.SP] => sepr, '(, '), ': => break, ENDCASE => other]; }; NextToken: PROC [ts: TokenStream] RETURNS [token: ROPE] ~ { IF ts.prefetch # NIL THEN token Ź ts.prefetch ELSE token Ź IO.GetTokenRope[ts.stream, TokenProc ! IO.EndOfStream => {token Ź NIL; CONTINUE}].token; ts.prefetch Ź NIL; }; PeekToken: PROC [ts: TokenStream] RETURNS [token: ROPE] ~ { IF ts.prefetch = NIL THEN ts.prefetch Ź IO.GetTokenRope[ts.stream, TokenProc ! IO.EndOfStream => CONTINUE].token; token Ź ts.prefetch; }; <> AbortQuery: PUBLIC PROC [cursor: Cursor] ~ { <> LoganQueryClass.AbortQuery[cursor]; }; <<>> <> ParseSubrange: PROC [r: ROPE] RETURNS [start, end: ROPE Ź NIL] ~ { <> ENABLE IO.EndOfStream, IO.Error => GOTO Bad; ToDash: IO.BreakProc = { <<[char: CHAR] RETURNS [IO.CharClass]>> RETURN[SELECT char FROM '- => sepr, ENDCASE => other]; }; s: IO.STREAM Ź IO.RIS[r]; start Ź IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetTokenRope[s, ToDash].token; IF IO.GetChar[s] # '- THEN GOTO Bad; end Ź IF IO.PeekChar[s] = '" THEN IO.GetRopeLiteral[s] ELSE IO.GetLineRope[s]; EXITS Bad => ERROR SyntaxError["Not a subrange"]; }; END.