build_type_graph.sa

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


class BUILD_TYPE_GRAPH < $BUILD_TYPE_GRAPH 
class BUILD_TYPE_GRAPH < $BUILD_TYPE_GRAPH is
   -- This phase builds the type graph of the types found above. 
   -- It causes errors if there are loops.

   include CS_COMPONENT;
   
   create(p:PROG):SAME is
      r::=new; r.prog:=p; return r end;-- BUILD_TYPE_GRAPH::prog
   
   build_graphs is
      -- Build the type graphs for all types in the program.
      prog.tp_graph.make_family_members;-- BUILD_TYPE_GRAPH::prog PROG::tp_graph TP_GRAPH::make_family_members
      loop tp:$TP:=prog.tp_done.elt!;-- BUILD_TYPE_GRAPH::prog PROG::tp_done FSET{1}::elt!
	 typecase tp
	 when TP_CLASS then
	    ig1::=prog.tp_graph.get_anc(tp);-- BUILD_TYPE_GRAPH::prog PROG::tp_graph TP_GRAPH::get_anc
	    ig2::=prog.tp_graph.get_des(tp)-- BUILD_TYPE_GRAPH::prog PROG::tp_graph TP_GRAPH::get_des
	 else end end;
      prog.tp_graph_abs_des.do_tbl;-- BUILD_TYPE_GRAPH::prog PROG::tp_graph_abs_des TP_GRAPH_ABS_DES::do_tbl
      if prog.show_graphs then-- BUILD_TYPE_GRAPH::prog PROG::show_graphs
	 anc_out; des_out; abs_des_out end end;-- BUILD_TYPE_GRAPH::anc_out BUILD_TYPE_GRAPH::des_out BUILD_TYPE_GRAPH::abs_des_out

   private anc_out is
      -- The ancestors of all types in `tp_done' with some.
      loop tp:$TP:=prog.tp_done.elt!;-- BUILD_TYPE_GRAPH::prog PROG::tp_done FSET{1}::elt!
	 at:FSET{TP_CLASS}:=void;
	 typecase tp
	 when TP_CLASS then at:=prog.tp_graph.get_anc(tp) -- BUILD_TYPE_GRAPH::prog PROG::tp_graph TP_GRAPH::get_anc
	 else end;
	 if ~void(at) then-- BOOL::not
	    #OUT + "Ancestors of " + tp.str + "=";-- OUT::create OUT::plus OUT::plus OUT::plus
	    loop #OUT + " ".separate!(at.elt!.str) end;-- OUT::create OUT::plus STR::separate! FSET{1}::elt! TP_CLASS::str
	    #OUT + "\n" end end;-- OUT::create OUT::plus
      #OUT + "\n" end;-- OUT::create OUT::plus
      
   private des_out is
      -- The descendants of all types in `tp_done' with some.
      loop tp:$TP:=prog.tp_done.elt!;-- BUILD_TYPE_GRAPH::prog PROG::tp_done FSET{1}::elt!
	 at:FSET{$TP}:=void;
	 typecase tp
	 when TP_CLASS then at:=prog.tp_graph.get_des(tp) -- BUILD_TYPE_GRAPH::prog PROG::tp_graph TP_GRAPH::get_des
	 else end;
	 if ~void(at) then-- BOOL::not
	    #OUT + "Descendants of " + tp.str + "=";-- OUT::create OUT::plus OUT::plus OUT::plus
	    loop #OUT + " ".separate!(at.elt!.str) end;-- OUT::create OUT::plus STR::separate! FSET{1}::elt!
	    #OUT + "\n" end end;-- OUT::create OUT::plus
      #OUT + "\n" end;-- OUT::create OUT::plus
      
   private abs_des_out is
      -- The concrete descendants of abstract types.
      loop p::=prog.tp_graph_abs_des.tbl.pairs!;-- BUILD_TYPE_GRAPH::prog PROG::tp_graph_abs_des TP_GRAPH_ABS_DES::tbl FMAP{2}::pairs!
	 #OUT + "The abstract type " + p.t1.str +-- OUT::create OUT::plus OUT::plus TUP{2}::t1 TP_CLASS::str
	 " has concrete descendants ";-- OUT::plus
	 loop #OUT + " ".separate!(p.t2.elt!.str) end;-- OUT::create OUT::plus STR::separate! TUP{2}::t2 FSET{1}::elt!
	 #OUT + "\n" end;-- OUT::create OUT::plus
      #OUT + "\n" end;-- OUT::create OUT::plus
   
end; -- class BUILD_TYPE_GRAPH