lateboundaccesstoexpression.vb

大名鼎鼎的mono是.NET平台的跨平台（支持linux

' 
' Visual Basic.Net Compiler
' Copyright (C) 2004 - 2007 Rolf Bjarne Kvinge, [e-mail]
' 
' 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., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301  USA
' 

Public MustInherit Class LateBoundAccessToExpression
    Inherits Expression

    Private m_LateBoundAccess As LateBoundAccessClassification

    ReadOnly Property LateBoundAccess() As LateBoundAccessClassification
        Get
            Return m_LateBoundAccess
        End Get
    End Property

    Public Overrides ReadOnly Property IsConstant() As Boolean
        Get
            Return False
        End Get
    End Property

    Public Overrides ReadOnly Property ConstantValue() As Object
        Get
            Throw New InternalException("A late bound expression does not have a constant value.")
        End Get
    End Property

    Sub New(ByVal Parent As ParsedObject, ByVal LateBoundAccessClassification As LateBoundAccessClassification)
        MyBase.new(Parent)
        m_LateBoundAccess = LateBoundAccessClassification
    End Sub

    Protected Overrides Function GenerateCodeInternal(ByVal Info As EmitInfo) As Boolean
        Dim result As Boolean = True

        Helper.NotImplemented()

        Return result
    End Function

    Overrides ReadOnly Property ExpressionType() As Type
        Get
            Return Compiler.TypeCache.System_Object
        End Get
    End Property

    Protected Function EmitLateIndexGet(ByVal Info As EmitInfo) As Boolean
        Return EmitLateIndexGet(Info, LateBoundAccess)
    End Function

    Protected Function EmitLateGet(ByVal Info As EmitInfo) As Boolean
        Return EmitLateGet(Info, LateBoundAccess)
    End Function

    Protected Function EmitLateIndexSet(ByVal Info As EmitInfo) As Boolean
        Return EmitLateIndexSet(Info, LateBoundAccess)
    End Function

    Protected Function EmitLateSet(ByVal Info As EmitInfo) As Boolean
        Return EmitLateSet(Info, LateBoundAccess)
    End Function

    ''' <summary>
    ''' Creates an object array (always).
    ''' - initializes it with the arguments (if any). 
    ''' - adds the rhs expression (if supplied).
    ''' Leaves a reference to the object array on the stack.
    ''' </summary>
    ''' <param name="Info"></param>
    ''' <param name="LateBoundAccess"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function EmitArguments(ByVal Info As EmitInfo, ByVal LateBoundAccess As LateBoundAccessClassification, ByRef arguments As LocalBuilder) As Boolean
        Dim result As Boolean = True

        Dim argCount As Integer
        Dim elementCount As Integer
        Dim args As ArgumentList

        args = LateBoundAccess.Arguments
        If args IsNot Nothing Then argCount = args.Count

        elementCount = argCount
        If Info.RHSExpression IsNot Nothing Then elementCount += 1

        arguments = Emitter.DeclareLocal(Info, Info.Compiler.TypeCache.System_Object_Array)

        Emitter.EmitLoadI4Value(Info, elementCount)
        Emitter.EmitNewArr(Info, Info.Compiler.TypeCache.System_Object)

        Emitter.EmitStoreVariable(Info, arguments)

        For i As Integer = 0 To argCount - 1
            Dim arg As Argument = args.Arguments(i)
            Emitter.EmitLoadVariable(Info, arguments)
            Emitter.EmitLoadI4Value(Info, i)
            If arg.Expression Is Nothing Then
                Emitter.EmitLoadVariable(Info, Info.Compiler.TypeCache.System_Reflection_Missing__Value)
            Else
                result = arg.GenerateCode(Info.Clone(True, False, arg.Expression.ExpressionType)) AndAlso result
                If arg.Expression.ExpressionType.IsValueType Then
                    Emitter.EmitBox(Info, arg.Expression.ExpressionType)
                End If
            End If
            Emitter.EmitStoreElement(Info, Info.Compiler.TypeCache.System_Object, Info.Compiler.TypeCache.System_Object_Array)
        Next

        If elementCount <> argCount Then
            Emitter.EmitLoadVariable(Info, arguments)
            Emitter.EmitLoadI4Value(Info, elementCount - 1)
            result = Info.RHSExpression.GenerateCode(Info.Clone(True, False, Info.RHSExpression.ExpressionType)) AndAlso result
            If Info.RHSExpression.ExpressionType.IsValueType Then
                Emitter.EmitBox(Info, Info.RHSExpression.ExpressionType)
            End If
            Emitter.EmitStoreElement(Info, Info.Compiler.TypeCache.System_Object, Info.Compiler.TypeCache.System_Object_Array)
        End If

        Emitter.EmitLoadVariable(Info, arguments)

        Return result
    End Function

    ''' <summary>
    ''' If there's anything to copy back, creates a boolean array with:
    ''' - true if the value can be copied back (the argument is assignable, that is: field, variable, rw property), otherwise false (function, ro property, constant)
    ''' Otherwise just loads a null value.
    ''' </summary>
    ''' <param name="Info"></param>
    ''' <param name="LateBoundAccess"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function EmitCopyBacks(ByVal Info As EmitInfo, ByVal LateBoundAccess As LateBoundAccessClassification, ByRef copyBackHints As Boolean(), ByRef copyBacks As LocalBuilder) As Boolean
        Dim result As Boolean = True
        Dim args As ArgumentList

        args = LateBoundAccess.Arguments

        If args Is Nothing OrElse args.Count = 0 Then
            Emitter.EmitLoadNull(Info.Clone(Info.Compiler.TypeCache.System_Boolean_Array))
        Else
            copyBackHints = New Boolean(args.Count - 1) {}
            copyBacks = Emitter.DeclareLocal(Info, Info.Compiler.TypeCache.System_Boolean_Array)

            Emitter.EmitLoadI4Value(Info, args.Count)
            Emitter.EmitNewArr(Info, Info.Compiler.TypeCache.System_Boolean)
            Emitter.EmitStoreVariable(Info, copyBacks)
            For i As Integer = 0 To args.Count - 1
                Dim arg As Argument
                Dim exp As Expression
                Dim copyBack As Boolean

                arg = args.Arguments(i)
                exp = arg.Expression

                Emitter.EmitLoadVariable(Info, copyBacks) ' Emitter.EmitDup(Info)
                Emitter.EmitLoadI4Value(Info, i)
                If exp Is Nothing Then
                    copyBack = False
                Else
                    Select Case exp.Classification.Classification
                        Case ExpressionClassification.Classifications.Variable
                            Dim varC As VariableClassification = exp.Classification.AsVariableClassification
                            If varC.LocalBuilder IsNot Nothing Then
                                copyBack = True
                            ElseIf varC.FieldInfo IsNot Nothing Then
                                Dim fD As FieldDescriptor = TryCast(varC.FieldInfo, FieldDescriptor)
                                If fD IsNot Nothing Then
                                    'TODO: Is the copyback done for readonly fields inside constructors?
                                    copyBack = fD.IsLiteral = False AndAlso fD.Declaration.Modifiers.Is(ModifierMasks.ReadOnly) = False
                                Else
                                    copyBack = varC.FieldInfo.IsLiteral = False
                                End If
                            Else
                                copyBack = False
                            End If
                        Case ExpressionClassification.Classifications.Value
                            copyBack = False
                        Case ExpressionClassification.Classifications.PropertyAccess
                            copyBack = exp.Classification.AsPropertyAccess.ResolvedProperty.CanWrite
                        Case Else
                            Helper.NotImplemented()
                    End Select
                End If
                copyBackHints(i) = copyBack
                If copyBack Then
                    Emitter.EmitLoadI4Value(Info, 1)
                Else
                    Emitter.EmitLoadI4Value(Info, 0)
                End If
                Emitter.EmitStoreElement(Info, Info.Compiler.TypeCache.System_Boolean, Info.Compiler.TypeCache.System_Boolean_Array)
            Next
            Emitter.EmitLoadVariable(Info, copyBacks)
        End If

        Return result
    End Function

    Private Shared Function EmitStoreBacks(ByVal Info As EmitInfo, ByVal LateBoundAccess As LateBoundAccessClassification, ByVal CopyBacks As Boolean(), ByVal array As LocalBuilder, ByVal arguments As LocalBuilder) As Boolean
        Dim result As Boolean = True
        Dim args As ArgumentList