<commit_before>﻿// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.

// Reflection on F# values. Analyze an object to see if it the representation
// of an F# value.

namespace Microsoft.FSharp.Reflection

open System
open System.Collections.Generic
open System.Reflection
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Primitives.Basics

module internal ReflectionUtils =

    type BindingFlags = System.Reflection.BindingFlags

    let toBindingFlags allowAccessToNonPublicMembers =
        if allowAccessToNonPublicMembers then
            BindingFlags.NonPublic ||| BindingFlags.Public
        else
            BindingFlags.Public

[<AutoOpen>]
module internal Impl =

    let getBindingFlags allowAccess = ReflectionUtils.toBindingFlags (defaultArg allowAccess false)

    let inline checkNonNull argName (v: 'T) =
        match box v with
        | null -> nullArg argName
        | _ -> ()

    let isNamedType(typ: Type) = not (typ.IsArray || typ.IsByRef || typ.IsPointer)

    let equivHeadTypes (ty1: Type) (ty2: Type) =
        isNamedType ty1 &&
        if ty1.IsGenericType then
          ty2.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(ty2.GetGenericTypeDefinition())
        else
          ty1.Equals ty2

    let func = typedefof<(obj -> obj)>

    let isOptionType typ = equivHeadTypes typ (typeof<int option>)
    let isFunctionType typ = equivHeadTypes typ (typeof<(int -> int)>)
    let isListType typ = equivHeadTypes typ (typeof<int list>)

    //-----------------------------------------------------------------
    // GENERAL UTILITIES
    let instanceFieldFlags = BindingFlags.GetField ||| BindingFlags.Instance
    let instancePropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Instance
    let staticPropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Static
    let staticFieldFlags = BindingFlags.GetField ||| BindingFlags.Static
    let staticMethodFlags = BindingFlags.Static
    let getInstancePropertyInfo (typ: Type, propName, bindingFlags) = typ.GetProperty(propName, instancePropertyFlags ||| bindingFlags)
    let getInstancePropertyInfos (typ, names, bindingFlags) = names |> Array.map (fun nm -> getInstancePropertyInfo (typ, nm, bindingFlags))
    let getInstancePropertyReader (typ: Type, propName, bindingFlags) =
        match getInstancePropertyInfo(typ, propName, bindingFlags) with
        | null -> None
        | prop -> Some(fun (obj: obj) -> prop.GetValue (obj, instancePropertyFlags ||| bindingFlags, null, null, null))

    //-----------------------------------------------------------------
    // ATTRIBUTE DECOMPILATION

    let tryFindCompilationMappingAttribute (attrs: obj[]) =
      match attrs with
      | null | [| |] -> None
      | [| res |] -> let a = (res :?> CompilationMappingAttribute) in Some (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber)
      | _ -> invalidOp (SR.GetString (SR.multipleCompilationMappings))

    let findCompilationMappingAttribute (attrs: obj[]) =
      match tryFindCompilationMappingAttribute attrs with
      | None -> failwith "no compilation mapping attribute"
      | Some a -> a

    let cmaName = typeof<CompilationMappingAttribute>.FullName
    let assemblyName = typeof<CompilationMappingAttribute>.Assembly.GetName().Name
    let _ = assert (assemblyName = "FSharp.Core")

    let tryFindCompilationMappingAttributeFromData (attrs: IList<CustomAttributeData>) =
        match attrs with
        | null -> None
        | _ ->
            let mutable res = None
            for a in attrs do
                if a.Constructor.DeclaringType.FullName = cmaName then
                    let args = a.ConstructorArguments
                    let flags =
                         match args.Count  with
                         | 1 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), 0, 0)
                         | 2 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), 0)
                         | 3 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), (let x = args.[2] in x.Value :?> int))
                         | _ -> (enum 0, 0, 0)
                    res <- Some flags
            res

    let findCompilationMappingAttributeFromData attrs =
      match tryFindCompilationMappingAttributeFromData attrs with
      | None -> failwith "no compilation mapping attribute"
      | Some a -> a

    let tryFindCompilationMappingAttributeFromType       (typ: Type)        =
        let assem = typ.Assembly
        if (not (isNull assem)) && assem.ReflectionOnly then
           tryFindCompilationMappingAttributeFromData ( typ.GetCustomAttributesData())
        else
        tryFindCompilationMappingAttribute ( typ.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))

    let tryFindCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
        let assem = info.DeclaringType.Assembly
        if (not (isNull assem)) && assem.ReflectionOnly then
           tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData())
        else
        tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))

    let    findCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
        let assem = info.DeclaringType.Assembly
        if (not (isNull assem)) && assem.ReflectionOnly then
            findCompilationMappingAttributeFromData (info.GetCustomAttributesData())
        else
        findCompilationMappingAttribute (info.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))

    let sequenceNumberOfMember          (x: MemberInfo) = let (_, n, _) = findCompilationMappingAttributeFromMemberInfo x in n
    let variantNumberOfMember           (x: MemberInfo) = let (_, _, vn) = findCompilationMappingAttributeFromMemberInfo x in vn

    let sortFreshArray f arr = Array.sortInPlaceWith f arr; arr

    let isFieldProperty (prop : PropertyInfo) =
        match tryFindCompilationMappingAttributeFromMemberInfo prop with
        | None -> false
        | Some (flags, _n, _vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field

    let tryFindSourceConstructFlagsOfType (typ: Type) =
      match tryFindCompilationMappingAttributeFromType typ with
      | None -> None
      | Some (flags, _n, _vn) -> Some flags

    //-----------------------------------------------------------------
    // UNION DECOMPILATION

    // Get the type where the type definitions are stored
    let getUnionCasesTyp (typ: Type, _bindingFlags) =
#if CASES_IN_NESTED_CLASS
       let casesTyp = typ.GetNestedType("Cases", bindingFlags)
       if casesTyp.IsGenericTypeDefinition then casesTyp.MakeGenericType(typ.GetGenericArguments())
       else casesTyp
#else
       typ
#endif

    let getUnionTypeTagNameMap (typ: Type, bindingFlags) =
        let enumTyp = typ.GetNestedType("Tags", bindingFlags)
        // Unions with a singleton case do not get a Tags type (since there is only one tag), hence enumTyp may be null in this case
        match enumTyp with
        | null ->
            typ.GetMethods(staticMethodFlags ||| bindingFlags)
            |> Array.choose (fun minfo ->
                match tryFindCompilationMappingAttributeFromMemberInfo minfo with
                | None -> None
                | Some (flags, n, _vn) ->
                    if (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.UnionCase then
                        let nm = minfo.Name
                        // chop "get_" or  "New" off the front
                        let nm =
                            if not (isListType typ) && not (isOptionType typ) then
                                if   nm.Length > 4 && nm.[0..3] = "get_" then nm.[4..]
                                elif nm.Length > 3 && nm.[0..2] = "New" then nm.[3..]
                                else nm
                            else nm
                        Some (n, nm)
                    else
                        None)
        | _ ->
            enumTyp.GetFields(staticFieldFlags ||| bindingFlags)
            |> Array.filter (fun (f: FieldInfo) -> f.IsStatic && f.IsLiteral)
            |> sortFreshArray (fun f1 f2 -> compare (f1.GetValue null :?> int) (f2.GetValue null :?> int))
            |> Array.map (fun tagfield -> (tagfield.GetValue null :?> int), tagfield.Name)

    let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) =
        let tagFields = getUnionTypeTagNameMap(typ, bindingFlags)
        let tagField = tagFields |> Array.pick (fun (i, f) -> if i = tag then Some f else None)
        if tagFields.Length = 1 then
            typ
        else
            // special case: two-cased DU annotated with CompilationRepresentation(UseNullAsTrueValue)
            // in this case it will be compiled as one class: return self type for non-nullary case and null for nullary
            let isTwoCasedDU =<commit_msg>Remove string allocation (#9706)<commit_after>﻿// Copyright (c) Microsoft Corporation.  All Rights Reserved.  See License.txt in the project root for license information.

// Reflection on F# values. Analyze an object to see if it the representation
// of an F# value.

namespace Microsoft.FSharp.Reflection

open System
open System.Collections.Generic
open System.Reflection
open Microsoft.FSharp.Core
open Microsoft.FSharp.Core.Operators
open Microsoft.FSharp.Core.LanguagePrimitives.IntrinsicOperators
open Microsoft.FSharp.Collections
open Microsoft.FSharp.Primitives.Basics

module internal ReflectionUtils =

    type BindingFlags = System.Reflection.BindingFlags

    let toBindingFlags allowAccessToNonPublicMembers =
        if allowAccessToNonPublicMembers then
            BindingFlags.NonPublic ||| BindingFlags.Public
        else
            BindingFlags.Public

[<AutoOpen>]
module internal Impl =

    let getBindingFlags allowAccess = ReflectionUtils.toBindingFlags (defaultArg allowAccess false)

    let inline checkNonNull argName (v: 'T) =
        match box v with
        | null -> nullArg argName
        | _ -> ()

    let isNamedType(typ: Type) = not (typ.IsArray || typ.IsByRef || typ.IsPointer)

    let equivHeadTypes (ty1: Type) (ty2: Type) =
        isNamedType ty1 &&
        if ty1.IsGenericType then
          ty2.IsGenericType && (ty1.GetGenericTypeDefinition()).Equals(ty2.GetGenericTypeDefinition())
        else
          ty1.Equals ty2

    let func = typedefof<(obj -> obj)>

    let isOptionType typ = equivHeadTypes typ (typeof<int option>)
    let isFunctionType typ = equivHeadTypes typ (typeof<(int -> int)>)
    let isListType typ = equivHeadTypes typ (typeof<int list>)

    //-----------------------------------------------------------------
    // GENERAL UTILITIES
    let instanceFieldFlags = BindingFlags.GetField ||| BindingFlags.Instance
    let instancePropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Instance
    let staticPropertyFlags = BindingFlags.GetProperty ||| BindingFlags.Static
    let staticFieldFlags = BindingFlags.GetField ||| BindingFlags.Static
    let staticMethodFlags = BindingFlags.Static
    let getInstancePropertyInfo (typ: Type, propName, bindingFlags) = typ.GetProperty(propName, instancePropertyFlags ||| bindingFlags)
    let getInstancePropertyInfos (typ, names, bindingFlags) = names |> Array.map (fun nm -> getInstancePropertyInfo (typ, nm, bindingFlags))
    let getInstancePropertyReader (typ: Type, propName, bindingFlags) =
        match getInstancePropertyInfo(typ, propName, bindingFlags) with
        | null -> None
        | prop -> Some(fun (obj: obj) -> prop.GetValue (obj, instancePropertyFlags ||| bindingFlags, null, null, null))

    //-----------------------------------------------------------------
    // ATTRIBUTE DECOMPILATION

    let tryFindCompilationMappingAttribute (attrs: obj[]) =
      match attrs with
      | null | [| |] -> None
      | [| res |] -> let a = (res :?> CompilationMappingAttribute) in Some (a.SourceConstructFlags, a.SequenceNumber, a.VariantNumber)
      | _ -> invalidOp (SR.GetString (SR.multipleCompilationMappings))

    let findCompilationMappingAttribute (attrs: obj[]) =
      match tryFindCompilationMappingAttribute attrs with
      | None -> failwith "no compilation mapping attribute"
      | Some a -> a

    let cmaName = typeof<CompilationMappingAttribute>.FullName
    let assemblyName = typeof<CompilationMappingAttribute>.Assembly.GetName().Name
    let _ = assert (assemblyName = "FSharp.Core")

    let tryFindCompilationMappingAttributeFromData (attrs: IList<CustomAttributeData>) =
        match attrs with
        | null -> None
        | _ ->
            let mutable res = None
            for a in attrs do
                if a.Constructor.DeclaringType.FullName = cmaName then
                    let args = a.ConstructorArguments
                    let flags =
                         match args.Count  with
                         | 1 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), 0, 0)
                         | 2 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), 0)
                         | 3 -> ((let x = args.[0] in x.Value :?> SourceConstructFlags), (let x = args.[1] in x.Value :?> int), (let x = args.[2] in x.Value :?> int))
                         | _ -> (enum 0, 0, 0)
                    res <- Some flags
            res

    let findCompilationMappingAttributeFromData attrs =
      match tryFindCompilationMappingAttributeFromData attrs with
      | None -> failwith "no compilation mapping attribute"
      | Some a -> a

    let tryFindCompilationMappingAttributeFromType       (typ: Type)        =
        let assem = typ.Assembly
        if (not (isNull assem)) && assem.ReflectionOnly then
           tryFindCompilationMappingAttributeFromData ( typ.GetCustomAttributesData())
        else
        tryFindCompilationMappingAttribute ( typ.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))

    let tryFindCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
        let assem = info.DeclaringType.Assembly
        if (not (isNull assem)) && assem.ReflectionOnly then
           tryFindCompilationMappingAttributeFromData (info.GetCustomAttributesData())
        else
        tryFindCompilationMappingAttribute (info.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))

    let    findCompilationMappingAttributeFromMemberInfo (info: MemberInfo) =
        let assem = info.DeclaringType.Assembly
        if (not (isNull assem)) && assem.ReflectionOnly then
            findCompilationMappingAttributeFromData (info.GetCustomAttributesData())
        else
        findCompilationMappingAttribute (info.GetCustomAttributes (typeof<CompilationMappingAttribute>, false))

    let sequenceNumberOfMember          (x: MemberInfo) = let (_, n, _) = findCompilationMappingAttributeFromMemberInfo x in n
    let variantNumberOfMember           (x: MemberInfo) = let (_, _, vn) = findCompilationMappingAttributeFromMemberInfo x in vn

    let sortFreshArray f arr = Array.sortInPlaceWith f arr; arr

    let isFieldProperty (prop : PropertyInfo) =
        match tryFindCompilationMappingAttributeFromMemberInfo prop with
        | None -> false
        | Some (flags, _n, _vn) -> (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.Field

    let tryFindSourceConstructFlagsOfType (typ: Type) =
      match tryFindCompilationMappingAttributeFromType typ with
      | None -> None
      | Some (flags, _n, _vn) -> Some flags

    //-----------------------------------------------------------------
    // UNION DECOMPILATION

    // Get the type where the type definitions are stored
    let getUnionCasesTyp (typ: Type, _bindingFlags) =
#if CASES_IN_NESTED_CLASS
       let casesTyp = typ.GetNestedType("Cases", bindingFlags)
       if casesTyp.IsGenericTypeDefinition then casesTyp.MakeGenericType(typ.GetGenericArguments())
       else casesTyp
#else
       typ
#endif

    let getUnionTypeTagNameMap (typ: Type, bindingFlags) =
        let enumTyp = typ.GetNestedType("Tags", bindingFlags)
        // Unions with a singleton case do not get a Tags type (since there is only one tag), hence enumTyp may be null in this case
        match enumTyp with
        | null ->
            typ.GetMethods(staticMethodFlags ||| bindingFlags)
            |> Array.choose (fun minfo ->
                match tryFindCompilationMappingAttributeFromMemberInfo minfo with
                | None -> None
                | Some (flags, n, _vn) ->
                    if (flags &&& SourceConstructFlags.KindMask) = SourceConstructFlags.UnionCase then
                        let nm = minfo.Name
                        // chop "get_" or  "New" off the front
                        let nm =
                            if not (isListType typ) && not (isOptionType typ) && nm.Length > 3 then
                                if   nm.StartsWith ("get_", StringComparison.Ordinal) then nm.[4..]
                                elif nm.StartsWith ("New", StringComparison.Ordinal) then nm.[3..]
                                else nm
                            else nm
                        Some (n, nm)
                    else
                        None)
        | _ ->
            enumTyp.GetFields(staticFieldFlags ||| bindingFlags)
            |> Array.filter (fun (f: FieldInfo) -> f.IsStatic && f.IsLiteral)
            |> sortFreshArray (fun f1 f2 -> compare (f1.GetValue null :?> int) (f2.GetValue null :?> int))
            |> Array.map (fun tagfield -> (tagfield.GetValue null :?> int), tagfield.Name)

    let getUnionCaseTyp (typ: Type, tag: int, bindingFlags) =
        let tagFields = getUnionTypeTagNameMap(typ, bindingFlags)
        let tagField = tagFields |> Array.pick (fun (i, f) -> if i = tag then Some f else None)
        if tagFields.Length = 1 then
            typ
        else
            // special case: two-cased DU annotated with CompilationRepresentation(UseNullAsTrueValue)
            // in this case it will be compiled as one class: return self type for non-nullary case and null for nullary
            let isTwoCasedDU =
{'fraction_non_alphanumeric': 0.10656894679695983, 'fraction_numerical': 0.003963083604777416, 'mean_word_length': 2.3719568002928795, 'pattern_counts': {'":': 0, '<': 27, '<?xml version=': 0, '>': 128, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1666287', 'n_tokens_mistral': 4906, 'n_tokens_neox': 4684, 'n_words': 1391}