helper.vb

来自「大名鼎鼎的mono是.NET平台的跨平台（支持linux」· VB 代码 · 共 1,554 行 · 第 1/5 页

' 
' 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
' 

#If DEBUG Then
#Const DEBUGMETHODRESOLUTION = 0
#Const DEBUGMETHODADD = 0
#Const EXTENDEDDEBUG = 0
#End If
''' <summary>
''' A module of useful global functions.
''' </summary>
''' <remarks></remarks>
Public Class Helper
    Private m_Compiler As Compiler
    Private Shared m_SharedCompilers As New Generic.List(Of Compiler)

    Public Shared LOGMETHODRESOLUTION As Boolean = False

    Public Const ALLMEMBERS As BindingFlags = BindingFlags.FlattenHierarchy Or BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or BindingFlags.Static

    Public Const ALLNOBASEMEMBERS As BindingFlags = BindingFlags.DeclaredOnly Or BindingFlags.Public Or BindingFlags.NonPublic Or BindingFlags.Instance Or BindingFlags.Static

#If DEBUGREFLECTION Then
    Private Shared object_ids As New ArrayList()
    Private Shared object_nameshash As New Generic.Dictionary(Of String, Object)
    Private Shared object_names As New Generic.List(Of String)

    Private Shared m_DebugReflection As System.Text.StringBuilder
    Private Shared m_DebugReflectionFinalized As Boolean

    Shared ReadOnly Property DebugReflectionOutput() As System.Text.StringBuilder
        Get
            If m_DebugReflection Is Nothing Then
                m_DebugReflection = New System.Text.StringBuilder()
                DebugReflection_Init()
            End If

            Return m_DebugReflection
        End Get
    End Property

    Shared Function DebugReflection_Dump(ByVal Compiler As Compiler) As String
        DebugReflection_Finalize(Compiler)
        Return m_DebugReflection.ToString
    End Function

    Shared Sub DebugReflection_Init()
        m_DebugReflection.AppendLine("Imports System")
        m_DebugReflection.AppendLine("Imports System.Reflection")
        m_DebugReflection.AppendLine("Imports System.Reflection.Emit")
        m_DebugReflection.AppendLine("Class DebugReflection")
        m_DebugReflection.AppendLine("    Shared Sub Main ()")
    End Sub

    Shared Sub DebugReflection_Finalize(ByVal Compiler As Compiler)
        If m_DebugReflectionFinalized Then Return

        m_DebugReflection.AppendLine(String.Format("        {0}.Save(""{1}"")", GetObjectName(Compiler.AssemblyBuilder), IO.Path.GetFileName(Compiler.OutFileName)))
        m_DebugReflection.AppendLine("    End Sub")
        m_DebugReflection.AppendLine("End Class")

        m_DebugReflectionFinalized = True
    End Sub

    Shared Function DebugReflection_BuildArray(Of T)(ByVal Array As T()) As T()
        Dim arr() As T
        ReDim arr(Array.Length - 1)
        System.Array.Copy(Array, arr, Array.Length)
        For i As Integer = 0 To Array.Length - 1
            Helper.DebugReflection_AppendLine("{0}({1}) = {2}", arr, i, arr(i))
        Next
        Return arr
    End Function

    Shared Sub DebugReflection_AppendLine(ByVal Line As String, ByVal ParamArray objects() As Object)
        Dim strs() As String

        If objects.Length > 0 Then
            ReDim strs(objects.Length - 1)
            For i As Integer = 0 To objects.Length - 1
                strs(i) = GetObjectName(objects(i))
            Next
            Select Case strs.Length
                Case 1
                    Line = String.Format(Line, strs(0))
                Case 2
                    Line = String.Format(Line, strs(0), strs(1))
                Case 3
                    Line = String.Format(Line, strs(0), strs(1), strs(2))
                Case 4
                    Line = String.Format(Line, strs(0), strs(1), strs(2), strs(3))
                Case 5
                    Line = String.Format(Line, strs(0), strs(1), strs(2), strs(3), strs(4))
                Case Else
                    Line = String.Format(Line, strs)
            End Select
        End If
        DebugReflectionOutput.AppendLine("        " & Line)
    End Sub

    Shared Function GetObjectName(ByVal obj As Object) As String
        If obj Is Nothing Then Return "Nothing"
        If TypeOf obj Is String Then Return CStr(obj)
        If TypeOf obj Is EmitLog Then obj = DirectCast(obj, EmitLog).TheRealILGenerator

        For i As Integer = 0 To object_ids.Count - 1
            If object_ids(i) Is obj Then Return object_names(i)
        Next

        Dim type As Type = obj.GetType
        Dim name As String
        Dim typename As String

        If type.FullName = "System.Reflection.Emit.TypeBuilderInstantiation" Then type = type.BaseType
        If type.FullName = "System.RuntimeType" Then type = type.BaseType
        If type.FullName = "System.Reflection.MonoGenericClass" Then type = type.BaseType
        If type.FullName = "System.MonoType" Then type = type.BaseType

        Dim counter As Integer = 1
        For i As Integer = 0 To object_ids.Count - 1
            If object_ids(i).GetType Is type Then counter += 1 : Continue For
            If type.IsArray AndAlso object_ids(i).GetType Is type.GetElementType Then counter += 1 : Continue For
        Next
        If type.IsArray Then
            name = type.GetElementType.Name & "Array_" & counter
            typename = type.GetElementType.FullName & "()"
        Else
            name = obj.GetType.Name & "_" & counter
            typename = type.FullName
        End If

        Helper.DebugReflection_AppendLine("Dim " & name & " As " & typename)

        object_ids.Add(obj)
        object_names.Add(name)
        object_nameshash.Add(name, obj)

        Return name
    End Function
