Click here to Skip to main content
15,891,529 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 196K   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
'

' Bitwise and logical operations
Imports System.Reflection.Emit
Imports System.ComponentModel.Design

' Logical and bitwise Not
Friend Class NotExpression
	Inherits UnaryExpression

	Public Overrides Sub Emit(ByVal ilg As System.Reflection.Emit.ILGenerator, ByVal services As IServiceContainer)
		If MyChild.ResultType Is GetType(Boolean) Then
			Me.EmitLogical(ilg, services)
		Else
			MyChild.Emit(ilg, services)
			ilg.Emit(OpCodes.Not)
		End If
	End Sub

	Private Sub EmitLogical(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		MyChild.Emit(ilg, services)
		ilg.Emit(OpCodes.Ldc_I4_0)
		ilg.Emit(OpCodes.Ceq)
	End Sub

	Protected Overrides Function GetResultType(ByVal childType As System.Type) As System.Type
		If childType Is GetType(Boolean) Then
			Return GetType(Boolean)
		ElseIf IsIntegralType(childType) = True Then
			Return childType
		Else
			Return Nothing
		End If
	End Function

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

' Bitwise and logical And/Or/Xor
Friend Class AndOrXorExpression
	Inherits BinaryExpressionElement

	Private MyOperation As AndOrXorOperation
	Private Shared OurTrueTerminalKey As New Object
	Private Shared OurFalseTerminalKey As New Object
	Private Shared OurEndLabelKey As New Object

	Public Sub New()

	End Sub

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

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

		If resultType Is GetType(Boolean) Then
			Me.EmitLogical(ilg, services)
		Else
			MyLeftChild.Emit(ilg, services)
			EmitConversion(MyLeftChild.ResultType, resultType, ilg)
			MyRightChild.Emit(ilg, services)
			EmitConversion(MyRightChild.ResultType, resultType, ilg)
			Me.EmitBitwiseOperation(ilg, MyOperation)
		End If
	End Sub

	Private Sub EmitBitwiseOperation(ByVal ilg As ILGenerator, ByVal op As AndOrXorOperation)
		Select Case op
			Case AndOrXorOperation.And
				ilg.Emit(OpCodes.And)
			Case AndOrXorOperation.Or
				ilg.Emit(OpCodes.Or)
			Case AndOrXorOperation.Xor
				ilg.Emit(OpCodes.Xor)
			Case Else
				Throw New InvalidOperationException("Unknown op type")
		End Select
	End Sub

	' Emit a short-circuited logical operation sequence
	' The idea: Store all the leaf operands in a stack with the leftmost at the top and rightmost at the bottom.
	' For each operand, emit it and try to find an end point for when it short-circuits.  This means we go up through
	' the stack of operators (ignoring siblings) until we find a different operation (then emit a branch to its right operand)
	' or we reach the root (emit a branch to a true/false).
	' Repeat the process for all operands and then emit the true/false/last operand end cases.
	Private Sub EmitLogical(ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		Dim operands As New Stack()								' The leaf operands with leftmost at top
		Dim operators As New Stack()							' The stack of operators
		Dim labels As IDictionary = New Hashtable()				' All used labels

		' We always have an end label
		labels.Add(OurEndLabelKey, ilg.DefineLabel())

		' Populate our data structures
		Me.PopulateData(operands, operators)

		' Emit the sequence
		Me.EmitLogicalShortCircuit(operands, operators, ilg, services, labels)

		' Get the last operand
		Dim terminalOperand As ExpressionElement = operands.Pop()
		' Emit it
		Me.EmitOperand(terminalOperand, labels, ilg, services)
		' And jump to the end
		Dim endLabel As Label = labels.Item(OurEndLabelKey)
		ilg.Emit(OpCodes.Br_S, endLabel)

		' Emit our true/false terminals
		Me.EmitTerminals(labels, ilg, endLabel)

		' Mark the end
		ilg.MarkLabel(endLabel)
	End Sub

	' Emit a sequence of and/or expressions with short-circuiting
	Private Sub EmitLogicalShortCircuit(ByVal operands As Stack, ByVal operators As Stack, ByVal ilg As ILGenerator, ByVal services As IServiceContainer, ByVal labels As IDictionary)
		While operators.Count <> 0
			' Get the operator
			Dim op As AndOrXorExpression = operators.Pop()
			' Get the left operand
			Dim leftOperand As ExpressionElement = operands.Pop()

			' Emit the left
			Me.EmitOperand(leftOperand, labels, ilg, services)

			' Get the label for the short-circuit case
			Dim l As Label = Me.GetShortCircuitLabel(op, labels, operands, operators, ilg)
			Dim brOpcode As OpCode

			' Get the appropriate branch opcode
			If op.MyOperation = AndOrXorOperation.And Then
				brOpcode = OpCodes.Brfalse_S
			Else
				brOpcode = OpCodes.Brtrue_S
			End If

			' Emit the branch
			ilg.Emit(brOpcode, l)
		End While
	End Sub

	' Get the label for a short-circuit
	Private Function GetShortCircuitLabel(ByVal current As AndOrXorExpression, ByVal labels As IDictionary, ByVal operands As Stack, ByVal operators As Stack, ByVal ilg As ILGenerator) As Label
		' We modify the given stacks so we need to clone them
		Dim cloneOperands As Stack = operands.Clone()
		Dim cloneOperators As Stack = operators.Clone()

		' Pop all siblings
		current.PopRightChild(cloneOperands, cloneOperators)

		' Go until we run out of operators
		While cloneOperators.Count > 0
			' Get the top operator
			Dim top As AndOrXorExpression = cloneOperators.Pop()

			' Is is a different operation?
			If top.MyOperation <> current.MyOperation Then
				' Yes, so return a label to its right operand
				Dim nextOperand As Object = cloneOperands.Pop()
				Return Me.GetLabel(nextOperand, labels, ilg)
			Else
				' No, so keep going up the stack
				top.PopRightChild(cloneOperands, cloneOperators)
			End If
		End While

		' We've reached the end of the stack so return the label for the appropriate true/false terminal
		If current.MyOperation = AndOrXorOperation.And Then
			Return Me.GetLabel(OurFalseTerminalKey, labels, ilg)
		Else
			Return Me.GetLabel(OurTrueTerminalKey, labels, ilg)
		End If
	End Function

	Private Sub PopRightChild(ByVal operands As Stack, ByVal operators As Stack)
		Dim andOrChild As AndOrXorExpression = TryCast(MyRightChild, AndOrXorExpression)

		' What kind of child do we have?
		If Not andOrChild Is Nothing Then
			' Another and/or expression so recurse
			andOrChild.Pop(operands, operators)
		Else
			' A terminal so pop it off the operands stack
			operands.Pop()
		End If
	End Sub

	' Recursively pop operators and operands
	Private Sub Pop(ByVal operands As Stack, ByVal operators As Stack)
		operators.Pop()

		Dim andOrChild As AndOrXorExpression = TryCast(MyLeftChild, AndOrXorExpression)
		If andOrChild Is Nothing Then
			operands.Pop()
		Else
			andOrChild.Pop(operands, operators)
		End If

		andOrChild = TryCast(MyRightChild, AndOrXorExpression)

		If andOrChild Is Nothing Then
			operands.Pop()
		Else
			andOrChild.Pop(operands, operators)
		End If
	End Sub

	Private Sub EmitOperand(ByVal operand As ExpressionElement, ByVal labels As IDictionary, ByVal ilg As ILGenerator, ByVal services As IServiceContainer)
		' Is this operand is the target of a label?
		If labels.Contains(operand) = True Then
			' Yes, so mark it
			Dim leftLabel As Label = labels.Item(operand)
			ilg.MarkLabel(leftLabel)
		End If

		' Emit the operand
		operand.Emit(ilg, services)
	End Sub

	' Emit the end cases for a short-circuit
	Private Sub EmitTerminals(ByVal labels As IDictionary, ByVal ilg As ILGenerator, ByVal endLabel As Label)
		' Emit the false case if it was used
		If labels.Contains(OurFalseTerminalKey) = True Then
			Dim falseLabel As Label = labels.Item(OurFalseTerminalKey)
			ilg.MarkLabel(falseLabel)
			ilg.Emit(OpCodes.Ldc_I4_0)

			' If we also have a true terminal, then skip over it
			If labels.Contains(OurTrueTerminalKey) = True Then
				ilg.Emit(OpCodes.Br_S, endLabel)
			End If
		End If

		' Emit the true case if it was used
		If labels.Contains(OurTrueTerminalKey) = True Then
			Dim trueLabel As Label = labels.Item(OurTrueTerminalKey)
			ilg.MarkLabel(trueLabel)
			ilg.Emit(OpCodes.Ldc_I4_1)
		End If
	End Sub

	Private Function GetLabel(ByVal key As Object, ByVal labels As IDictionary, ByVal ilg As ILGenerator) As Label
		If labels.Contains(key) = False Then
			Dim l As Label = ilg.DefineLabel()
			labels.Add(key, l)
		End If

		Return labels.Item(key)
	End Function

	' Visit the nodes of the tree (right then left) and populate some data structures
	Private Sub PopulateData(ByVal operands As Stack, ByVal operators As Stack)
		' Is our right child a leaf or another And/Or expression?
		Dim andOrChild As AndOrXorExpression = TryCast(MyRightChild, AndOrXorExpression)
		If andOrChild Is Nothing Then
			' Leaf so push it on the stack
			operands.Push(MyRightChild)
		Else
			' Another And/Or expression so recurse
			andOrChild.PopulateData(operands, operators)
		End If

		' Add ourselves as an operator
		operators.Push(Me)

		' Do the same thing for the left child
		andOrChild = TryCast(MyLeftChild, AndOrXorExpression)

		If andOrChild Is Nothing Then
			operands.Push(MyLeftChild)
		Else
			andOrChild.PopulateData(operands, operators)
		End If
	End Sub

	Protected Overrides Function GetResultType(ByVal leftType As System.Type, ByVal rightType As System.Type) As System.Type
		Dim bitwiseOpType As Type = Me.GetBitwiseOpType(leftType, rightType)
		If Not bitwiseOpType Is Nothing Then
			Return bitwiseOpType
		ElseIf Me.AreBothChildrenOfType(GetType(Boolean)) And ((MyOperation = AndOrXorOperation.And) Or (MyOperation = AndOrXorOperation.Or)) Then
			Return GetType(Boolean)
		Else
			Return Nothing
		End If
	End Function

	Private Function GetBitwiseOpType(ByVal leftType As Type, ByVal rightType As Type) As Type
		If IsIntegralType(leftType) = False OrElse IsIntegralType(rightType) = False Then
			Return Nothing
		Else
			Return ImplicitConverter.GetBinaryResultType(leftType, rightType)
		End If
	End Function

	Protected Overrides ReadOnly Property Name() As String
		Get
			Return "And/Or/Xor Operator"
		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