' Licensed to the .NET Foundation under one or more agreements.
' The .NET Foundation licenses this file to you under the MIT license.
' See the LICENSE file in the project root for more information.

Imports System.Collections.Immutable
Imports Microsoft.CodeAnalysis.CodeGen
Imports Microsoft.CodeAnalysis.Emit
Imports Microsoft.CodeAnalysis.Symbols
Imports Microsoft.CodeAnalysis.VisualBasic.Emit

Namespace Microsoft.CodeAnalysis.VisualBasic.Symbols

    Partial Friend Class VisualBasicAttributeData
        Implements Cci.ICustomAttribute

        Private Function GetArguments1(context As EmitContext) As ImmutableArray(Of Cci.IMetadataExpression) Implements Cci.ICustomAttribute.GetArguments
            Return CommonConstructorArguments.SelectAsArray(Function(arg) CreateMetadataExpression(arg, context))
        End Function

        Private Function Constructor1(context As EmitContext, reportDiagnostics As Boolean) As Cci.IMethodReference Implements Cci.ICustomAttribute.Constructor
            If Me.AttributeConstructor.IsDefaultValueTypeConstructor() Then
                ' Parameter constructors for structs exist in symbol table, but are not emitted.
                ' Produce an error since we cannot use it (instead of crashing):
                ' Details: https://github.com/dotnet/roslyn/issues/19394

                If reportDiagnostics Then
                    context.Diagnostics.Add(ERRID.ERR_AttributeMustBeClassNotStruct1, If(context.Location, NoLocation.Singleton), Me.AttributeClass)
                End If

                Return Nothing
            End If

            Dim moduleBeingBuilt As PEModuleBuilder = DirectCast(context.Module, PEModuleBuilder)
            Return moduleBeingBuilt.Translate(AttributeConstructor, needDeclaration:=False,
                                              syntaxNodeOpt:=DirectCast(context.SyntaxNode, VisualBasicSyntaxNode), diagnostics:=context.Diagnostics)
        End Function

        Private Function GetNamedArguments1(context As EmitContext) As ImmutableArray(Of Cci.IMetadataNamedArgument) Implements Cci.ICustomAttribute.GetNamedArguments
            Return CommonNamedArguments.SelectAsArray(Function(namedArgument) CreateMetadataNamedArgument(namedArgument.Key, namedArgument.Value, context))
        End Function

        Private ReadOnly Property ArgumentCount As Integer Implements Cci.ICustomAttribute.ArgumentCount
            Get
                Return CommonConstructorArguments.Length
            End Get
        End Property

        Private ReadOnly Property NamedArgumentCount As UShort Implements Cci.ICustomAttribute.NamedArgumentCount
            Get
                Return CType(CommonNamedArguments.Length, UShort)
            End Get
        End Property

        Private Function GetType1(context As EmitContext) As Cci.ITypeReference Implements Cci.ICustomAttribute.GetType
            Dim moduleBeingBuilt As PEModuleBuilder = DirectCast(context.Module, PEModuleBuilder)
            Return moduleBeingBuilt.Translate(AttributeClass, syntaxNodeOpt:=DirectCast(context.SyntaxNode, VisualBasicSyntaxNode), diagnostics:=context.Diagnostics)
        End Function

        Private ReadOnly Property AllowMultiple1 As Boolean Implements Cci.ICustomAttribute.AllowMultiple
            Get
                Return Me.AttributeClass.GetAttributeUsageInfo().AllowMultiple
            End Get
        End Property

        Private Function CreateMetadataExpression(argument As TypedConstant, context As EmitContext) As Cci.IMetadataExpression
            If argument.IsNull Then
                Return CreateMetadataConstant(argument.TypeInternal, Nothing, context)
            End If

            Select Case argument.Kind
                Case TypedConstantKind.Array
                    Return CreateMetadataArray(argument, context)
                Case TypedConstantKind.Type
                    Return CreateType(argument, context)
                Case Else
                    Return CreateMetadataConstant(argument.TypeInternal, argument.ValueInternal, context)
            End Select
        End Function

        Private Function CreateMetadataArray(argument As TypedConstant, context As EmitContext) As MetadataCreateArray
            Debug.Assert(Not argument.Values.IsDefault)

            Dim values = argument.Values
            Dim moduleBeingBuilt = DirectCast(context.Module, PEModuleBuilder)
            Dim arrayType = moduleBeingBuilt.Translate(DirectCast(argument.TypeInternal, ArrayTypeSymbol))

            If values.Length = 0 Then
                Return New MetadataCreateArray(arrayType,
                                               arrayType.GetElementType(context),
                                               ImmutableArray(Of Cci.IMetadataExpression).Empty)
            End If

            Dim metadataExprs = New Cci.IMetadataExpression(values.Length - 1) {}
            For i = 0 To values.Length - 1
                metadataExprs(i) = CreateMetadataExpression(values(i), context)
            Next

            Return New MetadataCreateArray(arrayType,
                                           arrayType.GetElementType(context),
                                           metadataExprs.AsImmutableOrNull)
        End Function

        Private Function CreateType(argument As TypedConstant, context As EmitContext) As MetadataTypeOf
            Debug.Assert(argument.ValueInternal IsNot Nothing)

            Dim moduleBeingBuilt = DirectCast(context.Module, PEModuleBuilder)
            Dim syntaxNodeOpt = DirectCast(context.SyntaxNode, VisualBasicSyntaxNode)
            Dim diagnostics = context.Diagnostics
            Return New MetadataTypeOf(moduleBeingBuilt.Translate(DirectCast(argument.ValueInternal, TypeSymbol), syntaxNodeOpt, diagnostics),
                                      moduleBeingBuilt.Translate(DirectCast(argument.TypeInternal, TypeSymbol), syntaxNodeOpt, diagnostics))
        End Function

        Private Function CreateMetadataConstant(type As ITypeSymbolInternal, value As Object, context As EmitContext) As MetadataConstant
            Dim moduleBeingBuilt = DirectCast(context.Module, PEModuleBuilder)
            Return moduleBeingBuilt.CreateConstant(DirectCast(type, TypeSymbol), value, syntaxNodeOpt:=DirectCast(context.SyntaxNode, VisualBasicSyntaxNode), diagnostics:=context.Diagnostics)
        End Function

        Private Function CreateMetadataNamedArgument(name As String, argument As TypedConstant, context As EmitContext) As Cci.IMetadataNamedArgument
            Dim sym = LookupName(name)
            Dim value = CreateMetadataExpression(argument, context)
            Dim type As TypeSymbol
            Dim fieldSymbol = TryCast(sym, FieldSymbol)
            If fieldSymbol IsNot Nothing Then
                type = fieldSymbol.Type
            Else
                type = DirectCast(sym, PropertySymbol).Type
            End If

            Dim moduleBeingBuilt = DirectCast(context.Module, PEModuleBuilder)
            Return New MetadataNamedArgument(sym, moduleBeingBuilt.Translate(type, syntaxNodeOpt:=DirectCast(context.SyntaxNode, VisualBasicSyntaxNode), diagnostics:=context.Diagnostics), value)
        End Function

        Private Function LookupName(name As String) As Symbol
            Dim type = AttributeClass
            Do
                For Each member In type.GetMembers(name)
                    If member.DeclaredAccessibility = Accessibility.Public Then
                        Return member
                    End If
                Next

                type = type.BaseTypeNoUseSiteDiagnostics
            Loop While type IsNot Nothing

            Debug.Assert(False, "Name does not match an attribute field or a property.  How can that be?")
            Return ErrorTypeSymbol.UnknownResultType
        End Function
    End Class
End Namespace