


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˜�—�…—���� >��(ò��