TypeGraphs.Mesa
Mike Spreitzer September 27, 1986 3:35:20 pm PDT
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.