lbld_digraph.sa

 
---------------------------> Sather 1.1 source file <--------------------------


abstract class $LBLD_DIGRAPH{NTP,NLB,ELB} < $DIGRAPH{NTP} 
abstract class $LBLD_DIGRAPH{NTP,NLB,ELB} < $DIGRAPH{NTP} is
   -- A digraph with node (NLB) and edge (ELB) labels 

   -- Reading routines
   node_label(n: NTP): NLB;
   edge_label(e: DIEDGE{NTP}): ELB;

   -- Writing routines
   set_node_label(n: NTP, w: NLB);
   set_edge_label(e: DIEDGE{NTP},w: ELB);

   outgoing!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP;
   -- Yield the outgoing nodes for "n" and also provide the node and
   -- edge labels at the same time. It might be much more efficient
   -- to yield these together, in order, than to have to look up the node and
   -- edge labels separately.
   
   incoming!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP;
   -- Similar to the outgoing iter, but yield all incoming nodes into "n"
      
   connect(src,dest:NTP,w: ELB);
   -- It is still possible to connect nodes without specifying a label
   
   add_node_labelled(w: NLB): NTP;
   -- It is still possible to use the digraph "add_node" function
   -- to  not specify a node label
   
   has_node_label(n: NTP): BOOL;
   -- Return true if the node "n" has a label

   has_edge_label(e:DIEDGE{NTP}): BOOL;
   -- Return true if the edge "e" has a label
   
   are_all_nodes_labelled: BOOL;
   -- Returns true if all the nodes have labels
   
   are_all_edges_labelled: BOOL;
   -- Returns true if all edges have labels
   
end;


partial class LBLD_DIGRAPH_INCL{NTP,NLB,ELB} 
partial class LBLD_DIGRAPH_INCL{NTP,NLB,ELB} is
   -- A mixin that associates labels with the nodes/edges of a graph

   private attr node_labels: MAP{NTP,NLB};
   private attr edge_labels: MAP{DIEDGE{NTP},ELB};
   
   stub connect(n1,n2: NTP);
   stub add_node(n: NTP);
   stub add_node: NTP;
   stub node!: NTP;
   stub edge!: DIEDGE{NTP};
   stub incoming!(n: NTP): NTP;
   stub outgoing!(n: NTP): NTP;

   private init_labels pre ~void(self) is
      -- This routine initializes the label datastructures.
      -- Since this class is meant to be used by inclusion, this
      -- routine should be called after the class has been created
      node_labels := #;
      edge_labels := #;
   end;
   
   has_node_label(n:NTP): BOOL is 
      return node_labels.has_ind(n);
   end;

   has_edge_label(e:DIEDGE{NTP}): BOOL is 
      return edge_labels.has_ind(e);
   end;

   node_label(n:NTP): NLB is
      -- Return void if the node is not labelled
      if ~node_labels.has_ind(n) then return void
      else return node_labels[n] end;
   end;
   
   edge_label(e:DIEDGE{NTP}): ELB is
      -- Return the edge label if it exists, void otherwise
      if ~edge_labels.has_ind(e) then return void
      else return edge_labels[e] end;
   end;
   
   node!(out label: NLB): NTP is
      -- Yield successive nodes and set the corresponding value of "label"
      -- to the node's label (or void, if it is not labelled)
      loop n ::= node!; label := node_label(n); yield n; end;
   end;
   
   edge!(out label: ELB): DIEDGE{NTP} is
      -- Yield successive edges and set the corresponding value of "label"
      -- to be the edge's label, or void otherwise
      loop e ::= edge!; label := edge_label(e); yield e; end;
   end;

   incoming!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP is
      -- Yield successive incoming nodes to node "n". Set the out parameter
      -- "a_node_label" to be the corresponding label of the incoming node
      -- and "a_edge_label" to be the label of the corresponding edge from
      -- the incoming node to "n"
      loop 
	 inc ::= incoming!(n);
	 a_node_label := node_label(inc); 
	 a_edge_label := edge_label(#DIEDGE{NTP}(inc,n));
	 yield inc;
      end;
   end;

   outgoing!(once n: NTP, out a_node_label: NLB, out a_edge_label: ELB): NTP is
      -- See incoming!
      loop 
	 outg ::= outgoing!(n);
	 a_node_label := node_label(outg); 
	 a_edge_label := edge_label(#DIEDGE{NTP}(n,outg));
	 yield outg;
      end;
   end;

   connect(n1,n2: NTP,w: ELB) is
      -- Add an edge from "n1" to "n2" with the edge label "w"
      connect(n1,n2);
      set_edge_label(#DIEDGE{NTP}(n1,n2),w);
   end;
   
   add_node(n: NTP,w: NLB) is
      -- Add the node "n" to the graph with the node label "w"
      add_node(n);
      set_node_label(n,w);
   end;

   add_node_labelled(w: NLB): NTP is
      -- Add the node "n" to the graph with the node label "w"
      n ::= add_node;
      set_node_label(n,w);
      return n;
   end;

   add_node(n: NTP,l: NLB): SAME is add_node(n,l); return self end;
      -- Version of "add_node" that returns self for convenience in 
      -- chaining operations

   connect(s,d: NTP,l:ELB): SAME is connect(s,d,l); return self end;
      -- Version of "connect" that returns self for convenience in 
      -- chaining connections
      
   set_node_label(n: NTP,w: NLB) is 
      -- Set the label of node "n" to "w"
      node_labels[n] := w; 
   end;
   
   set_edge_label(e: DIEDGE{NTP},w: ELB) is 
      -- Set the label of edge "e" to "w"
      edge_labels[e] := w; 
   end;
   
   are_all_nodes_labelled: BOOL is
      -- Return true if all the nodes in self have a label
      loop n ::= node!;
	 if ~node_labels.has_ind(n) then return false end;
      end;
      return true;
   end; 
   
   are_all_edges_labelled: BOOL is
      -- Return true if all the edges in self are labelled
      loop e ::= edge!;
	 if ~edge_labels.has_ind(e) then return false end;
      end;
      return true;
   end;

   str: STR is
      -- Print out the graph using the bound routine "f"
      -- for the nodes   
      res ::= #FSTR("");
      loop n ::= node!;
	 -- if void(n) then res := res + "void  : ";
	 -- Should never have "void" nodes in the graph.
	 -- If they are value types, then void might be 0 or something useful
	 res := res + ob_str(n); 
	 if has_node_label(n) then res:=res+"["+ob_str(node_label(n))+"]" end;
	 res := res + "<-";
	 loop inc ::= incoming!(n);
	    inc_edge ::= #DIEDGE{NTP}(inc,n);
	    if has_edge_label(inc_edge) then
	       inc_lbl ::= edge_label(inc_edge);
	       res:=res + ",".separate!(ob_str(inc)+"["+ob_str(inc_lbl)+"]"); 
	    else
	       res:=res + ",".separate!(ob_str(inc)+"[]"); 
	    end;
	 end;
	 res := res+"\n";		-- End of another row of edges
      end; -- All graph nodes
      return(res.str);
   end;   
   
   private ob_str(n: $OB): STR is
      typecase n
      when $STR then return n.str
      else return "" end;

   end;
   
end;


class LBLD_DIGRAPH{NTP,NLB,ELB} < $LBLD_DIGRAPH{NTP,NLB,ELB} 
class LBLD_DIGRAPH{NTP,NLB,ELB} < $LBLD_DIGRAPH{NTP,NLB,ELB} is
   -- A standard labelled digraph, where NTP represents the type 
   -- of the nodes, NLB represents the node labels (which need not
   -- be unique) and ELB represents the type of the edge labels
   -- which also need not be unquie
   include DIGRAPH{NTP} create->private old_create,str->n;
   include LBLD_DIGRAPH_INCL{NTP,NLB,ELB};
   
   create: SAME is res ::= old_create; res.init_labels; return res; end;
   
end;