A Calculation Engine for .NET

''' <summary>
''' Base class that represents parsed expressions.
''' </summary>
''' <remarks>
''' For example:
''' <code>
''' Expression expr = scriptEngine.Parse(strExpression);
''' object val = expr.Evaluate();
''' </code>
''' </remarks>
Public Class Expression
    Implements IComparable(Of Expression)

    ' Fields
    Private Shared _ci As System.Globalization.CultureInfo = System.Globalization.CultureInfo.InvariantCulture
    Friend _token As Token

    ' Methods
    Friend Sub New()
        _token = New Token(Nothing, TKID.ATOM, TKTYPE.IDENTIFIER)
    End Sub

    Friend Sub New(ByVal tk As Token)
        _token = tk
    End Sub

    Friend Sub New(ByVal value As Object)
        _token = New Token(value, TKID.ATOM, TKTYPE.LITERAL)
    End Sub

    Public Function CompareTo(ByVal other As Expression) As Integer
        Dim c1 As IComparable = TryCast(Evaluate, IComparable)
        Dim c2 As IComparable = TryCast(other.Evaluate, IComparable)
        If ((c1 Is Nothing) AndAlso (c2 Is Nothing)) Then
            Return 0
        End If
        If (c2 Is Nothing) Then
            Return -1
        End If
        If (c1 Is Nothing) Then
            Return 1
        End If
        Return c1.CompareTo(c2)
    End Function

    Public Overridable Function Evaluate() As Object
        If (_token.Type <> TKTYPE.LITERAL) Then
            Throw New ArgumentException("Bad expression.")
        End If
        Return _token.Value
    End Function

    Public Shared Widening Operator CType(ByVal x As Expression) As Boolean
        Dim v As Object = x.Evaluate
        If TypeOf v Is Boolean Then
            Return CBool(v)
        End If
        If (v Is Nothing) Then
            Return False
        End If
        If TypeOf v Is Double Then
            Return (CDbl(v) <> 0)
        End If
        Return (CDbl(x) <> 0)
    End Operator

    Public Shared Widening Operator CType(ByVal x As Expression) As DateTime
        Dim v As Object = x.Evaluate
        If TypeOf v Is DateTime Then
            Return CDate(v)
        End If
        If TypeOf v Is Double Then
            Return DateTime.FromOADate(CDbl(x))
        End If
        Return CDate(Convert.ChangeType(v, GetType(DateTime), Expression._ci))
    End Operator

    Public Shared Widening Operator CType(ByVal x As Expression) As Double
        Dim v As Object = x.Evaluate
        If TypeOf v Is Double Then
            Return CDbl(v)
        End If
        If TypeOf v Is Boolean Then
            Return IIf(CBool(v), CDbl(1), CDbl(0))
        End If
        If TypeOf v Is DateTime Then
            Dim dt As DateTime = CDate(v)
            Return dt.ToOADate
        End If
        If (v Is Nothing) Then
            Return 0
        End If
        Return CDbl(Convert.ChangeType(v, GetType(Double), Expression._ci))
    End Operator

    Public Shared Widening Operator CType(ByVal x As Expression) As Integer
        Dim dbl As Double = CType(x, Double)
        Return CInt(dbl)
    End Operator

    Public Shared Widening Operator CType(ByVal x As Expression) As String
        Dim v As Object = x.Evaluate
        Return IIf((v Is Nothing), String.Empty, v.ToString)
    End Operator

    Public Overridable Function Optimize() As Expression
        Return Me
    End Function

    Public Function CompareTo1(ByVal other As Expression) As Integer Implements System.IComparable(Of Expression).CompareTo

    End Function
End Class

