Add CustomAttribute implementation and open up API slightly for Falanx usage.

src/ProvidedTypes.fs

@@ -274,6 +274,90 @@ namespace ProviderImplementation.ProvidedTypes
 
         let canBindNestedType (bindingFlags: BindingFlags) (c: Type) =
              hasFlag bindingFlags BindingFlags.Public && c.IsNestedPublic || hasFlag bindingFlags BindingFlags.NonPublic && not c.IsNestedPublic
+
+        open System.Collections.ObjectModel
+        open System.Runtime.CompilerServices
+
+        [<Extension>]
+        type AttributeExtensions =
+
+            [<Extension>]
+            static member CreateAttribute(data: CustomAttributeData) : Attribute =
+
+                let arguments = data.ConstructorArguments.GetConstructorValues() |> Seq.toArray
+                let attribute = data.Constructor.Invoke(arguments) :?> Attribute
+
+                match data.NamedArguments with
+                | null -> attribute
+                | namedArguments -> 
+                    for namedArgument in namedArguments do
+                        let propertyInfo = namedArgument.MemberInfo :?> PropertyInfo
+                        let value = namedArgument.TypedValue.GetArgumentValue()
+
+                        if not (isNull propertyInfo)
+                        then propertyInfo.SetValue(attribute, value, null)
+                        else
+                            let fieldInfo = namedArgument.MemberInfo :?> FieldInfo
+                            if not (isNull fieldInfo) then
+                                fieldInfo.SetValue(attribute, value)
+
+                    attribute
+
+            [<Extension>]
+            static member GetCustomAttributesCopy(typ: Type) : IEnumerable<Attribute> =
+                CustomAttributeData.GetCustomAttributes(typ).CreateAttributes()
+
+            [<Extension>]
+            static member GetCustomAttributesCopy(assembly: Assembly) : IEnumerable<Attribute> =
+                CustomAttributeData.GetCustomAttributes(assembly).CreateAttributes();
+
+            [<Extension>]
+            static member GetCustomAttributesCopy(memberInfo: MemberInfo) : IEnumerable<Attribute> =
+                CustomAttributeData.GetCustomAttributes(memberInfo).CreateAttributes()
+
+            [<Extension>]
+            static member CreateAttributes(attributesData: IEnumerable<CustomAttributeData>) : IEnumerable<Attribute> =
+                seq {for attributeData in attributesData do
+                        yield attributeData.CreateAttribute() }
+
+            [<Extension>]
+            static member GetConstructorValues(arguments: IEnumerable<CustomAttributeTypedArgument>) : IEnumerable<obj> =
+                seq {for argument in arguments do
+                        yield argument.GetArgumentValue() }
+
+            [<Extension>]
+            static member GetArgumentValue(argument: CustomAttributeTypedArgument) : obj =
+
+                let value =
+                    if (argument.ArgumentType.IsEnum)
+                    then
+                        let argumentType =
+
+                            match argument.ArgumentType with
+                            | :? TypeDelegator as td ->
+                                let fullAssyName = td.Assembly.FullName
+                                let fullTypeName = td.FullName
+                                let t = Type.GetType(fullTypeName + "," + fullAssyName, true, true)
+                                t
+                            | other -> other
+
+                        Enum.ToObject(argumentType, argument.Value)
+                    else argument.Value
+
+                match value with
+                | :? ReadOnlyCollection<CustomAttributeTypedArgument> as collectionValue ->
+                    box <| AttributeExtensions.ConvertCustomAttributeTypedArgumentArray(collectionValue, argument.ArgumentType.GetElementType())
+                | _ -> value
+
+
+            static member ConvertCustomAttributeTypedArgumentArray(arguments: IEnumerable<CustomAttributeTypedArgument>, elementType: Type) : Array =
+                let valueArray =
+                    arguments
+                    |> Seq.map(fun x -> x.Value)
+                    |> Seq.toArray
+                let newArray = Array.CreateInstance(elementType, valueArray.Length)
+                Array.Copy(valueArray, newArray, newArray.Length)
+                newArray
 
         // We only want to return source types "typeof<Void>" values as _target_ types in one very specific location due to a limitation in the
         // F# compiler code for multi-targeting.
