CustomizeImpl.mesa
Copyright Ó 1989, 1991 by Xerox Corporation. All rights reserved.
Goran Rydqvist and Christian Jacobi, July 24, 1989 9:20:43 pm PDT
Simplified algorithm Christian Jacobi, November 22, 1991 3:20 pm PST
Christian Jacobi, April 30, 1992 10:23 am PDT
Small Point:
Should xsoft take advantage of Xl and shed away from PFS; the use of PFS is not critical and could be commented out
DIRECTORY
Atom, Customize, CustomizeExtras, <<PFS,>> IO, PreDebug, Rope, SymTab;
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;
--
copy.value ¬ source.value;
IF source.wildN#NIL THEN copy.wildN ¬ CopyDB[source.wildN];
IF source.wild1#NIL THEN copy.wild1 ¬ CopyDB[source.wild1];
IF source.identifier#NIL THEN {
<<copy.identifier ¬ COPY[source.identifier]>>
EachEntry: SymTab.EachPairAction = {
x: REF ¬ val;
WITH val SELECT FROM
db: DB => x ¬ CopyDB[db];
ENDCASE => {};
[] ¬ SymTab.Insert[copy.identifier, key, x];
};
copy.identifier ¬ SymTab.Create[SymTab.GetSize[source.identifier]+1];
[] ¬ SymTab.Pairs[source.identifier, EachEntry];
};
};
MergeDB:
PUBLIC
PROC [into:
DB, from: DBreadonly, overwrite:
BOOL] = {
Merges the entries of "from" into "into"
In case of conflict, the "from" value will overwrite the "into" value
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];
};
};
Memory allocations hacks
freeQuery: Query ¬ NIL;
FreeQuery:
PUBLIC
PROC [query: Query] = {
Returns query for re-use. Caller asserts that he won't modify query anymore.
It is ok to not worry but leave query's to the garbage collector.
old: Query ¬ freeQuery;
IF old=NIL OR old.count<query.count THEN freeQuery ¬ query;
};
INewQuery:
ENTRY
PROC [reserve:
NAT]
RETURNS [Query] = {
query: Query ¬ freeQuery;
IF query#NIL AND query.count>reserve THEN {freeQuery ¬ NIL; RETURN [query]};
query ¬ NEW[QueryRec[reserve+1]];
RETURN [query];
};
Database Scanner
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;
};
Database Parser
This builds a data structure specially tailored to efficiently answering a query. For each step in the tree representing the database, a node is generated. A lookup table is created in each node to facilitate finding the next possible steps.
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;
};
Query Types
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] = {
Returns <state> 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] = {
Creates new empty query. Query does not yet have any steps or options.
<reserve>: allocates enough memory for about <reserve> 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] = {
Resets state of query to <state>. <state>=0 means reset to empty.
IF query=NIL THEN {IF state>1 THEN Error[] ELSE RETURN};
state ¬ MAX[state, 1];
IF query.lastDef<state THEN Error[];
query[state] ¬ separator;
query.lastDef ¬ state;
};
CopyQuery:
PUBLIC
PROC [query:
REF QueryRep, reserve:
NAT ¬ 0]
RETURNS [q:
REF QueryRep] = {
Creates new copy which does not share memory with query.
<reserve> is a guess: allocates enough memory to append about <reserve> 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] = {
Appends step to <query>; The new step has no options yet.
Returns <query> 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] = {
Append query option to the current step of <query>.
<query> must not be empty.
Returns <query> 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] = {
Parses <string> into a query.
May raise error QueryError.
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;
};
Query Resolver
QueryError: PUBLIC ERROR [what: Rope.ROPE ¬ NIL] = CODE;
DoQueryString:
PUBLIC
PROC [db: DBreadonly, string: AnyString]
RETURNS [x:
REF] = {
Conveniance procedure.
Query the database <db> strings.
q: Query ¬ ParseQuery[string];
x ¬ DoQuery[db, q];
FreeQuery[q];
};
DoQuery:
PUBLIC
PROC [db: DBreadonly, query: Query]
RETURNS [
REF ¬
NIL] = {
Query the database <db> with <query>.
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] = {
Creates new, empty DB.
x ¬ NEW[DBRec];
};
UpdateDB:
PUBLIC
PROC [db:
DB, stream:
STREAM]
RETURNS [errors:
ROPE ¬
NIL] = {
Parse <stream> and merge database entries into <db>. 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] = {
Parse <string> and and merge database entries into <db>.
stream: STREAM ¬ ToStream[string];
errors ¬ Parse[db, stream, NIL];
};
UpdateDBExplicite:
PUBLIC
PROC [db:
DB, key: AnyString, value:
REF]
RETURNS [errors:
ROPE ¬
NIL] = {
Parse <key> and add <value> as database entry into <db>.
Database values may be overwriten, but, they can't be removed.
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] = {
Conveniance procedure: <inputDb> is updated and returned again. <file> 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];
name: ROPE => {
BEGIN
ENABLE PFS.Error => {
errors ← IO.PutFR["file not opened: %g", IO.rope[error.explanation]];
GOTO failed;
};
stream: STREAM ← PFS.StreamOpen[PFS.PathFromRope[name]];
errors ← UpdateDB[db, stream];
EXITS failed => {};
END;
};
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
}];
};