可以在运行时专门化 F# 函数吗？

Question

假设我有一个应该在本地和远程运行的 F# 函数。我想创建一个函数的代理，让那个代理决定在哪里运行函数，这样远程调用对外界是完全不可见的。如果它要在本地运行，代理只会返回函数本身，如下所示：

let proxy_local f = f

如果不是，该函数必须收集其所有参数，然后通过连接发送它们并返回结果。这就是困难的地方：我需要确切地知道用户希望代理的哪个函数，还需要知道该函数的参数，这样我就可以在通过网络发送它们之前收集它们。

AFAIK 我无法检查函数参数本身，因为在运行时它将是 FSharpFunc 的一些未知子类，它收集参数并使用它们调用函数。为了解决这个问题，我想我需要引用一个引号（顺便说一句，有没有更好的方法来做这部分？）：

let getMethodInfo = function
    | Call (_, mi, _) -> [], mi
    | Lambdas (vs, Call(_, mi, _)) -> List.map (fun (v: Var list) -> (List.head v).Type) vs, mi
    | _ -> failwith "Not a function"

let proxy_remote (f: Expr) =
    let (argTypes, methodInfo) = getMethodInfo f
    … ? // What to return?

let proxy f = if isLocal then proxy_local f else proxy_remote f

上面的getMethodInfo 不适用于带有元组参数的方法，我们还需要修改proxy_local，但我们现在先把它放在一边。问题是proxy_remote 的返回值。它应该是一个与原始参数具有相同参数的函数，但它应该在最后通过网络发送它们。像这样的：

let callRemote (method: MethodInfo) a b c … = doHttpConnection()

但是，参数需要输入。这是真正的问题：由于 F# 函数调用在编译时 被转换为 FSharpFunc 子类，因此我不知道如何获得可以与反射一起使用的非专业表示。我真正的问题是：F# 函数可以在运行时使用未知类型进行特化吗？

我可以想出两种方法来解决这个问题。第一个是让proxy 本身是通用的：