@@ -370,6 +454,8 @@ namespace ProviderImplementation.ProvidedTypes
         assert (ifThenElseOp |> isNull |> not)
         let newUnionCaseOp = qTy.GetMethod("NewNewUnionCaseOp", bindAll)
         assert (newUnionCaseOp |> isNull |> not)
+        let newRecordOp = qTy.GetMethod("NewNewRecordOp", bindAll)
+        assert (newRecordOp |> isNull |> not)
 
         type Microsoft.FSharp.Quotations.Expr with
 
@@ -459,6 +545,10 @@ namespace ProviderImplementation.ProvidedTypes
                 let op = newUnionCaseOp.Invoke(null, [| box uci |])
                 mkFEN.Invoke(null, [| box op; box args |]) :?> Expr
 
+            static member NewRecordUnchecked (ty:Type, args:Expr list) = 
+                let op = newRecordOp.Invoke(null, [| box ty |])
+                mkFEN.Invoke(null, [| box op; box args |]) :?> Expr
+
         type Shape = Shape of (Expr list -> Expr)
 
         let (|ShapeCombinationUnchecked|ShapeVarUnchecked|ShapeLambdaUnchecked|) e =
@@ -1151,8 +1241,19 @@ namespace ProviderImplementation.ProvidedTypes
         override __.MemberType: MemberTypes = MemberTypes.Property
 
         override this.ReflectedType = notRequired this "ReflectedType" propertyName
-        override __.GetCustomAttributes(_inherit) = emptyAttributes
-        override __.GetCustomAttributes(attributeType, _inherit) = Attributes.CreateEmpty attributeType
+        override __.GetCustomAttributes(_inherit) =
+            let attribs =
+                customAttributesImpl.GetCustomAttributesData()
+                |> Seq.map (fun attrib -> attrib.CreateAttribute())
+                |> Seq.toArray
+            attribs |> box |> unbox<obj[]>
+        override __.GetCustomAttributes(attributeType, _inherit) =
+            let attribs =
+                customAttributesImpl.GetCustomAttributesData()
+                |> Seq.filter (fun attrib -> attrib.AttributeType.FullName = attributeType.FullName)
+                |> Seq.map (fun attrib -> attrib.CreateAttribute())
+                |> Seq.toArray
+            attribs |> box |> unbox<obj[]>
         override this.IsDefined(_attributeType, _inherit) = notRequired this "IsDefined" propertyName
 
     and ProvidedEvent(isTgt: bool, eventName:string, attrs: EventAttributes, eventHandlerType:Type, isStatic: bool, adder: (unit -> MethodInfo), remover: (unit -> MethodInfo), customAttributesData) =

src/ProvidedTypes.fsi

@@ -129,37 +129,6 @@ namespace ProviderImplementation.ProvidedTypes
         member internal GetInvokeCode: (Expr list -> Expr) option
 
 
-    /// Represents an erased provided property.
-    [<Class>]
-    type ProvidedProperty =
-        inherit PropertyInfo
-
-        /// Create a new provided property. It is not initially associated with any specific provided type definition.
-        new: propertyName: string * propertyType: Type * ?getterCode: (Expr list -> Expr) * ?setterCode: (Expr list -> Expr) * ?isStatic: bool * ?indexParameters: ProvidedParameter list -> ProvidedProperty
-
-        /// Add a 'Obsolete' attribute to this provided property
-        member AddObsoleteAttribute: message: string * ?isError: bool -> unit
-
-        /// Add XML documentation information to this provided constructor
-        member AddXmlDoc: xmlDoc: string -> unit
-
-        /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary
-        member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit
-
-        /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary
-        /// The documentation is re-computed  every time it is required.
-        member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit
-
-        /// Get or set a flag indicating if the property is static.
-        member IsStatic: bool
-
-        /// Add definition location information to the provided type definition.
-        member AddDefinitionLocation: line:int * column:int * filePath:string -> unit
-
-        /// Add a custom attribute to the provided property definition.
-        member AddCustomAttribute: CustomAttributeData -> unit
-
-
     /// Represents an erased provided property.
     [<Class>]
     type ProvidedEvent =
@@ -267,11 +236,61 @@ namespace ProviderImplementation.ProvidedTypes
         /// Returns a type where the type has been annotated with the given types and/or units-of-measure.
         /// e.g. float<kg>, Vector<int, kg>
         static member AnnotateType: basic: Type * argument: Type list -> Type
