DIRECTORY AMTypes, Graphs, Rope; TypeGraphs: CEDAR PROGRAM IMPORTS AMTypes, Graphs, Rope = BEGIN ROPE: TYPE = Rope.ROPE; TypeRef: TYPE = REF Type; Type: TYPE = AMTypes.Type; NewTypeVertex: PROC [type: AMTypes.Type] RETURNS [vertex: Graphs.Vertex] = BEGIN vertex _ [ class: typeVertexClass, rep: NEW [Type _ type]] END; ExpandType: PROC [vertex: Graphs.Vertex, Consume: Graphs.EdgeConsumer, filter: Graphs.DirectionFilter _ Graphs.allDirections] --Graphs.ExpandProc-- = { tr: TypeRef = NARROW[vertex.rep]; tc: AMTypes.Class = AMTypes.TypeClass[tr^]; IF filter[Incoming] THEN Graphs.Error[Cant]; IF NOT filter[Outgoing] THEN RETURN; SELECT tc FROM record, structure => BEGIN FOR i: INT IN [1 .. AMTypes.NComponents[tr^]] DO Consume[ [AMTypes.IndexToName[type: tr^, index: i], edgeClass], Outgoing, NewTypeVertex[AMTypes.IndexToType[type: tr^, index: i]] ]; ENDLOOP; END; ref, pointer, longPointer => Consume[["referent", edgeClass], Outgoing, NewTypeVertex[AMTypes.Range[tr^]]]; definition => Consume[["definition", edgeClass], Outgoing, NewTypeVertex[AMTypes.UnderType[tr^]]]; array, sequence, procedure => { Consume[["arg", edgeClass], Outgoing, NewTypeVertex[AMTypes.Domain[tr^]]]; Consume[["result", edgeClass], Outgoing, NewTypeVertex[AMTypes.Range[tr^]]]; }; ENDCASE; }; EnumerateTypeLabels: PROC [vertex: Graphs.Vertex, Consume: Graphs.LabelConsumer, filter: Graphs.DirectionFilter _ Graphs.allDirections] --Graphs.LabelEnumerator-- = { tr: TypeRef _ NARROW[vertex.rep]; tc: AMTypes.Class _ AMTypes.TypeClass[tr^]; IF filter[Incoming] THEN Graphs.Error[Cant]; IF NOT filter[Outgoing] THEN RETURN; SELECT tc FROM record, structure => BEGIN FOR i: INT IN [1 .. AMTypes.NComponents[tr^]] DO Consume[Outgoing, AMTypes.IndexToName[type: tr^, index: i], NIL]; ENDLOOP; END; ref, pointer, longPointer => Consume[Outgoing, "referent", NIL]; definition => Consume[Outgoing, "definition", NIL]; array, sequence, procedure => BEGIN Consume[Outgoing, "arg", NIL]; Consume[Outgoing, "result", NIL]; END; ENDCASE; }; GetNeighbor: PROC [vertex: Graphs.Vertex, filter: Graphs.DirectionFilter _ Graphs.allDirections, edgeLabel, vertexLabel: ROPE _ Graphs.unlabeled, index: INT--origin 1-- _ Graphs.noIndex, goal: Graphs.Vertex _ Graphs.nullVertex] RETURNS [edge: Graphs.Edge, neighbor: Graphs.Vertex] --Graphs.NeighborGetter-- = BEGIN tr: TypeRef = NARROW[vertex.rep]; tc: AMTypes.Class = AMTypes.TypeClass[tr^]; Check: PROC [e: Graphs.Edge, n: Graphs.Vertex, i: Graphs.Index] = { IF index # Graphs.noIndex AND index # i THEN Graphs.Error[BadArgs]; IF edgeLabel # Graphs.unlabeled AND NOT edgeLabel.Equal[NARROW[e.rep]] THEN Graphs.Error[BadArgs]; }; IF filter[Incoming] THEN Graphs.Error[Cant]; IF NOT filter[Outgoing] THEN RETURN [Graphs.nullEdge, Graphs.nullVertex]; IF vertexLabel # Graphs.unlabeled THEN Graphs.Error[BadArgs]; IF goal # Graphs.nullVertex THEN [edge, neighbor] _ Graphs.GetNeighborFromExpand[vertex, filter, edgeLabel, vertexLabel, index, goal]; SELECT tc FROM record, structure => NULL; ref, pointer, longPointer => {Check[["referent", edgeClass], NewTypeVertex[AMTypes.Range[tr^]], 1]; RETURN}; definition => {Check[["definition", edgeClass], NewTypeVertex[AMTypes.UnderType[tr^]], 1]; RETURN}; array, sequence, procedure => NULL; ENDCASE => ERROR; SELECT TRUE FROM index # Graphs.noIndex => { SELECT tc FROM record, structure => { ctr: TypeRef = NEW [Type _ AMTypes.IndexToType[type: tr^, index: index]]; Check[[AMTypes.IndexToName[tr^, index], edgeClass], [ctr, typeVertexClass], index]; }; ref, pointer, longPointer => ERROR; definition => ERROR; array, sequence, procedure => SELECT index FROM 1 => {Check[["arg", edgeClass], NewTypeVertex[AMTypes.Domain[tr^]], 1]}; 2 => {Check[["result", edgeClass], NewTypeVertex[AMTypes.Range[tr^]], 2]}; ENDCASE => Graphs.Error[BadArgs]; ENDCASE => ERROR; }; edgeLabel # Graphs.unlabeled => { SELECT tc FROM record, structure => { i: CARDINAL _ AMTypes.NameToIndex[type: tr^, name: edgeLabel]; ctr: TypeRef _ NEW [Type _ AMTypes.IndexToType[type: tr^, index: i]]; Check[[edgeLabel, edgeClass], [ctr, typeVertexClass], i]; }; ref, pointer, longPointer => ERROR; definition => ERROR; array, sequence, procedure => { edge _ [edgeLabel, edgeClass]; IF edgeLabel.Equal["arg"] THEN Check[edge, NewTypeVertex[AMTypes.Domain[tr^]], 1] ELSE IF edgeLabel.Equal["result"] THEN Check[edge, NewTypeVertex[AMTypes.Range[tr^]], 2] ELSE Graphs.Error[BadArgs]; }; ENDCASE => ERROR; }; ENDCASE => Graphs.Error[Cant]; END; CountTypeNeighbors: PROC [vertex: Graphs.Vertex, filter: Graphs.DirectionFilter _ Graphs.allDirections] RETURNS [neighborCount: INT] --Graphs.NeighborCountProc-- = BEGIN tr: TypeRef _ NARROW[vertex.rep]; tc: AMTypes.Class _ AMTypes.TypeClass[tr^]; IF filter[Incoming] THEN Graphs.Error[Cant]; IF NOT filter[Outgoing] THEN RETURN [0]; SELECT tc FROM record, structure => BEGIN neighborCount _ AMTypes.NComponents[tr^]; END; ref, pointer, longPointer, definition => neighborCount _ 1; array, sequence, procedure => neighborCount _ 2; ENDCASE => neighborCount _ 0; END; typeVertexClass: Graphs.VertexClass _ Graphs.NewVertexClass[[ Expand: ExpandType, EnumerateForLabels: EnumerateTypeLabels, GetNeighbor: GetNeighbor, GetNeighborCount: CountTypeNeighbors ]]; edgeClass: Graphs.EdgeClass _ Graphs.NewEdgeClass[[GetLabel: GetEdgeLabel]]; GetEdgeLabel: PROC [e: Graphs.Edge] RETURNS [l: Graphs.Label] = { l _ NARROW[e.rep]; }; END. HTypeGraphs.Mesa Mike Spreitzer September 27, 1986 3:35:20 pm PDT ΚΪ– "cedar" style˜™Icode™0—J˜KšΟk œ˜ K˜šœ œ˜Kšœ˜—K˜Kš˜K˜Kšœœœ˜K˜Kšœ œœ˜Kšœœ˜K˜šΟn œœœ˜JKš˜šœ ˜ Kšœ˜Kšœœ˜—Kšœ˜—K˜šž œœžœNΟcœ˜—Kšœœ ˜!K˜+Kšœœ˜,Kšœœœœ˜$šœ˜šœ˜šœœœ!˜0šœ˜Kšœ6˜6K˜ Kšœ7˜7Kšœ˜—Kšœ˜—Kšœ˜—Kšœl˜lKšœb˜bšœ˜KšœJ˜JKšœL˜LKšœ˜—Kšœ˜—Kšœ˜—K˜šžœœžœOŸœ˜¦Kšœœ ˜!K˜+Kšœœ˜,Kšœœœœ˜$šœ˜šœ˜šœœœ!˜0Kšœ<œ˜AKšœ˜—Kšœ˜—Kšœ;œ˜@Kšœ.œ˜3šœ˜#Kšœœ˜Kšœœ˜!Kšœ˜—Kšœ˜—Kšœ˜—K˜š ž œœhœŸ œ<œ.Ÿœ˜΄Kš˜Kšœœ ˜!K˜+šžœœ8˜CKšœœ œ˜CKš œœœœ œ˜bK˜—Kšœœ˜,Kšœœœœ&˜IKšœ œ˜=Kšœœf˜†šœ˜Kšœœ˜Kšœdœ˜lKšœ[œ˜cKšœœ˜#Kšœœ˜—šœœ˜šœ˜šœ˜šœ˜Kšœœ7˜IKšœS˜SKšœ˜—Kšœœ˜#Kšœœ˜šœœ˜/KšœH˜HKšœJ˜JKšœ˜!—Kšœœ˜—K˜—šœ!˜!šœ˜šœ˜Kšœœ3˜>Kšœœ3˜EKšœ9˜9Kšœ˜—Kšœœ˜#Kšœœ˜šœ˜K˜Kšœœ3˜QKšœœœ2˜XKšœ˜Kšœ˜—Kšœœ˜—K˜—Kšœ˜—Kšœ˜—K˜š žœœPœœŸœ˜£Kš˜Kšœœ ˜!K˜+Kšœœ˜,Kšœœœœ˜(šœ˜šœ˜Kšœ)˜)Kšœ˜—Kšœ;˜;Kšœ0˜0Kšœ˜—Kšœ˜—K˜šœ=˜=Kšžœ ˜Kšžœ˜(Kšž œ˜Kšžœ˜$K˜—K˜Kšœ3žœ˜LK˜šž œœœ˜AKšœœ˜K˜—K˜Kšœ˜—…—: