SaffronContextImpl:
CEDAR
PROGRAM
IMPORTS IO, Rope
EXPORTS SaffronATDef, SaffronBaseDef, SaffronContext =
BEGIN OPEN SaffronGenericDef, SaffronATDef;
LocalContextNode:
TYPE =
REF LocalContextNodeBody; LocalContextNodeBody:
PUBLIC TYPE =
RECORD[
frozen: BOOLEAN ← FALSE,
rib: ContextRibNode,
lvtn: VisibleNames,
maxTGNodeIndex: INT ← 0,
bottom, top: TypeGraphNodeNode ← NIL,
paintIndex: INT ← 0,
unpaintedPaint: PaintNode ← NIL,
tgNodes: TypeGraphNodeNode ← NIL,
fieldLists: FrozenFieldListNode ← NIL];
TypeGraphNodeNode: TYPE = REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody:
PUBLIC TYPE = RECORD[
shown: BOOLEAN, -- used during show routines
index: INT,
localContext: LocalContextNode,
body: REF ANY, -- many different types
next: TypeGraphNodeNode -- tgNodes chain from localContext -- ];
CreateBasicLocalContext: PROC RETURNS[LocalContextNode] =
BEGIN
lc: LocalContextNode ← NEW[LocalContextNodeBody];
lc.lvtn ← CreateEmptyVisibleNames[];
lc.paintIndex ← 0;
RETURN[lc];
END;
CreateRootLocalContext: PROC RETURNS[LocalContextNode] =
BEGIN
lc: LocalContextNode ← CreateBasicLocalContext[];
lc.rib ← NIL;
[lc.top, lc.bottom] ← CreateTopAndBottom[lc];
lc.unpaintedPaint ← CreateUnpaintedPaint[lc];
InstallBaseTypes[lc];
RETURN[lc];
END;
CreateEmptyContext: PUBLIC PROC[rib: ContextRibNode] RETURNS[LocalContextNode] =
BEGIN
lc: LocalContextNode ← CreateBasicLocalContext[];
lc.rib ← rib;
lc.top ← rib.lc.top;
lc.bottom ← rib.lc.bottom;
lc.unpaintedPaint ← rib.lc.unpaintedPaint;
RETURN[lc];
END;
FakeDamageContext: PUBLIC PROC[lc: LocalContextNode] RETURNS[lcp: LocalContextNode] =
BEGIN
lcp ← lc;
END;
RealShowLocalContext: PROC[on: IO.STREAM, nest: INT, lc: LocalContextNode] =
BEGIN
FOR tgn: TypeGraphNodeNode ← lc.tgNodes, tgn.next WHILE tgn # NIL DO
tgn.shown ← FALSE;
ENDLOOP;
FOR fl: FrozenFieldListNode ← lc.fieldLists, fl.next WHILE fl # NIL DO
fl.shown ← FALSE;
ENDLOOP;
IO.PutRope[on, "\N\N"]; ShowNested[on, nest];
IO.PutRope[on, "locally visible types\N"]; ShowNested[on, nest+2];
ShowLocallyVisibleTypes[on, nest+2, lc.lvtn];
IO.PutRope[on, "\N\N"]; ShowNested[on, nest]; IO.PutRope[on, "other nodes"];
FOR tgn: TypeGraphNodeNode ← lc.tgNodes, tgn.next WHILE tgn # NIL DO
IF NOT tgn.shown THEN
BEGIN
IO.PutRope[on, "\N\N"]; ShowNested[on, nest+2];
ShowTGN[on, nest+2, tgn];
END
ENDLOOP;
IO.PutRope[on, "\N\N"];
END;
CreateTGN: PROC[lc: LocalContextNode, body: REF ANY] RETURNS[tgn: TypeGraphNodeNode] =
BEGIN
tgn ← NEW[TypeGraphNodeNodeBody ← [
shown: FALSE,
index: lc.maxTGNodeIndex + 1,
localContext: lc,
body: body,
next: lc.tgNodes]];
lc.maxTGNodeIndex ← tgn.index;
lc.tgNodes ← tgn;
END;
(FIX: This should be a procedure to be applied to a RIB, we will change as soon as we get ribs)
FindBottomTGN: PUBLIC
PROC[lc: LocalContextNode]
RETURNS[tgn: TypeGraphNodeNode] =
{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] =
BEGIN
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[];
END;
none of the internal nodes are visible from outside, so just trees
ShowLocallyVisibleTypes: PROC[on: IO.STREAM, nest: INT, lvtn: VisibleNames] =
BEGIN
first: BOOLEAN ← TRUE;
ShowOneLVTGN: PROC[name: IdNode, access: AccessValNode, value: REF ANY] =
BEGIN
IF NOT first THEN
{IO.PutRope[on, "\N\N"]; ShowNested[on, nest]};
first ← FALSE;
IO.PutRope[on, RopeForId[name]];
ShowAVN[on, nest, access];
IO.PutRope[on, "\N"]; ShowNested[on, nest+2];
ShowNamedTGNTree[on, nest+4, NARROW[value]];
END;
IO.PutRope[on, "\N"]; ShowNested[on, nest];
GenVisibleNames[lvtn, ShowOneLVTGN];
END;
Idea is that this routine will print out address of node on current line, and allow called routine to put more info on that line, or on subsequent lines.
Nodes will be marked to show that they have been printed, so we do not progress any deaper on previously printed nodes.
We do not proceed passed a named node in any case. (ShowNamedTGNTree will do that)
We assume that we have been positioned on current line, and that the caller will supply the final carriage return.
ShowTGN: PROC[on: IO.STREAM, nest: INT, tgn: TypeGraphNodeNode] =
BEGIN
IO.PutF[on, "[%g](%g): ", IO.int[tgn.index], IO.int[LOOPHOLE[tgn, INT]]];
IF tgn.shown THEN
WITH tgn.body SELECT FROM
ntgn: NamedTGN => ShowNamedTGN[on, nest, ntgn, TRUE];
ENDCASE => NULL
ELSE
BEGIN
tgn.shown ← TRUE;
WITH tgn.body SELECT FROM
ntgn: NamedTGN => ShowNamedTGN[on, nest, ntgn, TRUE];
spctgn: SpecialTGN => ShowSpecialTGN[on, nest, spctgn];
srtgn: SubrangeTGN => ShowSubrangeTGN[on, nest, srtgn];
rn: RecordTGN => ShowRecordTGN[on, nest, rn];
ptgn: PointerTGN => ShowPointerTGN[on, nest, ptgn];
rtgn: RefTGN => ShowRefTGN[on, nest, rtgn];
vtgn: VarTGN => ShowVarTGN[on, nest, vtgn];
rtgn: RelativeTGN => ShowRelativeTGN[on, nest, rtgn];
refenttgn: ReferentTGN => ShowReferentTGN[on, nest, refenttgn];
ltgn: ListTGN => ShowListTGN[on, nest, ltgn];
etgn: EnumTGN => ShowEnumTypeTGN[on, nest, etgn];
vptgn: VariantPartTGN => ShowVariantPartTGN[on, nest, vptgn];
stgn: SequenceTGN => ShowSequenceTGN[on, nest, stgn];
atgn: ArrayTGN => ShowArrayTGN[on, nest, atgn];
dtgn: DescriptorTGN => ShowDescriptorTGN[on, nest, dtgn];
ttgn: TransferTGN => ShowTransferTGN[on, nest, ttgn];
ztgn: ZoneTGN => ShowZoneTGN[on, nest, ztgn];
ltgn: LongTGN => ShowLongTGN[on, nest, ltgn];
stgn: SpecianatedTGN => ShowSpecianatedTGN[on, nest, stgn];
bttgn: BaseTypeTGN => ShowBaseTypeTGN[on, nest, bttgn];
ENDCASE => ERROR;
END;
END;
ShowNamedTGNTree: PROC[on: IO.STREAM, nest: INT, tgn: TypeGraphNodeNode] =
BEGIN
ntgn: NamedTGN ← NARROW[tgn.body];
ShowNamedTGN[on, nest, ntgn, FALSE];
tgn.shown ← TRUE;
END;
ShowTGNAsNamedSubstructure: PROC[on: IO.STREAM, nest: INT, name: Rope.ROPE, tgn: TypeGraphNodeNode] =
BEGIN
IO.PutF[on, "\N"]; ShowNested[on, nest+2]; IO.PutF[on, "%g ", IO.rope[name]];
ShowTGN[on, nest+2, tgn];
END;
Now for the assorted body types
BaseTypes
BaseTypeTGN: TYPE = REF BaseTypeTGNBody;
BaseTypeTGNBody: TYPE = RECORD[typeName: Rope.ROPE];
InstallBaseTypes: PROC[lc: LocalContextNode] =
BEGIN -- 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
END;
InstallBaseType: PROC[lc: LocalContextNode, typeName: Rope.ROPE] =
BEGIN
body: BaseTypeTGN ← NEW[BaseTypeTGNBody ← [typeName: typeName]];
tgn: TypeGraphNodeNode ← CreateTGN[lc, body];
nameAsIdNode: IdNode ← NEW[IdNodeBody ← [typeName, 0, 0]];
RecordVisibleName[lc.lvtn, nameAsIdNode, NIL, tgn];
END;
ShowBaseTypeTGN: PROC[on: IO.STREAM, nest: INT, bttgn: BaseTypeTGN] =
{IO.PutRope[on, bttgn.typeName]};
Top and Bottom
SpecialKind: TYPE = {bottom, top};
SpecialTGN: TYPE = REF SpecialTGNBody; SpecialTGNBody: TYPE = RECORD[
kind: SpecialKind];
CreateTopAndBottom: PROC[lc: LocalContextNode] RETURNS[top, bottom: TypeGraphNodeNode] =
BEGIN
topBody: SpecialTGN ← NEW[SpecialTGNBody ← [top]];
bottomBody: SpecialTGN ← NEW[SpecialTGNBody ← [bottom]];
top ← CreateTGN[lc, topBody];
bottom ← CreateTGN[lc, bottomBody];
END;
ShowSpecialTGN: PROC[on: IO.STREAM, nest: INT, spctgn: SpecialTGN] =
BEGIN
IO.PutF[on, "%g", IO.rope[SELECT spctgn.kind FROM
bottom => "bottom",
top => "top",
ENDCASE => ERROR]];
END;
Named nodes (i.e., locally visible)
NamedTGN: TYPE = REF NamedTGNBody; NamedTGNBody: TYPE = RECORD[
name: IdNode,
access: AccessValNode, -- access is initially Nil
type: TypeGraphNodeNode, -- type is initially Nil
default: DefaultExpNode]; -- default is initially Nil
CreateLocallyVisibleTGN: PUBLIC
PROC[lc: LocalContextNode, name: IdNode, access: AccessValNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
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] =
BEGIN
namedNode: NamedTGN ← NARROW[lvTgn.body];
namedNode.access ← access;
namedNode.type ← tgn;
namedNode.default ← default;
RETURN[lc];
END;
ShowNamedTGN: PROC[on: IO.STREAM, nest: INT, ntgn: NamedTGN, shown: BOOLEAN] =
BEGIN
IO.PutF[on, "%g ", IO.rope[RopeForId[ntgn.name]]];
ShowAVN[on, nest, ntgn.access];
ShowDEN[on, nest, ntgn.default];
IF NOT shown THEN ShowTGN[on, nest+2, ntgn.type];
END;
SubRange Nodes
SubrangeTGN: TYPE = REF SubrangeTGNBody; SubrangeTGNBody: TYPE = RECORD[
subrangeOf: TypeGraphNodeNode,
bounds: BoundsValNode];
CreateSubrangeTGN: PUBLIC PROC[lc: LocalContextNode, subrangeOf: TypeGraphNodeNode, bounds: BoundsValNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: SubrangeTGN ← NEW[SubrangeTGNBody←[subrangeOf, bounds]];
RETURN[lc, CreateTGN[lc, body]];
ShowSubrangeTGN: PROC[on: IO.STREAM, nest: INT, srtgn: SubrangeTGN] =
BEGIN
IO.PutF[on, " sub range of\N"]; ShowNested[on, nest+2];
ShowTGN[on, nest+2, srtgn.subrangeOf];
IO.PutF[on, "\N"]; ShowNested[on, nest+2];
ShowBVN[on, nest+2, srtgn.bounds];
END;
Record nodes
RecordTGN: TYPE = REF RecordTGNBody; RecordTGNBody: TYPE = RECORD[
paint: PaintNode,
machineDependent, monitoredRecord: BOOLEAN,
ffl: FrozenFieldListNode];
CreateRecordTGN: PUBLIC
PROC[lc: LocalContextNode, p: PaintNode, machineDependent, monitoredRecord: BOOLEAN, ffl: FrozenFieldListNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: RecordTGN ← NEW[RecordTGNBody←[p, machineDependent, monitoredRecord, ffl]];
RETURN[lc, CreateTGN[lc, body]];
END;
ShowRecordTGN: PROC[on: IO.STREAM, nest: INT, rn: RecordTGN] =
BEGIN
IO.PutF[on, " RECORD"];
ShowPaint[on, nest, rn.paint];
IF rn.machineDependent THEN IO.PutF[on, " (machineDependent)"];
IF rn.monitoredRecord THEN IO.PutF[on, " (monitoredRecord)"];
ShowFrozenFieldList[on, nest+2, rn.ffl];
END;
pointer type nodes
PointerTGN: TYPE = REF PointerTGNBody; PointerTGNBody: TYPE = RECORD[
ordered, base, readOnly: BOOLEAN,
bounds: BoundsValNode,
target: TypeGraphNodeNode];
RefTGN: TYPE = REF RefTGNBody; RefTGNBody: TYPE = RECORD[
machineDependent: BOOLEAN,
target: TypeGraphNodeNode];
VarTGN: TYPE = REF VarTGNBody; VarTGNBody: TYPE = RECORD[
target: TypeGraphNodeNode];
base and pointer must both be pointerTGNs, base must have base = true
RelativeTGN: TYPE = REF RelativeTGNBody; RelativeTGNBody: TYPE = RECORD[
base: TypeGraphNodeNode, pointer: TypeGraphNodeNode];
refs point to encapsulated types
ReferentTGN: TYPE = REF ReferentTGNBody; ReferentTGNBody: TYPE = RECORD[
contents: TypeGraphNodeNode];
CreatePointerTGN: PUBLIC
PROC[lc: LocalContextNode, ordered, base: BOOLEAN, bounds: BoundsValNode, readOnly: BOOLEAN, targetTgn: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: PointerTGN ← NEW[PointerTGNBody←[ordered, base, readOnly, bounds, targetTgn]];
RETURN[lc, CreateTGN[lc, body]];
END;
CreateRefTGN: PUBLIC
PROC[lc: LocalContextNode, machineDependent: BOOLEAN, contentsTgn: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
referent: ReferentTGN ← NEW[ReferentTGNBody←[contentsTgn]];
body: RefTGN ← NEW[RefTGNBody←[machineDependent, CreateTGN[lc, referent]]];
RETURN[lc, CreateTGN[lc, body]];
END;
CreateVarTGN: PUBLIC
PROC[lc: LocalContextNode, targetTgn: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: VarTGN ← NEW[VarTGNBody←[targetTgn]];
RETURN[lc, CreateTGN[lc, body]];
CreateRelativeTGN: PUBLIC
PROC[lc: LocalContextNode, base, pointer: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: RelativeTGN ← NEW[RelativeTGNBody←[base, pointer]];
RETURN[lc, CreateTGN[lc, body]];
END;
ShowPointerTGN: PROC[on: IO.STREAM, nest: INT, ptgn: PointerTGN] =
BEGIN
IO.PutF[on, "%g Pointer %g %g\N",
IO.rope[IF ptgn.ordered THEN "(ordered)" ELSE ""],
IO.rope[IF ptgn.base THEN "(base)" ELSE ""],
IO.rope[IF ptgn.readOnly THEN "(readOnly)" ELSE ""]];
ShowNested[on, nest+1];
ShowBVN[on, nest+1, ptgn.bounds];
IO.PutF[on, "\N"]; ShowNested[on, nest+1]; IO.PutF[on, "target type = "];
ShowTGN[on, nest+2, ptgn.target];
END;
ShowRefTGN: PROC[on: IO.STREAM, nest: INT, rtgn: RefTGN] =
BEGIN
IO.PutF[on, "Ref %g\N", IO.rope[IF rtgn.machineDependent THEN "(machine dependent)" ELSE ""]];
ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", rtgn.target];
END;
ShowVarTGN: PROC[on: IO.STREAM, nest: INT, vtgn: VarTGN] =
BEGIN
IO.PutF[on, "var\N"];
ShowTGNAsNamedSubstructure[on, nest+2, "target type = ", vtgn.target];
ShowRelativeTGN: PROC[on: IO.STREAM, nest: INT, rtgn: RelativeTGN] =
BEGIN
IO.PutF[on, "relative\N"];
ShowTGNAsNamedSubstructure[on, nest+2, "base type = ", rtgn.base];
ShowTGNAsNamedSubstructure[on, nest+2, "pointer type = ", rtgn.pointer];
ShowReferentTGN: PROC[on: IO.STREAM, nest: INT, refenttgn: ReferentTGN] =
BEGIN
IO.PutF[on, "REFERENT\N"];
ShowTGNAsNamedSubstructure[on, nest+2, "contents type = ", refenttgn.contents];
END;
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
ListTGN: TYPE = REF ListTGNBody; ListTGNBody: TYPE = RECORD[
readOnly: BOOLEAN,
first: TypeGraphNodeNode,
rest: ListTGN];
CreateListTGN: PUBLIC PROC[lc: LocalContextNode, readOnly: BOOLEAN, itemType: TypeGraphNodeNode]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: ListTGN ← NEW[ListTGNBody←[readOnly, itemType, NIL]];
body.rest ← body;
RETURN[lc, CreateTGN[lc, body]];
END;
ShowListTGN: PROC[on: IO.STREAM, nest: INT, ltgn: ListTGN] =
BEGIN
IO.PutF[on, "LIST %Gof \N", IO.rope[IF ltgn.readOnly THEN "(readOnly)" ELSE ""]];
ShowNested[on, nest+1]; IO.PutF[on, "item type = "];
ShowTGN[on, nest+2, ltgn.first];
END;
EnumeratedType Nodes
EnumTGN: TYPE = REF EnumTGNBody; EnumTGNBody: TYPE = RECORD[
machineDependent: BOOLEAN, paint: PaintNode, firstElement, lastElement: EnumElementCell];
EnumElementCell: TYPE = REF EnumElementCellBody;
EnumElementCellBody: TYPE = RECORD[
id: IdNode,
rep: ExpPTreeNode,
next: EnumElementCell];
CreateEmptyEnumTypeTGN: PUBLIC
PROC[lc: LocalContextNode, machineDependent: BOOLEAN]
RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: EnumTGN ← NEW[EnumTGNBody←[machineDependent, GetUniquePaint[lc].p, NIL, NIL]];
RETURN[lc, CreateTGN[lc, body]];
END;
one of elementName or rep can be NIL
AppendElementToEnumTypeTGN:
PUBLIC PROC[lc: LocalContextNode, tgn: TypeGraphNodeNode, elementName: IdNode, rep: ExpPTreeNode]
RETURNS[lcp: LocalContextNode] =
BEGIN
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];
END;
ShowEnumTypeTGN: PROC[on: IO.STREAM, nest: INT, etgn: EnumTGN] =
BEGIN
IO.PutF[on, "Enumerated Type %g {", IO.rope[IF etgn.machineDependent THEN "(MachineDependent)" ELSE ""]];
ShowPaint[on, nest, etgn.paint];
FOR cell: EnumElementCell ← etgn.firstElement, cell.next WHILE cell # NIL DO
IO.PutF[on, " %g %g", IF cell.id # NIL THEN IO.rope[RopeForId[cell.id]] ELSE IO.rope[""], IF cell.rep # NIL THEN IO.rope[Rope.Cat["(", TextForExpPTree[cell.rep], ")"]] ELSE IO.rope[""]];
IF cell = etgn.lastElement THEN EXIT;
ENDLOOP;
IO.PutF[on, " }"];
END;
Field lists and frozen field lists
FieldNode:
TYPE =
REF FieldNodeBody; FieldNodeBody:
PUBLIC TYPE = RECORD[
name: IdNode, pvn: PositionValNode, avn: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode];
(for unnamed fields, name = NIL)
FieldListNode:
TYPE =
REF FieldListNodeBody; FieldListNodeBody:
PUBLIC TYPE = RECORD[
any: BOOLEAN, nFields: INT, nCells: INT, firstCell, lastCell: FieldListCell];
FieldListCell: TYPE = REF FieldListCellBody; FieldListCellBody: TYPE = RECORD[
item: REF ANY, next: FieldListCell];
(an item is either a Field or a FrozenFieldList)
FrozenFieldListNode:
TYPE =
REF FrozenFieldListNodeBody; FrozenFieldListNodeBody:
PUBLIC TYPE = RECORD[
shown: BOOLEAN, -- used during show
variant: BOOLEAN, -- last field is a variant ffl, or is a variant part TGN
any: BOOLEAN,
nFields: CARDINAL,
next: FrozenFieldListNode,
fields: SEQUENCE nSlots: CARDINAL OF FFLSlot];
FFLSlot: TYPE = RECORD[case: FFLCase, name: IdNode, pvn: PositionValNode, avn: AccessValNode, tgn: TypeGraphNodeNode, default: DefaultExpNode, ffl: FrozenFieldListNode];
FFLCase: TYPE = {field, ffl};
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] =
BEGIN
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];
END;
AppendCellToFieldList: PROC[fl: FieldListNode, nFields: INT, cell: FieldListCell] RETURNS[flp: FieldListNode] =
BEGIN
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];
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.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];
END;
FreezeFieldList:
PUBLIC PROC[lc: LocalContextNode, fl: FieldListNode]
RETURNS[lcp: LocalContextNode, ffl: FrozenFieldListNode] =
BEGIN
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
BEGIN
IF I = (CARDINAL[ffl.nFields]-1) THEN ffl.variant ← TRUE
ELSE ERROR; -- variation allowed only in last field
END;
ffl => IF ffl[I].ffl.variant THEN
BEGIN
IF I = (CARDINAL[ffl.nFields]-1) THEN ffl.variant ← TRUE
ELSE ERROR; -- variation allowed only in last field
END;
ENDCASE => ERROR;
ENDLOOP;
RETURN[lc, ffl];
END;
ShowFrozenFieldList: PROC[on: IO.STREAM, nest: INT, ffl: FrozenFieldListNode] =
BEGIN
IO.PutF[on, "ffl (%g) %g", IO.int[LOOPHOLE[ffl, INT]], IO.rope[IF ffl.any THEN "ANY" ELSE ""]];
IF NOT ffl.shown THEN
BEGIN
ffl.shown ← TRUE;
FOR x: CARDINAL IN [0..ffl.nSlots) DO
IO.PutRope[on, "\N"]; ShowNested[on, nest];
SELECT ffl.fields[x].case FROM
field =>
BEGIN
IF ffl.fields[x].name = NIL
THEN
BEGIN -- assume unnamed field
IO.PutF[on, "<>: "]
END
ELSE
BEGIN -- assume named field
IO.PutF[on, "%g: ", IO.rope[RopeForId[ffl.fields[x].name]]];
ShowPVN[on, nest, ffl.fields[x].pvn];
ShowAVN[on, nest, ffl.fields[x].avn];
END;
ShowTGN[on, nest+2, ffl.fields[x].tgn];
ShowDEN[on, nest+2, ffl.fields[x].default]
END;
ffl => ShowFrozenFieldList[on, nest+2, ffl.fields[x].ffl];
ENDCASE => ERROR;
ENDLOOP;
END;
END;
VariantPart TGN and Union List
VariantPartTGN: TYPE = REF VariantPartTGNBody;
VariantPartTGNBody: TYPE = RECORD[
flavor: VariantFlavorNode,
tagType: TypeGraphNodeNode,
types: FrozenUnionList];
UnionListNode: TYPE = REF UnionListNodeBody;
UnionListNodeBody: PUBLIC TYPE = RECORD[
nCells: CARDINAL, first, last: UnionListCell];
UnionListCell: TYPE = REF UnionListCellBody;
UnionListCellBody: TYPE = RECORD[id: IdNode, ffl: FrozenFieldListNode, next: UnionListCell];
FrozenUnionList: TYPE = REF FrozenUnionListBody;
FrozenUnionListBody: TYPE = RECORD[data: SEQUENCE nTypes: CARDINAL OF FULSlot];
FULSlot: TYPE = RECORD[id: IdNode, ffl: FrozenFieldListNode];
CreateVariantPartTGN: PUBLIC PROC[lc: LocalContextNode, flavor: VariantFlavorNode, tagType: TypeGraphNodeNode, types: UnionListNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: VariantPartTGN ← NEW[VariantPartTGNBody←[
flavor,
tagType,
FreezeUnionList[types]]];
RETURN[lc, CreateTGN[lc, body]];
END;
IsVariantPartTGN: PROC[tgn: TypeGraphNodeNode] RETURNS[BOOLEAN] =
BEGIN
WITH tgn.body SELECT FROM
vptgn: VariantPartTGN => RETURN[TRUE];
ENDCASE => RETURN[FALSE];
END;
GetVariantPartUnionList: PROC[tgn: TypeGraphNodeNode] RETURNS[FrozenUnionList] =
BEGIN
WITH tgn.body SELECT FROM
vptgn: VariantPartTGN => RETURN[vptgn.types];
ENDCASE => ERROR;
END;
ShowVariantPartTGN: PROC[on: IO.STREAM, nest: INT, vptgn: VariantPartTGN] =
BEGIN
IO.PutF[on, "variant\N"]; ShowNested[on, nest+2];
ShowVariantFlavor[on, nest+2, vptgn.flavor];
IO.PutF[on, "tagType\N"]; ShowNested[on, nest+2];
ShowTGN[on, nest+2, vptgn.tagType];
IO.PutF[on, "\N"];
ShowNested[on, nest+2]; IO.PutF[on, "variations\N"]; ShowNested[on, nest+2];
ShowFrozenUnionList[on, nest+2, vptgn.types];
END;
CreateEmptyUnionList: PUBLIC PROC RETURNS[UnionListNode] =
{RETURN[NEW[UnionListNodeBody←[0, NIL, NIL]]]};
AppendToUnionList: PUBLIC PROC[ul: UnionListNode, id: IdNode, ffl: FrozenFieldListNode] RETURNS[ulnp: UnionListNode] =
BEGIN
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];
END;
damages ul, used internally
FreezeUnionList: PROC[ul: UnionListNode] RETURNS[FrozenUnionList] =
BEGIN
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]
ShowFrozenUnionList: PROC[on: IO.STREAM, nest: INT, ful: FrozenUnionList] =
BEGIN
first: BOOLEAN ← FALSE;
FOR I: CARDINAL IN [0..ful.nTypes) DO
IF NOT first THEN {IO.PutF[on, "\N"]; ShowNested[on, nest]};
IO.PutF[on, "%g => ", IO.rope[RopeForId[ful[I].id]]];
ShowFrozenFieldList[on, nest+2, ful[I].ffl];
ENDLOOP;
END;
Variant Flavors
VariantFlavorNode: TYPE = REF VariantFlavorNodeBody;
VariantFlavorNodeBody: PUBLIC TYPE = RECORD[
SELECT flavor: VFlavor FROM
overlaid => [],
computed => [],
vanilla => [
id: IdNode,
position: PositionValNode,
access: AccessValNode],
ENDCASE];
VFlavor: TYPE = {overlaid, computed, vanilla};
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]]]]};
ShowVariantFlavor: PUBLIC PROC[on: IO.STREAM, nest: INT, vf: VariantFlavorNode] =
BEGIN
WITH vf SELECT FROM
o: REF VariantFlavorNodeBody.overlaid =>
IO.PutF[on, "Overlaid"];
c: REF VariantFlavorNodeBody.computed =>
IO.PutF[on, "Computed"];
v: REF VariantFlavorNodeBody.vanilla =>
BEGIN
IO.PutF[on, "Vanilla %g", IO.rope[RopeForId[v.id]]];
ShowPVN[on, nest, v.position];
ShowAVN[on, nest, v.access];
END;
ENDCASE => ERROR;
END;
Sequence TGNs
SequenceTGN: TYPE = REF SequenceTGNBody;
SequenceTGNBody: PUBLIC TYPE = RECORD[
packed: BOOLEAN,
id: IdNode,
position: PositionValNode,
access: AccessValNode,
tagType: TypeGraphNodeNode,
type: TypeGraphNodeNode];
CreateSequenceTGN: PUBLIC PROC[lc: LocalContextNode, packed: BOOLEAN, id: IdNode, position: PositionValNode, access: AccessValNode, tagType: TypeGraphNodeNode, type: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: SequenceTGN ← NEW[SequenceTGNBody←[packed, id, position, access, tagType, type]];
RETURN[lc, CreateTGN[lc, body]];
END;
ShowSequenceTGN: PROC[on: IO.STREAM, nest: INT, stgn: SequenceTGN] =
BEGIN
IO.PutF[on, "%gsequence\N", IO.rope[IF stgn.packed THEN "packed " ELSE ""]]; ShowNested[on, nest+2];
IO.PutF[on, "%g", IO.rope[RopeForId[stgn.id]]];
ShowPVN[on, nest, stgn.position];
ShowAVN[on, nest, stgn.access];
ShowTGNAsNamedSubstructure[on, nest+2, "tagType", stgn.tagType];
ShowTGNAsNamedSubstructure[on, nest+2, "type", stgn.type];
IO.PutF[on, "\N"]; ShowNested[on, nest+2]; IO.PutF[on, "tagType "];
END;
Array TGN
ArrayTGN: TYPE = REF ArrayTGNBody;
ArrayTGNBody: PUBLIC TYPE = RECORD[
packed: BOOLEAN,
indexType: TypeGraphNodeNode,
itemType: TypeGraphNodeNode];
CreateArrayTGN: PUBLIC PROC[lc: LocalContextNode, packed: BOOLEAN, indexType: TypeGraphNodeNode, itemType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: ArrayTGN ← NEW[ArrayTGNBody←[packed, indexType, itemType]];
RETURN[lc, CreateTGN[lc, body]];
ShowArrayTGN: PROC[on: IO.STREAM, nest: INT, atgn: ArrayTGN] =
BEGIN
IO.PutF[on, "%array\N", IO.rope[IF atgn.packed THEN "packed " ELSE ""]];
ShowTGNAsNamedSubstructure[on, nest+2, "indexType", atgn.indexType];
ShowTGNAsNamedSubstructure[on, nest+2, "itemType", atgn.itemType];
END;
Descriptor TGN
DescriptorTGN: TYPE = REF DescriptorTGNBody;
DescriptorTGNBody: PUBLIC TYPE = RECORD[
readonly: BOOLEAN,
itemType: TypeGraphNodeNode];
CreateDescriptorTGN: PUBLIC PROC[lc: LocalContextNode, readonly: BOOLEAN, itemType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: DescriptorTGN ← NEW[DescriptorTGNBody←[readonly, itemType]];
RETURN[lc, CreateTGN[lc, body]];
ShowDescriptorTGN: PROC[on: IO.STREAM, nest: INT, dtgn: DescriptorTGN] =
BEGIN
IO.PutF[on, "%descriptor\N", IO.rope[IF dtgn.readonly THEN "ReadOnly " ELSE ""]];
ShowTGNAsNamedSubstructure[on, nest+2, "itemType", dtgn.itemType];
END;
Transfer TGN
TransferTGN: TYPE = REF TransferTGNBody;
TransferTGNBody: PUBLIC TYPE = RECORD[
safe: BOOLEAN,
mode: TransferMode,
arguments: FrozenFieldListNode,
results: FrozenFieldListNode];
TransferMode: TYPE = {proc, port, signal, error, process, program};
CreateTransferTGN: PUBLIC PROC[lc: LocalContextNode, safe: BOOLEAN, modeName: Rope.ROPE, arguments, results: FrozenFieldListNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
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]];
ShowTransferTGN: PROC[on: IO.STREAM, nest: INT, ttgn: TransferTGN] =
BEGIN
modeName: Rope.ROPE ← SELECT ttgn.mode FROM
proc => "proc",
port => "port",
signal => "signal",
error => "error",
process => "process",
program => "program",
ENDCASE => ERROR;
IO.PutF[on, "% transfer\N", IO.rope[modeName]];
ShowNested[on, nest+2];
ShowFrozenFieldList[on, nest+2, ttgn.arguments];
IO.PutF[on, "\N"]; ShowNested[on, nest+2];
ShowFrozenFieldList[on, nest+2, ttgn.results];
END;
Zone TGN
ZoneTGN: TYPE = REF ZoneTGNBody;
ZoneTGNBody: PUBLIC TYPE = RECORD[
CreateZoneTGN: PUBLIC PROC[lc: LocalContextNode, uncounted: BOOLEAN] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: ZoneTGN ← NEW[ZoneTGNBody←[uncounted]];
RETURN[lc, CreateTGN[lc, body]];
END;
ShowZoneTGN: PROC[on: IO.STREAM, nest: INT, ztgn: ZoneTGN] =
BEGIN
IO.PutF[on, "% zone ", IO.rope[IF ztgn.uncounted THEN "uncounted" ELSE "counted"]];
END;
Long TGN
(For now we treat this as a constructor, but we could take it as a parameter during the construction of the underlying type)
(In the world of 16bit words, the underlying type must be a 16bit numerical quantity, a 16bit pointer, or an (array) descriptor. LONG makes it into a 32bit quantity. In other worlds, this may be a no-op, or not, depending.)
LongTGN: TYPE = REF LongTGNBody;
LongTGNBody: PUBLIC TYPE = RECORD[
underlyingType: TypeGraphNodeNode];
CreateLongTGN: PUBLIC PROC[lc: LocalContextNode, underlyingType: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: LongTGN ← NEW[LongTGNBody←[underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
END;
ShowLongTGN: PROC[on: IO.STREAM, nest: INT, ltgn: LongTGN] =
BEGIN
IO.PutF[on, "% long "];
ShowTGN[on, nest+2, ltgn.underlyingType];
END;
Interface TGN
InterfaceTGN: TYPE = REF InterfaceTGNBody;
InterfaceTGNBody: PUBLIC TYPE = RECORD[
typeNames: VisibleNames];
(Initial implementation will use same data structure as local type names)
(these are type graph nodes that occur inside a type graph. They are not the external manifestation of an interface, which is a DefFileInterfaceNode)
CreateEmptyInterfaceTGN: PUBLIC PROC[lc: LocalContextNode] RETURNS[lcp: LocalContextNode, tgn: TypeGraphNodeNode] =
BEGIN
body: InterfaceTGN ← NEW[InterfaceTGNBody←[CreateEmptyVisibleNames[]]];
RETURN[lc, CreateTGN[lc, body]];
AddTGNToInterfaceTGN: PUBLIC PROC[lc: LocalContextNode, if: TypeGraphNodeNode, id: IdNode, access: AccessValNode, tgn: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] =
BEGIN
iftgn: InterfaceTGN ← NARROW[if.body];
RecordVisibleName[iftgn.typeNames, id, access, tgn];
RETURN[lc];
END;
LookupTypeNameInInterfaceTGN: PUBLIC PROC[lc: LocalContextNode, id: IdNode, if: TypeGraphNodeNode] RETURNS[access: AccessValNode, tgn: TypeGraphNodeNode] =
BEGIN
iftgn: InterfaceTGN ← NARROW[if.body];
refAnyTgn: REF ANY;
[access, refAnyTgn] ← LookupVisibleName[iftgn.typeNames, id];
RETURN[access, NARROW[refAnyTgn]];
END;
GenTypeNamesFromInterface: PROC[if: TypeGraphNodeNode, for: PROC[IdNode, AccessValNode, TypeGraphNodeNode]] =
BEGIN
iftgn: InterfaceTGN ← NARROW[if.body];
localFor: PROC[name: IdNode, access: AccessValNode, value: REF ANY] =
{for[name, access, NARROW[value]]};
GenVisibleNames[iftgn.typeNames, localFor];
END;
(following two operations correspond to entries in an OPEN clause)
RenameInterface: PUBLIC PROC[lc: LocalContextNode, name: IdNode, interface: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] =
BEGIN
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];
END;
OpenInterface: PUBLIC PROC[lc: LocalContextNode, interface: TypeGraphNodeNode] RETURNS[lcp: LocalContextNode] =
BEGIN
OpenOneInterfaceTypeName: PROC[name: IdNode, access: AccessValNode, tgn: TypeGraphNodeNode] =
BEGIN
newTGN: TypeGraphNodeNode ← CreateLocallyVisibleTGN[lc, name, AccessValConst["private"]].tgn;
not sure "private" is correct, or whether argument access should be checked to be sure not private, etc.
[] ← AddArcFromLVTGNToTGN[lc, newTGN, AccessValConst["private"], tgn, DefaultExpVal["", NullExpPTree[]]];
END;
GenTypeNamesFromInterface[interface, OpenOneInterfaceTypeName];
END;
Frame TGN
FrameTGN: TYPE = REF FrameTGNBody;
FrameTGNBody: PUBLIC TYPE = RECORD[
FrameTGN: REF ANY];
(I will fill this in as needed later)
FindFrameTGN: PUBLIC PROC[lc: LocalContextNode, id: IdNode] RETURNS[tgn: TypeGraphNodeNode] =
BEGIN
tgn ← FindLocallyVisibleTGN[lc, id];
WITH tgn.body SELECT FROM
ftgn: FrameTGN => RETURN[tgn];
ENDCASE => ERROR;
END;
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)
SpecianatedTGN: TYPE = REF SpecianatedTGNBody;
SpecianatedTGNBody: PUBLIC TYPE = RECORD[
expParam: ExpPTreeNode,
idParam: IdNode,
underlyingType: TypeGraphNodeNode];
(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] =
BEGIN
WITH underlyingType.body SELECT FROM
iftgn: InterfaceTGN =>
BEGIN
RETURN[lc, LookupTypeNameInInterfaceTGN[lc, id, underlyingType].tgn];
probably should be doing an access check here
END;
ENDCASE =>
BEGIN
body: SpecianatedTGN ← NEW[SpecianatedTGNBody←[NIL, id, underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
END;
END;
(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] =
BEGIN
body: SpecianatedTGN ← NEW[SpecianatedTGNBody←[parameter, NIL, underlyingType]];
RETURN[lc, CreateTGN[lc, body]];
END;
ShowSpecianatedTGN: PROC[on: IO.STREAM, nest: INT, stgn: SpecianatedTGN] =
BEGIN
IO.PutF[on, "%g specianated ", IF stgn.expParam # NIL THEN IO.rope[TextForExpPTree[stgn.expParam]] ELSE IO.rope[RopeForId[stgn.idParam]]];
ShowTGN[on, nest+2, stgn.underlyingType];
END;
Paint nodes
PaintNode:
TYPE =
REF PaintNodeBody; PaintNodeBody: PUBLIC TYPE = RECORD[
parentlc: LocalContextNode,
index: INT];
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] =
BEGIN
lc.paintIndex ← lc.paintIndex + 1;
RETURN[lc, NEW[PaintNodeBody←[lc, lc.paintIndex]]];
END;
ShowPaint: PROC[on: IO.STREAM, nest: INT, paint: PaintNode] =
BEGIN
IO.PutF[on, " (paint = %g) ", IO.int[paint.index]];
END;
Locally Visible Names
Very simple for now, just a chained list of IdNodes
VisibleNames: TYPE = REF VisibleNamesBody;
VisibleNamesBody: TYPE = RECORD[
first: VNCell];
VNCell: TYPE = REF VNCellBody; VNCellBody: TYPE = RECORD[
id: IdNode, access: AccessValNode, value: REF ANY, next: VNCell];
CreateEmptyVisibleNames: PROC RETURNS[vn: VisibleNames] =
BEGIN
vn ← NEW[VisibleNamesBody ← [NIL]];
RETURN[vn];
END;
RecordVisibleName: PROC[vn: VisibleNames, name: IdNode, access: AccessValNode, value: REF ANY] =
BEGIN
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;
END;
LookupVisibleName: PROC[vn: VisibleNames, name: IdNode] RETURNS[access: AccessValNode, value: REF ANY] =
BEGIN
cell: VNCell ← vn.first;
WHILE cell # NIL DO
IF Rope.Equal[RopeForId[cell.id], RopeForId[name]] THEN RETURN[cell.access, cell.value];
cell ← cell.next;
ENDLOOP;
RETURN[NIL, NIL];
END;
GenVisibleNames: PROC[vn: VisibleNames, for: PROC[name: IdNode, access: AccessValNode, value: REF ANY]] =
BEGIN
cell: VNCell ← vn.first;
WHILE cell # NIL DO
for[cell.id, cell.access, cell.value];
cell ← cell.next;
ENDLOOP;
END;
General purpose show routines
ShowNested: PROC[on: IO.STREAM, nest: INT] =
{FOR I: INT IN [0..nest) DO IO.PutRope[on, " "] ENDLOOP};
RopeForId: PROC[id: IdNode] RETURNS[Rope.ROPE] =
{RETURN[IF id # NIL THEN id.text ELSE ""]};
Context Ribs
ContextRibNode: TYPE = REF ContextRibNodeBody;
ContextRibNodeBody: PUBLIC TYPE = RECORD[
lc: LocalContextNode];
RootContextRib: PUBLIC PROC RETURNS[rib: ContextRibNode] =
{RETURN[FreezeLocalContext[CreateRootLocalContext[]]]};
(damages lc)
FreezeLocalContext: PUBLIC PROC[lc: LocalContextNode] RETURNS[rib: ContextRibNode] =
BEGIN
lc.frozen ← TRUE;
RETURN[NEW[ContextRibNodeBody←[lc]]];
END;
RealShowRib: PROC[on: IO.STREAM, nest: INT, rib: ContextRibNode] =
BEGIN
IO.PutF[on, "Context Rib %g:", IO.int[LOOPHOLE[rib, INT]]];
IO.PutRope[on, "\N"]; ShowNested[on, nest+2];
RealShowLocalContext[on, nest+2, rib.lc];
END;
Context Trees
ContextTreeNode: TYPE = REF ContextTreeNodeBody;
ContextTreeNodeBody: PUBLIC TYPE = RECORD[
rib: ContextRibNode,
subTrees: CTCell,
lastSubTree: CTCell];
CTCell: TYPE = REF CTCellBody; CTCellBody: TYPE = RECORD[
ctn: ContextTreeNode,
next: CTCell];
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] =
BEGIN
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];
RealShowTree: PROC[on: IO.STREAM, nest: INT, ct: ContextTreeNode] =
BEGIN
IO.PutF[on, "Context Tree %g:", IO.int[LOOPHOLE[ct, INT]]];
IO.PutRope[on, "\N"]; ShowNested[on, nest+2];
RealShowRib[on, nest+2, ct.rib];
IO.PutRope[on, "\N\N"]; ShowNested[on, nest+4];
FOR cell: CTCell ← ct.subTrees, cell.next WHILE cell # NIL DO
RealShowTree[on, nest+4, cell.ctn];
IF cell = ct.lastSubTree THEN EXIT;
ENDLOOP;
Default Exp Nodes
DefaultExpCase: TYPE = {c1, c2, c3, c4, c5};
see section 3.3.5 of Mesa manual
DefaultExpNode: TYPE = REF DefaultExpNodeBody;
DefaultExpNodeBody: PUBLIC TYPE = RECORD[
case: DefaultExpCase,
exp: ExpPTreeNode];
DefaultExpVal: PUBLIC PROC[case: Rope.ROPE, exp: ExpPTreeNode] RETURNS[DefaultExpNode] =
BEGIN
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]]];
END;
ShowDEN: PROC[on: IO.STREAM, nest: INT, den: DefaultExpNode] =
BEGIN
t1: Rope.ROPE ← SELECT den.case FROM
c1 => "",
c2 => "← ",
c3 => "𡤎 ",
c4 => "←TRASH ",
c5 => "𡤎|TRASH ",
ENDCASE => ERROR;
t2: Rope.ROPE ← TextForExpPTree[den.exp];
IO.PutF[on, "<%g%g>", IO.rope[t1], IO.rope[t2]];
END;
position val nodes
PositionValNode: TYPE = REF PositionValNodeBody;
PositionValNodeBody: PUBLIC TYPE = RECORD[
index: ExpPTreeNode,
PositionValFun: PUBLIC PROC[index: ExpPTreeNode, bounds: BoundsValNode] RETURNS[PositionValNode] =
{RETURN[NEW[PositionValNodeBody←[index, bounds]]]};
NullPosition: PUBLIC PROC RETURNS[PositionValNode] =
{RETURN[NIL]};
ShowPVN: PROC[on: IO.STREAM, nest: INT, pvn: PositionValNode] =
BEGIN
IF pvn # NIL THEN
BEGIN
IO.PutF[on, "( %g ", IO.rope[TextForExpPTree[pvn.index]]];
ShowBVN[on, nest, pvn.bounds];
IO.PutF[on, " )"];
END;
END;
bounds val nodes
OpenClosed: TYPE = {open, closed};
BoundsValNode: TYPE = REF BoundsValNodeBody;
BoundsValNodeBody: PUBLIC TYPE = RECORD[
left: OpenClosed, first, last: ExpPTreeNode, right: OpenClosed]; -- what about closed and open end points?
BoundsValFun: PUBLIC PROC[leftBracket: Rope.ROPE, first: ExpPTreeNode, last: ExpPTreeNode, rightBracket: Rope.ROPE] RETURNS[BoundsValNode] =
BEGIN
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];
END;
NullBounds: PUBLIC PROC RETURNS[BoundsValNode] =
{RETURN[NIL]};
The colon is not needed for some uses, but I have to go back and figure out all of the uses, and see which ones need the colon.
ShowBVN: PROC[on: IO.STREAM, nest: INT, bvn: BoundsValNode] =
BEGIN
IF bvn # NIL THEN
BEGIN
left: Rope.ROPE ← SELECT bvn.left FROM
open => "(",
closed => "[",
ENDCASE => ERROR;
right: Rope.ROPE ← SELECT bvn.right FROM
open => ")",
closed => "]",
ENDCASE => ERROR;
IO.PutF[on, ": %g%g..%g%g ", IO.rope[left], IO.rope[TextForExpPTree[bvn.first]], IO.rope[TextForExpPTree[bvn.last]], IO.rope[right]];
END;
END;
access val nodes
AccessValNode: TYPE = REF AccessValNodeBody;
AccessValNodeBody: PUBLIC TYPE = AccessValSet;
AccessValSet: TYPE = {empty, private, public};
AccessValConst: PUBLIC PROC[r: Rope.ROPE] RETURNS[AccessValNode] =
BEGIN
SELECT TRUE FROM
Rope.Equal[r, "empty"] => RETURN[NEW[AccessValNodeBody𡤎mpty]];
Rope.Equal[r, "private"] => RETURN[NEW[AccessValNodeBody←private]];
Rope.Equal[r, "public"] => RETURN[NEW[AccessValNodeBody←public]];
ENDCASE => ErrorSignal[];
END;
ShowAVN: PUBLIC PROC[on: IO.STREAM, nest: INT, avn: AccessValNode] =
BEGIN
IO.PutF[on, " %g", IO.rope[SELECT avn^ FROM
empty => "empty",
private => "private",
public => "public",
ENDCASE => ERROR]];
END;
ExpPTree
I can't remember why these boxes are needed (ExpPTree, ScopePTree, ...). Perhaps it is a flaw in the current version of ThreeCasabaFour.
ExpPTreeNode: TYPE = REF ExpPTreeNodeBody;
ExpPTreeNodeBody: PUBLIC TYPE = RECORD[node: ExpNode];
exported to SaffronATDef??
ExpPTreeVal: PUBLIC PROC[node: ExpNode] RETURNS[ExpPTreeNode] =
{RETURN[NEW[ExpPTreeNodeBody←[node]]]};
NullExpPTree: PUBLIC PROC RETURNS[ExpPTreeNode] =
{RETURN[NIL]};
TextForExpPTree: PROC[exp: ExpPTreeNode] RETURNS[Rope.ROPE] =
{RETURN[IF (exp # NIL) THEN "exp" ELSE ""]};
ScopePTree
ScopePTreeNode: TYPE = REF ScopePTreeNodeBody;
ScopePTreeNodeBody: PUBLIC TYPE = RECORD[node: ScopeNode];
exported to SaffronATDef??
ScopePTreeVal: PUBLIC PROC[node: ScopeNode] RETURNS[ScopePTreeNode] =
{RETURN[NEW[ScopePTreeNodeBody←[node]]]};
ScopeVal: PUBLIC PROC[box: ScopePTreeNode] RETURNS[ScopeNode] =
misc stuff
following are exported to SaffronContext
ErrorSignal: PUBLIC ERROR = CODE;
ShowLocalContext: PUBLIC PROC[on: IO.STREAM, nest: INT, lc: LocalContextNode] =
{RealShowLocalContext[on, nest, lc]};
ShowContextRib: PUBLIC PROC[on: IO.STREAM, nest: INT, rib: ContextRibNode] =
{RealShowRib[on, nest, rib]};
ShowContextTree: PUBLIC PROC[on: IO.STREAM, nest: INT, ct: ContextTreeNode] =
{RealShowTree[on, nest, ct]};
Following are exported to SaffronBaseDef
True: PUBLIC PROC RETURNS[BOOLEAN] =
{RETURN[TRUE]};
False: PUBLIC PROC RETURNS[BOOLEAN] =
{RETURN[FALSE]};
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;
Error: PUBLIC PROC[r: Rope.ROPE] RETURNS[BOOLEAN] =
BEGIN ERROR END;
NullId: PUBLIC PROC RETURNS[IdNode] = {RETURN[NIL]};
END..