DIRECTORY
Rope USING[Equal, ROPE],
SaffronBaseDef USING[],
SaffronGenericDef USING[IdNode],
SaffronContext USING[];

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;

FindBottomTGN: PUBLIC PROC[lc: LocalContextNode] RETURNS[tgn: TypeGraphNodeNode] =
BEGIN ERROR END;

FindLocallyVisibleTGN: PUBLIC PROC[lc: LocalContextNode, name: IdNode] RETURNS[TypeGraphNodeNode] =
BEGIN ERROR END;




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];
END;


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]];
END;

AddArcFromLVTGNToTGN: PUBLIC PROC[lc: LocalContextNode, lvTgn, tgn: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] =
BEGIN
namedNode: NamedTGN _ NARROW[lvTgn.body];
namedNode.type _ tgn;
RETURN[lc];
END;


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;


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;


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;





FieldNode: TYPE = REF FieldNodeBody; FieldNodeBody: PUBLIC TYPE = RECORD[
name: IdNode, tgn: TypeGraphNodeNode];

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];

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: TYPE = REF LocallyVisibleTypeNamesBody;
LocallyVisibleTypeNamesBody: TYPE = RECORD[
LocallyVisibleTypeNames: INT];

CreateEmptyLocallyVisibleTypeNames: PROC RETURNS[lvtn: LocallyVisibleTypeNames] =
BEGIN
lvtn _ NEW[LocallyVisibleTypeNamesBody];
RETURN[lvtn];
END;




ErrorSignal: PUBLIC ERROR = CODE;


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..

ºSaffronContextImpl.mesa
Copyright Ó 1987 by Xerox Corporation.  All rights reserved.
Sturgis, July 15, 1987 12:56:40 pm PDT
(FIX: This should be a procedure to be applied to a RIB, we will change as soon as we get ribs)
(FIX: The public version of this procedure should also take a RIB as an argument, not a LocalContext.)




Now for the assorted body types
Top and Bottom

Named nodes (i.e., locally visible)
Record nodes
Ref Nodes
EnumeratedType Nodes

Field lists and frozen field lists
(for unnamed fields, name = NIL)
(an item is either a Field or a FrozenFieldList)


LocallyVisibleTypeNames
misc stuff
following are exported to SaffronContext
Following are exported to SaffronBaseDef
�Êú˜J˜Jš
œ™Jš
œ<™<Jšœ#Ïk™&J˜J˜š
�	˜	Jš
œ˜Jš
œ˜Jšœ�œ	˜ Jš
œ˜—J˜š
Ïnœ�œ
�œ
�œ�œ!˜WJš�œ�
˜J˜š	œ�œ�œ-�œ�œ
˜^J˜Jšœ�œ˜Jšœ!�œ
˜%Jšœ�œ
˜!Jšœ"�œ˜'—J˜Jšœ�œ�œ˜4šœ�œ
˜,J˜J˜J˜&Jš
œ@˜@—J˜˜;J˜Jš
œ1˜1J˜/J˜-J˜J˜—J˜š
œU˜UJ˜J˜	J˜—˜J˜—˜VJ˜š
œ#˜#Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜—Jš
œ˜J˜J˜—J˜J™_šœ�œ�œ˜RJ˜—J˜J™fšžœ	�œ%�œ˜cJ˜—J˜J™J™J™J™J˜J™J˜J™J˜J˜"˜EJ˜—J™˜XJ˜J˜2J˜8J˜J˜#˜J˜——J™#J˜˜?J˜
J˜3—J˜šžœ	�œ%�œ1˜‚
J˜J˜2J˜ ˜J˜——šžœ�œ6�œ˜wJ˜J˜)J˜J˜J˜—J˜J™J˜˜BJ˜J˜—J˜šžœ�œ?�œ1˜“
J˜J˜.J˜ J˜—J˜J™	J˜˜9J˜ —J˜šžœ�œ=�œ1˜Ž
J˜Jš
œ3˜3J˜ J˜—J˜J™J˜˜=J˜,—J˜J˜0˜#J˜J˜—J˜šÐbnœ�œ�œ1˜rJ˜Jš
œ,˜,J˜ J˜—J™šŸœ�œD�œ˜‹
J˜Jš
œ!˜!Jš
œF˜F˜J˜J˜"—J˜J˜J˜—J˜J˜J˜J˜J™"J˜šœ�œ�œ�
œ˜Iš
œ&˜&J™ —J˜—šœ�œ�œ'�
œ˜UJš
œ?˜?—J˜˜Nš
œ$˜$J™0—J˜—šœ�œ�œ3�œ˜hJš
œ<˜<—J˜Jš
œf˜fJ˜J˜šžœ�œ$�œ˜XJš
œ&˜&J˜—šžœ�œ�œ˜OJš
œ(˜(J˜—šžœ�œ
�œ˜>Jš
œ2˜2—J˜˜pJ˜J˜J˜J˜-J˜"J˜J˜J˜—J˜˜oJ˜J˜KJ˜J˜"J˜J˜J˜—J˜šžœ�œ"�œ˜cJ˜J˜8J˜,J˜—J˜šžœ�œ"�œ˜bJ˜J˜8J˜+J˜—J˜šžœ�œ.�œ˜mJ˜Jš
œ:˜:J˜6J˜—J˜šžœ�œ.�œ˜lJ˜Jš
œ:˜:J˜5J˜—J™šžœ�œ�œ˜SJ˜J˜(J˜(J˜"J˜J˜(J˜%J˜J˜J˜—šžœ�œ*�œ3˜€
J˜Jš
œ#˜#J˜.J˜˜.˜#J˜,J˜7J˜—J˜—J˜J˜—J˜šœ�œ�œ4˜IJ˜—J˜šžœ�œ�œ'˜cJ˜—J™šžœ�œ�œ'˜`J˜J˜—J˜J™J˜J˜@˜+˜J˜——˜QJ˜J˜(J˜
J˜—J˜J˜J™
J˜J™(J˜J˜!J˜J™(J˜˜:J˜˜J˜&J˜(J˜—J˜—J˜Jš�œ˜—J˜—…— >(ò