latebinder.vb

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

'
' LateBinder.vb
'
' Author:
'   Boris Kirzner ([e-mail])
'

'
' Copyright (C) 2002-2006 Mainsoft Corporation.
' Copyright (C) 2004-2006 Novell, Inc (http://www.novell.com)
'
' Permission is hereby granted, free of charge, to any person obtaining
' a copy of this software and associated documentation files (the
' "Software"), to deal in the Software without restriction, including
' without limitation the rights to use, copy, modify, merge, publish,
' distribute, sublicense, and/or sell copies of the Software, and to
' permit persons to whom the Software is furnished to do so, subject to
' the following conditions:
' 
' The above copyright notice and this permission notice shall be
' included in all copies or substantial portions of the Software.
' 
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
' EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
' MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
' NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE
' LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION
' OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION
' WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.

Imports System
Imports System.Reflection
Imports System.Globalization
Imports System.ComponentModel
'Helper Class for LateBinding. Not public.
Namespace Microsoft.VisualBasic.CompilerServices
    Friend Class LateBinder
        Inherits Binder

        Private _wasIncompleteInvocation As Boolean
        Private _invokeNext As MethodInfo
        Private _invokeNextArgs() As Object

        Public ReadOnly Property WasIncompleteInvocation() As Boolean
            Get
                Return _wasIncompleteInvocation
            End Get
        End Property
        Public ReadOnly Property InvokeNext() As MethodInfo
            Get
                Return _invokeNext
            End Get
        End Property
        Public ReadOnly Property InvokeNextArgs() As Object()
            Get
                Return _invokeNextArgs
            End Get
        End Property
        
        Private Enum TypeConversion
            NotConvertible
            Equal
            [Widening]
            [Narrowing]
        End Enum

        Private Enum SignatureCompare
            Equal
            Left
            Right
            Ambiguity
        End Enum

        Public Sub New()
            MyBase.new()
        End Sub

        Class BState
            Public mapping() As Integer
            Public parameters() As ParameterInfo
            Public oargs() As Object
        End Class

        Public Shared Function GetStateInstance() As Object
            Return New BState
        End Function

        Public Overrides Function BindToField(ByVal bindingAttr As System.Reflection.BindingFlags, _
                                                ByVal match() As System.Reflection.FieldInfo, _
                                                ByVal value As Object, _
                                                ByVal culture As System.Globalization.CultureInfo) As System.Reflection.FieldInfo
            Throw New NotImplementedException
        End Function

        Public Overrides Function BindToMethod(ByVal bindingAttr As System.Reflection.BindingFlags, _
                                                ByVal match() As System.Reflection.MethodBase, _
                                                ByRef args() As Object, _
                                                ByVal modifiers() As System.Reflection.ParameterModifier, _
                                                ByVal culture As System.Globalization.CultureInfo, _
                                                ByVal names() As String, _
                                                ByRef state As Object) As System.Reflection.MethodBase


            state = GetStateInstance()
            CType(state, BState).oargs = CType(args.Clone(), Object())

            Dim matchExists As Boolean = False

            'FIXME : add filtering of methods hiding by name and by signature

            Dim nameMatches() As MethodBase = FilterMethodsByParameterName(match, names)

            If nameMatches Is Nothing Then
                Throw New MissingMemberException
            End If
            Dim potentialMatches() As MethodBase = FilterMethods(nameMatches, args, names)

            If potentialMatches Is Nothing Then
                'FIXME more elegant care of different failure cases
                If match.Length = 1 Then
                    If Not names Is Nothing Then
                        Dim parameters As ParameterInfo() = match(0).GetParameters()
                        If IsParamArray(parameters, parameters.Length - 1) Then
                            If Array.IndexOf(names, parameters(parameters.Length - 1).Name) <> -1 Then
                                Throw New ArgumentException("Named arguments cannot match ParamArray parameters.")
                            End If
                        End If
                    End If
                Else
                    If Not names Is Nothing Then ' there are name matches but not parameter matches
                        Throw New AmbiguousMatchException
                    End If
                End If
                Throw New MissingMemberException
            End If

            For j As Integer = 0 To potentialMatches.Length - 1
                Dim matches(potentialMatches.Length - j) As MethodBase
                Dim matchesCount As Integer = 0
                Dim fj As MethodBase = potentialMatches(j)

                matches(matchesCount) = fj
                matchesCount += 1

                For k As Integer = 0 To potentialMatches.Length - 1
                    If k <> j Then
                        Dim fk As MethodBase = potentialMatches(k)
                        Dim order As SignatureCompare = CompareMethods(fj, fk, args)

                        Select Case order
                            Case SignatureCompare.Ambiguity
                                matches(matchesCount) = fk
                                matchesCount += 1
                            Case SignatureCompare.Left
                                ' fk < fj , continue checking
                            Case SignatureCompare.Right
                                'fk > fj , fj does not match
                                matchesCount = 0
                                Exit For
                                ' Case SignatureCompare.Equal impossible case
                        End Select
                    End If
                Next

                If matchesCount = 1 Then 'fj suits better that any other fk

                    PrepareParameters(args, fj, names, CType(state, BState))
                    CType(state, BState).parameters = fj.GetParameters()
                    Return fj
                ElseIf matchesCount > 1 Then ' there are ambigous fj and fk
                    Throw New AmbiguousMatchException
                End If
            Next

            Return Nothing
        End Function

        Public Overrides Function ChangeType(ByVal value As Object, ByVal type1 As System.Type, _
                                    ByVal culture As System.Globalization.CultureInfo) As Object
            Return ConvertValue(value, type1)
        End Function

        Public Overrides Sub ReorderArgumentArray(ByRef args() As Object, ByVal state As Object)
            Dim bstate As BState = CType(state, BState)
            Dim mapping() As Integer = bstate.mapping
            Dim parameters() As ParameterInfo = bstate.parameters
            Dim clone() As Object = CType(args.Clone(), Object())
            Dim oargs() As Object = bstate.oargs
            Dim cpos As Integer = 0

            If args.Length <> oargs.Length Then
                ReDim args(oargs.Length - 1)
            End If

            For i As Integer = 0 To args.Length - 1
                If IsParamArray(parameters, i) Then
                    If args.Length - 1 >= i Then
                        If oargs(i).GetType().IsArray Then
                            args(i) = clone(cpos) ' param array was passed as array
                        Else
                            Dim arr As Array = CType(clone(cpos), Array)
                            For j As Integer = 0 To arr.Length - 1
                                args(i) = arr.GetValue(j)
                                i += 1
                            Next
                        End If
                    Else
                        'FIXME: impossible case
                    End If
                    Exit For
                Else
                    If mapping Is Nothing Then
                        args(i) = clone(cpos) 'FIXME: is it possible that method was invoked after the mapping failed? 
                    Else
                        Dim reverseMapping As Integer = Array.IndexOf(mapping, i)
                        If reverseMapping > -1 Then
                            If parameters(i).ParameterType.IsByRef Then
                                'ByRef parameters
                                If Not oargs(i) Is Nothing Then
                                    If oargs(i).GetType().IsArray Then
                                        'array that was passed by ref
                                        Dim arr As Array = CType(clone(reverseMapping), Array)
                                        For j As Integer = 0 To arr.Length - 1
                                            CType(oargs(i), Array).SetValue(arr.GetValue(j), j)
                                        Next
                                        args(i) = oargs(i)
                                    ElseIf oargs(i).GetType().IsPrimitive Then
                                        'primitives passed by ref should be updated
                                        args(i) = clone(reverseMapping)
                                    End If
                                End If
                            Else
                                'ByVal parameters
                                args(i) = clone(reverseMapping)
                            End If
                        End If
                    End If
                End If

                If Not IsParamArray(parameters, i) Then
                    cpos += 1
                End If
            Next

        End Sub

        Public Overrides Function SelectMethod(ByVal bindingAttr As System.Reflection.BindingFlags, _
                                                ByVal match() As System.Reflection.MethodBase, _
                                                ByVal types() As System.Type, _
                                                ByVal modifiers() As System.Reflection.ParameterModifier) As System.Reflection.MethodBase
            Throw New NotImplementedException
        End Function
        Public Overrides Function SelectProperty(ByVal bindingAttr As System.Reflection.BindingFlags, _
                                                ByVal match() As System.Reflection.PropertyInfo, _
                                                ByVal returnType As System.Type, _
                                                ByVal indexes() As System.Type, _
                                                ByVal modifiers() As System.Reflection.ParameterModifier) As System.Reflection.PropertyInfo

            Throw New NotImplementedException
        End Function

        Private Function PrepareArguments(ByVal args() As Object, ByVal parameters() As ParameterInfo, ByVal names() As String, ByVal bstate As BState) As Object()
            If parameters.Length = 0 Then 'no parameters
                Return args
            End If

            Dim mapping() As Integer = GetArgumentsMapping(parameters, names, args)

            If Not bstate Is Nothing Then
                bstate.mapping = mapping
            End If

            If mapping Is Nothing Then
                Return Nothing 'name mapping failed
            End If

            Dim preparedArguments() As Object = CType(args.Clone(), Object())

            ' optional parameters case (optional parameters are always at the end)
            If parameters(parameters.Length - 1).IsOptional Then