<> <> <> <<>> 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]~ <> 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; <> <> <<(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, lc] _ decls.procs.AddDeclarationsToFieldList[decls, BD.CreateEmptyFieldList[], lc, cs];>> <<[lc, ffl] _ BD.FreezeFieldList[lc, fl];>> <<[lc, block] _ BD.CreateBlockTGN[lc, ffl];>> <> <<>> <> <<>> <> <<>> <> <<>> <> <<>> <> <> <> <> <> <> <<>> <> <> <> <>> <> <> <> <> <<[field.value, lc] _ AT.CompileAndTypeCheckExpression[expNode, lc, cs, targetType];>> <<};>> < {};>> < >> <> < >> <> <> <> <> <> <> <> < {>> <> <<[e.body.firstElement, lc] _ AT.CompileAndTypeCheckExpression[expNode, lc, cs, e.body.baseType];>> <<};>> < {>> <> <<};>> < ERROR EH.InternalError["should not be dependency-analyzing this kind of element type"];>> <<};>> < >> <> <> <> <> <> <> <> < {>> <> <<[e.body.lastElement, lc] _ AT.CompileAndTypeCheckExpression[expNode, lc, cs, e.body.baseType];>> <<};>> < {>> <> <<};>> < ERROR EH.InternalError["should not be dependency-analyzing this kind of element type"];>> <<};>> <> <> <> <> <> <<>> <> <> <> <> <<(Can constants be initialized to trash? They probably can!)>> <> <> <> <> <> <<>> <> <> <> < {};>> < {>> <> < {};>> < {>> <<[field.value, lc] _ AT.CompileAndTypeCheckExpression[value.parseTree, lc, cs, field.type];>> <<};>> < {};>> < ERROR EH.InternalError["a"];>> <<};>> < {>> <> < {>> <> <> <<};>> < {>> <<[field.initialValue, lc] _ AT.CompileAndTypeCheckExpression[initialValue.parseTree, lc, cs, field.type];>> <<};>> < {};>> < ERROR EH.InternalError["b"];>> <<};>> < ERROR EH.InternalError["c"];>> <> <> <<>> <> <<>> <> <<>> <> <> 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.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; 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; <> 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}; < >> <> <> <> <> <> <> <> <> < RETURN[f.type];>> < ERROR EH.FatalError[stgn.idParam.position, "Mumblefrotz in interface is not a type."];>> <<}>> <> <> <> <<};>> ENDCASE => ERROR EH.FatalError[0, "Bad type underlying specianated tgn"]; <> 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.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; 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; <> 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 <> 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 => { <> 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 <> cell: DependencyGraphNodeCell _ NEW[DependencyGraphNodeCellBody _ [dgn2, NIL]]; <> 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]]; <> 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]]; <> 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]]; <> 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, tgn] _ BD.GetPathToName[dg.lc, id];>> <> <> 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; END; 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; <> BuildDependencyGraph: PUBLIC PROC [fl: FieldListNode, lc: LocalContextNode] RETURNS [DependencyGraphNode] = BEGIN dg: DependencyGraphNode _ CreateDependencyGraph[fl, lc]; FOR cell: PT.FieldListCell _ fl.first, cell.next WHILE (cell # NIL) DO WITH cell.node SELECT FROM c: REF typeDecl FieldNodeBody => { dgn1: DependencyGraphNodeNode _ FindDGN[dg, cell.node.name, size].dgn; typeExp: AT.TypeExpNode _ c.parseTree; namedTGN: PT.NamedTGN _ NARROW[c.type.body]; IF typeExp = NIL -- is it an opaque type? THEN NULL -- eventually, we have to hook into the opaque type's OptSize.... ELSE dg _ typeExp.procs.AddSizeDependencies[typeExp, dg, dgn1]; IF ISTYPE[namedTGN.type.body, PT.ElementTGN] THEN { <> elementTGN: PT.ElementTGN _ NARROW[namedTGN.type.body]; dgnf: DependencyGraphNodeNode _ FindDGN[dg, cell.node.name, first].dgn; dgnl: DependencyGraphNodeNode _ FindDGN[dg, cell.node.name, last].dgn; dg _ typeExp.procs.AddFirstDependencies[typeExp, dg, dgnf]; dg _ typeExp.procs.AddLastDependencies[typeExp, dg, dgnl]; }; }; c: REF constant FieldNodeBody => { dgn1: DependencyGraphNodeNode _ FindDGN[dg, cell.node.name, value].dgn; initialization: AT.InitializationNode _ c.initialization.node; dg _ initialization.procs.AddValueDependencies[initialization, dg, dgn1]; <> <> }; c: REF variable FieldNodeBody => { dgn1: DependencyGraphNodeNode _ FindDGN[dg, cell.node.name, value].dgn; dg _ AddRuntimeDependency[dg, dgn1]; }; ENDCASE => ERROR EH.InternalError["Bad kind of field for dependency analysis"]; ENDLOOP; RETURN [dg]; END; <<>> <> WalkDependencyGraph: PROC [dg: DependencyGraphNode, nodeProc: PROC [DependencyGraphNodeNode]] = BEGIN <> 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 <> 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 <> 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; <> <> <> <> <> <> <> <> <<>> <> <<>> <> <> <> <<[fl, lc1] _ decls.procs.AddDeclarationsToFieldList[>> <> <> <> <> <> END.