+
+    /// Represents an erased provided property.
+    type [<Class>] ProvidedProperty =
+        inherit PropertyInfo
+
+        /// Create a new provided property. It is not initially associated with any specific provided type definition.
+        new: propertyName: string * propertyType: Type * ?getterCode: (Expr list -> Expr) * ?setterCode: (Expr list -> Expr) * ?isStatic: bool * ?indexParameters: ProvidedParameter list -> ProvidedProperty
+
+        /// Add a 'Obsolete' attribute to this provided property
+        member AddObsoleteAttribute: message: string * ?isError: bool -> unit
 
+        /// Add XML documentation information to this provided constructor
+        member AddXmlDoc: xmlDoc: string -> unit
+
+        /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary
+        member AddXmlDocDelayed: xmlDocFunction: (unit -> string) -> unit
 
+        /// Add XML documentation information to this provided constructor, where the computation of the documentation is delayed until necessary
+        /// The documentation is re-computed  every time it is required.
+        member AddXmlDocComputed: xmlDocFunction: (unit -> string) -> unit
+
+        /// Get or set a flag indicating if the property is static.
+        member IsStatic: bool
+
+        /// Add definition location information to the provided type definition.
+        member AddDefinitionLocation: line:int * column:int * filePath:string -> unit
+
+        /// Add a custom attribute to the provided property definition.
+        member AddCustomAttribute: CustomAttributeData -> unit
+
+        override GetAccessors : _nonPublic:bool -> System.Reflection.MethodInfo []
+        override GetCustomAttributes : _inherit:bool -> obj []
+        override GetCustomAttributes : attributeType:System.Type * _inherit:bool -> obj []
+        override GetCustomAttributesData : unit -> System.Collections.Generic.IList<System.Reflection.CustomAttributeData>
+        override GetGetMethod : _nonPublic:bool -> System.Reflection.MethodInfo
+        override GetIndexParameters : unit -> System.Reflection.ParameterInfo []
+        override GetSetMethod : _nonPublic:bool -> System.Reflection.MethodInfo
+        override GetValue : _obj:obj * _invokeAttr:System.Reflection.BindingFlags * _binder:System.Reflection.Binder * _index:obj [] * _culture:System.Globalization.CultureInfo -> obj
+        override IsDefined : _attributeType:System.Type * _inherit:bool -> bool
+        override SetValue : _obj:obj * _value:obj * _invokeAttr:System.Reflection.BindingFlags * _binder:System.Reflection.Binder * _index:obj [] * _culture:System.Globalization.CultureInfo -> unit
+        override Attributes : System.Reflection.PropertyAttributes
+        override CanRead : bool
+        override CanWrite : bool
+        override DeclaringType : System.Type
+        override MemberType : System.Reflection.MemberTypes
+        override Name : string
+        override PropertyType : System.Type
+        override ReflectedType : System.Type
+
+        member internal Getter : (unit -> System.Reflection.MethodInfo) option
+
+        member PatchDeclaringType : x:ProvidedTypeDefinition -> unit
+
     /// Represents a provided type definition.
-    [<Class>]
-    type ProvidedTypeDefinition =
+    and [<Class>] ProvidedTypeDefinition =
         inherit TypeDelegator
 
         /// When making a cross-targeting type provider, use this method instead of the corresponding ProvidedTypeDefinition constructor from ProvidedTypes
@@ -358,6 +377,9 @@ namespace ProviderImplementation.ProvidedTypes
         /// Add a custom attribute to the provided type definition.
         member AddCustomAttribute: CustomAttributeData -> unit
 
+        /// Returns an array of members that have been overidden along with the ProvidedMethods defining them.
+        member internal GetMethodOverrides : unit -> (ProvidedMethod * System.Reflection.MethodInfo) []
+
         /// Emulate the F# type provider type erasure mechanism to get the
         /// actual (erased) type. We erase ProvidedTypes to their base type
         /// and we erase array of provided type to array of base type. In the
@@ -368,6 +390,8 @@ namespace ProviderImplementation.ProvidedTypes
         /// Get or set a utility function to log the creation of root Provided Type. Used to debug caching/invalidation.
         static member Logger: (string -> unit) option ref
 
