[Git][ghc/ghc][wip/T25281] 3 commits: Wibbles
Simon Peyton Jones (@simonpj)
gitlab at gitlab.haskell.org
Tue Oct 1 11:20:44 UTC 2024
Simon Peyton Jones pushed to branch wip/T25281 at Glasgow Haskell Compiler / GHC
Commits:
315cd26b by Simon Peyton Jones at 2024-10-01T12:11:56+01:00
Wibbles
- - - - -
66a1fde8 by Simon Peyton Jones at 2024-10-01T12:17:46+01:00
Wibble
- - - - -
07c56357 by Simon Peyton Jones at 2024-10-01T12:20:28+01:00
Wibble
- - - - -
3 changed files:
- compiler/GHC/HsToCore/Pmc.hs
- compiler/GHC/Tc/Instance/Class.hs
- compiler/GHC/Tc/TyCl/Utils.hs
Changes:
=====================================
compiler/GHC/HsToCore/Pmc.hs
=====================================
@@ -280,11 +280,9 @@ Here is how we achieve all this in the implementation:
(Remember, the same field may occur in several constructors of the data
type; hence the selector may succeed on more than one constructor.)
-The next three items describe mechanisms for producing warnings on record
-selectors and situations in which they trigger.
-They are ordered by specificity, so we prefer (2) over (3) over (4).
-Item (5) below describes how we resolve the overlap.
-(-XOverloadedRecordDot is discussed separately in Item (6) and (7).)
+We generate warnings for incomplete record selectors in two places:
+* Mainly: in GHC.HsToCore.Expr.ds_app (see (IRS2-5) below)
+* Plus: in GHC.Tc.Instance.Class.matchHassField (see (IRS6-7) below)
(IRS2) In function `ldi`, we have a record selector application `sel arg`.
This situation is detected `GHC.HsToCore.Expr.ds_app_rec_sel`, when the
@@ -305,7 +303,7 @@ Item (5) below describes how we resolve the overlap.
In case of `urgh`, `T1` is indeed the case that we report as inexhaustive.
However, in function `ldi`, we have *both* the result type of
- `arg::T a` (boring, but see (3)) as well as Note [Long-distance information]
+ `arg::T a` (boring, but see (IRS3)) as well as Note [Long-distance information]
about `arg` from the ambient match, and the latter lists the constraint
`arg /~ T1`. Consequently, since `arg` is neither `T1` nor `T2` in the
reduced problem, the match is exhaustive and the use of the record selector
@@ -313,70 +311,52 @@ Item (5) below describes how we resolve the overlap.
(IRS3) In function `resTy`, the record selector is unsaturated, but the result type
ensures a safe use of the selector.
+
This situation is also detected in `GHC.HsToCore.Expr.ds_app_rec_sel`.
THe selector is elaborated with its type arguments; we simply match on
desugared Core `sel @Bool :: T Bool -> Int` to learn the result type `T Bool`.
We again call `pmcRecSel`, but this time with a fresh dummy Id `ds::T Bool`.
(IRS4) In case of an unsaturated record selector that is *not* applied to any type
- argument after elaboration (e.g. in `urgh2 = sel2 :: Dot -> Int`), we simply
- produce a warning about all `sel_cons`; no need to call `pmcRecSel`.
- This happens in the `HsRecSel` case of `dsExpr`.
-
- XXXX: this isn't right, is it? We might have
- data T a where
- T1 :: { sel1 :: Char } -> T Int
- T2 :: T a
- f :: T a -> T Int -> Char
- f T1 = \_ -> 'x'
- f T2 = sel1
-
-We resolve the overlap between situations (2)-(4) by preferring (2) over (3)
-over (4) as follows:
-
-Finally, there are 2 more items addressing -XOverloadedRecordDot:
-
- 6. -XOverloadedRecordDot such as in function `ldiDot` desugars as follows:
- getField @GHC.Types.Symbol
- @"sel2"
- @Dot
- @Int
- ($dHasField :: HasField "sel2" Dot Int)
- d
- where
+ argument after elaboration (e.g. in `urgh2 = sel2 :: Dot -> Int`), we simply
+ produce a warning about all `sel_cons`; no need to call `pmcRecSel`.
+ This happens in `ds_app_rec_sel`
+
+Finally, there are two more items addressing -XOverloadedRecordDot:
+
+(IRS5) With -XOverloadedDot, all occurrences of (r.x), such as in `ldiDot` and
+ `accessDot` above, are warned about as follows. `r.x` is parsed as
+ `HsGetField` in `HsExpr`; which is then expanded (in `rnExpr`) to a call to
+ `getField`. For example, consider:
+ ldiDot No = 0
+ ldiDot x = x.sel2 -- should not warn
+ The `d.sel2` in the RHS generates
+ getField @GHC.Types.Symbol @"sel2" @Dot @Int
+ ($dHasField :: HasField "sel2" Dot Int) x
+ where
$dHasField = sel2 |> (co :: Dot -> Int ~R# HasField "sel2" Dot Int)
- We want to catch these applications in the saturated (2) case.
- (The unsaturated case is handled implicitly by (7).)
- For example, we do not want to generate a warning for function `ldiDot`!
-
- Function `GHC.HsToCore.Expr.ds_app_var` spots the `getField` application,
- and then treats the above expression similar to a vanilla (RecSel app sel2 d).
- This is a bit nasty (it has to do instance lookup) since we cannot look at
- the unfolding of `$dHasField`. Tested in T24891.
-
- 7. For `accessDot` above, `ds_app_var` will fail to find a record selector,
- because type `t` is not obviously a record type.
-
- That's good, because it means we won't emit a warning for `accessDot`.
-
- But we really should emit a warning for `solveDot`! There, the
- compiler solves a `HasField` constraint and without an immediate
- `getField`, roughly `solveDot = accessDot @Dot $d`. It must be the job
- of the solver to warn about incompleteness here, in
- `GHC.Tc.Instance.Class.matchHasField`.
-
- What makes this complicated is that we do not *also* want to warn in the
- example `dot d = d.sel2` above, which is covered by more precise case (6)!
- We suppress the warning in this case as follows:
- 1. The type-checker (`GHC.Tc.Gen.tcApp`) produces `getField @.. $d e`
- (Remember that (6) will detect `getField @.. $d e` as well.)
- 2. Through `tcl_suppress_incomplete_rec_sel`, we suppress warnings when
- solving `$d`.
- 3. ... but not when checking `e`, because `e` might itself be a field
- access that would need to be checked individually.
- 4. What complicates matters is that the solver runs *after* type-checking,
- so we must persist `tcl_suppress_incomplete_rec_sel` in the `CtLocEnv`.
- What a hassle. This is all tested in T24891.
+ We spot this `getField` application in `GHC.HsToCore.Expr.ds_app_var`,
+ and treat it exactly like (IRS2) and (IRS3).
+
+ Note carefully that doing this in the desugarer allows us to account for the
+ long-distance info about `x`; even though `sel2` is partial, we don't want
+ to warn about `x.sel2` in this example.
+
+(IRS6) Finally we have
+ solveDot :: Dot -> Int
+ solveDot = accessDot
+ No field-accesses or selectors in sight! From the RHS we get the constraint
+ [W] HasField @"sel2" @Dot @Int`
+ The only time we can generate a warning is when we solve this constraint,
+ in `GHC.Tc.Instance.Class.matchHasField`, generating a call to the (partial)
+ selector. We have no hope of exploiting long-distance info here.
+
+(IRS7) BUT, look back at `ldiDot`. Doesn't `matchHasField` /also/ generate a
+ warning for the `HasField` constraint arising from `x.sel2`? We don't
+ want that, because the desugarer will catch it: see (IRS5). So we suppress
+ the (IRS6) warning in the typechecker for a `HasField` constraint that
+ arises from a record-dot HsGetField occurrence. Happily, this is easy to do
+ by looking at its `CtOrigin`. Tested in T24891.
-}
pmcRecSel :: Id -- ^ Id of the selector
=====================================
compiler/GHC/Tc/Instance/Class.hs
=====================================
@@ -151,7 +151,7 @@ matchGlobalInst dflags short_cut clas tys mb_loc
| cls_name == typeableClassName = matchTypeable clas tys
| cls_name == withDictClassName = matchWithDict tys
| cls_name == dataToTagClassName = matchDataToTag clas tys
- | cls_name == hasFieldClassName = matchHasField dflags short_cut clas tys mb_loc
+ | cls_name == hasFieldClassName = matchHasField dflags clas tys mb_loc
| cls_name == unsatisfiableClassName = return NoInstance -- See (B) in Note [Implementation of Unsatisfiable constraints] in GHC.Tc.Errors
| otherwise = matchInstEnv dflags short_cut clas tys
where
@@ -1247,9 +1247,10 @@ addUsedGRE extends tcg_used_gres with imported GREs only.
-}
-- See Note [HasField instances]
-matchHasField :: DynFlags -> Bool -> Class -> [Type] -> Maybe CtLoc
+matchHasField :: DynFlags -> Class -> [Type]
+ -> Maybe CtLoc -- Nothing used only during type validity checking
-> TcM ClsInstResult
-matchHasField dflags short_cut clas tys mb_ct_loc
+matchHasField dflags clas tys mb_ct_loc
= do { fam_inst_envs <- tcGetFamInstEnvs
; rdr_env <- getGlobalRdrEnv
; case lookupHasFieldLabel fam_inst_envs rdr_env tys of
@@ -1262,7 +1263,8 @@ matchHasField dflags short_cut clas tys mb_ct_loc
-- the HasField x r a dictionary. The preds will
-- typically be empty, but if the datatype has a
-- "stupid theta" then we have to include it here.
- ; let theta = mkPrimEqPred sel_ty (mkVisFunTyMany r_ty a_ty) : preds
+ ; let tvs = mkTyVarTys (map snd tv_prs)
+ theta = mkPrimEqPred sel_ty (mkVisFunTyMany r_ty a_ty) : preds
-- Use the equality proof to cast the selector Id to
-- type (r -> a), then use the newtype coercion to cast
@@ -1273,35 +1275,41 @@ matchHasField dflags short_cut clas tys mb_ct_loc
`mkTransCo` mkSymCo co2
mk_ev [] = panic "matchHasField.mk_ev"
- Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas)
- tys
-
- tvs = mkTyVarTys (map snd tv_prs)
+ Just (_, co2) = tcInstNewTyCon_maybe (classTyCon clas) tys
-- The selector must not be "naughty" (i.e. the field
- -- cannot have an existentially quantified type), and
- -- it must not be higher-rank.
- ; if not (isNaughtyRecordSelector sel_id) && isTauTy sel_ty
- then do { -- See Note [Unused name reporting and HasField]
- addUsedGRE AllDeprecationWarnings gre
- ; keepAlive sel_name
- ; warnIncompleteRecSel dflags sel_id mb_ct_loc
- ; return OneInst { cir_new_theta = theta
- , cir_mk_ev = mk_ev
- , cir_canonical = EvCanonical
- , cir_what = BuiltinInstance } }
- else matchInstEnv dflags short_cut clas tys }
-
- Nothing -> matchInstEnv dflags short_cut clas tys }
-
-warnIncompleteRecSel :: DynFlags -> Id -> Maybe CtLoc -> TcM ()
-warnIncompleteRecSel dflags sel_id mb_ct_loc
- | Just ct_loc <- mb_ct_loc
- , not (isGetFieldOrigin (ctLocOrigin ct_loc))
+ -- cannot have an existentially quantified type),
+ -- and it must not be higher-rank.
+ ; if (isNaughtyRecordSelector sel_id) && isTauTy sel_ty
+ then return NoInstance
+ else
+ do { case mb_ct_loc of
+ Nothing -> return () -- Nothing: only during type-validity checking
+ Just loc -> setCtLocM loc $ -- Set location for warnings
+ do { -- See Note [Unused name reporting and HasField]
+ addUsedGRE AllDeprecationWarnings gre
+ ; keepAlive sel_name
+
+ -- Warn about incomplete record selection
+ ; warnIncompleteRecSel dflags sel_id loc }
+
+ ; return OneInst { cir_new_theta = theta
+ , cir_mk_ev = mk_ev
+ , cir_canonical = EvCanonical
+ , cir_what = BuiltinInstance } } }
+
+ Nothing -> return NoInstance }
+
+warnIncompleteRecSel :: DynFlags -> Id -> CtLoc -> TcM ()
+-- Warn about incomplete record selectors
+-- See (IRS6) in Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+warnIncompleteRecSel dflags sel_id ct_loc
+ | not (isGetFieldOrigin (ctLocOrigin ct_loc))
+ -- isGetFieldOrigin: see (IRS7) in
+ -- Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
, not (null fallible_cons)
- = traceTc "tc-warn" (ppr sel_id $$ ppr (ctLocOrigin ct_loc)) >>
- (setCtLocM ct_loc $ addDiagnostic $
- TcRnHasFieldResolvedIncomplete (idName sel_id) fallible_cons maxCons)
+ = addDiagnostic $
+ TcRnHasFieldResolvedIncomplete (idName sel_id) fallible_cons maxCons
| otherwise
= return ()
@@ -1320,25 +1328,27 @@ lookupHasFieldLabel
, GlobalRdrElt -- GRE for the selector
, Type -- Type of the record value
, Type ) -- Type of the field of the record
--- The call (lookupHasFieldLabel fam_envs (LitTy "fld") (T t1..tn))
--- returns the `Name` of record selector Id for field "fld" in the data type T.
+-- If possible, decompose application
+-- (HasField @k @rrep @arep @"fld" @(T t1..tn) @fld-ty),
+-- or (getField @k @rrep @arep @"fld" @(T t1..tn) @fld-ty)
+-- and return the pieces, if the record selector is in scope
+--
-- A complication is that `T` might be a data family, so we need to
-- look it up in the `fam_envs` to find its representation tycon.
lookupHasFieldLabel fam_inst_envs rdr_env arg_tys
| -- We are matching HasField {k} {r_rep} {a_rep} x r a...
- (_k_ty : _r_rep : _a_rep : x_ty : r_ty : a_ty : _) <- arg_tys
- -- Look up the field named x in the type r
+ (_k : _rec_rep : _fld_rep : x_ty : rec_ty : fld_ty : _) <- arg_tys
-- x should be a literal string
, Just x <- isStrLitTy x_ty
-- r should be an applied type constructor
- , Just (tc, args) <- tcSplitTyConApp_maybe r_ty
- -- use representation tycon (if data family); it has the fields
+ , Just (tc, args) <- tcSplitTyConApp_maybe rec_ty
+ -- Use the representation tycon (if data family); it has the fields
, let r_tc = fstOf3 (tcLookupDataFamInst fam_inst_envs tc args)
-- x should be a field of r
, Just fl <- lookupTyConFieldLabel (FieldLabelString x) r_tc
- -- and ensure the field selector is in scope
+ -- Ensure the field selector is in scope
, Just gre <- lookupGRE_FieldLabel rdr_env fl
- = Just (flSelector fl, gre, r_ty, a_ty)
+ = Just (flSelector fl, gre, rec_ty, fld_ty)
| otherwise
= Nothing
=====================================
compiler/GHC/Tc/TyCl/Utils.hs
=====================================
@@ -890,7 +890,8 @@ mkOneRecordSelector all_cons idDetails fl has_sel
, sel_naughty = is_naughty
, sel_fieldLabel = fl
, sel_cons = rec_sel_info }
- -- See Note [Detecting incomplete record selectors] in GHC.HsToCore.Pmc
+ -- See (IRS1) in Note [Detecting incomplete record selectors]
+ -- in GHC.HsToCore.Pmc
-- Selector type; Note [Polymorphic selectors]
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec99f417829f3bba5f84ffb59873df3efc8bfe51...07c5635740b840feaf9e677dc8f7c95297619b66
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/ec99f417829f3bba5f84ffb59873df3efc8bfe51...07c5635740b840feaf9e677dc8f7c95297619b66
You're receiving this email because of your account on gitlab.haskell.org.
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20241001/16a04148/attachment-0001.html>
More information about the ghc-commits
mailing list