TcTyClsDecls: Typecheck type and class declarations
\begin{code}
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
module TcTyClsDecls (
tcTyAndClassDecls, tcFamInstDecl
) where
tcTyAndClassDecls :: ModDetails -> [LTyClDecl Name]
-> TcM TcGblEnv -- Input env extended by types and classes
-- and their implicit Ids,DataCons
+-- Fails if there are any errors
+
tcTyAndClassDecls boot_details allDecls
- = do { -- Omit instances of type families; they are handled together
+ = checkNoErrs $ -- The code recovers internally, but if anything gave rise to
+ -- an error we'd better stop now, to avoid a cascade
+ do { -- Omit instances of type families; they are handled together
-- with the *heads* of class instances
; let decls = filter (not . isFamInstDecl . unLoc) allDecls
recoverM (returnM Nothing) $
setSrcSpan loc $
tcAddDeclCtxt decl $
- do { -- type families require -ftype-families and can't be in an
+ do { -- type families require -XTypeFamilies and can't be in an
-- hs-boot file
; type_families <- doptM Opt_TypeFamilies
; is_boot <- tcIsHsBoot -- Are we compiling an hs-boot file?
; t_rhs <- tcHsKindedType k_rhs
-- (3) check that
- -- - left-hand side contains no type family applications
- -- (vanilla synonyms are fine, though)
- ; mappM_ checkTyFamFreeness t_typats
-
- -- - the right-hand side is a tau type
- ; unless (isTauTy t_rhs) $
- addErr (polyTyErr t_rhs)
+ -- - check the well-formedness of the instance
+ ; checkValidTypeInst t_typats t_rhs
-- (4) construct representation tycon
; rep_tc_name <- newFamInstTyConName tc_name loc
-- (3) Check that
-- - left-hand side contains no type family applications
- -- (vanilla synonyms are fine, though)
+ -- (vanilla synonyms are fine, though, and we checked for
+ -- foralls earlier)
; mappM_ checkTyFamFreeness t_typats
-- - we don't use GADT syntax for indexed types
L _ (ConDecl { con_res = ResTyGADT _ }) : _ -> False
other -> True
--- Check that a type index does not contain any type family applications
---
--- * Earlier phases have already checked that there are no foralls in the
--- type; we also cannot have PredTys and NoteTys are being skipped by using
--- the core view.
---
-checkTyFamFreeness :: Type -> TcM ()
-checkTyFamFreeness ty | Just (tycon, tys) <- splitTyConApp_maybe ty
- = if isSynTyCon tycon
- then addErr $ tyFamAppInIndexErr ty
- else mappM_ checkTyFamFreeness tys
- -- splitTyConApp_maybe uses the core view; hence,
- -- any synonym tycon must be a family tycon
-
- | Just (ty1, ty2) <- splitAppTy_maybe ty
- = checkTyFamFreeness ty1 >> checkTyFamFreeness ty2
-
- | otherwise -- only vars remaining
- = return ()
-
-
-- Kind checking of indexed types
-- -
{ traceTc (text "type family: " <+> ppr tc_name)
; idx_tys <- doptM Opt_TypeFamilies
- -- Check that we don't use families without -ftype-families
+ -- Check that we don't use families without -XTypeFamilies
; checkTc idx_tys $ badFamInstDecl tc_name
; tycon <- buildSynTyCon tc_name tvs' (OpenSynTyCon kind Nothing) Nothing
; return [ATyCon tycon]
}
- -- "newtype family" or "data family" declaration
+ -- "data family" declaration
tcTyClDecl1 _calc_isrec
(TyFamily {tcdFlavour = DataFamily,
tcdLName = L _ tc_name, tcdTyVars = tvs, tcdKind = mb_kind})
; idx_tys <- doptM Opt_TypeFamilies
- -- Check that we don't use families without -ftype-families
+ -- Check that we don't use families without -XTypeFamilies
; checkTc idx_tys $ badFamInstDecl tc_name
; tycon <- buildAlgTyCon tc_name final_tvs []
}
-- "newtype" and "data"
+ -- NB: not used for newtype/data instances (whether associated or not)
tcTyClDecl1 calc_isrec
(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdTyVars = tvs,
tcdLName = L _ tc_name, tcdKindSig = mb_ksig, tcdCons = cons})
{ ctxt' <- tcHsKindedContext ctxt
; fds' <- mappM (addLocM tc_fundep) fundeps
; atss <- mappM (addLocM (tcTyClDecl1 (const Recursive))) ats
+ -- NB: 'ats' only contains "type family" and "data family"
+ -- declarations as well as type family defaults
; let ats' = zipWith setTyThingPoss atss (map (tcdTyVars . unLoc) ats)
; sig_stuff <- tcClassSigs class_name sigs meths
; clas <- fixM (\ clas ->
| isAlgTyCon family = ptext SLIT("data type")
| otherwise = pprPanic "wrongKindOfFamily" (ppr family)
-polyTyErr ty
- = hang (ptext SLIT("Illegal polymorphic type in type instance") <> colon) 4 $
- ppr ty
-
-tyFamAppInIndexErr ty
- = hang (ptext SLIT("Illegal type family application in type instance") <>
- colon) 4 $
- ppr ty
-
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
nest 2 $ ptext SLIT("(-XEmptyDataDecls permits this)")]