Click here to Skip to main content
15,886,840 members
Articles / Programming Languages / Visual Basic

Flee - Fast Lightweight Expression Evaluator

Rate me:
Please Sign up or sign in to vote.
4.91/5 (47 votes)
11 Oct 2007LGPL310 min read 195.5K   3.7K   108  
A .NET expression evaluator that compiles to IL and is designed for speed.
' This library is free software; you can redistribute it and/or
' modify it under the terms of the GNU Lesser General Public License
' as published by the Free Software Foundation; either version 2.1
' of the License, or (at your option) any later version.
' 
' This library is distributed in the hope that it will be useful,
' but WITHOUT ANY WARRANTY; without even the implied warranty of
' MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
' Lesser General Public License for more details.
' 
' You should have received a copy of the GNU Lesser General Public
' License along with this library; if not, write to the Free
' Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
' MA 02111-1307, USA.
' 
' Flee - Fast Lightweight Expression Evaluator
' Copyright � 2007 Eugene Ciloci
'

' Elements for field, property, array, and function access

Imports System.Reflection
Imports System.Reflection.Emit
Imports System.ComponentModel.Design

' Chain of member accesses
Friend Class InvocationList
	Inherits ExpressionElement

	Private MyTail As MemberElement

	Public Sub New(ByVal elements As IList, ByVal services As IServiceContainer)
		Dim exp As Expression = services.GetService(GetType(Expression))
		Dim options As ExpressionOptions = services.GetService(GetType(ExpressionOptions))
		Dim head As MemberElement = Me.GetRootElement(elements, options, exp)

		If head Is Nothing Then
			Me.OnNoRootElement(elements, options.Imports)
		End If

		Me.Resolve(head, elements, services)

		MyTail = elements.Item(elements.Count - 1)
		elements.Insert(0, head)
		Me.LinkElements(elements)
	End Sub

	Private Sub OnNoRootElement(ByVal elements As IList, ByVal ic As ImportsCollection)
		Dim names As String() = Me.GetFieldMemberNames(elements)

		If ic.AllowGlobalImport = False Or names.Length < 2 Then
			Dim firstMember As MemberElement = elements.Item(0)
			Dim msg As String = String.Format("'{0}' is not a known type, field, property, or function", firstMember.MemberName)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.UndefinedName)
		Else
			Dim path As String = String.Join(".", names)
			Dim msg As String = String.Format("Could not resolve type of '{0}'", path)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.UndefinedName)
		End If
	End Sub

	' Arrange elements as a linked list
	Private Sub LinkElements(ByVal elements As IList)
		For i As Integer = 0 To elements.Count - 1
			Dim current As MemberElement = elements.Item(i)
			Dim nextElement As MemberElement = Nothing
			If i + 1 < elements.Count Then
				nextElement = elements.Item(i + 1)
			End If
			current.Link(nextElement)
		Next
	End Sub

	Private Sub Resolve(ByVal head As MemberElement, ByVal elements As IList, ByVal services As IServiceContainer)
		Dim current As MemberElement = head

		For Each element As MemberElement In elements
			element.Resolve(current, services)
			current = element
		Next
	End Sub

	Private Function GetRootElement(ByVal elements As IList, ByVal options As ExpressionOptions, ByVal e As Expression) As MemberElement
		Dim first As ExpressionElement = elements.Item(0)
		Dim firstMember As MemberElement = TryCast(first, MemberElement)
		Dim imps As ImportsCollection = options.Imports

		' Is first member a member element?
		If firstMember Is Nothing Then
			' No, so remove it and use it as a head element
			elements.RemoveAt(0)
			Return New NonMemberHeadElement(first)
		End If

		' Try to find the reference in the owner
		If imps.OwnerHasMember(firstMember.MemberName, e.Owner, options) = True Then
			Return New OwnerHeadElement(e.OwnerType)
		End If

		' Try to find the reference in the imported types
		Dim t As Type = imps.FindImportedTypeWithMember(firstMember.MemberName)

		If Not t Is Nothing Then
			Return New TypeHeadElement(t)
		End If

		' Try to resolve a type from the first name in the list
		t = Me.ResolveFirstNameType(elements, imps)

		If Not t Is Nothing Then
			elements.RemoveAt(0)
			Return New TypeHeadElement(t)
		End If

		If imps.AllowGlobalImport = False Then
			Return Nothing
		End If

		' Finally, try to resolve it as a fully-qualified type
		Dim info As TypeCountInfo = Me.ResolveGlobalNamespaceType(elements, imps)

		If info.T Is Nothing Then
			Return Nothing
		End If

		If info.Count = elements.Count Then
			Me.ThrowTypeCannotBeUsedAsAnExpression(info.T)
		End If

		For i As Integer = 0 To info.Count - 1
			elements.RemoveAt(0)
		Next

		Return New TypeHeadElement(info.T)
	End Function

	' Resolve the type of the first name (ie: Byte.MaxValue)
	Private Function ResolveFirstNameType(ByVal elements As IList, ByVal ic As ImportsCollection) As Type
		Dim first As FieldPropertyElement = TryCast(elements.Item(0), FieldPropertyElement)

		If first Is Nothing Then
			' Can't resolve if first member is not a name
			Return Nothing
		End If

		' Try to find a builtin type with the name
		Dim t As Type = ic.FindBuiltinType(first.MemberName)

		' If that fails, try to find a type imported from a namespace
		If t Is Nothing Then
			t = ic.FindNamespaceType(first.MemberName)
		End If

		If t Is Nothing Then
			' First name doesn't resolve to a type
			Return Nothing
		End If

		If elements.Count = 1 Then
			Me.ThrowTypeCannotBeUsedAsAnExpression(t)
			Return Nothing
		End If

		Return t
	End Function

	Private Function ResolveGlobalNamespaceType(ByVal elements As IList, ByVal ic As ImportsCollection) As TypeCountInfo
		Dim names As String() = Me.GetFieldMemberNames(elements)

		For i As Integer = 0 To names.Length - 1
			Dim path As String = String.Join(".", names, 0, i + 1)
			Dim t As Type = ic.FindGlobalType(path)
			If Not t Is Nothing Then
				Return New TypeCountInfo(t, i + 1)
			End If
		Next

		Return Nothing
	End Function

	Private Function GetFieldMemberNames(ByVal elements As IList) As String()
		Dim names As IList = New ArrayList()

		For i As Integer = 0 To elements.Count - 1
			Dim current As MemberElement = elements.Item(i)
			Dim currentField As FieldPropertyElement = TryCast(current, FieldPropertyElement)
			If Not currentField Is Nothing Then
				names.Add(currentField.MemberName)
			Else
				Exit For
			End If
		Next

		Dim arr(names.Count - 1) As String
		names.CopyTo(arr, 0)
		Return arr
	End Function

	Private Sub ThrowTypeCannotBeUsedAsAnExpression(ByVal t As Type)
		Dim msg As String = String.Format("'{0}' is a type and cannot be used as an expression", t.Name)
		MyBase.ThrowCompileException(msg, CompileExceptionReason.UndefinedName)
	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As IServiceContainer)
		MyTail.Emit(ilg, services)
	End Sub

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "Invocation List"
		End Get
	End Property

	Public Overrides ReadOnly Property ResultType() As System.Type
		Get
			Return MyTail.ResultType
		End Get
	End Property
End Class

' Base class for all member elements
Friend MustInherit Class MemberElement
	Inherits ExpressionElement

	Protected MyName As String
	Protected MyPrevious As MemberElement
	Protected MyNext As MemberElement
	Public Const BindFlags As BindingFlags = BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Static Or BindingFlags.Instance Or BindingFlags.IgnoreCase

	Protected Sub New()

	End Sub

	Public Sub Link(ByVal nextElement As MemberElement)
		MyNext = nextElement
		If Not nextElement Is Nothing Then
			nextElement.MyPrevious = Me
		End If
	End Sub

	Public Sub Resolve(ByVal previous As MemberElement, ByVal services As IServiceContainer)
		Me.ResolveInternal(previous.TargetType, previous, services)
		Me.Validate(previous)
	End Sub

	Protected MustOverride Sub ResolveInternal(ByVal target As Type, ByVal previous As MemberElement, ByVal services As IServiceContainer)
	Public MustOverride ReadOnly Property IsStatic() As Boolean
	Protected MustOverride ReadOnly Property IsPublic() As Boolean

	Protected Overridable Sub Validate(ByVal target As MemberElement)
		If Me.IsStatic = True And target.SupportsStatic = False Then
			Dim msg As String = String.Format("Static member '{0}' cannot be accessed with an instance reference; qualify it with a type name instead", MyName)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.TypeMismatch)
		ElseIf Me.IsStatic = False And target.SupportsInstance = False Then
			Dim msg As String = String.Format("Reference to a non-shared member '{0}' requires an object reference", MyName)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.TypeMismatch)
		ElseIf Me.IsPublic = False And target.SupportsNonPublic = False Then
			Dim msg As String = String.Format("Cannot access non-public member '{0}'", MyName)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.TypeMismatch)
		End If
	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		If Not MyPrevious Is Nothing Then
			MyPrevious.Emit(ilg, services)
		End If
	End Sub

	' Handles a call emit for static, instance methods of reference/value types
	Protected Sub EmitMethodCall(ByVal mi As MethodInfo, ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		If mi.IsStatic = True Then
			ilg.Emit(OpCodes.Call, mi)
		ElseIf mi.DeclaringType.IsValueType = True Then
			If mi.IsVirtual = False Then
				ilg.Emit(OpCodes.Call, mi)
			Else
				ilg.Emit(OpCodes.Constrained, mi.DeclaringType)
				ilg.Emit(OpCodes.Callvirt, mi)
			End If
		Else
			ilg.Emit(OpCodes.Callvirt, mi)
		End If

		Me.EmitTempLocal(ilg, services)
	End Sub

	Protected Sub EmitTempLocal(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		If Me.ResultType.IsValueType = True And Me.NextRequiresAddress = True Then
			Dim manager As TempLocalManager = services.GetService(GetType(TempLocalManager))
			Dim index As Integer = manager.GetLocalIndex(Me.ResultType, ilg)
			EmitStoreLocal(ilg, index)
			ilg.Emit(OpCodes.Ldloca_S, CByte(index))
		End If
	End Sub

	Public ReadOnly Property MemberName() As String
		Get
			Return MyName
		End Get
	End Property

	Protected ReadOnly Property NextRequiresAddress() As Boolean
		Get
			If MyNext Is Nothing Then
				Return False
			Else
				Return MyNext.RequiresAddress
			End If
		End Get
	End Property

	Protected Overridable ReadOnly Property RequiresAddress() As Boolean
		Get
			Return False
		End Get
	End Property

	Protected Overridable ReadOnly Property SupportsInstance() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overridable ReadOnly Property SupportsStatic() As Boolean
		Get
			Return False
		End Get
	End Property

	Protected Overridable ReadOnly Property SupportsNonPublic() As Boolean
		Get
			Return False
		End Get
	End Property

	Public ReadOnly Property TargetType() As System.Type
		Get
			Return Me.ResultType
		End Get
	End Property
End Class

' Represents a field/property
Friend Class FieldPropertyElement
	Inherits MemberElement

	Private MyField As FieldInfo
	Private MyProperty As PropertyInfo
	Private MyDynamicVariableType As Type
	Private MyCalcEngineReferenceType As Type

	Public Sub New(ByVal name As String)
		Me.MyName = name
	End Sub

	Protected Overrides Sub ResolveInternal(ByVal target As System.Type, ByVal previous As MemberElement, ByVal services As IServiceContainer)
		' Try to find a field with our name
		Dim fi As FieldInfo = target.GetField(MyName, BindFlags)

		If Not fi Is Nothing Then
			MyField = fi
			Return
		End If

		' Try to find a property with our name
		Dim pi As PropertyInfo = target.GetProperty(MyName, BindFlags)

		If Not pi Is Nothing Then
			MyProperty = pi
			Return
		End If

		' Try to find a variable with our name
		MyDynamicVariableType = Me.ResolveDynamicVariable(previous, services)

		If Not MyDynamicVariableType Is Nothing Then
			Return
		End If

		Dim ce As CalculationEngine = services.GetService(GetType(CalculationEngine))

		If Not ce Is Nothing Then
			Dim options As ExpressionOptions = services.GetService(GetType(ExpressionOptions))
			ce.AddDependency(MyName, options)
			MyCalcEngineReferenceType = ce.ResolveTailType(MyName)
			Return
		End If

		Dim msg As String = String.Format("Type '{0}' has no field or property named '{1}'", target.Name, MyName)
		MyBase.ThrowCompileException(msg, CompileExceptionReason.UndefinedName)
	End Sub

	Private Function ResolveDynamicVariable(ByVal previous As MemberElement, ByVal services As IServiceContainer) As Type
		Dim e As Expression = services.GetService(GetType(Expression))
		Dim owner As Object = e.Owner

		' The previous element has to be an owner head element
		If Not previous.GetType() Is GetType(OwnerHeadElement) Then
			Return Nothing
		End If

		' Try to cast the owner as an owner of variables
		Dim deo As IDynamicExpressionOwner = TryCast(owner, IDynamicExpressionOwner)

		If deo Is Nothing Then
			' Owner doesn't support variables
			Return Nothing
		ElseIf deo.HasVariable(MyName) = False Then
			' Owner does support variables but doesn't have one with our name
			Return Nothing
		Else
			' Found a variable so return its type
			Return deo.GetVariableType(MyName)
		End If
	End Function

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		MyBase.Emit(ilg, services)

		If Not MyCalcEngineReferenceType Is Nothing Then
			Me.EmitReferenceLoad(ilg, services)
		ElseIf Not MyDynamicVariableType Is Nothing Then
			Me.EmitDynamicVariableLoad(ilg, services)
		ElseIf Not MyField Is Nothing Then
			Me.EmitFieldLoad(MyField, ilg, services)
		Else
			Me.EmitPropertyLoad(MyProperty, ilg, services)
		End If
	End Sub

	Private Sub EmitDynamicVariableLoad(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim e As Expression = services.GetService(GetType(Expression))
		Dim owner As IDynamicExpressionOwner = e.Owner
		owner.EmitVariableLoad(MyName, ilg, services)
	End Sub

	Private Sub EmitReferenceLoad(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim e As Expression = services.GetService(GetType(Expression))
		Dim ce As CalculationEngine = services.GetService(GetType(CalculationEngine))
		Dim owner As IDynamicExpressionOwner = e.Owner
		ce.EmitLoad(MyName, ilg, owner, services)
	End Sub

	Private Sub EmitFieldLoad(ByVal fi As System.Reflection.FieldInfo, ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		If fi.IsLiteral = True Then
			Me.EmitLiteral(fi, ilg, services)
		ElseIf fi.IsStatic = True Then
			If Me.ResultType.IsValueType = True And Me.NextRequiresAddress = True Then
				ilg.Emit(OpCodes.Ldsflda, fi)
			Else
				ilg.Emit(OpCodes.Ldsfld, fi)
			End If
		ElseIf Me.ResultType.IsValueType = True And Me.NextRequiresAddress = True Then
			ilg.Emit(OpCodes.Ldflda, fi)
		Else
			ilg.Emit(OpCodes.Ldfld, fi)
		End If
	End Sub

	' Emit the load of a constant field.  We can't emit a ldsfld/ldfld of a constant so we have to get its value
	' and then emit a ldc.
	Private Sub EmitLiteral(ByVal fi As System.Reflection.FieldInfo, ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim value As Object = fi.GetValue(Nothing)
		Dim t As Type = value.GetType()
		Dim code As TypeCode = Type.GetTypeCode(t)
		Dim elem As ConstantElement

		Select Case code
			Case TypeCode.Char, TypeCode.Byte, TypeCode.SByte, TypeCode.Int16, TypeCode.UInt16, TypeCode.Int32
				elem = New Int32Constant(System.Convert.ToInt32(value))
			Case TypeCode.UInt32
				elem = New UInt32Constant(DirectCast(value, UInt32))
			Case TypeCode.Int64
				elem = New Int64Constant(DirectCast(value, Int64))
			Case TypeCode.UInt64
				elem = New UInt64Constant(DirectCast(value, UInt64))
			Case TypeCode.Double
				elem = New DoubleConstantElement(DirectCast(value, Double))
			Case TypeCode.Single
				elem = New SingleConstantElement(DirectCast(value, Single))
			Case TypeCode.Boolean
				elem = New BooleanConstantElement(DirectCast(value, Boolean))
			Case TypeCode.String
				elem = New StringConstantElement(DirectCast(value, String))
			Case Else
				Throw New NotSupportedException("Unsupported constant type")
		End Select

		elem.Emit(ilg, services)
	End Sub

	Private Sub EmitPropertyLoad(ByVal pi As System.Reflection.PropertyInfo, ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim getter As System.Reflection.MethodInfo = pi.GetGetMethod(True)
		MyBase.EmitMethodCall(getter, ilg, services)
	End Sub

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "Field/Property Operator"
		End Get
	End Property

	Public Overrides ReadOnly Property ResultType() As System.Type
		Get
			If Not MyCalcEngineReferenceType Is Nothing Then
				Return MyCalcEngineReferenceType
			ElseIf Not MyDynamicVariableType Is Nothing Then
				Return MyDynamicVariableType
			ElseIf Not MyField Is Nothing Then
				Return MyField.FieldType
			Else
				Dim mi As MethodInfo = MyProperty.GetGetMethod(True)
				Return mi.ReturnType
			End If
		End Get
	End Property

	Protected Overrides ReadOnly Property RequiresAddress() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overrides ReadOnly Property IsPublic() As Boolean
		Get
			If Not MyDynamicVariableType Is Nothing Or Not MyCalcEngineReferenceType Is Nothing Then
				Return True
			ElseIf Not MyField Is Nothing Then
				Return MyField.IsPublic
			Else
				Dim mi As MethodInfo = MyProperty.GetGetMethod(True)
				Return mi.IsPublic
			End If
		End Get
	End Property

	Public Overrides ReadOnly Property IsStatic() As Boolean
		Get
			If Not MyDynamicVariableType Is Nothing Or Not MyCalcEngineReferenceType Is Nothing Then
				Return False
			ElseIf Not MyField Is Nothing Then
				Return MyField.IsStatic
			Else
				Dim mi As MethodInfo = MyProperty.GetGetMethod(True)
				Return mi.IsStatic
			End If
		End Get
	End Property
End Class

' Element representing a function call
Friend Class FunctionCallElement
	Inherits MemberElement

	Private MyArguments As IList
	Private MyMethod As MethodInfo

	Public Sub New(ByVal name As String, ByVal arguments As IList)
		Me.MyName = name
		MyArguments = arguments
	End Sub

	Protected Overrides Sub ResolveInternal(ByVal target As System.Type, ByVal previous As MemberElement, ByVal services As IServiceContainer)
		' Try to find a method that matches our argument list
		Dim argTypes As Type() = Me.GetArgumentTypes()
		Dim mi As MethodInfo = target.GetMethod(MyName, BindFlags, Nothing, CallingConventions.Any, argTypes, Nothing)

		If Not mi Is Nothing Then
			MyMethod = mi
		Else
			Dim argList As String = String.Join(", ", Me.GetArgumentTypeNames(Me.GetArgumentTypes()))
			Dim msg As String = String.Format("Could find not function '{0}({1})' on type '{2}'", MyName, argList, target.Name)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.UndefinedName)
		End If
	End Sub

	Protected Overrides Sub Validate(ByVal target As MemberElement)
		MyBase.Validate(target)
		' Any function reference in an expression must return a value
		If MyMethod.ReturnType Is GetType(Void) Then
			Dim msg As String = String.Format("Function '{0}' does not return a value", MyName)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.FunctionHasNoReturnValue)
		End If
	End Sub

	Private Function GetArgumentTypes() As Type()
		Dim arr(MyArguments.Count - 1) As Type
		For i As Integer = 0 To MyArguments.Count - 1
			arr(i) = DirectCast(MyArguments.Item(i), ExpressionElement).ResultType
		Next
		Return arr
	End Function

	Private Function GetArgumentTypeNames(ByVal argTypes As Type()) As String()
		Dim arr(argTypes.Length - 1) As String
		For i As Integer = 0 To arr.Length - 1
			arr(i) = argTypes(i).Name
		Next
		Return arr
	End Function

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		MyBase.Emit(ilg, services)
		Me.EmitArguments(ilg, services)
		MyBase.EmitMethodCall(MyMethod, ilg, services)
	End Sub

	Private Sub EmitArguments(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim params As System.Reflection.ParameterInfo() = MyMethod.GetParameters()
		Debug.Assert(params.Length = MyArguments.Count, "argument count mismatch")

		For i As Integer = 0 To params.Length - 1
			Dim element As ExpressionElement = MyArguments.Item(i)
			Dim pi As System.Reflection.ParameterInfo = params(i)
			element.Emit(ilg, services)
			Dim success As Boolean = ImplicitConverter.EmitImplicitConvert(element.ResultType, pi.ParameterType, ilg)
			Debug.Assert(success, "conversion failed")
		Next
	End Sub

	Public ReadOnly Property Arguments() As IList
		Get
			Return MyArguments
		End Get
	End Property

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "Function Operator"
		End Get
	End Property

	Public Overrides ReadOnly Property ResultType() As System.Type
		Get
			Return MyMethod.ReturnType
		End Get
	End Property

	Protected Overrides ReadOnly Property RequiresAddress() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overrides ReadOnly Property IsPublic() As Boolean
		Get
			Return MyMethod.IsPublic
		End Get
	End Property

	Public Overrides ReadOnly Property IsStatic() As Boolean
		Get
			Return MyMethod.IsStatic
		End Get
	End Property
End Class

' Element representing an array index
Friend Class ArrayIndexElement
	Inherits MemberElement

	Private MyArrayType As Type
	Private MyIndexerElement As ExpressionElement
	Private MyIndexer As MethodInfo
	Private MyIndexerType As Type

	Public Sub New(ByVal indexer As ExpressionElement)
		MyIndexerElement = indexer
	End Sub

	Protected Overrides Sub ResolveInternal(ByVal target As System.Type, ByVal previous As MemberElement, ByVal services As IServiceContainer)
		' Are we are indexing on an array?
		If target.IsArray = True Then
			MyArrayType = target
			MyIndexerType = GetType(Int32)
			Me.ValidateIndexer()
			Return
		End If

		' Not an array, so try to find an indexer on the type
		If Me.FindIndexer(target) = False Then
			Dim msg As String = String.Format("Type '{0}' is not an array and does not have an indexer defined", target.Name)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.TypeMismatch)
		End If
	End Sub

	Private Function FindIndexer(ByVal targetType As Type) As Boolean
		' Get the default members
		Dim members As MemberInfo() = targetType.GetDefaultMembers()
		If members.Length = 0 Then
			' None found
			Return False
		End If

		' Is the first element a property?
		Dim pi As PropertyInfo = TryCast(members(0), PropertyInfo)

		If pi Is Nothing Then
			Return False
		End If

		' Does it have an indexer?
		Dim params As ParameterInfo() = pi.GetIndexParameters()

		If params.Length = 0 Then
			Return False
		End If

		' Get the indexer type and validate it
		Dim indexer As ParameterInfo = params(0)
		MyIndexerType = indexer.ParameterType

		Me.ValidateIndexer()
		MyIndexer = pi.GetGetMethod(True)
		Return True
	End Function

	Private Sub ValidateIndexer()
		If ImplicitConverter.EmitImplicitConvert(MyIndexerElement.ResultType, MyIndexerType, Nothing) = False Then
			Dim msg As String = String.Format("Cannot convert index expression type of '{0}' to indexer type of '{1}'", MyIndexerElement.ResultType.Name, MyIndexerType.Name)
			MyBase.ThrowCompileException(msg, CompileExceptionReason.TypeMismatch)
		End If
	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		MyBase.Emit(ilg, services)

		MyIndexerElement.Emit(ilg, services)
		ImplicitConverter.EmitImplicitConvert(MyIndexerElement.ResultType, MyIndexerType, ilg)

		If MyIndexer Is Nothing Then
			Me.EmitElementLoad(ilg)
		Else
			MyBase.EmitMethodCall(MyIndexer, ilg, services)
		End If
	End Sub

	Private Sub EmitElementLoad(ByVal ilg As ILGenerator)
		Dim elementType As Type = Me.ResultType

		If elementType.IsValueType = False Then
			' Simple reference load
			ilg.Emit(OpCodes.Ldelem_Ref)
		Else
			Me.EmitValueTypeLoad(ilg, elementType)
		End If
	End Sub

	Private Sub EmitValueTypeLoad(ByVal ilg As ILGenerator, ByVal elementType As Type)
		If Me.NextRequiresAddress = True Then
			ilg.Emit(OpCodes.Ldelema, elementType)
		Else
			If Me.EmitFastLoad(ilg, elementType) = True Then
				Return
			Else
				ilg.Emit(OpCodes.Ldelema, elementType)
				ilg.Emit(OpCodes.Ldobj, elementType)
			End If
		End If
	End Sub

	Private Function EmitFastLoad(ByVal ilg As ILGenerator, ByVal elementType As Type) As Boolean
		Dim tc As TypeCode = Type.GetTypeCode(elementType)
		Dim ldElem As OpCode

		Select Case tc
			Case TypeCode.Byte
				ldElem = OpCodes.Ldelem_U1
			Case TypeCode.SByte, TypeCode.Boolean
				ldElem = OpCodes.Ldelem_I1
			Case TypeCode.Int16
				ldElem = OpCodes.Ldelem_I2
			Case TypeCode.UInt16
				ldElem = OpCodes.Ldelem_U2
			Case TypeCode.Int32
				ldElem = OpCodes.Ldelem_I4
			Case TypeCode.UInt32
				ldElem = OpCodes.Ldelem_U4
			Case TypeCode.Int64
				ldElem = OpCodes.Ldelem_I8
			Case TypeCode.Single
				ldElem = OpCodes.Ldelem_R4
			Case TypeCode.Double
				ldElem = OpCodes.Ldelem_R8
			Case Else
				Return False
		End Select

		ilg.Emit(ldElem)
		Return True
	End Function

	Protected Overrides ReadOnly Property RequiresAddress() As Boolean
		Get
			Return Not MyIndexer Is Nothing
		End Get
	End Property

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "Array Indexer"
		End Get
	End Property

	Public Overrides ReadOnly Property ResultType() As System.Type
		Get
			If Not MyArrayType Is Nothing Then
				Return MyArrayType.GetElementType()
			Else
				Return MyIndexer.ReturnType
			End If
		End Get
	End Property

	Protected Overrides ReadOnly Property IsPublic() As Boolean
		Get
			If Not MyArrayType Is Nothing Then
				Return True
			Else
				Return MyIndexer.IsPublic
			End If
		End Get
	End Property

	Public Overrides ReadOnly Property IsStatic() As Boolean
		Get
			If Not MyArrayType Is Nothing Then
				Return False
			Else
				Return MyIndexer.IsStatic
			End If
		End Get
	End Property
End Class

' Base class for the first element in an invocation list
Friend MustInherit Class HeadElement
	Inherits MemberElement

	Private MyTarget As Type

	Protected Sub New(ByVal target As Type)
		MyTarget = target
	End Sub

	Protected Overrides Sub ResolveInternal(ByVal target As System.Type, ByVal previous As MemberElement, ByVal services As IServiceContainer)

	End Sub

	Protected MustOverride Overrides ReadOnly Property SupportsInstance() As Boolean
	Protected MustOverride Overrides ReadOnly Property SupportsStatic() As Boolean
	Protected MustOverride Overrides ReadOnly Property SupportsNonPublic() As Boolean

	Protected Overrides ReadOnly Property IsPublic() As Boolean
		Get
			Return True
		End Get
	End Property

	Public Overrides ReadOnly Property IsStatic() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "Head Element"
		End Get
	End Property

	Public Overrides ReadOnly Property ResultType() As System.Type
		Get
			Return MyTarget
		End Get
	End Property
End Class

' Head element that is the expression owner
Friend Class OwnerHeadElement
	Inherits HeadElement

	Public Sub New(ByVal ownerType As Type)
		MyBase.New(ownerType)
	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		MyBase.Emit(ilg, services)
		' If next is not static we have to load the first argument
		If MyNext.IsStatic = False Then
			ilg.Emit(OpCodes.Ldarg_0)
		End If
	End Sub

	Protected Overrides ReadOnly Property SupportsInstance() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overrides ReadOnly Property SupportsNonPublic() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overrides ReadOnly Property SupportsStatic() As Boolean
		Get
			Return True
		End Get
	End Property
End Class

' Head element that is a type
Friend Class TypeHeadElement
	Inherits HeadElement

	Public Sub New(ByVal targetType As Type)
		MyBase.New(targetType)
	End Sub

	Protected Overrides ReadOnly Property SupportsInstance() As Boolean
		Get
			Return False
		End Get
	End Property

	Protected Overrides ReadOnly Property SupportsNonPublic() As Boolean
		Get
			Return False
		End Get
	End Property

	Protected Overrides ReadOnly Property SupportsStatic() As Boolean
		Get
			Return True
		End Get
	End Property
End Class

' Head element that is an expression
Friend Class NonMemberHeadElement
	Inherits HeadElement

	Private MyElement As ExpressionElement

	Public Sub New(ByVal element As ExpressionElement)
		MyBase.New(element.ResultType)
		MyElement = element
	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		MyBase.Emit(ilg, services)
		MyElement.Emit(ilg, services)
		If MyElement.ResultType.IsValueType = True Then
			MyBase.EmitTempLocal(ilg, services)
		End If
	End Sub

	Protected Overrides ReadOnly Property SupportsInstance() As Boolean
		Get
			Return True
		End Get
	End Property

	Protected Overrides ReadOnly Property SupportsNonPublic() As Boolean
		Get
			Return False
		End Get
	End Property

	Protected Overrides ReadOnly Property SupportsStatic() As Boolean
		Get
			Return False
		End Get
	End Property
End Class

By viewing downloads associated with this article you agree to the Terms of Service and the article's licence.

If a file you wish to view isn't highlighted, and is a text file (not binary), please let us know and we'll add colourisation support for it.

License

This article, along with any associated source code and files, is licensed under The GNU Lesser General Public License (LGPLv3)


Written By
Web Developer
Canada Canada
This member has not yet provided a Biography. Assume it's interesting and varied, and probably something to do with programming.

Comments and Discussions