parser.vb

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

        If BuiltInTypeName.IsBuiltInTypeName(tm) Then
            Dim m_BuiltInTypeName As BuiltInTypeName
            m_BuiltInTypeName = ParseBuiltinTypeName(result)
            If m_BuiltInTypeName Is Nothing Then Helper.ErrorRecoveryNotImplemented()

            result.Init(m_BuiltInTypeName)
        Else
            Dim m_QualifiedIdentifier As QualifiedIdentifier

            If QualifiedIdentifier.CanBeQualifiedIdentifier(tm) = False Then
                Return Nothing
            End If

            m_QualifiedIdentifier = ParseQualifiedIdentifier(result)
            If m_QualifiedIdentifier Is Nothing Then Helper.ErrorRecoveryNotImplemented()

            result.Init(m_QualifiedIdentifier)
        End If

        Return result
    End Function

    Private Shared Function ParseQualifiedIdentifier(ByVal Parent As ParsedObject, ByVal str As String) As QualifiedIdentifier
        Dim result As New QualifiedIdentifier(Parent)

        Dim m_First As ParsedObject
        Dim m_Second As Token = Nothing

        Dim first As String
        Dim second As String = Nothing
        Dim isplit As Integer = str.LastIndexOf("."c)

        If isplit >= 0 Then
            first = str.Substring(0, isplit)
            second = str.Substring(isplit + 1)
        Else
            first = str
        End If

        If first.Contains("."c) Then
            m_First = ParseQualifiedIdentifier(result, first)
            If m_First Is Nothing Then Helper.ErrorRecoveryNotImplemented()
        ElseIf first.Length > 7 AndAlso NameResolution.CompareName(first.Substring(1, 7), "Global.") Then
            m_First = New GlobalExpression(result)
        Else
            Dim i As Token = Token.CreateIdentifierToken(Parent.Location, first, TypeCharacters.Characters.None, False)
            m_First = New Identifier(result, i)
        End If

        If second IsNot Nothing Then
            m_Second = Token.CreateIdentifierToken(Span.CommandLineSpan, second, TypeCharacters.Characters.None, False)
        End If

        result.Init(m_First, m_Second)

        Return result
    End Function

    ''' <summary>
    ''' QualifiedIdentifier ::= Identifier | "Global" "." IdentifierOrKeyword | QualifiedIdentifier "." IdentifierOrKeyword
    ''' 
    ''' Call if CurrentToken is identifier or "Global".
    ''' </summary>
    ''' <remarks></remarks>
    Private Function ParseQualifiedIdentifier(ByVal Parent As ParsedObject) As QualifiedIdentifier
        Dim result As New QualifiedIdentifier(Parent)

        Helper.Assert(vbnc.QualifiedIdentifier.CanBeQualifiedIdentifier(tm))

        Dim m_First As ParsedObject
        Dim m_Second As Token = Nothing

        If tm.CurrentToken.IsIdentifier Then
            m_First = ParseIdentifier(result)
        ElseIf tm.CurrentToken.Equals(KS.Global) Then
            m_First = ParseGlobalExpression(result)
            If tm.CurrentToken <> KS.Dot Then Return Nothing
        Else
            Throw New InternalException(result)
        End If

        While tm.Accept(KS.Dot)
            If Token.IsSomething(m_Second) Then m_First = New QualifiedIdentifier(Parent, m_First, m_Second)
            If tm.CurrentToken.IsIdentifierOrKeyword Then
                m_Second = tm.CurrentToken
                tm.NextToken()
            Else
                Compiler.Report.ShowMessage(Messages.VBNC30203)
                Return Nothing
            End If
        End While

        result.Init(m_First, m_Second)

        Return result
    End Function

    Private Function ParseIdentifier(ByVal Parent As ParsedObject) As Identifier
        Dim result As Identifier

        If tm.CurrentToken.IsIdentifier Then
            result = New Identifier(Parent, tm.CurrentToken)
            tm.NextToken()
        Else
            result = Nothing
        End If

        Return result
    End Function

    Private Function ParseBuiltinTypeName(ByVal Parent As ParsedObject) As BuiltInTypeName
        Dim m_Typename As KS

        If vbnc.BuiltInTypeName.IsBuiltInTypeName(tm) = False Then Throw New InternalException(Parent)

        m_Typename = tm.CurrentToken.Keyword
        tm.NextToken()

        Return New BuiltInTypeName(Parent, m_Typename)
    End Function

    Private Function ParseModifiers(ByVal Parent As ParsedObject, ByVal ValidModifiers As ModifierMasks) As Modifiers
        Dim result As New Modifiers()

        While tm.CurrentToken.Equals(ValidModifiers)
            result.AddModifier(tm.CurrentToken.Keyword)
            tm.NextToken()
        End While

        Return result
    End Function

    ''' <summary>
    ''' Parses type members for interfaces.
    ''' Never returns nothing.
    ''' </summary>
    ''' <param name="Parent"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ParseInterfaceMembers(ByVal Parent As InterfaceDeclaration) As MemberDeclarations
        Dim result As New MemberDeclarations(Parent)

        Dim newMembers As New Generic.List(Of IMember)
        While True
            Dim attributes As Attributes
            attributes = New Attributes(Parent)
            If vbnc.Attributes.IsMe(tm) Then
                If ParseAttributes(Parent, attributes) = False Then Helper.ErrorRecoveryNotImplemented()
            End If

            Dim newType As TypeDeclaration
            newType = ParseTypeDeclaration(Parent, attributes, Parent.Namespace)
            If newType IsNot Nothing Then
                result.Add(newType)
                Continue While
            End If

            Dim newMember As IMember
            'InterfaceDeclarations
            If InterfaceEventMemberDeclaration.IsMe(tm) Then
                newMember = ParseInterfaceEventMemberDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
            ElseIf InterfaceFunctionDeclaration.IsMe(tm) Then
                newMember = ParseInterfaceFunctionDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
            ElseIf InterfaceSubDeclaration.IsMe(tm) Then
                newMember = ParseInterfaceSubDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
            ElseIf InterfacePropertyMemberDeclaration.IsMe(tm) Then
                newMember = ParseInterfacePropertyMemberDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
            Else
                If attributes.Count > 0 Then Helper.AddError("Hanging attributes.")
                Exit While
            End If

            If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()

            result.Add(newMember)
        End While

        Return result
    End Function

    Private Function ParseTypeMembers(ByVal Parent As TypeDeclaration) As MemberDeclarations
        Dim result As New MemberDeclarations(Parent)
        If ParseTypeMembers(Parent, result) = False Then
            Helper.ErrorRecoveryNotImplemented()
        End If
        Return result
    End Function

    ''' <summary>
    ''' Parses type members for classes, modules and structures.
    ''' Never returns nothing.
    ''' </summary>
    ''' <param name="Parent"></param>
    ''' <remarks></remarks>
    Private Function ParseTypeMembers(ByVal Parent As TypeDeclaration, ByVal Members As MemberDeclarations) As Boolean
        Dim result As Boolean = True
        Dim isModuleDeclaration As Boolean = TypeOf Parent Is ModuleDeclaration

        Helper.Assert(TypeOf Parent Is ClassDeclaration OrElse isModuleDeclaration OrElse TypeOf Parent Is StructureDeclaration)

        Dim newMembers As New Generic.List(Of IMember)
        While True
            Dim attributes As Attributes
            attributes = New Attributes(Parent)
            If vbnc.Attributes.IsMe(tm) Then
                If ParseAttributes(Parent, attributes) = False Then Helper.ErrorRecoveryNotImplemented()
            End If

            Dim newType As TypeDeclaration
            newType = ParseTypeDeclaration(Parent, attributes, Parent.Namespace)
            If newType IsNot Nothing Then
                Members.Add(newType)
                Continue While
            End If

            Dim newMember As IMember

            'Class and Structure declarations
            If isModuleDeclaration = False AndAlso OperatorDeclaration.IsMe(tm) Then
                newMember = ParseOperatorDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf isModuleDeclaration = False AndAlso ConversionOperatorDeclaration.IsMe(tm) Then
                newMember = ParseConversionOperatorDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                'Class, Structure and Module declarations
            ElseIf RegularEventDeclaration.IsMe(tm) Then
                newMember = ParseRegularEventDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf CustomEventDeclaration.IsMe(tm) Then
                newMember = ParseCustomEventMemberDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf VariableDeclaration.IsMe(tm) Then
                Dim tmp As Generic.List(Of VariableDeclaration)
                tmp = ParseVariableMemberDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If tmp Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                For Each item As VariableDeclaration In tmp
                    newMembers.Add(item)
                Next
                newMember = Nothing
            ElseIf ConstantDeclaration.IsMe(tm) Then
                Dim tmp As Generic.List(Of ConstantDeclaration)
                tmp = ParseConstantMemberDeclarations(Parent, New ParseAttributableInfo(Compiler, attributes))
                If tmp Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                For Each item As ConstantDeclaration In tmp
                    newMembers.Add(item)
                Next
                newMember = Nothing
            ElseIf ExternalSubDeclaration.IsMe(tm) Then
                newMember = ParseExternalSubDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf ExternalFunctionDeclaration.IsMe(tm) Then
                newMember = ParseExternalFunctionDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf SubDeclaration.IsMe(tm) Then
                newMember = ParseSubDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf FunctionDeclaration.IsMe(tm) Then
                newMember = ParseFunctionDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf RegularPropertyDeclaration.IsMe(tm) Then
                newMember = ParseRegularPropertyMemberDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf MustOverridePropertyDeclaration.IsMe(tm) Then
                newMember = ParseMustOverridePropertyMemberDeclaration(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            ElseIf ConstructorDeclaration.IsMe(tm) Then
                newMember = ParseConstructorMember(Parent, New ParseAttributableInfo(Compiler, attributes))
                If newMember Is Nothing Then Helper.ErrorRecoveryNotImplemented()
            Else
                If attributes.Count > 0 Then Helper.AddError("Hanging attributes.")
                Exit While
            End If

            If newMember IsNot Nothing Then newMembers.Add(newMember)
            If newMembers.Count = 0 Then Helper.ErrorRecoveryNotImplemented()
            Members.AddRange(newMembers)
            newMembers.Clear()
        End While

        Return result
    End Function

    ''' <summary>
    ''' Parses a type declaration. Returns nothing if no type declaration was found.
    ''' Parses only one typedeclaration.
    ''' Type declaration = Class, Module, Structure, Enum, Delegate, Interface declaration.
    ''' </summary>
    ''' <param name="Parent"></param>
    ''' <param name="Namespace"></param>
    ''' <returns></returns>
    ''' <remarks></remarks>
    Private Function ParseTypeDeclaration(ByVal Parent As ParsedObject, ByVal Attributes As Attributes, ByVal [Namespace] As String) As TypeDeclaration
        Dim result As TypeDeclaration
        If ClassDeclaration.IsMe(tm) Then
            result = ParseClassDeclaration(Parent, Attributes, [Namespace])
        ElseIf EnumDeclaration.IsMe(tm) Then
            result = ParseEnumDeclaration(Parent, Attributes, [Namespace])
        ElseIf StructureDeclaration.IsMe(tm) Then
            result = ParseStructureDeclaration(Parent, Attributes, [Namespace])
        ElseIf InterfaceDeclaration.IsMe(tm) Then
            result = ParseInterfaceDeclaration(Parent, Attributes, [Namespace])
        ElseIf DelegateDeclaration.IsMe(tm) Then
            result = ParseDelegateDeclaration(Parent, Attributes, [Namespace])
        ElseIf ModuleDeclaration.IsMe(tm) Then
            result = ParseModuleDeclaration(Parent, Attributes, [Namespace])
        Else
            result = Nothing
        End If
        Return result
    End Function

    Private Sub ParseAssemblyMembers(ByVal Parent As AssemblyDeclaration, ByVal RootNamespace As String, ByVal result As MemberDeclarations)

        Dim currentNameSpace As String = RootNamespace
        Dim currentNamespaces As New Generic.List(Of QualifiedIdentifier)

        Helper.Assert(result IsNot Nothing)

        While True
            Dim attributes As Attributes
            attributes = New Attributes(Parent)
            If vbnc.Attributes.IsMe(tm) Then
                If ParseAttributes(Parent, attributes) = False Then Helper.ErrorRecoveryNotImplemented()
                If tm.AcceptEndOfStatement Then
                    Parent.Attributes.AddRange(attributes)
                    Continue While
                End If
            End If

            Dim newType As TypeDeclaration
            newType = ParseTypeDeclaration(Parent, attributes, currentNameSpace)
            If newType IsNot Nothing Then
                result.Add(newType)
            ElseIf tm.Accept(KS.Namespace) Then
                Dim qi As QualifiedIdentifier
                qi = ParseQualifiedIdentifier(Parent)
                If qi Is Nothing Then Helper.ErrorRecoveryNotImplemented()
                currentNamespaces.Add(qi)
                currentNameSpace = RootNamespace
                If currentNamespaces.Count > 0 Then
                    If currentNameSpace <> "" Then currentNameSpace &= "."
                    For i As Integer = 0 To currentNamespaces.Count - 2
                        currentNameSpace &= currentNamespaces(i).Name & "."
                    Next
                    currentNameSpace &= currentNamespaces(currentNamespaces.Count - 1).Name
                End If
                If tm.AcceptNewLine(True, True, True) = False Then Helper.ErrorRecoveryNotImplemented()
            ElseIf tm.Accept(KS.End_Namespace) Then
                If tm.AcceptNewLine(True, False, True) = False Then Helper.ErrorRecoveryNotImplemented()
                If currentNamespaces.Count >= 1 Then
                    currentNamespaces.RemoveAt(currentNamespaces.Count - 1)
                    currentNameSpace = RootNamespace
                    If currentNamespaces.Count > 0 Then
                        If currentNameSpace <> "" Then currentNameSpace &= "."
                        For i As Integer = 0 To currentNamespaces.Count - 2
                            currentNameSpace &= currentNamespaces(i).Name & "."
                        Next
                        currentNameSpace &= currentNamespaces(currentNamespaces.Count - 1).Name
                    End If
                Else
                    Helper.AddError("'End Namespace' without 'Namespace'.")
                End If
            Else
                If attributes.Count > 0 Then Helper.AddError("Hanging attributes.")
                Exit While
            End If
        End While
    End Sub


End Class