articleCreating a .NET delegate object from an Eiffel routine

manus_eiffel's picture

Someone recently asked me how to create a .NET delegate from an Eiffel routine. Ideally it would be nice to simply do:

	my_delegate := (agent my_routine).to_delegate

where `to_delegate' is a query from the ROUTINE class. However this feature does not yet exist. Instead I've devised a simple way to create a delegate given a routine name of the Current class:

	my_delegate := new_delegate ("my_routine")

Where new_delegate is defined as:

	new_delegate (a_name: STRING): DELEGATE
			-- Using `a_name' routine from the current class creates its corresponding
			-- .NET delegate if found, Void otherwise.
		require
			a_name_not_void: a_name /= Void
		local
			l_obj: SYSTEM_OBJECT
			l_method_info: METHOD_INFO
			l_params: NATIVE_ARRAY [SYSTEM_TYPE]
			l_delegate_type: SYSTEM_TYPE
			i, nb: INTEGER
		do
			l_obj := Current
				-- Obtain the associated MethodInfo for routine `a_name' from Current.
				-- Use the Eiffel name first and if we cannot find it, then the PascalCase version
				-- of the name (This is an EiffelStudio project settings for .NET code generation).
			l_method_info := l_obj.get_type.get_method (a_name)
			if l_method_info = Void then
				l_method_info := l_obj.get_type.get_method (pascal_case (a_name))
			end
 
				-- If not MethodInfo was found, the name was incorrect and we simply return Void.
			if l_method_info /= Void then
				if attached l_method_info.get_parameters as l_infos then
					from:= 0
						nb := l_infos.count
						create l_params.make (nb + 1)
					until
						i = nb
					loop
						l_params.put (i + 1, l_infos.item (i).parameter_type):= i + 1
					end
				end
					-- Always the type of Current as first argument
					-- (Eiffel always generates instance methods).
				l_params.put (0, l_obj.get_type)
				l_delegate_type := new_delegate_type (l_method_info.return_type, l_params)
				if l_delegate_type /= Void then
					Result := {DELEGATE}.create_delegate (l_delegate_type, l_method_info, True)
				end
			end
		end
 
	new_delegate_type (a_return_type: SYSTEM_TYPE; a_parameters: NATIVE_ARRAY [SYSTEM_TYPE]): SYSTEM_TYPE
		local
			l_name: ASSEMBLY_NAME
			l_assembly: ASSEMBLY_BUILDER
			l_module: MODULE_BUILDER
			l_type: TYPE_BUILDER
			l_constructor: CONSTRUCTOR_BUILDER
			l_invoke: METHOD_BUILDER
		do
				-- Creating the assembly holding the delegate type
			create l_name.make ("DelegateDynamicAssembly" + counter.item.out)
 
			l_assembly := {APP_DOMAIN}.current_domain.define_dynamic_assembly (l_name,
				{ASSEMBLY_BUILDER_ACCESS}.run_and_save)
 
			l_module := l_assembly.define_dynamic_module (l_name.name,
				{SYSTEM_STRING}.concat (l_name.name, dll_extension))
 
				-- Creating the delegate type
			l_type := l_module.define_type ("Delegate" + counter.item.out,
				{TYPE_ATTRIBUTES}.Public | {TYPE_ATTRIBUTES}.sealed | {TYPE_ATTRIBUTES}.ansi_class |
					{TYPE_ATTRIBUTES}.auto_class,
				{MULTICAST_DELEGATE})
 
				-- Creating the .ctor
			l_constructor := l_type.define_constructor (
				{METHOD_ATTRIBUTES}.public | {METHOD_ATTRIBUTES}.special_name |
					{METHOD_ATTRIBUTES}.rt_special_name | {METHOD_ATTRIBUTES}.hide_by_sig,
				{CALLING_CONVENTIONS}.standard, << ({SYSTEM_OBJECT}).to_cil, ({POINTER}).to_cil >> )
 
			l_constructor.set_implementation_flags ({METHOD_IMPL_ATTRIBUTES}.runtime |
				{METHOD_IMPL_ATTRIBUTES}.managed)
 
				-- Create `invoke'
			l_invoke := l_type.define_method ("Invoke",
				{METHOD_ATTRIBUTES}.public | {METHOD_ATTRIBUTES}.hide_by_sig | 
					{METHOD_ATTRIBUTES}.new_slot | {METHOD_ATTRIBUTES}.virtual,
				{CALLING_CONVENTIONS}.standard,
				a_return_type, a_parameters)
 
			l_invoke.set_implementation_flags ({METHOD_IMPL_ATTRIBUTES}.runtime | 
				{METHOD_IMPL_ATTRIBUTES}.managed)
 
			Result := l_type.create_type
			l_assembly.save ({SYSTEM_STRING}.concat (l_name.name, dll_extension))
 
				-- Increment our counter
			counter.put (counter.item + 1)
		end
 
	dll_extension: SYSTEM_STRING = ".dll"
			-- Extension for assembly/module
 
	pascal_case (name: STRING): STRING
			-- Convert `name' using PascalCasing convention.
		require
			name_not_void: name /= Void
			name_not_empty: not name.is_empty
		local
			i, nb: INTEGER
			l_c: CHARACTER
		do
			Result := name
			Result := Result.twin
			from:= 2
				nb := Result.count
				Result.put (Result.item (1).upper, 1)
			until
				i > nb
			loop
					-- When we encounter a '_' we delete it if it is not the last one
					-- in `Result' and the character following the `_' has its case
					-- changed  to upper.
				l_c := Result.item (i)
				if l_c = '_' and i < nb then
					l_c := Result.item (i + 1)
					if l_c.upper /= l_c then
						Result.remove (i)
						nb := nb - 1
						Result.put (l_c.upper, i)
					end
				end:= i + 1
			end
		ensure
			result_not_void: Result /= Void
		end
 
	counter: CELL [INTEGER]
		once
			create Result.put (1)
		end

Comments

Not type-safe

peter_gummer's picture

Relying on a string to find the routine would have the usual problems of reflection: it would be slow and not type-safe.

Never said it was the ideal

manus_eiffel's picture

Never said it was the ideal solution :-) It is what you can get now without compiler support or changes in the agent classes.

What about the $ operator?

peter_gummer's picture

I seem to recall using the $ operator to get a new delegate. This would have been several years ago. Is my memory failing me, or has something changed?

The issue I'm trying to

manus_eiffel's picture

The issue I'm trying to resolve in this article is the creation of a proper delegate type and from that type to create an instance of it.

If you already have a delegate type handy, then indeed you just need to do:

delegate: DELEGATE_TYPE
 
create delegate.make (Current, $my_routine)
.

Syndicate content