''' <summary>
''' Unary expression, e.g. +123
''' </summary>
Friend Class UnaryExpression
    Inherits Expression

    ' Fields
    Private _expr As Expression

    ' Methods
    Public Sub New(ByVal tk As Token, ByVal expr As Expression)
        MyBase.New(tk)
        _expr = expr
    End Sub

    Public Overrides Function Evaluate() As Object
        Select Case MyBase._token.ID
            Case TKID.ADD
                Return CDbl(_expr)
            Case TKID.SUB
                Return -CDbl(_expr)
        End Select
        Throw New ArgumentException("Bad expression.")
    End Function

    Public Overrides Function Optimize() As Expression
        _expr = _expr.Optimize
        Return IIf((_expr._token.Type = TKTYPE.LITERAL), New Expression(Evaluate), Me)
    End Function
End Class

''' <summary>
''' Binary expression, e.g. 1+2
''' </summary>
Friend Class BinaryExpression
    Inherits Expression

    ' Fields
    Private _lft As Expression
    Private _rgt As Expression

    ' Methods
    Public Sub New(ByVal tk As Token, ByVal exprLeft As Expression, ByVal exprRight As Expression)
        MyBase.New(tk)
        _lft = exprLeft
        _rgt = exprRight
    End Sub

    Public Overrides Function Evaluate() As Object
        If (MyBase._token.Type = TKTYPE.COMPARE) Then
            Dim cmp As Integer = _lft.CompareTo(_rgt)
            Select Case MyBase._token.ID
                Case TKID.GT
                    Return (cmp > 0)
                Case TKID.LT
                    Return (cmp < 0)
                Case TKID.GE
                    Return (cmp >= 0)
                Case TKID.LE
                    Return (cmp <= 0)
                Case TKID.EQ
                    Return (cmp = 0)
                Case TKID.NE
                    Return (cmp <> 0)
            End Select
        End If
        Select Case MyBase._token.ID
            Case TKID.ADD
                Return (CDbl(_lft) + CDbl(_rgt))
            Case TKID.SUB
                Return (CDbl(_lft) - CDbl(_rgt))
            Case TKID.MUL
                Return (CDbl(_lft) * CDbl(_rgt))
            Case TKID.DIV
                Return (CDbl(_lft) / CDbl(_rgt))
            Case TKID.DIVINT
                Return CDbl(CInt((CDbl(_lft) / CDbl(_rgt))))
            Case TKID.MOD
                Return CDbl(CInt((CDbl(_lft) Mod CDbl(_rgt))))
            Case TKID.POWER
                Dim a As Double = CDbl(_lft)
                Dim b As Double = CDbl(_rgt)
                If (b <> 0) Then
                    Select Case b
                        Case 0.5
                            Return Math.Sqrt(a)
                        Case 1
                            Return a
                        Case 2
                            Return (a * a)
                        Case 3
                            Return ((a * a) * a)
                        Case 4
                            Return (((a * a) * a) * a)
                    End Select
                    Return Math.Pow(CDbl(_lft), CDbl(_rgt))
                End If
                Return 1
        End Select
        Throw New ArgumentException("Bad expression.")
    End Function

    Public Overrides Function Optimize() As Expression
        _lft = _lft.Optimize
        _rgt = _rgt.Optimize
        Return IIf(((_lft._token.Type = TKTYPE.LITERAL) AndAlso (_rgt._token.Type = TKTYPE.LITERAL)), New Expression(Evaluate), Me)
    End Function
End Class

''' <summary>
''' Function call expression, e.g. sin(0.5)
''' </summary>
Friend Class FunctionExpression
    Inherits Expression

    ' Fields
    Private _fn As FunctionDefinition
    Private _parms As List(Of Expression)

    ' Methods
    Friend Sub New()
    End Sub

    Public Sub New(ByVal [function] As FunctionDefinition, ByVal parms As List(Of Expression))
        _fn = [function]
        _parms = parms
    End Sub

    Public Overrides Function Evaluate() As Object
        Return _fn.Function.Invoke(_parms)
    End Function

    Public Overrides Function Optimize() As Expression
        Dim allLits As Boolean = True
        If (Not _parms Is Nothing) Then
            Dim i As Integer
            For i = 0 To _parms.Count - 1
                Dim p As Expression = _parms.Item(i).Optimize
                _parms.Item(i) = p
                If (p._token.Type <> TKTYPE.LITERAL) Then
                    allLits = False
                End If
            Next i
        End If
        Return IIf(allLits, New Expression(Evaluate), Me)
    End Function
End Class

''' <summary>
''' Simple variable reference.
''' </summary>
Friend Class VariableExpression
    Inherits Expression

    ' Fields
    Private _dct As Dictionary(Of String, Object)
    Private _name As String

    ' Methods
    Public Sub New(ByVal dct As Dictionary(Of String, Object), ByVal name As String)
        _dct = dct
        _name = name
    End Sub

    Public Overrides Function Evaluate() As Object
        Return _dct.Item(_name)
    End Function

End Class

