parser.vb

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

' 
' 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 EXTENDEDDEBUG = 0
#End If

Partial Public Class Parser
    Private tm As tm
    Private m_Compiler As Compiler

    Private m_ShowErrors As Boolean = True

    Private ReadOnly Property ShowErrors() As Boolean
        Get
            Return m_ShowErrors
        End Get
    End Property

    Public ReadOnly Property Compiler() As Compiler
        Get
            Return m_Compiler
        End Get
    End Property

    Public Sub New(ByVal Compiler As Compiler)
        m_Compiler = Compiler
        tm = m_Compiler.tm
        Helper.Assert(tm IsNot Nothing)
    End Sub

    Public Sub New(ByVal Compiler As Compiler, ByVal TokenReader As ITokenReader)
        m_Compiler = Compiler
        tm = New tm(Compiler, TokenReader)
        tm.NextToken()
        Helper.Assert(tm IsNot Nothing)
    End Sub

    Public Function Parse(ByVal RootNamespace As String) As AssemblyDeclaration
        Dim result As AssemblyDeclaration

        result = ParseAssemblyDeclaration(RootNamespace)
        If result Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        Return result
    End Function

    ''' <summary>
    ''' Can be called multiple times. (Will just exit).
    ''' </summary>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ParseFileHeader(ByVal CodeFile As CodeFile, ByVal [Assembly] As AssemblyDeclaration) As Boolean
        Dim result As Boolean = True

        Dim m_OptionExplicit As OptionExplicitStatement = CodeFile.OptionExplicit
        Dim m_OptionStrict As OptionStrictStatement = CodeFile.OptionStrict
        Dim m_OptionCompare As OptionCompareStatement = CodeFile.OptionCompare
        Dim m_Imports As ImportsClauses = CodeFile.Imports

        While tm.CurrentToken.Equals(KS.Option)
            If OptionExplicitStatement.IsMe(tm) Then
                If m_OptionExplicit IsNot Nothing Then
                    Helper.NotImplemented() 'AddError
                End If
                m_OptionExplicit = ParseOptionExplicitStatement(CodeFile)
                If m_OptionExplicit Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf OptionStrictStatement.IsMe(tm) Then
                If m_OptionStrict IsNot Nothing Then
                    Helper.NotImplemented() 'AddError
                End If
                m_OptionStrict = ParseOptionStrictStatement(CodeFile)
                If m_OptionStrict Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf OptionCompareStatement.IsMe(tm) Then
                If m_OptionCompare IsNot Nothing Then
                    Helper.NotImplemented() 'AddError
                End If
                m_OptionCompare = ParseOptionCompareStatement(CodeFile)
                If m_OptionCompare Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            Else
                Helper.NotImplemented()
            End If
        End While

        If m_Imports Is Nothing Then m_Imports = New ImportsClauses([Assembly])
        Dim tmpImportsStatements As Generic.List(Of ImportsStatement)
        tmpImportsStatements = ParseImportsStatements([Assembly])
        For Each imp As ImportsStatement In tmpImportsStatements
            m_Imports.AddRange(imp.Clauses)
        Next

        CodeFile.Init(m_OptionCompare, m_OptionStrict, m_OptionExplicit, m_Imports)

        Return result
    End Function
    ''' <summary>
    ''' OptionCompareStatement  ::=  "Option" "Compare" CompareOption  StatementTerminator
    ''' CompareOption  ::=  "Binary" | "Text"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseOptionCompareStatement(ByVal Parent As IBaseObject) As OptionCompareStatement
        Dim result As New OptionCompareStatement(Parent)

        Dim m_IsBinary As Boolean

        tm.AcceptIfNotInternalError(KS.Option)
        tm.AcceptIfNotInternalError("Compare")

        If tm.Accept("Text") Then
            m_IsBinary = False
        ElseIf tm.Accept("Binary") Then
            m_IsBinary = True
        Else
            Helper.NotImplemented() 'AddError
        End If

        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_IsBinary)

        Return result
    End Function

    ''' <summary>
    ''' OptionStrictStatement  ::=  "Option" "Strict" [  OnOff  ]  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseOptionStrictStatement(ByVal Parent As IBaseObject) As OptionStrictStatement
        Dim result As New OptionStrictStatement(Parent)

        Dim m_Off As Boolean

        tm.AcceptIfNotInternalError(KS.Option)
        tm.AcceptIfNotInternalError("Strict")

        If tm.Accept(KS.On) Then
            m_Off = False
        ElseIf tm.Accept("Off") Then
            Compiler.Report.ShowMessage(Messages.VBNC99999, tm.PeekToken(-1).Location, "Option Strict Off will probably fail.")
            m_Off = True
        End If

        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Off)

        Return result
    End Function

    ''' <summary>
    ''' OptionExplicitStatement  ::=  Option  Explicit  [  OnOff  ]  StatementTerminator
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseOptionExplicitStatement(ByVal Parent As IBaseObject) As OptionExplicitStatement
        Dim result As New OptionExplicitStatement(Parent)

        Dim m_Off As Boolean
        tm.AcceptIfNotInternalError(KS.Option)
        tm.AcceptIfNotInternalError("Explicit")

        If tm.Accept(KS.On) Then
            m_Off = False
        ElseIf tm.Accept("Off") Then
            m_Off = True
        End If

        If tm.AcceptEndOfStatement(, True) = False Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Off)
        Return result
    End Function

    ''' <summary>
    ''' ImportsClauses  ::= ImportsClause  | ImportsClauses  ","  ImportsClause
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseImportsClauses(ByVal Parent As ImportsStatement) As ImportsClauses
        Dim result As New ImportsClauses(Parent)

        If ParseList(Of ImportsClause)(result, New ParseDelegate_Parent(Of ImportsClause)(AddressOf ParseImportsClause), result) = False Then
            Helper.ErrorRecoveryNotImplemented()
        End If

        Return result
    End Function

    ''' <summary>
    ''' Parses clauses seen on the command line.
    ''' ImportsClauses  ::= ImportsClause  | ImportsClauses  ","  ImportsClause
    ''' </summary>
    ''' <param name="str"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Shared Function ParseImportsClauses(ByVal Parent As ImportsClauses, ByVal str As String) As Boolean
        Dim result As Boolean = True

        For Each clause As String In str.Split(","c)
            If clause <> "" Then
                Dim newClause As ImportsClause
                newClause = ParseImportsClause(Parent, str)
                If newClause Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                If Parent.Exists(newClause) Then
                    If newClause.IsNamespaceClause Then '
                        'ignore the duplication
                    ElseIf newClause.IsAliasClause Then
                        Parent.Compiler.Report.SaveMessage(Messages.VBNC30572, newClause.AsAliasClause.Name)
                    Else
                        Throw New InternalException("")
                    End If
                Else
                    Parent.Add(newClause)
                End If
            End If
        Next

        Return result
    End Function

    ''' <summary>
    ''' ImportsClause  ::=  ImportsAliasClause  |  ImportsNamespaceClause
    ''' </summary>
    ''' <remarks></remarks>
    Private Shared Function ParseImportsClause(ByVal Parent As ParsedObject, ByVal str As String) As ImportsClause
        Dim result As New ImportsClause(Parent)

        If ImportsAliasClause.IsMe(str) Then
            Dim m_Clause As ImportsAliasClause
            m_Clause = ParseImportsAliasClause(Parent, str)
            If m_Clause Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            result.Init(m_Clause)
        Else
            Dim m_Clause As ImportsNamespaceClause
            m_Clause = ParseImportsNamespaceClause(Parent, str)
            If m_Clause Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            result.Init(m_Clause)
        End If

        Return result
    End Function

    ''' <summary>
    ''' ImportsClause  ::=  ImportsAliasClause  |  ImportsNamespaceClause
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseImportsClause(ByVal Parent As ParsedObject) As ImportsClause
        Dim result As New ImportsClause(Parent)

        If ImportsAliasClause.IsMe(tm) Then
            Dim m_Clause As ImportsAliasClause
            m_Clause = ParseImportsAliasClause(result)
            If m_Clause Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            result.Init(m_Clause)
        Else
            Dim m_Clause As ImportsNamespaceClause
            m_Clause = ParseImportsNamespaceClause(result)
            If m_Clause Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            result.Init(m_Clause)
        End If

        Return result
    End Function

    ''' <summary>
    ''' ImportsAliasClause  ::=
    '''	Identifier  =  QualifiedIdentifier  |
    '''	Identifier  =  ConstructedTypeName
    ''' 
    ''' ConstructedTypeName  ::=
    '''	QualifiedIdentifier  "("  "Of"  TypeArgumentList  ")"
    ''' 
    ''' This overload is used when parsing commandline imports.
    ''' </summary>
    ''' <param name="str"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Shared Function ParseImportsAliasClause(ByVal Parent As ParsedObject, ByVal str As String) As ImportsAliasClause
        Dim result As New ImportsAliasClause(Parent)

        Dim m_Identifier As Token = Nothing
        Dim m_Second As ImportsNamespaceClause = Nothing

        Dim values() As String = str.Split("="c)
        If values.Length <> 2 Then Return Nothing

        m_Identifier = Token.CreateIdentifierToken(Span.CommandLineSpan, values(0), TypeCharacters.Characters.None, False)

        m_Second = ParseImportsNamespaceClause(result, values(1))
        If m_Second Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Identifier, m_Second)

        Return result
    End Function

    ''' <summary>
    ''' ImportsAliasClause  ::=
    '''	Identifier  =  QualifiedIdentifier  |
    '''	Identifier  =  ConstructedTypeName
    ''' 
    ''' ConstructedTypeName  ::=
    '''	QualifiedIdentifier  "("  "Of"  TypeArgumentList  ")"
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseImportsAliasClause(ByVal Parent As ParsedObject) As ImportsAliasClause
        Dim result As New ImportsAliasClause(Parent)

        Dim m_Identifier As Token = Nothing
        Dim m_Second As ImportsNamespaceClause = Nothing

        If tm.AcceptIdentifier(m_Identifier) = False Then Helper.ErrorRecoveryNotImplemented()

        tm.AcceptIfNotInternalError(KS.Equals)

        m_Second = ParseImportsNamespaceClause(result)
        If m_Second Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(m_Identifier, m_Second)

        Return result
    End Function

    ''' <summary>
    ''' ImportsNamespaceClause  ::=	QualifiedIdentifier  |	ConstructedTypeName
    ''' 
    ''' ConstructedTypeName  ::=
    '''	QualifiedIdentifier  "("  "Of"  TypeArgumentList  ")"
    '''    
    ''' Only namespaces, classes, structures, enumerated types, and standard modules may be imported.
    ''' This overload is used when parsing commandline imports.
    ''' </summary>
    ''' <remarks></remarks>
    Private Shared Function ParseImportsNamespaceClause(ByVal Parent As ParsedObject, ByVal str As String) As ImportsNamespaceClause
        Dim result As New ImportsNamespaceClause(Parent)

        Dim qi As QualifiedIdentifier = Nothing
        qi = ParseQualifiedIdentifier(result, str)
        If qi Is Nothing Then Helper.ErrorRecoveryNotImplemented()

        result.Init(qi)

        Return result
    End Function

    ''' <summary>
    ''' ImportsNamespaceClause  ::=	QualifiedIdentifier  |	ConstructedTypeName
    ''' 
    ''' ConstructedTypeName  ::=
    '''	QualifiedIdentifier  "("  "Of"  TypeArgumentList  ")"
    '''    
    ''' Only namespaces, classes, structures, enumerated types, and standard modules may be imported.
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseImportsNamespaceClause(ByVal Parent As ParsedObject) As ImportsNamespaceClause
        Dim result As New ImportsNamespaceClause(Parent)

        Dim iCurrent As RestorablePoint = tm.GetRestorablePoint
        Dim qi As QualifiedIdentifier

        qi = ParseQualifiedIdentifier(result)