note
	description: "[
				Utility class to traverse object graphs starting at a root object.
		
		
				When traversing a graph the class distinguishes four different types of references:
				
					(1) Normal references
					(2) References with copy-semantics, which are usually seen when attaching 
						an expanded object to an ANY reference
					(3) User-defined expanded objects, embedded inside another object. 
						Semantically this is a special case of a copy-semantics reference.
					(4) Language-defined expanded objects (INTEGER, POINTER etc) embedded inside another object. 
						Semantically, this is a special case of a copy-semantics reference.
						
				This class will follow all reference types except (4). 
				
				During traversal the agent on_processing_object_action will be called for each object
				and the agent on_processing_reference_action for each reference, if present. This includes
				references to objects that have already been processed.
				
				The algorighm has two output values: visited_objects and visited_types:
				Any standard object without copy-semantics (i.e. reference type (1)) will be stored
				by aliasing inside visited_object. For references of type (2) and (3) a copy will be stored.
				The visited_types hash table contains the dynamic type id of all types encountered during 
				traversal. The key and value in the hashtable are the same.
				
				Setting is_skip_copy_semantics_reference to true means that references of (2) and (3) will
				not be stored in visited_types. Note that this is the only effect of this setting - i.e.
				the traversal algorithm will still follow the references, the agents will be called, and the
				visited_types array will be extended anyway.
		
				NOTE:
				
				Due to a limitation in the reflection library, references of type (2) and (3) within TUPLE 
				and references of type (3) within SPECIAL cannot be handled without causing a copy. This is 
				problematic for agents, especially when they want to change the object. Therefore
				the algorithm will raise an exception when an agent is attached.
				In read-only situations it may be acceptable to use a copy of an object. Therefore to disable the
				exception behaviour you can set is_exception_on_copy_suppressed to True.
				
				NOTE:
				
				To maintain backwards compatibility the traversal algorithm will silently ignore any kind of 
				exception and just return normally, with traversed_objects set to whatever value it had before 
				invoking traverse. In order to get exceptions you need to set is_exception_propagated to True.
	]"
	library: "Free implementation of ELKS library"
	legal: "See notice at end of class."
	status: "See notice at end of class."
	author: "Stephanie Balzer"
	date: "$Date: 2017-03-23 19:18:26 +0000 (Thu, 23 Mar 2017) $"
	revision: "$Revision: 100033 $"

deferred class 
	OBJECT_GRAPH_TRAVERSABLE

feature -- Access

	root_object: detachable ANY
			-- Starting point of graph traversing

	on_processing_object_action: detachable PROCEDURE [REFLECTED_OBJECT]
			-- Action called on every object in the object graph.
			-- Note: The argument is reused later for a different object. Do not alias it.

	on_processing_reference_action: detachable PROCEDURE [REFLECTED_OBJECT, REFLECTED_OBJECT]
			-- Action called on every reference in the object graph.
			-- Note: The arguments are reused later for different objects. Do not alias them.

	object_action: detachable PROCEDURE [separate ANY]
			-- Action called on every object in object graph

	visited_objects: detachable ARRAYED_LIST [separate ANY]
			-- List referencing objects of object graph that have been visited in traverse.

	visited_types: detachable HASH_TABLE [INTEGER_32, INTEGER_32]
			-- List of all types encountered during traversal
	
feature -- Status report

	has_failed: BOOLEAN
			-- Was the last traversal successful?

	is_root_object_set: BOOLEAN
			-- Is starting point of graph traversing set?
		do
			Result := root_object /= Void
		end

	is_object_action_set: BOOLEAN
			-- Is procedure to call on every object set?
		do
			Result := object_action /= Void
		end

	has_reference_with_copy_semantics: BOOLEAN
			-- Does the traversed graph of objects contain reference with copy semantics?

	is_skip_transient: BOOLEAN
			-- Do we skip transient attribute during traversal?

	is_skip_copy_semantics_reference: BOOLEAN
			-- Do we skip copy semantics reference from visited_objects during traversal?

	is_exception_on_copy_suppressed: BOOLEAN
			-- Do we suppress an exception when object_action is called on a copied object?
			-- A copy happens when encountering tuples containing copy-semantics references
			-- or with SPECIAL[XX], where XX is a user-defined expanded type.

	is_exception_propagated: BOOLEAN
			-- Does the algorithm propagate any exceptions to the user?
	
