<commit_before>﻿module Barb.Interop

open System
open System.Text
open System.Text.RegularExpressions
open System.Reflection
open System.ComponentModel
open System.Linq
open System.Collections
open System.Collections.Concurrent
open System.Collections.Generic
open System.Runtime.CompilerServices

open Barb.Helpers
open Barb.Representation


//let findAllExtensionMethods () = 
//    AppDomain.CurrentDomain.GetAssemblies()   
//    |> Seq.filter (fun a -> a.IsDefined(typeof<ExtensionAttribute>,false))
//    |> Seq.collect (fun a -> a.GetTypes())
//    |> Seq.filter (fun typ -> typ.IsSealed && not typ.IsNested)
//    |> Seq.filter (fun typ -> typ.IsDefined(typeof<ExtensionAttribute>,false))
//    |> Seq.collect (fun typ -> typ.GetMethods(BindingFlags.Static ||| BindingFlags.Public))

let findAllPublicStaticTypes () =
    AppDomain.CurrentDomain.GetAssemblies()
    |> Seq.collect (fun a -> a.GetTypes())
    |> Seq.filter (fun typ -> typ.IsPublic && typ.IsClass && typ.IsSealed && typ.IsAbstract)

let nullableToOption res =
    match res with
    | null -> None
    | item -> Some item

let (|DecomposeOption|_|) (o: obj) = 
    if o = null then Some null
    else
        let genericOptionType = typedefof<_ option>
        let bindingFlags = BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public      
        match o.GetType() with
        | t when t.IsGenericType -> 
            let gt = t.GetGenericTypeDefinition()
            if gt = genericOptionType then t.InvokeMember("Value", bindingFlags, null, o, Array.empty) |> Some
            else None
        | _ -> None  
       
let (|SupportedNumberType|_|) (input: obj) =
    match input with
    | (:? byte as num) -> Some (int64 (int num) :> obj)
    | (:? sbyte as num) -> Some (int64 (int num) :> obj)
    | (:? int16 as num) -> Some (int64 (int32 num) :> obj)
    | (:? uint16 as num) -> Some (int64 (uint32 num) :> obj)
    | (:? int32 as num) -> Some (int64 num :> obj)
    | (:? uint32 as num) -> Some (int64 num :> obj)
//    | (:? int64 as num) -> Some (int64 num :> obj)
    | (:? uint64 as num) -> Some (int64 num :> obj)
    | (:? nativeint as num) -> Some (int64 (int64 num) :> obj)
    | (:? unativeint as num) -> Some (int64 (uint64 num) :> obj)
    | (:? decimal as num) -> Some (float num :> obj)
    | (:? single as num) -> Some (float num :> obj)
    | value -> None

let rec resolveResultType (output: obj) = 
    match output with
    | null -> Obj null
    | DecomposeOption contents -> resolveResultType contents
    | SupportedNumberType contents -> Obj contents
    | other -> Obj other

let propertyToExpr (prop: PropertyInfo) =
    match prop.GetIndexParameters() with
    | [||] -> (fun obj -> prop.GetValue(obj, null) |> Returned)
    | prms ->
        let typeArgs = prms |> Array.map (fun pi -> pi.ParameterType)
        (fun (obj: obj) -> [(fun args -> prop.GetValue(obj, args)), typeArgs] |> IndexedProperty)

let overloadedMethodToExpr (methods: MethodInfo seq) (getter: obj -> obj) =
    let methodsWithPrms = methods |> Seq.map (fun mi -> mi, mi.GetParameters() |> Array.map (fun pi -> pi.ParameterType)) |> Seq.toList
    fun (instance:obj) -> 
        let methodOverloads =
            [
                for mi, prms in methodsWithPrms do
                    let resolver = 
                        fun (args) -> 
                            let parentResult = getter instance
                            mi.Invoke(parentResult, args)
                    yield resolver, prms
            ]
        Method methodOverloads

let resolveMember (rtype: System.Type) (memberName: string) =
    let resolveProp () = 
        rtype.GetProperty(memberName) |> nullableToOption
        |> function
           | None -> None
           | Some prop -> match prop.GetIndexParameters() with
                          | [||] -> Some <| PropertyCall (fun obj -> prop.GetValue(obj, null))
                          | prms ->
                                let typeArgs = prms |> Array.map (fun pi -> pi.ParameterType)
                                Some <| IndexedPropertyCall (fun obj -> [(fun args -> prop.GetValue(obj, args)), typeArgs])
    let resolveMethod () = 
       rtype.GetMethods()
       |> Array.filter (fun mi -> mi.Name = memberName) |> Array.toList
       |> function
          | [] -> None
          | list -> 
            let methodsWithParams = 
                list |> List.map (fun mi -> mi, mi.GetParameters() |> Array.map (fun pi -> pi.ParameterType))
            let globallyResolvedMethods instance =
                methodsWithParams
                |> List.map (fun (mi, mp) ->
                                let callMethod = 
                                    fun args ->
                                        if instance <> null then mi.Invoke(instance, args)
                                        else null
                                callMethod, mp)
            Some <| MethodCall (globallyResolvedMethods)
    let resolveField () = 
        rtype.GetField(memberName) |> nullableToOption
        |> function
            | Some fld -> Some <| PropertyCall (fun obj -> fld.GetValue(obj, null))
            | None -> None  
    resolveProp () |> Option.tryResolve resolveMethod |> Option.tryResolve resolveField

