From d2bca6d361ce50185b62fb86ade44798668c9de2 Mon Sep 17 00:00:00 2001 From: dawe Date: Sun, 21 May 2023 22:17:12 +0200 Subject: [PATCH 1/5] preserve ranges in result of UnsolvedTyparsOfModuleDef to help with warnings --- src/Compiler/Checking/FindUnsolved.fs | 61 ++++++++++++++------------- 1 file changed, 32 insertions(+), 29 deletions(-) diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index 3a3b8c9de89..0f5a98a7a02 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -8,6 +8,7 @@ open Internal.Utilities.Library open Internal.Utilities.Library.Extras open FSharp.Compiler open FSharp.Compiler.DiagnosticsLogger +open FSharp.Compiler.Text open FSharp.Compiler.TypedTree open FSharp.Compiler.TypedTreeBasics open FSharp.Compiler.TypedTreeOps @@ -29,14 +30,16 @@ type cenv = override _.ToString() = "" /// Walk types, collecting type variables -let accTy cenv _env ty = +let accTy cenv _env (r: Range option) ty = let normalizedTy = tryNormalizeMeasureInType cenv.g ty (freeInType CollectTyparsNoCaching normalizedTy).FreeTypars |> Zset.iter (fun tp -> - if (tp.Rigidity <> TyparRigidity.Rigid) then + if (tp.Rigidity <> TyparRigidity.Rigid) then + if Option.isSome r then + tp.SetIdent (FSharp.Compiler.Syntax.Ident(tp.typar_id.idText, r.Value)) cenv.unsolved <- tp :: cenv.unsolved) let accTypeInst cenv env tyargs = - tyargs |> List.iter (accTy cenv env) + tyargs |> List.iter (accTy cenv env None) /// Walk expressions, collecting type variables let rec accExpr (cenv: cenv) (env: env) expr = @@ -52,17 +55,17 @@ let rec accExpr (cenv: cenv) (env: env) expr = accBind cenv env bind accExpr cenv env body - | Expr.Const (_, _, ty) -> - accTy cenv env ty + | Expr.Const (_, r, ty) -> + accTy cenv env (Some r) ty | Expr.Val (_v, _vFlags, _m) -> () - | Expr.Quote (ast, _, _, _m, ty) -> + | Expr.Quote (ast, _, _, m, ty) -> accExpr cenv env ast - accTy cenv env ty + accTy cenv env (Some m) ty - | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, _m) -> - accTy cenv env ty + | Expr.Obj (_, ty, basev, basecall, overrides, iimpls, m) -> + accTy cenv env (Some m) ty accExpr cenv env basecall accMethods cenv env basev overrides accIntfImpls cenv env basev iimpls @@ -77,8 +80,8 @@ let rec accExpr (cenv: cenv) (env: env) expr = | Expr.Op (c, tyargs, args, m) -> accOp cenv env (c, tyargs, args, m) - | Expr.App (f, fty, tyargs, argsl, _m) -> - accTy cenv env fty + | Expr.App (f, fty, tyargs, argsl, m) -> + accTy cenv env (Some m) fty accTypeInst cenv env tyargs accExpr cenv env f accExprs cenv env argsl @@ -88,9 +91,9 @@ let rec accExpr (cenv: cenv) (env: env) expr = let ty = mkMultiLambdaTy cenv.g m argvs bodyTy accLambdas cenv env valReprInfo expr ty - | Expr.TyLambda (_, tps, _body, _m, bodyTy) -> + | Expr.TyLambda (_, tps, _body, m, bodyTy) -> let valReprInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal) - accTy cenv env bodyTy + accTy cenv env (Some m) bodyTy let ty = mkForallTyIfNeeded tps bodyTy accLambdas cenv env valReprInfo expr ty @@ -98,7 +101,7 @@ let rec accExpr (cenv: cenv) (env: env) expr = accExpr cenv env e1 | Expr.Match (_, _exprm, dtree, targets, m, ty) -> - accTy cenv env ty + accTy cenv env (Some m) ty accDTree cenv env dtree accTargets cenv env m ty targets @@ -106,15 +109,15 @@ let rec accExpr (cenv: cenv) (env: env) expr = accBinds cenv env binds accExpr cenv env e - | Expr.StaticOptimization (constraints, e2, e3, _m) -> + | Expr.StaticOptimization (constraints, e2, e3, m) -> accExpr cenv env e2 accExpr cenv env e3 constraints |> List.iter (function | TTyconEqualsTycon(ty1, ty2) -> - accTy cenv env ty1 - accTy cenv env ty2 + accTy cenv env (Some m) ty1 + accTy cenv env (Some m) ty2 | TTyconIsStruct(ty1) -> - accTy cenv env ty1) + accTy cenv env (Some m) ty1) | Expr.WitnessArg (traitInfo, _m) -> accTraitInfo cenv env traitInfo @@ -136,7 +139,7 @@ and accIntfImpls cenv env baseValOpt l = List.iter (accIntfImpl cenv env baseValOpt) l and accIntfImpl cenv env baseValOpt (ty, overrides) = - accTy cenv env ty + accTy cenv env None ty accMethods cenv env baseValOpt overrides and accOp cenv env (op, tyargs, args, _m) = @@ -158,16 +161,16 @@ and accOp cenv env (op, tyargs, args, _m) = and accTraitInfo cenv env (TTrait(tys, _nm, _, argTys, retTy, _sln)) = argTys |> accTypeInst cenv env - retTy |> Option.iter (accTy cenv env) - tys |> List.iter (accTy cenv env) + retTy |> Option.iter (accTy cenv env None) + tys |> List.iter (accTy cenv env None) and accLambdas cenv env valReprInfo expr exprTy = match stripDebugPoints expr with | Expr.TyChoose (_tps, bodyExpr, _m) -> accLambdas cenv env valReprInfo bodyExpr exprTy - | Expr.Lambda _ - | Expr.TyLambda _ -> + | Expr.Lambda (range = range) + | Expr.TyLambda (range = range) -> let _tps, ctorThisValOpt, baseValOpt, vsl, body, bodyTy = destLambdaWithValReprInfo cenv.g cenv.amap valReprInfo (expr, exprTy) - accTy cenv env bodyTy + accTy cenv env (Some range) bodyTy vsl |> List.iterSquared (accVal cenv env) baseValOpt |> Option.iter (accVal cenv env) ctorThisValOpt |> Option.iter (accVal cenv env) @@ -198,23 +201,23 @@ and accSwitch cenv env (e, cases, dflt, _m) = and accDiscrim cenv env d = match d with | DecisionTreeTest.UnionCase(_ucref, tinst) -> accTypeInst cenv env tinst - | DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env ty + | DecisionTreeTest.ArrayLength(_, ty) -> accTy cenv env None ty | DecisionTreeTest.Const _ | DecisionTreeTest.IsNull -> () - | DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env srcTy; accTy cenv env tgtTy + | DecisionTreeTest.IsInst (srcTy, tgtTy) -> accTy cenv env None srcTy; accTy cenv env None tgtTy | DecisionTreeTest.ActivePatternCase (exp, tys, _, _, _, _) -> accExpr cenv env exp accTypeInst cenv env tys | DecisionTreeTest.Error _ -> () -and accAttrib cenv env (Attrib(_, _k, args, props, _, _, _m)) = +and accAttrib cenv env (Attrib(_, _k, args, props, _, _, m)) = args |> List.iter (fun (AttribExpr(expr1, expr2)) -> accExpr cenv env expr1 accExpr cenv env expr2) props |> List.iter (fun (AttribNamedArg(_nm, ty, _flg, AttribExpr(expr, expr2))) -> accExpr cenv env expr accExpr cenv env expr2 - accTy cenv env ty) + accTy cenv env (Some m) ty) and accAttribs cenv env attribs = List.iter (accAttrib cenv env) attribs @@ -229,7 +232,7 @@ and accArgReprInfo cenv env (argInfo: ArgReprInfo) = and accVal cenv env v = v.Attribs |> accAttribs cenv env v.ValReprInfo |> Option.iter (accValReprInfo cenv env) - v.Type |> accTy cenv env + v.Type |> accTy cenv env None and accBind cenv env (bind: Binding) = accVal cenv env bind.Var From 446f61265e134d94652d4fab51fc649d7c1b7c8b Mon Sep 17 00:00:00 2001 From: dawe Date: Mon, 22 May 2023 00:09:24 +0200 Subject: [PATCH 2/5] use fallback range only for range0 --- src/Compiler/Checking/FindUnsolved.fs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index 0f5a98a7a02..fbaf55066e4 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -30,12 +30,12 @@ type cenv = override _.ToString() = "" /// Walk types, collecting type variables -let accTy cenv _env (r: Range option) ty = +let accTy cenv _env (fallbackRange: Range option) ty = let normalizedTy = tryNormalizeMeasureInType cenv.g ty (freeInType CollectTyparsNoCaching normalizedTy).FreeTypars |> Zset.iter (fun tp -> if (tp.Rigidity <> TyparRigidity.Rigid) then - if Option.isSome r then - tp.SetIdent (FSharp.Compiler.Syntax.Ident(tp.typar_id.idText, r.Value)) + if Option.isSome fallbackRange && tp.Range = Range.range0 then + tp.SetIdent (FSharp.Compiler.Syntax.Ident(tp.typar_id.idText, fallbackRange.Value)) cenv.unsolved <- tp :: cenv.unsolved) let accTypeInst cenv env tyargs = From 69df3a7c1da686668d1807efded7873c5ec00716 Mon Sep 17 00:00:00 2001 From: dawe Date: Tue, 23 May 2023 16:05:32 +0200 Subject: [PATCH 3/5] pattern match instead of Option.isSome --- src/Compiler/Checking/FindUnsolved.fs | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/src/Compiler/Checking/FindUnsolved.fs b/src/Compiler/Checking/FindUnsolved.fs index fbaf55066e4..26b34d50b19 100644 --- a/src/Compiler/Checking/FindUnsolved.fs +++ b/src/Compiler/Checking/FindUnsolved.fs @@ -34,8 +34,9 @@ let accTy cenv _env (fallbackRange: Range option) ty = let normalizedTy = tryNormalizeMeasureInType cenv.g ty (freeInType CollectTyparsNoCaching normalizedTy).FreeTypars |> Zset.iter (fun tp -> if (tp.Rigidity <> TyparRigidity.Rigid) then - if Option.isSome fallbackRange && tp.Range = Range.range0 then - tp.SetIdent (FSharp.Compiler.Syntax.Ident(tp.typar_id.idText, fallbackRange.Value)) + match fallbackRange with + | Some r when tp.Range = Range.range0 -> tp.SetIdent (FSharp.Compiler.Syntax.Ident(tp.typar_id.idText, r)) + | _ -> () cenv.unsolved <- tp :: cenv.unsolved) let accTypeInst cenv env tyargs = From e05e808ec964c5df1f0d2c4a6a5f265b0f52fe9b Mon Sep 17 00:00:00 2001 From: dawe Date: Tue, 23 May 2023 16:06:38 +0200 Subject: [PATCH 4/5] Add test --- .../FSharp.Compiler.ComponentTests.fsproj | 1 + .../Miscellaneous/FindUnsolvedTests.fs | 13 +++++++++++++ 2 files changed, 14 insertions(+) create mode 100644 tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index a83d57f55a5..5ae695105f0 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -233,6 +233,7 @@ + diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs new file mode 100644 index 00000000000..24ac0962b17 --- /dev/null +++ b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs @@ -0,0 +1,13 @@ +// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. + +module FSharp.Compiler.ComponentTests.Miscellaneous.FindUnsolvedTests + +open Xunit +open FSharp.Test.Compiler + +[] +let ``fallbackRange being set in FindUnsolved`` () = + FSharp + """let f<'b> () : 'b = (let a = failwith "" in unbox a)""" + |> typecheckResults + |> ignore From e8e9aeaaafd18d097229d2f78dd637981c92a123 Mon Sep 17 00:00:00 2001 From: dawe Date: Tue, 23 May 2023 16:09:58 +0200 Subject: [PATCH 5/5] Revert "Add test" This reverts commit e05e808ec964c5df1f0d2c4a6a5f265b0f52fe9b. --- .../FSharp.Compiler.ComponentTests.fsproj | 1 - .../Miscellaneous/FindUnsolvedTests.fs | 13 ------------- 2 files changed, 14 deletions(-) delete mode 100644 tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs diff --git a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj index 5ae695105f0..a83d57f55a5 100644 --- a/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj +++ b/tests/FSharp.Compiler.ComponentTests/FSharp.Compiler.ComponentTests.fsproj @@ -233,7 +233,6 @@ - diff --git a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs b/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs deleted file mode 100644 index 24ac0962b17..00000000000 --- a/tests/FSharp.Compiler.ComponentTests/Miscellaneous/FindUnsolvedTests.fs +++ /dev/null @@ -1,13 +0,0 @@ -// Copyright (c) Microsoft Corporation. All Rights Reserved. See License.txt in the project root for license information. - -module FSharp.Compiler.ComponentTests.Miscellaneous.FindUnsolvedTests - -open Xunit -open FSharp.Test.Compiler - -[] -let ``fallbackRange being set in FindUnsolved`` () = - FSharp - """let f<'b> () : 'b = (let a = failwith "" in unbox a)""" - |> typecheckResults - |> ignore