baseobject.vb

来自「大名鼎鼎的mono是.NET平台的跨平台（支持linux」· VB 代码 · 共 332 行

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

''' <summary>
''' Every object that can be put in the parse tree should derive
''' from this class.
''' </summary>
''' <remarks></remarks>
Public MustInherit Class BaseObject
    Implements IBaseObject

    ''' <summary>
    ''' The parent of this object
    ''' </summary>
    ''' <remarks></remarks>
    Private m_Parent As IBaseObject

    ''' <summary>
    ''' The location in the source of this object.
    ''' </summary>
    ''' <remarks></remarks>
    Private m_Location As Span

    Private Shared m_Compiler As Compiler
    ''' <summary>
    ''' The location in the source of this object.
    ''' </summary>
    ''' <value></value>
    ''' <remarks></remarks>
    Friend Property Location() As Span Implements IBaseObject.Location
        Get
            If m_Location.HasFile = False AndAlso m_Location.Column = 0 AndAlso m_Location.Line = 0 AndAlso m_Parent IsNot Nothing Then
                Return m_Parent.Location
            End If
            Return m_Location
        End Get
        Set(ByVal value As Span)
            m_Location = value
        End Set
    End Property

    ReadOnly Property File() As CodeFile
        Get
            Return Location.File(Compiler)
        End Get
    End Property

    Overridable ReadOnly Property FullName() As String Implements IBaseObject.FullName
        Get
            Dim nameable As INameable = TryCast(Me, INameable)
            Helper.Assert(nameable IsNot Nothing)
            Dim nstpparent As IBaseObject = Me.FindFirstParent(Of IType)()
            If TypeOf Me Is TypeParameter Then Return Nothing
            If nstpparent IsNot Nothing Then
                If TypeOf nstpparent Is IType Then
                    Return nstpparent.FullName & "+" & nameable.Name
                Else
                    Return nstpparent.FullName & "." & nameable.Name
                End If
            Else
                Return nameable.Name
            End If
        End Get
    End Property

    Friend Function FindTypeParent() As TypeDeclaration
        Return Me.FindFirstParent(Of TypeDeclaration)()
    End Function

    Friend Function FindMethod() As IBaseObject
        Dim found As IBaseObject
        found = FindFirstParent(Of IMethod)()
        If found Is Nothing Then found = FindFirstParent(Of PropertyDeclaration)()
        Return found
    End Function

    Function FindFirstParent_IType() As IType
        If Parent Is Nothing Then
            Return Nothing
        ElseIf TypeOf Parent Is IType Then
            Return CType(CObj(Parent), IType)
        Else
            Return Parent.FindFirstParent(Of IType)()
        End If
    End Function

    Function FindFirstParent(Of T)() As T
        If Parent Is Nothing Then
            Return Nothing
        ElseIf TypeOf Parent Is T Then
            Return CType(CObj(Parent), T)
        Else
            Return Parent.FindFirstParent(Of T)()
        End If
    End Function

    Function FindFirstParent(Of T1, T2)() As IBaseObject
        If Parent Is Nothing Then
            Return Nothing
        ElseIf TypeOf Parent Is T1 Then
            Return CType(CObj(Parent), IBaseObject)
        ElseIf TypeOf Parent Is T2 Then
            Return CType(CObj(Parent), IBaseObject)
        Else
            Return Parent.FindFirstParent(Of T1, T2)()
        End If
    End Function

    ''' <summary>
    ''' Create a new base object with the specified Parent.
    ''' </summary>
    Protected Sub New(ByVal Parent As IBaseObject)
        m_Parent = Parent
        If m_Parent IsNot Nothing AndAlso tm IsNot Nothing AndAlso tm.IsCurrentTokenValid Then m_Location = tm.CurrentToken.Location
        'If m_Parent IsNot Nothing AndAlso tm IsNot Nothing Then m_Location = tm.CurrentToken.Location
#If DEBUG Then
        Helper.Assert(Parent IsNot Me)
        Helper.Assert(Parent IsNot Nothing OrElse TypeOf Me Is Compiler)
        'Make sure there aren't any circular references.
        Dim tmp As IBaseObject = Parent
        Do While tmp IsNot Nothing
            tmp = tmp.Parent
            Helper.Assert(tmp IsNot Me)
        Loop
#End If
    End Sub

    ''' <summary>
    ''' Create a new base object with the specified Parent.
    ''' </summary>
    Protected Sub New(ByVal Parent As IBaseObject, ByVal Location As Span)
        m_Parent = Parent
        m_Location = Location
#If DEBUG Then
        Helper.Assert(Parent IsNot Me)
        Helper.Assert(Parent IsNot Nothing OrElse TypeOf Me Is Compiler)
        'Make sure there aren't any circular references.
        Dim tmp As IBaseObject = Parent
        Do While tmp IsNot Nothing
            tmp = tmp.Parent
            Helper.Assert(tmp IsNot Me)
        Loop
