<commit_before>﻿module (*internal*) FunJS.ExpressionReplacer

open InternalCompiler
open CompilerComponent
open Microsoft.FSharp.Quotations
open System.Reflection
open System

let private buildInlineReplacement (mi:MethodBase) (args:_ list) =
   match Expr.TryGetReflectedDefinition mi with
   | Some (DerivedPatterns.Lambdas(vars, bodyExpr)) -> 
      let appliedVars = 
         vars |> List.concat |> Seq.take args.Length
         |> Seq.toList
      let unappliedVars =
         vars |> List.concat |> Seq.skip args.Length
         |> Seq.toList
      let varValues = List.zip appliedVars args |> Map.ofList
      let inlinedBody = bodyExpr.Substitute(varValues.TryFind)
      let rec buildLambda expr args =
         match args with
         | [] -> expr
         | x::xs -> buildLambda (Expr.Lambda(x, expr)) xs
      buildLambda inlinedBody unappliedVars
   | _ -> failwith "Expected a method"
   

let inline (==) x y = obj.ReferenceEquals(x, y)
let inline (!=) x y = not (x == y)

let private getReplacementMethod (replacementMi:MethodInfo) args =
   if replacementMi.IsGenericMethodDefinition then
      replacementMi.MakeGenericMethod(args)
   else if replacementMi.IsGenericMethod then
      replacementMi.GetGenericMethodDefinition().MakeGenericMethod(args)
   else replacementMi

let private isInlined (replacementMi:MethodInfo) = 
   (replacementMi.GetCustomAttribute<InlineAttribute>() != null ||
    replacementMi.DeclaringType.GetCustomAttribute<InlineAttribute>() != null) &&
   (replacementMi.GetCustomAttribute<JSEmitAttribute>() == null)

let private castMi =
   typeof<Helpers>
      .GetMethod("Cast", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static)
      .GetGenericMethodDefinition()

let buildCall (mi:MethodInfo) exprs =
   let obj, argExprs =
      match exprs with
      | objExpr::argExprs when not mi.IsStatic ->
         Some objExpr, argExprs
      | exprs -> None, exprs
   let castArgs = 
      mi.GetParameters() |> Array.toList
      |> List.map2 (fun expr p ->
         let castArg = castMi.MakeGenericMethod p.ParameterType
         Expr.Call(castArg, [expr])
      ) argExprs
   match obj with
   | None -> Expr.Call(mi, castArgs)
   | Some objExpr ->
      let objType = mi.DeclaringType
      let castArg = castMi.MakeGenericMethod objType
      let castObjExpr = Expr.Call(castArg, [objExpr])
      Expr.Call(castObjExpr, mi, castArgs)

let createMethodMap mi callType replacementMi =
   let isInlined = isInlined replacementMi
   let replacementRegistration =
      if isInlined then None
      else Some replacementMi
   createCallerReplacer mi callType replacementRegistration <| fun split compiler retStrategy ->
      function
      | None, args, exprs -> 
         let mi = getReplacementMethod replacementMi args
         compiler.Compile retStrategy <|
            if isInlined then buildInlineReplacement mi exprs
            else buildCall mi exprs
      | Some obj, args, exprs -> 
         let mi = getReplacementMethod replacementMi args
         compiler.Compile retStrategy <|
            if isInlined then buildInlineReplacement mi (obj::exprs)
            else buildCall mi (obj::exprs)

