EDIFGrammarImpl:
CEDAR
PROGRAM
IMPORTS Atom, HashTable, IO, RedBlackTree, Rope, StructuredStreams, TiogaAccess, UnparserBuffer
EXPORTS EDIFGrammar
= {OPEN EDIFGrammar, SS: StructuredStreams, UB: UnparserBuffer;
ROPE: TYPE = Rope.ROPE;
Grammar: TYPE = REF GrammarPrivate;
GrammarPrivate:
TYPE =
RECORD [
defQuick: HashTable.Table,
defs, tUses, ntUses, keyUses: RedBlackTree.Table
];
Usage: TYPE = REF UsagePrivate;
UsagePrivate:
TYPE =
RECORD [
subject: ATOM,
users: ATOMList ← NIL
];
g: Grammar ← NewGrammar[];
termNames:
ARRAY TerminalClass
OF
ATOM = [
String: $String,
Integer: $Integer,
Identifier: $Identifier,
Form: $Form
];
NewGrammar:
PROC
RETURNS [g: Grammar] = {
g ←
NEW [GrammarPrivate ← [
defQuick: HashTable.Create[],
defs: RedBlackTree.Create[GetIDKey, CompareATOMs],
tUses: RedBlackTree.Create[GetUsageKey, CompareUsages],
ntUses: RedBlackTree.Create[GetUsageKey, CompareUsages],
keyUses: RedBlackTree.Create[GetUsageKey, CompareUsages]
]];
};
GetIDKey: PROC [data: REF ANY] RETURNS [REF ANY] --RedBlackTree.GetKey-- = {RETURN [data]};
CompareATOMs:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison]
--RedBlackTree.Compare-- = {
k1: ATOM = NARROW[k];
k2: ATOM = NARROW[data];
c ← Atom.GetPName[k1].Compare[Atom.GetPName[k2], FALSE];
};
GetUsageKey:
PROC [data:
REF
ANY]
RETURNS [
ATOM]
--RedBlackTree.GetKey-- = {
u: Usage = NARROW[data];
RETURN [u.subject]};
CompareUsages:
PROC [k, data:
REF
ANY]
RETURNS [c: Basics.Comparison]
--RedBlackTree.Compare-- = {
k1: ATOM = NARROW[k];
k2: ATOM = GetUsageKey[data];
c ← Atom.GetPName[k1].Compare[Atom.GetPName[k2], FALSE];
};
GetRuleDef:
PUBLIC
PROC [category:
ATOM]
RETURNS [r: Rule] = {
r ← NARROW[g.defQuick.Fetch[category].value];
};
Def:
PROC [g: Grammar, category:
ATOM, r: Rule] = {
or: Rule ← GetRuleDef[category];
NoteUse[g, category, r];
IF or #
NIL
THEN
WITH or
SELECT
FROM
olr:
REF levelGuard RulePrivate => {
nlr: REF levelGuard RulePrivate = NARROW[r];
cr: Rule = ConsAlt[LIST[olr, nlr]];
FOR l: Level
IN Level
DO
IF l IN [olr.min .. olr.max] AND l IN [nlr.min .. nlr.max] THEN ERROR;
ENDLOOP;
IF NOT g.defQuick.Replace[category, cr] THEN ERROR;
};
ocr:
REF choice RulePrivate => {
nlr: REF levelGuard RulePrivate = NARROW[r];
ocr.choices ← Append[ocr.choices, nlr];
};
ENDCASE => ERROR
ELSE {
IF NOT g.defQuick.Insert[category, r] THEN ERROR;
g.defs.Insert[category, category];
};
};
Append:
PROC [rl: RuleList, r: Rule]
RETURNS [rl2: RuleList] = {
tail: RuleList = LIST[r];
prev: RuleList ← NIL;
rl2 ← rl;
FOR rl ← rl, rl.rest WHILE rl # NIL DO prev ← rl ENDLOOP;
IF prev # NIL THEN prev.rest ← tail ELSE rl2 ← tail;
};
NoteUse:
PROC [g: Grammar, user:
ATOM, r: Rule] = {
Gotcha:
PROC [table: RedBlackTree.Table, use:
ATOM] = {
usage: Usage ← NARROW[table.Lookup[use]];
IF usage =
NIL
THEN {
usage ← NEW [UsagePrivate ← [use]];
table.Insert[usage, use];
};
IF usage.users = NIL OR usage.users.first # user THEN usage.users ← CONS[user, usage.users];
};
SeeList:
PROC [rl: RuleList] = {
FOR rl ← rl, rl.rest WHILE rl # NIL DO NoteUse[g, user, rl.first] ENDLOOP;
};
WITH r
SELECT
FROM
x:
REF list RulePrivate => {
IF x.keyword # NIL THEN Gotcha[g.keyUses, x.keyword];
SeeList[x.elts.rest]};
x: REF repeat RulePrivate => NoteUse[g, user, x.sub];
x: REF choice RulePrivate => SeeList[x.choices];
x: REF levelGuard RulePrivate => NoteUse[g, user, x.r];
x: REF nonTerminal RulePrivate => Gotcha[g.ntUses, x.category];
x: REF terminal RulePrivate => Gotcha[g.tUses, termNames[x.category]];
ENDCASE => ERROR;
};
PrintGrammar:
PROC [to:
IO.
STREAM, g: Grammar] = {
out: IO.STREAM = SS.Create[UB.NewHandle[[stream[to]], 75]];
PrintGrammarDefs[out, g];
PrintGrammarUses[out, g];
out.Close[]};
PrintGrammarDefsToFile:
PROC [fileName:
ROPE, g: Grammar] = {
w: TiogaAccess.Writer = TiogaAccess.Create[];
out: IO.STREAM = SS.Create[UB.NewHandle[[access[w, $code, 4]], 75]];
PrintGrammarDefs[out, g];
out.Close[];
w.WriteFile[fileName];
};
PrintGrammarDefs:
PROC [out:
IO.
STREAM, g: Grammar] = {
PrintDef:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
category: ATOM = NARROW[ra];
r: Rule = GetRuleDef[category];
SS.Begin[out];
{ENABLE UNWIND => SS.End[out];
out.PutF["%g: ", [atom[category]]];
PrintRule[out, r];
};
SS.End[out];
out.PutRope["\n"];
};
PrintUndef:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
usage: Usage = NARROW[ra];
def: Rule = GetRuleDef[usage.subject];
IF def = NIL THEN out.PutF["%g: Undefined!\n", [atom[usage.subject]]];
};
out.PutF["%l\nDefinitions:%l\n", [rope["lb"]], [rope["LB"]]];
g.defs.EnumerateIncreasing[PrintDef];
g.ntUses.EnumerateIncreasing[PrintUndef];
};
PrintGrammarUsesToFile:
PROC [fileName:
ROPE, g: Grammar] = {
w: TiogaAccess.Writer = TiogaAccess.Create[];
out: IO.STREAM = SS.Create[UB.NewHandle[[access[w, $code, 4]], 75]];
PrintGrammarUses[out, g];
out.Close[];
w.WriteFile[fileName];
};
PrintGrammarUses:
PROC [out:
IO.
STREAM, g: Grammar] = {
PrintUse:
PROC [ra:
REF
ANY]
RETURNS [stop:
BOOL ←
FALSE]
--RedBlackTree.EachNode-- = {
usage: Usage = NARROW[ra];
SS.Begin[out];
{ENABLE UNWIND => SS.End[out];
out.PutF["%g: ", [atom[usage.subject]]];
FOR uses: ATOMList ← usage.users, uses.rest
WHILE uses #
NIL
DO
SS.Bp[out, FALSE, 4];
out.Put[[atom[uses.first]]];
IF uses.rest # NIL THEN out.PutChar[' ];
ENDLOOP;
};
SS.End[out];
out.PutRope["\n"];
};
out.PutF["%l\nUses:%l\n", [rope["lb"]], [rope["LB"]]];
g.ntUses.EnumerateIncreasing[PrintUse];
g.tUses.EnumerateIncreasing[PrintUse];
};
PrintRule:
PROC [out:
IO.
STREAM, r: Rule] = {
WITH r
SELECT
FROM
x:
REF list RulePrivate => {
i: INT ← 0;
out.PutF["'%l(%l'", [rope["b"]], [rope["B"]] ];
FOR rl: RuleList ← x.elts, rl.rest
WHILE rl #
NIL
DO
out.PutChar[' ];
SS.Bp[out, FALSE, 4];
SS.Begin[out];
{ENABLE UNWIND => SS.End[out];
PrintRule[out, rl.first];
};
SS.End[out];
IF i=0 AND x.cutAfterFirst THEN out.PutRope[" !"];
i ← i + 1;
ENDLOOP;
out.PutF[" '%l)%l'", [rope["b"]], [rope["B"]] ];
};
x:
REF repeat RulePrivate => {
Close:
PROC [c:
CHAR] = {
out.PutF["%l%g%l", [rope["u"]], [character[c]], [rope["U"]] ]};
IF x.zero
AND
NOT x.moreThanOne
THEN {
out.PutChar['[];
PrintRule[out, x.sub];
out.PutChar[']];
}
ELSE {
PrintRule[out, x.sub];
};
IF x.moreThanOne THEN Close[IF x.zero THEN '* ELSE '+];
};
x:
REF choice RulePrivate => {
first: BOOL ← TRUE;
out.PutChar['(];
FOR rl: RuleList ← x.choices, rl.rest
WHILE rl #
NIL
DO
SS.Bp[out, FALSE, 4];
SS.Begin[out];
{ENABLE UNWIND => SS.End[out];
IF first THEN first ← FALSE ELSE out.PutRope["| "];
PrintRule[out, rl.first];
};
SS.End[out];
IF rl.rest # NIL THEN out.PutRope[" "];
ENDLOOP;
out.PutChar[')];
};
x:
REF levelGuard RulePrivate => {
out.PutF["%g..%g & ", [cardinal[x.min]], [cardinal[x.max]] ];
PrintRule[out, x.r];
};
x:
REF nonTerminal RulePrivate => {
IF x.onceOnly THEN out.PutChar['<];
out.Put[[atom[x.category]]];
IF x.onceOnly THEN out.PutChar['>];
};
x:
REF terminal RulePrivate => {
IF x.value #
NIL
THEN {
out.PutF["'%l", [rope["b"]]];
WITH x.value
SELECT
FROM
x: ATOM => out.Put[[atom[x]]];
x: REF INT => out.Put[[integer[x^]]];
x: ROPE => out.PutF["\"%g\"", [rope[x]]];
ENDCASE => ERROR;
out.PutF["%l'", [rope["B"]]];
}
ELSE out.PutF[
"%l%g%l",
[rope["i"]],
[atom[termNames[x.category]]],
[rope["I"]]
];
};
ENDCASE => ERROR;
};
DL:
PUBLIC
PROC [category:
ATOM, rest:
LORA, min: Level ← 0, max: Level ← 2]
RETURNS [a:
ATOM] = {
a ← DL2[category, CONS[category, rest], min, max];
};
DL2:
PUBLIC
PROC [category:
ATOM, rest:
LORA, min: Level ← 0, max: Level ← 2]
RETURNS [a:
ATOM] = {
r: Rule = Limit[ConsList[NARROW[rest.first], rest.rest], min, max];
Def[g, category, r];
a ← category;
};
DBL2:
PUBLIC
PROC [category:
ATOM, rest:
LORA, min: Level ← 0, max: Level ← 2, cutAfterFirst:
BOOL ←
FALSE]
RETURNS [a:
ATOM] = {
r: Rule = Limit[ConsList[NARROW[rest.first], rest.rest, cutAfterFirst], min, max];
Def[g, category, r];
a ← category;
};
DLU:
PUBLIC
PROC [category:
ATOM, rest:
LORA, min: Level ← 0, max: Level ← 2]
RETURNS [a:
ATOM] = {
a ← DL2[category, CONS[NIL, rest], min, max];
};
DC:
PUBLIC
PROC [category:
ATOM, choices:
LORA, min: Level ← 0, max: Level ← 2]
RETURNS [a:
ATOM] = {
r: Rule = Limit[ConsAlt[choices], min, max];
Def[g, category, r];
a ← category;
};
DQ:
PUBLIC
PROC [category:
ATOM, list:
LORA, other:
REF
ANY, min: Level ← 0, max: Level ← 2]
RETURNS [a:
ATOM] = {
sub: ATOM = Atom.MakeAtom[Atom.GetPName[category].Concat["Aux"]];
[] ← DL2[sub, list, min, max];
a ← DC[category, LIST[sub, other], min, max];
};
NameDef:
PUBLIC
PROC
RETURNS [r: Rule] = {
r ← NEW [RulePrivate ← [variant: terminal[Identifier, NIL, TRUE]]];
};
NameRef:
PUBLIC
PROC
RETURNS [r: Rule] = {
r ← NEW [RulePrivate ← [variant: terminal[Identifier]]];
};
Ch:
PUBLIC
PROC [choices:
LORA]
RETURNS [r: Rule] = {
r ← ConsAlt[choices];
};
Star:
PUBLIC
PROC [rule:
REF
ANY]
RETURNS [r: Rule] = {
r ← ConsStar[rule, TRUE, TRUE];
};
Plus:
PUBLIC
PROC [rule:
REF
ANY]
RETURNS [r: Rule] = {
r ← ConsStar[rule, FALSE, TRUE];
};
Limit:
PUBLIC
PROC [rule:
REF
ANY, min: Level ← 0, max: Level ← 2]
RETURNS [r: Rule] = {
sub: Rule ← ToRule[rule];
IF min = 0 AND max = 2 THEN RETURN [sub];
r ← NEW [RulePrivate ← [levelGuard[sub, min, max]]];
};
Opt:
PUBLIC
PROC [rule:
REF
ANY]
RETURNS [r: Rule] = {
r ← ConsStar[rule, TRUE, FALSE];
};
StarCh:
PUBLIC
PROC [choices:
LORA]
RETURNS [r: Rule] = {
r ← ConsStar[ConsAlt[choices], TRUE, TRUE];
};
Oo:
PUBLIC
PROC [category:
ATOM]
RETURNS [r: Rule] = {
ntr: REF nonTerminal RulePrivate = NARROW[ToRule[category]];
ntr.onceOnly ← TRUE;
r ← ntr;
};
LR:
PUBLIC
PROC [rules:
LORA, cutAfterFirst:
BOOL ←
FALSE]
RETURNS [r: Rule] = {
r ← ConsList[NARROW[rules.first], rules.rest, cutAfterFirst];
};
JdC:
PUBLIC
PROC [left, right: ATOMList]
RETURNS [crossed:
LORA] = {
crossed ← NIL;
FOR l: ATOMList ← left, l.rest
WHILE l #
NIL
DO
FOR r: ATOMList ← right, r.rest
WHILE r #
NIL
DO
crossed ←
CONS[
Atom.GetPName[l.first].Concat[Atom.GetPName[r.first]],
crossed];
ENDLOOP;
ENDLOOP;
};
MakeRule:
PUBLIC
PROC [category:
ATOM]
RETURNS [r: Rule] = {
r ← ToRule[category]};
ToRule:
PROC [ra:
REF
ANY]
RETURNS [r: Rule] = {
WITH ra
SELECT
FROM
x: Rule => r ← x;
x: REF INT => r ← ConsTerm[Integer, x];
x: REF TEXT => r ← ConsTerm[Identifier, Atom.MakeAtomFromRefText[x]];
x: ROPE => r ← ConsTerm[Identifier, Atom.MakeAtom[x]];
x:
ATOM => {
FOR tc: TerminalClass
IN TerminalClass
DO
IF x = termNames[tc]
THEN {
r ← ConsTerm[tc, NIL];
EXIT};
REPEAT
FINISHED => r ← ConsNT[x];
ENDLOOP;
};
ENDCASE => ERROR;
};
ToRuleList:
PROC [lora:
LORA]
RETURNS [rl: RuleList] = {
tail: RuleList ← rl ← NIL;
FOR lora ← lora, lora.rest
WHILE lora #
NIL
DO
this: RuleList = LIST[ToRule[lora.first]];
IF rl = NIL THEN rl ← this ELSE tail.rest ← this;
tail ← this;
ENDLOOP;
};
ConsList:
PROC [key:
ATOM, rest:
LORA, cutAfterFirst:
BOOL ←
TRUE]
RETURNS [r: Rule] = {
rl: RuleList = ToRuleList[rest];
r ←
NEW [RulePrivate ← [variant: list[
keyword: key,
elts: CONS[ConsTerm[Identifier, key], rl],
cutAfterFirst: cutAfterFirst
]]];
};
ListDefsName: PROC [rl: RuleList] RETURNS [defs: BOOL] = {
defs ← FALSE;
FOR rl ← rl, rl.rest WHILE rl # NIL DO
IF DefsName[rl.first] THEN {
IF defs THEN ERROR ELSE RETURN [TRUE];
};
ENDLOOP;
defs ← FALSE;
};
DefsName: PROC [r: Rule] RETURNS [defs: BOOL] = {
defs ← FALSE;
WITH r SELECT FROM
x: REF list RulePrivate => defs ← ListDefsName[x.rest];
x: REF repeat RulePrivate => IF DefsName[x.sub] THEN ERROR;
x: REF choice RulePrivate => IF ListDefsName[x.choices] THEN ERROR;
x: REF levelGuard RulePrivate => IF DefsName[x.r] THEN ERROR;
x: REF nonTerminal RulePrivate => NULL;
x: REF terminal RulePrivate => defs ← x.defsName;
ENDCASE => ERROR;
defs ← defs;
};
ConsStar:
PROC [sub:
REF
ANY, zero, moreThanOne:
BOOL]
RETURNS [r: Rule] = {
sr: Rule = ToRule[sub];
IF NOT (zero OR moreThanOne) THEN RETURN [sr];
r ←
NEW [RulePrivate ← [variant: repeat[
sub: sr,
zero: zero,
moreThanOne: moreThanOne
]]];
};
ConsAlt:
PROC [choices:
LORA]
RETURNS [r: Rule] = {
rl: RuleList = ToRuleList[choices];
IF rl.rest = NIL THEN RETURN [rl.first];
r ←
NEW [RulePrivate ← [variant: choice[
choices: rl
]]];
};
ConsNT:
PROC [category:
ATOM]
RETURNS [r: Rule] = {
r ←
NEW [RulePrivate ← [variant: nonTerminal[
category: category
]]];
};
ConsTerm:
PROC [category: TerminalClass, value:
REF
ANY]
RETURNS [r: Rule] = {
r ←
NEW [RulePrivate ← [variant: terminal[
category: category,
value: value
]]];
};
GetCategory:
PUBLIC
PROC [r: Rule]
RETURNS [category:
ATOM] = {
WITH r
SELECT
FROM
x: REF terminal RulePrivate => category ← termNames[x.category];
x: REF nonTerminal RulePrivate => category ← x.category;
ENDCASE => ERROR;
};
}.