DIRECTORY
FS USING[ComponentPositions, Error, ExpandName, StreamOpen],
IO USING [Close, PutF, rope, STREAM],
Rope USING [ Cat, Concat, Equal, ROPE, Substr ],
SaffronAG1Def USING[TopmodulepProdData],
SaffronATDef USING [ DefBodyNode, ExpNode, ModulePNode, ScopeNode, TopNode ],
SaffronBaseDef USING [ ],
SaffronCentralDef USING[ParseOneStream],
SaffronGenericDef USING [ IdNode, IdNodeBody, StringNode ],
SaffronContext USING [ ],
SaffronContextPrivateTypes,
ThreeC4Support USING[GetReportStream],
VersionMap USING[MapAndNameList, MapList, ShortNameToNames],
VersionMapDefaults USING[GetMapList];

SaffronContextCreateCTImpl: CEDAR PROGRAM
IMPORTS FS, IO, Rope, SaffronCentralDef, ThreeC4Support, VersionMap, VersionMapDefaults
EXPORTS SaffronATDef, SaffronBaseDef, SaffronContext, SaffronContextPrivateTypes ~ {
OPEN SaffronATDef, SaffronContextPrivateTypes, SaffronGenericDef;


ReadDefFile: PUBLIC PROC [ fname: Rope.ROPE ] RETURNS [ ModulePPTreeNode ] ~ {
actualFileName: Rope.ROPE;
data: IO.STREAM;
root: SaffronATDef.TopNode;
rootData: SaffronAG1Def.TopmodulepProdData;
reportStream: IO.STREAM _ ThreeC4Support.GetReportStream[];
[actualFileName, data] _ FindFile[fname];

IF data = NIL THEN
BEGIN
IO.PutF[reportStream, "\N\N\NFailed to find %g \N\N\N", IO.rope[fname]];
ERROR;
END;
IO.PutF[reportStream, "\N\N\N parsing from %g \N\N\N", IO.rope[actualFileName]];
root _ NARROW [SaffronCentralDef.ParseOneStream[data, 0, reportStream]];
IO.Close[data];
rootData _ NARROW[root.data];
RETURN[ModulePPTreeVal[rootData.ModuleP]];
};

FindFile: PUBLIC PROC[short: Rope.ROPE, extension: Rope.ROPE _ NIL] RETURNS[fullName: Rope.ROPE, s: IO.STREAM _ NIL] =
BEGIN
fileName: Rope.ROPE;
mapList: VersionMap.MapList ~ VersionMapDefaults.GetMapList[$Symbols];
list: VersionMap.MapAndNameList;

IF ( extension = NIL ) THEN extension _ "Mesa";
fileName _ Rope.Cat[short, ".", extension];
IF ( (s _ FS.StreamOpen[fileName ! FS.Error => CONTINUE]) # NIL ) THEN RETURN[fileName, s];
list _ VersionMap.ShortNameToNames[mapList, Rope.Cat[short, ".", "BCD"]];
FOR p: VersionMap.MapAndNameList _ list, p.rest UNTIL p=NIL DO
remoteFileName: Rope.ROPE ~ p.first.name;
cp: FS.ComponentPositions;
package: Rope.ROPE;
src: Rope.ROPE;
fullFName: Rope.ROPE;
[fullFName, cp] _ FS.ExpandName[remoteFileName];
package _ Rope.Substr[fullFName, 0, cp.ext.start];
src _ Rope.Concat[package, extension];
IF ( (s _ FS.StreamOpen[src ! FS.Error => LOOP]) # NIL ) THEN RETURN[src, s];
ENDLOOP;
END;




EnvironmentNode: TYPE ~ REF EnvironmentNodeBody;
EnvironmentNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.EnvironmentNodeBody;

CreateEmptyEnvironment: PUBLIC PROC RETURNS [EnvironmentNode] ~ {
RETURN[NEW [EnvironmentNodeBody _ [CreateEmptyRopeNames[]] ]];
};

AddInterfaceToEnvironment: PUBLIC PROC [env: EnvironmentNode, fileName: Rope.ROPE,
ifc: InterfaceValNode] RETURNS [EnvironmentNode] ~ {
RecordRopeName[env.interfaces, fileName, ifc];
RETURN[env];
};

LookupInterfaceInEnv: PUBLIC PROC [env: EnvironmentNode, fileName: Rope.ROPE]
RETURNS [InterfaceValNode] ~ {
RETURN[NARROW[LookupRopeName[env.interfaces, fileName]]];
};

IsInterfaceInEnv: PUBLIC PROC [env: EnvironmentNode, fileName: Rope.ROPE] RETURNS [BOOLEAN] ~ {
RETURN[LookupRopeName[env.interfaces, fileName] # NIL];
};

FakeDamageEnvironment: PUBLIC PROC [env: EnvironmentNode] RETURNS [EnvironmentNode] = {RETURN[env]};
InterfaceValNode: TYPE ~ REF InterfaceValNodeBody;
InterfaceValNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.InterfaceValNodeBody; 

CreateInterfaceFromContextTree: PUBLIC PROC [ct: ContextTreeNode, ns: NameSequenceNode]
RETURNS [in: InterfaceValNode] ~ {
entries: VisibleNames _ CreateEmptyVisibleNames[];
typeNames: VisibleNames _ ct.rib.lc.lvtn; -- herein lies the crock
EnterOneName: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ~ {
tgn: TypeGraphNodeNode _ NARROW[value]; -- check
RecordVisibleName[entries, name, access, tgn];
};
GenVisibleNames[typeNames, EnterOneName];
RETURN[NEW [InterfaceValNodeBody _ [ns, entries, ct]]];
};


GenInterfaceEntries: PROC [in: InterfaceValNode,
for: PROC [IdNode, AccessValNode, TypeGraphNodeNode] ] ~ {
SeeOne: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ~ {
for[name, access, NARROW[value]];
};
GenVisibleNames[in.entries, SeeOne];
};

LookupInterfaceEntry: PUBLIC PROC [in: InterfaceValNode, name: IdNode]
RETURNS [access: AccessValNode, tgn: TypeGraphNodeNode] ~ {
value: REF ANY;
[access, value] _ LookupVisibleName[in.entries, name];
RETURN[access, NARROW[value]];
};




ContextTreeNode: TYPE ~ REF ContextTreeNodeBody;
ContextTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ContextTreeNodeBody;


EmptyContextTree: PUBLIC PROC [ rib: ContextRibNode ] RETURNS [ ContextTreeNode ] ~ { RETURN[NEW [ContextTreeNodeBody _ [rib, NIL, NIL]]] };

FakeDamageContextTree: PUBLIC PROC [ ctn: ContextTreeNode ] RETURNS [ ctnp: ContextTreeNode ] ~ { RETURN[ctn] };

AddSubContextTree: PUBLIC PROC [ ctn: ContextTreeNode, subCtn: ContextTreeNode ] RETURNS [ ctnp: ContextTreeNode ] ~ {
cell: CTCell _ NEW [CTCellBody_[subCtn, NIL]];
IF subCtn.rib.lc.rib # ctn.rib THEN ErrorSignal[];
IF ctn.subTrees = NIL THEN ctn.subTrees _ cell ELSE ctn.lastSubTree.next _ cell;
ctn.lastSubTree _ cell;
RETURN[ctn];
};
ContextRibNode: TYPE ~ REF ContextRibNodeBody;
ContextRibNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ContextRibNodeBody;

RootContextRib: PUBLIC PROC RETURNS [ rib: ContextRibNode ] ~ { RETURN[FreezeLocalContext[CreateRootLocalContext[]]] };

FreezeLocalContext: PUBLIC PROC [ lc: LocalContextNode ] RETURNS [ rib: ContextRibNode ] ~ {
lc.frozen _ TRUE;
RETURN[NEW [ContextRibNodeBody _ [lc]]];
};
LocalContextNode: TYPE ~ REF LocalContextNodeBody;
LocalContextNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.LocalContextNodeBody;

CreateBasicLocalContext: PROC RETURNS [ LocalContextNode ] ~ {
lc: LocalContextNode _ NEW [LocalContextNodeBody];
lc.lvtn _ CreateEmptyVisibleNames[];
lc.paintIndex _ 0;
RETURN[lc];
};

CreateRootLocalContext: PROC RETURNS [ LocalContextNode ] ~ {
lc: LocalContextNode _ CreateBasicLocalContext[];
lc.rib _ NIL;
[lc.top, lc.bottom] _ CreateTopAndBottom[lc];
lc.unpaintedPaint _ CreateUnpaintedPaint[lc];
InstallBaseTypes[lc];
RETURN[lc];
};

CreateEmptyContext: PUBLIC PROC [ rib: ContextRibNode ]
RETURNS [ LocalContextNode ] ~ {
lc: LocalContextNode _ CreateBasicLocalContext[];
lc.rib _ rib;
lc.top _ rib.lc.top;
lc.bottom _ rib.lc.bottom;
lc.unpaintedPaint _ rib.lc.unpaintedPaint;
RETURN[lc];
};

FakeDamageContext: PUBLIC PROC [lc: LocalContextNode]
RETURNS [lcp: LocalContextNode] ~ {
lcp _ lc;
};
TypeGraphNodeNode: TYPE ~ REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.TypeGraphNodeNodeBody;

CreateTGN: PROC [ lc: LocalContextNode, body: REF ANY ]
RETURNS [ tgn: TypeGraphNodeNode ] ~ {
tgn _ NEW [TypeGraphNodeNodeBody _ [
shown: FALSE,
index: lc.maxTGNodeIndex + 1,
localContext: lc,
body: body,
next: lc.tgNodes]];
lc.maxTGNodeIndex _ tgn.index;
lc.tgNodes _ tgn;
};

FindBottomTGN: PUBLIC PROC [ lc: LocalContextNode ]
RETURNS [ tgn: TypeGraphNodeNode ] ~ {
RETURN[lc.bottom];
};

FindTopTGN: PUBLIC PROC [ lc: LocalContextNode ]
RETURNS [ tgn: TypeGraphNodeNode ] ~ {
RETURN[lc.top];
};

FindLocallyVisibleTGN: PUBLIC PROC [ lc: LocalContextNode, name: IdNode ]
RETURNS [ TypeGraphNodeNode ] ~ {
FOR lcx: LocalContextNode _ lc, lcx.rib.lc WHILE ( lcx # NIL ) DO
tgn: TypeGraphNodeNode _ NARROW[LookupVisibleName[lcx.lvtn, name].value];
IF tgn # NIL THEN RETURN[tgn];
IF lcx.rib = NIL THEN EXIT;
ENDLOOP;
ErrorSignal[];
};
InstallBaseTypes: PROC [ lc: LocalContextNode ] ~ {
InstallBaseType[lc, "ATOM"];
InstallBaseType[lc, "BOOL"];
InstallBaseType[lc, "BOOLEAN"];
InstallBaseType[lc, "CHAR"];
InstallBaseType[lc, "CHARACTER"];
InstallBaseType[lc, "CONDITION"];
InstallBaseType[lc, "MONITORLOCK"];
InstallBaseType[lc, "REAL"];
InstallBaseType[lc, "STRING"];
InstallBaseType[lc, "UNSPECIFIED"];

InstallBaseType[lc, "WORD"]; -- bpw?
InstallBaseType[lc, "BYTE"]; -- 8

InstallBaseType[lc, "DINT"]; -- bdpw
InstallBaseType[lc, "INT"];  -- bplw
InstallBaseType[lc, "INTEGER"];  -- bpw
InstallBaseType[lc, "INT16"]; -- 16
InstallBaseType[lc, "INT32"]; -- 32
InstallBaseType[lc, "INT64"];  -- 64

InstallBaseType[lc, "DCARD"]; -- bdpw
InstallBaseType[lc, "CARD"]; -- bplw
InstallBaseType[lc, "CARDINAL"]; -- bpw
InstallBaseType[lc, "CARD16"]; -- 16
InstallBaseType[lc, "CARD32"]; -- 32
InstallBaseType[lc, "CARD64"]; -- 64

InstallBaseType[lc, "NAT"]; -- bpw-1
InstallBaseType[lc, "NATURAL"]; -- bpw-1
InstallBaseType[lc, "NAT15"]; -- 15
InstallBaseType[lc, "NAT31"]; -- 31
InstallBaseType[lc, "NAT63"]; -- 63
};

InstallBaseType: PROC [ lc: LocalContextNode, typeName: Rope.ROPE ] ~ {
body: BaseTypeTGN _ NEW [BaseTypeTGNBody _ [typeName: typeName]];
tgn: TypeGraphNodeNode _ CreateTGN[lc, body];
nameAsIdNode: IdNode _ NEW [IdNodeBody _ [typeName, 0, 0]];
RecordVisibleName[lc.lvtn, nameAsIdNode, NIL, tgn];
};
CreateTopAndBottom: PROC [ lc: LocalContextNode ] RETURNS [ top, bottom: TypeGraphNodeNode ] ~ {
topBody: SpecialTGN _ NEW [SpecialTGNBody _ [top]];
bottomBody: SpecialTGN _ NEW [SpecialTGNBody _ [bottom]];
top _ CreateTGN[lc, topBody];
bottom _ CreateTGN[lc, bottomBody];
};
CreateLocallyVisibleTGN:  PUBLIC PROC [ lc: LocalContextNode, name: IdNode, access: AccessValNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: NamedTGN _ NEW [NamedTGNBody _ [name: name]];
tgn _ CreateTGN[lc, body];
RecordVisibleName[lc.lvtn, name, access, tgn];
RETURN[lc, tgn];
};

AddArcFromLVTGNToTGN: PUBLIC PROC [ lc: LocalContextNode, lvTgn: TypeGraphNodeNode, access: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode ] RETURNS [ lcp: LocalContextNode ] ~ {
namedNode: NamedTGN _ NARROW[lvTgn.body];
namedNode.access _ access;
namedNode.type _ tgn;
namedNode.default _ default;
RETURN[lc];
};

ResolveNamedNodes: PROC[tgn: TypeGraphNodeNode] RETURNS[TypeGraphNodeNode] =
BEGIN
x: TypeGraphNodeNode _ tgn;
WHILE TRUE DO
WITH x.body SELECT FROM
namedNode: NamedTGN => x _ namedNode.type;
ENDCASE => RETURN[x];
ENDLOOP;
ERROR;
END;
CreateSubrangeTGN: PUBLIC PROC [ lc: LocalContextNode, subrangeOf: TypeGraphNodeNode, bounds: BoundsValNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: SubrangeTGN _ NEW [SubrangeTGNBody _ [subrangeOf, bounds]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateRecordTGN: PUBLIC PROC [ lc: LocalContextNode, p: PaintNode, machineDependent, monitoredRecord: BOOLEAN, ffl: FrozenFieldListNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: RecordTGN _ NEW [RecordTGNBody _ [p, machineDependent, monitoredRecord, ffl]];
RETURN[lc, CreateTGN[lc, body]];
};
CreatePointerTGN: PUBLIC PROC [ lc: LocalContextNode, ordered, base: BOOLEAN, bounds: BoundsValNode, readOnly: BOOLEAN, targetTgn: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: PointerTGN _ NEW [PointerTGNBody _ [ordered, base, readOnly, bounds, targetTgn]];
RETURN[lc, CreateTGN[lc, body]];
};

CreateRefTGN: PUBLIC PROC [ lc: LocalContextNode, machineDependent: BOOLEAN, contentsTgn: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
referent: ReferentTGN _ NEW [ReferentTGNBody _ [contentsTgn]];
body: RefTGN _ NEW [RefTGNBody _ [machineDependent, CreateTGN[lc, referent]]];
RETURN[lc, CreateTGN[lc, body]];
};

CreateVarTGN: PUBLIC PROC [ lc: LocalContextNode, targetTgn: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: VarTGN _ NEW [VarTGNBody _ [targetTgn]];
RETURN[lc, CreateTGN[lc, body]];
};

CreateRelativeTGN: PUBLIC PROC [ lc: LocalContextNode, base, pointer: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: RelativeTGN _ NEW [RelativeTGNBody _ [base, pointer]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateListTGN: PUBLIC PROC [ lc: LocalContextNode, readOnly: BOOLEAN, itemType: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: ListTGN _ NEW [ListTGNBody _ [readOnly, itemType, NIL]];
body.rest _ body;
RETURN[lc, CreateTGN[lc, body]];
};
CreateEmptyEnumTypeTGN: PUBLIC PROC [ lc: LocalContextNode, machineDependent: BOOLEAN ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: EnumTGN _ NEW [EnumTGNBody _ [machineDependent, GetUniquePaint[lc].p, NIL, NIL]];
RETURN[lc, CreateTGN[lc, body]];
};
AppendElementToEnumTypeTGN: PUBLIC PROC [ lc: LocalContextNode, tgn: TypeGraphNodeNode, elementName: IdNode, rep: ExpPTreeNode ] RETURNS [ lcp: LocalContextNode ] ~ {
body: EnumTGN _ NARROW[tgn.body];
cell: EnumElementCell _ NEW [EnumElementCellBody _ [elementName, rep, NIL]];
IF body.lastElement = NIL
THEN body.firstElement _ cell
ELSE body.lastElement.next _ cell;
body.lastElement _ cell;
RETURN[lc];
};
FieldNode: TYPE ~ REF FieldNodeBody;
FieldNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.FieldNodeBody;

FieldListNode: TYPE ~ REF FieldListNodeBody;
FieldListNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.FieldListNodeBody;

FrozenFieldListNode: TYPE ~ REF FrozenFieldListNodeBody;
FrozenFieldListNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.FrozenFieldListNodeBody;

CreateNamedField: PUBLIC PROC [ n: IdNode, pvn: PositionValNode, avn: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode ] RETURNS [ f: FieldNode ] ~ { RETURN[NEW [FieldNodeBody _ [n, pvn, avn, tgn, default]]] };

CreateUnnamedField: PUBLIC PROC [ tgn: TypeGraphNodeNode, default: DefaultExpNode ] RETURNS [ f: FieldNode ] ~ { RETURN[NEW [FieldNodeBody _ [NIL, NIL, NIL, tgn, default]]] };

CreateEmptyFieldList: PUBLIC PROC RETURNS [ fl: FieldListNode ] ~ { RETURN[NEW [FieldListNodeBody _ [FALSE, 0, 0, NIL, NIL]]] };

AnyFieldList: PUBLIC PROC RETURNS [ fl: FieldListNode ] ~ { RETURN[NEW [FieldListNodeBody _ [TRUE, 0, 0, NIL, NIL]]] };

PrependCellToFieldList: PROC [ nFields: INT, cell: FieldListCell, fl: FieldListNode ] RETURNS [ flp: FieldListNode ] ~ {
IF fl.any THEN ERROR;
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];
};

AppendCellToFieldList: PROC [ fl: FieldListNode, nFields: INT, cell: FieldListCell ] RETURNS [ flp: FieldListNode ] ~ {
IF fl.any THEN ERROR;
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];
};

PrependFieldToFieldList: PUBLIC PROC [ f: FieldNode, fl: FieldListNode ] RETURNS [ flp: FieldListNode ] ~ {
cell: FieldListCell _ NEW [FieldListCellBody _ [f, NIL]];
RETURN[PrependCellToFieldList[1, cell, fl]];
};

AppendFieldToFieldList: PUBLIC PROC [ fl: FieldListNode, f: FieldNode ] RETURNS [ flp: FieldListNode ] ~ {
cell: FieldListCell _ NEW [FieldListCellBody _ [f, NIL]];
RETURN[AppendCellToFieldList[fl, 1, cell]];
};

AppendFFLToFieldList: PUBLIC PROC [ fl: FieldListNode, ffl: FrozenFieldListNode ] RETURNS [ flp: FieldListNode ] ~ {
cell: FieldListCell _ NEW [FieldListCellBody _ [ffl, NIL]];
RETURN[AppendCellToFieldList[fl, ffl.nFields, cell]];
};
ConcatFieldLists: PUBLIC PROC [ fl1, fl2: FieldListNode ] RETURNS [ fl: FieldListNode ] ~ {
IF fl1.any OR fl2.any THEN ERROR;
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];
};

FreezeFieldList: PUBLIC PROC [ lc: LocalContextNode, fl: FieldListNode ] RETURNS [ lcp: LocalContextNode, ffl: FrozenFieldListNode ] ~ {
cell: FieldListCell _ fl.firstCell;
ffl _ NEW [FrozenFieldListNodeBody[fl.nCells]];
ffl.any _ fl.any;
ffl.nFields _ fl.nFields;
ffl.next _ lc.fieldLists;
lc.fieldLists _ ffl;
FOR I: CARDINAL IN [0..CARDINAL[fl.nCells]) DO
ffl[I] _ WITH cell.item SELECT FROM
f: FieldNode => [field, f.name, f.pvn, f.avn, f.tgn, f.default, NIL],
fflist: FrozenFieldListNode => [ffl, NIL, NIL, NIL, NIL, NIL, fflist],
ENDCASE => ERROR;
cell _ cell.next;
ENDLOOP;
FOR I: CARDINAL IN [0..ffl.nFields) DO
SELECT ffl[I].case FROM
field => IF IsVariantPartTGN[ffl[I].tgn] THEN {
IF I = (CARDINAL[ffl.nFields]-1) THEN ffl.variant _ TRUE
ELSE ERROR; -- variation allowed only in last field
};
ffl => IF ffl[I].ffl.variant THEN {
IF I = (CARDINAL[ffl.nFields]-1) THEN ffl.variant _ TRUE
ELSE ERROR; -- variation allowed only in last field
};
ENDCASE => ERROR;
ENDLOOP;
RETURN[lc, ffl];
};
UnionListNode: TYPE ~ REF UnionListNodeBody;
UnionListNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.UnionListNodeBody;

CreateVariantPartTGN: PUBLIC PROC [ lc: LocalContextNode, flavor: VariantFlavorNode, tagType: TypeGraphNodeNode, types: UnionListNode ]
RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: VariantPartTGN _ NEW [VariantPartTGNBody _ [
flavor,
tagType,
FreezeUnionList[types]]];
RETURN[lc, CreateTGN[lc, body]];
};

IsVariantPartTGN: PROC [ tgn: TypeGraphNodeNode ] RETURNS [ BOOLEAN ] ~ {
WITH tgn.body SELECT FROM
vptgn: VariantPartTGN => RETURN[TRUE];
ENDCASE => RETURN[FALSE];
};

GetVariantPartUnionList: PROC [ tgn: TypeGraphNodeNode ]
RETURNS [ FrozenUnionList ] ~ {
WITH tgn.body SELECT FROM
vptgn: VariantPartTGN => RETURN[vptgn.types];
ENDCASE => ERROR;
};

CreateEmptyUnionList: PUBLIC PROC RETURNS [ UnionListNode ] ~ {
RETURN[NEW [UnionListNodeBody _ [0, NIL, NIL]]];
};

AppendToUnionList: PUBLIC PROC [ ul: UnionListNode, id: IdNode,
ffl: FrozenFieldListNode ] RETURNS [ ulnp: UnionListNode ] ~ {
newCell: UnionListCell _ NEW [UnionListCellBody _ [id, ffl, NIL]];
IF ( ul.first = NIL ) THEN ul.first _ newCell ELSE ul.last.next _ newCell;
ul.last _ newCell;
ul.nCells _ ul.nCells+1;
RETURN[ul];
};

FreezeUnionList: PROC[ ul: UnionListNode ] RETURNS [ FrozenUnionList ] ~ {
ful: FrozenUnionList _ NEW [FrozenUnionListBody[ul.nCells]];
cell: UnionListCell _ ul.first;
FOR i: CARDINAL IN [0..ful.nTypes) DO
ful[i] _ [cell.id, cell.ffl];
cell _ cell.next;
ENDLOOP;
RETURN[ful]
};
VariantFlavorNode: TYPE ~ REF VariantFlavorNodeBody;
VariantFlavorNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.VariantFlavorNodeBody;

OverlaidVariantFlavorConst: PUBLIC PROC RETURNS [ VariantFlavorNode ] ~ { RETURN[NEW [overlaid VariantFlavorNodeBody _ [overlaid[]]]] };

ComputedVariantFlavorConst: PUBLIC PROC RETURNS [ VariantFlavorNode ] ~ { RETURN[NEW [computed VariantFlavorNodeBody _ [computed[]]]] };

VanillaVariantFlavorVal: PUBLIC PROC [ id: IdNode, position: PositionValNode, access: AccessValNode ] RETURNS [ VariantFlavorNode ] ~ { RETURN[NEW [vanilla VariantFlavorNodeBody _ [vanilla[id, position, access]]]] };
SequenceTGN: TYPE ~ REF SequenceTGNBody;
SequenceTGNBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.SequenceTGNBody;

CreateSequenceTGN: PUBLIC PROC [ lc: LocalContextNode, packed: BOOLEAN, id: IdNode, position: PositionValNode, access: AccessValNode, tagType: TypeGraphNodeNode,
type: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode,
tgn: TypeGraphNodeNode ] ~ {
body: SequenceTGN _ NEW [SequenceTGNBody _ [packed, id, position, access, tagType, type]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateArrayTGN: PUBLIC PROC [ lc: LocalContextNode, packed: BOOLEAN, indexType: TypeGraphNodeNode, itemType: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: ArrayTGN _ NEW [ArrayTGNBody _ [packed, indexType, itemType]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateDescriptorTGN: PUBLIC PROC [ lc: LocalContextNode, readonly: BOOLEAN, itemType: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: DescriptorTGN _ NEW [DescriptorTGNBody _ [readonly, itemType]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateTransferTGN: PUBLIC PROC [ lc: LocalContextNode, safe: BOOLEAN, modeName: Rope.ROPE, arguments, results: FrozenFieldListNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
mode: TransferMode _ SELECT TRUE FROM
Rope.Equal["proc", modeName] => proc,
Rope.Equal["port", modeName] => port,
Rope.Equal["signal", modeName] => signal,
Rope.Equal["error", modeName] => error,
Rope.Equal["process", modeName] => process,
Rope.Equal["program", modeName] => program,
ENDCASE => ERROR;
body: TransferTGN _ NEW [TransferTGNBody_[safe, mode, arguments, results]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateZoneTGN: PUBLIC PROC [ lc: LocalContextNode, uncounted: BOOLEAN ]
RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: ZoneTGN _ NEW [ZoneTGNBody _ [uncounted]];
RETURN[lc, CreateTGN[lc, body]];
};
CreateLongTGN: PUBLIC PROC [ lc: LocalContextNode,
underlyingType: TypeGraphNodeNode ]
RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: LongTGN _ NEW [LongTGNBody _ [underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
};

CreateEmptyInterfaceTGN: PUBLIC PROC [ lc: LocalContextNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: InterfaceTGN _ NEW [InterfaceTGNBody _ [FALSE, CreateEmptyVisibleNames[]]];
RETURN[lc, CreateTGN[lc, body]];
};
AddTGNToInterfaceTGN: PUBLIC PROC [lc: LocalContextNode, if: TypeGraphNodeNode, name: IdNode, access: AccessValNode, entryTgn: TypeGraphNodeNode]
RETURNS [lcp: LocalContextNode] ~ {
iftgn: InterfaceTGN _ NARROW[if.body];
IF entryTgn # NIL THEN RecordVisibleName[iftgn.typeNames, name, access, entryTgn];
RETURN[lc];
};

CreateInterfaceTGNFromInterface: PUBLIC PROC [lc: LocalContextNode, if: InterfaceValNode] RETURNS [lcp: LocalContextNode, ifTgn: TypeGraphNodeNode] ~ {
AddOne: PROC [name: IdNode, access: AccessValNode, entryTGN: TypeGraphNodeNode] ~ {
[] _ AddTGNToInterfaceTGN[lc, ifTgn, name, access, CreateLinkTGN[lc, entryTGN, if, name].ltgn];
};
ifTgn _ CreateEmptyInterfaceTGN[lc].tgn;
GenInterfaceEntries[if, AddOne];
RETURN[lc, ifTgn];
};




LookupTypeNameInInterfaceTGN: PUBLIC PROC [ lc: LocalContextNode, id: IdNode, if: TypeGraphNodeNode ] RETURNS [ tgn: TypeGraphNodeNode ] ~ {
iftgn: InterfaceTGN _ NARROW[if.body];
refAnyTgn: REF ANY;
access: AccessValNode;
[access, refAnyTgn] _ LookupVisibleName[iftgn.typeNames, id];
IF access^ = public OR (access^ = private AND iftgn.sharedAccess) THEN RETURN[NARROW[refAnyTgn]];
ErrorSignal[];
};

GenPublicTypeNamesFromInterfaceTGN: PROC [ if: TypeGraphNodeNode,
for: PROC [ IdNode, TypeGraphNodeNode ] ] ~ {
iftgn: InterfaceTGN _ NARROW[if.body];
localFor: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ~ 
BEGIN
IF access^ = public OR (access^ = private AND iftgn.sharedAccess) THEN for[name, NARROW[value]] 
END;
GenVisibleNames[iftgn.typeNames, localFor];
};

RenameInterface: PUBLIC PROC [lc: LocalContextNode, name: IdNode, interface: TypeGraphNodeNode] RETURNS [lcp: LocalContextNode] ~ {
newTGN: TypeGraphNodeNode _ CreateLocallyVisibleTGN[lc, name, AccessValConst["private"]].tgn;
WITH interface.body SELECT FROM
itgn: InterfaceTGN => NULL;
ENDCASE => ERROR;
[] _ AddArcFromLVTGNToTGN[lc, newTGN, AccessValConst["private"], interface, DefaultExpVal["", NullExpPTree[]]];
RETURN[lc];
};

OpenInterface: PUBLIC PROC [ lc: LocalContextNode, interfaceTGN: TypeGraphNodeNode ] RETURNS [ lcp: LocalContextNode ] ~ {
OpenOneInterfaceTypeName: PROC [ name: IdNode, tgn: TypeGraphNodeNode ] ~ {
newTGN: TypeGraphNodeNode _ CreateLocallyVisibleTGN[lc, name, NEW[AccessValNodeBody_NotSureWhatItShouldBe]].tgn;
[] _ AddArcFromLVTGNToTGN[lc, newTGN, NEW[AccessValNodeBody_NotSureWhatItShouldBe], tgn, DefaultExpVal["", NullExpPTree[]]];
};
GenPublicTypeNamesFromInterfaceTGN[ResolveNamedNodes[interfaceTGN], OpenOneInterfaceTypeName];
RETURN[lc];
};

CreateLinkTGN: PUBLIC PROC[lc: LocalContextNode, tgn: TypeGraphNodeNode, if: InterfaceValNode, itemName: IdNode] RETURNS[lcp: LocalContextNode, ltgn: TypeGraphNodeNode] =
BEGIN
IF tgn = NIL THEN RETURN[lc, NIL]; -- was a standin for an entry point
RETURN[lc, CreateTGN[lc, NEW[LinkTGNBody_[tgn, if, itemName]]]];
END;

FindFrameTGN: PUBLIC PROC [ lc: LocalContextNode, id: IdNode ]
RETURNS [ tgn: TypeGraphNodeNode ] ~ {
tgn _ FindLocallyVisibleTGN[lc, id];
WITH tgn.body SELECT FROM
ftgn: FrameTGN => RETURN[tgn];
ENDCASE => ERROR;
};
CreateSpecianatedTGNUsingId: PUBLIC PROC [ lc: LocalContextNode, underlyingType: TypeGraphNodeNode, id: IdNode ] RETURNS [ lcp: LocalContextNode,
tgn: TypeGraphNodeNode ] ~ {
WITH underlyingType.body SELECT FROM
iftgn: InterfaceTGN => {
RETURN[lc, LookupTypeNameInInterfaceTGN[lc, id, underlyingType].tgn];
};
ENDCASE => {
body: SpecianatedTGN _ NEW [SpecianatedTGNBody _ [NIL, id, underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
};
};

CreateSpecianatedTGNUsingExp: PUBLIC PROC [ lc: LocalContextNode, underlyingType: TypeGraphNodeNode, parameter: ExpPTreeNode ] RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: SpecianatedTGN _ NEW [SpecianatedTGNBody _ [parameter, NIL, underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
};
OpaqueTGN: TYPE = REF OpaqueTGNBody;
OpaqueTGNBody: PUBLIC TYPE = SaffronContextPrivateTypes.OpaqueTGNBody;

CreateOpaqueTGN: PUBLIC PROC[lc: LocalContextNode, paint: PaintNode, optSize: ExpPTreeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode ] =
BEGIN
body: OpaqueTGN _ NEW[OpaqueTGNBody_[paint, optSize]];
RETURN[lc, CreateTGN[lc, body]];
END; 
PaintNode: TYPE ~ REF PaintNodeBody;
PaintNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.PaintNodeBody;

CreateUnpaintedPaint: PROC [ lc: LocalContextNode ] RETURNS [ PaintNode ] ~ { RETURN[NEW [PaintNodeBody _ [lc, 0]]] };

GetUnpaintedPaint: PUBLIC PROC [ lc: LocalContextNode ] RETURNS [ lcp: LocalContextNode, p: PaintNode ] ~ { RETURN[lc, lc.unpaintedPaint] };
GetUniquePaint: PUBLIC PROC [ lc: LocalContextNode ] RETURNS [ lcp: LocalContextNode, p: PaintNode ] ~ {
lc.paintIndex _ lc.paintIndex + 1;
RETURN[lc, NEW [PaintNodeBody _ [lc, lc.paintIndex]]];
};
CreateEmptyVisibleNames: PROC RETURNS [ vn: VisibleNames ] ~ {
vn _ NEW [VisibleNamesBody _ [NIL]];
RETURN[vn];
};

RecordVisibleName: PROC [ vn: VisibleNames, name: IdNode, access: AccessValNode,
value: REF ANY ] ~ {
newCell: VNCell _ NEW [VNCellBody _ [name, access, value, vn.first]];
IF ( LookupVisibleName[vn, name].value # NIL ) THEN ErrorSignal[];
newCell _ NEW[VNCellBody _ [name, access, value, vn.first]];
vn.first _ newCell;
};

LookupVisibleName: PROC [vn: VisibleNames, name: IdNode]
RETURNS [access: AccessValNode, value: REF ANY] ~ {
cell: VNCell _ vn.first;
WHILE ( cell # NIL ) DO
IF Rope.Equal[RopeFromId[cell.id], RopeFromId[name]] THEN RETURN[cell.access, cell.value];
cell _ cell.next;
ENDLOOP;
RETURN[NIL, NIL];
};

GenVisibleNames: PUBLIC PROC [vn: VisibleNames,
for: PROC [name: IdNode, access: AccessValNode, value: REF ANY] ] ~ {
cell: VNCell _ vn.first;
WHILE ( cell # NIL ) DO
for[cell.id, cell.access, cell.value];
cell _ cell.next;
ENDLOOP;
};
DefaultExpNode: TYPE ~ REF DefaultExpNodeBody;
DefaultExpNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.DefaultExpNodeBody;

DefaultExpVal: PUBLIC PROC [ case: Rope.ROPE, exp: ExpPTreeNode ]
RETURNS [ DefaultExpNode ] ~ {
RETURN[NEW [DefaultExpNodeBody _ [
SELECT TRUE FROM
Rope.Equal[case, ""] => c1,
Rope.Equal[case, "_"] => c2,
Rope.Equal[case, "_e"] => c3,
Rope.Equal[case, "_TRASH"] => c4,
Rope.Equal[case, "_e|TRASH"] => c5,
ENDCASE => ERROR,
exp]]];
};

NullDefaultVal: PUBLIC PROC RETURNS [ DefaultExpNode ] ~ {
RETURN[NIL];
};
PositionValNode: TYPE ~ REF PositionValNodeBody;
PositionValNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.PositionValNodeBody;

PositionValFun: PUBLIC PROC [ index: ExpPTreeNode, bounds: BoundsValNode ]
RETURNS [ PositionValNode ] ~ {
RETURN[NEW[PositionValNodeBody _ [index, bounds]]];
};

NullPosition: PUBLIC PROC RETURNS [ PositionValNode ] ~ {
RETURN[NIL];
};
BoundsValNode: TYPE ~ REF BoundsValNodeBody;
BoundsValNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.BoundsValNodeBody;

BoundsValFun: PUBLIC PROC [ leftBracket: Rope.ROPE, first: ExpPTreeNode, last: ExpPTreeNode, rightBracket: Rope.ROPE ] RETURNS [ BoundsValNode ] ~ {
bvn: BoundsValNode _ NEW [BoundsValNodeBody _ [open, first, last, open]];
bvn.left _ SELECT TRUE FROM
Rope.Equal["[", leftBracket] => closed,
Rope.Equal["(", leftBracket] => open,
ENDCASE => ERROR;
bvn.right _ SELECT TRUE FROM
Rope.Equal["]", rightBracket] => closed,
Rope.Equal[")", rightBracket] => open,
ENDCASE => ERROR;
RETURN[bvn];
};

NullBounds: PUBLIC PROC RETURNS [ BoundsValNode ] ~ { RETURN[NIL] };
AccessValNode: TYPE ~ REF AccessValNodeBody;
AccessValNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.AccessValNodeBody;

AccessValConst: PUBLIC PROC [ r: Rope.ROPE ] RETURNS [ AccessValNode ] ~ {
SELECT TRUE FROM
Rope.Equal[r, "empty"] => RETURN[NEW [AccessValNodeBody _ empty]];
Rope.Equal[r, "private"] => RETURN[NEW [AccessValNodeBody _ private]];
Rope.Equal[r, "public"] => RETURN[NEW [AccessValNodeBody _ public]];
ENDCASE => ErrorSignal[];
};

NullAccessVal: PUBLIC PROC [ ] RETURNS [ AccessValNode ] ~ {
RETURN[NIL];
};
ExpPTreeNode: TYPE ~ REF ExpPTreeNodeBody;
ExpPTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ExpPTreeNodeBody;

ExpPTreeVal: PUBLIC PROC [ node: ExpNode ] RETURNS [ ExpPTreeNode ] ~ {
RETURN[NEW [ExpPTreeNodeBody _ [node]]];
};

NullExpPTree: PUBLIC PROC RETURNS [ ExpPTreeNode ] ~ { RETURN[NIL] };
ScopePTreeNode: TYPE ~ REF ScopePTreeNodeBody;
ScopePTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ScopePTreeNodeBody;
ScopePTreeVal: PUBLIC PROC [ node: ScopeNode ] RETURNS [ ScopePTreeNode ] ~ { RETURN[NEW [ScopePTreeNodeBody _ [node]]] };

ScopeVal: PUBLIC PROC [ box: ScopePTreeNode ] RETURNS [ ScopeNode ] ~ { RETURN[box.node] };
ModulePPTreeNode: TYPE ~ REF ModulePPTreeNodeBody;
ModulePPTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ModulePPTreeNodeBody;

ModulePPTreeVal: PUBLIC PROC [ node: ModulePNode ]
RETURNS [ ModulePPTreeNode ] ~ 
{RETURN[NEW[ModulePPTreeNodeBody_[node]]]};

ModulePVal: PUBLIC PROC [ node: ModulePPTreeNode ] RETURNS [ ModulePNode ] ~ 
{RETURN[node.node]};



DefBodyPTreeNode: TYPE ~ REF DefBodyPTreeNodeBody;
DefBodyPTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.DefBodyPTreeNodeBody;

DefBodyPTreeVal: PUBLIC PROC [ node: DefBodyNode ]
RETURNS [ DefBodyPTreeNode ] ~ 
{RETURN[NEW[DefBodyPTreeNodeBody_[node]]]};


DefBodyVal: PUBLIC PROC [ node: DefBodyPTreeNode ]
RETURNS [ DefBodyNode ] ~ 
{RETURN[node.node]};
NameSequenceNode: TYPE = REF NameSequenceNodeBody;
NameSequenceNodeBody: PUBLIC TYPE = SaffronContextPrivateTypes.NameSequenceNodeBody;

EmptyNameSequence: PUBLIC PROC RETURNS[NameSequenceNode] =
{RETURN[NEW[NameSequenceNodeBody _ NIL]]};

InsertNameOnNameSequence: PUBLIC PROC[name: IdNode, ns: NameSequenceNode] RETURNS[NameSequenceNode] =
{RETURN[NEW[NameSequenceNodeBody _ CONS[name, ns^]]]};
RopeNames: TYPE  = REF RopeNamesBody;
RopeNamesBody: TYPE = SaffronContextPrivateTypes.RopeNamesBody;

RNCell: TYPE = REF RNCellBody; RNCellBody: TYPE = SaffronContextPrivateTypes.RNCellBody;

CreateEmptyRopeNames: PROC RETURNS[rns: RopeNames] =
BEGIN
rns _ NEW[RopeNamesBody _ [NIL]];
RETURN[rns];
END;

RecordRopeName: PROC[rns: RopeNames, name: Rope.ROPE, val: REF ANY] =
BEGIN
newCell: RNCell _ NEW[RNCellBody_[name, val, rns.first]];
IF (LookupRopeName[rns, name] # NIL) THEN ErrorSignal[];
rns.first _ newCell;
END;

LookupRopeName: PROC[rns: RopeNames, name: Rope.ROPE] RETURNS[REF ANY] =
BEGIN
cell: RNCell _ rns.first;
WHILE cell # NIL DO
IF Rope.Equal[cell.name, name] THEN RETURN[cell.value];
cell _ cell.next;
ENDLOOP;
RETURN[NIL];
END;

GenRopeNames: PUBLIC PROC[rns: RopeNames, for: PROC[Rope.ROPE, REF ANY]] =
BEGIN
cell: RNCell _ rns.first;
WHILE cell # NIL DO
for[cell.name, cell.value];
cell _ cell.next;
ENDLOOP;
END;
RopeFromId: PUBLIC PROC [ id: IdNode ] RETURNS [ Rope.ROPE ] ~ {
RETURN[IF ( id # NIL ) THEN id.text ELSE ""];
};

RopeFromString: PUBLIC PROC [ string: StringNode ] RETURNS [ Rope.ROPE ] ~ {
RETURN[IF ( string # NIL ) THEN string.text ELSE ""];
};
ErrorSignal: PUBLIC ERROR ~ CODE;
True: PUBLIC PROC RETURNS [ BOOLEAN ] ~ { RETURN[TRUE] };

False: PUBLIC PROC RETURNS [ BOOLEAN ] ~ { RETURN[FALSE] };

BooleanConst: PUBLIC PROC [ r: Rope.ROPE ] RETURNS [ BOOLEAN ] ~ {
SELECT TRUE FROM
Rope.Equal[r, "True"] => RETURN[TRUE];
Rope.Equal[r, "False"] => RETURN[FALSE];
ENDCASE => ErrorSignal[];
};

Error: PUBLIC PROC [ r: Rope.ROPE ] RETURNS [ BOOLEAN ] ~ { ERROR };

NullId: PUBLIC PROC RETURNS [ IdNode ] ~ { RETURN[NIL] };
}.

๖SaffronContextCreateCTImpl.Mesa
Copyright ำ 1987 by Xerox Corporation.  All rights reserved.
Sturgis, July 15, 1987 12:56:40 pm PDT
Bill Jackson (bj) August 12, 1987 4:53:31 pm PDT
Lucy Hederman August 17, 1987 6:32:17 pm PDT

This module contains the code to create the context tree and type graph, but it performs no analysis, nor does it contain any print routines
Module Stuff
The need for delving into the root data structure is a hack.  Since the parser returns a TopNode, the recursive function body that calls theis procedure should have been prepared to get a (boxed) TopNode, rather than a (boxed) ModulePNode.
tries working directory then release.  Adopts some code from Bill Jackson.
If the working directory succeeds, then returns a file name without any directory prefix.
If had to try the release, then returns a file name with directory prefix.
Environment
damages env and ifc
declare as damaging env
Interfaces

this procedure must be called after forming the context tree that contains the body of the definitions file.  i.e., the names occurring in the locally visible names must be the names one expects to see in the interface
It is a little bit of a crock at the moment, because I do not have the data structures quite like I would like them.

Note: Context trees have no modifiable data structures.  Hence, this does not have to damage the context tree, nor share with the result.
used to create an interfaceTGN whole hog

Context Trees
ERROR: There needs to be a form of frozen context tree.  In any case, the comment on CreateInterfaceFromContextTree is wrong.  Either there is a way of freezing context trees, and it will be used on the way to forming an interface, so as to avoid the declaration of sharing, or we build up a list of context trees, and then form then at one blow.  I prefer the latter.  So, we need a new concept: ContextTreeSeq, the following ops: EmptyContextTree, FakeDamageContextTree, AddContextTree, and finally, FormContextTree which takes a ContextTreeSeq.
(declared as damages ctn)
(damages ctn)
Context Ribs
(damages lc)
Local Contexts
Type Graph Nodes
( FIX: This should be a procedure to be applied to a RIB,
we will change as soon as we get ribs )
( FIX: This should be a procedure to be applied to a RIB,
we will change as soon as we get ribs )
( Upon reaching top level context,
then looks up names of frames and interfaces, then root context.
Must add this later. )
Locally Visible Names
Very simple for now, just a chained list of IdNodes
assorted body types
BaseTypes
some subset for now, no additional information
Top and Bottom
Named nodes (i.e., locally visible)
This routine should be checking access as it spins deeper
SubRange Nodes
Record nodes
pointer type nodes
base and pointer must both be pointerTGNs, base must have base = true

refs point to encapsulated types

List nodes
perhaps I could use record type constructors, except they are not set up for making cyclic types directly, and perhaps there are some special semantics associated with list types

EnumeratedType Nodes

one of elementName or rep can be NIL
Field lists and frozen field lists
PrependFFLToFieldList: PUBLIC PROC [ ffl: FrozenFieldListNode, fl: FieldListNode ] RETURNS [ flp: FieldListNode ] ~ {
cell: FieldListCell _ NEW [FieldListCellBody _ [ffl, NIL]];
RETURN[PrependCellToFieldList[ffl.nFields, cell, fl]];
};


VariantPart TGN and Union List
damages ul
damages ul, used internally
Variant Flavors
Sequence TGNs
Array TGN
Descriptor TGN
Transfer TGN
Zone TGN
Long TGN
Interface TGN
There are several ways to create interfaceTGNs.  One is directly from an interface, using all the entries.  (Corresponds to directory line without out a Using clause).  Another is by putting the names in one at a time.  (Used to implement a directory line with a Using clause.),  The third is by a "renaming" Open clause entry.

When creating the first interfaceTGN within one module tot points to a particular second module, be sure to use the Link tgns inbetween.  For a directory line without a Using clause, this is done by CreateInterfaceTGNFromInterface, but when a Using clause is involved, the recursive function is responsible.

damages lc
if entryTgn = NIL then we are in a Using clause and processing an entry point name rather than a type name, we should do nothing here, and later this case will go away when we correctly handle entry points.
ExportLocallyVisibleTGN: PUBLIC PROC[lc: LocalContextNode, name: IdNode] RETURNS[AccessValNode, TypeGraphNodeNode] =
BEGIN
ratgn: REF ANY;
access: AccessValNode;
[access, ratgn] _ LookupVisibleName[lc.lvtn, name];
IF ratgn # NIL THEN RETURN[access, NARROW[ratgn]];
ErrorSignal[];
END;
(following two operations correspond to entries in an OPEN clause)

(OPEN name: interface)
(OPEN interface)
LinkTGN
damages lc
(currently might be called with NIL tgn, when in a Using clause and refering to a entry point, rather than a type)
Frame TGN
(I will fill this in as needed later)
Specianated TGN
(we are either : 1)  specializing a sequence or array of length 0, 2) discriminating a variant, 3) selecting an interface type.)  There is one syntactic case in which we can't tell which until the data structures are completely built.  ("foo[red]"), so we use this more general term for now.)
(Dan Swinehart selected the word Specianated, if you can't figure out what this word means, try another field.)

(underlying type must be a variant style record type, a sequence style record type, an array type with empty index domain, or an interface TGN.)
(In the case of a def file TGN we do the appropriate look up, as this case can be distinguished during this construction pass.)

(only one of expParameter and idParam will be non nil)

(This one might be the selection of a type from an interface)
probably should be doing an access check here
(this one can not be the selection of a type from an interface)
Opaque TGNs
Paint nodes

Locally Visible Names
Default Exp Nodes
position val nodes
bounds val nodes
access val nodes
ExpPTree

I can't remember why these boxes are needed (ExpPTree, ScopePTree, ...).  Perhaps it is a flaw in the current version of ThreeCasabaFour.
exported to SaffronATDef??
ScopePTree

exported to SaffronATDef??

ModulePPTreeNode
DefBodyPTreeNode 
NameSequence
RopeNames
General purpose routines
following are exported to SaffronContext
Following are exported to SaffronBaseDef
ส%‡˜š
œ™Jš
œ<™<Jšœ#ฯk™&Jšœ-™0Icodeš
œ,™,—J˜š
	˜	Kšœ
œ4˜<Kšœ
œœ˜%Kšœœœ˜0Kšœœ˜(Jšœ
œ;˜MJšœœ˜Jšœœ˜(Jšœœ$˜;Jšœœ˜Kš
œ˜Kšœœ˜&Kšœœ,˜<Kšœœ
˜%—J˜šฯnœœ
˜)Kšœ
œœI˜WKšœM˜TJšœ=˜AJ™Jš
œŒ
™Œ

headš
ฯz™J˜˜K™๏
—š
žœœ
œœœ˜NKšœœ
˜Kšœœ
œ
˜Kš
œ˜K˜+Kšœœ
œ$˜;Kš
œ)˜)K˜šœœ
˜Kš
˜Kšœ6œ˜HKšœ
˜Kšœ
˜—Kšœ5œ˜PKšœœ;˜HKšœ
˜Kšœœ˜Kšœ$˜*š
œ˜K˜K™JK™YK™J——šžœœ
œ
œœœœœœ
œœ˜vKš
˜Kšœœ
˜Kš
œF˜FKš
œ ˜ K˜Kšœœœ˜/K˜+Kšœœœ
œœœ
œ˜[Kš
œI˜Išœ-œœ
˜>Kšœœ˜)Kšœœ˜Kšœœ
˜Kšœ
œ
˜Kšœœ
˜Kšœœ˜0Kš
œ2˜2Kš
œ&˜&Kšœœœ
œœœ
œ	˜MKšœ
˜—Kšœ
˜K˜—˜K˜—J˜—š
Ÿ™Kšœœœ˜0Kšœœ
œ2˜RK˜šžœœ
œ
œ˜AKšœ
œ4˜>Kš
œ˜K˜Kš
œ™—š
žœœ
œ'œœ˜‡
Kš
œ.˜.Kšœ˜K˜—K˜š
žœœ
œ'œœ˜lKšœ
œ,˜9Kš
œ˜—K˜šžœœ
œ'œœœ˜_Kšœ,œ˜7Kš
œ˜—˜K™—Kš
ะbnœœ
œœœ˜d—š
Ÿ
™
K™Kšœœœ˜2Kšœœ
œ4˜U˜Kš
œฺ
™ฺ
Kš
œt™tK™Kšžœ…
™‰
—šžœœ
œ-œ˜zK˜2Kšœ*ฯc˜Bšžœœ.œ
œ˜LKšœœ	ก˜0K˜.K˜—K˜)Kšœ
œ-˜7K˜—K˜˜Kš
œ(™(—šžœœœ1˜kšžœœ.œ
œ˜FKšœœ	˜!Kš
œ˜—Kš
œ$˜$K˜—K˜šžœœ
œ&œ4˜‚
Kšœœ
œ
˜K˜6Kšœ	œ	˜K˜—K˜K™K˜K˜—K˜š
Ÿ
™
Jšœœœ˜0Jšœœ
œ2˜RJ˜Jšะbkœž™ฃK˜Kšžœœ
œœœ
œœœ˜Œ
˜Kš
œ™—š
žœœ
œœœ˜pK˜Kš
œ
™
—šžœœ
œ3œ˜vKšœœœ˜.Kšœœ˜2Kšœœ
œœ˜PK˜Kšœ˜K˜——š
Ÿ™Jšœœœ˜.Jšœœ
œ1˜PK˜š
žœœ
œ
œœ1˜wK˜Kš
œ™—šžœœ
œœ˜\Kšœœ
˜Kšœ
œ˜(K˜——š
Ÿ™Jšœœœ˜2Jšœœ
œ3˜TK˜šžœœ
œ˜>Kšœœ˜2K˜$K˜Kšœ˜K˜—K˜šžœœ
œ˜=K˜1Kšœ	œ
˜
K˜-K˜-K˜Kšœ˜K˜—K˜šžœœ
œœ˜XK˜1K˜
K˜K˜K˜*Kšœ˜K˜—K˜šžœœ
œœ˜YK˜	K˜——š
Ÿ™Jšœœœ˜4Jšœœ
œ4˜VK˜š
ž	œœœ
œœ˜^šœœ˜$Kšœœ
˜
K˜K˜K˜K˜—K˜K˜K˜—K˜Kšœœ0œ)™ašž
œœ
œœ˜ZKšœ˜Kš
œ˜—K˜Kšœœ0œ)™ašž
œœ
œœ˜WKšœ	˜Kš
œ˜—˜Kš
œz™z—šžœœ
œ(œ˜kšœ(œ	œ˜AKšœœ*˜IKšœœ
œ
œ˜Kšœœ
œ
œ
˜Kšœ
˜—K˜K˜——š
Ÿ™Jš
œ3™3—Lš
Ÿ™š
Ÿ	™	šžœœ˜3Kš
œ.™.K˜K˜K˜K˜K˜!K˜!K˜#K˜K˜K˜#K˜Kšœก˜$Kšœก˜!K˜Kšœก˜$Kšœก˜$Kšœ!ก˜'Kšœก˜#Kšœก˜#Kšœก˜$K˜Kšœก˜%Kšœก˜$Kšœ!ก˜'Kšœก˜$Kšœก˜$Kšœก˜$K˜Kšœก˜$Kšœ ก˜(Kšœก˜#Kšœก˜#Kšœก˜#K˜K˜—šžœœ(œ˜GKšœœ*˜AK˜-Kšœœ!˜;Kšœ)œ˜3K˜——š
Ÿ™šžœœœ'˜`Kšœœ˜3Kšœœ˜9K˜K˜#K˜——š
Ÿ#™#šžœœ
œ?œ6˜ก
Kšœœ˜3K˜K˜.Kšœ
˜˜K˜——šžœœ
œ|œ˜ย
Kšœœ
˜)K˜K˜K˜Kšœ˜K˜—˜K™9—šžœœœ˜LKš
˜Kš
œ˜šœ
œ
˜
šœœ
˜Kš
œ*˜*Kšœœ˜—Kšœ
˜—Kšœ
˜Kšœ
˜——š
Ÿ™šžœœ
œPœ6˜ซ
Kšœœ*˜AKšœ˜ K˜——š
Ÿ™š
žœœ
œJœœ6˜ว
Kšœœ?˜TKšœ˜ K˜——š
Ÿ™Kš
œE™EK™Kš
œ ™ K™šžœœ
œ(œ#œ!œ6˜ิ
KšœœA˜WKšœ˜ K˜K˜—š
žœœ
œ+œ#œ6˜ซ
Kšœœ#˜>Kšœœ<˜NKšœ˜ K˜K˜—šžœœ
œ8œ6˜Ž
Kšœœ˜.Kšœ˜ ˜K˜——šžœœ
œ<œ6˜—
Kšœœ%˜<Kšœ˜ K˜——š
Ÿ
™
Kš
œฒ
™ฒ
K™š
ž
œœ
œ#œ œ6˜ก
Kšœœ%œ˜>K˜Kšœ˜ K˜——š
Ÿ™š
žœœ
œ+œœ6˜•
Kšœœ9œœ˜WKšœ˜ K˜—™Kšœ!™$—šžœœ
œZœ˜ฆ
Kšœœ˜!Kšœœ+œ˜Lšœ˜Kšœ˜Kšœ˜"—K˜Kšœ˜K˜——š
Ÿ"™"Kšœœœ˜$šœœ
œ,˜FK˜—Kšœœœ˜,Kšœœ
œ0˜NK˜Kšœœœ˜8Kšœœ
œ6˜ZK˜šžœœ
œjœœ
œ2˜เ
K˜—šžœœ
œ5œœ
œœœœ˜ฏ
K˜—Kšžœœ
œ
œœ
œœœœ˜€
K˜Kšžœœ
œ
œœ
œœœœ˜wK˜šžœœœ+œ˜xKšœœ
œ
˜K˜K˜Kšœœ
œ˜-K˜"K˜Kšœ˜K˜—K˜šžœœœœ˜wKšœœ
œ
˜Kšœœ
œœ˜KK˜K˜"K˜Kšœ˜K˜—K˜šžœœ
œ%œ˜kKšœœœ˜9Kšœ&˜,K˜—K˜šžœœ
œ%œ˜jKšœœœ˜9Kšœ%˜+K˜K˜—šžœœ
œ1œ™uKšœœœ™;Kšœ0™6Kš
œ™K™—šžœœ
œ1œ˜tKšœœœ˜;Kšœ/˜5K˜—K™šžœœ
œœ˜[Kšœ	œ	œ
œ
˜!Kšœœ
œ
œ˜(Kšœœ
œ
œ˜(K˜"K˜K˜(K˜%Kšœ˜K˜K˜—šžœœ
œ-œ8˜ˆ
K˜#Kšœœ&˜/K˜K˜K˜K˜šœ
ž
œœ
œœ
˜.šœ	œœ
˜#Kšœ@œ˜EKšœ%œœœœœ
˜FKšœœ
˜—K˜Kšœ
˜—š	œ
ž
œœ
œ˜&šœ
˜šœ	œœ˜/šœœœ˜8Kšœ
œก'˜3—K˜—šœœœ˜#šœœœ˜8Kšœ
œก'˜3—K˜—Kšœœ
˜—Kšœ
˜—Kšœ
˜K˜——šŸะkzŸ™Jšœœœ˜,Jšœœ
œ0˜NK˜šžœœ
œgœ6˜ล
šœœ˜2K˜K˜K˜—Kšœ˜ Kš
œ˜—K˜šžœœœœ˜Išœ
œ
˜Kšœœ
œ˜&Kšœœ
œ˜—Kš
œ˜—K˜šžœœœ˜Xšœ
œ
˜Kšœœ˜-Kšœœ
˜—Kš
œ˜—K˜šžœœ
œ
œ˜?Kšœ
œœœ˜0Kš
œ˜—˜K™
—šžœœ
œ=œ˜~Kšœœ œ˜BKšœœœœ˜JK˜K˜Kšœ˜Kš
œ˜—˜K™—šžœœœ˜JKšœœ"˜<K˜šœœ
œ˜%K˜K˜Kšœ
˜—Kšœ˜Kš
œ˜——š
Ÿ™Jšœœœ˜4Jšœœ
œ4˜VK˜šžœœ
œ
œœ
œ4˜ˆ
K˜—Kšžœœ
œ
œœ
œ4˜ˆ
K˜Kšžœœ
œBœœ
œF˜ุ
—š
Ÿ
™
Jšœ
œœ˜(Jšœœ
œ.˜JJ˜š
žœœ
œ!œvœ6˜๙
KšœœC˜ZKšœ˜ Kš
œ˜——šŸฃ™	š
žœœ
œ!œ>œ6˜พ
Kšœœ0˜DKšœ˜ K˜——šŸฃ™š
žœœ
œ#œ œ6˜ง
Kšœœ,˜EKšœ˜ K˜——šŸ	ฃ™šžœœ
œœœ,œ6˜ย
šœœ
œ
˜%K˜%K˜%K˜)K˜'K˜+K˜+Kšœœ
˜—Kšœœ4˜KKšœ˜ K˜——šŸฃ™š
ž
œœ
œ$œœ6˜…
Kšœœ˜0Kšœ˜ Kš
œ˜——šŸฃ™šž
œœ
œ=œ6˜”
Kšœœ"˜5Kšœ˜ Kš
œ˜——šŸ
ฃ™
Kš
œว™วK™Kš
œณ™ณK˜šžœœ
œœ6˜{Kšœœœ˜QKšœ˜ Kš
œ˜K™Kš
œ
™
—šžœœ
œqœ˜ต
Kšœœ
˜&šœœ
œ<˜RKšœœฝ
™ฮ
—Kšœ˜K˜—K˜šžœœ
œ.œ6˜—
šžœœG˜SKš
œ_˜_Kš
œ˜—Kš
œ(˜(K˜ Kšœ˜K˜—K˜šžœœ
œ%œ$™tJš
™Jšœœ
œ
™Jš
œ™Jš
œ3™3Jš
œ	œ
œ
œ	œ	™2J™Jšœ
™—K˜K˜K˜šžœœ
œ=œ˜Œ
Kšœœ
˜&Kšœœ
œ
˜K˜K˜=Kšœœœœ
œ
œ
˜aKš
œ˜K˜—K˜šž"œœœ$˜oKšœœ
˜&šœ
œ.œ
œ˜GKš
˜Kš
œœœœœ	˜`Kšœ
˜—K˜+K˜K˜—Kšœ6œ™BK™Kšœ
œ™šžœœ
œDœ˜ƒ
K˜]šœœ
˜Kšœœ
˜Kšœœ
˜—K˜oKšœ˜K˜—˜Kšœ
œ™—šž
œœ
œ;œ˜zšžœœ-˜KKšœ>œ/˜pKšœ&œS˜|K˜—Kš
œ^˜^Kšœ˜K˜—K˜—š
Ÿ™™
Kšœ œO™r—šž
œœ
œWœ2˜ช
Kš
˜Kšœœ
œ
œœก#˜FKšœœ$˜@Kšœ
˜——šŸฃ™	Kš
œ%™%K˜šžœœ
œ&œ˜eK˜$šœ
œ
˜Kšœœ˜Kšœœ
˜—K˜——šŸฃ™K™คKš
œo™oK™Kšœ‹
œ™
Kšœœa™™K™6K™K™=—šžœœ
œIœ6˜ฎ
šœœ
˜$š
œ˜šœ?˜EK™-—Kš
œ˜—šœ˜Kšœœœ˜LKšœ˜ Kš
œ˜——Kš
œ˜—˜K™?—šžœœ
œVœ6˜ผ
Kšœœ#œ˜SKšœ˜ Kš
œ˜——š
Ÿ™Kšœœœ˜$Kšœœ
œ,˜FK˜šžœœ
œ@œ2˜•
Kš
˜Kšœœ!˜6Kšœ˜ Kšœ˜——š
Ÿ™Jšœœœ˜$Jšœœ
œ,˜FK˜š
žœœœœ
œ˜vK˜—Kš
žœœ
œœ-œ˜Œ
K™šžœœ
œœ,˜hK˜"Kšœœ(˜6K˜——š
Ÿ™šžœœ
œ˜>Kšœœœ˜$Kšœ˜Kš
œ˜—K˜šžœœAœ
œ˜eKšœœ0˜EKšœ'œœ˜BKšœ
œ/˜<K˜Kš
œ˜—K˜š
žœœ"œ œ
œ˜lK˜šœ
œ˜Kšœ3œ
œ˜ZK˜Kšœ
˜—Kšœ
œœ˜Kš
œ˜—K˜šžœœ
œœ.œ
œ˜uK˜šœ
œ˜K˜&K˜Kšœ
˜—Kš
œ˜——š
Ÿ™Jšœœœ˜.Jšœœ
œ1˜PK˜š
ž
œœ
œœœ˜`šœ
œ˜"šœ
œ
˜K˜K˜K˜K˜!K˜#Kšœœ
˜—K˜—K˜—K˜šžœœ
œ
œ˜:Kšœ
œ˜Kš
œ˜——š
Ÿ™Kšœœœ˜0Kšœœ
œ2˜RK˜šžœœ
œ0œ˜jKšœ
œ)˜3Kš
œ˜—K˜šžœœ
œ
œ˜9Kšœ
œ˜Kš
œ˜——š
Ÿ™Jšœœœ˜,Jšœœ
œ0˜NK˜šžœœ
œœ>œœ˜”
Kšœœ1˜Išœœ
œ
˜K˜'K˜%Kšœœ
˜—šœœ
œ
˜K˜(K˜&Kšœœ
˜—Kšœ˜K˜—K˜Kšž
œœ
œ
œœ
œ˜D—š
Ÿ™Jšœœœ˜,Jšœœ
œ0˜NJ˜š
žœœ
œœœ˜Jšœ
œ
˜Jšœœ
œ˜BJšœœ
œ ˜FJšœœ
œ˜DJšœ˜—Jš
œ˜J˜—šž
œœ
œœ˜<Jšœ
œ˜Jš
œ˜——š
Ÿ™Jšœœœ˜*Jšœœ
œ/˜LK™Kš
œ‰
™‰
K˜Kš
œ™šžœœ
œœ˜GKšœ
œ˜(Kš
œ˜—K˜Kšžœœ
œ
œœ
œ˜E—š
Ÿ
™
Jšœœœ˜.Jšœœ
œ1˜PK™Kš
œ™Kšž
œœ
œœœ
œ"˜zK˜Kš
žœœ
œœœ
˜[—L™Lš
Ÿ™Kšœœœ˜2Jšœœ
œ3˜TJ˜šžœœ
œœ˜RKšœ
œ
œ ˜+K˜—šž
œœ
œœ˜MKšœ
œ
˜K˜—J˜—˜šŸœ
™Kšœœœ˜2Jšœœ
œ3˜TK˜šžœœ
œœ˜RKšœ
œ
œ ˜+K˜K˜—šž
œœ
œœ˜MKšœ
œ
˜——š
Ÿ™Kšœœœ˜2Kšœœ
œ3˜TK˜šžœœ
œ
œ˜:šœ
œ
œœ˜*K˜——šžœœ
œ%œ˜eKšœ
œ
œœ˜6——š
Ÿ	™	Kšœœœ˜%Kšœœ,˜?J˜Jšœœœœ)˜XK˜šžœœ
œ˜4Kš
˜Jšœœœ˜!Jšœ˜Jšœ
˜—K˜š
žœœœœ
œ˜EKš
˜Jšœœ$˜9Jšœœœ˜8J˜Jšœ
˜—K˜šžœœœœ
œ
œ˜HKš
˜J˜šœœ
˜Jšœœ
œ
˜7J˜Jšœ
˜—Jšœ
œ˜šœ
˜J˜——šžœœ
œœœœ
œ˜JJš
˜J˜šœœ
˜J˜J˜Jšœ
˜—Jšœ
˜——š
Ÿ™š
ž
œœ
œœœ˜@Kš
œ
œœœ	œ˜-Kš
œ˜—K˜š
žœœ
œœœ˜LKš
œ
œœœ
œ˜5Kš
œ˜——š
Ÿ(™(Kšžœœ
œœ
˜!—š
Ÿ(™(Kšžœœ
œ
œœœ
œ˜9K˜Kšžœœ
œ
œœœ
œ˜;K˜šžœœ
œœœœ˜Bšœ
œ
˜Kšœœ
œ˜&Kšœœ
œ˜(Kšœ˜—K˜K˜—Kšžœœ
œœœœœ˜DK˜Kšžœœ
œ
œœ
œ˜9—˜J˜———…—~Tผั