let cachedResolveMember = 
    let inputToKey (rtype: System.Type, caseName) = rtype.FullName + "~" + caseName
    let resolveMember (rtype, caseName) = resolveMember rtype caseName
    memoizeBy inputToKey resolveMember

let resolveInvoke (o: obj) (memberName: string) =
    if o = null then None
    else cachedResolveMember (o.GetType(), memberName)
         |> Option.map (function
                        | PropertyCall pc -> Returned (pc o)
                        | MethodCall mc -> Method (mc o)
                        | IndexedPropertyCall ipc -> IndexedProperty (ipc o))

let rec resolveMembers (rtype: System.Type) (parentName: string) (getter: obj -> obj) =
    let properties = rtype.GetProperties()
    let methodCollections = rtype.GetMethods()
                            |> Seq.groupBy (fun mi -> mi.Name)                                   
    seq {
        for prop in properties do
            let fullName =
                if String.IsNullOrEmpty parentName then prop.Name 
                else String.Format("{0}.{1}", parentName, prop.Name)
            yield fullName, propertyToExpr prop
        for (name, methods) in methodCollections do           
            yield name, overloadedMethodToExpr methods id
    }     

let rec inline convertSequence seq1 seq2 = 
    List.zip (seq1 |> Seq.toList) (seq2 |> Seq.toList) 
    |> List.map (fun (one, two) -> convertToSameType one two) 
    |> List.unzip |> (fun (l1, l2) -> l1 :> obj, l2 :> obj)

and convertToSameType (obj1: obj) (obj2: obj) : (obj * obj) = 
    try
        if obj1 <> null && obj2 <> null && obj1.GetType() = obj2.GetType() then obj1, obj2
        else
            let t1Des = TypeDescriptor.GetConverter(obj1.GetType())
            if t1Des.CanConvertFrom(obj2.GetType()) then obj1, t1Des.ConvertFrom(obj2)
            else match obj1, obj2 with
                    // Compares reference-typed lists
                    // NOTE: This will break with any version of .NET lower than 4.0<commit_msg>Significant improvements to code sharing and cleanliness in interop/reflection<commit_after>﻿module Barb.Interop

open System
open System.Text
open System.Text.RegularExpressions
open System.Reflection
open System.ComponentModel
open System.Linq
open System.Collections
open System.Collections.Concurrent
open System.Collections.Generic
open System.Runtime.CompilerServices

open Barb.Helpers
open Barb.Representation


//let findAllExtensionMethods () = 
//    AppDomain.CurrentDomain.GetAssemblies()   
//    |> Seq.filter (fun a -> a.IsDefined(typeof<ExtensionAttribute>,false))
//    |> Seq.collect (fun a -> a.GetTypes())
//    |> Seq.filter (fun typ -> typ.IsSealed && not typ.IsNested)
//    |> Seq.filter (fun typ -> typ.IsDefined(typeof<ExtensionAttribute>,false))
//    |> Seq.collect (fun typ -> typ.GetMethods(BindingFlags.Static ||| BindingFlags.Public))

let findAllPublicStaticTypes () =
    AppDomain.CurrentDomain.GetAssemblies()
    |> Seq.collect (fun a -> a.GetTypes())
    |> Seq.filter (fun typ -> typ.IsPublic && typ.IsClass && typ.IsSealed && typ.IsAbstract)

let nullableToOption res =
    match res with
    | null -> None
    | item -> Some item

let (|DecomposeOption|_|) (o: obj) = 
    if o = null then Some null
    else
        let genericOptionType = typedefof<_ option>
        let bindingFlags = BindingFlags.GetProperty ||| BindingFlags.Instance ||| BindingFlags.Public      
        match o.GetType() with
        | t when t.IsGenericType -> 
            let gt = t.GetGenericTypeDefinition()
            if gt = genericOptionType then t.InvokeMember("Value", bindingFlags, null, o, Array.empty) |> Some
            else None
        | _ -> None  
       
let (|SupportedNumberType|_|) (input: obj) =
    match input with
    | (:? byte as num) -> Some (int64 (int num) :> obj)
    | (:? sbyte as num) -> Some (int64 (int num) :> obj)
    | (:? int16 as num) -> Some (int64 (int32 num) :> obj)
    | (:? uint16 as num) -> Some (int64 (uint32 num) :> obj)
    | (:? int32 as num) -> Some (int64 num :> obj)
    | (:? uint32 as num) -> Some (int64 num :> obj)
