SaffronContextImpl:
CEDAR
PROGRAM
IMPORTS Rope
EXPORTS SaffronBaseDef, SaffronContext =
BEGIN OPEN SaffronGenericDef;
LocalContextNode:
TYPE =
REF LocalContextNodeBody; LocalContextNodeBody:
PUBLIC TYPE =
RECORD[
lvtn: LocallyVisibleTypeNames,
maxTGNodeIndex: INT ← 0,
bottom, top: TypeGraphNodeNode ← NIL,
tgNodes: TypeGraphNodeNode ← NIL,
fieldLists: FrozenFieldListNode ← NIL];
TypeGraphNodeNode: TYPE = REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody:
PUBLIC TYPE = RECORD[
index: INT,
localContext: LocalContextNode,
body: REF ANY, -- many different types
next: TypeGraphNodeNode -- tgNodes chain from localContext -- ];
CreateEmptyContext: PUBLIC PROC RETURNS[LocalContextNode] =
BEGIN
lc: LocalContextNode ← NEW[LocalContextNodeBody];
lc.lvtn ← CreateEmptyLocallyVisibleTypeNames[];
[lc.top, lc.bottom] ← CreateTopAndBottom[lc];
RETURN[lc];
END;
FakeDamageContext: PUBLIC PROC[lc: LocalContextNode] RETURNS[lcp: LocalContextNode] =
BEGIN
lcp ← lc;
END;
CreateTGN: PROC[lc: LocalContextNode, body: REF ANY] RETURNS[tgn: TypeGraphNodeNode] =
BEGIN
tgn ← NEW[TypeGraphNodeNodeBody ← [
index: lc.maxTGNodeIndex + 1,
localContext: lc,
body: body,
next: lc.tgNodes]];
lc.maxTGNodeIndex ← tgn.index;
lc.tgNodes ← tgn;
END;
(FIX: This should be a procedure to be applied to a RIB, we will change as soon as we get ribs)
FindBottomTGN: PUBLIC
PROC[lc: LocalContextNode]
RETURNS[tgn: TypeGraphNodeNode] =
BEGIN ERROR END;
(FIX: The public version of this procedure should also take a RIB as an argument, not a LocalContext.)
FindLocallyVisibleTGN: PUBLIC
PROC[lc: LocalContextNode, name: IdNode]
RETURNS[TypeGraphNodeNode] =
BEGIN ERROR END;
Now for the assorted body types
Top and Bottom
SpecialKind: TYPE = {bottom, top};
SpecialTGN: TYPE = REF SpecialTGNBody; SpecialTGNBody: TYPE = RECORD[
kind: SpecialKind];
CreateTopAndBottom: PROC[lc: LocalContextNode] RETURNS[top, bottom: TypeGraphNodeNode] =
BEGIN
topBody: SpecialTGN ← NEW[SpecialTGNBody ← [top]];
bottomBody: SpecialTGN ← NEW[SpecialTGNBody ← [bottom]];
top ← CreateTGN[lc, topBody];
bottom ← CreateTGN[lc, bottomBody];
Named nodes (i.e., locally visible)
NamedTGN: TYPE = REF NamedTGNBody; NamedTGNBody: TYPE = RECORD[
name: IdNode,
type: TypeGraphNodeNode]; -- type is initially Nil
CreateLocallyVisibleTGN: PUBLIC
PROC[lc: LocalContextNode, name: IdNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: NamedTGN ← NEW[NamedTGNBody ← [name: name]];
RETURN[lc, CreateTGN[lc, body]];
AddArcFromLVTGNToTGN: PUBLIC
PROC[lc: LocalContextNode, lvTgn, tgn: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode] =
BEGIN
namedNode: NamedTGN ← NARROW[lvTgn.body];
namedNode.type ← tgn;
RETURN[lc];
END;
Record nodes
RecordTGN: TYPE = REF RecordTGNBody; RecordTGNBody: TYPE = RECORD[
paint: PaintNode,
ffl: FrozenFieldListNode];
CreateRecordTGN: PUBLIC
PROC[lc: LocalContextNode, p: PaintNode, ffl: FrozenFieldListNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: RecordTGN ← NEW[RecordTGNBody←[p, ffl]];
RETURN[lc, CreateTGN[lc, body]];
END;
Ref Nodes
RefTGN: TYPE = REF RefTGNBody; RefTGNBody: TYPE = RECORD[
load, store: TypeGraphNodeNode];
CreateRefTGN: PUBLIC
PROC[lc: LocalContextNode, loadtgn, storetgn: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: RefTGN ← NEW[RefTGNBody←[loadtgn, storetgn]];
RETURN[lc, CreateTGN[lc, body]];
END;
EnumeratedType Nodes
EnumTGN: TYPE = REF EnumTGNBody; EnumTGNBody: TYPE = RECORD[
firstElement, lastElement: EnumElementCell];
EnumElementCell: TYPE = REF EnumElementCellBody;
EnumElementCellBody: TYPE = RECORD[
id: IdNode,
next: EnumElementCell];
CreateEmptyEnumTypeTGN: PUBLIC
PROC[lc: LocalContextNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: EnumTGN ← NEW[EnumTGNBody←[NIL, NIL]];
RETURN[lc, CreateTGN[lc, body]];
END;
AppendElementToEnumTypeTGN:
PUBLIC PROC[lc: LocalContextNode, tgn: TypeGraphNodeNode, elementName: IdNode]
RETURNS[lcp: LocalContextNode] =
BEGIN
body: EnumTGN ← NARROW[tgn.body];
cell: EnumElementCell ← NEW[EnumElementCellBody ← [elementName, NIL]];
IF body.lastElement = NIL
THEN body.firstElement ← cell
ELSE body.lastElement.next ← cell;
body.lastElement ← cell;
RETURN[lc];
END;
Field lists and frozen field lists
FieldNode:
TYPE =
REF FieldNodeBody; FieldNodeBody:
PUBLIC TYPE = RECORD[
name: IdNode, tgn: TypeGraphNodeNode];
(for unnamed fields, name = NIL)
FieldListNode:
TYPE =
REF FieldListNodeBody; FieldListNodeBody:
PUBLIC TYPE = RECORD[
nFields: INT, nCells: INT, firstCell, lastCell: FieldListCell];
FieldListCell: TYPE = REF FieldListCellBody; FieldListCellBody: TYPE = RECORD[
item: REF ANY, next: FieldListCell];
(an item is either a Field or a FrozenFieldList)
FrozenFieldListNode:
TYPE =
REF FrozenFieldListNodeBody; FrozenFieldListNodeBody:
PUBLIC TYPE = RECORD[
nFields: INT, fields: SEQUENCE nSlots: CARDINAL OF FFLSlot];
FFLSlot: TYPE = RECORD[case: FFLCase, name: IdNode, tgn: TypeGraphNodeNode, ffl: FrozenFieldListNode];
FFLCase: TYPE = {field, ffl};
CreateNamedField:
PUBLIC PROC[n: IdNode, tgn: TypeGraphNodeNode]
RETURNS[f: FieldNode] =
{RETURN[NEW[FieldNodeBody←[n, tgn]]]};
CreateUnnamedField:
PUBLIC PROC[tgn: TypeGraphNodeNode]
RETURNS[f: FieldNode] =
{RETURN[NEW[FieldNodeBody←[NIL, tgn]]]};
CreateEmptyFieldList:
PUBLIC PROC
RETURNS[fl: FieldListNode] =
{RETURN[NEW[FieldListNodeBody←[0, 0, NIL, NIL]]]};
PrependCellToFieldList: PROC[nFields: INT, cell: FieldListCell, fl: FieldListNode] RETURNS[flp: FieldListNode] =
BEGIN
cell.next ← fl.firstCell;
fl.firstCell ← cell;
IF fl.lastCell = NIL THEN fl.lastCell ← cell;
fl.nFields ← fl.nFields + nFields;
fl.nCells ← fl.nCells + 1;
RETURN[fl];
END;
AppendCellToFieldList: PROC[fl: FieldListNode, nFields: INT, cell: FieldListCell] RETURNS[flp: FieldListNode] =
BEGIN
IF fl.lastCell = NIL THEN fl.firstCell ← cell ELSE fl.lastCell.next ← cell;
fl.lastCell ← cell;
fl.nFields ← fl.nFields + nFields;
fl.nCells ← fl.nCells + 1;
RETURN[fl];
END;
PrependFieldToFieldList:
PUBLIC PROC[f: FieldNode, fl: FieldListNode]
RETURNS[flp: FieldListNode] =
BEGIN
cell: FieldListCell ← NEW[FieldListCellBody ← [f, NIL]];
RETURN[PrependCellToFieldList[1, cell, fl]];
END;
AppendFieldToFieldList:
PUBLIC PROC[fl: FieldListNode, f: FieldNode]
RETURNS[flp: FieldListNode] =
BEGIN
cell: FieldListCell ← NEW[FieldListCellBody ← [f, NIL]];
RETURN[AppendCellToFieldList[fl, 1, cell]];
END;
PrependFFLToFieldList:
PUBLIC PROC[ffl: FrozenFieldListNode, fl: FieldListNode]
RETURNS[flp: FieldListNode] =
BEGIN
cell: FieldListCell ← NEW[FieldListCellBody ← [ffl, NIL]];
RETURN[PrependCellToFieldList[ffl.nFields, cell, fl]];
END;
AppendFFLToFieldList:
PUBLIC PROC[fl: FieldListNode, ffl: FrozenFieldListNode]
RETURNS[flp: FieldListNode] =
BEGIN
cell: FieldListCell ← NEW[FieldListCellBody ← [ffl, NIL]];
RETURN[AppendCellToFieldList[fl, ffl.nFields, cell]];
END;
ConcatFieldLists:
PUBLIC PROC[fl1, fl2: FieldListNode]
RETURNS[fl: FieldListNode] =
BEGIN
IF fl1.firstCell = NIL THEN RETURN[fl2];
IF fl2.firstCell = NIL THEN RETURN[fl1];
fl1.lastCell.next ← fl2.firstCell;
fl1.lastCell ← fl2.lastCell;
fl1.nFields ← fl1.nFields + fl2.nFields;
fl1.nCells ← fl1.nCells + fl2.nCells;
RETURN[fl1];
END;
FreezeFieldList:
PUBLIC PROC[lc: LocalContextNode, fl: FieldListNode]
RETURNS[lcp: LocalContextNode, ffl: FrozenFieldListNode] =
BEGIN
cell: FieldListCell ← fl.firstCell;
ffl ← NEW[FrozenFieldListNodeBody[fl.nCells]];
ffl.nFields ← fl.nFields;
FOR I: CARDINAL IN [0..CARDINAL[fl.nCells]) DO
ffl[I] ← WITH cell.item SELECT FROM
f: FieldNode => [field, f.name, f.tgn, NIL],
fflist: FrozenFieldListNode => [ffl, NIL, NIL, fflist],
ENDCASE => ERROR;
ENDLOOP;
RETURN[lc, ffl];
END;
PaintNode:
TYPE =
REF PaintNodeBody; PaintNodeBody: PUBLIC TYPE = RECORD[
PaintNodeBody: INT];
GetUnpaintedPaint:
PUBLIC PROC[lc: LocalContextNode]
RETURNS[lcp: LocalContextNode, p: PaintNode] =
BEGIN ERROR END;
GetUniquePaint:
PUBLIC PROC[lc: LocalContextNode]
RETURNS[lcp: LocalContextNode, p: PaintNode] =
BEGIN ERROR END;
LocallyVisibleTypeNames
LocallyVisibleTypeNames: TYPE = REF LocallyVisibleTypeNamesBody;
LocallyVisibleTypeNamesBody: TYPE = RECORD[
LocallyVisibleTypeNames: INT];
CreateEmptyLocallyVisibleTypeNames: PROC RETURNS[lvtn: LocallyVisibleTypeNames] =
BEGIN
lvtn ← NEW[LocallyVisibleTypeNamesBody];
RETURN[lvtn];
END;
misc stuff
following are exported to SaffronContext
ErrorSignal: PUBLIC ERROR = CODE;
Following are exported to SaffronBaseDef
BooleanConst: PUBLIC PROC[r: Rope.ROPE] RETURNS[BOOLEAN] =
BEGIN
SELECT TRUE FROM
Rope.Equal[r, "True"] => RETURN[TRUE];
Rope.Equal[r, "False"] => RETURN[FALSE];
ENDCASE => ErrorSignal[];
END;
END..