------------------------------------------------------------------------------
------------------------------------------------------------------------------
--  This source file was automatically generated by Platypus
--  see http://dossen.univ-brest.fr/apl
-- 
--  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 GNU GPL real-time scheduling analysis tool.
-- This program provides services to automatically check schedulability and
-- other performance criteria of real-time architecture models.
--
-- Copyright (C) 2002-2016   Frank Singhoff, Alain Plantec, Jerome Legrand
--
-- The Cheddar project was started in 2002 by 
-- Frank Singhoff, Lab-STICC UMR 6285 laboratory, Université de Bretagne Occidentale
-- 
-- Cheddar has been published in the "Agence de Protection des Programmes/France" in 2008. 
-- Since 2008, Ellidiss technologies also contributes to the development of 
-- Cheddar and provides industrial support.
--
-- The full list of contributors and sponsors can be found in AUTHORS.txt and SPONSORS.txt
--
-- 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 Text_io;
use Text_io;

with unbounded_strings;
use unbounded_strings;

with primitive_xml_strings;
use primitive_xml_strings;



Package Body Automaton is 
 
function XML_String(obj : in Synchronizations_Type) return Unbounded_String is
begin
	return to_unbounded_string(Synchronizations_Type'image (obj) );
end XML_String;

function XML_Ref_String (obj : in Synchronizations_Type) return Unbounded_String is
begin
	raise xml_ref_string_error;
	return to_unbounded_string("");
end XML_Ref_String;


function XML_String(obj : in Status_Type) return Unbounded_String is
begin
	return to_unbounded_string(Status_Type'image (obj) );
end XML_String;

function XML_Ref_String (obj : in Status_Type) return Unbounded_String is
begin
	raise xml_ref_string_error;
	return to_unbounded_string("");
end XML_Ref_String;



-- --------= State =--------

procedure Initialize(obj : in out State) is 
begin
	initialize(Named_Object(obj));
	obj.is_initial := false;
	obj.object_type := State_Object_Type;
end Initialize;

function Copy ( obj : in State ) return State_Ptr is
	New_State : State_Ptr;
begin
	New_State := new State'(obj);
	return (New_State);
end Copy;

function Copy ( obj : in State_Ptr ) return State_Ptr is
begin
	return copy(obj.all);
end Copy;

procedure Put(obj : in State) is 
begin
	put(Named_Object(obj));
	put("is_initial: "); standards_io.boolean_io.put(obj.is_initial); put ( "; " );
end Put;
 
procedure Put(obj : in State_Ptr) is
begin
	Put(Obj.All);
end Put;
 
procedure Put_Name ( obj : in State_Ptr) is
begin
	Put ( To_String ( Obj.Name ) );
end Put_Name;

function Get_Name (obj : in State) return Unbounded_String is
begin
	return obj.name;
end Get_Name;

function Get_Name (obj : in State_ptr) return Unbounded_String is
begin
	return obj.name;
end Get_Name;

function type_of ( obj : in State ) 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("OBJECTS.NAMED_OBJECT");
	Add (list, s);

	s := new unbounded_string;
	s.all := to_unbounded_string("AUTOMATON.STATE");
	Add (list, s);

	return list;
end type_of;

function type_of ( obj : in State_Ptr ) return unbounded_string_list is
begin
	return type_of(obj.all);
end type_of;


procedure Build_Attributes_XML_String(obj : in State; result : in out Unbounded_String) is 
begin
	Build_Attributes_XML_String(Named_Object(obj), result);
	if (XML_String(obj.is_initial) /= Empty_String) then
		result := result & to_unbounded_string("<is_initial>") & XML_String(obj.is_initial) & to_unbounded_string("</is_initial>");
	end if;
end Build_Attributes_XML_String;

function XML_String(obj : in State) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<state id=""") & obj.cheddar_private_id & to_unbounded_string(""" >");
	Build_Attributes_XML_String(obj, result);
	result := result & to_unbounded_string("</state>");
	return (result);
end XML_String;

function XML_String(obj : in State_Ptr) return Unbounded_String is
begin
	if obj /= null then
		return XML_String(obj.all);
	else
		return Empty_String;
	end if;
end XML_String;

function XML_Ref_String(obj : in State) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<state ref=""") & obj.cheddar_private_id & to_unbounded_string(""" />");
	return (result);
end XML_Ref_String;

function XML_Ref_String(obj : in State_Ptr) return Unbounded_String is
begin
	return XML_Ref_String(obj.all);
end XML_Ref_String;




-- --------= Synchronization =--------

procedure Initialize(obj : in out Synchronization) is 
begin
	initialize(Named_Object(obj));
	obj.synchronization_type := Send;
	obj.object_type := Synchronization_Object_Type;
end Initialize;

function Copy ( obj : in Synchronization ) return Synchronization_Ptr is
	New_Synchronization : Synchronization_Ptr;
begin
	New_Synchronization := new Synchronization'(obj);
	return (New_Synchronization);
end Copy;

function Copy ( obj : in Synchronization_Ptr ) return Synchronization_Ptr is
begin
	return copy(obj.all);
end Copy;

procedure Put(obj : in Synchronization) is 
begin
	put(Named_Object(obj));
	put("synchronization_type: "); put(obj.synchronization_type); put ( "; " );
end Put;
 
procedure Put(obj : in Synchronization_Ptr) is
begin
	Put(Obj.All);
end Put;
 
procedure Put_Name ( obj : in Synchronization_Ptr) is
begin
	Put ( To_String ( Obj.Name ) );
end Put_Name;

function Get_Name (obj : in Synchronization) return Unbounded_String is
begin
	return obj.name;
end Get_Name;

function Get_Name (obj : in Synchronization_ptr) return Unbounded_String is
begin
	return obj.name;
end Get_Name;

function type_of ( obj : in Synchronization ) 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("OBJECTS.NAMED_OBJECT");
	Add (list, s);

	s := new unbounded_string;
	s.all := to_unbounded_string("AUTOMATON.SYNCHRONIZATION");
	Add (list, s);

	return list;
end type_of;

function type_of ( obj : in Synchronization_Ptr ) return unbounded_string_list is
begin
	return type_of(obj.all);
end type_of;


procedure Build_Attributes_XML_String(obj : in Synchronization; result : in out Unbounded_String) is 
begin
	Build_Attributes_XML_String(Named_Object(obj), result);
	if (XML_String(obj.synchronization_type) /= Empty_String) then
		result := result & to_unbounded_string("<synchronization_type>") & XML_String(obj.synchronization_type) & to_unbounded_string("</synchronization_type>");
	end if;
end Build_Attributes_XML_String;

function XML_String(obj : in Synchronization) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<synchronization id=""") & obj.cheddar_private_id & to_unbounded_string(""" >");
	Build_Attributes_XML_String(obj, result);
	result := result & to_unbounded_string("</synchronization>");
	return (result);
end XML_String;

function XML_String(obj : in Synchronization_Ptr) return Unbounded_String is
begin
	if obj /= null then
		return XML_String(obj.all);
	else
		return Empty_String;
	end if;
end XML_String;

function XML_Ref_String(obj : in Synchronization) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<synchronization ref=""") & obj.cheddar_private_id & to_unbounded_string(""" />");
	return (result);
end XML_Ref_String;

function XML_Ref_String(obj : in Synchronization_Ptr) return Unbounded_String is
begin
	return XML_Ref_String(obj.all);
end XML_Ref_String;




-- --------= Transition =--------

procedure Initialize(obj : in out Transition) is 
begin
	initialize(Named_Object(obj));
	obj.object_type := Transition_Object_Type;
end Initialize;

function Copy ( obj : in Transition ) return Transition_Ptr is
	New_Transition : Transition_Ptr;
begin
	New_Transition := new Transition'(obj);
	return (New_Transition);
end Copy;

function Copy ( obj : in Transition_Ptr ) return Transition_Ptr is
begin
	return copy(obj.all);
end Copy;

procedure Put(obj : in Transition) is 
begin
	put(Named_Object(obj));
	put("from_state: "); if obj.from_state /= null then put(obj.from_state.all); else put("null"); end if;put ( "; " );
	put("to_state: "); if obj.to_state /= null then put(obj.to_state.all); else put("null"); end if;put ( "; " );
	put("guards: "); if obj.guards /= null then put(obj.guards.all); else put("null"); end if;put ( "; " );
	put("clocks: "); if obj.clocks /= null then put(obj.clocks.all); else put("null"); end if;put ( "; " );
	put("synchronization: "); if obj.synchronization /= null then put(obj.synchronization.all); else put("null"); end if;put ( "; " );
end Put;
 
procedure Put(obj : in Transition_Ptr) is
begin
	Put(Obj.All);
end Put;
 
procedure Put_Name ( obj : in Transition_Ptr) is
begin
	Put ( To_String ( Obj.Name ) );
end Put_Name;

function Get_Name (obj : in Transition) return Unbounded_String is
begin
	return obj.name;
end Get_Name;

function Get_Name (obj : in Transition_ptr) return Unbounded_String is
begin
	return obj.name;
end Get_Name;

function type_of ( obj : in Transition ) 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("OBJECTS.NAMED_OBJECT");
	Add (list, s);

	s := new unbounded_string;
	s.all := to_unbounded_string("AUTOMATON.TRANSITION");
	Add (list, s);

	return list;
end type_of;

function type_of ( obj : in Transition_Ptr ) return unbounded_string_list is
begin
	return type_of(obj.all);
end type_of;


procedure Build_Attributes_XML_String(obj : in Transition; result : in out Unbounded_String) is 
begin
	Build_Attributes_XML_String(Named_Object(obj), result);
	result := result & to_unbounded_string("<from_state ref=""") & obj.from_state.cheddar_private_id & to_unbounded_string(""" />");
	result := result & to_unbounded_string("<to_state ref=""") & obj.to_state.cheddar_private_id & to_unbounded_string(""" />");
	result := result & to_unbounded_string("<guards ref=""") & obj.guards.cheddar_private_id & to_unbounded_string(""" />");
	result := result & to_unbounded_string("<clocks ref=""") & obj.clocks.cheddar_private_id & to_unbounded_string(""" />");
	result := result & to_unbounded_string("<synchronization ref=""") & obj.synchronization.cheddar_private_id & to_unbounded_string(""" />");
end Build_Attributes_XML_String;

function XML_String(obj : in Transition) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<transition id=""") & obj.cheddar_private_id & to_unbounded_string(""" >");
	Build_Attributes_XML_String(obj, result);
	result := result & to_unbounded_string("</transition>");
	return (result);
end XML_String;

function XML_String(obj : in Transition_Ptr) return Unbounded_String is
begin
	if obj /= null then
		return XML_String(obj.all);
	else
		return Empty_String;
	end if;
end XML_String;

function XML_Ref_String(obj : in Transition) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<transition ref=""") & obj.cheddar_private_id & to_unbounded_string(""" />");
	return (result);
end XML_Ref_String;

function XML_Ref_String(obj : in Transition_Ptr) return Unbounded_String is
begin
	return XML_Ref_String(obj.all);
end XML_Ref_String;




-- --------= Automaton_Status =--------

procedure Initialize(obj : out Automaton_Status) is 
begin
	null;
end Initialize;

procedure Put(obj : in Automaton_Status) is 
begin
	put("current_state: "); if obj.current_state /= null then put(obj.current_state.all); else put("null"); end if;put ( "; " );
end Put;
 
procedure Put(obj : in Automaton_Status_Ptr) is
begin
	Put(Obj.All);
end Put;


procedure Build_Attributes_XML_String(obj : in Automaton_Status; result : in out Unbounded_String) is 
begin
	result := result & to_unbounded_string("<current_state ref=""") & obj.current_state.cheddar_private_id & to_unbounded_string(""" />");
end Build_Attributes_XML_String;

function XML_String(obj : in Automaton_Status) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<automaton_status>");
	Build_Attributes_XML_String(obj, result);
	result := result & to_unbounded_string("</automaton_status>");
	return (result);
end XML_String;

function XML_String(obj : in Automaton_Status_Ptr) return Unbounded_String is
begin
	if obj /= null then
		return XML_String(obj.all);
	else
		return Empty_String;
	end if;
end XML_String;

function XML_Ref_String(obj : in Automaton_Status) return Unbounded_String is
	result : Unbounded_String;
begin
	raise xml_ref_string_error;
	return to_unbounded_string("");
end XML_Ref_String;

function Copy ( obj : in Automaton_Status ) return Automaton_Status_Ptr is
	New_Automaton_Status : Automaton_Status_Ptr;
begin
	New_Automaton_Status := new Automaton_Status'(obj);
	return (New_Automaton_Status);
end Copy;

function Copy ( obj : in Automaton_Status_Ptr ) return Automaton_Status_Ptr is
begin
	return copy(obj.all);
end Copy;



-- --------= Transition_Status =--------

procedure Initialize(obj : out Transition_Status) is 
begin
	obj.status := Ready;
	obj.wakeup_time := 0;
end Initialize;

procedure Put(obj : in Transition_Status) is 
begin
	put("code: "); if obj.code /= null then put(obj.code.all); else put("null"); end if;put ( "; " );
	put("status: "); put(obj.status); put ( "; " );
	put("wakeup_time: "); standards_io.natural_io.put(obj.wakeup_time); put ( "; " );
end Put;
 
procedure Put(obj : in Transition_Status_Ptr) is
begin
	Put(Obj.All);
end Put;


procedure Build_Attributes_XML_String(obj : in Transition_Status; result : in out Unbounded_String) is 
begin
	result := result & to_unbounded_string("<code ref=""") & obj.code.cheddar_private_id & to_unbounded_string(""" />");
	if (XML_String(obj.status) /= Empty_String) then
		result := result & to_unbounded_string("<status>") & XML_String(obj.status) & to_unbounded_string("</status>");
	end if;
	if (XML_String(obj.wakeup_time) /= Empty_String) then
		result := result & to_unbounded_string("<wakeup_time>") & XML_String(obj.wakeup_time) & to_unbounded_string("</wakeup_time>");
	end if;
end Build_Attributes_XML_String;

function XML_String(obj : in Transition_Status) return Unbounded_String is
	result : Unbounded_String;
begin
	result := to_unbounded_string("<transition_status>");
	Build_Attributes_XML_String(obj, result);
	result := result & to_unbounded_string("</transition_status>");
	return (result);
end XML_String;

function XML_String(obj : in Transition_Status_Ptr) return Unbounded_String is
begin
	if obj /= null then
		return XML_String(obj.all);
	else
		return Empty_String;
	end if;
end XML_String;

function XML_Ref_String(obj : in Transition_Status) return Unbounded_String is
	result : Unbounded_String;
begin
	raise xml_ref_string_error;
	return to_unbounded_string("");
end XML_Ref_String;

function Copy ( obj : in Transition_Status ) return Transition_Status_Ptr is
	New_Transition_Status : Transition_Status_Ptr;
begin
	New_Transition_Status := new Transition_Status'(obj);
	return (New_Transition_Status);
end Copy;

function Copy ( obj : in Transition_Status_Ptr ) return Transition_Status_Ptr is
begin
	return copy(obj.all);
end Copy;



End Automaton;