@@ -16,8 +16,80 @@ open Microsoft.FSharp.Compiler.TypeRelations
1616open Internal.Utilities
1717
1818
19+ [<AutoOpen>]
20+ module ExprUtilsImpl =
21+
22+ // ILCall nodes arise from calls to .NET methods, and provided calls to
23+ // F# methods. This method attempts to take the information in a ILMethodRef
24+ // and bind it to a symbol. This is not fool proof when the ILCall refers to
25+ // an F# method, but is a good approximation.
26+ let bindILMethodRefToSymbol ( cenv : Impl.cenv ) m ( ilMethRef : ILMethodRef ) =
27+ let tcref = Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef
28+ let enclosingType = generalizedTyconRef tcref
29+ // First try to resolve it to IL metadata
30+ let try1 =
31+ if tcref.IsILTycon then
32+ try
33+ let mdef = resolveILMethodRefWithRescope ( rescopeILType ( p13 tcref.ILTyconInfo)) tcref.ILTyconRawMetadata ilMethRef
34+ let minfo = MethInfo.CreateILMeth( cenv.amap, m, enclosingType, mdef)
35+ Some ( FSharpMemberOrFunctionOrValue( cenv, minfo))
36+ with _ -> None
37+ else None
38+
39+ // Otherwise try to bind it to an F# symbol
40+ match try1 with
41+ | Some res -> res
42+ | None ->
43+ try
44+ // Try to bind the call to an F# method call
45+ let memberParentName = if tcref.IsModuleOrNamespace then None else Some tcref.LogicalName
46+ // TODO: this logical name is not correct in the presence of CompiledName
47+ let logicalName = ilMethRef.Name
48+ let isMember = memberParentName.IsSome
49+ if isMember then
50+ let isCtor = ( ilMethRef.Name = " .ctor" )
51+ let isStatic = isCtor || ilMethRef.CallingConv.IsStatic
52+ let scoref = ilMethRef.EnclosingTypeRef.Scope
53+ let typars1 = tcref.Typars( m)
54+ let typars2 = [ 1 .. ilMethRef.GenericArity ] |> List.map ( fun _ -> NewRigidTypar " T" )
55+ let tinst1 = typars1 |> generalizeTypars
56+ let tinst2 = typars2 |> generalizeTypars
57+ // TODO: this will not work for curried methods in F# classes.
58+ // This is difficult to solve as the information in the ILMethodRef
59+ // is not sufficient to resolve to a symbol unambiguously in these cases.
60+ let argtys = [ ilMethRef.ArgTypes |> List.map ( ImportTypeFromMetadata cenv.amap m scoref tinst1 tinst2) ]
61+ let rty =
62+ match ImportReturnTypeFromMetaData cenv.amap m ilMethRef.ReturnType scoref tinst1 tinst2 with
63+ | None -> if isCtor then enclosingType else cenv.g.unit_ ty
64+ | Some ty -> ty
65+
66+ let linkageType =
67+ let ty = mkIteratedFunTy ( List.map ( mkTupledTy cenv.g) argtys) rty
68+ let ty = if isStatic then ty else mkFunTy enclosingType ty
69+ tryMkForallTy ( typars1 @ typars2) ty
70+
71+ let argCount = List.sum ( List.map List.length argtys) + ( if isStatic then 0 else 1 )
72+ let key = ValLinkageFullKey({ MemberParentMangledName= memberParentName; MemberIsOverride= false ; LogicalName= logicalName; TotalArgCount= argCount }, Some linkageType)
73+
74+ let enclosingNonLocalRef = mkNonLocalEntityRef tcref.nlr.Ccu tcref.PublicPath.Value.EnclosingPath
75+ let vref = mkNonLocalValRef enclosingNonLocalRef key
76+ vref.Deref |> ignore // check we can dereference the value
77+ let minfo = MethInfo.FSMeth( cenv.g, enclosingType, vref, None)
78+ FSharpMemberOrFunctionOrValue( cenv, minfo)
79+ else
80+ let key = ValLinkageFullKey({ MemberParentMangledName= memberParentName; MemberIsOverride= false ; LogicalName= logicalName; TotalArgCount= 0 }, None)
81+ let vref = mkNonLocalValRef tcref.nlr key
82+ vref.Deref |> ignore // check we can dereference the value
83+ FSharpMemberOrFunctionOrValue( cenv, vref)
84+
85+ with _ ->
86+ failwith ( sprintf " A call to '%s " ( ilMethRef.ToString()))
87+
88+
89+
1990[<AutoOpen>]
2091module ExprTranslationImpl =
92+
2193 type ExprTranslationEnv =
2294 { //Map from Val to binding index
2395 vs: ValMap < unit >;
@@ -612,12 +684,7 @@ module FSharpExprConvert =
612684 | _ -> failwith " unexpected for-loop form"
613685
614686 | TOp.ILCall(_,_,_, isNewObj,_ valUseFlags,_ isProp,_, ilMethRef, enclTypeArgs, methTypeArgs,_ tys),[], callArgs ->
615- let tcref = Import.ImportILTypeRef cenv.amap m ilMethRef.EnclosingTypeRef
616- let mdef =
617- try resolveILMethodRefWithRescope ( rescopeILType ( p13 tcref.ILTyconInfo)) tcref.ILTyconRawMetadata ilMethRef
618- with _ -> failwith ( sprintf " A call to '%s " ( ilMethRef.ToString()))
619- let minfo = MethInfo.CreateILMeth( cenv.amap, m, generalizedTyconRef tcref, mdef)
620- let v = FSharpMemberFunctionOrValue( cenv, minfo)
687+ let v = bindILMethodRefToSymbol cenv m ilMethRef
621688 ConvObjectModelCallLinear cenv env ( isNewObj, v, enclTypeArgs, methTypeArgs, callArgs) ( fun e -> e)
622689
623690 | TOp.TryFinally _,[_ resty],[ Expr.Lambda(_,_,_,[_], e1,_,_); Expr.Lambda(_,_,_,[_], e2,_,_)] ->
0 commit comments