''' <summary>
''' Expression based on an object's properties.
''' </summary>
Friend Class BindingExpression
    Inherits Expression

    ' Fields
    Private _bindingPath As List(Of BindingInfo)
    Private _ci As System.Globalization.CultureInfo
    Private _ce As CalcEngine

    ' Methods
    Friend Sub New(ByVal engine As CalcEngine, ByVal bindingPath As List(Of BindingInfo), ByVal ci As System.Globalization.CultureInfo)
        _ce = engine
        _bindingPath = bindingPath
        _ci = ci
    End Sub

    Public Overrides Function Evaluate() As Object
        Return GetValue(_ce.DataContext)
    End Function

    Private Function GetValue(ByVal obj As Object) As Object
        Dim bf As System.Reflection.BindingFlags = System.Reflection.BindingFlags.Public Or System.Reflection.BindingFlags.Static Or System.Reflection.BindingFlags.Instance Or System.Reflection.BindingFlags.IgnoreCase
        Dim bi As BindingInfo
        For Each bi In _bindingPath
            If (bi.PropertyInfo Is Nothing) Then
                bi.PropertyInfo = obj.GetType.GetProperty(bi.Name, bf)
            End If
            obj = bi.PropertyInfo.GetValue(obj, Nothing)
            If ((Not bi.Parms Is Nothing) AndAlso (bi.Parms.Count > 0)) Then
                If (bi.PropertyInfoItem Is Nothing) Then
                    bi.PropertyInfoItem = obj.GetType.GetProperty("Item", bf)
                End If
                Dim pip As System.Reflection.ParameterInfo() = bi.PropertyInfoItem.GetIndexParameters
                Dim list As New List(Of Object)
                Dim i As Integer
                For i = 0 To pip.Length - 1
                    Dim pv As Object = Convert.ChangeType(bi.Parms.Item(i).Evaluate, pip(i).ParameterType, _ci)
                    list.Add(pv)
                Next i
                obj = bi.PropertyInfoItem.GetValue(obj, list.ToArray)
            End If
        Next
        Return obj
    End Function
End Class

''' <summary>
''' Helper used for building BindingExpression objects.
''' </summary>
Friend Class BindingInfo

    ' Fields
    Dim _name As String
    Dim _parms As List(Of Expression)
    Dim _pi, _piItem As System.Reflection.PropertyInfo

    ' Methods
    Public Sub New(ByVal member As String, ByVal parms As List(Of Expression))
        Name = member
        Parms = parms
    End Sub


    ' Properties
    Public Property Name As String
        Get
            Return _name
        End Get
        Set(ByVal value As String)
            _name = value
        End Set
    End Property
    Public Property Parms As List(Of Expression)
        Get
            Return _parms
        End Get
        Set(ByVal value As List(Of Expression))
            _parms = value
        End Set
    End Property
    Public Property PropertyInfo As System.Reflection.PropertyInfo
        Get
            Return _pi
        End Get
        Set(ByVal value As System.Reflection.PropertyInfo)
            _pi = value
        End Set
    End Property
    Public Property PropertyInfoItem As System.Reflection.PropertyInfo
        Get
            Return _piItem
        End Get
        Set(ByVal value As System.Reflection.PropertyInfo)
            _piItem = value
        End Set
    End Property

End Class

''' <summary>
''' Expression that represents an external object.
''' </summary>
Friend Class XObjectExpression
    Inherits Expression
    Implements IEnumerable

    ' Fields
    Private _value As Object

    ' Methods
    Friend Sub New(ByVal value As Object)
        _value = value
    End Sub

    Public Overrides Function Evaluate() As Object
        Dim iv As IValueObject = TryCast(_value, IValueObject)
        If (Not iv Is Nothing) Then
            Return iv.GetValue
        End If
        Return _value
    End Function

    Public Function GetEnumerator() As IEnumerator Implements IEnumerable.GetEnumerator
        Dim ie As IEnumerable = TryCast(_value, IEnumerable)
        Return IIf((Not ie Is Nothing), ie.GetEnumerator, Nothing)
    End Function
End Class


''' <summary>
''' Interface supported by external objects that have to return a value
''' other than themselves (e.g. a cell range object should return the 
''' cell content instead of the range itself).
''' </summary>
Public Interface IValueObject
    ' Methods
    Function GetValue() As Object
End Interface