+        /// Provides a way of setting the Declaring type which is normally done via AddMember/s.
+        member PatchDeclaringType : x:ProvidedTypeDefinition -> unit
 
 #if !NO_GENERATIVE
     /// A provided generated assembly
@@ -527,7 +551,7 @@ namespace ProviderImplementation.ProvidedTypes
         interface ITypeProvider
 
 
-    module internal UncheckedQuotations =
+    module UncheckedQuotations =
 
       type Expr with
         static member NewDelegateUnchecked: ty:Type * vs:Var list * body:Expr -> Expr
@@ -546,6 +570,9 @@ namespace ProviderImplementation.ProvidedTypes
         static member FieldSetUnchecked: obj:Expr * pinfo:FieldInfo * value:Expr -> Expr
         static member TupleGetUnchecked: e:Expr * n:int -> Expr
         static member LetUnchecked: v:Var * e:Expr * body:Expr -> Expr
+        static member IfThenElseUnchecked : e:Expr * t:Expr * f:Expr -> Expr
+        static member NewUnionCaseUnchecked : uci:Reflection.UnionCaseInfo * args:Expr list -> Expr
+        static member NewRecordUnchecked : ty:Type * args:Expr list -> Expr
 
       type Shape
       val ( |ShapeCombinationUnchecked|ShapeVarUnchecked|ShapeLambdaUnchecked| ): e:Expr -> Choice<(Shape * Expr list),Var, (Var * Expr)>

tests/BasicGenerativeProvisionTests.fs

@@ -19,6 +19,13 @@ open Xunit
 
 #nowarn "760" // IDisposable needs new
 
+type CustomAttributeData with
+    static member Make(ctorInfo, ?args, ?namedArgs) = 
+        { new CustomAttributeData() with 
+            member __.Constructor =  ctorInfo
+            member __.ConstructorArguments = defaultArg args [||] :> Collections.Generic.IList<_>
+            member __.NamedArguments = defaultArg namedArgs [||] :> Collections.Generic.IList<_> }
+
 [<TypeProvider>]
 type GenerativePropertyProviderWithStaticParams (config : TypeProviderConfig) as this =
     inherit TypeProviderForNamespaces (config)
@@ -117,6 +124,13 @@ type GenerativePropertyProviderWithStaticParams (config : TypeProviderConfig) as
 
         let myProp = ProvidedProperty("MyStaticProperty", typeof<string list>, isStatic = true, getterCode = testCode)
         let myProp2 = ProvidedProperty("MyInstaceProperty", typeof<string list>, isStatic = false, getterCode = testCode, setterCode = setterCode)
+
+        //Add a CompilationMappingAttribute to a property to test ProvidedProperty custom attributes
+        let compilationMappingCtor = typeof<CompilationMappingAttribute>.GetConstructor([|typeof<SourceConstructFlags>; typeof<int> |])
+        let arguments = [| CustomAttributeTypedArgument (typeof<SourceConstructFlags>, SourceConstructFlags.Field)
+                           CustomAttributeTypedArgument (typeof<int>, 0) |]
+        myProp2.AddCustomAttribute(CustomAttributeData.Make(compilationMappingCtor, args = arguments))
+
         let myMeth1 = ProvidedMethod("MyStaticMethod", [], typeof<string list>, isStatic = true, invokeCode = testCode)
         let myMeth2 = ProvidedMethod("MyInstanceMethod", [], typeof<string list>, isStatic = false, invokeCode = testCode)
         let myEvent1 = ProvidedEvent("MyEvent", typeof<System.EventHandler>, isStatic = false, adderCode = adderCode, removerCode = removerCode)
@@ -232,6 +246,10 @@ let ``GenerativePropertyProviderWithStaticParams attributes are read correctly``
             let attrib = firstMethod.GetCustomAttributes<CompiledNameAttribute>()
             Assert.NotNull attrib
 
+            let myInstaceProperty = t.GetMembers() |> Array.find (fun m -> m :? ProvidedProperty && m.Name = "MyInstaceProperty" )
+            let myInstacePropertyAttrib = myInstaceProperty.GetCustomAttributes<CompilationMappingAttribute>()
+            Assert.NotNull myInstacePropertyAttrib
+
 [<Fact>]
 let ``GenerativePropertyProviderWithStaticParams reflection on MethodSymbol and ConstructorSymbols do not throw``() : unit  = 
     for (text, desc, supports, refs) in testCases() do