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.
' 
' Compiled Runtime Expressions
' 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 AndOrXorOperation
	[And]
	[Or]
	[Xor]
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
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

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

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"]/*' />
Public NotInheritable Class ImportsCollection

	Private MyNamespaceImports As IList
	Private MyTypeImports As IList
	Private MyOwnerImport As TypeImport
	Private MyAllowGlobalImport As Boolean

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

	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)
		MyTypeImports.Add(New TypeImport(t))
	End Sub

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

	Friend Function OwnerHasMember(ByVal memberName As String) As Boolean
		Return MyOwnerImport.HasMember(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 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
End Class

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

	Private MyImports As ImportsCollection
	Private MyResultType As Type
	Private MyChecked As Boolean

	Public Sub New()
		MyImports = New ImportsCollection()
	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)
			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)
			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
End Class

' Ensures that we only declare one local of a particular type
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