let createTypeMethodMappings (fromType:Type) (toType:Type) =
   // REVIEW: Tomas: I first tried to use this method to create mapping that
   // translates instance methods (of an F# type) to JS-specific static methods 
   // of a different F# type (with JS attributes). To do that, I had to change
   // BindingFlags below ('toType' needs Static|NonPublic|Public in order to support
   // static types, 'fromType' needs Instance|Static|NonPublic|Public).
   //
   // .. but then I found I can just use 'ExpressionReplacer.createUnsafe'
   // so I did not include the change. But I think it might be useful to make this
   // more general - if you could map one type to another, it could simplify
   // the mapping code in e.g. 'Maps.fs' which explicitly creates such mapping.
   let methodLookup = 
      toType.GetMethods() 
      |> Array.map (fun mi -> mi.Name, mi)
      |> Map.ofArray
   let availableMethods =
      fromType.GetMethods(BindingFlags.Static ||| BindingFlags.NonPublic ||| BindingFlags.Public)
      |> Array.choose (fun mi ->
         match methodLookup.TryFind mi.Name with
         | Some replacementMi -> 
            match Expr.TryGetReflectedDefinition replacementMi with
            | Some _ -> 
               let replacementMi =
                  if mi.IsGenericMethod then
                     replacementMi.MakeGenericMethod(mi.GetGenericArguments())
                  else replacementMi
               Some <| createMethodMap mi Quote.MethodCall replacementMi
            | None -> None
         | None -> None)
      |> Array.toList
   availableMethods

let private getModule assembly (name:string) =
   let ass =
      AppDomain.CurrentDomain.GetAssemblies()
      |> Seq.find (fun ass -> ass.GetName().Name = assembly)
   let split (name:string) =
      let i = name.LastIndexOf '.'
      if i >= 0 then Some(name.Substring(0, i), name.Substring (i+1))
      else None
   let rec getType n =
      let t = ass.GetType n
      if obj.ReferenceEquals(t, null) then
         match split n with
         | Some(parentType, typeName) ->
            let parentT: System.Type = getType parentType
            parentT.GetMember(typeName).[0] :?> System.Type
         | None -> failwithf "Could not find type: %s" name
      else t
   getType name

let createModuleMapping fromAss fromType toAss toType =
   createTypeMethodMappings (getModule fromAss fromType) (getModule toAss toType)

let private createImpl (quoteTemplate:Expr) (quoteReplacement:Expr) =
   let replacementMi, _ = Quote.toMethodInfoFromLambdas quoteReplacement
   let mi, callType = Quote.toMethodBaseFromLambdas quoteTemplate
   createMethodMap mi callType replacementMi

let createUnsafe (quoteTemplate:Expr) (quoteReplacement:Expr) =
   createImpl quoteTemplate quoteReplacement

let create (quoteTemplate:Expr<'a>) (quoteReplacement:Expr<'a>) =
   createImpl quoteTemplate quoteReplacement<commit_msg>Remove review note<commit_after>﻿module (*internal*) FunJS.ExpressionReplacer

open InternalCompiler
open CompilerComponent
open Microsoft.FSharp.Quotations
open System.Reflection
open System

let private buildInlineReplacement (mi:MethodBase) (args:_ list) =
   match Expr.TryGetReflectedDefinition mi with
   | Some (DerivedPatterns.Lambdas(vars, bodyExpr)) -> 
      let appliedVars = 
         vars |> List.concat |> Seq.take args.Length
         |> Seq.toList
      let unappliedVars =
         vars |> List.concat |> Seq.skip args.Length
         |> Seq.toList
      let varValues = List.zip appliedVars args |> Map.ofList
      let inlinedBody = bodyExpr.Substitute(varValues.TryFind)
      let rec buildLambda expr args =
         match args with
         | [] -> expr
         | x::xs -> buildLambda (Expr.Lambda(x, expr)) xs
      buildLambda inlinedBody unappliedVars
   | _ -> failwith "Expected a method"
   

let inline (==) x y = obj.ReferenceEquals(x, y)
let inline (!=) x y = not (x == y)

let private getReplacementMethod (replacementMi:MethodInfo) args =
   if replacementMi.IsGenericMethodDefinition then
      replacementMi.MakeGenericMethod(args)
   else if replacementMi.IsGenericMethod then
      replacementMi.GetGenericMethodDefinition().MakeGenericMethod(args)
   else replacementMi

let private isInlined (replacementMi:MethodInfo) = 
   (replacementMi.GetCustomAttribute<InlineAttribute>() != null ||
    replacementMi.DeclaringType.GetCustomAttribute<InlineAttribute>() != null) &&
   (replacementMi.GetCustomAttribute<JSEmitAttribute>() == null)

let private castMi =
   typeof<Helpers>
      .GetMethod("Cast", BindingFlags.Public ||| BindingFlags.NonPublic ||| BindingFlags.Static)
      .GetGenericMethodDefinition()

