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;
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.
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]];
};
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.
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;
Environment
EnvironmentNode: TYPE ~ REF EnvironmentNodeBody;
EnvironmentNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.EnvironmentNodeBody;
CreateEmptyEnvironment:
PUBLIC
PROC
RETURNS [EnvironmentNode] ~ {
RETURN[NEW [EnvironmentNodeBody ← [CreateEmptyRopeNames[]] ]];
};
damages env and ifc
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]};
Interfaces
InterfaceValNode: TYPE ~ REF InterfaceValNodeBody;
InterfaceValNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.InterfaceValNodeBody;
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.
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]]];
};
used to create an interfaceTGN whole hog
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]];
};
Context Trees
ContextTreeNode: TYPE ~ REF ContextTreeNodeBody;
ContextTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ContextTreeNodeBody;
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.
EmptyContextTree: PUBLIC PROC [ rib: ContextRibNode ] RETURNS [ ContextTreeNode ] ~ { RETURN[NEW [ContextTreeNodeBody ← [rib, NIL, NIL]]] };
(declared as damages ctn)
FakeDamageContextTree:
PUBLIC
PROC [ ctn: ContextTreeNode ]
RETURNS [ ctnp: ContextTreeNode ] ~ {
RETURN[ctn] };
(damages 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];
};
Context Ribs
ContextRibNode: TYPE ~ REF ContextRibNodeBody;
ContextRibNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ContextRibNodeBody;
RootContextRib:
PUBLIC
PROC
RETURNS [ rib: ContextRibNode ] ~ {
RETURN[FreezeLocalContext[CreateRootLocalContext[]]] };
(damages lc)
FreezeLocalContext:
PUBLIC
PROC [ lc: LocalContextNode ]
RETURNS [ rib: ContextRibNode ] ~ {
lc.frozen ← TRUE;
RETURN[NEW [ContextRibNodeBody ← [lc]]];
};
Local Contexts
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;
};
Type Graph Nodes
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;
};
( 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 ] ~ {
RETURN[lc.bottom];
};
( FIX: This should be a procedure to be applied to a RIB,
we will change as soon as we get ribs )
FindTopTGN:
PUBLIC
PROC [ lc: LocalContextNode ]
RETURNS [ tgn: TypeGraphNodeNode ] ~ {
RETURN[lc.top];
};
( Upon reaching top level context,
then looks up names of frames and interfaces, then root context.
Must add this later. )
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[];
};
Locally Visible Names
Very simple for now, just a chained list of IdNodes
assorted body types
BaseTypes
InstallBaseTypes:
PROC [ lc: LocalContextNode ] ~ {
some subset for now, no additional information
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];
};
Top and Bottom
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];
};
Named nodes (i.e., locally visible)
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];
};
This routine should be checking access as it spins deeper
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;
SubRange Nodes
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]];
};
Record nodes
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]];
};
pointer type nodes
base and pointer must both be pointerTGNs, base must have base = true
refs point to encapsulated types
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]];
};
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
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]];
};
EnumeratedType Nodes
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]];
};
one of elementName or rep can be NIL
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];
};
Field lists and frozen field lists
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]];
};
PrependFFLToFieldList: PUBLIC PROC [ ffl: FrozenFieldListNode, fl: FieldListNode ] RETURNS [ flp: FieldListNode ] ~ {
cell: FieldListCell ← NEW [FieldListCellBody ← [ffl, NIL]];
RETURN[PrependCellToFieldList[ffl.nFields, cell, fl]];
};
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];
};
VariantPart TGN and Union List
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];
};
damages ul, used internally
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]
};
Variant Flavors
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]]]] };
Sequence TGNs
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]];
};
Array TGN
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]];
};
Descriptor TGN
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]];
};
Transfer TGN
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]];
};
Zone TGN
CreateZoneTGN:
PUBLIC
PROC [ lc: LocalContextNode, uncounted:
BOOLEAN ]
RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: ZoneTGN ← NEW [ZoneTGNBody ← [uncounted]];
RETURN[lc, CreateTGN[lc, body]];
};
Long TGN
CreateLongTGN:
PUBLIC
PROC [ lc: LocalContextNode,
underlyingType: TypeGraphNodeNode ]
RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: LongTGN ← NEW [LongTGNBody ← [underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
};
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.
CreateEmptyInterfaceTGN:
PUBLIC
PROC [ lc: LocalContextNode ]
RETURNS [ lcp: LocalContextNode, tgn: TypeGraphNodeNode ] ~ {
body: InterfaceTGN ← NEW [InterfaceTGNBody ← [FALSE, CreateEmptyVisibleNames[]]];
RETURN[lc, CreateTGN[lc, body]];
};
damages lc
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];
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.
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];
};
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;
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];
};
(following two operations correspond to entries in an OPEN clause)
(OPEN name: interface)
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];
};
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)
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;
Frame TGN
(I will fill this in as needed later)
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;
};
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)
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];
probably should be doing an access check here
};
ENDCASE => {
body: SpecianatedTGN ← NEW [SpecianatedTGNBody ← [NIL, id, underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
};
};
(this one can not be the selection of a type from an interface)
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]];
};
Opaque TGNs
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;
Paint nodes
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]]];
};
Locally Visible Names
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;
};
Default Exp Nodes
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, "𡤎"] => c3,
Rope.Equal[case, "←TRASH"] => c4,
Rope.Equal[case, "𡤎|TRASH"] => c5,
ENDCASE => ERROR,
exp]]];
};
NullDefaultVal:
PUBLIC
PROC
RETURNS [ DefaultExpNode ] ~ {
RETURN[NIL];
};
position val nodes
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];
};
bounds val nodes
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] };
access val nodes
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];
};
ExpPTree
ExpPTreeNode: TYPE ~ REF ExpPTreeNodeBody;
ExpPTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ExpPTreeNodeBody;
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??
ExpPTreeVal:
PUBLIC
PROC [ node: ExpNode ]
RETURNS [ ExpPTreeNode ] ~ {
RETURN[NEW [ExpPTreeNodeBody ← [node]]];
};
NullExpPTree: PUBLIC PROC RETURNS [ ExpPTreeNode ] ~ { RETURN[NIL] };
ScopePTree
ScopePTreeNode: TYPE ~ REF ScopePTreeNodeBody;
ScopePTreeNodeBody: PUBLIC TYPE ~ SaffronContextPrivateTypes.ScopePTreeNodeBody;
exported to SaffronATDef??
ScopePTreeVal: PUBLIC PROC [ node: ScopeNode ] RETURNS [ ScopePTreeNode ] ~ { RETURN[NEW [ScopePTreeNodeBody ← [node]]] };
ScopeVal: PUBLIC PROC [ box: ScopePTreeNode ] RETURNS [ ScopeNode ] ~ { RETURN[box.node] };
ModulePPTreeNode
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]};