DIRECTORY
IO USING [PutF, PutFR, rope, RopeFromROS, ROS, STREAM],
Rope USING [Equal, ROPE],
SaffronATDef USING [EvaluateAndTypeCheckExpression, ExpNode, InitializationNode, TypeExpNode],
SaffronBaseDef USING [AccessValNode, CompilerStateNode, DemandTypeDeclarationField, FieldNode, LookupNameInContextRib, LookupNameInFieldList],
SaffronContext USING [],
SaffronContextPrivateTypes,
SaffronErrorHandling USING [FatalError, InternalError, Message, Warning],
SaffronGenericDef USING [IdNode],
SaffronProgramGraphPrivateTypes USING [ParameterizedFieldDescriptorNodeBody];
SaffronDeclarationAnalysisImpl:
CEDAR
PROGRAM
IMPORTS IO, Rope, SaffronATDef, SaffronBaseDef, SaffronErrorHandling
EXPORTS SaffronBaseDef, SaffronContext
~ BEGIN
OPEN
AT: SaffronATDef,
BD: SaffronBaseDef,
EH: SaffronErrorHandling,
GEN: SaffronGenericDef,
PG: SaffronProgramGraphPrivateTypes,
PT: SaffronContextPrivateTypes;
LocalContextNode: TYPE ~ REF LocalContextNodeBody;
LocalContextNodeBody: PUBLIC TYPE ~ PT.LocalContextNodeBody;
ContextRibNode: TYPE ~ REF ContextRibNodeBody;
ContextRibNodeBody: PUBLIC TYPE ~ PT.ContextRibNodeBody;
FrozenFieldListNode: TYPE = REF FrozenFieldListNodeBody;
FrozenFieldListNodeBody: PUBLIC TYPE = PT.FrozenFieldListNodeBody;
FieldListNode: TYPE = REF FieldListNodeBody;
FieldListNodeBody: PUBLIC TYPE = PT.FieldListNodeBody;
TypeGraphNodeNode: TYPE ~ REF TypeGraphNodeNodeBody;
TypeGraphNodeNodeBody: PUBLIC TYPE ~ PT.TypeGraphNodeNodeBody;
ValueNode: TYPE = REF ValueNodeBody;
ValueNodeBody: PUBLIC TYPE = PT.ValueNodeBody;
FieldNode: TYPE = REF FieldNodeBody;
FieldNodeBody: PUBLIC TYPE = PT.FieldNodeBody;
ParameterizedFieldDescriptorNode: TYPE = REF ParameterizedFieldDescriptorNodeBody;
ParameterizedFieldDescriptorNodeBody: PUBLIC TYPE = PG.ParameterizedFieldDescriptorNodeBody;
AnalyzeDependencies:
PUBLIC
PROC [dg: DependencyGraphNode, fl: FieldListNode, lc: LocalContextNode, cs:
BD.CompilerStateNode]
RETURNS [FieldListNode, LocalContextNode]~
Perform the analysis described above on contextNode. If contextNode is okay, fill in all of its SIZE, FIRST, and LAST fields. (If we get really clever, and lucky, maybe we can also discriminate the Specianated types.)
BEGIN
NodeProc:
PROC [dgn: DependencyGraphNodeNode] =
BEGIN
WITH dgn
SELECT
FROM
d:
REF value DependencyGraphNodeNodeBody =>
IF
NOT DependsOnRuntimeState[dgn]
THEN {
field: REF constant FieldNodeBody ← NARROW[d.of];
targetType: TypeGraphNodeNode ← field.type;
expNode: AT.ExpNode ← NARROW[field.value, REF unparsed ValueNodeBody].parseTree;
field.value ← AT.EvaluateAndTypeCheckExpression[expNode, lc, fl, cs, targetType];
};
d: REF runtime DependencyGraphNodeNodeBody => {};
d:
REF size DependencyGraphNodeNodeBody =>
SIGNAL EH.Warning[0, "size dgn proc not yet implemented"];
d:
REF first DependencyGraphNodeNodeBody =>
IF DependsOnRuntimeState[dgn]
THEN ERROR EH.FatalError[0, "FIRST[] is not constant"]
ELSE {
field: REF typeDecl FieldNodeBody ← NARROW[d.of];
namedType: PT.NamedTGN ← NARROW[field.type.body];
elementTGN: PT.ElementTGN ← NARROW[namedType.type.body];
WITH elementTGN
SELECT
FROM
e:
REF subrange
PT.ElementTGNBody => {
expNode: AT.ExpNode ← NARROW[e.body.firstElement, REF unparsed ValueNodeBody].parseTree;
e.body.firstElement ← AT.EvaluateAndTypeCheckExpression[expNode, lc, fl, cs, e.body.baseType];
};
e:
REF enumerated base
PT.ElementTGNBody => {
SIGNAL EH.Warning[0, "first dgn proc not yet implemented for base enumerated tgn"]
};
ENDCASE => ERROR EH.InternalError["should not be dependency-analyzing this kind of element type"];
};
d:
REF last DependencyGraphNodeNodeBody =>
IF DependsOnRuntimeState[dgn]
THEN ERROR EH.FatalError[0, "LAST[] is not constant"]
ELSE {
field: REF typeDecl FieldNodeBody ← NARROW[d.of];
namedType: PT.NamedTGN ← NARROW[field.type.body];
elementTGN: PT.ElementTGN ← NARROW[namedType.type.body];
WITH elementTGN
SELECT
FROM
e:
REF subrange
PT.ElementTGNBody => {
expNode: AT.ExpNode ← NARROW[e.body.lastElement, REF unparsed ValueNodeBody].parseTree;
e.body.lastElement ← AT.EvaluateAndTypeCheckExpression[expNode, lc, fl, cs, e.body.baseType];
};
e:
REF enumerated base
PT.ElementTGNBody => {
SIGNAL EH.Warning[0, "last dgn proc not yet implemented for base enumerated tgn"]
};
ENDCASE => ERROR EH.InternalError["should not be dependency-analyzing this kind of element type"];
};
ENDCASE;
END;
lc.dependencyGraph ← dg;
WalkDependencyGraph[lc.dependencyGraph, NodeProc];
RETURN[fl, lc];
END;
CompileDecList: PUBLIC PROC [decls: AT.DecListNode, lc: LocalContextNode, cs: BD.CompilerStateNode] RETURNS [LocalContextNode] = BEGIN
This is the starting point for compiling a list of declarations. CompileDecList does the following:
(1) Build a field list with one entry for each name declared in decls. Represent identifiers appearing where type expressions are expected as IdentifierTGN's. Represent identifiers appearing where value expressions are expected as ???.
(2) Chill the field list, create a BlockTGN, and stuff the BlockTGN into lc's contents.
(3) Look up the names stubbed out in part (1), bashing their occurrences.
(4) Build a dependency graph for the names declared in decls.
(5) Walk through the dependency graph, filling in size/value/first/last attributes. (Note that the bodies of procedure definitions, etc., are handled at this point).
(6) Return the local context, ready to be frozen into a rib.
fl: BD.FieldListNode;
ffl: BD.FrozenFieldListNode;
block: TypeGraphNodeNode;
Build a field list with one entry for each name declared in decls. Represent identifiers appearing where type expressions are expected as IdentifierTGN's. Represent identifiers appearing where value expressions are expected as ???. Chill the field list, create a BlockTGN, and stuff the BlockTGN into lc's contents.
[fl, lc] ← decls.procs.AddDeclarationsToFieldList[decls, BD.CreateEmptyFieldList[], lc, cs];
[lc, ffl] ← BD.FreezeFieldList[lc, fl];
[lc, block] ← BD.CreateBlockTGN[lc, ffl];
lc.contents ← NEW[PT.LocalContextContentsBody ← [frozen[block]]];
Now go back and look up all the IdentiferTGNs. Replace the body field of each identifer TypeGraphNode with named TypeGraphNode corresponding to the identifier. (Note: At this point, all value expressions are still trash or unparsed or defaultMe.)
LookupTypeIdentifersInLocalContext[lc, ffl];
Build a dependency graph for the names declared in decls.
lc.dependencyGraph ← BuildDependencyGraph[ffl, lc];
Do a topological sort of the dependency graph, performing the following on each node:
If the node is a value node which does not ultimately depend on the runtime state, then it must represent a static (compile-time constant) value. Use the expression compiler to change the value's parse tree into a static representation.
If the node is a value node which ultimately depends on the runtime state, then it represents a variable or runtime constant. Do nothing with it at this time.
If the node is a FIRST, LAST, or SIZE node which does not ultimately depend on the runtime state, then use the expression compiler to compute a static value and stuff this value into the appropriate slot of the appropriate type graph node.
If the node is a FIRST, LAST, or SIZE node which ultimately depends on the runtime state, then raise an error.
This will determine all the compile-time (static) quantities in the dependency graph.
BEGIN
NodeProc: PROC [dgn: DependencyGraphNodeNode] = BEGIN
WITH dgn SELECT FROM
d: REF value DependencyGraphNodeNodeBody =>
IF NOT DependsOnRuntimeState[dgn] THEN {
field: REF constant FieldNodeBody ← NARROW[d.of];
targetType: TypeGraphNodeNode ← field.type;
expNode: AT.ExpNode ← NARROW[field.value, REF unparsed ValueNodeBody].parseTree;
[field.value, lc] ← AT.CompileAndTypeCheckExpression[expNode, lc, cs, targetType];
};
d: REF runtime DependencyGraphNodeNodeBody => {};
d: REF size DependencyGraphNodeNodeBody =>
SIGNAL EH.Warning[0, "size dgn proc not yet implemented"];
d: REF first DependencyGraphNodeNodeBody =>
IF DependsOnRuntimeState[dgn]
THEN ERROR EH.FatalError[0, "FIRST[] is not constant"]
ELSE {
field: REF typeDecl FieldNodeBody ← NARROW[d.of];
namedType: PT.NamedTGN ← NARROW[field.type.body];
elementTGN: PT.ElementTGN ← NARROW[namedType.type.body];
WITH elementTGN SELECT FROM
e: REF subrange PT.ElementTGNBody => {
expNode: AT.ExpNode ← NARROW[e.body.firstElement, REF unparsed ValueNodeBody].parseTree;
[e.body.firstElement, lc] ← AT.CompileAndTypeCheckExpression[expNode, lc, cs, e.body.baseType];
};
e: REF enumerated base PT.ElementTGNBody => {
SIGNAL EH.Warning[0, "first dgn proc not yet implemented for base enumerated tgn"]
};
ENDCASE => ERROR EH.InternalError["should not be dependency-analyzing this kind of element type"];
};
d: REF last DependencyGraphNodeNodeBody =>
IF DependsOnRuntimeState[dgn]
THEN ERROR EH.FatalError[0, "LAST[] is not constant"]
ELSE {
field: REF typeDecl FieldNodeBody ← NARROW[d.of];
namedType: PT.NamedTGN ← NARROW[field.type.body];
elementTGN: PT.ElementTGN ← NARROW[namedType.type.body];
WITH elementTGN SELECT FROM
e: REF subrange PT.ElementTGNBody => {
expNode: AT.ExpNode ← NARROW[e.body.lastElement, REF unparsed ValueNodeBody].parseTree;
[e.body.lastElement, lc] ← AT.CompileAndTypeCheckExpression[expNode, lc, cs, e.body.baseType];
};
e: REF enumerated base PT.ElementTGNBody => {
SIGNAL EH.Warning[0, "last dgn proc not yet implemented for base enumerated tgn"]
};
ENDCASE => ERROR EH.InternalError["should not be dependency-analyzing this kind of element type"];
};
ENDCASE;
END;
lc.dependencyGraph ← BuildDependencyGraph[ffl, lc];
WalkDependencyGraph[lc.dependencyGraph, NodeProc];
Now, proceed sequentially through the field list (the declarations), performing the following on each field:
If the field is a TYPE declaration, ignore it. (What about type codes, etc.?)
If the field is a constant declaration and the ValueNode in its value slot is a static ValueNode, then we know that the field represents a compile-time constant and that it was processed in the previous step. So, ignore it. (Fill in its code? -- no, the static value constructors should do this!).
If the field is a constant declaration and the ValueNode in its value slot is an unparsed value, then we know that it is a runtime constant. Compile the ValueNode, producing a runtime ValueNode, and stuff this new node into the field's value slot.
(Can constants be initialized to trash? They probably can!)
If the field is a variable declaration, then look at its initialValue slot:
If there is a defaultMe ValueNode there, then no initialization was provided for the variable. Check to see if the variable's type has a default initialization. If so, produce a ValueNode containing this (how???). If not, produce a trash ValueNode. Either way, stuff the new ValueNode into the field's initialValue slot.
If there is an unparsed ValueNode there, then compile the expression (producing a static or runtime ValueNode) and stuff this new ValueNode into the field's initialValue slot.
If there is a trash ValueNode there, then the variable was explicitly initialized to TRASH. Do nothing else.
Foo.
BEGIN
FOR cell: PT.FieldListCell ← ffl.cells.first, cell.next WHILE (cell # NIL) DO
WITH cell.node SELECT FROM
field: REF typeDecl FieldNodeBody => {};
field: REF constant FieldNodeBody => {
WITH field.value SELECT FROM
value: REF static ValueNodeBody => {};
value: REF unparsed ValueNodeBody => {
[field.value, lc] ← AT.CompileAndTypeCheckExpression[value.parseTree, lc, cs, field.type];
};
value: REF trash ValueNodeBody => {};
ENDCASE => ERROR EH.InternalError["a"];
};
field: REF variable FieldNodeBody => {
WITH field.initialValue SELECT FROM
initialValue: REF defaultMe ValueNodeBody => {
field.initialValue ← BD.MakeTrash[field.type]
this also must check field.type for a default initialization!!
};
initialValue: REF unparsed ValueNodeBody => {
[field.initialValue, lc] ← AT.CompileAndTypeCheckExpression[initialValue.parseTree, lc, cs, field.type];
};
initialValue: REF trash ValueNodeBody => {};
ENDCASE => ERROR EH.InternalError["b"];
};
ENDCASE => ERROR EH.InternalError["c"];
ENDLOOP;
END;
Return the local context.
RETURN[lc];
END;
Looking Up IdentiferTGN's
LookupIdentifierTGNs:
PUBLIC
PROC [fl: FieldListNode, lc: LocalContextNode]
RETURNS [FieldListNode] =
BEGIN
LookupTypeIdentifiersInFieldList[fl, fl, lc];
RETURN [fl];
END;
LookupTypeIdentifiers:
PROC [tgn: TypeGraphNodeNode, fl: FieldListNode, lc: LocalContextNode]
RETURNS [TypeGraphNodeNode] =
BEGIN
IF
ISTYPE[tgn.body,
PT.IdentifierTGN]
THEN
BEGIN
access: BD.AccessValNode;
lookedUpTGN: TypeGraphNodeNode;
id: GEN.IdNode ← NARROW[tgn.body, PT.IdentifierTGN].id;
field: FieldNode ← BD.LookupNameInFieldList[fl, id];
IF field = NIL THEN field ← BD.LookupNameInContextRib[id, lc.parentRib];
[access, lookedUpTGN] ← BD.DemandTypeDeclarationField[field];
RETURN [lookedUpTGN];
END
ELSE
BEGIN
WITH tgn.body
SELECT
FROM
t:
PT.ArrayTGN => {
t.indexType ← LookupTypeIdentifiers[t.indexType, fl, lc];
t.itemType ← LookupTypeIdentifiers[t.itemType, fl, lc];
};
t: PT.AtomTGN => {};
t: PT.BlockTGN => ERROR EH.InternalError["Name in local context bound to block TGN"];
t: PT.ConditionTGN => {};
t: PT.DescriptorTGN => t.itemType ← LookupTypeIdentifiers[t.itemType, fl, lc];
t: REF base PT.ElementTGNBody => {};
t:
REF subrange
PT.ElementTGNBody =>
t.body.baseType ← LookupTypeIdentifiers[t.body.baseType, fl, lc];
t: PT.InterfaceTGN => ERROR EH.InternalError["Name in local context bound to interface TGN"];
t: PT.LinkTGN => {
t.tgn ← LookupTypeIdentifiers[t.tgn, fl, lc];
t.if ← LookupTypeIdentifiers[t.if, fl, lc];
};
t: PT.ListTGN => t.elementType ← LookupTypeIdentifiers[t.elementType, fl, lc];
t: PT.LongTGN => t.underlyingType ← LookupTypeIdentifiers[t.underlyingType, fl, lc];
t: PT.MonitorlockTGN => {};
t: PT.NamedTGN => t.type ← LookupTypeIdentifiers[t.type, fl, lc];
t: PT.OpaqueTGN => {};
t: PT.PointerTGN => t.target ← LookupTypeIdentifiers[t.target, fl, lc];
t: PT.RealTGN => {};
t: PT.RecordTGN => LookupTypeIdentifiersInFrozenFieldList[t.fields, fl, lc];
t: PT.RefTGN => t.target ← LookupTypeIdentifiers[t.target, fl, lc];
t: PT.ReferentTGN => t.contents ← LookupTypeIdentifiers[t.contents, fl, lc];
t:
PT.RelativeTGN => {
t.base ← LookupTypeIdentifiers[t.base, fl, lc];
t.pointer ← LookupTypeIdentifiers[t.pointer, fl, lc];
};
t:
PT.SequenceTGN => {
t.tagType ← LookupTypeIdentifiers[t.tagType, fl, lc];
t.type ← LookupTypeIdentifiers[t.type, fl, lc];
};
t:
PT.SpecianatedTGN => {
t.underlyingType ← LookupTypeIdentifiers[t.underlyingType, fl, lc];
};
t: PT.StringTGN => {};
t: PT.TopTGN => {};
t: PT.BottomTGN => {};
t:
PT.TransferTGN => {
LookupTypeIdentifiersInFrozenFieldList[t.arguments, fl, lc];
LookupTypeIdentifiersInFrozenFieldList[t.results, fl, lc];
};
t: PT.UnspecifiedTGN => {};
t: PT.VarTGN => t.target ← LookupTypeIdentifiers[t.target, fl, lc];
t:
PT.VariantPartTGN => {
t.tagType ← LookupTypeIdentifiers[t.tagType, fl, lc];
LookupTypeIdentifiersInFrozenUnionList[t.types, fl, lc];
};
t: PT.ZoneTGN => {};
ENDCASE => ERROR;
RETURN [tgn];
END;
LookupTypeIdentifiersInFrozenFieldList:
PROC [ffl: FrozenFieldListNode, fl: FieldListNode, lc: LocalContextNode] =
BEGIN
LookupTypeIdentifiersInFieldList[ffl.cells, fl, lc];
END;
LookupTypeIdentifiersInFieldList:
PROC [arg: FieldListNode, fl: FieldListNode, lc: LocalContextNode] =
BEGIN
FOR cell:
PT.FieldListCell ← arg.first, cell.next
WHILE (cell #
NIL)
DO
WITH cell.node
SELECT
FROM
f: REF typeDecl FieldNodeBody => f.type ← LookupTypeIdentifiers[f.type, fl, lc];
f: REF constant FieldNodeBody => f.type ← LookupTypeIdentifiers[f.type, fl, lc];
f: REF variable FieldNodeBody => f.type ← LookupTypeIdentifiers[f.type, fl, lc];
f: REF recordField FieldNodeBody => f.type ← LookupTypeIdentifiers[f.type, fl, lc];
ENDCASE => ERROR;
ENDLOOP;
END;
LookupTypeIdentifiersInFrozenUnionList:
PROC [ful:
PT.FrozenUnionList, fl: FieldListNode, lc: LocalContextNode] =
BEGIN
FOR i:
INT
IN [0..ful.nTypes)
DO
LookupTypeIdentifiersInFrozenFieldList[ful[i].fields, fl, lc];
ENDLOOP;
END;
Discerning SpecianatedTGN's
DiscernSpecianatedTGNs:
PUBLIC
PROC [fl: FieldListNode, lc: LocalContextNode]
RETURNS [FieldListNode] =
BEGIN
DiscernSpecTGNsInFieldList[fl, fl, lc];
RETURN [fl];
END;
DiscernSpecTGNs:
PROC [tgn: TypeGraphNodeNode, fl: FieldListNode, lc: LocalContextNode]
RETURNS [TypeGraphNodeNode ←
NIL] =
BEGIN
IF
ISTYPE[tgn.body,
PT.SpecianatedTGN]
THEN
BEGIN
stgn: PT.SpecianatedTGN ← NARROW[tgn.body];
underlyingType: TypeGraphNodeNode ← stgn.underlyingType;
restrictionList: LIST OF GEN.IdNode ← NIL;
WHILE
TRUE
DO
WITH underlyingType.body
SELECT
FROM
ut: PT.NamedTGN => {underlyingType ← ut.type; restrictionList ← ut.restriction};
ut: PT.InterfaceTGN =>
IF (stgn.idParam = NIL) OR (stgn.expParam # NIL)
THEN ERROR EH.FatalError[0, "Bad form of interface field selector"]
ELSE {
WHILE restrictionList # NIL DO
IF Rope.Equal[restrictionList.first.text, stgn.idParam.text]
THEN {
field: FieldNode ← SaffronContext.LookupNameInFieldList[ut.entries.cells, stgn.idParam];
WITH field SELECT FROM
f: REF typeDecl FieldNodeBody => RETURN[f.type];
ENDCASE => ERROR EH.FatalError[stgn.idParam.position, "Mumblefrotz in interface is not a type."];
}
ELSE restrictionList ← restrictionList.rest;
ENDLOOP;
ERROR EH.FatalError[stgn.idParam.position, IO.PutFR["%g is not valid as an interface field selector.", IO.rope[stgn.idParam.text]]];
};
ENDCASE => ERROR EH.FatalError[0, "Bad type underlying specianated tgn"];
a better error message, please?
ENDLOOP;
END
ELSE
BEGIN
WITH tgn.body
SELECT
FROM
t:
PT.ArrayTGN => {
t.indexType ← DiscernSpecTGNs[t.indexType, fl, lc];
t.itemType ← DiscernSpecTGNs[t.itemType, fl, lc];
};
t: PT.AtomTGN => {};
t: PT.BlockTGN => ERROR EH.InternalError["Name in local context bound to block TGN"];
t: PT.ConditionTGN => {};
t: PT.DescriptorTGN => t.itemType ← DiscernSpecTGNs[t.itemType, fl, lc];
t: REF base PT.ElementTGNBody => {};
t:
REF subrange
PT.ElementTGNBody =>
t.body.baseType ← DiscernSpecTGNs[t.body.baseType, fl, lc];
t: PT.InterfaceTGN => ERROR EH.InternalError["Name in local context bound to interface TGN"];
t: PT.LinkTGN => {
t.tgn ← DiscernSpecTGNs[t.tgn, fl, lc];
t.if ← DiscernSpecTGNs[t.if, fl, lc];
};
t: PT.ListTGN => t.elementType ← DiscernSpecTGNs[t.elementType, fl, lc];
t: PT.LongTGN => t.underlyingType ← DiscernSpecTGNs[t.underlyingType, fl, lc];
t: PT.MonitorlockTGN => {};
t: PT.NamedTGN => t.type ← DiscernSpecTGNs[t.type, fl, lc];
t: PT.OpaqueTGN => {};
t: PT.PointerTGN => t.target ← DiscernSpecTGNs[t.target, fl, lc];
t: PT.RealTGN => {};
t: PT.RecordTGN => DiscernSpecTGNsInFrozenFieldList[t.fields, fl, lc];
t: PT.RefTGN => t.target ← DiscernSpecTGNs[t.target, fl, lc];
t: PT.ReferentTGN => t.contents ← DiscernSpecTGNs[t.contents, fl, lc];
t:
PT.RelativeTGN => {
t.base ← DiscernSpecTGNs[t.base, fl, lc];
t.pointer ← DiscernSpecTGNs[t.pointer, fl, lc];
};
t:
PT.SequenceTGN => {
t.tagType ← DiscernSpecTGNs[t.tagType, fl, lc];
t.type ← DiscernSpecTGNs[t.type, fl, lc];
};
t: PT.StringTGN => {};
t: PT.TopTGN => {};
t: PT.BottomTGN => {};
t:
PT.TransferTGN => {
DiscernSpecTGNsInFrozenFieldList[t.arguments, fl, lc];
DiscernSpecTGNsInFrozenFieldList[t.results, fl, lc];
};
t: PT.UnspecifiedTGN => {};
t: PT.VarTGN => t.target ← DiscernSpecTGNs[t.target, fl, lc];
t:
PT.VariantPartTGN => {
t.tagType ← DiscernSpecTGNs[t.tagType, fl, lc];
DiscernSpecTGNsInFrozenUnionList[t.types, fl, lc];
};
t: PT.ZoneTGN => {};
ENDCASE => ERROR;
RETURN [tgn];
END;
DiscernSpecTGNsInFrozenFieldList:
PROC [ffl: FrozenFieldListNode, fl: FieldListNode, lc: LocalContextNode] =
BEGIN
DiscernSpecTGNsInFieldList[ffl.cells, fl, lc];
END;
DiscernSpecTGNsInFieldList:
PROC [arg: FieldListNode, fl: FieldListNode, lc: LocalContextNode] =
BEGIN
FOR cell:
PT.FieldListCell ← arg.first, cell.next
WHILE (cell #
NIL)
DO
WITH cell.node
SELECT
FROM
f: REF typeDecl FieldNodeBody => f.type ← DiscernSpecTGNs[f.type, fl, lc];
f: REF constant FieldNodeBody => f.type ← DiscernSpecTGNs[f.type, fl, lc];
f: REF variable FieldNodeBody => f.type ← DiscernSpecTGNs[f.type, fl, lc];
f: REF recordField FieldNodeBody => f.type ← DiscernSpecTGNs[f.type, fl, lc];
ENDCASE => ERROR;
ENDLOOP;
END;
DiscernSpecTGNsInFrozenUnionList:
PROC [ful:
PT.FrozenUnionList, fl: FieldListNode, lc: LocalContextNode] =
BEGIN
FOR i:
INT
IN [0..ful.nTypes)
DO
DiscernSpecTGNsInFrozenFieldList[ful[i].fields, fl, lc];
ENDLOOP;
END;
Dependency Graph Primitives
DependencyGraphNode: TYPE = REF DependencyGraphNodeBody;
DependencyGraphNodeBody: PUBLIC TYPE = PT.DependencyGraphNodeBody;
DependencyGraphNodeNode: TYPE = REF DependencyGraphNodeNodeBody;
DependencyGraphNodeNodeBody: PUBLIC TYPE = PT.DependencyGraphNodeNodeBody;
DependencyGraphNodeCell: TYPE = REF DependencyGraphNodeCellBody;
DependencyGraphNodeCellBody: PUBLIC TYPE = PT.DependencyGraphNodeCellBody;
DependencyKind: PUBLIC TYPE = PT.DependencyKind;
CreateDependencyGraph:
PROC [fl: FieldListNode, lc: LocalContextNode]
RETURNS [DependencyGraphNode] =
BEGIN
Create a dependency graph with one node for each interesting quantity in ffl, plus an extra node indicating a runtime or side-effecting value.
dg: DependencyGraphNode ← NEW[DependencyGraphNodeBody ← [lc, NIL]];
AddDGN:
PROC [dgn: DependencyGraphNodeNode] =
BEGIN
dg.roots ← CONS[dgn, dg.roots];
END;
FOR cell:
PT.FieldListCell ← fl.first, cell.next
WHILE (cell #
NIL)
DO
WITH cell.node
SELECT
FROM
c:
REF typeDecl FieldNodeBody => {
do lookups
namedTGN: PT.NamedTGN ← NARROW[c.type.body];
AddDGN[
NEW[DependencyGraphNodeNodeBody ←
[TRASH, NIL, NIL, size[cell.node]]]];
IF
ISTYPE[namedTGN.type.body,
PT.ElementTGN]
THEN {
AddDGN[
NEW[DependencyGraphNodeNodeBody ←
[TRASH, NIL, NIL, first[cell.node]]]];
AddDGN[
NEW[DependencyGraphNodeNodeBody ←
[TRASH, NIL, NIL, last[cell.node]]]];
};
};
c:
REF constant FieldNodeBody => {
AddDGN[
NEW[DependencyGraphNodeNodeBody ←
[TRASH, NIL, NIL, value[cell.node]]]];
};
c:
REF variable FieldNodeBody => {
AddDGN[
NEW[DependencyGraphNodeNodeBody ←
[TRASH, NIL, NIL, value[cell.node]]]];
};
ENDCASE =>
ERROR EH.InternalError["Bad kind of field for dependency analysis"];
ENDLOOP;
AddDGN[NEW[DependencyGraphNodeNodeBody ← [TRASH, NIL, NIL, runtime[]]]];
RETURN[dg];
END;
FakeDamageDependencyGraph:
PUBLIC
PROC [dg: DependencyGraphNode]
RETURNS [DependencyGraphNode] = {
RETURN [dg] };
FindDGN:
PROC [dg: DependencyGraphNode, id:
GEN.IdNode, kind: DependencyKind]
RETURNS [found:
BOOLEAN, dgn: DependencyGraphNodeNode] =
BEGIN
FOR roots:
LIST
OF DependencyGraphNodeNode ← dg.roots, roots.rest
WHILE (roots #
NIL)
DO
dgn: DependencyGraphNodeNode ← roots.first;
IF (dgn.dependencyKind = kind)
AND (
WITH dgn
SELECT
FROM
d: REF value DependencyGraphNodeNodeBody => Rope.Equal[id.text, d.of.name.text],
d: REF first DependencyGraphNodeNodeBody => Rope.Equal[id.text, d.of.name.text],
d: REF last DependencyGraphNodeNodeBody => Rope.Equal[id.text, d.of.name.text],
d: REF size DependencyGraphNodeNodeBody => Rope.Equal[id.text, d.of.name.text],
d: REF runtime DependencyGraphNodeNodeBody => TRUE,
ENDCASE => ERROR
)
THEN RETURN[TRUE, dgn];
ENDLOOP;
RETURN[FALSE, NIL];
END;
AddDependency:
PROC [dgn1, dgn2: DependencyGraphNodeNode] =
BEGIN
Add the dependency "dgn1 depends on dgn2"
cell: DependencyGraphNodeCell ← NEW[DependencyGraphNodeCellBody ← [dgn2, NIL]];
SIGNAL EH.Message[IO.PutFR["Adding dependency: %g depends on %g", IO.rope[RopeFromDGN[dgn1]], IO.rope[RopeFromDGN[dgn2]]]];
IF dgn1.first =
NIL
THEN dgn1.first ← cell
ELSE dgn1.last.next ← cell;
dgn1.last ← cell;
END;
AddFirstDependency:
PUBLIC
PROC [dg: DependencyGraphNode, dgn1: DependencyGraphNodeNode, id:
GEN.IdNode]
RETURNS [DependencyGraphNode] =
BEGIN
found: BOOLEAN;
dgn2: DependencyGraphNodeNode;
[found, dgn2] ← FindDGN[dg, id, first];
IF found
THEN AddDependency[dgn1, dgn2]
ELSE [] ← BD.DemandTypeDeclarationField[BD.LookupNameInContextRib[id, dg.lc.parentRib]];
if "first[id]" is not in dg, then just demand that id names a type. If id does name a type, then this type must be in a higher context, and its size must therefore already be known. If id doesn't name a type, then the call to LookupTypeNameInLocalContext will cause an error. If it turns out that id is in dg, but first[id] isn't, then something else had better catch the error. (the expression compiler?) but it shouldn't affect the validity of the dependency graph. VERIFY THIS!!! OR FIX IT!!!
RETURN [dg];
END;
AddLastDependency:
PUBLIC
PROC [dg: DependencyGraphNode, dgn1: DependencyGraphNodeNode, id:
GEN.IdNode]
RETURNS [DependencyGraphNode] =
BEGIN
found: BOOLEAN;
dgn2: DependencyGraphNodeNode;
[found, dgn2] ← FindDGN[dg, id, last];
IF found
THEN AddDependency[dgn1, dgn2]
ELSE [] ← BD.DemandTypeDeclarationField[BD.LookupNameInContextRib[id, dg.lc.parentRib]];
if "last[id]" is not in dg, then just demand that id names a type. If id does name a type, then this type must be in a higher context, and its size must therefore already be known. If id doesn't name a type, then the call to LookupTypeNameInLocalContext will cause an error. If it turns out that id is in dg, but first[id] isn't, then something else had better catch the error. (the expression compiler?) but it shouldn't affect the validity of the dependency graph. VERIFY THIS!!! OR FIX IT!!!
RETURN [dg];
END;
AddSizeDependency:
PUBLIC
PROC [dg: DependencyGraphNode, dgn1: DependencyGraphNodeNode, id:
GEN.IdNode]
RETURNS [DependencyGraphNode] =
BEGIN
found: BOOLEAN;
dgn2: DependencyGraphNodeNode;
[found, dgn2] ← FindDGN[dg, id, size];
IF found
THEN AddDependency[dgn1, dgn2]
ELSE [] ← BD.DemandTypeDeclarationField[BD.LookupNameInContextRib[id, dg.lc.parentRib]];
if "size[id]" is not in dg, then just demand that id names a type. If id does name a type, then this type must be in a higher context, and its size must therefore already be known. If id doesn't name a type, then the call to LookupTypeNameInLocalContext will cause an error.
RETURN [dg];
END;
AddValueDependency:
PUBLIC
PROC [dg: DependencyGraphNode, dgn1: DependencyGraphNodeNode, id:
GEN.IdNode]
RETURNS [DependencyGraphNode] =
BEGIN
found: BOOLEAN;
dgn2: DependencyGraphNodeNode;
[found, dgn2] ← FindDGN[dg, id, value];
IF found
THEN AddDependency[dgn1, dgn2]
ELSE {
pfd: ParameterizedFieldDescriptorNode;
tgn: TypeGraphNodeNode;
[pfd, tgn] ← BD.GetPathToName[dg.lc, id];
IF NOT BD.Static[BD.CompileLValueIntoRValue[pfd, dg.lc]]
THEN dg ← AddRuntimeDependency[dg, dgn1];
dg ← AddRuntimeDependency[dg, dgn1]; -- FIX ME!
};
RETURN [dg];
END;
AddRuntimeDependency:
PUBLIC
PROC [dg: DependencyGraphNode, dgn1: DependencyGraphNodeNode]
RETURNS [DependencyGraphNode] =
BEGIN
found: BOOLEAN;
dgn2: DependencyGraphNodeNode;
[found, dgn2] ← FindDGN[dg, NIL, runtime];
IF NOT found THEN ERROR;
AddDependency[dgn1, dgn2];
RETURN [dg];
END;
ShowDependencyGraph:
PUBLIC PROC [on:
IO.
STREAM, nest:
INT, dg: DependencyGraphNode] =
BEGIN
FOR roots:
LIST
OF DependencyGraphNodeNode ← dg.roots, roots.rest
WHILE (roots #
NIL)
DO
dgn: DependencyGraphNodeNode ← roots.first;
IF dgn.dependencyKind # runtime
THEN {
IO.PutF[on, "%g depends on ", IO.rope[RopeFromDGN[dgn]]];
IF dgn.first =
NIL
THEN IO.PutF[on, "nothing"]
ELSE
FOR cell: DependencyGraphNodeCell ← dgn.first, cell.next
WHILE (cell #
NIL)
DO
IO.PutF[on, "%g", IO.rope[RopeFromDGN[cell.dependsOn]]];
IF cell.next # NIL THEN IO.PutF[on, ", "];
ENDLOOP;
IO.PutF[on, "\n"];
};
ENDLOOP;
RopeFromDGN:
PROC [dgn: DependencyGraphNodeNode]
RETURNS [Rope.
ROPE] =
BEGIN
RETURN [
WITH dgn
SELECT
FROM
d:
REF value DependencyGraphNodeNodeBody =>
IO.PutFR["value of %g", IO.rope[d.of.name.text]],
d:
REF first DependencyGraphNodeNodeBody =>
IO.PutFR["FIRST[%g]", IO.rope[d.of.name.text]],
d:
REF last DependencyGraphNodeNodeBody =>
IO.PutFR["LAST[%g]", IO.rope[d.of.name.text]],
d:
REF size DependencyGraphNodeNodeBody =>
IO.PutFR["SIZE[%g]", IO.rope[d.of.name.text]],
d:
REF runtime DependencyGraphNodeNodeBody =>
"runtime state"
ENDCASE => ERROR
];
END;
Topological Sort
WalkDependencyGraph:
PROC [dg: DependencyGraphNode, nodeProc:
PROC [DependencyGraphNodeNode]] =
BEGIN
Perform a topological sort on dg. Apply nodeProc to each node of dg, applying nodeProc to a node n only after having applied it to all the nodes that n depends upon. Signal an error and return immediately if a cycle is detected.
FOR rootList:
LIST
OF DependencyGraphNodeNode ← dg.roots, rootList.rest
WHILE (rootList #
NIL)
DO
rootList.first.visited ← FALSE;
ENDLOOP;
FOR rootList:
LIST
OF DependencyGraphNodeNode ← dg.roots, rootList.rest
WHILE (rootList #
NIL)
DO
VisitNode[rootList.first, NIL, nodeProc];
ENDLOOP;
END;
VisitNode:
PROC [node: DependencyGraphNodeNode, path:
LIST
OF DependencyGraphNodeNode, nodeProc:
PROC [DependencyGraphNodeNode]] =
BEGIN
IF node.visited THEN RETURN;
IF NodeIsInPath[node, path]
THEN {
ros: IO.STREAM ← IO.ROS[];
ros.PutF["Cycle in dependency graph: %g", IO.rope[RopeFromDGN[node]]];
FOR p:
LIST
OF DependencyGraphNodeNode ← path, p.rest
WHILE (p #
NIL)
DO
ros.PutF[" ← %g", IO.rope[RopeFromDGN[p.first]]];
IF p.first = node THEN EXIT;
ENDLOOP;
ERROR EH.FatalError[0, ros.RopeFromROS[]];
};
FOR cell: DependencyGraphNodeCell ← node.first, cell.next
WHILE (cell #
NIL)
DO
VisitNode[cell.dependsOn, CONS[node, path], nodeProc];
ENDLOOP;
nodeProc[node];
node.visited ← TRUE;
END;
NodeIsInPath:
PROC [dgn: DependencyGraphNodeNode, path:
LIST
OF DependencyGraphNodeNode]
RETURNS [
BOOLEAN] =
BEGIN
Return TRUE if dgn is an element of path, FALSE if it isn't.
FOR p:
LIST
OF DependencyGraphNodeNode ← path, p.rest
WHILE (p #
NIL)
DO
IF p.first = dgn THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;
NullNodeProc:
PROC [dgn: DependencyGraphNodeNode] =
BEGIN
SIGNAL EH.Message[IO.PutFR["Doing DGN %g", IO.rope[RopeFromDGN[dgn]]]];
END;
DependsOnRuntimeState:
PROC [dgn: DependencyGraphNodeNode]
RETURNS [
BOOLEAN] =
BEGIN
Return TRUE if there is a path from dgn to a runtime DGN, FALSE otherwise.
IF dgn.dependencyKind = runtime THEN RETURN [TRUE];
FOR cell: DependencyGraphNodeCell ← dgn.first, cell.next
WHILE (cell #
NIL)
DO
IF DependsOnRuntimeState[cell.dependsOn] THEN RETURN [TRUE];
ENDLOOP;
RETURN [FALSE];
END;
AddDeclarationsToLocalContext: PUBLIC PROC [fl: BD.FieldListNode, lc: LocalContextNode, cs: BD.CompilerStateNode] RETURNS [LocalContextNode] = BEGIN
fl should have been accumulated by calls to AddDeclarationToFieldList. At this point, we have a field list which contains type graph trees (no names looked up yet). This procedure looks up all the names referenced in fl, links them up, performs dependency analysis, and stuffs the resulting field list into the local context.
This should eventually be merged with FreezeLocalContext.
ffl: FrozenFieldListNode ← FreezeFieldList[lc, fl].ffl;
block: TypeGraphNodeNode ← CreateBlockTGN[lc, ffl].tgn;
lc.contents ← NEW[PT.LocalContextContentsBody ← [frozen[block]]];
RETURN [lc];
END;
moved to SaffronContextCreateCTImpl
MakeFieldListFromDecList: PUBLIC PROC [decls: AT.DecListNode, lc: LocalContextNode, cs: BD.CompilerStateNode] RETURNS [BD.FieldListNode, LocalContextNode] = BEGIN
fl: BD.FieldListNode;
lc1: LocalContextNode;
[fl, lc1] ← decls.procs.AddDeclarationsToFieldList[
decls, BD.CreateEmptyFieldList[], lc, cs];
link em up
dependency analysis
RETURN [fl, lc];
END;
END.