<commit_before>﻿namespace ProviderImplementation

open System
open System.Collections.Generic
open System.IO
open System.Reflection
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.ExprShape
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection
open ProviderImplementation.ProvidedTypes

type AssemblyReplacer =
    abstract member ToRuntime : Type -> Type
    abstract member ToRuntime : Expr -> Expr
    abstract member ToDesignTime: Expr -> Expr

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module private AssemblyReplacer =

    let private replace asmMappings (original, originalAsms) f =
        let toAsm = 
            asmMappings
            |> Seq.tryPick (fun (fromAsm, toAsm) -> 
                if originalAsms |> List.exists (fun originalAsm -> originalAsm = fromAsm) then                
                    if fromAsm = originalAsms.Head then 
                        Some toAsm 
                    else 
                        Some originalAsms.Head
                else 
                    None)
        match toAsm with
        | Some toAsm -> f toAsm
        | None -> original

    let private replaceLazy asmMappings (lazyOriginal : 'a Lazy, originalAsms) f =
        let toAsm = 
            asmMappings
            |> Seq.tryPick (fun (fromAsm, toAsm) -> 
                if originalAsms |> List.exists (fun originalAsm -> originalAsm = fromAsm) then                
                    if fromAsm = originalAsms.Head then 
                        Some toAsm 
                    else 
                        Some originalAsms.Head
                else 
                    None)
        match toAsm with
        | Some toAsm -> f toAsm
        | None -> lazyOriginal.Value

    let private getType (asm:Assembly) (t:Type) rt =
        let getFullName (t:Type) =
            let fullName = t.FullName        
            if fullName.StartsWith("FSI_")
            then fullName.Substring(fullName.IndexOf('.') + 1)
            else fullName
        let newT =
            if t.IsGenericType && not t.IsGenericTypeDefinition then 
                let genericType = t.GetGenericTypeDefinition()
                let newT = asm.GetType (getFullName genericType)
                if newT = null then 
                    null
                else
                    let typeArguments = 
                        t.GetGenericArguments()
                        |> Seq.map rt
                        |> Seq.toArray
                    newT.MakeGenericType(typeArguments)
            else 
                asm.GetType (getFullName t)
        if newT = null then
            failwithf "Type '%O' not found in '%s'" t asm.Location
        newT

    let rec getAssemblies (t:Type) = [
        yield t.Assembly
        if t.IsGenericType && not t.IsGenericTypeDefinition then
            for t in t.GetGenericArguments() do
                yield! getAssemblies t
    ]

    let rec private replaceType asmMappings (t : Type) =        
        if t.GetType().Name = "ProvidedSymbolType" then t
        elif t.GetType() = typeof<ProvidedTypeDefinition> then t
        else replace asmMappings (t, getAssemblies t) (fun toAsm -> getType toAsm t (replaceType asmMappings))

    let private replaceProperty asmMappings (p : PropertyInfo) =
        if p.GetType() = typeof<ProvidedProperty> then p
        else replace asmMappings (p, getAssemblies p.DeclaringType) (fun toAsm ->
            let t = getType toAsm p.DeclaringType (replaceType asmMappings)
            let isStatic = 
                p.CanRead && p.GetGetMethod().IsStatic || 
                p.CanWrite && p.GetSetMethod().IsStatic
            let bindingFlags = BindingFlags.Public ||| BindingFlags.NonPublic ||| 
                               (if isStatic then BindingFlags.Static else BindingFlags.Instance)
            let newP = t.GetProperty(p.Name, bindingFlags)
            if newP = null then
                failwithf "Property '%O' of type '%O' not found in '%s'" p t toAsm.Location
            newP)
    
    let private replaceMethod asmMappings (m : MethodInfo) =
        if m.GetType() = typeof<ProvidedMethod> then m
        elif m.DeclaringType.FullName = "Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions" then m // these methods don't really exist, so there's no need to replace them
        else replace asmMappings (m, getAssemblies m.DeclaringType) (fun toAsm ->
                let t = getType toAsm m.DeclaringType (replaceType asmMappings)
                let parameterTypes = 
                    m.GetParameters() 
                    |> Seq.map (fun p -> replaceType asmMappings p.ParameterType) 
                    |> Seq.toArray
                let newM =
                    if m.IsGenericMethod then 
                        let genericMethod = t.GetMethod(m.Name)
                        if genericMethod = null then 
                            null
                        else
                            let typeArguments = 
                                m.GetGenericArguments()
                                |> Seq.map (fun t -> replaceType asmMappings t) 
                                |> Seq.toArray                        
                            genericMethod.MakeGenericMethod(typeArguments)
                    else 
                        t.GetMethod(m.Name, parameterTypes)
                if newM = null then
                    failwithf "Method '%O' of type '%O' not found in '%s'" m t toAsm.Location
                else
                    newM)

    let private replaceConstructor asmMappings (c : ConstructorInfo) =
        if c.GetType() = typeof<ProvidedConstructor> then c
        else replace asmMappings (c, getAssemblies c.DeclaringType) (fun toAsm ->
            let t = getType toAsm c.DeclaringType (replaceType asmMappings)
            let parameterTypes = 
                c.GetParameters() 
                |> Seq.map (fun p -> replaceType asmMappings p.ParameterType) 
                |> Seq.toArray
            let newC = t.GetConstructor(parameterTypes)
            if newC = null then
                failwithf "Constructor '%O' of type '%O' not found in '%s'" c t toAsm.Location
            else
                newC)

    let private replaceUnionCase asmMappings (uci : UnionCaseInfo) exprs =
        replaceLazy asmMappings (lazy (Expr.NewUnionCase (uci, exprs)), getAssemblies uci.DeclaringType) (fun toAsm ->
            let t = getType toAsm uci.DeclaringType (replaceType asmMappings)
            let constructorMethod = t.GetMethod(uci.Name)
            if constructorMethod = null then
                failwithf "Method '%s' of type '%O' not found in '%s'" uci.Name t toAsm.Location
            Expr.Call (constructorMethod, exprs))

    let private replaceVar asmMappings (varTable: IDictionary<_,_>) reversePass (v: Var) =
        if v.Type.GetType() = typeof<ProvidedTypeDefinition> then v
        else replace asmMappings (v, getAssemblies v.Type) (fun toAsm ->
            if reversePass then
                let newVar = Var (v.Name, getType toAsm v.Type (replaceType asmMappings), v.IsMutable)
                // store the asmMappings as we'll have to revert them later
                varTable.Add(newVar, v)
                newVar
            else
                varTable.[v])
    
    let rec private replaceExpr asmMappings varTable reversePass quotation =
        let rt = replaceType asmMappings
        let rp = replaceProperty asmMappings
        let rm = replaceMethod asmMappings
        let rc = replaceConstructor asmMappings
        let ru = replaceUnionCase asmMappings
        let rv = replaceVar asmMappings varTable reversePass
        let re = replaceExpr asmMappings varTable reversePass
        
        // this is not exhaustive, it's missing fields, setters, etc...
        // add more patterns as needed
        match quotation with
        | Call (expr, m, exprs) -> 
            match expr with
            | Some expr -> Expr.Call (re expr, rm m, List.map re exprs)
            | None -> Expr.Call (rm m, List.map re exprs)
        | PropertyGet (expr, p, exprs) -> 
            match expr with
            | Some expr -> Expr.PropertyGet (re expr, rp p, List.map re exprs)
            | None -> Expr.PropertyGet (rp p, List.map re exprs)
        | NewObject (c, exprs) ->
            Expr.NewObject (rc c, List.map re exprs)
        | Coerce (expr, t) ->
            Expr.Coerce (re expr, rt t)
        | NewUnionCase (uci, exprs) ->
            ru uci (List.map re exprs)
        | NewDelegate (t, vars, expr) ->
            Expr.NewDelegate (rt t, List.map rv vars, re expr)
        | ShapeVar v -> 
            Expr.Var (rv v)
        | ShapeLambda (v, expr) -> 
            Expr.Lambda (rv v, re expr)
        | ShapeCombination (o, exprs) -> 
            RebuildShapeCombination (o, List.map re exprs)

    let create asmMappings =

        let asmMappingsReversed = asmMappings |> List.map (fun (a, b) -> b, a)
        let variablesTable = new Dictionary<_, _>()
            
        { new AssemblyReplacer with
            member __.ToRuntime (t:Type) = t |> replaceType asmMappings
            member __.ToRuntime (e:Expr) = e |> replaceExpr asmMappings variablesTable false
            member __.ToDesignTime (e:Expr) = e |> replaceExpr asmMappingsReversed variablesTable true }
<commit_msg>Improvements to AssemblyReplacer<commit_after>﻿namespace ProviderImplementation

open System
open System.Collections.Generic
open System.IO
open System.Reflection
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.ExprShape
open Microsoft.FSharp.Quotations.Patterns
open Microsoft.FSharp.Reflection
open ProviderImplementation.ProvidedTypes

type AssemblyReplacer =
    abstract member ToRuntime : Type -> Type
    abstract member ToRuntime : Expr -> Expr
    abstract member ToDesignTime: Expr -> Expr

[<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
module private AssemblyReplacer =

    let private replace asmMappings (original, originalAsms) f =
        let toAsm = 
            asmMappings
            |> Seq.tryPick (fun (fromAsm, toAsm) -> 
                if originalAsms |> List.exists (fun originalAsm -> originalAsm = fromAsm) then                
                    if fromAsm = originalAsms.Head then 
                        Some toAsm 
                    else 
                        Some originalAsms.Head
                else 
                    None)
        match toAsm with
        | Some toAsm -> f toAsm
        | None -> original

    let private replaceLazy asmMappings (lazyOriginal : 'a Lazy, originalAsms) f =
        let toAsm = 
            asmMappings
            |> Seq.tryPick (fun (fromAsm, toAsm) -> 
                if originalAsms |> List.exists (fun originalAsm -> originalAsm = fromAsm) then                
                    if fromAsm = originalAsms.Head then 
                        Some toAsm 
                    else 
                        Some originalAsms.Head
                else 
                    None)
        match toAsm with
        | Some toAsm -> f toAsm
        | None -> lazyOriginal.Value

    let private getType (asm:Assembly) (t:Type) rt =
        let getFullName (t:Type) =
            let fullName = t.FullName        
            if fullName.StartsWith("FSI_") then 
                fullName.Substring(fullName.IndexOf('.') + 1)
            else 
                fullName
        let getType name =
            if asm.GetName().Name = "FSI-ASSEMBLY" then
                asm.GetTypes() 
                |> Seq.filter (fun t -> t.FullName.EndsWith name)
                |> Seq.last
            else
                asm.GetType (getFullName t)
        let newT =
            if t.IsGenericType && not t.IsGenericTypeDefinition then 
                let genericType = t.GetGenericTypeDefinition()
                let newT = getType (getFullName genericType)
                if newT = null then 
                    null
                else
                    let typeArguments = 
                        t.GetGenericArguments()
                        |> Seq.map rt
                        |> Seq.toArray
                    newT.MakeGenericType(typeArguments)
            else 
                getType (getFullName t)
        if newT = null then
            failwithf "Type '%O' not found in '%s'" t asm.Location
        newT

    let rec getAssemblies (t:Type) = [
        yield t.Assembly
        if t.IsGenericType && not t.IsGenericTypeDefinition then
            for t in t.GetGenericArguments() do
                yield! getAssemblies t
    ]

    let rec private replaceType asmMappings (t : Type) =        
        if t.GetType().Name = "ProvidedSymbolType" then t
        elif t.GetType() = typeof<ProvidedTypeDefinition> then t
        else replace asmMappings (t, getAssemblies t) (fun toAsm -> getType toAsm t (replaceType asmMappings))

    let private replaceProperty asmMappings (p : PropertyInfo) =
        if p.GetType() = typeof<ProvidedProperty> then p
        else replace asmMappings (p, getAssemblies p.DeclaringType) (fun toAsm ->
            let t = getType toAsm p.DeclaringType (replaceType asmMappings)
            let isStatic = 
                p.CanRead && p.GetGetMethod().IsStatic || 
                p.CanWrite && p.GetSetMethod().IsStatic
            let bindingFlags = BindingFlags.Public ||| BindingFlags.NonPublic ||| 
                               (if isStatic then BindingFlags.Static else BindingFlags.Instance)
            let newP = t.GetProperty(p.Name, bindingFlags)
            if newP = null then
                failwithf "Property '%O' of type '%O' not found in '%s'" p t toAsm.Location
            newP)

    let private replaceField asmMappings (f : FieldInfo) =
        if f.GetType() = typeof<ProvidedField> then f
        else replace asmMappings (f, getAssemblies f.DeclaringType) (fun toAsm ->
            let t = getType toAsm f.DeclaringType (replaceType asmMappings)
            let bindingFlags = (if f.IsPublic then BindingFlags.Public else BindingFlags.NonPublic) ||| 
                               (if f.IsStatic then BindingFlags.Static else BindingFlags.Instance)
            let newF = t.GetField(f.Name, bindingFlags)
            if newF = null then
                failwithf "Field '%O' of type '%O' not found in '%s'" f t toAsm.Location
            newF)
    
    let private replaceMethod asmMappings (m : MethodInfo) =
        if m.GetType() = typeof<ProvidedMethod> then m
        elif m.DeclaringType.FullName = "Microsoft.FSharp.Core.LanguagePrimitives+IntrinsicFunctions" then m // these methods don't really exist, so there's no need to replace them
        else replace asmMappings (m, getAssemblies m.DeclaringType) (fun toAsm ->
                let t = getType toAsm m.DeclaringType (replaceType asmMappings)
                let parameterTypes = 
                    m.GetParameters() 
                    |> Seq.map (fun p -> replaceType asmMappings p.ParameterType) 
                    |> Seq.toArray
                let newM =
                    if m.IsGenericMethod then 
                        let genericMethod = t.GetMethod(m.Name)
                        if genericMethod = null then 
                            null
                        else
                            let typeArguments = 
                                m.GetGenericArguments()
                                |> Seq.map (fun t -> replaceType asmMappings t) 
                                |> Seq.toArray                        
                            genericMethod.MakeGenericMethod(typeArguments)
                    else 
                        t.GetMethod(m.Name, parameterTypes)
                if newM = null then
                    failwithf "Method '%O' of type '%O' not found in '%s'" m t toAsm.Location
                else
                    newM)

    let private replaceConstructor asmMappings (c : ConstructorInfo) =
        if c.GetType() = typeof<ProvidedConstructor> then c
        else replace asmMappings (c, getAssemblies c.DeclaringType) (fun toAsm ->
            let t = getType toAsm c.DeclaringType (replaceType asmMappings)
            let parameterTypes = 
                c.GetParameters() 
                |> Seq.map (fun p -> replaceType asmMappings p.ParameterType) 
                |> Seq.toArray
            let newC = t.GetConstructor(parameterTypes)
            if newC = null then
                failwithf "Constructor '%O' of type '%O' not found in '%s'" c t toAsm.Location
            else
                newC)

    let private replaceUnionCase asmMappings (uci : UnionCaseInfo) exprs =
        replaceLazy asmMappings (lazy (Expr.NewUnionCase (uci, exprs)), getAssemblies uci.DeclaringType) (fun toAsm ->
            let t = getType toAsm uci.DeclaringType (replaceType asmMappings)
            let constructorMethod = t.GetMethod(uci.Name)
            if constructorMethod = null then
                failwithf "Method '%s' of type '%O' not found in '%s'" uci.Name t toAsm.Location
            Expr.Call (constructorMethod, exprs))

    let private replaceVar asmMappings (varTable: IDictionary<_,_>) reversePass (v: Var) =
        if v.Type.GetType() = typeof<ProvidedTypeDefinition> then v
        else replace asmMappings (v, getAssemblies v.Type) (fun toAsm ->
            if reversePass then
                let newVar = Var (v.Name, getType toAsm v.Type (replaceType asmMappings), v.IsMutable)
                // store the asmMappings as we'll have to revert them later
                varTable.Add(newVar, v)
                newVar
            else
                varTable.[v])
    
    let rec private replaceExpr asmMappings varTable reversePass quotation =
        let rt = replaceType asmMappings
        let rp = replaceProperty asmMappings
        let rf = replaceField asmMappings
        let rm = replaceMethod asmMappings
        let rc = replaceConstructor asmMappings
        let ru = replaceUnionCase asmMappings
        let rv = replaceVar asmMappings varTable reversePass
        let re = replaceExpr asmMappings varTable reversePass
        
        match quotation with
        | Call (obj, m, args) -> 
            match obj with
            | Some obj -> Expr.Call (re obj, rm m, List.map re args)
            | None -> Expr.Call (rm m, List.map re args)
        | PropertyGet (obj, p, indexArgs) -> 
            match obj with
            | Some obj -> Expr.PropertyGet (re obj, rp p, List.map re indexArgs)
            | None -> Expr.PropertyGet (rp p, List.map re indexArgs)
        | PropertySet (obj, p, indexArgs, value) -> 
            match obj with
            | Some obj -> Expr.PropertySet (re obj, rp p, re value, List.map re indexArgs)
            | None -> Expr.PropertySet (rp p, re value, List.map re indexArgs)
        | NewObject (c, exprs) ->
            Expr.NewObject (rc c, List.map re exprs)
        | Coerce (expr, t) ->
            Expr.Coerce (re expr, rt t)
        | NewUnionCase (uci, exprs) ->
            ru uci (List.map re exprs)
        | NewDelegate (t, vars, expr) ->
            Expr.NewDelegate (rt t, List.map rv vars, re expr)
        | FieldGet (obj, f) -> 
            match obj with
            | Some obj -> Expr.FieldGet (re obj, rf f)
            | None -> Expr.FieldGet (rf f)
        | FieldSet (obj, f, value) -> 
            match obj with
            | Some obj -> Expr.FieldSet (re obj, rf f, re value)
            | None -> Expr.FieldSet (rf f, re value)
        | ShapeVar v -> 
            Expr.Var (rv v)
        | ShapeLambda (v, expr) -> 
            Expr.Lambda (rv v, re expr)
        | ShapeCombination (o, exprs) -> 
            RebuildShapeCombination (o, List.map re exprs)

    let create asmMappings =

        let asmMappingsReversed = asmMappings |> List.map (fun (a, b) -> b, a)
        let variablesTable = new Dictionary<_, _>()
            
        { new AssemblyReplacer with
            member __.ToRuntime (t:Type) = t |> replaceType asmMappings
            member __.ToRuntime (e:Expr) = e |> replaceExpr asmMappings variablesTable false
            member __.ToDesignTime (e:Expr) = e |> replaceExpr asmMappingsReversed variablesTable true }

{'fraction_non_alphanumeric': 0.07590938255762301, 'fraction_numerical': 9.871181086817038e-05, 'mean_word_length': 1.6688619599578505, 'pattern_counts': {'":': 0, '<': 20, '<?xml version=': 0, '>': 133, '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': '6867465', 'n_tokens_mistral': 5723, 'n_tokens_neox': 5314, 'n_words': 1668}