<<>> <> <> <> <> <> <<>> <> <> <<>> DIRECTORY Atom, Customize, CustomizeExtras, <> IO, PreDebug, Rope, SymTab; CustomizeImpl: CEDAR MONITOR IMPORTS Atom, <> IO, PreDebug, Rope, SymTab EXPORTS Customize, CustomizeExtras = BEGIN OPEN Customize; ROPE: TYPE = Rope.ROPE; STREAM: TYPE = IO.STREAM; error: ERROR = CODE; Error: PROC [] = {ERROR error}; DB: TYPE = REF DBRec; DBreadonly: TYPE = REF READONLY DBRec; DBRec: PUBLIC TYPE = RECORD [ value: REF Ź NIL, identifier: SymTab.Ref Ź NIL, -- contains following identifiers wildN: DB Ź NIL, wild1: DB Ź NIL ]; CopyDB: PUBLIC PROC [source: DBreadonly] RETURNS [copy: DB] = { copy Ź CreateDB[]; MergeDB[copy, source, FALSE]; RETURN; <<-->> <> <> <> <> <<<>>> <> <> <> < x Ź CopyDB[db];>> < {};>> <<[] Ź SymTab.Insert[copy.identifier, key, x];>> <<};>> <> <<[] Ź SymTab.Pairs[source.identifier, EachEntry];>> <<};>> }; MergeDB: PUBLIC PROC [into: DB, from: DBreadonly, overwrite: BOOL] = { <> <> IF from.value#NIL THEN { IF overwrite OR into.value=NIL THEN into.value Ź from.value; }; IF from.wildN#NIL THEN { IF into.wildN=NIL THEN into.wildN Ź CreateDB[]; MergeDB[into.wildN, from.wildN, overwrite]; }; IF from.wild1#NIL THEN { IF into.wild1=NIL THEN into.wild1 Ź CreateDB[]; MergeDB[into.wild1, from.wild1, overwrite]; }; IF from.identifier#NIL THEN { MergeOneEntry: SymTab.EachPairAction = { WITH val SELECT FROM fromChild: DB => { Update: SymTab.UpdateAction = { IF found THEN { WITH val SELECT FROM intoChild: DB => { MergeDB[intoChild, fromChild, overwrite]; op Ź none; }; ENDCASE => {} } ELSE { newChild: DB Ź CreateDB[]; MergeDB[newChild, fromChild, overwrite]; op Ź store; new Ź newChild; }; }; SymTab.Update[into.identifier, key, Update] } ENDCASE => {}; }; IF into.identifier=NIL THEN into.identifier Ź SymTab.Create[SymTab.GetSize[from.identifier]+1]; [] Ź SymTab.Pairs[from.identifier, MergeOneEntry]; }; }; <> <<>> freeQuery: Query Ź NIL; FreeQuery: PUBLIC PROC [query: Query] = { <> <> old: Query Ź freeQuery; IF old=NIL OR old.countreserve THEN {freeQuery Ź NIL; RETURN [query]}; query Ź NEW[QueryRec[reserve+1]]; RETURN [query]; }; <<>> <> Token: TYPE = RECORD [ type: {name, dot, wildN, wild1, colon, bang, error, eof, leftParen, rightParen, verticalbar}, data: Rope.ROPE Ź NIL --scanned name ]; <<--wild1 is represented as a question mark>> <<--wildN is represented as a asterix>> Break: IO.BreakProc = { RETURN[SELECT char FROM IN ['A..'Z], IN ['a..'z], IN ['0..'9], '-, '_ => other ENDCASE => sepr] }; GetToken: PROC [stream: STREAM, buffer: REF TEXT Ź NIL] RETURNS [t: Token] = { c: CHAR; IF IO.EndOf[stream] THEN {t.type Ź eof; RETURN}; [] Ź IO.SkipWhitespace[stream]; IF IO.EndOf[stream] THEN {t.type Ź eof; RETURN}; SELECT c Ź IO.GetChar[stream] FROM IN ['A..'Z], IN ['a..'z], IN ['0..'9], '-, '_ => { rt: REF TEXT; IO.Backup[stream, c]; rt Ź IO.GetToken[stream, Break, buffer].token; t.type Ź name; t.data Ź Rope.FromRefText[rt]; }; '. => t.type Ź dot; '* => t.type Ź wildN; ': => t.type Ź colon; '! => t.type Ź bang; '( => t.type Ź leftParen; ') => t.type Ź rightParen; '| => t.type Ź verticalbar; '? => t.type Ź wild1; ENDCASE => {t.type Ź error; t.data Ź NIL}; }; emptyRope: ROPE Ź ""; ScanValue: PROC [stream: STREAM] RETURNS [val: ROPE Ź emptyRope] = { IF IO.EndOf[stream] THEN RETURN; [] Ź IO.SkipWhitespace[stream]; IF ~IO.EndOf[stream] THEN { value: ROPE Ź IO.GetLineRope[stream]; IF value=NIL THEN value Ź emptyRope; RETURN [value]; }; }; SkipLine: PROC [stream: STREAM] = { c: CHAR; WHILE ~IO.EndOf[stream] DO SELECT c Ź IO.GetChar[stream] FROM IO.CR, IO.LF => RETURN[]; ENDCASE => NULL; ENDLOOP; }; <<>> <> <<>> <> Parse: PROC [db: DB, stream: IO.STREAM, expliciteValue: REF Ź NIL] RETURNS [errors: ROPE Ź NIL] = { newEntry: BOOL Ź TRUE; token: Token; buffer: REF TEXT Ź NEW[TEXT[64]]; currentRDB: DB Ź NIL; AddId: PROC [id: Rope.ROPE] = { action: SymTab.UpdateAction = { WITH val SELECT FROM db: DB => currentRDB Ź db; ENDCASE => { currentRDB Ź CreateDB[]; RETURN [store, currentRDB]; }; }; IF currentRDB.identifier=NIL THEN currentRDB.identifier Ź SymTab.Create[3]; SymTab.Update[currentRDB.identifier, id, action]; }; FinishEntry: PROC [ignore: BOOL Ź FALSE] = { val: REF Ź ScanValue[stream]; IF expliciteValue#NIL THEN val Ź expliciteValue; currentRDB.value Ź val; }; ParseError: PROC [message: ROPE] = { pos: INT Ź IO.GetIndex[stream]; errors Ź IO.PutFR["%g %g at pos %g\n", IO.rope[errors], IO.rope[message], IO.int[pos]]; SkipLine[stream]; newEntry Ź TRUE; }; wasWildN: BOOL; --hack to optimize adjacent wildcards WHILE TRUE DO IF newEntry THEN { currentRDB Ź db; newEntry Ź FALSE; wasWildN Ź FALSE; }; token Ź GetToken[stream, buffer]; SELECT token.type FROM name => {AddId[token.data]; wasWildN Ź FALSE}; dot => {--ignore dots; they are separators...--}; colon => {FinishEntry[]; newEntry Ź TRUE}; wildN => { IF wasWildN THEN LOOP; wasWildN Ź TRUE; IF currentRDB.wildN=NIL THEN currentRDB.wildN Ź CreateDB[]; currentRDB Ź currentRDB.wildN; }; wild1 => { IF currentRDB.wild1=NIL THEN currentRDB.wild1 Ź CreateDB[]; currentRDB Ź currentRDB.wild1; wasWildN Ź FALSE; }; bang => {SkipLine[stream]; newEntry Ź TRUE}; eof => { IF expliciteValue#NIL THEN currentRDB.value Ź expliciteValue; RETURN [] }; ENDCASE => ParseError["Syntax error"]; ENDLOOP; }; <<>> <> QueryRep: PUBLIC TYPE = QueryRec; QueryRec: TYPE = RECORD [ lastDef: NAT Ź 1, atoms: SEQUENCE count: NAT OF Rope.ROPE ]; <<--lastIdx: number of entries or index of last step >> <<--I know: atoms[0]=separator all the time; but it is queried>> <<--atoms[lastIdx+1]=separator>> separator: Rope.ROPE = NIL; QueryState: PUBLIC PROC [query: REF QueryRec] RETURNS [NAT] = { < of query in construction. Meaning of numerical value is private. >> RETURN [query.lastDef] }; NewQuery: PUBLIC PROC [reserve: NAT Ź 6, useMemory: REF QueryRep Ź NIL] RETURNS [q: REF QueryRep] = { <> <<: allocates enough memory for about steps or options.>> SELECT TRUE FROM useMemory#NIL AND useMemory.count>reserve => q Ź useMemory; freeQuery#NIL => q Ź INewQuery[reserve]; ENDCASE => q Ź NEW[QueryRec[reserve+1]]; q.lastDef Ź 1; q[0] Ź q[1] Ź separator; }; ResetQuery: PUBLIC PROC [query: REF QueryRep, state: NAT Ź 0] = { <. =0 means reset to empty.>> IF query=NIL THEN {IF state>1 THEN Error[] ELSE RETURN}; state Ź MAX[state, 1]; IF query.lastDef> << is a guess: allocates enough memory to append about more steps or options.>> IF query=NIL THEN RETURN [NewQuery[reserve]]; q Ź NewQuery[reserve+query.lastDef]; q.lastDef Ź query.lastDef; FOR i: NAT IN [0..q.lastDef] DO q[i] Ź query[i]; ENDLOOP; }; AppendStepOnly: PUBLIC PROC [query: REF QueryRep] RETURNS [REF QueryRep] = { <; The new step has no options yet.>> < or new query if new memory allocation needed.>> IF query=NIL THEN query Ź NewQuery[6]; BEGIN next: NAT Ź query.lastDef+1; IF query[next-2]=separator THEN RETURN [query]; --no empty steps IF next>=query.count THEN query Ź CopyQuery[query, next/2+4]; query[next] Ź separator; query.lastDef Ź next; END; RETURN [query]; }; AppendOptionOnly: PUBLIC PROC [query: REF QueryRep, option: AnyString] RETURNS [REF QueryRep] = { <. >> << must not be empty.>> < or new query if new memory allocation needed.>> IF query=NIL THEN Error[]; IF option=NIL THEN RETURN [query]; BEGIN next: NAT Ź query.lastDef+1; IF next>=query.count THEN query Ź CopyQuery[query, next/2+4]; query[next] Ź separator; query[next-1] Ź ToRope[option]; query.lastDef Ź next; END; RETURN [query]; }; <<>> ToRope: PROC [x: REF] RETURNS [Rope.ROPE] = INLINE { RETURN [WITH x SELECT FROM r: ROPE => r, a: ATOM => Atom.GetPName[a], r: REF TEXT => Rope.FromRefText[r], ENDCASE => ERROR error ]; }; AppendStep: PUBLIC PROC [query: REF QueryRep, val1, val2: AnyString Ź NIL] RETURNS [REF QueryRep] = { query Ź AppendStepOnly[query]; IF val1#NIL THEN query Ź AppendOptionOnly[query, val1]; IF val2#NIL THEN query Ź AppendOptionOnly[query, val2]; RETURN [query]; }; ParseQuery: PUBLIC PROC [string: AnyString] RETURNS [query: Query Ź NIL] = { < into a query. >> <> buffer: REF TEXT Ź NEW[TEXT[64]]; query Ź StreamParseQuery[ToStream[string], buffer]; }; StreamParseQuery: PROC [stream: STREAM, buffer: REF TEXT] RETURNS [q: Query Ź NewQuery[]] = { state: {expectStep, expectOption} Ź expectStep; token: Token; WHILE TRUE DO token Ź GetToken[stream, buffer]; SELECT state FROM expectStep => { SELECT token.type FROM leftParen => { q Ź AppendStepOnly[q]; state Ź expectOption; }; name => { q Ź AppendStepOnly[q]; q Ź AppendOptionOnly[q, token.data]; state Ź expectStep; }; eof => RETURN; ENDCASE => QueryError["( expected"]; }; expectOption => { SELECT token.type FROM name => { q Ź AppendOptionOnly[q, token.data]; state Ź expectOption; }; rightParen => state Ź expectStep; verticalbar => state Ź expectOption; ENDCASE => QueryError["| or ) or ident expected"]; }; ENDCASE => Error[]; -- can't happen ENDLOOP; }; <> QueryError: PUBLIC ERROR [what: Rope.ROPE Ź NIL] = CODE; DoQueryString: PUBLIC PROC [db: DBreadonly, string: AnyString] RETURNS [x: REF] = { <> < strings.>> q: Query Ź ParseQuery[string]; x Ź DoQuery[db, q]; FreeQuery[q]; }; DoQuery: PUBLIC PROC [db: DBreadonly, query: Query] RETURNS [REF Ź NIL] = { < with . >> xdb: DB; TRUSTED {xdb Ź LOOPHOLE[db]}; RETURN [ Follow[xdb, query, 0] ]; }; Follow: PROC [db: DB, query: REF QueryRep, sepIdx: NAT] RETURNS [REF] = { value: REF; this: NAT Ź sepIdx + 1; --index of first option next: NAT Ź 0; --index of separator after last option FindNextSeparator: PROC [] = INLINE { FOR next Ź this + 1, next + 1 WHILE query[next]#separator DO ENDLOOP; }; IF sepIdx>=query.lastDef THEN RETURN [db.value]; IF query[sepIdx]#separator THEN Error[]; FindNextSeparator[]; IF db.identifier#NIL THEN { FOR i: NAT IN [this..next) DO follow: REF ~ SymTab.Fetch[db.identifier, query[i]].val; IF follow#NIL THEN { WITH follow SELECT FROM db2: DB => { value Ź Follow[db2, query, next]; IF value # NIL THEN RETURN [value]; }; ENDCASE => {} }; ENDLOOP; }; IF db.wild1#NIL THEN { value Ź Follow[db.wild1, query, next]; IF value # NIL THEN RETURN [value]; }; IF db.wildN#NIL THEN { DO value Ź Follow[db.wildN, query, next]; IF value # NIL THEN RETURN [value]; this Ź next+1; IF this>=query.lastDef THEN RETURN [NIL]; FindNextSeparator[]; ENDLOOP; }; RETURN [NIL]; }; <<>> <> <<>> CreateDB: PUBLIC PROC [] RETURNS [x: DB] = { <> x Ź NEW[DBRec]; }; UpdateDB: PUBLIC PROC [db: DB, stream: STREAM] RETURNS [errors: ROPE Ź NIL] = { < and merge database entries into . If a specification is identical to one that already exists, the later one takes precedence. >> errors Ź Parse[db, stream, NIL]; }; ToStream: PROC [x: AnyString] RETURNS [stream: IO.STREAM] = { WITH x SELECT FROM r: ROPE => stream Ź IO.RIS[r]; rt: REF TEXT => stream Ź IO.TIS[rt]; s: STREAM => stream Ź s; ENDCASE => Error[]; }; UpdateDBString: PUBLIC PROC [db: DB, string: AnyString] RETURNS [errors: ROPE Ź NIL] = { < and and merge database entries into . >> stream: STREAM Ź ToStream[string]; errors Ź Parse[db, stream, NIL]; }; UpdateDBExplicite: PUBLIC PROC [db: DB, key: AnyString, value: REF] RETURNS [errors: ROPE Ź NIL] = { < and add as database entry into . >> <> stream: STREAM Ź ToStream[key]; SELECT TRUE FROM value=NIL => value Ź emptyRope; ISTYPE[value, DB] => Error[]; --this type has internal functions ENDCASE => {}; errors Ź Parse[db, stream, value]; }; UpdateDBFromFile: PUBLIC PROC [file: REF, inputDb: DB Ź NIL] RETURNS [db: DB, errors: ROPE Ź NIL] = { < is updated and returned again. a STREAM or a string (string is interpreted as a file name). Not found files are reported like syntax errors in the data base.>> IF inputDb=NIL THEN db Ź CreateDB[] ELSE db Ź inputDb; WITH file SELECT FROM stream: STREAM => errors Ź UpdateDB[db, stream]; < {>> <> < {>> <> <> <<};>> <> <> < {};>> <> <<};>> ENDCASE => Error[]; }; ExplainQueryError: PreDebug.Explainer = { msg Ź "Customize.QueryError"; IF args=NIL THEN RETURN; PreDebug.Raise[signalOrError, args ! QueryError => { IF ~Rope.IsEmpty[what] THEN msg Ź Rope.Cat[msg, " """, what, """"]; CONTINUE }]; }; PreDebug.RegisterErrorExplainer[QueryError, ExplainQueryError]; PreDebug.RegisterErrorExplainer[error, NIL, "Customize.error"]; END.