note
	description: "[
		Encoding of arbitrary objects graphs within a session of a same program.
		
		Some routines are explicitely frozen, not because we do not want them to be redefined
		but if they are frozen, it saves us having to look at all possible descendants whenever
		we do a change.
	]"
	legal: "See notice at end of class."
	status: "See notice at end of class."
	date: "$Date: 2017-03-28 12:36:24 +0000 (Tue, 28 Mar 2017) $"
	revision: "$Revision: 100064 $"

class 
	SED_SESSION_SERIALIZER

create 
	make

feature {NONE} -- Initialization

	default_create
			-- Process instances of classes with no creation clause.
			-- (Default: do nothing.)
			-- (from ANY)
		do
		end

	make (a_serializer: SED_READER_WRITER)
			-- Initialize current instance
		require
			a_serializer_not_void: a_serializer /= Void
			a_serializer_ready: a_serializer.is_ready_for_writing
		do
			create reflector
			create reflected_object.make (reflector)
			create object_indexes.make (1)
			traversable := Breadth_first_traversable
			serializer := a_serializer
			set_version ({SED_VERSIONS}.version_7_3)
		ensure
			serializer_set: serializer = a_serializer
		end
	
feature -- Access

	generating_type: TYPE [detachable SED_SESSION_SERIALIZER]
			-- Type of current object
			-- (type of which it is a direct instance)
			-- (from ANY)
		external
			"built_in"
		ensure -- from ANY
			generating_type_not_void: Result /= Void
		end

	generator: STRING_8
			-- Name of current object's generating class
			-- (base class of the type of which it is a direct instance)
			-- (from ANY)
		external
			"built_in"
		ensure -- from ANY
			generator_not_void: Result /= Void
			generator_not_empty: not Result.is_empty
		end

	root_object: detachable ANY
			-- Root object of object graph
		do
			Result := traversable.root_object
		end

	serializer: SED_READER_WRITER
			-- Serializer used to encode data
	
