Flee - Fast Lightweight Expression Evaluator

' 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
'

' Basic types that we need

Imports System.Reflection.Emit
Imports System.Reflection

Friend Enum BinaryArithmeticOperation
	Add
	Subtract
	Multiply
	Divide
	[Mod]
	Power
End Enum

Friend Enum LogicalCompareOperation
	LessThan
	GreaterThan
	Equal
	NotEqual
	LessThanOrEqual
	GreaterThanOrEqual
End Enum

Friend Enum AndOrOperation
	[And]
	[Or]
End Enum

Friend Enum ShiftOperation
	LeftShift
	RightShift
End Enum

''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason"]/*' />	
Public Enum CompileExceptionReason
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.SyntaxError"]/*' />	
	SyntaxError
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.ConstantOverflow"]/*' />	
	ConstantOverflow
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.TypeMismatch"]/*' />	
	TypeMismatch
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.UndefinedName"]/*' />	
	UndefinedName
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.FunctionHasNoReturnValue"]/*' />	
	FunctionHasNoReturnValue
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.InvalidExplicitCast"]/*' />	
	InvalidExplicitCast
	''' <include file='DocComments.xml' path='DocComments/Member[@name="CompileExceptionReason.AmbiguousCall"]/*' />	
	AmbiguousCall
End Enum

''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionEvaluator"]/*' />	
Public Delegate Function ExpressionEvaluator(Of T)() As T

''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionCompileException"]/*' />	
Public NotInheritable Class ExpressionCompileException
	Inherits Exception

	Private MyReason As CompileExceptionReason

	Friend Sub New(ByVal message As String, ByVal reason As CompileExceptionReason)
		MyBase.New(message)
		MyReason = reason
	End Sub

	Friend Sub New(ByVal parseException As PerCederberg.Grammatica.Runtime.ParserLogException)
		MyBase.New(String.Concat("Syntax Error: ", parseException.Message), parseException)
		MyReason = CompileExceptionReason.SyntaxError
	End Sub

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionCompileException.Reason"]/*' />	
	Public ReadOnly Property Reason() As CompileExceptionReason
		Get
			Return MyReason
		End Get
	End Property
End Class

<Serializable()> _
Friend Class TypeImport

	Private MyType As Type

	Public Sub New(ByVal t As Type)
		MyType = t
	End Sub

	Public Function HasMember(ByVal memberName As String) As Boolean
		Dim members As MemberInfo() = MyType.FindMembers(MemberTypes.Field Or MemberTypes.Property Or MemberTypes.Method, MemberElement.BindFlags, Type.FilterNameIgnoreCase, memberName)
		Return members.Length > 0
	End Function

	Public ReadOnly Property Target() As Type
		Get
			Return MyType
		End Get
	End Property
End Class

<Serializable()> _
Friend Class NamespaceImport

	Private MyNamespace As String

	Public Sub New(ByVal ns As String)
		MyNamespace = ns
	End Sub

	Private Shared Function ResolveTypeInternal(ByVal typeName As String) As Type
		Dim assemblies As System.Reflection.Assembly() = AppDomain.CurrentDomain.GetAssemblies()

		For Each a As System.Reflection.Assembly In assemblies
			Dim t As Type = a.GetType(typeName, False, True)
			If Not t Is Nothing Then
				Return t
			End If
		Next

		Return Nothing
	End Function

	Public Shared Function ResolveGlobalType(ByVal path As String) As Type
		Return ResolveTypeInternal(path)
	End Function

	Public Function ResolveType(ByVal name As String) As System.Type
		Dim typeName As String = String.Concat(MyNamespace, ".", name)
		Return ResolveTypeInternal(typeName)
	End Function
End Class

''' <include file='DocComments.xml' path='DocComments/Member[@name="ImportsCollection"]/*' />
<Serializable()> _
Public NotInheritable Class ImportsCollection
	Implements System.Runtime.Serialization.ISerializable

	Private MyNamespaceImports As IList
	Private MyTypeImports As IList
	Private MyOwnerImport As TypeImport
	Private MyAllowGlobalImport As Boolean
	Private MyImportBuiltinTypes As Boolean
	Private Shared OurBuiltinTypeMap As IDictionary = CreateBuiltinTypeMap()
	Private Const VERSION As Integer = 1

	Public Sub New()
		MyNamespaceImports = New ArrayList
		MyTypeImports = New ArrayList
		MyAllowGlobalImport = False
		MyImportBuiltinTypes = False
	End Sub

	Private Sub New(ByVal info As System.Runtime.Serialization.SerializationInfo, ByVal context As System.Runtime.Serialization.StreamingContext)
		MyNamespaceImports = info.GetValue("NamespaceImports", GetType(IList))
		MyTypeImports = info.GetValue("TypeImports", GetType(IList))
		MyOwnerImport = info.GetValue("OwnerImport", GetType(TypeImport))
		MyAllowGlobalImport = info.GetBoolean("AllowGlobalImport")
		MyImportBuiltinTypes = info.GetBoolean("ImportBuiltinTypes")
	End Sub

	Private Sub GetObjectData(ByVal info As System.Runtime.Serialization.SerializationInfo, ByVal context As System.Runtime.Serialization.StreamingContext) Implements System.Runtime.Serialization.ISerializable.GetObjectData
		info.AddValue("Version", VERSION)
		info.AddValue("NamespaceImports", MyNamespaceImports)
		info.AddValue("TypeImports", MyTypeImports)
		info.AddValue("OwnerImport", MyOwnerImport)
		info.AddValue("AllowGlobalImport", MyAllowGlobalImport)
		info.AddValue("ImportBuiltinTypes", MyImportBuiltinTypes)
	End Sub

	Private Shared Function CreateBuiltinTypeMap() As IDictionary
		Dim map As New Hashtable(StringComparer.OrdinalIgnoreCase)
		map.Add("boolean", GetType(Boolean))
		map.Add("byte", GetType(Byte))
		map.Add("sbyte", GetType(SByte))
		map.Add("short", GetType(Short))
		map.Add("ushort", GetType(UInt16))
		map.Add("int", GetType(Int32))
		map.Add("uint", GetType(UInt32))
		map.Add("long", GetType(Long))
		map.Add("ulong", GetType(ULong))
		map.Add("single", GetType(Single))
		map.Add("double", GetType(Double))
		map.Add("decimal", GetType(Decimal))
		map.Add("char", GetType(Char))
		map.Add("object", GetType(Object))
		map.Add("string", GetType(String))

		Return map
	End Function

	Friend Function Clone() As ImportsCollection
		Dim coll As ImportsCollection = Me.MemberwiseClone()
		coll.MyTypeImports = DirectCast(MyTypeImports, ICloneable).Clone()
		coll.MyNamespaceImports = DirectCast(MyNamespaceImports, ICloneable).Clone()
		Return coll
	End Function

	Friend Sub SetOwnerImport(ByVal ownerType As Type)
		MyOwnerImport = New TypeImport(ownerType)
	End Sub

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ImportsCollection.AddType"]/*' />
	Public Sub AddType(ByVal t As Type)
		Expression.AssertNotNull(t, "t")
		MyTypeImports.Add(New TypeImport(t))
	End Sub

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ImportsCollection.AddNamespace"]/*' />
	Public Sub AddNamespace(ByVal ns As String)
		If String.IsNullOrEmpty(ns) = True Then
			Throw New ArgumentException("Invalid namespace name")
		End If
		MyNamespaceImports.Add(New NamespaceImport(ns))
	End Sub

	Friend Function OwnerHasMember(ByVal memberName As String, ByVal owner As Object, ByVal options As ExpressionOptions) As Boolean
		If MyOwnerImport.HasMember(memberName) = True Then
			Return True
		End If

		Dim deo As IDynamicExpressionOwner = TryCast(owner, IDynamicExpressionOwner)

		If (Not deo Is Nothing) AndAlso deo.HasVariable(memberName) Then
			Return True
		End If

		Dim ceo As ICalculationEngineExpressionOwner = TryCast(owner, ICalculationEngineExpressionOwner)

		If ceo Is Nothing Then
			Return False
		End If

		Return (Not ceo.Engine Is Nothing) AndAlso (ceo.Engine.HasExpressionAt(memberName))
	End Function

	Friend Function FindNamespaceType(ByVal typeName As String) As Type
		For Each nsi As NamespaceImport In MyNamespaceImports
			Dim t As Type = nsi.ResolveType(typeName)
			If Not t Is Nothing Then
				Return t
			End If
		Next

		Return Nothing
	End Function

	Friend Function GetBuiltinType(ByVal typeName As String) As Type
		Return OurBuiltinTypeMap.Item(typeName)
	End Function

	Friend Function FindBuiltinType(ByVal typeName As String) As Type
		If MyImportBuiltinTypes = False Then
			Return Nothing
		Else
			Return OurBuiltinTypeMap.Item(typeName)
		End If
	End Function

	Friend Function FindGlobalType(ByVal typeName As String) As Type
		If MyAllowGlobalImport = True Then
			Return NamespaceImport.ResolveGlobalType(typeName)
		Else
			Return Nothing
		End If
	End Function

	Private Function GetTypePath(ByVal names As IList) As String
		Dim arr(names.Count - 1) As String
		For i As Integer = 0 To arr.Length - 1
			arr(i) = names.Item(i)
		Next

		Return String.Join(".", arr)
	End Function

	Friend Function FindImportedTypeWithMember(ByVal memberName As String) As Type
		For Each ti As TypeImport In MyTypeImports
			If ti.HasMember(memberName) = True Then
				Return ti.Target
			End If
		Next

		Return Nothing
	End Function

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ImportsCollection.AllowGlobalImport"]/*' />
	Public Property AllowGlobalImport() As Boolean
		Get
			Return MyAllowGlobalImport
		End Get
		Set(ByVal value As Boolean)
			MyAllowGlobalImport = value
		End Set
	End Property

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ImportsCollection.ImportBuiltinTypes"]/*' />
	Public Property ImportBuiltinTypes() As Boolean
		Get
			Return MyImportBuiltinTypes
		End Get
		Set(ByVal value As Boolean)
			MyImportBuiltinTypes = value
		End Set
	End Property