let buildCall (mi:MethodInfo) exprs =
   let obj, argExprs =
      match exprs with
      | objExpr::argExprs when not mi.IsStatic ->
         Some objExpr, argExprs
      | exprs -> None, exprs
   let castArgs = 
      mi.GetParameters() |> Array.toList
      |> List.map2 (fun expr p ->
         let castArg = castMi.MakeGenericMethod p.ParameterType
         Expr.Call(castArg, [expr])
      ) argExprs
   match obj with
   | None -> Expr.Call(mi, castArgs)
   | Some objExpr ->
      let objType = mi.DeclaringType
      let castArg = castMi.MakeGenericMethod objType
      let castObjExpr = Expr.Call(castArg, [objExpr])
      Expr.Call(castObjExpr, mi, castArgs)

let createMethodMap mi callType replacementMi =
   let isInlined = isInlined replacementMi
   let replacementRegistration =
      if isInlined then None
      else Some replacementMi
   createCallerReplacer mi callType replacementRegistration <| fun split compiler retStrategy ->
      function
      | None, args, exprs -> 
         let mi = getReplacementMethod replacementMi args
         compiler.Compile retStrategy <|
            if isInlined then buildInlineReplacement mi exprs
            else buildCall mi exprs
      | Some obj, args, exprs -> 
         let mi = getReplacementMethod replacementMi args
         compiler.Compile retStrategy <|
            if isInlined then buildInlineReplacement mi (obj::exprs)
            else buildCall mi (obj::exprs)

let createTypeMethodMappings (fromType:Type) (toType:Type) =
   let methodLookup = 
      toType.GetMethods() 
      |> Array.map (fun mi -> mi.Name, mi)
      |> Map.ofArray
   let availableMethods =
      fromType.GetMethods(BindingFlags.Static ||| BindingFlags.NonPublic ||| BindingFlags.Public)
      |> Array.choose (fun mi ->
         match methodLookup.TryFind mi.Name with
         | Some replacementMi -> 
            match Expr.TryGetReflectedDefinition replacementMi with
            | Some _ -> 
               let replacementMi =
                  if mi.IsGenericMethod then
                     replacementMi.MakeGenericMethod(mi.GetGenericArguments())
                  else replacementMi
               Some <| createMethodMap mi Quote.MethodCall replacementMi
            | None -> None
         | None -> None)
      |> Array.toList
   availableMethods

let private getModule assembly (name:string) =
   let ass =
      AppDomain.CurrentDomain.GetAssemblies()
      |> Seq.find (fun ass -> ass.GetName().Name = assembly)
   let split (name:string) =
      let i = name.LastIndexOf '.'
      if i >= 0 then Some(name.Substring(0, i), name.Substring (i+1))
      else None
   let rec getType n =
      let t = ass.GetType n
      if obj.ReferenceEquals(t, null) then
         match split n with
         | Some(parentType, typeName) ->
            let parentT: System.Type = getType parentType
            parentT.GetMember(typeName).[0] :?> System.Type
         | None -> failwithf "Could not find type: %s" name
      else t
   getType name

let createModuleMapping fromAss fromType toAss toType =
   createTypeMethodMappings (getModule fromAss fromType) (getModule toAss toType)

let private createImpl (quoteTemplate:Expr) (quoteReplacement:Expr) =
   let replacementMi, _ = Quote.toMethodInfoFromLambdas quoteReplacement
   let mi, callType = Quote.toMethodBaseFromLambdas quoteTemplate
   createMethodMap mi callType replacementMi

let createUnsafe (quoteTemplate:Expr) (quoteReplacement:Expr) =
   createImpl quoteTemplate quoteReplacement

let create (quoteTemplate:Expr<'a>) (quoteReplacement:Expr<'a>) =
   createImpl quoteTemplate quoteReplacement
{'fraction_non_alphanumeric': 0.08273626748549982, 'fraction_numerical': 0.0008529512111907199, 'mean_word_length': 2.6929133858267718, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 89, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '91688', 'n_tokens_mistral': 3509, 'n_tokens_neox': 3217, 'n_words': 914}