diff --git a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md index f05d847075d..62062f7b30e 100644 --- a/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md +++ b/docs/release-notes/.FSharp.Compiler.Service/9.0.100.md @@ -5,6 +5,7 @@ * Optimize simple mappings in comprehensions when the body of the mapping has `let`-bindings and/or sequential expressions before a single yield. ([PR #17419](https://github.com/dotnet/fsharp/pull/17419)) * C# protected property can be assigned in F# inherit constructor call. ([Issue #13299](https://github.com/dotnet/fsharp/issues/13299), [PR #17391](https://github.com/dotnet/fsharp/pull/17391)) * MethodAccessException on equality comparison of a record with private fields. ([Issue #17447](https://github.com/dotnet/fsharp/issues/17447), [PR #17391](https://github.com/dotnet/fsharp/pull/17467)) +* Fix `function` implicit conversion. ([Issue #7401](https://github.com/dotnet/fsharp/issues/7401), [PR #17487](https://github.com/dotnet/fsharp/pull/17487)) * Compiler fails to recognise namespace in FQN with enabled GraphBasedChecking. ([Issue #17508](https://github.com/dotnet/fsharp/issues/17508), [PR #17510](https://github.com/dotnet/fsharp/pull/17510)) ### Added diff --git a/src/Compiler/Checking/Expressions/CheckExpressions.fs b/src/Compiler/Checking/Expressions/CheckExpressions.fs index 585939038fb..4f8ef2b7a61 100644 --- a/src/Compiler/Checking/Expressions/CheckExpressions.fs +++ b/src/Compiler/Checking/Expressions/CheckExpressions.fs @@ -9672,22 +9672,36 @@ and TcMethodApplicationThen PropagateThenTcDelayed cenv overallTy env tpenv mWholeExpr (MakeApplicableExprNoFlex cenv expr) exprTy atomicFlag delayed /// Infer initial type information at the callsite from the syntax of an argument, prior to overload resolution. -and GetNewInferenceTypeForMethodArg (cenv: cenv) env tpenv x = +and GetNewInferenceTypeForMethodArg (cenv: cenv) x = let g = cenv.g - match x with - | SynExprParen(a, _, _, _) -> - GetNewInferenceTypeForMethodArg cenv env tpenv a - | SynExpr.AddressOf (true, a, _, m) -> - mkByrefTyWithInference g (GetNewInferenceTypeForMethodArg cenv env tpenv a) (NewByRefKindInferenceType g m) - | SynExpr.Lambda (body = a) - | SynExpr.DotLambda (expr = a) -> - mkFunTy g (NewInferenceType g) (GetNewInferenceTypeForMethodArg cenv env tpenv a) - | SynExpr.Quote (_, raw, a, _, _) -> - if raw then mkRawQuotedExprTy g - else mkQuotedExprTy g (GetNewInferenceTypeForMethodArg cenv env tpenv a) - | _ -> NewInferenceType g + let rec loopExpr expr cont : struct (_ * _) = + match expr with + | SynExprParen (a, _, _, _) -> + loopExpr a cont + | SynExpr.AddressOf (true, a, _, m) -> + loopExpr a (cont << fun struct (depth, ty) -> depth + 1, mkByrefTyWithInference g ty (NewByRefKindInferenceType g m)) + | SynExpr.Lambda (body = a) + | SynExpr.DotLambda (expr = a) -> + loopExpr a (cont << fun struct (depth, ty) -> depth + 1, mkFunTy g (NewInferenceType g) ty) + | SynExpr.MatchLambda (matchClauses = SynMatchClause (resultExpr = a) :: clauses) -> + let loopClause a = loopExpr a (cont << fun struct (depth, ty) -> depth + 1, mkFunTy g (NewInferenceType g) ty) + + // Look at all branches, keeping the one + // that gives us the most syntactic information. + (loopClause a, clauses) + ||> List.fold (fun ((maxClauseDepth, _) as acc) (SynMatchClause (resultExpr = a)) -> + match loopClause a with + | clauseDepth, ty when clauseDepth > maxClauseDepth -> clauseDepth, ty + | _ -> acc) + | SynExpr.Quote (_, raw, a, _, _) -> + if raw then cont (0, mkRawQuotedExprTy g) + else loopExpr a (cont << fun struct (depth, ty) -> depth + 1, mkQuotedExprTy g ty) + | _ -> cont (0, NewInferenceType g) + + let struct (_depth, ty) = loopExpr x id + ty and CalledMethHasSingleArgumentGroupOfThisLength n (calledMeth: MethInfo) = match calledMeth.NumArgs with @@ -9722,7 +9736,7 @@ and UnifyMatchingSimpleArgumentTypes (cenv: cenv) (env: TcEnv) exprTy (calledMet and TcMethodApplication_SplitSynArguments (cenv: cenv) (env: TcEnv) - tpenv + _tpenv isProp (candidates: MethInfo list) (exprTy: OverallTy) @@ -9750,7 +9764,7 @@ and TcMethodApplication_SplitSynArguments else unnamedCurriedCallerArgs, namedCurriedCallerArgs - let MakeUnnamedCallerArgInfo x = (x, GetNewInferenceTypeForMethodArg cenv env tpenv x, x.Range) + let MakeUnnamedCallerArgInfo x = (x, GetNewInferenceTypeForMethodArg cenv x, x.Range) let singleMethodCurriedArgs = match candidates with @@ -9789,7 +9803,7 @@ and TcMethodApplication_SplitSynArguments | _ -> let unnamedCurriedCallerArgs = unnamedCurriedCallerArgs |> List.mapSquared MakeUnnamedCallerArgInfo let namedCurriedCallerArgs = namedCurriedCallerArgs |> List.mapSquared (fun (isOpt, nm, x) -> - let ty = GetNewInferenceTypeForMethodArg cenv env tpenv x + let ty = GetNewInferenceTypeForMethodArg cenv x // #435263: compiler crash with .net optional parameters and F# optional syntax // named optional arguments should always have option type // STRUCT OPTIONS: if we allow struct options as optional arguments then we should relax this and rely diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadResolutionUsingFunction.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadResolutionUsingFunction.fs new file mode 100644 index 00000000000..33560ae9389 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadResolutionUsingFunction.fs @@ -0,0 +1,42 @@ +open System +let ae = new AggregateException() + +ae.Handle(fun e -> + match e with + | :? OperationCanceledException -> true + | _ -> false + ) + +ae.Handle(function + | :? OperationCanceledException -> true + | _ -> false + ) + +ae.Handle( + Func( + function + | :? OperationCanceledException -> true + | _ -> false + )) + +module M1 = + type T = + static member M (_ : Func) = () + + T.M (function _ -> function :? ArgumentException -> 3 | _ -> 4) + T.M (function 0 -> (function _ -> 3) | _ -> function :? ArgumentException -> 3 | _ -> 4) + +module M2 = + type T = + static member M (_ : Func) = () + + T.M (function 0 -> (function _ -> 1) | _ -> (function 0 -> 3 | _ -> 4)) + T.M (function 0 -> id | _ -> (function 0 -> 3 | _ -> 4)) + T.M (function 0 -> (function 0 -> 3 | _ -> 4) | _ -> id) + +module M3 = + type T = + static member M (_ : Func) = () + + T.M (function 0 -> (function 0 -> (function 0 -> 1 | _ -> 0) | _ -> (function 0 -> 2 | _ -> 3)) | _ -> (function 0 -> (function _ -> 3) | _ -> (function 3 -> 4 | _ -> 5))) + T.M (function 0 -> (function 0 -> id | _ -> (function 0 -> 2 | _ -> 3)) | _ -> (function 0 -> (function _ -> 3) | _ -> (function 3 -> 4 | _ -> 5))) diff --git a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadingMembers.fs b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadingMembers.fs index 1bc2d332247..e0b4c824187 100644 --- a/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadingMembers.fs +++ b/tests/FSharp.Compiler.ComponentTests/Conformance/BasicGrammarElements/MemberDefinitions/OverloadingMembers/OverloadingMembers.fs @@ -229,3 +229,9 @@ module MemberDefinitions_OverloadingMembers = |> withDefines ["TOO_GENERIC"] |> verifyCompileAndRun |> shouldSucceed + + [] + let ``OverloadResolutionUsingFunction_fs`` compilation = + compilation + |> verifyCompileAndRun + |> shouldSucceed