End Class

''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionOptions"]/*' />
<Serializable()> _
Public NotInheritable Class ExpressionOptions
	Implements System.Runtime.Serialization.ISerializable

	Private MyImports As ImportsCollection
	Private MyResultType As Type
	Private MyChecked As Boolean
	Private MyStringComparison As StringComparison
	Private MyCalcState As IDictionary
	Private Const VERSION As Integer = 1

	Public Sub New()
		MyImports = New ImportsCollection()
		MyStringComparison = System.StringComparison.Ordinal
		MyCalcState = New Hashtable()
	End Sub

	Private Sub New(ByVal info As System.Runtime.Serialization.SerializationInfo, ByVal context As System.Runtime.Serialization.StreamingContext)
		MyImports = info.GetValue("Imports", GetType(ImportsCollection))
		MyChecked = info.GetBoolean("Checked")
		MyStringComparison = info.GetInt32("StringComparison")
		MyResultType = info.GetValue("ResultType", GetType(Type))
	End Sub

	Private Sub GetObjectData(ByVal info As System.Runtime.Serialization.SerializationInfo, ByVal context As System.Runtime.Serialization.StreamingContext) Implements System.Runtime.Serialization.ISerializable.GetObjectData
		info.AddValue("Version", VERSION)
		info.AddValue("Imports", MyImports)
		info.AddValue("Checked", MyChecked)
		info.AddValue("StringComparison", CInt(MyStringComparison))
		info.AddValue("ResultType", MyResultType)
	End Sub

	Friend Function Clone() As ExpressionOptions
		Dim options As ExpressionOptions = Me.MemberwiseClone()
		options.MyImports = MyImports.Clone()
		Return options
	End Function

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionOptions.Imports"]/*' />	
	Public Property [Imports]() As ImportsCollection
		Get
			Return MyImports
		End Get
		Set(ByVal value As ImportsCollection)
			Expression.AssertNotNull(value, "value")
			MyImports = value
		End Set
	End Property

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionOptions.ResultType"]/*' />	
	Public Property ResultType() As Type
		Get
			Return MyResultType
		End Get
		Set(ByVal value As Type)
			Expression.AssertNotNull(value, "value")
			MyResultType = value
		End Set
	End Property

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionOptions.Checked"]/*' />	
	Public Property Checked() As Boolean
		Get
			Return MyChecked
		End Get
		Set(ByVal value As Boolean)
			MyChecked = value
		End Set
	End Property

	''' <include file='DocComments.xml' path='DocComments/Member[@name="ExpressionOptions.StringComparison"]/*' />	
	Public Property StringComparison() As StringComparison
		Get
			Return MyStringComparison
		End Get
		Set(ByVal value As StringComparison)
			MyStringComparison = value
		End Set
	End Property

	Friend ReadOnly Property CalcState() As IDictionary
		Get
			Return MyCalcState
		End Get
	End Property
End Class

' Manages local slots for temporary value types.  Ensures that we only declare one slot for each type of temporary value.
Friend Class TempLocalManager
	Private MyLocals As IDictionary

	Public Sub New()
		MyLocals = New Hashtable()
	End Sub

	Public Function GetLocalIndex(ByVal localType As Type, ByVal ilg As ILGenerator) As Integer
		If MyLocals.Contains(localType) = False Then
			MyLocals.Add(localType, ilg.DeclareLocal(localType))
		End If

		Dim lb As LocalBuilder = MyLocals.Item(localType)
		Return lb.LocalIndex
	End Function
End Class

Friend Structure TypeCountInfo
	Public T As Type
	Public Count As Integer

	Public Sub New(ByVal t As Type, ByVal count As Integer)
		Me.T = t
		Me.Count = count
	End Sub
End Structure

Friend Class ShortCircuitInfo
	Public Operands As Stack
	Public Operators As Stack
	Public Labels As IDictionary
	Public LabelLocations As IDictionary(Of Label, Integer)
	Public MarkMode As Boolean

	Public Sub New()
		Me.Operands = New Stack()
		Me.Operators = New Stack()
		Me.Labels = New Hashtable()
		Me.LabelLocations = New Dictionary(Of Label, Integer)
	End Sub

	Public Sub ClearTempState()
		Me.Operands.Clear()
		Me.Operators.Clear()
		Me.Labels.Clear()
	End Sub
End Class

Friend MustInherit Class CustomBinder
	Inherits Binder

	Public Overrides Function BindToField(ByVal bindingAttr As System.Reflection.BindingFlags, ByVal match() As System.Reflection.FieldInfo, ByVal value As Object, ByVal culture As System.Globalization.CultureInfo) As System.Reflection.FieldInfo
		Return Nothing
	End Function

	Public Overrides Function BindToMethod(ByVal bindingAttr As System.Reflection.BindingFlags, ByVal match() As System.Reflection.MethodBase, ByRef args() As Object, ByVal modifiers() As System.Reflection.ParameterModifier, ByVal culture As System.Globalization.CultureInfo, ByVal names() As String, ByRef state As Object) As System.Reflection.MethodBase
		Return Nothing
	End Function

	Public Overrides Function ChangeType(ByVal value As Object, ByVal type As System.Type, ByVal culture As System.Globalization.CultureInfo) As Object
		Return Nothing
	End Function

	Public Overrides Sub ReorderArgumentArray(ByRef args() As Object, ByVal state As Object)

	End Sub

	Public Overrides Function SelectProperty(ByVal bindingAttr As System.Reflection.BindingFlags, ByVal match() As System.Reflection.PropertyInfo, ByVal returnType As System.Type, ByVal indexes() As System.Type, ByVal modifiers() As System.Reflection.ParameterModifier) As System.Reflection.PropertyInfo
		Return Nothing
	End Function
End Class

Friend Class ExplicitOperatorMethodBinder
	Inherits CustomBinder

	Private MyReturnType As Type
	Private MyArgType As Type

	Public Sub New(ByVal returnType As Type, ByVal argType As Type)
		MyReturnType = returnType
		MyArgType = argType
	End Sub

	Public Overrides Function SelectMethod(ByVal bindingAttr As System.Reflection.BindingFlags, ByVal match() As System.Reflection.MethodBase, ByVal types() As System.Type, ByVal modifiers() As System.Reflection.ParameterModifier) As System.Reflection.MethodBase
		For Each mi As MethodInfo In match
			Dim parameters As ParameterInfo() = mi.GetParameters()
			Dim firstParameter As ParameterInfo = parameters(0)
			If firstParameter.ParameterType Is MyArgType And mi.ReturnType Is MyReturnType Then
				Return mi
			End If
		Next
		Return Nothing
	End Function
End Class

Friend Class BinaryOperatorBinder
	Inherits CustomBinder

	Private MyLeftType As Type
	Private MyRightType As Type

	Public Sub New(ByVal leftType As Type, ByVal rightType As Type)
		MyLeftType = leftType
		MyRightType = rightType
	End Sub

	Public Overrides Function SelectMethod(ByVal bindingAttr As System.Reflection.BindingFlags, ByVal match() As System.Reflection.MethodBase, ByVal types() As System.Type, ByVal modifiers() As System.Reflection.ParameterModifier) As System.Reflection.MethodBase
		For Each mi As MethodInfo In match
			Dim parameters As ParameterInfo() = mi.GetParameters()
			Dim leftValid As Boolean = ImplicitConverter.EmitImplicitConvert(MyLeftType, parameters(0).ParameterType, Nothing)
			Dim rightValid As Boolean = ImplicitConverter.EmitImplicitConvert(MyRightType, parameters(1).ParameterType, Nothing)

			If leftValid = True And rightValid = True Then
				Return mi
			End If
		Next
		Return Nothing
	End Function
End Class

Friend Interface IDynamicExpressionOwner
	Inherits ICalculationEngineExpressionOwner
	Function GetVariableType(ByVal name As String) As Type
	Function HasVariable(ByVal name As String) As Boolean
	Sub EmitVariableLoad(ByVal name As String, ByVal ilg As ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
End Interface

Public Interface ICalculationEngineExpressionOwner
	Property Engine() As CalculationEngine
End Interface

''' <include file='DocComments.xml' path='DocComments/Member[@name="DynamicExpressionOwner"]/*' />	
<Serializable()> _
Public Class DynamicExpressionOwner(Of T)
	Implements IDynamicExpressionOwner

	Private MyMap As IDictionary(Of String, T)
	Private MyCalculationEngine As CalculationEngine

	Public Sub New()
		MyMap = New Dictionary(Of String, T)(StringComparer.OrdinalIgnoreCase)
	End Sub

	' Can't code inline access to map because of bug in .NET
	' http://connect.microsoft.com/VisualStudio/feedback/ViewFeedback.aspx?FeedbackID=221225
	Private Sub EmitVariableLoad(ByVal name As String, ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer) Implements IDynamicExpressionOwner.EmitVariableLoad
		Dim mi As MethodInfo = Me.GetType().GetMethod("GetVariableValue", BindingFlags.Instance Or BindingFlags.NonPublic)
		ilg.Emit(OpCodes.Ldstr, name)
		ilg.Emit(OpCodes.Call, mi)

		Dim varType As Type = Me.GetVariableType(name)
		Dim nopElement As New NopExpressionElement(GetType(T))
		Dim castElement As New CastOperator(nopElement, varType)
		castElement.Emit(ilg, services)
	End Sub

	Private Function GetVariableValue(ByVal name As String) As T
		Return MyMap.Item(name)
	End Function

	Private Function GetVariableType(ByVal name As String) As System.Type Implements IDynamicExpressionOwner.GetVariableType
		Return MyMap.Item(name).GetType()
	End Function

	Private Function HasVariable(ByVal name As String) As Boolean Implements IDynamicExpressionOwner.HasVariable
		Return MyMap.ContainsKey(name)
	End Function

	Friend Sub SetCalculationEngine(ByVal engine As CalculationEngine)
		MyCalculationEngine = engine
	End Sub

	''' <include file='DocComments.xml' path='DocComments/Member[@name="DynamicExpressionOwner.Variables"]/*' />	
	Public ReadOnly Property Variables() As IDictionary(Of String, T)
		Get
			Return MyMap
		End Get
	End Property

	Private Property Engine() As CalculationEngine Implements ICalculationEngineExpressionOwner.Engine
		Get
			Return MyCalculationEngine
		End Get
		Set(ByVal value As CalculationEngine)
			MyCalculationEngine = value
		End Set
	End Property
End Class

Friend Class NopExpressionElement
	Inherits ExpressionElement

	Private MyResultType As Type

	Public Sub New(ByVal resultType As Type)
		MyResultType = resultType
	End Sub

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

	End Sub

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

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

Public Class CircularReferenceException
	Inherits System.Exception

	Public Sub New()
		MyBase.New("Circular reference detected in calculation engine")
	End Sub
End Class