Click here to Skip to main content
15,896,278 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 196.4K   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.
' 
' Compiled Runtime Expressions
' Copyright � 2007 Eugene Ciloci
'

' Elements for arithmetic operations
Imports System.Reflection.Emit
Imports System.ComponentModel.Design

' Class for all arithmetic opeations
Friend Class ArithmeticElement
	Inherits BinaryExpressionElement

	Private Shared OurPowerMethodInfo As System.Reflection.MethodInfo
	Private Shared OurStringConcatMethodInfo As System.Reflection.MethodInfo
	Private Shared OurObjectConcatMethodInfo As System.Reflection.MethodInfo
	Private MyOperation As BinaryArithmeticOperation

	Shared Sub New()
		OurPowerMethodInfo = GetType(Math).GetMethod("Pow", Reflection.BindingFlags.Public Or Reflection.BindingFlags.Static)
		OurStringConcatMethodInfo = GetType(String).GetMethod("Concat", Reflection.BindingFlags.Public Or Reflection.BindingFlags.Static, Nothing, New Type() {GetType(String), GetType(String)}, Nothing)
		OurObjectConcatMethodInfo = GetType(String).GetMethod("Concat", Reflection.BindingFlags.Public Or Reflection.BindingFlags.Static, Nothing, New Type() {GetType(Object), GetType(Object)}, Nothing)
	End Sub

	Public Sub New()

	End Sub

	Protected Overrides Sub GetOperation(ByVal operation As Object)
		MyOperation = DirectCast(operation, BinaryArithmeticOperation)
	End Sub

	Protected Overrides Function GetResultType(ByVal leftType As System.Type, ByVal rightType As System.Type) As System.Type
		If Not ImplicitConverter.GetBinaryResultType(leftType, rightType) Is Nothing Then
			If MyOperation = BinaryArithmeticOperation.Power Then
				Return GetType(Double)
			Else
				Return ImplicitConverter.GetBinaryResultType(leftType, rightType)
			End If
		ElseIf Me.IsEitherChildOfType(GetType(String)) = True And (MyOperation = BinaryArithmeticOperation.Add) Then
			Return GetType(String)
		Else
			Return Nothing
		End If
	End Function

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As IServiceContainer)
		If Me.IsEitherChildOfType(GetType(String)) = True Then
			Me.EmitStringAdd(ilg, services)
		Else
			Me.EmitChildWithConvert(MyLeftChild, Me.ResultType, ilg, services)
			Me.EmitChildWithConvert(MyRightChild, Me.ResultType, ilg, services)
			Me.EmitOperation(MyOperation, ilg, services)
		End If
	End Sub

	Private Function IsUnsignedForArithmetic(ByVal t As Type) As Boolean
		Return t Is GetType(UInt32) Or t Is GetType(UInt64)
	End Function

	Private Sub EmitOperation(ByVal op As BinaryArithmeticOperation, ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim options As ExpressionOptions = services.GetService(GetType(ExpressionOptions))
		Dim unsigned As Boolean = Me.IsUnsignedForArithmetic(MyLeftChild.ResultType) And Me.IsUnsignedForArithmetic(MyRightChild.ResultType)
		Dim integral As Boolean = IsIntegralType(MyLeftChild.ResultType) And IsIntegralType(MyRightChild.ResultType)
		Dim emitOverflow As Boolean = integral And options.Checked

		Select Case op
			Case BinaryArithmeticOperation.Add
				If emitOverflow = True Then
					If unsigned = True Then
						ilg.Emit(OpCodes.Add_Ovf_Un)
					Else
						ilg.Emit(OpCodes.Add_Ovf)
					End If
				Else
					ilg.Emit(OpCodes.Add)
				End If
			Case BinaryArithmeticOperation.Subtract
				If emitOverflow = True Then
					If unsigned = True Then
						ilg.Emit(OpCodes.Sub_Ovf_Un)
					Else
						ilg.Emit(OpCodes.Sub_Ovf)
					End If
				Else
					ilg.Emit(OpCodes.Sub)
				End If
			Case BinaryArithmeticOperation.Multiply
				If emitOverflow = True Then
					If unsigned = True Then
						ilg.Emit(OpCodes.Mul_Ovf_Un)
					Else
						ilg.Emit(OpCodes.Mul_Ovf)
					End If
				Else
					ilg.Emit(OpCodes.Mul)
				End If
			Case BinaryArithmeticOperation.Divide
				If unsigned = True Then
					ilg.Emit(OpCodes.Div_Un)
				Else
					ilg.Emit(OpCodes.Div)
				End If
			Case BinaryArithmeticOperation.Mod
				If unsigned = True Then
					ilg.Emit(OpCodes.Rem_Un)
				Else
					ilg.Emit(OpCodes.[Rem])
				End If
			Case BinaryArithmeticOperation.Power
				ilg.EmitCall(OpCodes.Call, OurPowerMethodInfo, Nothing)
			Case Else
				Throw New ArgumentException("Unknown op type")
		End Select
	End Sub

	Private Sub EmitStringAdd(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim argType As Type
		Dim concatMethodInfo As System.Reflection.MethodInfo

		If Me.AreBothChildrenOfType(GetType(String)) = True Then
			concatMethodInfo = OurStringConcatMethodInfo
			argType = GetType(String)
		Else
			Debug.Assert(Me.IsEitherChildOfType(GetType(String)), "one child must be a string")
			concatMethodInfo = OurObjectConcatMethodInfo
			argType = GetType(Object)
		End If

		MyLeftChild.Emit(ilg, services)
		EmitConversion(MyLeftChild.ResultType, argType, ilg)
		MyRightChild.Emit(ilg, services)
		EmitConversion(MyRightChild.ResultType, argType, ilg)

		ilg.EmitCall(OpCodes.Call, concatMethodInfo, Nothing)
	End Sub

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

' Unary negate
Friend Class NegateExpression
	Inherits UnaryExpression

	Public Sub New()

	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As IServiceContainer)
		Dim resultType As Type = Me.ResultType
		MyChild.Emit(ilg, services)
		EmitConversion(MyChild.ResultType, resultType, ilg)
		ilg.Emit(OpCodes.Neg)
	End Sub

	Protected Overrides Function GetResultType(ByVal childType As System.Type) As System.Type
		Dim tc As TypeCode = Type.GetTypeCode(childType)

		Select Case tc
			Case TypeCode.Single, TypeCode.Double, TypeCode.Int32, TypeCode.Int64
				Return childType
			Case TypeCode.UInt32
				Return GetType(Int64)
			Case Else
				Return Nothing
		End Select
	End Function

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

Friend Class ShiftElement
	Inherits BinaryExpressionElement

	Private MyOperation As ShiftOperation

	Public Sub New()

	End Sub

	Protected Overrides Function GetResultType(ByVal leftType As System.Type, ByVal rightType As System.Type) As System.Type
		If ImplicitConverter.EmitImplicitNumericConvert(rightType, GetType(Int32), Nothing) = False Then
			Return Nothing
		End If

		If IsIntegralType(leftType) = False Then
			Return Nothing
		End If

		Dim tc As TypeCode = Type.GetTypeCode(leftType)

		Select Case tc
			Case TypeCode.Byte, TypeCode.SByte, TypeCode.Int16, TypeCode.UInt16, TypeCode.Int32
				Return GetType(Int32)
			Case TypeCode.UInt32
				Return GetType(UInt32)
			Case TypeCode.Int64
				Return GetType(Int64)
			Case TypeCode.UInt64
				Return GetType(UInt64)
			Case Else
				Debug.Assert(False, "unknown left shift operand")
				Return Nothing
		End Select
	End Function

	Protected Overrides Sub GetOperation(ByVal operation As Object)
		MyOperation = DirectCast(operation, ShiftOperation)
	End Sub

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As System.ComponentModel.Design.IServiceContainer)
		MyLeftChild.Emit(ilg, services)
		Me.EmitShiftCount(ilg, services)
		Me.EmitShift(ilg)
	End Sub

	Private Sub EmitShiftCount(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		MyRightChild.Emit(ilg, services)
		Dim tc As TypeCode = Type.GetTypeCode(MyLeftChild.ResultType)
		Select Case tc
			Case TypeCode.Byte, TypeCode.SByte, TypeCode.Int16, TypeCode.UInt16, TypeCode.Int32, TypeCode.UInt32
				ilg.Emit(OpCodes.Ldc_I4_S, CSByte(&H1F))
			Case TypeCode.Int64, TypeCode.UInt64
				ilg.Emit(OpCodes.Ldc_I4_S, CSByte(&H3F))
			Case Else
				Debug.Assert(False, "unknown left shift operand")
		End Select

		ilg.Emit(OpCodes.And)
	End Sub

	Private Sub EmitShift(ByVal ilg As ILGenerator)
		Dim tc As TypeCode = Type.GetTypeCode(MyLeftChild.ResultType)
		Dim op As OpCode

		Select Case tc
			Case TypeCode.Byte, TypeCode.SByte, TypeCode.Int16, TypeCode.UInt16, TypeCode.Int32, TypeCode.Int64
				If MyOperation = ShiftOperation.LeftShift Then
					op = OpCodes.Shl
				Else
					op = OpCodes.Shr
				End If
			Case TypeCode.UInt32, TypeCode.UInt64
				If MyOperation = ShiftOperation.LeftShift Then
					op = OpCodes.Shl
				Else
					op = OpCodes.Shr_Un
				End If
			Case Else
				Debug.Assert(False, "unknown left shift operand")
		End Select

		ilg.Emit(op)
	End Sub

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "Shift"
		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