Dynamic Objects, Factories, and Runtime Machines to Boost Performance

Imports System.Reflection
Imports System.Reflection.Emit
Imports System.Threading
''' -----------------------------------------------------------------------------
''' Project	 : Widgets
''' Class	 : WidgetFactory
''' -----------------------------------------------------------------------------
''' <summary>
''' 
''' </summary>
''' <remarks>
''' </remarks>
''' <history>
''' 	[pliebscher]	7/20/2007	Created
''' </history>
''' -----------------------------------------------------------------------------
Public Class WidgetFactory

	' Cached Instance Benching - Practical in a real-world scenario.
	' --------------------------------------------------------------
	Private Shared _MachineCache As New Hashtable
	Private Shared _DelegateCache As New Hashtable
	Private Shared _ConstructorCache As New Hashtable
	Private Shared _IsInitialized As Boolean = InitCache()
	' --------------------------------------------------------------

	' Direct Instance Benching - Not practical as it defeats the
	' purpose of dynamic object creation. Used to determine the
	' caching overhead.
	' --------------------------------------------------------------
	Private Shared WonderWidgetMachine As IWidgetInstanceMachine = GetWidgetInstanceMachine(GetType(WonderWidget))
	' --------------------------------------------------------------

	Private Sub New()
	End Sub

	Public Shared Sub Init()
		' Dummy to init shared members...
	End Sub

#Region " -- ConstructorInfo -- "

	Public Shared Function GetWidgetByConstructorInfoCached(ByVal widgetType As Type) As Widget
		Dim Ctor As ConstructorInfo = DirectCast(_ConstructorCache(widgetType), ConstructorInfo)
		Return DirectCast(Ctor.Invoke(New Object() {}), Widget)
	End Function

	Public Shared Function GetWidgetByConstructorInfo(ByVal widgetType As Type) As Widget
		Return DirectCast(widgetType.GetConstructor(System.Type.EmptyTypes).Invoke(New Object() {}), Widget)
	End Function

#End Region

#Region " -- Activator -- "

	Public Shared Function GetWidgetBySystemActivator(ByVal widgetType As Type) As Widget
		Return DirectCast(Activator.CreateInstance(widgetType), Widget)
	End Function

#End Region

#Region " -- Delegate -- "

	Public Shared Function GetWidgetByDelegate(ByVal widgetType As Type) As Widget
		Return DirectCast(_DelegateCache(widgetType), GetInstanceDelegate).Invoke()
	End Function

#End Region

#Region " -- InstanceMachine -- "

	Public Shared Function GetWidgetFromMachineCache(ByVal widgetType As Type) As Widget
		Return DirectCast(_MachineCache(widgetType), IWidgetInstanceMachine).GetInstance()
	End Function

	Public Shared Function GetWidgetFromMachine(ByVal widgetType As Type) As Widget
		Return WonderWidgetMachine.GetInstance()
	End Function

	Private Shared Function GetWidgetInstanceMachine(ByVal widgetType As Type) As IWidgetInstanceMachine

		Dim Name As String = widgetType.FullName & "InstanceMachine"
		Dim AssemblyName As AssemblyName = New AssemblyName
		AssemblyName.Name = Name

		Dim SavePath As String = "C:\Temp"
		Dim TypeName As String = widgetType.Name & "Machine"

		' Define the assembly...
		Dim AssemblyBuilder As AssemblyBuilder = Thread.GetDomain().DefineDynamicAssembly(AssemblyName, AssemblyBuilderAccess.RunAndSave, SavePath)
		Dim ModuleBuilder As ModuleBuilder = AssemblyBuilder.DefineDynamicModule("Machine", Name & ".dll")

		' Define the class "Public Class SuperWidgetFactory"
		Dim TypeBuilder As TypeBuilder = ModuleBuilder.DefineType(TypeName, TypeAttributes.Public)

		' Implement our interface "Implements IWidgetInstanceMachine"
		TypeBuilder.AddInterfaceImplementation(GetType(IWidgetInstanceMachine))

		' Define the constructor "Public Sub New()"
		TypeBuilder.DefineDefaultConstructor(MethodAttributes.Public)

		' Define the input parameter array. In this case there are none but,
		' If you want to pass parameters (i.e. GetInstance(name As String, order As Integer) ),
		' simply list the Types in the braces: {GetType(String), GetType(Integer)}
		Dim InParamTypes As Type() = New Type() {}

		' Define the return Type...
		Dim ReturnType As Type = GetType(Widget)

		' Define the "GetInstance()" method...
		Dim GetInstance_MethodBuilder As MethodBuilder = TypeBuilder.DefineMethod("GetInstance", MethodAttributes.Public Or MethodAttributes.Virtual, ReturnType, InParamTypes)

		' Get the Widget's contructor. In this case, we have no input parameters so
		' the derived class', System.Object, contructor will be called.
		Dim WidgetCtor As ConstructorInfo = widgetType.GetConstructors()(0)

		' Get an IL generator to emit to body of the method...
		Dim GetInstance_ILGenerator As ILGenerator = GetInstance_MethodBuilder.GetILGenerator

		' Emit the body of the GetInstance method:
		'	"Return New xxxWidget"
		' ----------------------------------------
		' Creates the Widget and pop's in onto the stack...
		GetInstance_ILGenerator.Emit(OpCodes.Newobj, WidgetCtor)
		' Return's the Widget from the stack...
		GetInstance_ILGenerator.Emit(OpCodes.Ret)

		TypeBuilder.CreateType()

		' Uncomment to save...
		'AssemblyBuilder.Save(Name & ".dll")

		Return DirectCast(AssemblyBuilder.CreateInstance(TypeName), IWidgetInstanceMachine)
	End Function

#End Region

	''' -----------------------------------------------------------------------------
	''' <summary>
	''' Type.GetType only return Type's from the referenced assembly and mscorlib. This
	''' allows external callers to get types from within this assembly.
	''' </summary>
	''' <param name="name"></param>
	''' <returns></returns>
	''' <remarks>
	''' </remarks>
	''' <history>
	''' 	[pliebscher]	10/22/2007	Created
	''' </history>
	''' -----------------------------------------------------------------------------
	Public Shared Function GetWidgetType(ByVal name As String) As Type
		Return Type.GetType(name)
	End Function

	''' -----------------------------------------------------------------------------
	''' <summary>
	''' Pre-scan for Widgets. This example only scan's this assembly. Each assembly in
	''' the AppDomain could aslo be scanned in a real-world implementation.
	''' </summary>
	''' <returns></returns>
	''' <remarks>
	''' </remarks>
	''' <history>
	''' 	[pliebscher]	7/20/2007	Created
	''' </history>
	''' -----------------------------------------------------------------------------
	Private Shared Function InitCache() As Boolean

		For Each [type] As Type In System.Reflection.Assembly.GetExecutingAssembly.GetTypes

			If [type].IsSubclassOf(GetType(Widget)) Then

				' Dynamic Factory
				_MachineCache.Add([type], GetWidgetInstanceMachine([type]))

				' Delegate
				Dim GetInstanceMethod As MethodInfo = [type].GetMethod("GetWidgetInstance", BindingFlags.Public Or BindingFlags.Static)
				Dim GetInstanceDelegate As GetInstanceDelegate = DirectCast(System.Delegate.CreateDelegate(GetType(GetInstanceDelegate), GetInstanceMethod), GetInstanceDelegate)
				_DelegateCache.Add([type], GetInstanceDelegate)

				' Constructor
				_ConstructorCache.Add([type], [type].GetConstructor(System.Type.EmptyTypes))

			End If

		Next
		Return True
	End Function

End Class