#End If

#If DEBUG Then
    Shared Function ShowDebugFor(ByVal name As String) As Boolean
        Static args As Hashtable
        If args Is Nothing Then
            args = New Hashtable(StringComparer.OrdinalIgnoreCase)
            Dim env As String = Environment.GetEnvironmentVariable("VBNC_LOG")
            If env Is Nothing Then Return False
            For Each arg As String In env.Split(","c, ":"c, ";"c)
                args.Add(arg, arg)
            Next
        End If
        Return args.ContainsKey(name)
    End Function
#End If

    '#If DEBUG Then
    '    Shared Sub RunRT()
    '        Dim path As String = "rt\bin\rt.exe"
    '        Dim parent As String = VB.CurDir
    '        Do Until parent.Length <= 3
    '            Dim filename As String = IO.Path.Combine(parent, path)
    '            If IO.File.Exists(filename) Then
    '                Diagnostics.Process.Start(filename)
    '                Return
    '            End If

    '            parent = IO.Path.GetDirectoryName(parent)
    '        Loop
    '        System.Windows.Forms.MessageBox.Show("rt.exe not found.")
    '    End Sub
    '#End If

    Shared Function FilterCustomAttributes(ByVal attributeType As Type, ByVal Inherit As Boolean, ByVal i As IAttributableDeclaration) As Object()
        Dim result As New Generic.List(Of Object)

        Helper.Assert(i IsNot Nothing)

        Dim attribs() As Attribute = i.CustomAttributes.ToArray
        For Each a As Attribute In attribs
            If attributeType Is Nothing OrElse attributeType.IsAssignableFrom(a.AttributeType) Then
                result.Add(a.AttributeInstance)
            End If
        Next

        Dim tD As TypeDescriptor
        If Inherit Then
            Dim base As Type
            Dim baseDecl As TypeDescriptor

            tD = TryCast(i, TypeDescriptor)

            If tD IsNot Nothing Then
                base = DirectCast(i, TypeDescriptor).BaseType
                baseDecl = TryCast(base, TypeDescriptor)

                If baseDecl IsNot Nothing Then
                    result.AddRange(FilterCustomAttributes(attributeType, Inherit, baseDecl.Declaration))
                ElseIf base IsNot Nothing Then
                    result.AddRange(base.GetCustomAttributes(attributeType, Inherit))
                End If
            End If
        End If

        Return result.ToArray
    End Function

    Shared Function IsOnMS() As Boolean
        Return Not IsOnMono()
    End Function

    Shared Function IsOnMono() As Boolean
        Dim t As Type = GetType(Integer)

        If t.GetType().ToString = "System.MonoType" Then
            Return True
        Else
            Return False
        End If
    End Function

    Shared Function VerifyValueClassification(ByRef Expression As Expression, ByVal Info As ResolveInfo) As Boolean
        Dim result As Boolean = True
        If Expression.Classification.IsValueClassification Then
            result = True
        ElseIf Expression.Classification.CanBeValueClassification Then
            Expression = Expression.ReclassifyToValueExpression
            result = Expression.ResolveExpression(Info) AndAlso result
        Else
            Helper.AddError()
            result = False
        End If
        Return result
    End Function

    Shared Function IsReflectionType(ByVal Type As Type) As Boolean
        Dim typesTypename As String = Type.GetType.Name
        Dim result As Boolean

        result = typesTypename = "TypeBuilder" OrElse typesTypename = "TypeBuilderInstantiation" OrElse typesTypename = "SymbolType"

#If DEBUG Then
        Helper.Assert(result = (Type.GetType.Namespace = "System.Reflection.Emit"), Type.GetType.FullName)
#End If

        Return result
    End Function

    Shared Function IsReflectionMember(ByVal Member As MemberInfo) As Boolean
        Dim result As Boolean
        If TypeOf Member Is MethodDescriptor Then Return False
        If TypeOf Member Is FieldDescriptor Then Return False
        If TypeOf Member Is ConstructorDescriptor Then Return False
        If TypeOf Member Is EventDescriptor Then Return False
        If TypeOf Member Is TypeDescriptor Then Return False
        If TypeOf Member Is PropertyDescriptor Then Return False

        If Member.DeclaringType IsNot Nothing Then
            result = IsReflectionType(Member.DeclaringType)
        ElseIf Member.MemberType = MemberTypes.TypeInfo OrElse Member.MemberType = MemberTypes.NestedType Then
            result = IsReflectionType(DirectCast(Member, Type))
        Else
            Helper.NotImplemented()
        End If
        Return result
    End Function

    Shared Function IsReflectionMember(ByVal Members() As MemberInfo) As Boolean
        If Members Is Nothing Then Return True
        If Members.Length = 0 Then Return True

        For Each m As MemberInfo In Members
            If IsReflectionMember(m) = False Then Return False
        Next
        Return True
    End Function

    Shared Function IsEmittableMember(ByVal Member As MemberInfo) As Boolean
        Dim result As Boolean

        If Member Is Nothing Then Return True
        result = Member.GetType.Namespace.StartsWith("System")

        Return result
    End Function

    Shared Function IsEmittableMember(ByVal Members() As MemberInfo) As Boolean
        If Members Is Nothing Then Return True
        If Members.Length = 0 Then Return True

        For Each m As MemberInfo In Members
            If IsEmittableMember(m) = False Then Return False
        Next
        Return True
    End Function