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
i := 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 := 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
i := 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 := i + 1
end
ensure
result_not_void: Result /= Void
end
counter: CELL [INTEGER]
once
create Result.put (1)
end
Not type-safe
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 solution :-) It is what you can get now without compiler support or changes in the agent classes.
What about the $ operator?
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 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: