[Git][ghc/ghc][master] Type-check default declarations before deriving clauses (#24566)
Marge Bot (@marge-bot)
gitlab at gitlab.haskell.org
Fri Mar 22 01:02:28 UTC 2024
Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC
Commits:
52072f8e by Sylvain Henry at 2024-03-21T21:01:59-04:00
Type-check default declarations before deriving clauses (#24566)
See added Note and #24566. Default declarations must be type-checked
before deriving clauses.
- - - - -
5 changed files:
- compiler/GHC/Tc/Module.hs
- libraries/ghc-internal/src/GHC/Internal/Maybe.hs
- testsuite/tests/typecheck/should_compile/Makefile
- + testsuite/tests/typecheck/should_compile/T24566.hs
- testsuite/tests/typecheck/should_compile/all.T
Changes:
=====================================
compiler/GHC/Tc/Module.hs
=====================================
@@ -709,7 +709,7 @@ tcRnHsBootDecls boot_or_sig decls
-- Typecheck type/class/instance decls
; traceTc "Tc2 (boot)" empty
; (tcg_env, inst_infos, _deriv_binds, _th_bndrs)
- <- tcTyClsInstDecls tycl_decls deriv_decls val_binds
+ <- tcTyClsInstDecls tycl_decls deriv_decls def_decls val_binds
; setGblEnv tcg_env $ do {
-- Emit Typeable bindings
@@ -1612,7 +1612,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
traceTc "Tc3" empty ;
(tcg_env, inst_infos, th_bndrs,
XValBindsLR (NValBinds deriv_binds deriv_sigs))
- <- tcTyClsInstDecls tycl_decls deriv_decls val_binds ;
+ <- tcTyClsInstDecls tycl_decls deriv_decls default_decls val_binds ;
updLclCtxt (\tcl_env -> tcl_env { tcl_th_bndrs = th_bndrs `plusNameEnv` tcl_th_bndrs tcl_env }) $
setGblEnv tcg_env $ do {
@@ -1622,11 +1622,6 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
(fi_ids, fi_decls, fi_gres) <- tcForeignImports foreign_decls ;
tcExtendGlobalValEnv fi_ids $ do {
- -- Default declarations
- traceTc "Tc4a" empty ;
- default_tys <- tcDefaults default_decls ;
- updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
-
-- Value declarations next.
-- It is important that we check the top-level value bindings
-- before the GHC-generated derived bindings, since the latter
@@ -1686,13 +1681,14 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
addUsedGREs NoDeprecationWarnings (bagToList fo_gres) ;
return (tcg_env', tcl_env)
- }}}}}}
+ }}}}}
tcTopSrcDecls _ = panic "tcTopSrcDecls: ValBindsIn"
---------------------------
tcTyClsInstDecls :: [TyClGroup GhcRn]
-> [LDerivDecl GhcRn]
+ -> [LDefaultDecl GhcRn]
-> [(RecFlag, LHsBinds GhcRn)]
-> TcM (TcGblEnv, -- The full inst env
[InstInfo GhcRn], -- Source-code instance decls to
@@ -1702,16 +1698,24 @@ tcTyClsInstDecls :: [TyClGroup GhcRn]
HsValBinds GhcRn) -- Supporting bindings for derived
-- instances
-tcTyClsInstDecls tycl_decls deriv_decls binds
+tcTyClsInstDecls tycl_decls deriv_decls default_decls binds
= tcAddDataFamConPlaceholders (tycl_decls >>= group_instds) $
tcAddPatSynPlaceholders (getPatSynBinds binds) $
do { (tcg_env, inst_info, deriv_info, th_bndrs)
<- tcTyAndClassDecls tycl_decls ;
+
; setGblEnv tcg_env $ do {
+
-- With the @TyClDecl at s and @InstDecl at s checked we're ready to
-- process the deriving clauses, including data family deriving
-- clauses discovered in @tcTyAndClassDecls at .
--
+ -- But only after we've typechecked 'default' declarations.
+ -- See Note [Typechecking default declarations]
+ default_tys <- tcDefaults default_decls ;
+ updGblEnv (\gbl -> gbl { tcg_default = default_tys }) $ do {
+
+
-- Careful to quit now in case there were instance errors, so that
-- the deriving errors don't pile up as well.
; failIfErrsM
@@ -1720,7 +1724,7 @@ tcTyClsInstDecls tycl_decls deriv_decls binds
; setGblEnv tcg_env' $ do {
failIfErrsM
; pure ( tcg_env', inst_info' ++ inst_info, th_bndrs, val_binds )
- }}}
+ }}}}
{- *********************************************************************
* *
@@ -3141,3 +3145,43 @@ mark_plugin_unsafe dflags = unless (gopt Opt_PluginTrustworthy dflags) $
pluginUnsafe =
singleMessage $
mkPlainMsgEnvelope diag_opts noSrcSpan TcRnUnsafeDueToPlugin
+
+
+-- Note [Typechecking default declarations]
+-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+-- Typechecking default declarations requires careful placement:
+--
+-- 1. We must check them after types (tcTyAndClassDecls) because they can refer
+-- to them. E.g.
+--
+-- data T = MkT ...
+-- default(Int, T, Integer)
+--
+-- -- or even (tested by T11974b and T2245)
+-- default(Int, T, Integer)
+-- data T = MkT ...
+--
+-- 2. We must check them before typechecking deriving clauses (tcInstDeclsDeriv)
+-- otherwise we may lookup default default types (Integer, Double) while checking
+-- deriving clauses, ignoring the default declaration.
+--
+-- Before this careful placement (#24566), compiling the following example
+-- (T24566) with "-ddump-if-trace -ddump-tc-trace" showed a call to
+-- `applyDefaultingRules` with default types set to "(Integer,Double)":
+--
+-- module M where
+--
+-- import GHC.Classes
+-- default ()
+--
+-- data Foo a = Nothing | Just a
+-- deriving (Eq, Ord)
+--
+-- This was an issue while building modules like M in the ghc-internal package
+-- because they would spuriously fail to build if the module defining Integer
+-- (ghc-bignum:GHC.Num.Integer) wasn't compiled yet and its interface not to be
+-- found. The implicit dependency between M and GHC.Num.Integer isn't known to
+-- the build system.
+-- In addition, trying to explicitly avoid the implicit dependency with `default
+-- ()` didn't work, except if *standalone* deriving was used, which was an
+-- inconsistent behavior.
=====================================
libraries/ghc-internal/src/GHC/Internal/Maybe.hs
=====================================
@@ -28,14 +28,5 @@ default ()
--
data Maybe a = Nothing | Just a
deriving ( Eq -- ^ @since base-2.01
-
- --, Ord -- ^ @since base-2.01
+ , Ord -- ^ @since base-2.01
)
-
--- ???
--- A non-standalone instance will slurp the interface file for GHC.Num.Integer.
- -- During simplifyInstanceContexts, a call to GHC.Tc.Utils.Env.tcGetDefaultTys
- -- apparently sees mb_defaults = Nothing and thus tries to bring in the
- -- default "default" types, including Integer. This seems wrong.
-deriving instance Ord a => Ord (Maybe a) -- ^ @since base-2.01
-
=====================================
testsuite/tests/typecheck/should_compile/Makefile
=====================================
@@ -122,3 +122,7 @@ InlinePatSyn_ExplicitBidiBuilder:
InlinePatSyn_ExplicitBidiMatcher:
$(RM) -f InlinePatSyn_ExplicitBidiMatcher.o InlinePatSyn_ExplicitBidiMatcher.hi
'$(TEST_HC)' $(TEST_HC_OPTS) -c InlinePatSyn_ExplicitBidiMatcher.hs -O -dsuppress-all -ddump-simpl | sed -n '/^test/,/^$$/p' | grep -vq 'Pattern'
+
+T24566:
+ '$(TEST_HC)' $(TEST_HC_OPTS) -c T24566.hs -fno-code -dno-typeable-binds -ddump-if-trace 2>&1 | grep Integer || true
+ # Not expecting any mention of Integer in the interface loading trace
=====================================
testsuite/tests/typecheck/should_compile/T24566.hs
=====================================
@@ -0,0 +1,7 @@
+module M where
+
+import GHC.Classes
+default ()
+
+data Foo a = Nothing | Just a
+ deriving (Eq, Ord)
=====================================
testsuite/tests/typecheck/should_compile/all.T
=====================================
@@ -913,3 +913,4 @@ test('T17594a', req_th, compile, [''])
test('T17594f', normal, compile, [''])
test('WarnDefaultedExceptionContext', normal, compile, ['-Wdefaulted-exception-context'])
test('T24470b', normal, compile, [''])
+test('T24566', [], makefile_test, [])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52072f8e2121fe49a8367027efa3d8db32325f84
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/52072f8e2121fe49a8367027efa3d8db32325f84
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/20240321/ac567ea6/attachment-0001.html>
More information about the ghc-commits
mailing list