Commit 353d8ae6 authored by Simon Peyton Jones's avatar Simon Peyton Jones

SCC analysis for instances as well as types/classes

This big patch is in pursuit of Trac #11348.

It is largely the work of Alex Veith (thank you!), with some
follow-up simplification and refactoring from Simon PJ.

The main payload is described in RnSource
  Note [Dependency analysis of type, class, and instance decls]
which is pretty detailed.

* There is a new data type HsDecls.TyClGroup, for a strongly
  connected component of type/class/instance/role decls.

  The hs_instds field of HsGroup disappears, in consequence

  This forces some knock-on changes, including a minor
  haddock submodule update

Smaller, weakly-related things

* I found that both the renamer and typechecker were building an
  identical env for RoleAnnots, so I put common code for
  RoleAnnotEnv in RnEnv.

* I found that tcInstDecls1 had very clumsy error handling, so I
  put it together into TcInstDcls.doClsInstErrorChecks
parent 7319b80a
......@@ -110,7 +110,6 @@ repTopDs :: HsGroup Name -> DsM (Core (TH.Q [TH.Dec]))
repTopDs group@(HsGroup { hs_valds = valds
, hs_splcds = splcds
, hs_tyclds = tyclds
, hs_instds = instds
, hs_derivds = derivds
, hs_fixds = fixds
, hs_defds = defds
......@@ -121,7 +120,8 @@ repTopDs group@(HsGroup { hs_valds = valds
, hs_vects = vects
, hs_docs = docs })
= do { let { tv_bndrs = hsSigTvBinders valds
; bndrs = tv_bndrs ++ hsGroupBinders group } ;
; bndrs = tv_bndrs ++ hsGroupBinders group
; instds = tyclds >>= group_instds } ;
ss <- mkGenSyms bndrs ;
-- Bind all the names mainly to avoid repeated use of explicit strings.
......@@ -134,7 +134,7 @@ repTopDs group@(HsGroup { hs_valds = valds
decls <- addBinds ss (
do { val_ds <- rep_val_binds valds
; _ <- mapM no_splice splcds
; tycl_ds <- mapM repTyClD (tyClGroupConcat tyclds)
; tycl_ds <- mapM repTyClD (tyClGroupTyClDecls tyclds)
; role_ds <- mapM repRoleD (concatMap group_roles tyclds)
; inst_ds <- mapM repInstD instds
; deriv_ds <- mapM repStandaloneDerivD derivds
......
This diff is collapsed.
......@@ -80,6 +80,7 @@ module HsUtils(
hsLTyClDeclBinders, hsTyClForeignBinders, hsPatSynBinders,
hsForeignDeclsBinders, hsGroupBinders, hsDataFamInstBinders,
hsDataDefnBinders,
-- Collecting implicit binders
lStmtsImplicits, hsValBindsImplicits, lPatImplicits
......@@ -883,18 +884,21 @@ So in mkSelectorBinds in DsUtils, we want just m,n as the variables bound.
hsGroupBinders :: HsGroup Name -> [Name]
hsGroupBinders (HsGroup { hs_valds = val_decls, hs_tyclds = tycl_decls,
hs_instds = inst_decls, hs_fords = foreign_decls })
hs_fords = foreign_decls })
= collectHsValBinders val_decls
++ hsTyClForeignBinders tycl_decls inst_decls foreign_decls
++ hsTyClForeignBinders tycl_decls foreign_decls
hsTyClForeignBinders :: [TyClGroup Name] -> [LInstDecl Name]
-> [LForeignDecl Name] -> [Name]
hsTyClForeignBinders :: [TyClGroup Name]
-> [LForeignDecl Name]
-> [Name]
-- We need to look at instance declarations too,
-- because their associated types may bind data constructors
hsTyClForeignBinders tycl_decls inst_decls foreign_decls
= map unLoc (hsForeignDeclsBinders foreign_decls)
++ getSelectorNames (foldMap (foldMap hsLTyClDeclBinders . group_tyclds) tycl_decls
`mappend` foldMap hsLInstDeclBinders inst_decls)
hsTyClForeignBinders tycl_decls foreign_decls
= map unLoc (hsForeignDeclsBinders foreign_decls)
++ getSelectorNames
(foldMap (foldMap hsLTyClDeclBinders . group_tyclds) tycl_decls
`mappend`
foldMap (foldMap hsLInstDeclBinders . group_instds) tycl_decls)
where
getSelectorNames :: ([Located Name], [LFieldOcc Name]) -> [Name]
getSelectorNames (ns, fs) = map unLoc ns ++ map (selectorFieldOcc.unLoc) fs
......@@ -902,6 +906,7 @@ hsTyClForeignBinders tycl_decls inst_decls foreign_decls
-------------------
hsLTyClDeclBinders :: Located (TyClDecl name) -> ([Located name], [LFieldOcc name])
-- ^ Returns all the /binding/ names of the decl. The first one is
-- guaranteed to be the name of the decl. The first component
-- represents all binding names except record fields; the second
-- represents field occurrences. For record fields mentioned in
......
......@@ -118,7 +118,7 @@ import Data.Data ( dataTypeOf, fromConstr, dataTypeConstrs )
-- Similarly for mkConDecl, mkClassOpSig and default-method names.
-- *** See "THE NAMING STORY" in HsDecls ****
-- *** See Note [The Naming story] in HsDecls ****
mkTyClD :: LTyClDecl n -> LHsDecl n
mkTyClD (L loc d) = L loc (TyClD d)
......
......@@ -37,6 +37,10 @@ module RnEnv (
bindLocatedLocalsFV, bindLocatedLocalsRn,
extendTyVarEnvFVRn,
-- Role annotations
RoleAnnotEnv, emptyRoleAnnotEnv, mkRoleAnnotEnv,
lookupRoleAnnot, getRoleAnnots,
checkDupRdrNames, checkShadowedRdrNames,
checkDupNames, checkDupAndShadowedNames, dupNamesErr,
checkTupSize,
......@@ -1535,6 +1539,35 @@ lookupFieldFixityRn (Ambiguous (L _ rdr) _) = get_ambiguous_fixity rdr
2 (pprNameProvenance elt)
{- *********************************************************************
* *
Role annotations
* *
********************************************************************* -}
type RoleAnnotEnv = NameEnv (LRoleAnnotDecl Name)
mkRoleAnnotEnv :: [LRoleAnnotDecl Name] -> RoleAnnotEnv
mkRoleAnnotEnv role_annot_decls
= mkNameEnv [ (name, ra_decl)
| ra_decl <- role_annot_decls
, let name = roleAnnotDeclName (unLoc ra_decl)
, not (isUnboundName name) ]
-- Some of the role annots will be unbound;
-- we don't wish to include these
emptyRoleAnnotEnv :: RoleAnnotEnv
emptyRoleAnnotEnv = emptyNameEnv
lookupRoleAnnot :: RoleAnnotEnv -> Name -> Maybe (LRoleAnnotDecl Name)
lookupRoleAnnot = lookupNameEnv
getRoleAnnots :: [Name] -> RoleAnnotEnv -> ([LRoleAnnotDecl Name], RoleAnnotEnv)
getRoleAnnots bndrs role_env
= ( mapMaybe (lookupRoleAnnot role_env) bndrs
, delListFromNameEnv role_env bndrs )
{-
************************************************************************
* *
......
......@@ -526,7 +526,7 @@ extendGlobalRdrEnvRn avails new_fixities
getLocalDeclBindersd@ returns the names for an HsDecl
It's used for source code.
*** See "THE NAMING STORY" in HsDecls ****
*** See Note [The Naming story] in HsDecls ****
* *
********************************************************************* -}
......@@ -544,12 +544,13 @@ getLocalNonValBinders :: MiniFixityEnv -> HsGroup RdrName
getLocalNonValBinders fixity_env
(HsGroup { hs_valds = binds,
hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_fords = foreign_decls })
= do { -- Process all type/class decls *except* family instances
; let inst_decls = tycl_decls >>= group_instds
; overload_ok <- xoptM LangExt.DuplicateRecordFields
; (tc_avails, tc_fldss) <- fmap unzip $ mapM (new_tc overload_ok)
(tyClGroupConcat tycl_decls)
; (tc_avails, tc_fldss)
<- fmap unzip $ mapM (new_tc overload_ok)
(tyClGroupTyClDecls tycl_decls)
; traceRn (text "getLocalNonValBinders 1" <+> ppr tc_avails)
; envs <- extendGlobalRdrEnvRn tc_avails fixity_env
; setEnvs envs $ do {
......
This diff is collapsed.
......@@ -340,11 +340,9 @@ data DerivInfo = DerivInfo { di_rep_tc :: TyCon
}
-- | Extract `deriving` clauses of proper data type (skips data families)
mkDerivInfos :: [TyClGroup Name] -> TcM [DerivInfo]
mkDerivInfos tycls = concatMapM mk_derivs tycls
mkDerivInfos :: [LTyClDecl Name] -> TcM [DerivInfo]
mkDerivInfos decls = concatMapM (mk_deriv . unLoc) decls
where
mk_derivs (TyClGroup { group_tyclds = decls })
= concatMapM (mk_deriv . unLoc) decls
mk_deriv decl@(DataDecl { tcdLName = L _ data_name
, tcdDataDefn =
......@@ -2167,7 +2165,6 @@ genInst spec@(DS { ds_tvs = tvs, ds_tc = rep_tycon
, ds_name = dfun_name, ds_cls = clas, ds_loc = loc })
| Just rhs_ty <- is_newtype -- See Note [Bindings for Generalised Newtype Deriving]
= do { inst_spec <- newDerivClsInst theta spec
; traceTc "genInst/is_newtype" (vcat [ppr loc, ppr clas, ppr tvs, ppr tys, ppr rhs_ty])
; return ( InstInfo
{ iSpec = inst_spec
, iBinds = InstBindings
......
This diff is collapsed.
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}
module TcInstDcls ( tcInstDecls1 ) where
import HsSyn
import TcRnTypes
import TcEnv( InstInfo )
import TcDeriv
import Name
-- We need this because of the mutual recursion
-- between TcTyClsDecls and TcInstDcls
tcInstDecls1 :: [LInstDecl Name] -> TcM (TcGblEnv, [InstInfo Name], [DerivInfo])
......@@ -472,21 +472,21 @@ tcRnImports hsc_env import_decls
tcRnSrcDecls :: Bool -- False => no 'module M(..) where' header at all
-> [LHsDecl RdrName] -- Declarations
-> TcM TcGblEnv
-- Returns the variables free in the decls
-- Reason: solely to report unused imports and bindings
tcRnSrcDecls explicit_mod_hdr decls
= do { -- Do all the declarations
; ((tcg_env, tcl_env), lie) <- captureConstraints $
do { (tcg_env, tcl_env) <- tc_rn_src_decls decls ;
-- Check for the 'main' declaration
-- Must do this inside the captureConstraints
; tcg_env <- setEnvs (tcg_env, tcl_env) $
checkMain explicit_mod_hdr
; return (tcg_env, tcl_env) }
; setEnvs (tcg_env, tcl_env) $ do {
-- Emit Typeable bindings
; tcg_env <- setGblEnv tcg_env mkTypeableBinds
; setGblEnv tcg_env $ do {
; setEnvs (tcg_env, tcl_env) $ do {
#ifdef GHCI
; finishTH
......@@ -495,12 +495,7 @@ tcRnSrcDecls explicit_mod_hdr decls
-- wanted constraints from static forms
; stWC <- tcg_static_wc <$> getGblEnv >>= readTcRef
-- Finish simplifying class constraints
--
-- simplifyTop deals with constant or ambiguous InstIds.
-- How could there be ambiguous ones? They can only arise if a
-- top-level decl falls under the monomorphism restriction
-- and no subsequent decl instantiates its type.
-- Simplify constraints
--
-- We do this after checkMain, so that we use the type info
-- that checkMain adds
......@@ -546,7 +541,7 @@ tcRnSrcDecls explicit_mod_hdr decls
; setGlobalTypeEnv tcg_env' final_type_env
} } }
} }
tc_rn_src_decls :: [LHsDecl RdrName]
-> TcM (TcGblEnv, TcLclEnv)
......@@ -640,7 +635,6 @@ tcRnHsBootDecls hsc_src decls
-- Rename the declarations
; (tcg_env, HsGroup { hs_tyclds = tycl_decls
, hs_instds = inst_decls
, hs_derivds = deriv_decls
, hs_fords = for_decls
, hs_defds = def_decls
......@@ -666,7 +660,7 @@ tcRnHsBootDecls hsc_src decls
-- Typecheck type/class/instance decls
; traceTc "Tc2 (boot)" empty
; (tcg_env, inst_infos, _deriv_binds)
<- tcTyClsInstDecls tycl_decls inst_decls deriv_decls val_binds
<- tcTyClsInstDecls tycl_decls deriv_decls val_binds
; setGblEnv tcg_env $ do {
-- Typecheck value declarations
......@@ -1143,7 +1137,6 @@ rnTopSrcDecls group
tcTopSrcDecls :: HsGroup Name -> TcM (TcGblEnv, TcLclEnv)
tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
hs_instds = inst_decls,
hs_derivds = deriv_decls,
hs_fords = foreign_decls,
hs_defds = default_decls,
......@@ -1159,7 +1152,8 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
-- and import the supporting declarations
traceTc "Tc3" empty ;
(tcg_env, inst_infos, ValBindsOut deriv_binds deriv_sigs)
<- tcTyClsInstDecls tycl_decls inst_decls deriv_decls val_binds ;
<- tcTyClsInstDecls tycl_decls deriv_decls val_binds ;
setGblEnv tcg_env $ do {
-- Generate Applicative/Monad proposal (AMP) warnings
......@@ -1193,7 +1187,7 @@ tcTopSrcDecls (HsGroup { hs_tyclds = tycl_decls,
-- Second pass over class and instance declarations,
-- now using the kind-checked decls
traceTc "Tc6" empty ;
inst_binds <- tcInstDecls2 (tyClGroupConcat tycl_decls) inst_infos ;
inst_binds <- tcInstDecls2 (tyClGroupTyClDecls tycl_decls) inst_infos ;
-- Foreign exports
traceTc "Tc7" empty ;
......@@ -1427,7 +1421,6 @@ tcMissingParentClassWarn warnFlag isName shouldName
---------------------------
tcTyClsInstDecls :: [TyClGroup Name]
-> [LInstDecl Name]
-> [LDerivDecl Name]
-> [(RecFlag, LHsBinds Name)]
-> TcM (TcGblEnv, -- The full inst env
......@@ -1435,13 +1428,26 @@ tcTyClsInstDecls :: [TyClGroup Name]
-- contains all dfuns for this module
HsValBinds Name) -- Supporting bindings for derived instances
tcTyClsInstDecls tycl_decls inst_decls deriv_decls binds
= tcAddDataFamConPlaceholders inst_decls $
tcTyClsInstDecls tycl_decls deriv_decls binds
= tcAddDataFamConPlaceholders (tycl_decls >>= group_instds) $
tcAddPatSynPlaceholders (getPatSynBinds binds) $
do { tcg_env <- tcTyAndClassDecls tycl_decls ;
; setGblEnv tcg_env $
tcInstDecls1 tycl_decls inst_decls deriv_decls }
do { (tcg_env, inst_info, datafam_deriv_info)
<- tcTyAndClassDecls tycl_decls ;
; setGblEnv tcg_env $ do {
-- With the @TyClDecl@s and @InstDecl@s checked we're ready to
-- process the deriving clauses, including data family deriving
-- clauses discovered in @tcTyAndClassDecls@.
--
-- Careful to quit now in case there were instance errors, so that
-- the deriving errors don't pile up as well.
; failIfErrsM
; let tyclds = tycl_decls >>= group_tyclds
; (tcg_env', inst_info', val_binds)
<- tcInstDeclsDeriv datafam_deriv_info tyclds deriv_decls
; setGblEnv tcg_env' $ do {
failIfErrsM
; pure (tcg_env', inst_info' ++ inst_info, val_binds)
}}}
{- *********************************************************************
* *
......
This diff is collapsed.
......@@ -16,9 +16,6 @@ module TcTyDecls(
calcSynCycles,
checkClassCycles,
-- * Roles
RoleAnnots, extractRoleAnnots, emptyRoleAnnots, lookupRoleAnnots,
-- * Implicits
tcAddImplicits,
......@@ -31,6 +28,7 @@ module TcTyDecls(
import TcRnMonad
import TcEnv
import TcBinds( tcRecSelBinds )
import RnEnv( RoleAnnotEnv, lookupRoleAnnot )
import TyCoRep( Type(..), TyBinder(..), delBinderVar )
import TcType
import TysWiredIn( unitTy )
......@@ -363,7 +361,7 @@ data RecTyInfo = RTI { rti_roles :: Name -> [Role]
, rti_is_rec :: Name -> RecFlag }
calcRecFlags :: SelfBootInfo -> Bool -- hs-boot file?
-> RoleAnnots -> [TyCon] -> RecTyInfo
-> RoleAnnotEnv -> [TyCon] -> RecTyInfo
-- The 'boot_names' are the things declared in M.hi-boot, if M is the current module.
-- Any type constructors in boot_names are automatically considered loop breakers
-- Recursion of newtypes/data types can happen via
......@@ -457,27 +455,6 @@ findLoopBreakers deps
| CyclicSCC ((tc,_,_) : edges') <- stronglyConnCompFromEdgedVerticesR edges,
name <- tyConName tc : go edges']
{-
************************************************************************
* *
Role annotations
* *
************************************************************************
-}
type RoleAnnots = NameEnv (LRoleAnnotDecl Name)
extractRoleAnnots :: TyClGroup Name -> RoleAnnots
extractRoleAnnots (TyClGroup { group_roles = roles })
= mkNameEnv [ (tycon, role_annot)
| role_annot@(L _ (RoleAnnotDecl (L _ tycon) _)) <- roles ]
emptyRoleAnnots :: RoleAnnots
emptyRoleAnnots = emptyNameEnv
lookupRoleAnnots :: RoleAnnots -> Name -> Maybe (LRoleAnnotDecl Name)
lookupRoleAnnots = lookupNameEnv
{-
************************************************************************
* *
......@@ -588,12 +565,12 @@ we want to totally ignore coercions when doing role inference. This includes omi
any type variables that appear in nominal positions but only within coercions.
-}
type RoleEnv = NameEnv [Role] -- from tycon names to roles
type RoleEnv = NameEnv [Role] -- from tycon names to roles
-- This, and any of the functions it calls, must *not* look at the roles
-- field of a tycon we are inferring roles about!
-- See Note [Role inference]
inferRoles :: Bool -> RoleAnnots -> [TyCon] -> Name -> [Role]
inferRoles :: Bool -> RoleAnnotEnv -> [TyCon] -> Name -> [Role]
inferRoles is_boot annots tycons
= let role_env = initialRoleEnv is_boot annots tycons
role_env' = irGroup role_env tycons in
......@@ -601,11 +578,11 @@ inferRoles is_boot annots tycons
Just roles -> roles
Nothing -> pprPanic "inferRoles" (ppr name)
initialRoleEnv :: Bool -> RoleAnnots -> [TyCon] -> RoleEnv
initialRoleEnv :: Bool -> RoleAnnotEnv -> [TyCon] -> RoleEnv
initialRoleEnv is_boot annots = extendNameEnvList emptyNameEnv .
map (initialRoleEnv1 is_boot annots)
initialRoleEnv1 :: Bool -> RoleAnnots -> TyCon -> (Name, [Role])
initialRoleEnv1 :: Bool -> RoleAnnotEnv -> TyCon -> (Name, [Role])
initialRoleEnv1 is_boot annots_env tc
| isFamilyTyCon tc = (name, map (const Nominal) bndrs)
| isAlgTyCon tc = (name, default_roles)
......@@ -619,7 +596,7 @@ initialRoleEnv1 is_boot annots_env tc
-- if the number of annotations in the role annotation decl
-- is wrong, just ignore it. We check this in the validity check.
role_annots
= case lookupNameEnv annots_env name of
= case lookupRoleAnnot annots_env name of
Just (L _ (RoleAnnotDecl _ annots))
| annots `lengthIs` num_exps -> map unLoc annots
_ -> replicate num_exps Nothing
......
T9687.hs:4:10: error:
Class ‘Typeable’ does not support user-specified instances
T9687.hs:4:1: error:
• Class ‘Typeable’ does not support user-specified instances
• In the instance declaration for
‘Typeable (a, b, c, d, e, f, g, h)’
......@@ -14,7 +14,6 @@ infixl 9 !,\\
type role Map nominal representational
data Map k a
instance Typeable Map
instance Functor (Map k)
instance Foldable (Map k)
instance Traversable (Map k)
......
type family A a b :: * -- Defined at T4175.hs:7:1
type instance A (B a) b = () -- Defined at T4175.hs:10:15
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
type instance A Int Int = () -- Defined at T4175.hs:8:15
data family B a -- Defined at T4175.hs:12:1
instance G B -- Defined at T4175.hs:34:10
data instance B () = MkB -- Defined at T4175.hs:13:15
type instance A (B a) b = () -- Defined at T4175.hs:10:15
class C a where
type family D a b :: *
-- Defined at T4175.hs:16:5
type instance D () a = Bool -- Defined at T4175.hs:22:10
type instance D Int b = String -- Defined at T4175.hs:19:10
type family E a :: *
where
E () = Bool
E Int = String
-- Defined at T4175.hs:24:1
data () = () -- Defined in ‘GHC.Tuple’
instance C () -- Defined at T4175.hs:21:10
instance Bounded () -- Defined in ‘GHC.Enum’
instance Enum () -- Defined in ‘GHC.Enum’
instance Eq () -- Defined in ‘GHC.Classes’
instance Ord () -- Defined in ‘GHC.Classes’
instance Read () -- Defined in ‘GHC.Read’
instance Show () -- Defined in ‘GHC.Show’
instance Monoid () -- Defined in ‘GHC.Base’
type instance D () a = Bool -- Defined at T4175.hs:22:10
data instance B () = MkB -- Defined at T4175.hs:13:15
data Maybe a = Nothing | Just a -- Defined in ‘GHC.Base’
instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’
instance Monad Maybe -- Defined in ‘GHC.Base’
instance Functor Maybe -- Defined in ‘GHC.Base’
instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Base’
instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
instance Applicative Maybe -- Defined in ‘GHC.Base’
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Traversable Maybe -- Defined in ‘Data.Traversable’
instance Monoid a => Monoid (Maybe a) -- Defined in ‘GHC.Base’
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
data Int = I# Int# -- Defined in ‘GHC.Types’
instance C Int -- Defined at T4175.hs:18:10
instance Bounded Int -- Defined in ‘GHC.Enum’
instance Enum Int -- Defined in ‘GHC.Enum’
instance Eq Int -- Defined in ‘GHC.Classes’
instance Integral Int -- Defined in ‘GHC.Real’
instance Num Int -- Defined in ‘GHC.Num’
instance Ord Int -- Defined in ‘GHC.Classes’
instance Read Int -- Defined in ‘GHC.Read’
instance Real Int -- Defined in ‘GHC.Real’
instance Show Int -- Defined in ‘GHC.Show’
type instance D Int b = String -- Defined at T4175.hs:19:10
type instance A Int Int = () -- Defined at T4175.hs:8:15
class Z a -- Defined at T4175.hs:28:1
instance F (Z a) -- Defined at T4175.hs:31:10
type family A a b :: * -- Defined at T4175.hs:7:1
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
type instance A Int Int = () -- Defined at T4175.hs:8:15
type instance A (B a) b = () -- Defined at T4175.hs:10:15
data family B a -- Defined at T4175.hs:12:1
instance G B -- Defined at T4175.hs:34:10
data instance B () = MkB -- Defined at T4175.hs:13:15
type instance A (B a) b = () -- Defined at T4175.hs:10:15
class C a where
type family D a b :: *
-- Defined at T4175.hs:16:5
type instance D () a = Bool -- Defined at T4175.hs:22:10
type instance D Int b = String -- Defined at T4175.hs:19:10
type family E a :: *
where
E () = Bool
E Int = String
-- Defined at T4175.hs:24:1
data () = () -- Defined in ‘GHC.Tuple’
instance C () -- Defined at T4175.hs:21:10
instance Bounded () -- Defined in ‘GHC.Enum’
instance Enum () -- Defined in ‘GHC.Enum’
instance Eq () -- Defined in ‘GHC.Classes’
instance Ord () -- Defined in ‘GHC.Classes’
instance Read () -- Defined in ‘GHC.Read’
instance Show () -- Defined in ‘GHC.Show’
instance Monoid () -- Defined in ‘GHC.Base’
type instance D () a = Bool -- Defined at T4175.hs:22:10
data instance B () = MkB -- Defined at T4175.hs:13:15
data Maybe a = Nothing | Just a -- Defined in ‘GHC.Base’
instance Eq a => Eq (Maybe a) -- Defined in ‘GHC.Base’
instance Monad Maybe -- Defined in ‘GHC.Base’
instance Functor Maybe -- Defined in ‘GHC.Base’
instance Ord a => Ord (Maybe a) -- Defined in ‘GHC.Base’
instance Read a => Read (Maybe a) -- Defined in ‘GHC.Read’
instance Show a => Show (Maybe a) -- Defined in ‘GHC.Show’
instance Applicative Maybe -- Defined in ‘GHC.Base’
instance Foldable Maybe -- Defined in ‘Data.Foldable’
instance Traversable Maybe -- Defined in ‘Data.Traversable’
instance Monoid a => Monoid (Maybe a) -- Defined in ‘GHC.Base’
type instance A (Maybe a) a = a -- Defined at T4175.hs:9:15
data Int = I# Int# -- Defined in ‘GHC.Types’
instance C Int -- Defined at T4175.hs:18:10
instance Bounded Int -- Defined in ‘GHC.Enum’
instance Enum Int -- Defined in ‘GHC.Enum’
instance Eq Int -- Defined in ‘GHC.Classes’
instance Integral Int -- Defined in ‘GHC.Real’
instance Num Int -- Defined in ‘GHC.Num’
instance Ord Int -- Defined in ‘GHC.Classes’
instance Read Int -- Defined in ‘GHC.Read’
instance Real Int -- Defined in ‘GHC.Real’
instance Show Int -- Defined in ‘GHC.Show’
type instance D Int b = String -- Defined at T4175.hs:19:10
type instance A Int Int = () -- Defined at T4175.hs:8:15
class Z a -- Defined at T4175.hs:28:1
instance F (Z a) -- Defined at T4175.hs:31:10
T8550.hs:13:12:
Reduction stack overflow; size = 201
When simplifying the following type: F ()
Use -freduction-depth=0 to disable this check
(any upper bound you could choose might fail unpredictably with
minor updates to GHC, so disabling the check is recommended if
you're sure that type checking should terminate)
In the expression: A
In the expression: seq A (return ())
In an equation for ‘main’: main = seq A (return ())
T8550.hs:8:3: error:
• Reduction stack overflow; size = 201
When simplifying the following type: F ()
Use -freduction-depth=0 to disable this check
(any upper bound you could choose might fail unpredictably with
minor updates to GHC, so disabling the check is recommended if
you're sure that type checking should terminate)
• In the ambiguity check for ‘A’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
In the definition of data constructor ‘A’
In the data type declaration for ‘A’
T8132.hs:6:10: error:
Class ‘Typeable’ does not support user-specified instances
T8132.hs:6:1: error:
• Class ‘Typeable’ does not support user-specified instances
• In the instance declaration for ‘Typeable K’
......@@ -4,5 +4,4 @@ import Data.Data
data HsExpr i
instance Typeable HsExpr
instance Data i => Data (HsExpr i)
......@@ -12,9 +12,9 @@ TYPE CONSTRUCTORS
COERCION AXIOMS
axiom T8958.N:Map :: Map k v = [(k, v)] -- Defined at T8958.hs:13:1
INSTANCES
instance [incoherent] Nominal a -- Defined at T8958.hs:7:10
instance [incoherent] Representational a
-- Defined at T8958.hs:10:10
instance [incoherent] Nominal a -- Defined at T8958.hs:7:10
Dependent modules: []
Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
integer-gmp-1.0.0.1]
......
class GHC.Classes.Eq a_0 => Main.MyClass (a_0 :: *)
instance Main.MyClass Main.Foo
instance GHC.Classes.Ord a_1 => Main.MyClass (Main.Quux2 a_1)
instance GHC.Classes.Eq a_2 => Main.MyClass (Main.Quux a_2)
instance Main.MyClass Main.Baz
instance GHC.Classes.Eq a_1 => Main.MyClass (Main.Quux a_1)
instance GHC.Classes.Ord a_2 => Main.MyClass (Main.Quux2 a_2)
instance Main.MyClass Main.Foo
True
True
True
......
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
module T11348 where
import Data.Kind
import Data.Proxy
type family TrivialFamily t :: Type
type instance TrivialFamily (t :: Type) = Bool
data R where
R :: Proxy Bool -> R
type ProblemType t = 'R ('Proxy :: Proxy (TrivialFamily t))
......@@ -513,3 +513,4 @@ test('T11512', normal, compile, [''])
test('T11754', normal, compile, [''])
test('T11811', normal, compile, [''])
test('T11793', normal, compile, [''])
test('T11348', normal, compile, [''])
......@@ -62,7 +62,7 @@ T6018fail.hs:59:10: error:
(i.e. ones independent of the class type variables)
must be distinct type variables
Expected: PolyKindVarsF '[]
Actual: PolyKindVarsF '[]
Actual: PolyKindVarsF '[]
Use -fprint-explicit-kinds to see the kind arguments
• In the type instance declaration for ‘PolyKindVarsF’
In the instance declaration for ‘PolyKindVarsC '[]’
......@@ -91,10 +91,10 @@ T6018fail.hs:70:15: error:
forall k (a :: k) (b :: k).
Gc a b = Int -- Defined at T6018fail.hs:70:15
T6018fail.hs:75:15: error:
T6018fail.hs:74:15: error:
Type family equations violate injectivity annotation:
F1 (Maybe a) = Maybe (GF2 a) -- Defined at T6018fail.hs:75:15
F1 [a] = Maybe (GF1 a) -- Defined at T6018fail.hs:74:15
F1 (Maybe a) = Maybe (GF2 a) -- Defined at T6018fail.hs:75:15
T6018fail.hs:87:15: error:
Type family equation violates injectivity annotation.
......
tcfail211.hs:5:1:
Illegal implicit parameter ‘?imp::Int’
In the context: ?imp::Int
While checking the super-classes of class ‘D’
In the class declaration for ‘D’
tcfail211.hs:5:1: error:
• Illegal implicit parameter ‘?imp::Int’
• In the context: ?imp::Int
While checking the super-classes of class ‘D’
In the class declaration for ‘D’
tcfail211.hs:8:10: error:
• Illegal implicit parameter ‘?imp::Int’
• In the context: ?imp::Int
While checking an instance declaration
In the instance declaration for ‘D Int’
......@@ -256,7 +256,8 @@ boundValues mod group =
, bind <- bagToList binds
, x <- boundThings mod bind ]
_other -> error "boundValues"
tys = [ n | ns <- map (fst . hsLTyClDeclBinders) (tyClGroupConcat (hs_tyclds group))
tys = [ n | ns <- map (fst . hsLTyClDeclBinders)
(hs_tyclds group >>= group_tyclds)
, n <- map found ns ]
fors = concat $ map forBound (hs_fords group)
where forBound lford = case unLoc lford of
......
Subproject commit 5c82c9fc2d21ddaae4a2470f1c375426968f19c6
Subproject commit 56dbfe17d272670e5f2d082401c025755796950d
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