Fix immediate delegate invoke (#12920)

* Fix #5607

* Fix #5607

Author: dsyme

src/fsharp/CheckExpressions.fs

@@ -8953,26 +8953,39 @@ and TcValueItemThen cenv overallTy env vref tpenv mItem afterResolution delayed
 and TcPropertyItemThen cenv overallTy env nm pinfos tpenv mItem afterResolution delayed =
     let g = cenv.g
     let ad = env.eAccessRights
-    if isNil pinfos then error (InternalError ("Unexpected error: empty property list", mItem))
-    // if there are both intrinsics and extensions in pinfos, intrinsics will be listed first.
+    
+    if isNil pinfos then
+        error (InternalError ("Unexpected error: empty property list", mItem))
+
+    // If there are both intrinsics and extensions in pinfos, intrinsics will be listed first.
     // by looking at List.Head we are letting the intrinsics determine indexed/non-indexed
     let pinfo = List.head pinfos
+
     let _, tyargsOpt, args, delayed, tpenv =
-        if pinfo.IsIndexer
-        then GetMemberApplicationArgs delayed cenv env tpenv
-        else ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv
-    if not pinfo.IsStatic then error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItem))
+        if pinfo.IsIndexer then
+            GetMemberApplicationArgs delayed cenv env tpenv
+        else
+            ExprAtomicFlag.Atomic, None, [mkSynUnit mItem], delayed, tpenv
+    
+    if not pinfo.IsStatic then
+        error (Error (FSComp.SR.tcPropertyIsNotStatic nm, mItem))
+
     match delayed with
     | DelayedSet(e2, mStmt) :: otherDelayed ->
         if not (isNil otherDelayed) then error(Error(FSComp.SR.tcInvalidAssignment(), mStmt))
+
         // Static Property Set (possibly indexer)
         UnifyTypes cenv env mStmt overallTy.Commit g.unit_ty
+
         let meths = pinfos |> SettersOfPropInfos
+
         if meths.IsEmpty then
             let meths = pinfos |> GettersOfPropInfos
             let isByrefMethReturnSetter = meths |> List.exists (function _,Some pinfo -> isByrefTy g (pinfo.GetPropertyType(cenv.amap,mItem)) | _ -> false)
+
             if not isByrefMethReturnSetter then
                 errorR (Error (FSComp.SR.tcPropertyCannotBeSet1 nm, mItem))
+
             // x.P <- ... byref setter
             if isNil meths then error (Error (FSComp.SR.tcPropertyIsNotReadable nm, mItem))
             TcMethodApplicationThen cenv env overallTy None tpenv tyargsOpt [] mItem mItem nm ad NeverMutates true meths afterResolution NormalValUse args ExprAtomicFlag.Atomic delayed
@@ -9067,7 +9080,6 @@ and GetSynMemberApplicationArgs delayed tpenv =
     | otherDelayed ->
         (ExprAtomicFlag.NonAtomic, None, [], otherDelayed, tpenv)
 
-
 and TcMemberTyArgsOpt cenv env tpenv tyargsOpt =
     match tyargsOpt with
     | None -> None, tpenv
@@ -9233,15 +9245,15 @@ and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einf
     | None, false -> error (Error (FSComp.SR.tcEventIsNotStatic nm, mItem))
     | _ -> ()
 
-    let delegateType = einfo.GetDelegateType(cenv.amap, mItem)
-    let (SigOfFunctionForDelegate(invokeMethInfo, compiledViewOfDelArgTys, _, _)) = GetSigOfFunctionForDelegate cenv.infoReader delegateType mItem ad
+    let delTy = einfo.GetDelegateType(cenv.amap, mItem)
+    let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, _)) = GetSigOfFunctionForDelegate cenv.infoReader delTy mItem ad
     let objArgs = Option.toList (Option.map fst objDetails)
-    MethInfoChecks g cenv.amap true None objArgs env.eAccessRights mItem invokeMethInfo
+    MethInfoChecks g cenv.amap true None objArgs env.eAccessRights mItem delInvokeMeth
 
     // This checks for and drops the 'object' sender
     let argsTy = ArgsTypOfEventInfo cenv.infoReader mItem ad einfo
-    if not (slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(cenv.amap, mItem))) then errorR (nonStandardEventError einfo.EventName mItem)
-    let delEventTy = mkIEventType g delegateType argsTy
+    if not (slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(cenv.amap, mItem))) then errorR (nonStandardEventError einfo.EventName mItem)
+    let delEventTy = mkIEventType g delTy argsTy
 
     let bindObjArgs f =
         match objDetails with