let call1<'p, 'res> (method: MethodInfo) (p: 'p) = method.Invoke(null, [| p :> obj |]) :?> 'res
let call2<'p1, 'p2, 'res> (method: MethodInfo) (p1: 'p1) (p2: 'p2) = method.Invoke(null, [| p1 :> obj; p2 :> obj |]) :?> 'res
…

let proxy1 (f: Expr<'a -> 'b>) (s: string) : 'a -> 'b =
    let (types, mi) = getMethodInfo f
    match types with
    | [_] -> call1<'a, 'b> mi
    | _ -> failwith ""

let proxy2 (f: Expr<'a -> 'b -> 'c>) : 'a -> 'b -> 'c =
    let (types, mi) = getMethodInfo f
    match types with
    | [_; _] -> call2<'a, 'b, 'c> mi
    | _ -> failwith ""
…

这当然可行，但它需要程序员提前考虑每个函数的输入数量。更糟糕的是，具有更多参数的函数将适用于所有接受较少参数的代理方法：

let f a b = a + b
let fproxy = proxy1 f // The result will be of type int -> (int -> int), not what we want at all!

另一种方法是为此目的创建 FSharpFunc 的特殊子类：

type call1<'a, 'res>(id, ps) =
    inherit FSharpFunc<'a, 'res>()
    override __.Invoke(x: 'a) = callImpl<'res> id ((x :> obj) :: ps)

type call2<'a, 'b, 'res>(id, ps) =
    inherit FSharpFunc<'a, FSharpFunc<'b, 'res>>()
    override __.Invoke(x) = call1<'b, 'res>(id, x :> obj :: ps) :> obj :?> FSharpFunc<'b, 'res>

… 

let proxy (f: Expr<'a -> 'b>) : 'a -> 'b =
    let (types, methodInfo) = getMethodInfo f
    match types with
    | [a] ->
        let t = typedefof<call1<_,_>>.MakeGenericType([| a; methodInfo.ReturnType |])
        t.GetConstructors().[0].Invoke([|methodInfo; []|]) :?> ('a -> 'b)
    | [a; b] ->
        let t = typedefof<call2<_,_,_>>.MakeGenericType([| a; b; methodInfo.ReturnType |])
        t.GetConstructors().[0].Invoke([|methodInfo; []|]) :?> ('a -> 'b)
    … 
    | _ -> failwith ""

它会起作用，但它可能不会像 F# 编译器生成的那样高效，特别是在所有动态转换的情况下。那么，有没有办法在运行时专门化 F# 函数，所以 typedefof<call1<_,_>>.MakeGenericType([| a; methodInfo.ReturnType |]) 可以替换为直接调用函数？

Answer 1

经过大量搜索，似乎没有办法做我想做的事。然而，我确实了解到，其他人也将 FSharpFunc 子类化为一些非常奇怪的用例，所以它并非完全闻所未闻。如果有人有一些见解可以分享，我会留下这个问题。

Answer 2

这不是您问题的直接答案。但这是我玩过的实现（希望能有所帮助）：

type MyF<'U, 'V>(consumeParam: obj -> obj option, cont: 'V) = 
    inherit FSharpFunc<'U, 'V>()
    override __.Invoke(v: 'U) =
        match consumeParam (v :> obj) with 
        | None -> cont
        | Some result -> result :?> 'V

let netCall (outputT: Type) (paramObjs: obj[]): obj = 
    //tcp http etc
    printfn "%A" paramObjs
    Activator.CreateInstance(outputT)

let proxy (f: 't) : 't = 
    let rec collectTypes (t: Type) (acc: Type list) = 
        if t.Name = "FSharpFunc`2" then 
            let args = t.GetGenericArguments()
            collectTypes args.[1] (args.[0]::acc)
        else t::acc           
    let tps = collectTypes (typeof<'t>) [] //here we collected all types from sugnature to array
    printfn "%A" (tps |> List.map(fun x -> x.Name) |> List.rev) //just for debug
    match tps with 
    | [] -> failwithf "Could not be here" //signature cannot be empty
    | [ _ ] -> f //provided param is not a function
    | outputT::inputT::otherT -> //take last two types: ... -> inputT -> outputT
        let mutable paramIndex = 0 //at each call of FSharpFunc we add param to array
        let paramsHolder: obj[] = Array.zeroCreate (otherT.Length + 1)     
        let consumeParam (paramValue: obj) = 
            paramsHolder.[paramIndex] <- paramValue
            paramIndex <- paramIndex + 1
            if paramIndex = paramsHolder.Length then //if all params given
                Some(netCall outputT paramsHolder)//network call 
            else None
        let initialFunc = //build initial func inputT -> outputT
            typedefof<MyF<_,_>>.MakeGenericType([| inputT; outputT |])
                .GetConstructors().[0].Invoke([| consumeParam :> obj; Activator.CreateInstance(outputT) |])
        let rec buildF (func: obj) otherT = //recursivelly build other funcs
            match otherT with 
            | [] -> func 
            | inputT::otherT -> 
                let newFunc = 
                    typedefof<MyF<_,_>>.MakeGenericType([| inputT; func.GetType().BaseType |])
                        .GetConstructors().[0].Invoke([| consumeParam :> obj; func |])
                buildF newFunc otherT
        let finalFunc = buildF initialFunc otherT
        finalFunc :?> 't  //final cast

[<EntryPoint>]
let main args =
    let myTestF1 a b = a + b
    let myTestF1Proxied = proxy myTestF1
    printfn "myTestF1Proxied created"
    let res = myTestF1Proxied 1 2
    let myTestF2 a b c d e = 1.0 + a + b * c - d + (float) e
    let myTestF2Proxied = proxy myTestF2
    printfn "myTestF2Proxied created"
    let res = myTestF2Proxied 1. 2. 3. 4. 5
    // let myTestF3 a b c = a::b::c
    // let myTestF3Proxied = proxy myTestF3
    // printfn "myTestF3Proxied created"
    // let res = myTestF3Proxied "test" "a" []
    printfn "Done"
    0

前两个测试的输出：

["Int32"; "Int32"; "Int32"]
myTestF1Proxied created
[|1; 2|]
["Double"; "Double"; "Double"; "Double"; "Int32"; "Double"]
myTestF2Proxied created
[|1.0; 2.0; 3.0; 4.0; 5|]

第三次测试在 Activator.CreateInstance 上崩溃。这是一个有趣的案例，因为这里代理的函数是let myTestF3 a b c = a::b::c。它是通用的：'a -> 'a -> 'a 列表。因此，这就是如何代理此类函数的问题（假设我们可以使用可为空类型约束代理或以某种方式使用 Option）。

更新

这是改进的代码：

1) Activator.CreateInstance 已删除 - 它无法在运行时创建 FSharpList

2) invokeFunc - 它是 netCall 的存根 - 但可以在其他远程端使用。函数递归地将参数应用于泛型函数

3) MyF 分为两个类：MyF 和 MyFInit - 这允许在初始调用时删除 Activator.CreateInstance

现在第三次测试成功。代码：

type MyF<'U, 'V>(consumeParam, cont: 'V) = 
    inherit FSharpFunc<'U, 'V>()
    override __.Invoke(v: 'U) = consumeParam (v :> obj); cont

type MyFInit<'U, 'V>(consumeParam: obj -> obj) = 
    inherit FSharpFunc<'U, 'V>()
    override __.Invoke(v: 'U) = consumeParam (v :> obj) :?> 'V

let invokeFunc f (outputT: Type) (paramObjs: obj[]) = 
    let rec invoke partiallyAppliedFunc givenParams = 
        match givenParams with
        | p::otherParams ->
            let methodInfo = partiallyAppliedFunc.GetType().GetMethod("Invoke", [| p.GetType() |])
            if isNull methodInfo then 
                partiallyAppliedFunc //fully applied ?
            else 
                let newFunc = methodInfo.Invoke(partiallyAppliedFunc, [| p |])
                invoke newFunc otherParams
        | _ -> 
            partiallyAppliedFunc //params are empty 
    invoke f (paramObjs |> Array.toList)

let netCall f (outputT: Type) (paramObjs: obj[]): obj = 
    //tcp http etc instead of invokeFunc
    printfn "%A" paramObjs
    let res = invokeFunc f outputT paramObjs
    printfn "Res: %A" res
    res

let proxy (f: 't) : 't = 
    let rec collectTypes (t: Type) (acc: Type list) = 
        if t.Name = "FSharpFunc`2" then 
            let args = t.GetGenericArguments()
            collectTypes args.[1] (args.[0]::acc)
        else t::acc           
    let tps = collectTypes (typeof<'t>) [] //here we collected all types from sugnature to array
    printfn "%A" (tps |> List.map(fun x -> x.Name) |> List.rev) //just for debug
    match tps with 
    | [] -> failwithf "Could not be here" //signature cannot be empty
    | [ _ ] -> f //provided param is not a function
    | outputT::inputT::otherT -> //take last two types: ... -> inputT -> outputT
        let mutable paramIndex = 0 //at each call of FSharpFunc we add param to array
        let paramsHolder: obj[] = Array.zeroCreate (otherT.Length + 1)   
        let consumeParamInit (paramValue: obj) = 
            paramsHolder.[paramIndex] <- paramValue
            paramIndex <- paramIndex + 1
            netCall f outputT paramsHolder//network call 
        let consumeParam (paramValue: obj) = 
            paramsHolder.[paramIndex] <- paramValue
            paramIndex <- paramIndex + 1
        let initialFunc = //build initial func inputT -> outputT
            typedefof<MyFInit<_,_>>.MakeGenericType([| inputT; outputT |])
                .GetConstructors().[0].Invoke([| consumeParamInit :> obj |])
        let rec buildF (func: obj) otherT = //recursivelly build other funcs
            match otherT with 
            | [] -> func 
            | inputT::otherT -> 
                let newFunc = 
                    typedefof<MyF<_,_>>.MakeGenericType([| inputT; func.GetType().BaseType |])
                        .GetConstructors().[0].Invoke([| consumeParam :> obj; func |])
                buildF newFunc otherT
        let finalFunc = buildF initialFunc otherT
        finalFunc :?> 't  //final cast

[<EntryPoint>]
let main args = 
    let myTestF1 a b = a + b
    let myTestF1Proxied = proxy myTestF1
    printfn "myTestF1Proxied created"
    let res = myTestF1Proxied 1 2
    let myTestF2 a b c d e = 1.0 + a + b * c - d + (float) e
    let myTestF2Proxied = proxy myTestF2
    printfn "myTestF2Proxied created"
    let res = myTestF2Proxied 1. 2. 3. 4. 5
    let myTestF3 a b c = a::b.ToString()::c
    let myTestF3Proxied = proxy myTestF3
    printfn "myTestF3Proxied created"
    let res = myTestF3Proxied "test" 1 []
    printfn "Done"
    0

输出：

["Int32"; "Int32"; "Int32"]
myTestF1Proxied created
[|1; 2|]
Res: 3
["Double"; "Double"; "Double"; "Double"; "Int32"; "Double"]
myTestF2Proxied created
[|1.0; 2.0; 3.0; 4.0; 5|]
Res: 9.0
["String"; "Int32"; "FSharpList`1"; "FSharpList`1"]
myTestF3Proxied created
[|"test"; 1; []|]
Res: ["test"; "1"]
Done