#End If
    End Sub

    Property Parent() As BaseObject
        Get
            Return DirectCast(Me.pParent, BaseObject)
        End Get
        Set(ByVal value As BaseObject)
            m_Parent = value
        End Set
    End Property

    ''' <summary>
    ''' The parent of this type. Is nothing if this type is an assembly.
    ''' </summary>
    ''' <value></value>
    ''' <remarks></remarks>
    Private Property pParent() As IBaseObject Implements IBaseObject.Parent
        Get
            Dim tmpPTD As PartialTypeDeclaration = TryCast(m_Parent, PartialTypeDeclaration)
            If tmpPTD IsNot Nothing AndAlso tmpPTD.IsPartial AndAlso tmpPTD.IsMainPartialDeclaration = False Then
                Helper.Assert(tmpPTD.MainPartialDeclaration IsNot Nothing)
                m_Parent = tmpPTD.MainPartialDeclaration
                'Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "Parent of " & Me.GetType.ToString & " set to " & CObj(m_Parent).GetType.ToString)
            End If
            Return m_Parent
        End Get
        Set(ByVal value As IBaseObject)
            m_Parent = value
        End Set
    End Property

    ReadOnly Property ParentAsParsedObject() As ParsedObject
        Get
            Return DirectCast(Me.Parent, ParsedObject)
        End Get
    End Property

    ''' <summary>
    ''' Get the current compiling assembly.
    ''' </summary>
    Friend Overridable ReadOnly Property Assembly() As AssemblyDeclaration Implements IBaseObject.Assembly
        Get
            If TypeOf Me Is AssemblyDeclaration Then
                Return DirectCast(Me, AssemblyDeclaration)
            ElseIf TypeOf Me Is Compiler Then
                Return DirectCast(Me, Compiler).theAss
            Else
                Helper.Assert(m_Parent IsNot Nothing)
                Return m_Parent.Assembly
            End If
        End Get
    End Property

    Friend ReadOnly Property Report() As Report
        Get
            Return Compiler.Report
        End Get
    End Property

    ''' <summary>
    ''' Get the compiler compiling right now.
    ''' </summary>
    Overridable ReadOnly Property Compiler() As Compiler Implements IBaseObject.Compiler
        Get
            If m_Compiler IsNot Nothing Then
                Return m_Compiler
            End If

            If TypeOf m_Parent Is Compiler Then
                m_Compiler = DirectCast(m_Parent, Compiler)
            ElseIf TypeOf Me Is Compiler Then
                m_Compiler = DirectCast(Me, vbnc.Compiler)
            Else
                Helper.Assert(m_Parent IsNot Nothing)
                m_Compiler = m_Parent.Compiler
            End If

            Return m_Compiler
        End Get
    End Property

#If DEBUG Then
    ReadOnly Property ParentTree() As String()
        Get
            Dim result As New Generic.List(Of String)

            Dim tmp As BaseObject = Me
            Do Until tmp Is Nothing
                result.Add(tmp.GetType.Name)
                tmp = tmp.Parent
            Loop

            Return result.ToArray
        End Get
    End Property
#End If
    ReadOnly Property ParentLocationTree() As String
        Get
            Dim result As String = ""

            Dim tmp As BaseObject = Me
            Do Until tmp Is Nothing
                'If tmp.HasLocation = False Then
                '    result &= "(" & tmp.GetType.Name & "): (no location)" & VB.vbNewLine
                'Else
                result &= "(" & tmp.GetType.Name & "): " & tmp.Location.ToString(Compiler) & VB.vbNewLine
                'End If
                tmp = tmp.Parent
            Loop

            Return result
        End Get
    End Property

    ''' <summary>
    ''' Get the token manager used for quick token management.
    ''' </summary>
    Friend Overridable ReadOnly Property tm() As tm
        Get
            Helper.Assert(Compiler IsNot Nothing)
            Return Compiler.tm
        End Get
    End Property

    Overridable Function ResolveCode(ByVal Info As ResolveInfo) As Boolean Implements IBaseObject.ResolveCode
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "ResolveInfo ignored for '" & Me.GetType.ToString & "'")
        Helper.NotImplemented("ResolveCode not implemented for type: " & Me.GetType.ToString())
        'Return ResolveCode()
    End Function

    Friend Overridable Function GenerateCode(ByVal Info As EmitInfo) As Boolean Implements IBaseObject.GenerateCode
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "The class " & Me.GetType.ToString & " does not implement GenerateCode()")
        Helper.NotImplemented()
    End Function

    ''' <summary>
    ''' Define = create a builder for the object.
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    <Obsolete("Throws NotImplementedException() - The class you are using does not override this method!")> _
    Overridable Function Define() As Boolean Implements IBaseObject.Define
        Compiler.Report.WriteLine(vbnc.Report.ReportLevels.Debug, "The class " & Me.GetType.ToString & " does not implement Define()")
        Helper.NotImplemented()
    End Function

    '#If DEBUG Then
    'Overridable Sub Dump(ByVal Dumper As IndentedTextWriter) Implements IBaseObject.Dump
    '    Dumper.WriteLine("Dump of " & Me.GetType.ToString & "!")
    'End Sub

    Private m_ObjectID As Integer = NewID()
    Public Shared ObjectIDStop As Integer
    Public Shared NextID As Integer

    ReadOnly Property ObjectID() As Integer Implements IBaseObject.ObjectID
        Get
            Return m_ObjectID
        End Get
    End Property

    Shared Function NewID() As Integer
        NextID += 1
        If ObjectIDStop = NextID Then
            Helper.StopIfDebugging()
        End If

        Return NextID
    End Function
    '#End If
End Class