//    | (:? int64 as num) -> Some (int64 num :> obj)
    | (:? uint64 as num) -> Some (int64 num :> obj)
    | (:? nativeint as num) -> Some (int64 (int64 num) :> obj)
    | (:? unativeint as num) -> Some (int64 (uint64 num) :> obj)
    | (:? decimal as num) -> Some (float num :> obj)
    | (:? single as num) -> Some (float num :> obj)
    | value -> None

let rec resolveResultType (output: obj) = 
    match output with
    | null -> Obj null
    | DecomposeOption contents -> resolveResultType contents
    | SupportedNumberType contents -> Obj contents
    | other -> Obj other

let fieldToExpr (fld: FieldInfo) =
    fun (obj: obj) -> fld.GetValue(obj, null) |> Returned

let propertyToExpr (prop: PropertyInfo) =
    match prop.GetIndexParameters() with
    | [||] -> (fun obj -> prop.GetValue(obj, null) |> Returned)
    | prms ->
        let typeArgs = prms |> Array.map (fun pi -> pi.ParameterType)
        (fun (obj: obj) -> [(fun args -> prop.GetValue(obj, args)), typeArgs] |> IndexedProperty)

let overloadedMethodToExpr (methods: MethodInfo seq) =
    let methodsWithPrms = methods |> Seq.map (fun mi -> mi, mi.GetParameters() |> Array.map (fun pi -> pi.ParameterType)) |> Seq.toList
    fun (instance: obj) -> 
        let methodOverloads =
            [
                for mi, prms in methodsWithPrms do
                    let resolver = 
                        fun (args) -> 
                            mi.Invoke(instance, args)
                    yield resolver, prms
            ]
        Method methodOverloads

let resolveMember (rtype: System.Type) (memberName: string) : (obj -> ExprTypes) option =
    rtype.GetProperty(memberName) |> nullableToOption |> Option.map propertyToExpr
    |> Option.tryResolve (fun () -> match rtype.GetMethods() |> Array.filter (fun mi -> mi.Name = memberName) with | [||] -> None | methods -> methods |> overloadedMethodToExpr |> Some)
    |> Option.tryResolve (fun () -> rtype.GetField(memberName) |> nullableToOption |> Option.map fieldToExpr)

let cachedResolveMember = 
    let inputToKey (rtype: System.Type, caseName) = rtype.FullName + "~" + caseName
    let resolveMember (rtype, caseName) = resolveMember rtype caseName
    memoizeBy inputToKey resolveMember

let resolveInvoke (o: obj) (memberName: string) =
    if o = null then None
    else match cachedResolveMember (o.GetType(), memberName) with
         | Some (resolvedMember) -> resolvedMember o |> Some
         | None -> failwith (sprintf "Unable to lookup specified member %s in object %s" memberName (o.GetType().Name))

let rec resolveMembers (rtype: System.Type) (parentName: string) (getter: obj -> obj) =
    let properties = rtype.GetProperties()
    let methodCollections = rtype.GetMethods()
                            |> Seq.groupBy (fun mi -> mi.Name)                                   
    seq {
        for prop in properties do
            let fullName =
                if String.IsNullOrEmpty parentName then prop.Name 
                else String.Format("{0}.{1}", parentName, prop.Name)
            yield fullName, propertyToExpr prop
        for (name, methods) in methodCollections do           
            yield name, overloadedMethodToExpr methods
    }     

let rec inline convertSequence seq1 seq2 = 
    List.zip (seq1 |> Seq.toList) (seq2 |> Seq.toList) 
    |> List.map (fun (one, two) -> convertToSameType one two) 
    |> List.unzip |> (fun (l1, l2) -> l1 :> obj, l2 :> obj)

and convertToSameType (obj1: obj) (obj2: obj) : (obj * obj) = 
    try
        if obj1 <> null && obj2 <> null && obj1.GetType() = obj2.GetType() then obj1, obj2
        else
            let t1Des = TypeDescriptor.GetConverter(obj1.GetType())
            if t1Des.CanConvertFrom(obj2.GetType()) then obj1, t1Des.ConvertFrom(obj2)
            else match obj1, obj2 with
                    // Compares reference-typed lists
                    // NOTE: This will break with any version of .NET lower than 4.0
{'fraction_non_alphanumeric': 0.12082706766917294, 'fraction_numerical': 0.01037593984962406, 'mean_word_length': 2.243355279200195, 'pattern_counts': {'":': 0, '<': 18, '<?xml version=': 0, '>': 222, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 7, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '568361', 'n_tokens_mistral': 4055, 'n_tokens_neox': 3893, 'n_words': 1142}