Commit 25b70a29 authored by Edward Z. Yang's avatar Edward Z. Yang

Check family instance consistency of hs-boot families later, fixes #11062.

Summary:
With hs-boot files, some type families may be defined in the
module we are typechecking.  In this case, we are not allowed
to poke these families until after we typecheck our local
declarations.  So we first check everything involving non-recursive
families, and then check the recursive families as we finish
kind-checking them.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>

Test Plan: validate

Reviewers: goldfire, austin, simonpj, bgamari

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D2859

GHC Trac Issues: #11062
parent 52ba9470
......@@ -7,6 +7,7 @@ module FamInst (
checkFamInstConsistency, tcExtendLocalFamInstEnv,
tcLookupDataFamInst, tcLookupDataFamInst_maybe,
tcInstNewTyCon_maybe, tcTopNormaliseNewTypeTF_maybe,
checkRecFamInstConsistency,
newFamInst,
-- * Injectivity
......@@ -41,8 +42,10 @@ import VarSet
import Bag( Bag, unionBags, unitBag )
import Control.Monad
import Unique
import NameEnv
import Data.Set (Set)
import qualified Data.Set as Set
import Data.List
#include "HsVersions.h"
......@@ -116,6 +119,9 @@ modules where both modules occur in the `HscTypes.dep_finsts' set (of the
`HscTypes.Dependencies') of one of our directly imported modules must have
already been checked. Everything else, we check now. (So that we can be
certain that the modules in our `HscTypes.dep_finsts' are consistent.)
There is some fancy footwork regarding hs-boot module loops, see
Note [Don't check hs-boot type family instances too early]
-}
-- The optimisation of overlap tests is based on determining pairs of modules
......@@ -181,7 +187,14 @@ listToSet l = Set.fromList l
--
-- See Note [Checking family instance consistency] for more
-- details.
checkFamInstConsistency :: [Module] -> [Module] -> TcM ()
--
-- This function doesn't check ALL instances for consistency,
-- only ones that aren't involved in recursive knot-tying
-- loops; see Note [Don't check hs-boot type family instances too early].
-- It returns a modified 'TcGblEnv' that has saved the
-- instances that need to be checked later; use 'checkRecFamInstConsistency'
-- to check those.
checkFamInstConsistency :: [Module] -> [Module] -> TcM TcGblEnv
checkFamInstConsistency famInstMods directlyImpMods
= do { dflags <- getDynFlags
; (eps, hpt) <- getEpsAndHpt
......@@ -210,7 +223,10 @@ checkFamInstConsistency famInstMods directlyImpMods
-- See Note [ModulePairSet determinism and performance]
}
; mapM_ (check hpt_fam_insts) toCheckPairs
; pending_checks <- mapM (check hpt_fam_insts) toCheckPairs
; tcg_env <- getGblEnv
; return tcg_env { tcg_pending_fam_checks
= foldl' (plusNameEnv_C (++)) emptyNameEnv pending_checks }
}
where
allPairs [] = []
......@@ -219,12 +235,57 @@ checkFamInstConsistency famInstMods directlyImpMods
check hpt_fam_insts (ModulePair m1 m2)
= do { env1 <- getFamInsts hpt_fam_insts m1
; env2 <- getFamInsts hpt_fam_insts m2
; mapM_ (checkForConflicts (emptyFamInstEnv, env2))
(famInstEnvElts env1)
; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2))
(famInstEnvElts env1)
-- Note [Don't check hs-boot type family instances too early]
-- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-- Family instance consistency checking involves checking that
-- the family instances of our imported modules are consistent with
-- one another; this might lead you to think that this process
-- has nothing to do with the module we are about to typecheck.
-- Not so! If a type family was defined in the hs-boot file
-- of the current module, we are NOT allowed to poke the TyThing
-- for this family: since we haven't typechecked the definition
-- yet (checkFamInstConsistency is called during renaming),
-- we won't be able to find our local copy in if_rec_types.
-- Failing to do this lead to #11062.
--
-- So, we have to defer the checks for family instances that
-- refer to families that are locally defined.
--
-- See also Note [Tying the knot] and Note [Type-checking inside the knot]
-- for why we are doing this at all.
; this_mod <- getModule
; let (check_now, check_later)
-- NB: == this_mod only holds if there's an hs-boot file;
-- otherwise we cannot possible see instances for families
-- *defined by the module we are compiling* in imports.
= partition ((/= this_mod) . nameModule . fi_fam)
(famInstEnvElts env1)
; mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
; mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now
; let check_later_map =
extendNameEnvList_C (++) emptyNameEnv
[(fi_fam finst, [finst]) | finst <- check_later]
; return (mapNameEnv (\xs -> [(xs, env2)]) check_later_map)
}
-- | Given a 'TyCon' that has been incorporated into the type
-- environment (the knot is tied), if it is a type family, check
-- that all deferred instances for it are consistent.
-- See Note [Don't check hs-boot type family instances too early]
checkRecFamInstConsistency :: TyCon -> TcM ()
checkRecFamInstConsistency tc = do
tcg_env <- getGblEnv
let checkConsistency tc
| isFamilyTyCon tc
, Just pairs <- lookupNameEnv (tcg_pending_fam_checks tcg_env)
(tyConName tc)
= forM_ pairs $ \(check_now, env2) -> do
mapM_ (checkForConflicts (emptyFamInstEnv, env2)) check_now
mapM_ (checkForInjectivityConflicts (emptyFamInstEnv,env2)) check_now
| otherwise
= return ()
checkConsistency tc
getFamInsts :: ModuleEnv FamInstEnv -> Module -> TcM FamInstEnv
getFamInsts hpt_fam_insts mod
......
......@@ -347,9 +347,9 @@ tcRnImports hsc_env import_decls
; let { dir_imp_mods = moduleEnvKeys
. imp_mods
$ imports }
; checkFamInstConsistency (imp_finsts imports) dir_imp_mods ;
; tcg_env <- checkFamInstConsistency (imp_finsts imports) dir_imp_mods ;
; getGblEnv } }
; return tcg_env } }
{-
************************************************************************
......
......@@ -252,6 +252,7 @@ initTc hsc_env hsc_src keep_rn_syntax mod loc do_this
tcg_type_env_var = type_env_var,
tcg_inst_env = emptyInstEnv,
tcg_fam_inst_env = emptyFamInstEnv,
tcg_pending_fam_checks = emptyNameEnv,
tcg_ann_env = emptyAnnEnv,
tcg_th_used = th_var,
tcg_th_splice_used = th_splice_var,
......
......@@ -501,6 +501,13 @@ data TcGblEnv
tcg_fam_inst_env :: FamInstEnv, -- ^ Ditto for family instances
tcg_ann_env :: AnnEnv, -- ^ And for annotations
-- | Family instances we have to check for consistency.
-- Invariant: each FamInst in the list's fi_fam matches the
-- key of the entry in the 'NameEnv'. This gets consumed
-- by 'checkRecFamInstConsistency'.
-- See Note [Don't check hs-boot type family instances too early]
tcg_pending_fam_checks :: NameEnv [([FamInst], FamInstEnv)],
-- Now a bunch of things about this module that are simply
-- accumulated, but never consulted until the end.
-- Nevertheless, it's convenient to accumulate them along
......
......@@ -155,6 +155,10 @@ tcTyClGroup (TyClGroup { group_tyclds = tyclds
; checkSynCycles this_uid tyclss tyclds
; traceTc "Done synonym cycle check" (ppr tyclss)
; traceTc "Starting family consistency check" (ppr tyclss)
; forM_ tyclss checkRecFamInstConsistency
; traceTc "Done family consistency" (ppr tyclss)
-- Step 2: Perform the validity check on those types/classes
-- We can do this now because we are done with the recursive knot
-- Do it before Step 3 (adding implicit things) because the latter
......
......@@ -60,6 +60,7 @@ extra_src_files = {
'T10955dyn': ['A.c', 'B.c'],
'T10971d': ['T10971c.hs'],
'T11018': ['Test11018.hs'],
'T11062': ['T11062.hs','T11062.hs-boot','T11062a.hs'],
'T11072gcc': ['A.c', 'T11072.hs'],
'T11072msvc': ['A.c', 'T11072.hs', 'libAS.def', 'i686/', 'x86_64/'],
'T11223_link_order_a_b_2_fail': ['bar.c', 'foo.c', 'foo3.hs'],
......
{-# LANGUAGE TypeFamilies #-}
module T11062 where
import T11062a
type family F a
{-# LANGUAGE TypeFamilies #-}
module T11062 where
type family F a
{-# LANGUAGE TypeFamilies #-}
module T11062a where
import {-# SOURCE #-} T11062
type instance F Int = Bool
......@@ -497,6 +497,8 @@ test('T10770a', expect_broken(10770), compile, [''])
test('T10770b', expect_broken(10770), compile, [''])
test('T10935', normal, compile, [''])
test('T10971a', normal, compile, [''])
test('T11062', extra_clean(['T11062.hi-boot', 'T11062.o-boot', 'T11062a.hi', 'T11062a.o']),
multimod_compile, ['T11062', '-v0'])
test('T11237', normal, compile, [''])
test('T10592', normal, compile, [''])
test('T11305', normal, compile, [''])
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment