infer type parameters.fsx

open System
open FSharp.Reflection
open FSharp.Quotations
open System.Reflection




let inline poo2 (a : 'a) : 'b = (^a : (member Crap : unit -> 'b) a)
let inline poo (a : 'a) : 'b = failwith ""





let rec matchTypes mappings t1 t2 = 
    let (|GenericArgs|) (t : Type) = 
        if t.IsGenericType then 
            t.GetGenericArguments()
        else
            Array.empty
    let (|IsGenericParam|) (t : Type) = t.IsGenericParameter
    if t1 = t2 then
        mappings
    else
        match t1, t2 with 
        | IsGenericParam true, _ -> (t1,t2) :: mappings
        | GenericArgs a1, GenericArgs a2 -> 
            (a1,a2) 
            ||> Array.map2 (matchTypes mappings) 
            |> List.ofArray
            |> List.concat
            |> List.append mappings
            |> List.distinct
        | _ -> failwith "wtf"

            
let typeArgs (minfo : MethodInfo) = 
    let mdef = minfo.GetGenericMethodDefinition()
    let ps1 = mdef.GetParameters()
    let ps2 = minfo.GetParameters()
    matchTypes [] ps1.[0].ParameterType ps2.[0].ParameterType



let rec extractCall e = 
    match e with
    | Patterns.Lambda(_,body) -> extractCall body
    | Patterns.Call(_o,minfo,_args) -> minfo
    | _ -> failwithf "Expression not of expected form %A" e
let rec funcTypes args t = 
    if FSharpType.IsFunction t then 
        let d,r = FSharpType.GetFunctionElements(t)
        funcTypes (d :: args) r
    else
        (args |> List.rev |> List.toArray), t


let inline strip (a : Expr<'a>) : Expr<'b> = 
    let mi = extractCall a
    if mi.IsGenericMethod then 
        let mdef = mi.GetGenericMethodDefinition()
        let ins,out = funcTypes [] typeof<'b>
        let typeMap = 
            [
                yield! (mdef.GetParameters() |> Array.map (fun x -> x.ParameterType), ins) ||> Array.map2 (matchTypes []) |> Seq.concat
                yield! matchTypes [] mdef.ReturnType out
            ]
            |> List.distinct 
        let targs = 
            mdef.GetGenericArguments()
            |> Array.map 
                (fun a ->
                    typeMap |> List.find (fun (b,_) -> a = b) |> snd
                )
        let newMi = mdef.MakeGenericMethod(targs)
        let vars = ins |> Array.mapi (fun i x -> Var("v" + string i, x))
        let call = Expr.Call(newMi, vars |> Array.map Expr.Var |> Array.toList)
        let expr = (vars,call) ||> Array.foldBack (fun v b -> Expr.Lambda(v,b))        
        <@ %%(expr) : 'b @>
    else
        failwith "expecting generic method"



funcTypes [] (typeof<int -> string []>) 


let mi = extractCall <@poo@>
let mdef = mi.GetGenericMethodDefinition()



type Shit = Shit with
    member x.Crap() = ""

let poo3 : Expr<int -> string> = strip <@poo2 Shit@>
extractCall poo3