@@ -9253,17 +9265,17 @@ and TcEventItemThen cenv overallTy env tpenv mItem mExprAndItem objDetails (einf
     let expr =
         bindObjArgs (fun objVars ->
              //     EventHelper ((fun d -> e.add_X(d)), (fun d -> e.remove_X(d)), (fun f -> new 'Delegate(f)))
-            mkCallCreateEvent g mItem delegateType argsTy
-               (let dv, de = mkCompGenLocal mItem "eventDelegate" delegateType
+            mkCallCreateEvent g mItem delTy argsTy
+               (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy
                 let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.AddMethod NormalValUse [] objVars [de]
                 mkLambda mItem dv (callExpr, g.unit_ty))
-               (let dv, de = mkCompGenLocal mItem "eventDelegate" delegateType
+               (let dv, de = mkCompGenLocal mItem "eventDelegate" delTy
                 let callExpr, _ = BuildPossiblyConditionalMethodCall cenv env PossiblyMutates mItem false einfo.RemoveMethod NormalValUse [] objVars [de]
                 mkLambda mItem dv (callExpr, g.unit_ty))
                (let fvty = mkFunTy g g.obj_ty (mkFunTy g argsTy g.unit_ty)
                 let fv, fe = mkCompGenLocal mItem "callback" fvty
-                let createExpr = BuildNewDelegateExpr (Some einfo, g, cenv.amap, delegateType, invokeMethInfo, compiledViewOfDelArgTys, fe, fvty, mItem)
-                mkLambda mItem fv (createExpr, delegateType)))
+                let createExpr = BuildNewDelegateExpr (Some einfo, g, cenv.amap, delTy, delInvokeMeth, delArgTys, fe, fvty, mItem)
+                mkLambda mItem fv (createExpr, delTy)))
 
     let exprty = delEventTy
     PropagateThenTcDelayed cenv overallTy env tpenv mExprAndItem (MakeApplicableExprNoFlex cenv expr) exprty ExprAtomicFlag.Atomic delayed
@@ -9986,23 +9998,28 @@ and TcMethodArg cenv env (lambdaPropagationInfo, tpenv) (lambdaPropagationInfoFo
 
     CallerArg(callerArgTy, mArg, isOpt, e'), (lambdaPropagationInfo, tpenv)
 
-/// Typecheck "new Delegate(fun x y z -> ...)" constructs
-and TcNewDelegateThen cenv (overallTy: OverallTy) env tpenv mDelTy mExprAndArg delegateTy arg atomicFlag delayed =
+/// Typecheck "Delegate(fun x y z -> ...)" constructs
+and TcNewDelegateThen cenv (overallTy: OverallTy) env tpenv mDelTy mExprAndArg delegateTy synArg atomicFlag delayed =
     let g = cenv.g
     let ad = env.eAccessRights
-    UnifyTypes cenv env mExprAndArg overallTy.Commit delegateTy
-    let (SigOfFunctionForDelegate(invokeMethInfo, delArgTys, _, fty)) = GetSigOfFunctionForDelegate cenv.infoReader delegateTy mDelTy ad
+
+    let intermediateTy = if isNil delayed then overallTy.Commit else NewInferenceType g
+
+    UnifyTypes cenv env mExprAndArg intermediateTy delegateTy
+
+    let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, delFuncTy)) = GetSigOfFunctionForDelegate cenv.infoReader delegateTy mDelTy ad
 
     // We pass isInstance = true here because we're checking the rights to access the "Invoke" method
-    MethInfoChecks g cenv.amap true None [] env.eAccessRights mExprAndArg invokeMethInfo
-    let args = GetMethodArgs arg
+    MethInfoChecks g cenv.amap true None [] env.eAccessRights mExprAndArg delInvokeMeth
 
-    match args with
-    | [farg], [] ->
-        let m = arg.Range
-        let callerArg, (_, tpenv) = TcMethodArg cenv env (Array.empty, tpenv) (Array.empty, CallerArg(fty, m, false, farg))
-        let expr = BuildNewDelegateExpr (None, g, cenv.amap, delegateTy, invokeMethInfo, delArgTys, callerArg.Expr, fty, m)
-        PropagateThenTcDelayed cenv overallTy env tpenv m (MakeApplicableExprNoFlex cenv expr) delegateTy atomicFlag delayed
+    let synArgs = GetMethodArgs synArg
+
+    match synArgs with
+    | [synFuncArg], [] ->
+        let m = synArg.Range
+        let callerArg, (_, tpenv) = TcMethodArg cenv env (Array.empty, tpenv) (Array.empty, CallerArg(delFuncTy, m, false, synFuncArg))
+        let expr = BuildNewDelegateExpr (None, g, cenv.amap, delegateTy, delInvokeMeth, delArgTys, callerArg.Expr, delFuncTy, m)
+        PropagateThenTcDelayed cenv overallTy env tpenv m (MakeApplicableExprNoFlex cenv expr) intermediateTy atomicFlag delayed
     | _ ->
         error(Error(FSComp.SR.tcDelegateConstructorMustBePassed(), mExprAndArg))
 

src/fsharp/InfoReader.fs

@@ -900,38 +900,49 @@ let GetIntrinisicMostSpecificOverrideMethInfoSetsOfType (infoReader: InfoReader)
 /// The Invoke MethInfo, the function argument types, the function return type 
 /// and the overall F# function type for the function type associated with a .NET delegate type
 [<NoEquality;NoComparison>]
-type SigOfFunctionForDelegate = SigOfFunctionForDelegate of MethInfo * TType list * TType * TType
+type SigOfFunctionForDelegate =
+    SigOfFunctionForDelegate of
+        delInvokeMeth: MethInfo *
+        delArgTys: TType list *
+        delRetTy: TType *
+        delFuncTy: TType
 
 /// Given a delegate type work out the minfo, argument types, return type 
 /// and F# function type by looking at the Invoke signature of the delegate. 
 let GetSigOfFunctionForDelegate (infoReader: InfoReader) delty m ad =
     let g = infoReader.g
     let amap = infoReader.amap
-    let invokeMethInfo = 
+    let delInvokeMeth = 
         match GetIntrinsicMethInfosOfType infoReader (Some "Invoke") ad AllowMultiIntfInstantiations.Yes IgnoreOverrides m delty with 
         | [h] -> h
         | [] -> error(Error(FSComp.SR.noInvokeMethodsFound (), m))
         | h :: _ -> warning(InternalError(FSComp.SR.moreThanOneInvokeMethodFound (), m)); h
 
     let minst = []   // a delegate's Invoke method is never generic 
-    let compiledViewOfDelArgTys = 
-        match invokeMethInfo.GetParamTypes(amap, m, minst) with 
+
+    let delArgTys = 
+        match delInvokeMeth.GetParamTypes(amap, m, minst) with 
         | [args] -> args
         | _ -> error(Error(FSComp.SR.delegatesNotAllowedToHaveCurriedSignatures (), m))
+
     let fsharpViewOfDelArgTys = 
-        match compiledViewOfDelArgTys with 
+        match delArgTys with 
         | [] -> [g.unit_ty] 
-        | _ -> compiledViewOfDelArgTys
-    let delRetTy = invokeMethInfo.GetFSharpReturnTy(amap, m, minst)
-    CheckMethInfoAttributes g m None invokeMethInfo |> CommitOperationResult
-    let fty = mkIteratedFunTy g fsharpViewOfDelArgTys delRetTy
-    SigOfFunctionForDelegate(invokeMethInfo, compiledViewOfDelArgTys, delRetTy, fty)
+        | _ -> delArgTys
+
+    let delRetTy = delInvokeMeth.GetFSharpReturnTy(amap, m, minst)
+
+    CheckMethInfoAttributes g m None delInvokeMeth |> CommitOperationResult
+
+    let delFuncTy = mkIteratedFunTy g fsharpViewOfDelArgTys delRetTy
+
+    SigOfFunctionForDelegate(delInvokeMeth, delArgTys, delRetTy, delFuncTy)
 
 /// Try and interpret a delegate type as a "standard" .NET delegate type associated with an event, with a "sender" parameter.
 let TryDestStandardDelegateType (infoReader: InfoReader) m ad delTy =
     let g = infoReader.g
-    let (SigOfFunctionForDelegate(_, compiledViewOfDelArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad
-    match compiledViewOfDelArgTys with 
+    let (SigOfFunctionForDelegate(_, delArgTys, delRetTy, _)) = GetSigOfFunctionForDelegate infoReader delTy m ad
+    match delArgTys with 
     | senderTy :: argTys when (isObjTy g senderTy) && not (List.exists (isByrefTy g) argTys)  -> Some(mkRefTupledTy g argTys, delRetTy)
     | _ -> None
 

src/fsharp/InfoReader.fsi

@@ -159,10 +159,15 @@ val TryFindIntrinsicPropInfo: infoReader:InfoReader -> m:range -> ad:AccessorDom
 /// Get a set of most specific override methods.
 val GetIntrinisicMostSpecificOverrideMethInfoSetsOfType: infoReader:InfoReader -> m:range -> ty:TType -> NameMultiMap<TType * MethInfo>
 
-/// The Invoke MethInfo, the function argument types, the function return type 
+/// Represents information about the delegate - the Invoke MethInfo, the delegate argument types, the delegate return type 
 /// and the overall F# function type for the function type associated with a .NET delegate type
 [<NoEquality; NoComparison>]
-type SigOfFunctionForDelegate = | SigOfFunctionForDelegate of MethInfo * TType list * TType * TType
+type SigOfFunctionForDelegate =
+    SigOfFunctionForDelegate of
+        delInvokeMeth: MethInfo *
+        delArgTys: TType list *
+        delRetTy: TType *
+        delFuncTy: TType
 
 /// Given a delegate type work out the minfo, argument types, return type 
 /// and F# function type by looking at the Invoke signature of the delegate. 

src/fsharp/LowerStateMachines.fs

@@ -229,9 +229,8 @@ type LowerStateMachine(g: TcGlobals) =
                         if sm_verbose then printfn "application was partial, reducing further args %A" laterArgs
                         TryReduceApp env expandedExpr laterArgs
 
-        | NewDelegateExpr g (_, macroParamsCurried, macroBody, _, _) -> 
+        | NewDelegateExpr g (_, macroParams, macroBody, _, _) -> 
             let m = expr.Range
-            let macroParams = List.concat macroParamsCurried
             let macroVal2 = mkLambdas g m [] macroParams (macroBody, tyOfExpr g macroBody)
             if args.Length < macroParams.Length then 
                 //warning(Error(FSComp.SR.stateMachineMacroUnderapplied(), m))

src/fsharp/MethodCalls.fs

@@ -139,10 +139,10 @@ type CallerArgs<'T> =
 
 let AdjustDelegateTy (infoReader: InfoReader) actualTy reqdTy m =
     let g = infoReader.g
-    let (SigOfFunctionForDelegate(_, delArgTys, _, fty)) = GetSigOfFunctionForDelegate infoReader reqdTy m AccessibleFromSomewhere
+    let (SigOfFunctionForDelegate(_, delArgTys, _, delFuncTy)) = GetSigOfFunctionForDelegate infoReader reqdTy m AccessibleFromSomewhere
     let delArgTys = if isNil delArgTys then [g.unit_ty] else delArgTys
     if (fst (stripFunTy g actualTy)).Length = delArgTys.Length then
-        fty 
+        delFuncTy 
     else
         reqdTy 
 
@@ -1208,8 +1208,8 @@ let BuildObjCtorCall (g: TcGlobals) m =
     Expr.Op (TOp.ILCall (false, false, false, false, CtorValUsedAsSuperInit, false, true, ilMethRef, [], [], [g.obj_ty]), [], [], m)
 
 /// Implements the elaborated form of adhoc conversions from functions to delegates at member callsites
-let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, invokeMethInfo: MethInfo, delArgTys, f, fty, m) =
-    let slotsig = invokeMethInfo.GetSlotSig(amap, m)
+let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, delInvokeMeth: MethInfo, delArgTys, delFuncExpr, delFuncTy, m) =
+    let slotsig = delInvokeMeth.GetSlotSig(amap, m)
     let delArgVals, expr = 
         let topValInfo = ValReprInfo([], List.replicate (max 1 (List.length delArgTys)) ValReprInfo.unnamedTopArg, ValReprInfo.unnamedRetVal)
 
@@ -1219,7 +1219,7 @@ let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, i
             if Option.isSome eventInfoOpt then 
                 None 
             else 
-                tryDestTopLambda g amap topValInfo (f, fty)        
+                tryDestTopLambda g amap topValInfo (delFuncExpr, delFuncTy)        
 
         match lambdaContents with 
         | None -> 
@@ -1238,19 +1238,19 @@ let BuildNewDelegateExpr (eventInfoOpt: EventInfo option, g, amap, delegateTy, i
                         | h :: t -> [exprForVal m h; mkRefTupledVars g m t] 
                     | None -> 
                         if isNil delArgTys then [mkUnit g m] else List.map (exprForVal m) delArgVals
-                mkApps g ((f, fty), [], args, m)
+                mkApps g ((delFuncExpr, delFuncTy), [], args, m)
             delArgVals, expr
 
         | Some _ -> 
-            let _, _, _, vsl, body, _ = IteratedAdjustArityOfLambda g amap topValInfo f
+            let _, _, _, vsl, body, _ = IteratedAdjustArityOfLambda g amap topValInfo delFuncExpr
             List.concat vsl, body
 
     let meth = TObjExprMethod(slotsig, [], [], [delArgVals], expr, m)
     mkObjExpr(delegateTy, None, BuildObjCtorCall g m, [meth], [], m)
 
 let CoerceFromFSharpFuncToDelegate g amap infoReader ad callerArgTy m callerArgExpr delegateTy =    
-    let (SigOfFunctionForDelegate(invokeMethInfo, delArgTys, _, _)) = GetSigOfFunctionForDelegate infoReader delegateTy m ad
-    BuildNewDelegateExpr (None, g, amap, delegateTy, invokeMethInfo, delArgTys, callerArgExpr, callerArgTy, m)
+    let (SigOfFunctionForDelegate(delInvokeMeth, delArgTys, _, _)) = GetSigOfFunctionForDelegate infoReader delegateTy m ad
+    BuildNewDelegateExpr (None, g, amap, delegateTy, delInvokeMeth, delArgTys, callerArgExpr, callerArgTy, m)
 
 // Handle adhoc argument conversions
 let rec AdjustExprForTypeDirectedConversions tcVal (g: TcGlobals) amap infoReader ad reqdTy actualTy m expr = 

src/fsharp/MethodCalls.fsi

@@ -328,7 +328,7 @@ val BuildMethodCall:
 val BuildObjCtorCall: g:TcGlobals -> m:range -> Expr
 
 /// Implements the elaborated form of adhoc conversions from functions to delegates at member callsites
-val BuildNewDelegateExpr: eventInfoOpt:EventInfo option * g:TcGlobals * amap:ImportMap * delegateTy:TType * invokeMethInfo:MethInfo * delArgTys:TType list * f:Expr * fty:TType * m:range -> Expr
+val BuildNewDelegateExpr: eventInfoOpt:EventInfo option * g:TcGlobals * amap:ImportMap * delegateTy:TType * delInvokeMeth:MethInfo * delArgTys:TType list * delFuncExpr:Expr * delFuncTy:TType * m:range -> Expr
 
 val CoerceFromFSharpFuncToDelegate: g:TcGlobals -> amap:ImportMap -> infoReader:InfoReader -> ad:AccessorDomain -> callerArgTy:TType -> m:range -> callerArgExpr:Expr -> delegateTy:TType -> Expr
 

src/fsharp/NameResolution.fs

@@ -3897,9 +3897,9 @@ let ResolveCompletionsInType (ncenv: NameResolver) nenv (completionTargets: Reso
         if completionTargets.ResolveAll then
             [ for einfo in einfos do
                 let delegateType = einfo.GetDelegateType(amap, m)
-                let (SigOfFunctionForDelegate(invokeMethInfo, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad
+                let (SigOfFunctionForDelegate(delInvokeMeth, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad
                 // Only events with void return types are suppressed in intellisense.
-                if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then
+                if slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(amap, m)) then
                   yield einfo.AddMethod.DisplayName
                   yield einfo.RemoveMethod.DisplayName ]
         else []
@@ -4620,9 +4620,9 @@ let ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics ty (
 
                 [ for einfo in einfos do
                     let delegateType = einfo.GetDelegateType(amap, m)
-                    let (SigOfFunctionForDelegate(invokeMethInfo, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad
+                    let (SigOfFunctionForDelegate(delInvokeMeth, _, _, _)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad
                     // Only events with void return types are suppressed in intellisense.
-                    if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then
+                    if slotSigHasVoidReturnTy (delInvokeMeth.GetSlotSig(amap, m)) then
                       yield einfo.AddMethod.DisplayName
                       yield einfo.RemoveMethod.DisplayName ]