feature -- Element change

	set_root_object (an_object: like root_object)
			-- Set root_object with 'an_object'.
		require
			an_object_not_void: an_object /= Void
		do
			root_object := an_object
		ensure
			root_object_set: root_object = an_object and is_root_object_set
		end

	set_on_processing_object_action (an_action: like on_processing_object_action)
			-- Set on_processing_object_action with an_action
		require
			an_action_not_void: an_action /= Void
		do
			on_processing_object_action := an_action
		ensure
			on_processing_object_action_set: on_processing_object_action = an_action
		end

	set_on_processing_reference_action (an_action: like on_processing_reference_action)
			-- Set on_processing_object_action with an_action
		require
			an_action_not_void: an_action /= Void
		do
			on_processing_reference_action := an_action
		ensure
			on_processing_reference_action_set: on_processing_reference_action = an_action
		end

	set_object_action (an_object_action: like object_action)
		obsolete "Use set_on_processing_object_action to read and manipulate objects via REFLECTED_OBJECT. [2017-05-31]"
			-- Set object_action with an_object_action.
		require
			an_object_action_not_void: an_object_action /= Void
		do
			object_action := an_object_action
		ensure
			an_object_action_set: object_action = an_object_action and is_object_action_set
		end

	set_is_skip_transient (v: like is_skip_transient)
			-- Set is_skip_transient with v.
		do
			is_skip_transient := v
		ensure
			is_skip_transient_set: is_skip_transient = v
		end

	set_is_skip_copy_semantics_reference (v: like is_skip_copy_semantics_reference)
			-- Set is_skip_copy_semantics_reference with v.
		do
			is_skip_copy_semantics_reference := v
		ensure
			is_skip_copy_semantics_reference_set: is_skip_copy_semantics_reference = v
		end

	set_is_exception_on_copy_suppressed (v: like is_exception_on_copy_suppressed)
			-- Set set_is_exception_on_copy_suppressed with v.
		do
			is_exception_on_copy_suppressed := v
		ensure
			is_exception_on_copy_suppressed_set: is_exception_on_copy_suppressed = v
		end

	set_is_exception_propagated (v: like is_exception_propagated)
			-- Set is_exception_propagated with v.
		do
			is_exception_propagated := v
		ensure
			is_exception_propagated_set: is_exception_propagated = v
		end
	
feature -- Basic operations

	frozen traverse
			-- Traverse object structure starting at 'root_object' and call object_action
			-- on every object in the graph.
		require
			root_object_available: is_root_object_set
		local
			l_marker: detachable OBJECT_GRAPH_MARKER
			l_has_lock: BOOLEAN
			l_retried: BOOLEAN
		do
			if not l_retried and then attached root_object as l_root then
				create l_marker
				l_marker.lock_marking
				l_has_lock := True
				internal_traverse (l_root)
				l_marker.unlock_marking
				has_failed := False
			end
		rescue
			l_retried := True
			has_failed := True
			if l_has_lock and then l_marker /= Void then
				l_marker.unlock_marking
			end
			if not is_exception_propagated then
				retry
			end
		end

	wipe_out
			-- Clear current to default values
		do
			visited_objects := Void
			visited_types := Void
			object_action := Void
			root_object := Void
		ensure
			visited_objects_reset: visited_objects = Void
			object_action_not_set: not is_object_action_set
			root_object_not_set: not is_root_object_set
		end
	
