latebinder.vb

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

                    _invokeNext = newMethod
                    _invokeNextArgs = args
                    _wasIncompleteInvocation = True
                    args = Nothing
                    Return True
                End If
            End If
            Return False
        End Function


        Private Function FilterMethods(ByVal methods() As MethodBase, ByRef args() As Object, ByVal names() As String) As MethodBase()
            Dim filteredMethods(methods.Length) As MethodBase
            Dim methodsCount As Integer = 0
            Dim narrowingAmbiguity As Boolean = False

            Dim previous As TypeConversion
            Dim current As TypeConversion

            For i As Integer = 0 To methods.Length - 1
                Dim parameters() As ParameterInfo = methods(i).GetParameters()

                If i = 0 Then
                    previous = CompareSignature(args, parameters, names)
                    If Not previous = TypeConversion.NotConvertible Then
                        filteredMethods(methodsCount) = methods(i)
                        methodsCount += 1
                        If previous = TypeConversion.Equal Then
                            Exit For
                        End If
                    ElseIf (IsGetterThatReturnObjectWithIndexer(methods(i), args)) Then
                        previous = TypeConversion.Equal
                        filteredMethods(methodsCount) = methods(i)
                        methodsCount += 1
                        Exit For
                    End If

                Else
                    current = CompareSignature(args, parameters, names)

                    Select Case current
                        Case TypeConversion.Equal
                            previous = current
                            ReDim filteredMethods(0)
                            filteredMethods(0) = methods(i)
                            methodsCount = 1
                            Exit For
                        Case TypeConversion.Narrowing
                            If previous = TypeConversion.Narrowing Then
                                narrowingAmbiguity = True
                                'Throw New AmbiguousMatchException 
                                'do no thow since we still can find Equal or Widening
                            End If
                        Case TypeConversion.Widening
                            Select Case previous
                                Case TypeConversion.Equal
                                    ' do nothing
                                Case TypeConversion.Narrowing
                                    previous = TypeConversion.Widening
                                    ' we've already stored method with Narrowing - remove it
                                    ' this call is redundant sine there is only 1 method stored
                                    ' Array.Clear(filteredMethods,0,filteredMethods.Length)
                                    ' zerowing counter is enouph
                                    methodsCount = 0
                                    ' now we can store a current method
                                    filteredMethods(methodsCount) = methods(i)
                                    methodsCount += 1
                                Case TypeConversion.Widening
                                    filteredMethods(methodsCount) = methods(i)
                                    methodsCount += 1
                                Case TypeConversion.NotConvertible
                                    filteredMethods(methodsCount) = methods(i)
                                    methodsCount += 1
                            End Select
                    End Select
                End If
            Next

            If methodsCount = 0 Then
                Return Nothing
            Else
                If previous = TypeConversion.Narrowing And narrowingAmbiguity Then
                    ' thre are more that 1 narrowing methods and this is the best
                    Throw New AmbiguousMatchException
                End If
                ReDim Preserve filteredMethods(methodsCount - 1)
                Return filteredMethods
            End If
        End Function

        Private Function CompareSignature(ByVal args() As Object, ByVal parameters() As ParameterInfo, ByVal names() As String) As TypeConversion
            Dim current As TypeConversion
            Dim previous As TypeConversion = TypeConversion.NotConvertible

            If args.Length = 0 And parameters.Length = 0 Then  ' private case to make the things easy
                Return TypeConversion.Equal
            End If

            'basic parameters check
            If args.Length > parameters.Length And Not IsParamArray(parameters, parameters.Length - 1) Then
                ' args do not suit even parameters count
                Return TypeConversion.NotConvertible
            End If

            If parameters(parameters.Length - 1).IsOptional Then   ' check the args fill at least not optional parameters
                Dim optionalParametersCount As Integer = 0
                For i As Integer = 0 To parameters.Length - 1
                    If parameters(i).IsOptional Then
                        optionalParametersCount += 1
                    End If
                Next
                'if args does not fill non optional prameters
                If args.Length < parameters.Length - optionalParametersCount Then
                    Return TypeConversion.NotConvertible
                End If
            End If

            Dim margs() As Object = PrepareArguments(args, parameters, names, Nothing)

            If margs Is Nothing Then
                Return TypeConversion.NotConvertible 'failed to map parameters
            End If

            'special case of no arguments passed
            If margs.Length = 0 Then
                If IsParamArray(parameters, 0) Then 'method receives only param array, empty param array suits
                    Return TypeConversion.Widening
                Else
                    Return TypeConversion.NotConvertible 'method receives additional parameters
                End If
            End If

            For i As Integer = 0 To margs.Length - 1
                Dim type1 As Type
                Dim type2 As Type = GetParameterType(parameters, i)

                If margs(i) Is Nothing Then
                    current = TypeConversion.Widening
                Else
                    type1 = margs(i).GetType()
                    current = CompareTypes(type1, type2, IsParamArray(parameters, i))
                End If

                If current = TypeConversion.NotConvertible Then
                    Return current
                End If

                If i = 0 Then
                    previous = current
                Else
                    Select Case previous
                        Case TypeConversion.Equal
                            previous = current
                        Case TypeConversion.Narrowing
                            previous = TypeConversion.Narrowing
                        Case TypeConversion.Widening
                            If current = TypeConversion.Narrowing Then
                                previous = TypeConversion.Narrowing
                            End If
                    End Select
                End If
            Next

            ' args suit parameters checked, but there can exist more parameters
            If previous <> TypeConversion.NotConvertible And parameters.Length > margs.Length Then
                If IsParamArray(parameters, margs.Length) Then
                    'only if next (and the last parameter) is param array, its ok
                    If previous = TypeConversion.Equal Then
                        previous = TypeConversion.Widening
                    End If
                Else
                    Return TypeConversion.NotConvertible ' if there are more params, args does not suit
                End If
            End If

            Return previous
        End Function

        Private Function CompareTypes(ByVal type1 As Type, ByVal type2 As Type, ByVal type2isParamArray As Boolean) As TypeConversion
            Dim basicConversion As TypeConversion = CompareTypes(type1, type2)

            If type2isParamArray And basicConversion = TypeConversion.Equal Then
                Return TypeConversion.Widening
            End If

            Return basicConversion
        End Function

        Private Function CompareTypes(ByVal type1 As Type, ByVal type2 As Type) As TypeConversion
            If type1 Is type2 Then
                Return TypeConversion.Equal
            End If

            If type1 Is Nothing Then
                Return TypeConversion.Widening
            ElseIf type2 Is Nothing Then
                Return TypeConversion.NotConvertible
            End If

            Dim typeCode1 As TypeCode = Type.GetTypeCode(type1)
            Dim typeCode2 As TypeCode = Type.GetTypeCode(type2)

            If type1.IsPrimitive And type2.IsEnum Then
                Return TypeConversion.Narrowing
            ElseIf type1.IsEnum And type2.IsPrimitive Then
                Return TypeConversion.Widening
            End If

            If type1.IsPrimitive And type2.IsPrimitive Then

                If typeCode1 = TypeCode.Char Or typeCode2 = TypeCode.Char Then
                    Return TypeConversion.Narrowing
                End If

                If typeCode1 = TypeCode.Boolean Or typeCode2 = TypeCode.Boolean Then
                    Return TypeConversion.Narrowing
                End If

                If typeCode1 > TypeCode.Boolean And typeCode1 <= TypeCode.Decimal And _
                    typeCode2 > TypeCode.Boolean And typeCode2 <= TypeCode.Decimal Then

                    If typeCode1 < typeCode2 Then
                        Return TypeConversion.Widening
                    Else
                        Return TypeConversion.Narrowing
                    End If

                End If
                'FIXME additional cases
            Else
                If type1.IsPrimitive Then
                    ' primitive can be converted to string or object
                    'FIXME: is char to string convert widens or narrows ?
                    If typeCode1 = TypeCode.Char And typeCode2 = TypeCode.String Then
                        Return TypeConversion.Widening
                    End If

                    If typeCode2 = TypeCode.String Then
                        Return TypeConversion.Narrowing
                    ElseIf type2 Is GetType(Object) Then
                        Return TypeConversion.Widening
                    Else
                        Return TypeConversion.NotConvertible
                    End If
                End If

                If type2.IsPrimitive Then
                    ' string can be converted to primitive
                    If typeCode1 = TypeCode.String Then
                        Return TypeConversion.Narrowing
                    End If

                    'FIXME: is this should be valid for IConvertible only?
                    Return TypeConversion.Narrowing
                End If

                ' objects can be converted to strings
                If typeCode2 = TypeCode.String Then
                    If type1.IsArray Then
                        Return TypeConversion.NotConvertible
                    Else
                        Return TypeConversion.Narrowing
                    End If
                End If

                If type1.IsSubclassOf(type2) Then
                    Return TypeConversion.Widening
                ElseIf type2.IsSubclassOf(type1) Then
                    Return TypeConversion.Narrowing
                End If
            End If

            Return TypeConversion.NotConvertible
        End Function

    End Class
End Namespace