Commit 578fbeca authored by David Terei's avatar David Terei
Browse files

Dont allow hand-written Generic instances in Safe Haskell.

While they aren't strictly unsafe, it is a similar situation to
Typeable. There are few instances where a programmer will write their
own instance, and having compiler assurance that the Generic
implementation is correct brings a lot of benefits.
parent 02975c90
......@@ -1084,6 +1084,9 @@ datatypeClassName = clsQual gHC_GENERICS (fsLit "Datatype") datatypeClassK
constructorClassName = clsQual gHC_GENERICS (fsLit "Constructor") constructorClassKey
selectorClassName = clsQual gHC_GENERICS (fsLit "Selector") selectorClassKey
genericClassNames :: [Name]
genericClassNames = [genClassName, gen1ClassName]
-- GHCi things
ghciIoClassName, ghciStepIoMName :: Name
ghciIoClassName = clsQual gHC_GHCI (fsLit "GHCiSandboxIO") ghciIoClassKey
......
......@@ -51,8 +51,8 @@ import VarEnv
import VarSet
import CoreUnfold ( mkDFunUnfolding )
import CoreSyn ( Expr(Var, Type), CoreExpr, mkTyApps, mkVarApps )
import PrelNames ( tYPEABLE_INTERNAL, typeableClassName, oldTypeableClassNames )
import PrelNames ( tYPEABLE_INTERNAL, typeableClassName,
oldTypeableClassNames, genericClassNames )
import Bag
import BasicTypes
import DynFlags
......@@ -415,13 +415,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
-- hand written instances of old Typeable as then unsafe casts could be
-- performed. Derived instances are OK.
; dflags <- getDynFlags
; when (safeLanguageOn dflags) $
mapM_ (\x -> when (typInstCheck x)
(addErrAt (getSrcSpan $ iSpec x) typInstErr))
local_infos
; when (safeLanguageOn dflags) $ forM_ local_infos $ \x -> case x of
_ | typInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (typInstErr x)
_ | genInstCheck x -> addErrAt (getSrcSpan $ iSpec x) (genInstErr x)
_ -> return ()
-- As above but for Safe Inference mode.
; when (safeInferOn dflags) $
mapM_ (\x -> when (typInstCheck x) recordUnsafeInfer) local_infos
; when (safeInferOn dflags) $ forM_ local_infos $ \x -> case x of
_ | typInstCheck x -> recordUnsafeInfer
_ | genInstCheck x -> recordUnsafeInfer
_ -> return ()
; return ( gbl_env
, bagToList deriv_inst_info ++ local_infos
......@@ -442,8 +445,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
else (typeableInsts, i:otherInsts)
typInstCheck ty = is_cls_nm (iSpec ty) `elem` oldTypeableClassNames
typInstErr = ptext $ sLit $ "Can't create hand written instances of Typeable in Safe"
++ " Haskell! Can only derive them"
typInstErr i = hang (ptext (sLit $ "Typeable instances can only be "
++ "derived in Safe Haskell.") $+$
ptext (sLit "Replace the following instance:"))
2 (pprInstanceHdr (iSpec i))
genInstCheck ty = is_cls_nm (iSpec ty) `elem` genericClassNames
genInstErr i = hang (ptext (sLit $ "Generic instances can only be "
++ "derived in Safe Haskell.") $+$
ptext (sLit "Replace the following instance:"))
2 (pprInstanceHdr (iSpec i))
instMsg i = hang (ptext (sLit $ "Typeable instances can only be derived; replace "
++ "the following instance:"))
......
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