EDIFSemanticsBasic:
CEDAR
PROGRAM
IMPORTS Atom, BasicTime, EDIFGrammar, EDIFSemantics, Rope
= {OPEN EDIFfing, EDIFDataStructure, EDIFGrammar, EDIFSemantics;
DefineEm:
PROC = {
SS[
DL[$EDIF,
LIST[NameDef[], $Status, Star[$Keyword], Opt[$Rename], StarCh[
LIST[$Design, $External, $Library, $Comment, $UserData]] ]],
[BeforeEDIF, AfterEDIF, SeeEDIFField]];
SS[
DL[$Status,
LIST[Opt[$EDIFVersion], Opt[$EDIFLevel], StarCh[
LIST[$Written, $Comment, $UserData]] ]],
[BeforeStatus, AfterStatus]];
SS[
DL[$EDIFVersion,
LIST[$Integer, $Integer, $Integer]],
[NIL, NIL, SeeVersionField]];
SS[
DL[$EDIFLevel,
LIST[$EDIFLevelName]],
[NIL, NIL, SeeLevel]];
[] ← DC[$EDIFLevelName, LIST[NEW[INT ← 0], NEW[INT ← 1], NEW[INT ← 2]]];
SS[
DL[$Written,
LIST[$TimeStamp, StarCh[
LIST[$Accounting, $Comment, $UserData]] ]],
[BeforeWritten, AfterWritten]];
SS[
DL[$TimeStamp,
LIST[$Integer, $Integer, $Integer, $Integer, $Integer, $Integer]],
[BeforeTimeStamp, AfterTimeStamp, SeeTimeStampField]];
SS[
DL[$Accounting,
LIST[$Identifier, Opt[$String]]],
[BeforeAccounting, AfterAccounting, SeeAccountingField]];
SS[
DL[$Comment,
LIST[Star[$String]]],
[BeforeComment, AfterComment, SeeCommentField]];
SS[
DL[$UserData,
LIST[$Identifier, Star[$Form]]],
[BeforeUserData, AfterUserData, SeeUserDataField]];
SS[
DL[$Keyword,
LIST[NameDef[], StarCh[
LIST[$Formal, $Optional, $Extra, $FormalValue, $ForEach, $Comment]] ]],
[BeforeKeyword, AfterKeyword, SeeKeywordField]];
SS[
DL[$Formal,
LIST[Star[NameDef[]]]]
,
[BeforeRequiredFormal, NIL, SeeAnyFormalField]];
SS[
DL[$Optional,
LIST[NameDef[], $FormalValue]]
,
[BeforeOptionalFormal, NIL, SeeAnyFormalField]];
SS[
DL[$Extra,
LIST[Star[NameDef[]]]]
,
[BeforeExtraFormal, NIL, SeeAnyFormalField]];
[] ← DC[$FormalValue, LIST[$String, $Integer, NameRef[], $BuildName, $Build]];
SS[
DL[$BuildName,
LIST[$String]],
[BeforeBuildName, AfterBuildName, SeeBuildNameField]];
SS[
DL[$Build,
LIST[$KeyRef, StarCh[
LIST[$FormalValue, $ForEach, $Index, $Comment]] ]],
[BeforeBuildList, AfterBuildList, SeeBuildListField]];
[] ← DC[$KeyRef, LIST[$Identifier, $String]];
SS[
DL[$ForEach,
LIST[$NameRefs, StarCh[
LIST[$FormalValue, $ForEach, $Index, $Comment]] ]],
[BeforeForEach, AfterForEach, SeeForEachField]];
SS[
DL[$Index,
LIST[NameRef[]]],
[BeforeIndex, AfterIndex, SeeIndexField]];
SS[
DL[$Rename,
LIST[NameRef[], $String]],
[BeforeRename, AfterRename, SeeRenameField]];
};
BeforeEDIF: Beforer = {
ew: EDIFWhole =
NEW [EDIFWholePrivate ← [
status: NIL,
designs: MakeRopeDict[],
libraries: MakeRopeDict[],
externalLibraries: MakeRopeDict[]
]];
ewc: EDIFWholeConversion = NEW [EDIFWholeConversionPrivate ← [ew]];
context ← ewc;
};
SeeEDIFField: SubResultConsumer = {
ewc: EDIFWholeConversion = NARROW[context];
ew: EDIFWhole = ewc.ew;
IF index = 1
THEN {
ew.name.edif ← Atom.GetPName[NARROW[result]];
};
};
AfterEDIF: Afterer = {
ewc: EDIFWholeConversion = NARROW[context];
result ← ewc.ew;
};
BeforeStatus: Beforer = {
s: Status = NEW [StatusPrivate ← []];
sc: StatusConversion = NEW [StatusConversionPrivate ← [s]];
WITH parentContext
SELECT
FROM
ewc: EDIFWholeConversion => {
IF ewc.ew.status # NIL THEN ERROR;
ewc.ew.status ← s};
lc: LibraryConversion => {
IF lc.l.status # NIL THEN ERROR;
lc.l.status ← s};
ctgc: CellTypeGenConversion => {
IF ctgc.ctfe.status # NIL THEN ERROR;
ctgc.ctfe.status ← s};
dc: DesignConversion => {
IF dc.d.status # NIL THEN ERROR;
dc.d.status ← s};
vgc: ViewGenConversion => {
IF vgc.vg.status # NIL THEN ERROR;
vgc.vg.status ← s};
ENDCASE;
context ← sc;
};
AfterStatus: Afterer = {
sc: StatusConversion = NARROW[context];
s: Status = sc.s;
IF s.level # unspecifiedLevel THEN SetLevel[s.level, 1];
result ← s;
};
SeeVersionField: SubResultConsumer = {
sc: StatusConversion = NARROW[parentContext];
s: Status = sc.s;
ri: REFINT = NARROW[result];
SELECT index
FROM
1 => s.version.major ← ri^;
2 => s.version.medium ← ri^;
3 => s.version.minor ← ri^;
ENDCASE => ResultOffTail[];
};
SeeLevel: SubResultConsumer = {
sc: StatusConversion = NARROW[parentContext];
s: Status = sc.s;
ri: REFINT = NARROW[result];
s.level ← ri^;
};
BeforeWritten: Beforer = {
w: Written = NEW [WrittenPrivate ← []];
wc: WrittenConversion = NEW [WrittenConversionPrivate ← [w]];
context ← wc;
};
AfterWritten: Afterer = {
sc: StatusConversion = NARROW[parentContext];
s: Status = sc.s;
wc: WrittenConversion = NARROW[context];
w: Written = wc.w;
wl: WrittenList = LIST[w];
IF sc.wTail = NIL THEN s.writtens ← wl ELSE sc.wTail.rest ← wl;
sc.wTail ← wl;
result ← w;
};
BeforeTimeStamp: Beforer = {
context ← NEW [BasicTime.Unpacked ← [zone: 0]];
};
SeeTimeStampField: SubResultConsumer = {
tsc: TimeStampConversion = NARROW[context];
ri: REFINT = NARROW[result];
SELECT index
FROM
1 => tsc.year ← ri^;
2 => tsc.month ← VAL[CARDINAL[ri^-1]];
3 => tsc.day ← ri^;
4 => tsc.hour ← ri^;
5 => tsc.minute ← ri^;
6 => tsc.second ← ri^;
ENDCASE => ResultOffTail[];
};
AfterTimeStamp: Afterer = {
wc: WrittenConversion = NARROW[parentContext];
tsc: TimeStampConversion = NARROW[context];
wc.w.time ← BasicTime.Pack[tsc^];
result ← tsc;
};
BeforeAccounting: Beforer = {
context ← NEW [AccountingPrivate ← [NIL]];
};
SeeAccountingField: SubResultConsumer = {
a: Accounting = NARROW[context];
SELECT index
FROM
1 => a.name ← NARROW[result];
2 => a.data ← NARROW[result];
ENDCASE => ResultOffTail[];
};
AfterAccounting: Afterer = {
wc: WrittenConversion = NARROW[parentContext];
a: Accounting = NARROW[context];
al: AccountingList = LIST[a];
IF wc.aTail = NIL THEN wc.w.accountings ← al ELSE wc.aTail.rest ← al;
wc.aTail ← al;
result ← a;
};
BeforeComment: Beforer = {
c: Comment;
cc: CommentConversion = NEW [CommentConversionPrivate ← [c]];
context ← cc};
SeeCommentField: SubResultConsumer = {
cc: CommentConversion = NARROW[context];
r: ROPE = NARROW[result];
cl: Comment = LIST[r];
IF cc.tail = NIL THEN cc.c ← cl ELSE cc.tail.rest ← cl;
cc.tail ← cl;
};
AfterComment: Afterer = {
cc: CommentConversion = NARROW[context];
c: Comment = cc.c;
WITH parentContext
SELECT
FROM
ewc: EDIFWholeConversion => [ewc.ew.comments, ewc.cTail] ← AppendC[ewc.ew.comments, ewc.cTail, c];
sc: StatusConversion => [sc.s.comments, sc.cTail] ← AppendC[sc.s.comments, sc.cTail, c];
wc: WrittenConversion => [wc.w.comments, wc.cTail] ← AppendC[wc.w.comments, wc.cTail, c];
mdc: MacroDefConversion => [mdc.md.comments, mdc.cTail] ← AppendC[mdc.md.comments, mdc.cTail, c];
lc: LibraryConversion => [lc.l.comments, lc.cTail] ← AppendC[lc.l.comments, lc.cTail, c];
ctgc: CellTypeGenConversion => [ctgc.ctfe.comments, ctgc.cTail] ← AppendC[ctgc.ctfe.comments, ctgc.cTail, c];
vgc: ViewGenConversion => [vgc.vg.comments, vgc.cTail] ← AppendC[vgc.vg.comments, vgc.cTail, c];
ENDCASE;
result ← c;
};
AppendC:
PROC [head, tail: Comments, x: Comment]
RETURNS [
nHead,
nTail: Comments] = {
nTail ← LIST[x];
IF tail = NIL THEN nHead ← nTail ELSE {nHead ← head; tail.rest ← nTail};
};
BeforeUserData: Beforer = {
ue: UserExtension = [];
uec: UserExtensionConversion = NEW [UserExtensionConversionPrivate ← [ue]];
context ← uec;
};
SeeUserDataField: SubResultConsumer = {
uec: UserExtensionConversion = NARROW[context];
SELECT index
FROM
=1 => {uec.ue.name.edif ← Atom.GetPName[NARROW[result]]};
>1 => {tail: ParseTreeList =
LIST[
NARROW[result]];
IF uec.fTail = NIL THEN uec.ue.forms ← tail ELSE uec.fTail.rest ← tail;
uec.fTail ← tail};
ENDCASE => ERROR;
};
AfterUserData: Afterer = {
uec: UserExtensionConversion = NARROW[context];
ue: UserExtension = uec.ue;
WITH parentContext
SELECT
FROM
ewc: EDIFWholeConversion => [ewc.ew.ues, ewc.ueTail] ← AppendUE[ewc.ew.ues, ewc.ueTail, ue];
sc: StatusConversion => [sc.s.ues, sc.ueTail] ← AppendUE[sc.s.ues, sc.ueTail, ue];
wc: WrittenConversion => [wc.w.ues, wc.ueTail] ← AppendUE[wc.w.ues, wc.ueTail, ue];
lc: LibraryConversion => [lc.l.ues, lc.ueTail] ← AppendUE[lc.l.ues, lc.ueTail, ue];
ctgc: CellTypeGenConversion => [ctgc.ctfe.ues, ctgc.ueTail] ← AppendUE[ctgc.ctfe.ues, ctgc.ueTail, ue];
ENDCASE;
};
AppendUE:
PROC [head, tail: UserExtensions, x: UserExtension]
RETURNS [
nHead,
nTail: UserExtensions] = {
nTail ← LIST[x];
IF tail = NIL THEN nHead ← nTail ELSE {nHead ← head; tail.rest ← nTail};
};
MacroDefConversion: TYPE = REF MacroDefConversionPrivate;
MacroDefConversionPrivate:
TYPE =
RECORD [
md: MacroDef,
name: ATOM,
rfTail, ofTail, efTail: IdPtList ← NIL,
gTail: ParseTreeGeneratorList ← NIL,
cTail: Comments
];
BeforeKeyword: Beforer = {
md: MacroDef = NEW [MacroDefPrivate ← []];
mdc: MacroDefConversion = NEW [MacroDefConversionPrivate ← [md]];
context ← mdc;
};
SeeKeywordField: SubResultConsumer = {
mdc: MacroDefConversion = NARROW[context];
md: MacroDef = mdc.md;
IF index = 1
THEN {
mdc.name ← NARROW[result];
RETURN;
};
IF result = NIL THEN RETURN;
[md.generators, mdc.gTail] ← AppendPTG[md.generators, mdc.gTail, ToPTG[result, subTree]];
};
ToPTG:
PROC [result:
REF
ANY, subTree: ParseTree]
RETURNS [ptg: ParseTreeGenerator] = {
WITH result
SELECT
FROM
x: ParseTreeGenerator => ptg ← x;
x: ROPE => ptg ← MakePTG[literal, subTree, subTree];
x: REFINT => ptg ← MakePTG[literal, subTree, subTree];
x: ATOM => ptg ← MakePTG[name, x, subTree];
ENDCASE => ERROR;
};
AppendPTG:
PROC [head, tail: ParseTreeGeneratorList, x: ParseTreeGenerator]
RETURNS [
nHead,
nTail: ParseTreeGeneratorList] = {
nTail ← LIST[x];
IF tail = NIL THEN nHead ← nTail ELSE {nHead ← head; tail.rest ← nTail};
};
AfterKeyword: Afterer = {
mdc: MacroDefConversion = NARROW[context];
md: MacroDef = mdc.md;
DefineMacro[mdc.name, md];
result ← md;
};
MakePTG:
PROC [type: ParseTreeGeneratorType, val:
REF
ANY, quaPT: ParseTree]
RETURNS [ptg: ParseTreeGenerator] = {
ptg ←
SELECT type
FROM
literal => NEW [ParseTreeGeneratorPrivate ← [variant: literal[NARROW[val]]]],
name => NEW [ParseTreeGeneratorPrivate ← [variant: name[NARROW[val]]]],
ENDCASE => ERROR;
ptg.quaPT ← quaPT;
};
BeforeRequiredFormal: Beforer = {context ← $Required};
BeforeOptionalFormal: Beforer = {context ← $Optional};
BeforeExtraFormal: Beforer = {
mdc: MacroDefConversion = NARROW[parentContext];
md: MacroDef = mdc.md;
md.okToSkipTail ← TRUE;
context ← $Extra};
SeeAnyFormalField: SubResultConsumer = {
mdc: MacroDefConversion = NARROW[parentContext];
md: MacroDef = mdc.md;
f: ATOM = NARROW[result];
SELECT context
FROM
$Required => [md.requiredFormals, mdc.rfTail] ← AppendIP[md.requiredFormals, mdc.rfTail, NARROW[subTree]];
$Optional => [md.optionalFormals, mdc.ofTail] ← AppendIP[md.optionalFormals, mdc.ofTail, NARROW[subTree]];
$Extra => [md.extraFormals, mdc.efTail] ← AppendIP[md.extraFormals, mdc.efTail, NARROW[subTree]];
ENDCASE => ERROR;
};
AppendIP:
PROC [head, tail: IdPtList, x: IdPt]
RETURNS [
nHead,
nTail: IdPtList] = {
nTail ← LIST[x];
IF tail = NIL THEN nHead ← nTail ELSE {nHead ← head; tail.rest ← nTail};
};
BeforeBuildName: Beforer = {
ptg: ParseTreeGenerator =
NEW [ParseTreeGeneratorPrivate ← [
quaPT: selfTree,
variant: name[NIL]
]];
context ← ptg;
};
SeeBuildNameField: SubResultConsumer = {
nptg: REF name ParseTreeGeneratorPrivate = NARROW[context];
nptg.id ← Atom.MakeAtom[NARROW[result]];
};
AfterBuildName: Afterer = {result ← context};
ListGenConversion: TYPE = REF ListGenConversionPrivate;
ListGenConversionPrivate:
TYPE =
RECORD [
ptg: ParseTreeGenerator,
tail: ParseTreeGeneratorList ← NIL
];
BeforeBuildList: Beforer = {
ptg: ParseTreeGenerator = NEW [ParseTreeGeneratorPrivate.buildList ← [quaPT: selfTree, variant: buildList[elts: NIL]]];
lgc: ListGenConversion = NEW [ListGenConversionPrivate ← [ptg]];
context ← lgc};
SeeBuildListField: SubResultConsumer = {
lgc: ListGenConversion = NARROW[context];
lptg: REF buildList ParseTreeGeneratorPrivate = NARROW[lgc.ptg];
elt: ParseTreeGenerator;
SELECT index
FROM
=1 => {
WITH result
SELECT
FROM
x:
ROPE => {
pt: ParseTree =
NEW [ParseTreePrivate ← [
origin: subTree.origin,
replacing: subTree.replacing,
generator: subTree.generator,
variant: identifier[Atom.MakeAtom[x]]
]];
elt ← MakePTG[literal, pt, subTree];
};
x: ATOM => elt ← MakePTG[literal, subTree, subTree];
ENDCASE => ERROR;
};
#1 => {
elt ← ToPTG[result, subTree];
};
ENDCASE => ERROR;
[lptg.elts, lgc.tail] ← AppendPTG[lptg.elts, lgc.tail, elt];
};
AfterBuildList: Afterer = {
lgc: ListGenConversion = NARROW[context];
result ← lgc.ptg};
BeforeForEach: Beforer = {
ptg: ParseTreeGenerator = NEW [ParseTreeGeneratorPrivate.forEach ← [quaPT: selfTree, variant: forEach[domain: NIL, range: NIL]]];
lgc: ListGenConversion = NEW [ListGenConversionPrivate ← [ptg]];
context ← lgc};
SeeForEachField: SubResultConsumer = {
lgc: ListGenConversion = NARROW[context];
fptg: REF forEach ParseTreeGeneratorPrivate = NARROW[lgc.ptg];
SELECT index
FROM
=1 => {
ok: BOOL ← FALSE;
WITH subTree
SELECT
FROM
x:
REF identifier ParseTreePrivate => {
fptg.domain ← LIST[x.id];
ok ← TRUE};
x:
REF list ParseTreePrivate => {
dTail: ATOMList ← NIL;
WITH x.children.first
SELECT
FROM
y: REF identifier ParseTreePrivate => ok ← AtomNameEq[y.id, $Multiple];
ENDCASE => ok ← FALSE;
FOR cl: ParseTreeList ← x.children.rest, cl.rest
WHILE cl #
NIL
AND ok
DO
WITH cl.first
SELECT
FROM
y: REF identifier ParseTreePrivate => [fptg.domain, dTail] ← AppendA[fptg.domain, dTail, y.id];
ENDCASE => ok ← FALSE;
ENDLOOP;
};
ENDCASE => ok ← FALSE;
};
#1 => {
[fptg.range, lgc.tail] ← AppendPTG[fptg.range, lgc.tail, ToPTG[result, subTree]];
};
ENDCASE => ERROR;
};
AppendA:
PROC [head, tail: ATOMList, x:
ATOM]
RETURNS [
nHead,
nTail: ATOMList] = {
nTail ← LIST[x];
IF tail = NIL THEN nHead ← nTail ELSE {nHead ← head; tail.rest ← nTail};
};
AfterForEach: Afterer = {
lgc: ListGenConversion = NARROW[context];
fptg: REF forEach ParseTreeGeneratorPrivate = NARROW[lgc.ptg];
result ← fptg;
};
BeforeIndex: Beforer = {
context ← NEW [ParseTreeGeneratorPrivate ← [quaPT: selfTree, variant: index[NIL]]];
};
SeeIndexField: SubResultConsumer = {
iptg: REF index ParseTreeGeneratorPrivate = NARROW[context];
iptg.var ← NARROW[result];
};
AfterIndex: Afterer = {
result ← context;
};
BeforeRename: Beforer = {
context ← NEW [NameStuff ← []];
};
SeeRenameField: SubResultConsumer = {
ns: REF NameStuff = NARROW[context];
SELECT index
FROM
=1 => ns.edif ← Atom.GetPName[NARROW[result]];
=2 => ns.rename ← NARROW[result];
ENDCASE => ResultOffTail[];
};
AfterRename: Afterer = {
ns: REF NameStuff = NARROW[context];
Rename:
PROC [old, delta: NameStuff]
RETURNS [new: NameStuff] = {
new ← old;
IF RopeNameEq[new.edif, delta.edif]
THEN {
IF new.rename = NIL THEN new.rename ← delta.rename ELSE ERROR
}
ELSE ERROR;
};
WITH parentContext
SELECT
FROM
ewc: EDIFWholeConversion => ewc.ew.name ← Rename[ewc.ew.name, ns^];
ENDCASE;
};
}.