feature -- Comparison

	frozen deep_equal (a: detachable ANY; b: like arg #1): BOOLEAN
			-- Are a and b either both void
			-- or attached to isomorphic object structures?
			-- (from ANY)
		do
			if a = Void then
				Result := b = Void
			else
				Result := b /= Void and then a.is_deep_equal (b)
			end
		ensure -- from ANY
			instance_free: class
			shallow_implies_deep: standard_equal (a, b) implies Result
			both_or_none_void: (a = Void) implies (Result = (b = Void))
			same_type: (Result and (a /= Void)) implies (b /= Void and then a.same_type (b))
			symmetric: Result implies deep_equal (b, a)
		end

	frozen equal (a: detachable ANY; b: like arg #1): BOOLEAN
			-- Are a and b either both void or attached
			-- to objects considered equal?
			-- (from ANY)
		do
			if a = Void then
				Result := b = Void
			else
				Result := b /= Void and then a.is_equal (b)
			end
		ensure -- from ANY
			instance_free: class
			definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.is_equal (b))
		end

	frozen is_deep_equal alias "≡≡≡" (other: SED_SESSION_SERIALIZER): BOOLEAN
			-- Are Current and other attached to isomorphic object structures?
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
		external
			"built_in"
		ensure -- from ANY
			shallow_implies_deep: standard_is_equal (other) implies Result
			same_type: Result implies same_type (other)
			symmetric: Result implies other.is_deep_equal (Current)
		end

	is_equal (other: SED_SESSION_SERIALIZER): BOOLEAN
			-- Is other attached to an object considered
			-- equal to current object?
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
		external
			"built_in"
		ensure -- from ANY
			symmetric: Result implies other ~ Current
			consistent: standard_is_equal (other) implies Result
		end

	frozen standard_equal (a: detachable ANY; b: like arg #1): BOOLEAN
			-- Are a and b either both void or attached to
			-- field-by-field identical objects of the same type?
			-- Always uses default object comparison criterion.
			-- (from ANY)
		do
			if a = Void then
				Result := b = Void
			else
				Result := b /= Void and then a.standard_is_equal (b)
			end
		ensure -- from ANY
			instance_free: class
			definition: Result = (a = Void and b = Void) or else ((a /= Void and b /= Void) and then a.standard_is_equal (b))
		end

	frozen standard_is_equal alias "≜" (other: SED_SESSION_SERIALIZER): BOOLEAN
			-- Is other attached to an object of the same type
			-- as current object, and field-by-field identical to it?
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
		external
			"built_in"
		ensure -- from ANY
			same_type: Result implies same_type (other)
			symmetric: Result implies other.standard_is_equal (Current)
		end
	
feature -- Status report

	conforms_to (other: ANY): BOOLEAN
			-- Does type of current object conform to type
			-- of other (as per Eiffel: The Language, chapter 13)?
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
		external
			"built_in"
		end

	is_root_object_set: BOOLEAN
			-- Is root object of object graph set?

	is_traversing_mode_set: BOOLEAN
			-- Is traversing mode set?
		do
			Result := traversable /= Void
		end

	same_type (other: ANY): BOOLEAN
			-- Is type of current object identical to type of other?
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
		external
			"built_in"
		ensure -- from ANY
			definition: Result = (conforms_to (other) and other.conforms_to (Current))
		end
	
feature {NONE} -- Status report

	has_reference_with_copy_semantics: BOOLEAN
			-- Does serialized data have some reference with copy semantics?
			-- If none, we optimize the serialization of references by not emitting
			-- a boolean switch each time we refer to an object.

	is_store_settings_enabled: BOOLEAN
			-- Are settings stored?
			-- By default not for SED_INDEPENDENT_SERIALIZER.
		do
			Result := True
		end
	
feature -- Element change

	set_breadth_first_traversing_mode
			-- Change graph traversing to breadth first.
		do
			traversable := Breadth_first_traversable
		ensure
			traversing_mode_set: is_traversing_mode_set
			breadth_first_mode: attached {OBJECT_GRAPH_BREADTH_FIRST_TRAVERSABLE} traversable
		end

	set_depth_first_traversing_mode
			-- Change graph traversing to depth first.
		do
			traversable := Depth_first_traversable
		ensure
			traversing_mode_set: is_traversing_mode_set
			depth_first_mode: attached {OBJECT_GRAPH_DEPTH_FIRST_TRAVERSABLE} traversable
		end

	set_root_object (an_object: like root_object)
			-- Make 'an_object' the root_object.
		require
			an_object_not_void: an_object /= Void
			traversing_mode_set: is_traversing_mode_set
		do
			traversable.set_root_object (an_object)
			is_root_object_set := True
		ensure
			root_object_set: root_object = an_object and is_root_object_set
			root_object_identity: root_object = traversable.root_object
		end

	set_serializer (a_serializer: like serializer)
			-- Set serializer with a_serializer.
		require
			a_serializer_not_void: a_serializer /= Void
			a_serializer_ready: a_serializer.is_ready_for_writing
		do
			serializer := a_serializer
		ensure
			serializer_set: serializer = a_serializer
		end
	
feature -- Duplication

	frozen clone (other: detachable ANY): like other
		obsolete "Use `twin' instead. [2017-05-31]"
			-- Void if other is void; otherwise new object
			-- equal to other
			--
			-- For non-void other, clone calls copy;
			-- to change copying/cloning semantics, redefine copy.
			-- (from ANY)
		do
			if other /= Void then
				Result := other.twin
			end
		ensure -- from ANY
			instance_free: class
			equal: Result ~ other
		end

	copy (other: SED_SESSION_SERIALIZER)
			-- Update current object using fields of object attached
			-- to other, so as to yield equal objects.
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
			type_identity: same_type (other)
		external
			"built_in"
		ensure -- from ANY
			is_equal: Current ~ other
		end

	frozen deep_clone (other: detachable ANY): like other
		obsolete "Use `deep_twin' instead. [2017-05-31]"
			-- Void if other is void: otherwise, new object structure
			-- recursively duplicated from the one attached to other
			-- (from ANY)
		do
			if other /= Void then
				Result := other.deep_twin
			end
		ensure -- from ANY
			instance_free: class
			deep_equal: deep_equal (other, Result)
		end

	frozen deep_copy (other: SED_SESSION_SERIALIZER)
			-- Effect equivalent to that of:
			--		copy (other . deep_twin)
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
		do
			copy (other.deep_twin)
		ensure -- from ANY
			deep_equal: deep_equal (Current, other)
		end

	frozen deep_twin: SED_SESSION_SERIALIZER
			-- New object structure recursively duplicated from Current.
			-- (from ANY)
		external
			"built_in"
		ensure -- from ANY
			deep_twin_not_void: Result /= Void
			deep_equal: deep_equal (Current, Result)
		end

	frozen standard_clone (other: detachable ANY): like other
		obsolete "Use `standard_twin' instead. [2017-05-31]"
			-- Void if other is void; otherwise new object
			-- field-by-field identical to other.
			-- Always uses default copying semantics.
			-- (from ANY)
		do
			if other /= Void then
				Result := other.standard_twin
			end
		ensure -- from ANY
			instance_free: class
			equal: standard_equal (Result, other)
		end

	frozen standard_copy (other: SED_SESSION_SERIALIZER)
			-- Copy every field of other onto corresponding field
			-- of current object.
			-- (from ANY)
		require -- from ANY
			other_not_void: other /= Void
			type_identity: same_type (other)
		external
			"built_in"
		ensure -- from ANY
			is_standard_equal: standard_is_equal (other)
		end

	frozen standard_twin: SED_SESSION_SERIALIZER
			-- New object field-by-field identical to other.
			-- Always uses default copying semantics.
			-- (from ANY)
		external
			"built_in"
		ensure -- from ANY
			standard_twin_not_void: Result /= Void
			equal: standard_equal (Result, Current)
		end

	frozen twin: SED_SESSION_SERIALIZER
			-- New object equal to Current
			-- twin calls copy; to change copying/twinning semantics, redefine copy.
			-- (from ANY)
		external
			"built_in"
		ensure -- from ANY
			twin_not_void: Result /= Void
			is_equal: Result ~ Current
		end
	
feature -- Basic operations

	frozen as_attached: attached SED_SESSION_SERIALIZER
		obsolete "Remove calls to this feature. [2017-05-31]"
			-- Attached version of Current.
			-- (Can be used during transitional period to convert
			-- non-void-safe classes to void-safe ones.)
			-- (from ANY)
		do
			Result := Current
		end

	frozen default: detachable SED_SESSION_SERIALIZER
			-- Default value of object's type
			-- (from ANY)
		do
		end

	frozen default_pointer: POINTER
			-- Default value of type POINTER
			-- (Avoid the need to write p.default for
			-- some p of type POINTER.)
			-- (from ANY)
		do
		ensure -- from ANY
			instance_free: class
		end

	default_rescue
			-- Process exception for routines with no Rescue clause.
			-- (Default: do nothing.)
			-- (from ANY)
		do
		end

	frozen do_nothing
			-- Execute a null action.
			-- (from ANY)
		do
		ensure -- from ANY
			instance_free: class
		end

	frozen encode
			-- Encode object graph starting with the root object.
		require
			traversing_mode_set: is_traversing_mode_set
			root_object_set: is_root_object_set
		local
			l_mem: detachable MEMORY
			l_is_collecting: BOOLEAN
			l_list_count: NATURAL_32
		do
			if not {PLATFORM}.is_dotnet then
				create l_mem
				l_is_collecting := l_mem.collecting;
				l_mem.collection_off
			end;
			traversable.set_is_skip_transient (True);
			traversable.set_is_skip_copy_semantics_reference (True);
			traversable.traverse
			if attached traversable.visited_objects as l_list and then attached traversable.visited_types as l_type_table then
				has_reference_with_copy_semantics := traversable.has_reference_with_copy_semantics
				l_list_count := l_list.count.to_natural_32
				if l_list.count > object_indexes.capacity then
					create object_indexes.make (l_list_count)
				end;
				serializer.write_compressed_natural_32 (l_list_count)
				write_header (l_list, l_type_table)
				encode_objects (l_list)
			end;
			traversable.wipe_out;
			object_indexes.wipe_out
			if l_mem /= Void and then l_is_collecting then
				l_mem.collection_on
			end
		end
	
feature {NONE} -- Implementation

	abstract_type (a_type_id: INTEGER_32): INTEGER_32
			-- Abstract type of a_type_id.
			-- (from SED_UTILITIES)
		require -- from SED_UTILITIES
			a_type_id_non_negative: a_type_id >= 0
		local
			l_spec_mapping: like Special_type_mapping
		do
			l_spec_mapping := Special_type_mapping;
			l_spec_mapping.search (a_type_id)
			if l_spec_mapping.found then
				Result := l_spec_mapping.found_item
			else
				Result := {REFLECTOR_CONSTANTS}.reference_type
			end
		end

	frozen encode_normal_object (a_reflected_object: REFLECTED_OBJECT)
			-- Encode normal object a_reflected_object.
		local
			i, nb: INTEGER_32
			l_ser: like serializer
			l_exp: REFLECTED_COPY_SEMANTICS_OBJECT
		do
			from
				l_ser := serializer
				i := 1
				nb := a_reflected_object.field_count + 1
			until
				i = nb
			loop
				if not a_reflected_object.is_field_transient (i) then
					inspect a_reflected_object.field_type (i)
					when {REFLECTOR_CONSTANTS}.boolean_type then
						l_ser.write_boolean (a_reflected_object.boolean_field (i))
					when {REFLECTOR_CONSTANTS}.character_8_type then
						l_ser.write_character_8 (a_reflected_object.character_8_field (i))
					when {REFLECTOR_CONSTANTS}.character_32_type then
						l_ser.write_character_32 (a_reflected_object.character_32_field (i))
					when {REFLECTOR_CONSTANTS}.natural_8_type then
						l_ser.write_natural_8 (a_reflected_object.natural_8_field (i))
					when {REFLECTOR_CONSTANTS}.natural_16_type then
						l_ser.write_natural_16 (a_reflected_object.natural_16_field (i))
					when {REFLECTOR_CONSTANTS}.natural_32_type then
						l_ser.write_natural_32 (a_reflected_object.natural_32_field (i))
					when {REFLECTOR_CONSTANTS}.natural_64_type then
						l_ser.write_natural_64 (a_reflected_object.natural_64_field (i))
					when {REFLECTOR_CONSTANTS}.integer_8_type then
						l_ser.write_integer_8 (a_reflected_object.integer_8_field (i))
					when {REFLECTOR_CONSTANTS}.integer_16_type then
						l_ser.write_integer_16 (a_reflected_object.integer_16_field (i))
					when {REFLECTOR_CONSTANTS}.integer_32_type then
						l_ser.write_integer_32 (a_reflected_object.integer_32_field (i))
					when {REFLECTOR_CONSTANTS}.integer_64_type then
						l_ser.write_integer_64 (a_reflected_object.integer_64_field (i))
					when {REFLECTOR_CONSTANTS}.real_32_type then
						l_ser.write_real_32 (a_reflected_object.real_32_field (i))
					when {REFLECTOR_CONSTANTS}.real_64_type then
						l_ser.write_real_64 (a_reflected_object.real_64_field (i))
					when {REFLECTOR_CONSTANTS}.pointer_type then
						l_ser.write_pointer (a_reflected_object.pointer_field (i))
					when {REFLECTOR_CONSTANTS}.reference_type then
						if has_reference_with_copy_semantics then
							if a_reflected_object.is_copy_semantics_field (i) then
								l_ser.write_boolean (True)
								l_exp := a_reflected_object.copy_semantics_field (i);
								l_ser.write_compressed_integer_32 (l_exp.dynamic_type)
								encode_normal_object (l_exp)
							else
								l_ser.write_boolean (False)
								encode_reference (a_reflected_object.reference_field (i))
							end
						else
							encode_reference (a_reflected_object.reference_field (i))
						end
					when {REFLECTOR_CONSTANTS}.expanded_type then
						l_ser.write_compressed_integer_32 (a_reflected_object.dynamic_type)
						encode_normal_object (a_reflected_object.expanded_field (i))
					else
						check
								False
						end
					end
				end
				i := i + 1
			end
		end

	frozen encode_objects (a_list: ARRAYED_LIST [separate ANY])
			-- Encode all objects referenced in a_list.
		require
			a_list_not_void: a_list /= Void
			a_list_not_empty: not a_list.is_empty
		local
			l_reflected_object: like reflected_object
			l_ser: like serializer
			l_object_indexes: like object_indexes
			l_obj: separate ANY
			i, nb: INTEGER_32
			l_area: SPECIAL [separate ANY]
			l_obj_index: NATURAL_32
		do
			l_reflected_object := reflected_object
			l_ser := serializer
			l_object_indexes := object_indexes
			from
				l_area := a_list.area
				i := 0
				nb := a_list.count
			until
				i = nb
			loop
				l_obj := l_area.item (i);
				l_reflected_object.set_object (l_obj)
				i := i + 1
				l_obj_index := l_object_indexes.index (l_obj);
				l_ser.write_compressed_natural_32 (l_obj_index)
				check
						l_obj_index = i.as_natural_32
				end
				if l_reflected_object.is_special then
					encode_special (l_obj, abstract_type (l_reflected_object.generic_dynamic_type (1)))
				elseif l_reflected_object.is_tuple then
					if attached {TUPLE} l_obj as l_tuple then
						encode_tuple_object (l_tuple)
					else
						check
							l_tuple_attached: False
						end
					end
				else
					encode_normal_object (l_reflected_object)
				end
			end
		end

	frozen encode_reference (an_object: detachable separate ANY)
			-- Encode reference to an_object.
		do
			if an_object /= Void then
				serializer.write_compressed_natural_32 (object_indexes.index (an_object))
			else
				serializer.write_compressed_natural_32 (0)
			end
		end

	frozen encode_special (an_object: separate ANY; a_item_type: INTEGER_32)
			-- Encode an object which is a special object.
		require
			an_object_not_void: an_object /= Void
			an_object_is_special: attached {separate SPECIAL [detachable ANY]} an_object
			a_item_type_non_negative: a_item_type >= 0
		do
			inspect a_item_type
			when {REFLECTOR_CONSTANTS}.boolean_type then
				if attached {SPECIAL [BOOLEAN]} an_object as l_spec_boolean then
					encode_special_boolean (l_spec_boolean)
				else
					check
						l_spec_boolean_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.character_8_type then
				if attached {SPECIAL [CHARACTER_8]} an_object as l_spec_character_8 then
					encode_special_character_8 (l_spec_character_8)
				else
					check
						l_spec_character_8_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.character_32_type, {REFLECTOR_CONSTANTS}.natural_32_type then
				if attached {SPECIAL [CHARACTER_32]} an_object as l_spec_character_32 then
					encode_special_character_32 (l_spec_character_32)
				elseif attached {SPECIAL [NATURAL_32]} an_object as l_spec_natural_32 then
					encode_special_natural_32 (l_spec_natural_32)
				else
					check
						l_spec_natural_32_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.natural_8_type then
				if attached {SPECIAL [NATURAL_8]} an_object as l_spec_natural_8 then
					encode_special_natural_8 (l_spec_natural_8)
				else
					check
						l_spec_natural_8_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.natural_16_type then
				if attached {SPECIAL [NATURAL_16]} an_object as l_spec_natural_16 then
					encode_special_natural_16 (l_spec_natural_16)
				else
					check
						l_spec_natural_16_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.natural_64_type then
				if attached {SPECIAL [NATURAL_64]} an_object as l_spec_natural_64 then
					encode_special_natural_64 (l_spec_natural_64)
				else
					check
						l_spec_natural_64_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.integer_8_type then
				if attached {SPECIAL [INTEGER_8]} an_object as l_spec_integer_8 then
					encode_special_integer_8 (l_spec_integer_8)
				else
					check
						l_spec_integer_8_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.integer_16_type then
				if attached {SPECIAL [INTEGER_16]} an_object as l_spec_integer_16 then
					encode_special_integer_16 (l_spec_integer_16)
				else
					check
						l_spec_integer_16_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.integer_32_type then
				if attached {SPECIAL [INTEGER_32]} an_object as l_spec_integer_32 then
					encode_special_integer_32 (l_spec_integer_32)
				else
					check
						l_spec_integer_32_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.integer_64_type then
				if attached {SPECIAL [INTEGER_64]} an_object as l_spec_integer_64 then
					encode_special_integer_64 (l_spec_integer_64)
				else
					check
						l_spec_integer_64_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.real_32_type then
				if attached {SPECIAL [REAL_32]} an_object as l_spec_real_32 then
					encode_special_real_32 (l_spec_real_32)
				else
					check
						l_spec_real_32_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.real_64_type then
				if attached {SPECIAL [REAL_64]} an_object as l_spec_real_64 then
					encode_special_real_64 (l_spec_real_64)
				else
					check
						l_spec_real_64_not_void: False
					end
				end
			when {REFLECTOR_CONSTANTS}.pointer_type then
				if attached {SPECIAL [POINTER]} an_object as l_spec_pointer then
					encode_special_pointer (l_spec_pointer)
				else
					check
						l_spec_pointer_not_void: False
					end
				end
			else
				check
					a_item_type_valid: a_item_type = {REFLECTOR_CONSTANTS}.reference_type
				end
				if attached {SPECIAL [detachable ANY]} an_object as l_spec_any then
					encode_special_reference (l_spec_any)
				else
					check
						l_spec_any_not_void: False
					end
				end
			end
		end

	frozen encode_special_boolean (a_spec: SPECIAL [BOOLEAN])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_boolean (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_character_32 (a_spec: SPECIAL [CHARACTER_32])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_character_32 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_character_8 (a_spec: SPECIAL [CHARACTER_8])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_character_8 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_integer_16 (a_spec: SPECIAL [INTEGER_16])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_integer_16 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_integer_32 (a_spec: SPECIAL [INTEGER_32])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_integer_32 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_integer_64 (a_spec: SPECIAL [INTEGER_64])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_integer_64 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_integer_8 (a_spec: SPECIAL [INTEGER_8])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_integer_8 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_natural_16 (a_spec: SPECIAL [NATURAL_16])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_natural_16 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_natural_32 (a_spec: SPECIAL [NATURAL_32])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_natural_32 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_natural_64 (a_spec: SPECIAL [NATURAL_64])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_natural_64 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_natural_8 (a_spec: SPECIAL [NATURAL_8])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_natural_8 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_pointer (a_spec: SPECIAL [POINTER])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_pointer (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_real_32 (a_spec: SPECIAL [REAL_32])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_real_32 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_real_64 (a_spec: SPECIAL [REAL_64])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_ser: like serializer
		do
			from
				nb := a_spec.count
				l_ser := serializer;
				l_ser.write_compressed_integer_32 (nb)
			until
				i = nb
			loop
				l_ser.write_real_64 (a_spec.item (i))
				i := i + 1
			end
		end

	frozen encode_special_reference (a_spec: SPECIAL [detachable ANY])
			-- Encode a_spec.
		require
			a_spec_not_void: a_spec /= Void
		local
			i, nb: INTEGER_32
			l_reflected_object: like reflected_object
			l_exp: REFLECTED_COPY_SEMANTICS_OBJECT
			l_ser: like serializer
			l_has_copy_semantics: BOOLEAN
		do
			l_ser := serializer
			nb := a_spec.count;
			l_ser.write_compressed_integer_32 (nb)
			if version >= {SED_VERSIONS}.version_7_3 then
				from
					l_reflected_object := reflected_object;
					l_reflected_object.set_object (a_spec)
				until
					i = nb
				loop
					if l_reflected_object.is_special_copy_semantics_item (i) then
						l_has_copy_semantics := True
						i := nb - 1
					end
					i := i + 1
				end;
				l_ser.write_boolean (l_has_copy_semantics)
				if l_has_copy_semantics then
					from
						i := 0
					until
						i = nb
					loop
						if l_reflected_object.is_special_copy_semantics_item (i) then
							l_ser.write_boolean (True)
							l_exp := l_reflected_object.special_copy_semantics_item (i);
							l_ser.write_compressed_integer_32 (l_exp.dynamic_type)
							encode_normal_object (l_exp)
						else
							l_ser.write_boolean (False)
							encode_reference (a_spec.item (i))
						end
						i := i + 1
					end
				end
			end
			if not l_has_copy_semantics then
				from
					i := 0
				until
					i = nb
				loop
					encode_reference (a_spec.item (i))
					i := i + 1
				end
			end
		end

	frozen encode_tuple_object (a_tuple: TUPLE)
			-- Encode a TUPLE object.
		require
			a_tuple_not_void: a_tuple /= Void
		local
			i, nb: INTEGER_32
			l_code: NATURAL_8
			l_ser: like serializer
		do
			from
				l_ser := serializer
				i := 1
				nb := a_tuple.count + 1
			until
				i = nb
			loop
				l_code := a_tuple.item_code (i);
				l_ser.write_natural_8 (l_code)
				inspect l_code
				when {TUPLE}.boolean_code then
					l_ser.write_boolean (a_tuple.boolean_item (i))
				when {TUPLE}.character_8_code then
					l_ser.write_character_8 (a_tuple.character_8_item (i))
				when {TUPLE}.character_32_code then
					l_ser.write_character_32 (a_tuple.character_32_item (i))
				when {TUPLE}.natural_8_code then
					l_ser.write_natural_8 (a_tuple.natural_8_item (i))
				when {TUPLE}.natural_16_code then
					l_ser.write_natural_16 (a_tuple.natural_16_item (i))
				when {TUPLE}.natural_32_code then
					l_ser.write_natural_32 (a_tuple.natural_32_item (i))
				when {TUPLE}.natural_64_code then
					l_ser.write_natural_64 (a_tuple.natural_64_item (i))
				when {TUPLE}.integer_8_code then
					l_ser.write_integer_8 (a_tuple.integer_8_item (i))
				when {TUPLE}.integer_16_code then
					l_ser.write_integer_16 (a_tuple.integer_16_item (i))
				when {TUPLE}.integer_32_code then
					l_ser.write_integer_32 (a_tuple.integer_32_item (i))
				when {TUPLE}.integer_64_code then
					l_ser.write_integer_64 (a_tuple.integer_64_item (i))
				when {TUPLE}.real_32_code then
					l_ser.write_real_32 (a_tuple.real_32_item (i))
				when {TUPLE}.real_64_code then
					l_ser.write_real_64 (a_tuple.real_64_item (i))
				when {TUPLE}.pointer_code then
					l_ser.write_pointer (a_tuple.pointer_item (i))
				when {TUPLE}.reference_code then
					encode_reference (a_tuple.reference_item (i))
				else
					check
							False
					end
				end
				i := i + 1
			end
		end

	Is_special_flag: NATURAL_8 = 1
			-- (from SED_UTILITIES)

	Is_tuple_flag: NATURAL_8 = 2
			-- Various flags for storing objects
			-- (from SED_UTILITIES)

	Is_void_safe: BOOLEAN
			-- Is current system compiled in void-safe mode?
			-- (from SED_UTILITIES)
		once
			Result := {SPECIAL [ANY]} /= {SPECIAL [detachable ANY]}
		end

	Special_type_mapping: HASH_TABLE [INTEGER_32, INTEGER_32]
			-- Mapping betwwen dynamic type of SPECIAL instances
			-- to abstract element types.
			-- (from SED_UTILITIES)
		once
			create Result.make (10);
			Result.put ({REFLECTOR_CONSTANTS}.boolean_type, ({BOOLEAN}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.character_8_type, ({CHARACTER_8}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.character_32_type, ({CHARACTER_32}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.natural_8_type, ({NATURAL_8}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.natural_16_type, ({NATURAL_16}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.natural_32_type, ({NATURAL_32}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.natural_64_type, ({NATURAL_64}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.integer_8_type, ({INTEGER_8}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.integer_16_type, ({INTEGER_16}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.integer_32_type, ({INTEGER_32}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.integer_64_type, ({INTEGER_64}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.real_32_type, ({REAL_32}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.real_64_type, ({REAL_64}).type_id);
			Result.put ({REFLECTOR_CONSTANTS}.pointer_type, ({POINTER}).type_id)
		ensure -- from SED_UTILITIES
			special_type_mapping_not_void: Result /= Void
		end

	write_header (a_list: ARRAYED_LIST [separate ANY]; a_type_table: HASH_TABLE [INTEGER_32, INTEGER_32])
			-- Operation performed before encoding_objects.
		require
			a_list_not_void: a_list /= Void
			a_list_not_empty: not a_list.is_empty
		do
			write_settings
			write_object_table (a_list)
		end

	frozen write_object_table (a_list: ARRAYED_LIST [separate ANY])
			-- Write mapping between object's reference ID in a_list with
			-- all the necessary information necessary to recreate it at a
			-- later time.
		require
			a_list_not_void: a_list /= Void
			a_list_not_empty: not a_list.is_empty
		local
			l_reflected_object: like reflected_object
			l_ser: like serializer
			l_object_indexes: like object_indexes
			i, nb: INTEGER_32
			l_obj: separate ANY
			l_area: SPECIAL [separate ANY]
		do
			l_ser := serializer;
			l_ser.write_boolean (True)
			l_reflected_object := reflected_object
			l_object_indexes := object_indexes
			from
				l_area := a_list.area
				i := 0
				nb := a_list.count
			until
				i = nb
			loop
				l_obj := l_area.item (i);
				l_reflected_object.set_object (l_obj)
				i := i + 1;
				l_ser.write_compressed_natural_32 (l_reflected_object.dynamic_type.to_natural_32);
				l_ser.write_compressed_natural_32 (l_object_indexes.index (l_obj))
				if l_reflected_object.is_special then
					l_ser.write_natural_8 (Is_special_flag);
					l_ser.write_compressed_integer_32 (abstract_type (l_reflected_object.generic_dynamic_type (1)))
					if attached {ABSTRACT_SPECIAL} l_obj as l_abstract_spec then
						l_ser.write_compressed_integer_32 (l_abstract_spec.capacity)
					else
						check
							l_abstract_spec_attached: False
						end
					end
				elseif l_reflected_object.is_tuple then
					l_ser.write_natural_8 (Is_tuple_flag)
				else
					l_ser.write_natural_8 (0)
				end
			end
		end

	frozen write_settings
		do
			if is_store_settings_enabled then
				serializer.write_compressed_natural_32 (version);
				serializer.write_boolean (has_reference_with_copy_semantics)
			end
		end
	
feature {NONE} -- Implementation: Access

	Breadth_first_traversable: OBJECT_GRAPH_BREADTH_FIRST_TRAVERSABLE
			-- Return an instance of OBJECT_GRAPH_BREADTH_FIRST_TRAVERSABLE.
		once
			Result := create {OBJECT_GRAPH_BREADTH_FIRST_TRAVERSABLE}
		end

	Depth_first_traversable: OBJECT_GRAPH_DEPTH_FIRST_TRAVERSABLE
			-- Return an instance of OBJECT_GRAPH_DEPTH_FIRST_TRAVERSABLE.
		once
			Result := create {OBJECT_GRAPH_DEPTH_FIRST_TRAVERSABLE}
		end

	object_indexes: SED_OBJECTS_TABLE
			-- Mapping between object and their associated index.

	reflected_object: REFLECTED_REFERENCE_OBJECT
			-- Facility to inspect object.

	reflector: REFLECTOR
			-- Facilities to inspect.

	traversable: OBJECT_GRAPH_TRAVERSABLE
			-- Object used for traversing object graph

	version: NATURAL_32
			-- Internal version of the format (See SED_VERSIONS for possible values).
	
feature {NONE} -- Implementation: Setting

	set_version (v: like version)
			-- Set version with v.
		do
			version := v
		end
	
feature -- Output

	Io: STD_FILES
			-- Handle to standard file setup
			-- (from ANY)
		once
			create Result;
			Result.set_output_default
		ensure -- from ANY
			instance_free: class
			io_not_void: Result /= Void
		end

	out: STRING_8
			-- New string containing terse printable representation
			-- of current object
			-- (from ANY)
		do
			Result := tagged_out
		ensure -- from ANY
			out_not_void: Result /= Void
		end

	print (o: detachable ANY)
			-- Write terse external representation of o
			-- on standard output.
			-- (from ANY)
		local
			s: READABLE_STRING_8
		do
			if attached o then
				s := o.out
				if attached {READABLE_STRING_32} s as s32 then
					Io.put_string_32 (s32)
				elseif attached {READABLE_STRING_8} s as s8 then
					Io.put_string (s8)
				else
					Io.put_string_32 (s.as_string_32)
				end
			end
		ensure -- from ANY
			instance_free: class
		end

	frozen tagged_out: STRING_8
			-- New string containing terse printable representation
			-- of current object
			-- (from ANY)
		external
			"built_in"
		ensure -- from ANY
			tagged_out_not_void: Result /= Void
		end
	
feature -- Platform

	Operating_environment: OPERATING_ENVIRONMENT
			-- Objects available from the operating system
			-- (from ANY)
		once
			create Result
		ensure -- from ANY
			instance_free: class
			operating_environment_not_void: Result /= Void
		end
	
feature {NONE} -- Retrieval

	frozen internal_correct_mismatch
			-- Called from runtime to perform a proper dynamic dispatch on correct_mismatch
			-- from MISMATCH_CORRECTOR.
			-- (from ANY)
		local
			l_msg: STRING_32
			l_exc: EXCEPTIONS
		do
			if attached {MISMATCH_CORRECTOR} Current as l_corrector then
				l_corrector.correct_mismatch
			else
				create l_msg.make_from_string ("Mismatch: ".as_string_32)
				create l_exc;
				l_msg.append (generating_type.name_32);
				l_exc.raise_retrieval_exception (l_msg)
			end
		end
	
invariant
	reflector_not_void: reflector /= Void
	reflected_object_not_void: reflected_object /= Void
	traversable_not_void: traversable /= Void
	serializer_not_void: serializer /= Void
	object_indexes_not_void: object_indexes /= Void

		-- from ANY
	reflexive_equality: standard_is_equal (Current)
	reflexive_conformance: conforms_to (Current)

note
	library: "EiffelBase: Library of reusable components for Eiffel."
	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 SED_SESSION_SERIALIZER

Generated by ISE EiffelStudio