feature {NONE} -- Implementation

	new_dispenser: DISPENSER [separate ANY]
			-- New dispenser to use for storing visited objects.
		deferred
		ensure
			new_dispenser_not_void: Result /= Void
		end

	Default_size: INTEGER_32 = 200
			-- Default size for containers used during object traversal

	internal_traverse (a_root_object: ANY)
			-- Traverse object structure starting at 'root_object' and call object_action
			-- on every object in the graph.
		local
			i, nb: INTEGER_32
			l_object: separate ANY
			l_field: like {TUPLE}.reference_item
			l_field_type: INTEGER_32
			l_marker: OBJECT_GRAPH_MARKER
			l_objects_to_visit: like new_dispenser
			l_visited: like visited_objects
			l_visited_types: like visited_types
			l_action: like object_action
			l_on_processing_object_action: like on_processing_object_action
			l_spec: like visited_objects.area
			l_reflected_reference_object: REFLECTED_REFERENCE_OBJECT
			l_reflected_object: REFLECTED_OBJECT
			l_has_reference_with_copy_semantics: BOOLEAN
			l_on_processing_reference_action: like on_processing_reference_action
			l_referee_object_cache: REFLECTED_REFERENCE_OBJECT
			l_referee_object: REFLECTED_OBJECT
		do
			from
				create l_marker
				create l_reflected_reference_object.make (a_root_object)
				l_marker.mark (a_root_object)
				create l_visited.make (Default_size)
				create l_visited_types.make (Default_size)
				l_objects_to_visit := new_dispenser
				l_objects_to_visit.put (a_root_object)
				l_action := object_action
				l_on_processing_object_action := on_processing_object_action
				l_on_processing_reference_action := on_processing_reference_action
				create l_referee_object_cache.make (a_root_object)
			until
				l_objects_to_visit.is_empty
			loop
				l_object := l_objects_to_visit.item
				l_objects_to_visit.remove
				if attached {REFLECTED_OBJECT} l_object as l_copy_semantics_object then
					check
						embedded_or_copy_semantics: attached {REFLECTED_COPY_SEMANTICS_OBJECT} l_copy_semantics_object or (attached {REFLECTED_REFERENCE_OBJECT} l_copy_semantics_object as l_ref_obj and then l_ref_obj.physical_offset /= 0)
					end
					l_has_reference_with_copy_semantics := True
					l_reflected_object := l_copy_semantics_object
					if not is_skip_copy_semantics_reference then
						l_visited.extend (l_copy_semantics_object.object)
					end
				else
					l_reflected_reference_object.set_object (l_object)
					l_reflected_object := l_reflected_reference_object
					if l_reflected_reference_object.is_expanded then
						l_has_reference_with_copy_semantics := True
						if not is_skip_copy_semantics_reference then
							l_visited.extend (l_object)
						end
					else
						l_visited.extend (l_object)
					end
				end
				l_visited_types.put (l_reflected_object.dynamic_type, l_reflected_object.dynamic_type)
				if l_action /= Void or l_on_processing_object_action /= Void then
					if not is_exception_on_copy_suppressed and then l_reflected_object.is_expanded then
						raise_unwanted_copy_exception
					else
						if l_action /= Void then
							l_action.call ([l_object])
						end
						if attached l_on_processing_object_action then
							l_on_processing_object_action.call ([l_reflected_object])
						end
					end
				end
				if l_reflected_object.is_special then
					if l_reflected_object.is_special_of_reference then
						if attached {SPECIAL [detachable ANY]} l_object as l_sp then
							from
								i := 0
								nb := l_sp.count
							until
								i = nb
							loop
								if l_reflected_object.is_special_copy_semantics_item (i) then
									l_referee_object := l_reflected_object.special_copy_semantics_item (i)
									l_field := l_referee_object
									l_objects_to_visit.put (l_field)
									if attached l_on_processing_reference_action then
										l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
									end
								else
									l_field := l_sp.item (i)
									if l_field /= Void and then not l_marker.is_marked (l_field) then
										l_marker.mark (l_field)
										l_objects_to_visit.put (l_field)
									end
									if attached l_on_processing_reference_action and attached l_field then
										l_referee_object_cache.set_object (l_field)
										l_referee_object := l_referee_object_cache
										l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
									end
								end
								i := i + 1
							end
						end
					elseif l_reflected_object.is_special_of_expanded then
						if attached {SPECIAL [ANY]} l_object as l_sp then
							from
								i := 0
								nb := l_sp.count
							until
								i = nb
							loop
								l_field := l_sp.item (i)
								l_objects_to_visit.put (l_field)
								if attached l_on_processing_reference_action then
									if is_exception_on_copy_suppressed then
										l_referee_object_cache.set_object (l_field)
										l_referee_object := l_referee_object_cache
										l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
									else
										raise_unwanted_copy_exception
									end
								end
								i := i + 1
							end
						end
					end
				elseif l_reflected_object.is_tuple then
					if attached {TUPLE} l_object as l_tuple_obj then
						from
							i := 1
							nb := l_tuple_obj.count + 1
						until
							i = nb
						loop
							if l_tuple_obj.is_reference_item (i) then
								l_field := l_tuple_obj.reference_item (i)
								if l_field /= Void and then not l_marker.is_marked (l_field) then
									l_marker.mark (l_field)
									l_objects_to_visit.put (l_field)
								end
								if attached l_on_processing_reference_action and attached l_field then
									if is_exception_on_copy_suppressed then
										l_referee_object_cache.set_object (l_field)
										l_referee_object := l_referee_object_cache
										l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
									else
										raise_unwanted_copy_exception
									end
								end
							end
							i := i + 1
						end
					end
				else
					from
						i := 1
						nb := l_reflected_object.field_count + 1
					until
						i = nb
					loop
						l_field_type := l_reflected_object.field_type (i)
						if l_field_type = {REFLECTOR_CONSTANTS}.reference_type or l_field_type = {REFLECTOR_CONSTANTS}.expanded_type then
							if not is_skip_transient or else not l_reflected_object.is_field_transient (i) then
								if l_field_type = {REFLECTOR_CONSTANTS}.expanded_type then
									l_referee_object := l_reflected_object.expanded_field (i)
									l_objects_to_visit.put (l_referee_object)
									if attached l_on_processing_reference_action then
										l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
									end
								elseif l_reflected_object.is_copy_semantics_field (i) then
									l_referee_object := l_reflected_object.copy_semantics_field (i)
									l_objects_to_visit.put (l_referee_object)
									if attached l_on_processing_reference_action then
										l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
									end
								else
									l_field := l_reflected_object.reference_field (i)
									if l_field /= Void then
										if not l_marker.is_marked (l_field) then
											l_marker.mark (l_field)
											l_objects_to_visit.put (l_field)
										end
										if attached l_on_processing_reference_action then
											l_referee_object_cache.set_object (l_field)
											l_referee_object := l_referee_object_cache
											l_on_processing_reference_action.call ([l_reflected_object, l_referee_object])
										end
									end
								end
							end
						end
						i := i + 1
					variant
							nb - i
					end
				end
			end
			from
				i := 0
				nb := l_visited.count
				l_spec := l_visited.area
			until
				i = nb
			loop
				l_marker.unmark (l_spec.item (i))
				i := i + 1
			end
			visited_objects := l_visited
			visited_types := l_visited_types
			has_reference_with_copy_semantics := l_has_reference_with_copy_semantics
		end

	raise_unwanted_copy_exception
		local
			l_exception: DEVELOPER_EXCEPTION
		do
			create l_exception
			l_exception.set_description ("An agent has been invoked on a copy of an object during object graph traversal.%NThis happens in TUPLE containing objects with copy-semantics or in SPECIAL[XX],%Nwhere XX is a user-defined expanded type.")
			l_exception.raise
		end
	
note
	copyright: "Copyright (c) 1984-2017, Eiffel Software and others"
	license: "Eiffel Forum License v2 (see http://www.eiffel.com/licensing/forum.txt)"
	source: "[
		Eiffel Software
		5949 Hollister Ave., Goleta, CA 93117 USA
		Telephone 805-685-1006, Fax 805-685-6869
		Website http://www.eiffel.com
		Customer support http://support.eiffel.com
	]"

end -- class OBJECT_GRAPH_TRAVERSABLE

Generated by ISE EiffelStudio