------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  This Ada package was automatically generated by the software engineering
--tool Platypus
--  see http://cassoulet.univ-brest.fr/mme
--
--  Any modification of this file will be lost.
--  Please see the "platypus" directory instead : it contains the Cheddar's
--  model and its meta-model.
------------------------------------------------------------------------------

------------------------------------------------------------------------------
-- Cheddar is a free real time scheduling tool.
-- This program provides services to automatically check temporal constraints
-- of real time tasks.
--
-- Copyright (C) 2002-2009   Frank Singhoff
-- Cheddar is developed by the LISYC Team, University of Brest
--
-- This program is free software; you can redistribute it and/or modify
-- it under the terms of the GNU General Public License as published by
-- the Free Software Foundation; either version 2 of the License, or
-- (at your option) any later version.
--
-- This program is distributed in the hope that it will be useful,
-- but WITHOUT ANY WARRANTY; without even the implied warranty of
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
-- GNU General Public License for more details.
--
-- You should have received a copy of the GNU General Public License
-- along with this program; if not, write to the Free Software
-- Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
--
--
-- Contact : cheddar@listes.univ-brest.fr
--      To post to this mailing list, you must be subscribed
--      (see http//beru.univ-brest.fr/~singhoff/cheddar for details)
--
------------------------------------------------------------------------------
------------------------------------------------------------------------------

with primitive_xml_strings; use primitive_xml_strings;

with unbounded_strings; use unbounded_strings;
with debug;             use debug;

with Ada.Strings.Unbounded.Text_IO; use Ada.Strings.Unbounded.Text_IO;

use unbounded_strings.unbounded_string_list_package;

with Tasks; use Tasks;

with task_dependencies; use task_dependencies;
use task_dependencies.half_dep_set;

with task_set; use task_set;

with Buffers; use Buffers;

with Generic_Graph; use Generic_Graph;
use Generic_Graph.Edge_Lists_Package;
use Generic_Graph.Node_Lists_Package;
with Generic_Graph.extended; use Generic_Graph.extended;

with systems; use systems;

with debug; use debug;

with Messages; use Messages;

with Dependencies; use Dependencies;

with Resources; use Resources;

with Processors; use Processors;

package body DP_Graph.extended is

   -- --------= Task_Node =--------

   procedure add_node
     (obj     : in out graph;
      n       : in     task_node_ptr;
      succeed :    out Boolean)
   is
   begin
      add_generic_node (obj, generic_node_ptr (n), succeed);
   end add_node;

   procedure initialize (obj : in out task_node_ptr) is
   begin
      obj := new task_node;
      Initialize (generic_node'class (obj.all));
      obj.TaskRef := null;
      obj.Kind    := periodic_type;
      -- obj.Cpu     := Empty_String;
   end initialize;

   function copy (obj : in task_node) return task_node_ptr is
      new_task_node : task_node_ptr;
   begin
      new_task_node := new task_node'(obj);
      return (new_task_node);
   end copy;

   function copy (obj : in task_node_ptr) return task_node_ptr is
   begin
      if (obj = null) then
         raise building_graph_exception;
      else
         return copy (obj);
      end if;
   end copy;

   function get_name (obj : in task_node) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function get_name (obj : in task_node_ptr) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function type_of (obj : in task_node) return unbounded_string_list is
      list : unbounded_string_list;
      s    : unbounded_string_ptr;
   begin
      initialize (list);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_NODE");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("DP_GRAPH.TASK_NODE");
      add (list, s);

      return list;
   end type_of;

   function xml_string (obj : in task_node) return Unbounded_String is
      result : Unbounded_String;
   begin
      result := "<Task_Node id=""" & get_name (obj) & """ >" & unbounded_lf;
      Build_Attributes_XML_String (obj, result);
      result := result & "</Task_Node>" & unbounded_lf;
      return (result);
   end xml_string;

   function create_node_from_task
     (obj : in generic_task_ptr) return task_node_ptr
   is
      res : task_node_ptr;
   begin
      initialize (res);
      res.all.Id                 := obj.all.cheddar_private_id;
      res.all.cheddar_private_id := obj.all.cheddar_private_id;
      res.all.TaskRef            := obj;
      res.all.Kind               := obj.all.task_type;
      put_debug ("Node Id" & res.all.Id);
      put_debug ("Task Id" & obj.all.cheddar_private_id);
      return res;
   end create_node_from_task;

   -- --------= Time_Triggered_Communication_Edge =--------

   procedure add_edge
     (obj     : in out graph;
      e       : in     time_triggered_communication_edge_ptr;
      succeed :    out Boolean)
   is
   begin
      add_generic_edge (obj, generic_edge_ptr (e), succeed);
   end add_edge;

   procedure initialize (obj : in out time_triggered_communication_edge) is
   begin
      Initialize (generic_edge (obj));
      obj.Timing_Property := sampled_timing;
   end initialize;

   procedure initialize (obj : in out time_triggered_communication_edge_ptr) is
   begin
      obj := new time_triggered_communication_edge;
      Initialize (generic_edge'class (obj.all));
      obj.Timing_Property := sampled_timing;
   end initialize;

   function copy
     (obj : in time_triggered_communication_edge)
      return time_triggered_communication_edge_ptr
   is
      new_time_triggered_communication_edge : time_triggered_communication_edge_ptr;
   begin
      new_time_triggered_communication_edge :=
        new time_triggered_communication_edge'(obj);
      return (new_time_triggered_communication_edge);
   end copy;

   procedure put (obj : in time_triggered_communication_edge) is
   begin
      Put (generic_edge (obj));
      Put ("Timing_Property: ");
      Put (obj.Timing_Property'img);
      Put ("; ");
   end put;

   procedure put_name (obj : in time_triggered_communication_edge_ptr) is
   begin
      Put (To_String (obj.cheddar_private_id));
   end put_name;

   function get_name
     (obj : in time_triggered_communication_edge) return Unbounded_String
   is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function get_name
     (obj : in time_triggered_communication_edge_ptr) return Unbounded_String
   is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function type_of
     (obj : in time_triggered_communication_edge) return unbounded_string_list
   is
      list : unbounded_string_list;
      s    : unbounded_string_ptr;
   begin
      initialize (list);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
      add (list, s);

      s     := new Unbounded_String;
      s.all :=
        To_Unbounded_String ("DP_GRAPH.Time_Triggered_Communication_EDGE");
      add (list, s);

      return list;
   end type_of;

   procedure build_attributes_xml_string
     (obj    : in     time_triggered_communication_edge;
      result : in out Unbounded_String)
   is
   begin
      Build_Attributes_XML_String (generic_edge (obj), result);
      result :=
        result &
        ASCII.HT &
        "<Timing_Property> " &
        XML_String (obj.Timing_Property) &
        " </Timing_Property>" &
        unbounded_lf;
   end build_attributes_xml_string;

   function xml_string
     (obj : in time_triggered_communication_edge) return Unbounded_String
   is
      result : Unbounded_String;
   begin
      result :=
        "<Time_Triggered_Communication_Edge id=""" &
        get_name (obj) &
        """ >" &
        unbounded_lf;
      build_attributes_xml_string (obj, result);
      result := result & "</Time_Triggered_Communication_Edge>" & unbounded_lf;
      return (result);
   end xml_string;

   function create_time_triggered_communication_edge_from_dependency
     (obj        : in dependency_ptr;
      naming_cpt : in Integer) return time_triggered_communication_edge_ptr
   is
      res : time_triggered_communication_edge_ptr;
   begin
      initialize (res);
      res.all.Id     := To_Unbounded_String ("Edge_" & (naming_cpt'img));
      res.all.Node_1 :=
        obj.all.time_triggered_communication_source.all.cheddar_private_id;
      res.all.Node_2 :=
        obj.all.time_triggered_communication_sink.all.cheddar_private_id;
      res.all.Timing_Property := obj.all.time_triggered_timing_property;
      return res;
   end create_time_triggered_communication_edge_from_dependency;

   -- --------= Resource_Edge =--------

   procedure add_edge
     (obj     : in out graph;
      e       : in     resource_edge_ptr;
      succeed :    out Boolean)
   is
   begin
      add_generic_edge (obj, generic_edge_ptr (e), succeed);
   end add_edge;

   procedure initialize (obj : in out resource_edge) is
   begin
      Initialize (generic_edge (obj));
      obj.Resource_Dependency_Resource := new generic_resource;
   end initialize;

   procedure initialize (obj : in out resource_edge_ptr) is
   begin
      obj := new resource_edge;
      Initialize (generic_edge'class (obj.all));
      obj.Resource_Dependency_Resource := new generic_resource;
   end initialize;

   function copy (obj : in resource_edge) return resource_edge_ptr is
      new_resource_edge : resource_edge_ptr;
   begin
      new_resource_edge := new resource_edge'(obj);
      return (new_resource_edge);
   end copy;

   procedure put (obj : in resource_edge) is
   begin
      Put (generic_edge (obj));
      Put ("Resource_Dependency_Resource: ");
      Put (obj.Resource_Dependency_Resource);
      Put ("; ");
   end put;

   procedure put_name (obj : in resource_edge_ptr) is
   begin
      Put (To_String (obj.cheddar_private_id));
   end put_name;

   function get_name (obj : in resource_edge) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function get_name (obj : in resource_edge_ptr) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function type_of (obj : in resource_edge) return unbounded_string_list is
      list : unbounded_string_list;
      s    : unbounded_string_ptr;
   begin
      initialize (list);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE");
      add (list, s);

      return list;
   end type_of;

   procedure build_attributes_xml_string
     (obj    : in     resource_edge;
      result : in out Unbounded_String)
   is
   begin
      Build_Attributes_XML_String (generic_edge (obj), result);

   end build_attributes_xml_string;

   function xml_string (obj : in resource_edge) return Unbounded_String is
      result : Unbounded_String;
   begin
      result :=
        "<Resource_Edge id=""" & get_name (obj) & """ >" & unbounded_lf;
      build_attributes_xml_string (obj, result);
      result := result & "</Resource_Edge>" & unbounded_lf;
      return (result);
   end xml_string;

   function create_resource_edge_from_dependency
     (obj        : in dependency_ptr;
      naming_cpt : in Integer) return resource_edge_ptr
   is
      res : resource_edge_ptr;
   begin
      initialize (res);
      res.all.Id     := To_Unbounded_String ("Edge_" & (naming_cpt'img));
      res.all.Node_1 :=
        obj.all.resource_dependency_task.all.cheddar_private_id;
      res.all.Resource_Dependency_Resource :=
        obj.all.resource_dependency_resource;
      return res;
   end create_resource_edge_from_dependency;

   procedure clean_resource_edges (obj : in out graph) is
      e_iterator    : edge_lists_iterator;
      current_edge  : generic_edge_ptr;
      e_iterator2   : edge_lists_iterator;
      current_edge2 : generic_edge_ptr;
   begin
      reset_head_iterator (obj.Edges, e_iterator);
      reset_head_iterator (obj.Edges, e_iterator2);
      if not is_empty (obj.Edges) then
         current_element (obj.Edges, current_edge, e_iterator);

         while (not is_tail_element (obj.Edges, e_iterator)) loop
            if element_in_list
                (To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
                 type_of (current_edge))
            then
               current_element (obj.Edges, current_edge2, e_iterator2);
               while (not is_tail_element (obj.Edges, e_iterator2)) loop
                  if element_in_list
                      (To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
                       type_of (current_edge2))
                  then
                     if
                       ((resource_edge_ptr (current_edge)
                           .Resource_Dependency_Resource =
                         resource_edge_ptr (current_edge2)
                           .Resource_Dependency_Resource) and
                        not (current_edge.all.Id = current_edge2.all.Id) and
                        (current_edge.all.Node_2 =
                         current_edge2.all.Node_2) and
                        (current_edge.all.Node_1 = current_edge2.all.Node_1))
                     then
                        delete (obj.Edges, current_edge2);
                        reset_head_iterator (obj.Edges, e_iterator2);
                        reset_head_iterator (obj.Edges, e_iterator);

                     end if;
                  end if;
                  next_element (obj.Edges, e_iterator2);
                  current_element (obj.Edges, current_edge2, e_iterator2);
               end loop;
               reset_head_iterator (obj.Edges, e_iterator2);
            end if;
            next_element (obj.Edges, e_iterator);
            current_element (obj.Edges, current_edge, e_iterator);
         end loop;
         if element_in_list
             (To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
              type_of (current_edge))
         then
            current_element (obj.Edges, current_edge2, e_iterator2);
            while (not is_tail_element (obj.Edges, e_iterator2)) loop
               if element_in_list
                   (To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
                    type_of (current_edge2))
               then
                  if
                    ((resource_edge_ptr (current_edge)
                        .Resource_Dependency_Resource =
                      resource_edge_ptr (current_edge2)
                        .Resource_Dependency_Resource) and
                     not (current_edge.all.Id = current_edge2.all.Id) and
                     (current_edge.all.Node_2 = current_edge2.all.Node_2) and
                     (current_edge.all.Node_1 = current_edge2.all.Node_1))
                  then
                     delete (obj.Edges, current_edge2);
                     reset_head_iterator (obj.Edges, e_iterator2);
                     reset_head_iterator (obj.Edges, e_iterator);

                  end if;
               end if;
               next_element (obj.Edges, e_iterator2);
               current_element (obj.Edges, current_edge2, e_iterator2);
            end loop;
            reset_head_iterator (obj.Edges, e_iterator2);
         end if;

      end if;
   end clean_resource_edges;

   procedure create_specific_resource_edges
     (obj        : in out graph;
      d          : in     dependency_ptr;
      naming_cpt : in out Integer;
      succeed    :    out Boolean)
   is
      e_iterator     : edge_lists_iterator;
      current_edge   : generic_edge_ptr;
      temporary_edge : resource_edge_ptr;
   begin
      succeed := False;
      reset_head_iterator (obj.Edges, e_iterator);
      if not is_empty (obj.Edges) then
         current_element (obj.Edges, current_edge, e_iterator);
         while (not is_tail_element (obj.Edges, e_iterator)) loop
            if element_in_list
                (To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
                 type_of (current_edge))
            then
               if
                 (resource_edge_ptr (current_edge)
                    .Resource_Dependency_Resource =
                  d.resource_dependency_resource)
               then

                  if (current_edge.all.Node_2 = empty_string) then
                     current_edge.all.Node_2 :=
                       Get_Name (d.all.resource_dependency_task);
                     succeed := True;
                  else
                     temporary_edge :=
                       create_resource_edge_from_dependency (d, naming_cpt);
                     naming_cpt                := naming_cpt + 1;
                     temporary_edge.all.Node_2 := current_edge.all.Node_2;
                     add_edge (obj, Copy (temporary_edge), succeed);
                     temporary_edge :=
                       create_resource_edge_from_dependency (d, naming_cpt);
                     naming_cpt                := naming_cpt + 1;
                     temporary_edge.all.Node_2 := current_edge.all.Node_1;
                     add_edge (obj, Copy (temporary_edge), succeed);
                  end if;
               end if;
            end if;
            next_element (obj.Edges, e_iterator);
            current_element (obj.Edges, current_edge, e_iterator);
         end loop;
         if element_in_list
             (To_Unbounded_String ("DP_GRAPH.RESOURCE_EDGE"),
              type_of (current_edge))
         then
            if
              (resource_edge_ptr (current_edge).Resource_Dependency_Resource =
               d.resource_dependency_resource)
            then

               if (current_edge.all.Node_2 = empty_string) then
                  current_edge.all.Node_2 :=
                    Get_Name (d.all.resource_dependency_task);
                  succeed := True;
               else
                  temporary_edge :=
                    create_resource_edge_from_dependency (d, naming_cpt);
                  naming_cpt                := naming_cpt + 1;
                  temporary_edge.all.Node_2 := current_edge.all.Node_2;
                  add_edge (obj, Copy (temporary_edge), succeed);
                  temporary_edge :=
                    create_resource_edge_from_dependency (d, naming_cpt);
                  naming_cpt                := naming_cpt + 1;
                  temporary_edge.all.Node_2 := current_edge.all.Node_1;
                  add_edge (obj, Copy (temporary_edge), succeed);
               end if;
            end if;
         end if;
      end if;
      if not succeed then
         add_edge
           (obj,
            create_resource_edge_from_dependency (d, naming_cpt),
            succeed);
      end if;
      if not succeed then
         raise building_graph_exception;
      end if;
      naming_cpt := naming_cpt + 1;
   end create_specific_resource_edges;

   -- --------= Precedence_Edge =--------

   procedure add_edge
     (obj     : in out graph;
      e       : in     precedence_edge_ptr;
      succeed :    out Boolean)
   is
   begin
      add_generic_edge (obj, generic_edge_ptr (e), succeed);
   end add_edge;

   procedure initialize (obj : in out precedence_edge) is
   begin
      Initialize (generic_edge (obj));
   end initialize;

   procedure initialize (obj : in out precedence_edge_ptr) is
   begin
      obj := new precedence_edge;
      Initialize (generic_edge'class (obj.all));
   end initialize;

   function copy (obj : in precedence_edge) return precedence_edge_ptr is
      new_precedence_edge : precedence_edge_ptr;
   begin
      new_precedence_edge := new precedence_edge'(obj);
      return (new_precedence_edge);
   end copy;

   procedure put (obj : in precedence_edge) is
   begin
      Put (generic_edge (obj));
   end put;

   procedure put_name (obj : in precedence_edge_ptr) is
   begin
      Put (To_String (obj.cheddar_private_id));
   end put_name;

   function get_name (obj : in precedence_edge) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function get_name (obj : in precedence_edge_ptr) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function type_of (obj : in precedence_edge) return unbounded_string_list is
      list : unbounded_string_list;
      s    : unbounded_string_ptr;
   begin
      initialize (list);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("DP_GRAPH.PRECEDENCE_EDGE");
      add (list, s);

      return list;
   end type_of;

   procedure build_attributes_xml_string
     (obj    : in     precedence_edge;
      result : in out Unbounded_String)
   is
   begin
      Build_Attributes_XML_String (generic_edge (obj), result);
   end build_attributes_xml_string;

   function xml_string (obj : in precedence_edge) return Unbounded_String is
      result : Unbounded_String;
   begin
      result :=
        "<Precedence_Edge id=""" & get_name (obj) & """ >" & unbounded_lf;
      build_attributes_xml_string (obj, result);
      result := result & "</Precedence_Edge>" & unbounded_lf;
      return (result);
   end xml_string;

   function create_precedence_edge_from_dependency
     (obj        : in dependency_ptr;
      naming_cpt : in Integer) return precedence_edge_ptr
   is
      res : precedence_edge_ptr;
   begin
      initialize (res);
      res.all.Id     := To_Unbounded_String ("Edge_" & (naming_cpt'img));
      res.all.Node_1 := obj.all.precedence_source.all.cheddar_private_id;
      res.all.Node_2 := obj.all.precedence_sink.all.cheddar_private_id;

      return res;
   end create_precedence_edge_from_dependency;

   -- --------= Communication_Edge =--------

   procedure add_edge
     (obj     : in out graph;
      e       : in     communication_edge_ptr;
      succeed :    out Boolean)
   is
   begin
      add_generic_edge (obj, generic_edge_ptr (e), succeed);
   end add_edge;

   procedure initialize (obj : in out communication_edge) is
   begin
      Initialize (generic_edge (obj));
      obj.Communication_Dependency_Object := new periodic_message;
      Initialize (obj.Communication_Dependency_Object.all);
   end initialize;

   procedure initialize (obj : in out communication_edge_ptr) is
   begin
      obj := new communication_edge;
      Initialize (generic_edge'class (obj.all));
      obj.all.Communication_Dependency_Object := new periodic_message;
      Initialize (obj.all.Communication_Dependency_Object.all);
   end initialize;

   function create_communication_edge_from_dependency
     (obj        : in dependency_ptr;
      naming_cpt : in Integer) return communication_edge_ptr
   is
      res : communication_edge_ptr;
   begin
      initialize (res);
      res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
      if
        (obj.all.asynchronous_communication_orientation = from_task_to_object)
      then
         res.all.Node_1 :=
           obj.all.asynchronous_communication_dependent_task.all
             .cheddar_private_id;
      else
         res.all.Node_2 :=
           obj.all.asynchronous_communication_dependent_task.all
             .cheddar_private_id;
      end if;
      res.all.Communication_Dependency_Object :=
        obj.all.asynchronous_communication_dependency_object;
      return res;
   end create_communication_edge_from_dependency;

   procedure create_specific_communication_edges
     (obj        : in out graph;
      d          : in     dependency_ptr;
      naming_cpt : in out Integer;
      succeed    :    out Boolean)
   is
      e_iterator     : edge_lists_iterator;
      current_edge   : generic_edge_ptr;
      temporary_edge : communication_edge_ptr;
   begin
      succeed := False;
      reset_head_iterator (obj.Edges, e_iterator);
      if not is_empty (obj.Edges) then
         current_element (obj.Edges, current_edge, e_iterator);
         while (not is_tail_element (obj.Edges, e_iterator)) loop
            if element_in_list
                (To_Unbounded_String ("DP_GRAPH.COMMUNICATION_EDGE"),
                 type_of (current_edge))
            then
               if
                 (communication_edge_ptr (current_edge)
                    .Communication_Dependency_Object =
                  d.asynchronous_communication_dependency_object)
               then
                  if
                    (d.all.asynchronous_communication_orientation =
                     from_task_to_object)
                  then
                     if (current_edge.all.Node_1 = empty_string) then
                        current_edge.all.Node_1 :=
                          Get_Name
                            (d.all.asynchronous_communication_dependent_task);
                        succeed := True;
                     else
                        if not (current_edge.all.Node_2 = empty_string) then
                           temporary_edge :=
                             create_communication_edge_from_dependency
                               (d,
                                naming_cpt);
                           naming_cpt                := naming_cpt + 1;
                           temporary_edge.all.Node_2 :=
                             current_edge.all.Node_2;
                           add_edge (obj, Copy (temporary_edge), succeed);
                        end if;
                     end if;
                  else
                     if (current_edge.all.Node_2 = empty_string) then
                        current_edge.all.Node_2 :=
                          Get_Name
                            (d.all.asynchronous_communication_dependent_task);
                        succeed := True;
                     else
                        if not (current_edge.Node_1 = empty_string) then
                           temporary_edge :=
                             create_communication_edge_from_dependency
                               (d,
                                naming_cpt);
                           naming_cpt                := naming_cpt + 1;
                           temporary_edge.all.Node_1 :=
                             current_edge.all.Node_1;
                           add_edge (obj, Copy (temporary_edge), succeed);
                        end if;
                     end if;
                  end if;
               end if;
            end if;
            next_element (obj.Edges, e_iterator);
            current_element (obj.Edges, current_edge, e_iterator);
         end loop;
         if element_in_list
             (To_Unbounded_String ("DP_GRAPH.COMMUNICATION_EDGE"),
              type_of (current_edge))
         then
            if
              (communication_edge_ptr (current_edge)
                 .Communication_Dependency_Object =
               d.asynchronous_communication_dependency_object)
            then
               if
                 (d.all.asynchronous_communication_orientation =
                  from_task_to_object)
               then
                  if (current_edge.all.Node_1 = empty_string) then
                     current_edge.all.Node_1 :=
                       Get_Name
                         (d.all.asynchronous_communication_dependent_task);
                     succeed := True;
                  else
                     if not (current_edge.all.Node_2 = empty_string) then
                        temporary_edge :=
                          create_communication_edge_from_dependency
                            (d,
                             naming_cpt);
                        naming_cpt                := naming_cpt + 1;
                        temporary_edge.all.Node_2 := current_edge.all.Node_2;
                        add_edge (obj, Copy (temporary_edge), succeed);
                     end if;
                  end if;
               else
                  if (current_edge.all.Node_2 = empty_string) then
                     current_edge.all.Node_2 :=
                       Get_Name
                         (d.all.asynchronous_communication_dependent_task);
                     succeed := True;
                  else
                     if not (current_edge.all.Node_1 = empty_string) then
                        temporary_edge :=
                          create_communication_edge_from_dependency
                            (d,
                             naming_cpt);
                        naming_cpt                := naming_cpt + 1;
                        temporary_edge.all.Node_1 := current_edge.all.Node_1;
                        add_edge (obj, Copy (temporary_edge), succeed);
                     end if;
                  end if;
               end if;
            end if;
         end if;
      end if;
      if not succeed then
         add_edge
           (obj,
            create_communication_edge_from_dependency (d, naming_cpt),
            succeed);
      end if;
      if not succeed then
         raise building_graph_exception;
      end if;
      naming_cpt := naming_cpt + 1;
   end create_specific_communication_edges;

   function copy (obj : in communication_edge) return communication_edge_ptr is
      new_communication_edge : communication_edge_ptr;
   begin
      new_communication_edge := new communication_edge'(obj);
      return (new_communication_edge);
   end copy;

   procedure put (obj : in communication_edge) is
   begin
      Put (generic_edge (obj));
      Put ("Communication_Dependency_Object: ");
      if obj.Communication_Dependency_Object /= null then
         Put (obj.Communication_Dependency_Object.all);
      else
         Put ("null");
      end if;
      Put ("; ");
   end put;

   procedure put_name (obj : in communication_edge_ptr) is
   begin
      Put (To_String (obj.cheddar_private_id));
   end put_name;

   function get_name (obj : in communication_edge) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function get_name
     (obj : in communication_edge_ptr) return Unbounded_String
   is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function type_of
     (obj : in communication_edge) return unbounded_string_list
   is
      list : unbounded_string_list;
      s    : unbounded_string_ptr;
   begin
      initialize (list);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("DP_GRAPH.COMMUNICATION_EDGE");
      add (list, s);

      return list;
   end type_of;

   procedure build_attributes_xml_string
     (obj    : in     communication_edge;
      result : in out Unbounded_String)
   is
   begin
      Build_Attributes_XML_String (generic_edge (obj), result);

   end build_attributes_xml_string;

   function xml_string (obj : in communication_edge) return Unbounded_String is
      result : Unbounded_String;
   begin
      result :=
        "<Communication_Edge id=""" & get_name (obj) & """ >" & unbounded_lf;
      build_attributes_xml_string (obj, result);
      result := result & "</Communication_Edge>" & unbounded_lf;
      return (result);
   end xml_string;

   -- --------= Buffer_Edge =--------

   procedure add_edge
     (obj     : in out graph;
      e       : in     buffer_edge_ptr;
      succeed :    out Boolean)
   is
   begin
      add_generic_edge (obj, generic_edge_ptr (e), succeed);
   end add_edge;

   procedure initialize (obj : in out buffer_edge) is
   begin
      Initialize (generic_edge (obj));
      obj.Buffer_Dependency_Object := new buffer;
      Initialize (obj.Buffer_Dependency_Object.all);
   end initialize;

   procedure initialize (obj : in out buffer_edge_ptr) is
   begin
      obj := new buffer_edge;
      Initialize (generic_edge'class (obj.all));
      obj.all.Buffer_Dependency_Object := new buffer;
      Initialize (obj.Buffer_Dependency_Object.all);
   end initialize;

   function copy (obj : in buffer_edge) return buffer_edge_ptr is
      new_buffer_edge : buffer_edge_ptr;
   begin
      new_buffer_edge := new buffer_edge'(obj);
      return (new_buffer_edge);
   end copy;

   procedure put (obj : in buffer_edge) is
   begin
      Put (generic_edge (obj));
      Put ("Buffer_Dependency_Object: ");
      if obj.Buffer_Dependency_Object /= null then
         Put (obj.Buffer_Dependency_Object.all);
      else
         Put ("null");
      end if;
      Put ("; ");
   end put;

   procedure put_name (obj : in buffer_edge_ptr) is
   begin
      Put (To_String (obj.cheddar_private_id));
   end put_name;

   function get_name (obj : in buffer_edge) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function get_name (obj : in buffer_edge_ptr) return Unbounded_String is
   begin
      return obj.cheddar_private_id;
   end get_name;

   function type_of (obj : in buffer_edge) return unbounded_string_list is
      list : unbounded_string_list;
      s    : unbounded_string_ptr;
   begin
      initialize (list);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("OBJECTS.GENERIC_OBJECT");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("GENERIC_GRAPH.GENERIC_EDGE");
      add (list, s);

      s     := new Unbounded_String;
      s.all := To_Unbounded_String ("DP_GRAPH.BUFFER_EDGE");
      add (list, s);

      return list;
   end type_of;

   function create_buffer_edge_from_dependency
     (obj        : in dependency_ptr;
      naming_cpt : in Integer) return buffer_edge_ptr
   is
      res : buffer_edge_ptr;
   begin
      initialize (res);
      res.all.Id := To_Unbounded_String ("Edge_" & (naming_cpt'img));
      res.all.Node_1 := obj.all.buffer_dependent_task.all.cheddar_private_id;
      res.all.Buffer_Dependency_Object := obj.all.buffer_dependency_object;
      return res;
   end create_buffer_edge_from_dependency;

   procedure create_specific_buffer_edges
     (obj        : in out graph;
      d          : in     dependency_ptr;
      naming_cpt : in out Integer;
      succeed    :    out Boolean)
   is
      e_iterator     : edge_lists_iterator;
      current_edge   : generic_edge_ptr;
      temporary_edge : buffer_edge_ptr;
   begin

      succeed := False;
      reset_head_iterator (obj.Edges, e_iterator);
      if not is_empty (obj.Edges) then
         current_element (obj.Edges, current_edge, e_iterator);

         while (not is_tail_element (obj.Edges, e_iterator)) loop
            if element_in_list
                (To_Unbounded_String ("DP_GRAPH.BUFFER_EDGE"),
                 type_of (current_edge))
            then
               if
                 (buffer_edge_ptr (current_edge).Buffer_Dependency_Object =
                  d.buffer_dependency_object)
               then
                  if (d.all.buffer_orientation = from_task_to_object) then
                     if (current_edge.all.Node_1 = empty_string) then
                        current_edge.all.Node_1 :=
                          Get_Name (d.all.buffer_dependent_task);
                        succeed := True;
                     else
                        if not (current_edge.all.Node_2 = empty_string) then
                           temporary_edge :=
                             create_buffer_edge_from_dependency
                               (d,
                                naming_cpt);
                           naming_cpt                := naming_cpt + 1;
                           temporary_edge.all.Node_2 :=
                             current_edge.all.Node_2;
                           add_edge (obj, Copy (temporary_edge), succeed);
                        end if;
                     end if;
                  else
                     if (current_edge.all.Node_2 = empty_string) then
                        current_edge.all.Node_2 :=
                          Get_Name (d.all.buffer_dependent_task);
                        succeed := True;
                     else
                        if not (current_edge.Node_1 = empty_string) then
                           temporary_edge :=
                             create_buffer_edge_from_dependency
                               (d,
                                naming_cpt);
                           naming_cpt                := naming_cpt + 1;
                           temporary_edge.all.Node_1 :=
                             current_edge.all.Node_1;
                           add_edge (obj, Copy (temporary_edge), succeed);
                        end if;
                     end if;
                  end if;
               end if;
            end if;
            next_element (obj.Edges, e_iterator);
            current_element (obj.Edges, current_edge, e_iterator);
         end loop;
         if element_in_list
             (To_Unbounded_String ("DP_GRAPH.BUFFER_EDGE"),
              type_of (current_edge))
         then
            if
              (buffer_edge_ptr (current_edge).Buffer_Dependency_Object =
               d.buffer_dependency_object)
            then
               if (d.all.buffer_orientation = from_task_to_object) then
                  if (current_edge.all.Node_1 = empty_string) then
                     current_edge.all.Node_1 :=
                       Get_Name (d.all.buffer_dependent_task);
                     succeed := True;
                  else
                     if not (current_edge.all.Node_2 = empty_string) then
                        temporary_edge :=
                          create_buffer_edge_from_dependency (d, naming_cpt);
                        naming_cpt                := naming_cpt + 1;
                        temporary_edge.all.Node_2 := current_edge.all.Node_2;
                        add_edge (obj, Copy (temporary_edge), succeed);
                     end if;
                  end if;
               else
                  if (current_edge.all.Node_2 = empty_string) then
                     current_edge.all.Node_2 :=
                       Get_Name (d.all.buffer_dependent_task);
                     succeed := True;
                  else
                     if not (current_edge.all.Node_1 = empty_string) then
                        temporary_edge :=
                          create_buffer_edge_from_dependency (d, naming_cpt);
                        naming_cpt                := naming_cpt + 1;
                        temporary_edge.all.Node_1 := current_edge.all.Node_1;
                        add_edge (obj, Copy (temporary_edge), succeed);
                     end if;
                  end if;
               end if;
            end if;
         end if;
      end if;
      if not succeed then
         add_edge
           (obj,
            create_buffer_edge_from_dependency (d, naming_cpt),
            succeed);
      end if;
      if not succeed then
         raise building_graph_exception;
      end if;
      naming_cpt := naming_cpt + 1;
   end create_specific_buffer_edges;

   function build_graph_from_system (obj : system) return graph is
      built_graph        : graph;
      t_iterator         : tasks_iterator;
      current_task       : generic_task_ptr;
      d_iterator         : tasks_dependencies_iterator;
      current_dependency : dependency_ptr;
      succeed            : Boolean;
      naming_cpt         : Integer;
   begin
      naming_cpt := 1;
      Initialize (built_graph);
      reset_iterator (obj.tasks, t_iterator);
      current_element (obj.tasks, current_task, t_iterator);
      -- First Step : adding all task_nodes
      while (not is_last_element (obj.tasks, t_iterator)) loop
         add_node (built_graph, create_node_from_task (current_task), succeed);
         put_debug ("*******************Building Graph");
         next_element (obj.tasks, t_iterator);
         current_element (obj.tasks, current_task, t_iterator);
         if not succeed then
            raise building_graph_exception;
         end if;
      end loop;
      add_node (built_graph, create_node_from_task (current_task), succeed);

      if (not is_empty (obj.dependencies.all.depends)) then

         reset_iterator (obj.dependencies.all.depends, d_iterator);
         current_element
           (obj.dependencies.all.depends,
            current_dependency,
            d_iterator);

         while (not is_last_element (obj.dependencies.all.depends, d_iterator))
         loop

            case current_dependency.type_of_dependency is
               when precedence_dependency | remote_procedure_call_dependency =>
                  add_edge
                    (built_graph,
                     create_precedence_edge_from_dependency
                       (current_dependency,
                        naming_cpt),
                     succeed);
                  if not succeed then
                     raise building_graph_exception;
                  end if;
                  naming_cpt := naming_cpt + 1;

               when queueing_buffer_dependency =>
                  create_specific_buffer_edges
                    (built_graph,
                     current_dependency,
                     naming_cpt,
                     succeed);
                  if not succeed then
                     raise building_graph_exception;
                  end if;

               when asynchronous_communication_dependency =>
                  create_specific_communication_edges
                    (built_graph,
                     current_dependency,
                     naming_cpt,
                     succeed);
                  if not succeed then
                     raise building_graph_exception;
                  end if;

               when time_triggered_communication_dependency =>
                  add_edge
                    (built_graph,
                     create_time_triggered_communication_edge_from_dependency
                       (current_dependency,
                        naming_cpt),
                     succeed);
                  if not succeed then
                     raise building_graph_exception;
                  end if;
                  naming_cpt := naming_cpt + 1;

               when resource_dependency =>
                  create_specific_resource_edges
                    (built_graph,
                     current_dependency,
                     naming_cpt,
                     succeed);
                  if not succeed then
                     raise building_graph_exception;
                  end if;
                  naming_cpt := naming_cpt + 1;
               when black_board_buffer_dependency =>
                  null;

            end case;

            next_element (obj.dependencies.all.depends, d_iterator);
            current_element
              (obj.dependencies.all.depends,
               current_dependency,
               d_iterator);
         end loop;

         case current_dependency.type_of_dependency is
            when precedence_dependency | remote_procedure_call_dependency =>
               add_edge
                 (built_graph,
                  create_precedence_edge_from_dependency
                    (current_dependency,
                     naming_cpt),
                  succeed);
               if not succeed then
                  raise building_graph_exception;
               end if;
               naming_cpt := naming_cpt + 1;

            when queueing_buffer_dependency =>
               create_specific_buffer_edges
                 (built_graph,
                  current_dependency,
                  naming_cpt,
                  succeed);
               if not succeed then
                  raise building_graph_exception;
               end if;

            when asynchronous_communication_dependency =>
               create_specific_communication_edges
                 (built_graph,
                  current_dependency,
                  naming_cpt,
                  succeed);
               if not succeed then
                  raise building_graph_exception;
               end if;

            when time_triggered_communication_dependency =>
               add_edge
                 (built_graph,
                  create_time_triggered_communication_edge_from_dependency
                    (current_dependency,
                     naming_cpt),
                  succeed);
               if not succeed then
                  raise building_graph_exception;
               end if;
               naming_cpt := naming_cpt + 1;

            when resource_dependency =>
               create_specific_resource_edges
                 (built_graph,
                  current_dependency,
                  naming_cpt,
                  succeed);
               if not succeed then
                  raise building_graph_exception;
               end if;
               naming_cpt := naming_cpt + 1;

            when black_board_buffer_dependency =>
               null;

         end case;
      end if;
      clean_resource_edges (built_graph);
      return built_graph;
   end build_graph_from_system;

   function get_value (obj : graph_ptr) return graph is
      return_graph : graph;
      temp         : graph_ptr;
   begin
      Initialize (return_graph);
      temp               := Copy (obj);
      return_graph.Edges := temp.Edges;
      return_graph.Nodes := temp.Nodes;

      return return_graph;
   end get_value;

end DP_Graph.extended;