[commit: ghc] master: Enable derived but not hand crafted Typeable instances in Safe Haskell (b61ad3e)

[David Terei]

Repository : ssh://darcs.haskell.org//srv/darcs/ghc

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b61ad3e883bfae874a6cbc8079cb44925326b328

>---------------------------------------------------------------

commit b61ad3e883bfae874a6cbc8079cb44925326b328
Author: David Terei <davidterei at gmail.com>
Date:   Wed Jul 20 16:28:03 2011 -0700

    Enable derived but not hand crafted Typeable instances in Safe Haskell

>---------------------------------------------------------------

 compiler/typecheck/TcInstDcls.lhs |   11 +++++++++++
 1 files changed, 11 insertions(+), 0 deletions(-)

diff --git a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
index 221d42b..a0a5a50 100644
--- a/compiler/typecheck/TcInstDcls.lhs
+++ b/compiler/typecheck/TcInstDcls.lhs
@@ -41,6 +41,7 @@ import Pair
 import CoreUtils  ( mkPiTypes )
 import CoreUnfold ( mkDFunUnfolding )
 import CoreSyn    ( Expr(Var), CoreExpr, varToCoreExpr )
+import PrelNames  ( typeableClassNames )
 
 import Bag
 import BasicTypes
@@ -408,6 +409,16 @@ tcInstDecls1 tycl_decls inst_decls deriv_decls
                     tcExtendGlobalEnv (concatMap implicitTyThings all_tycons) $
                     addFamInsts deriv_ty_insts $
                     addInsts deriv_inst_info getGblEnv
+
+       -- Check that if the module is compiled with -XSafe, there are no
+       -- hand written instances of Typeable as then unsafe casts could be
+       -- performed. Derivied instances are OK.
+       ; dflags <- getDOpts
+       ; when (safeLanguageOn dflags) $
+             mapM_ (\x -> when (is_cls (iSpec x) `elem` typeableClassNames)
+                               (addErrAt (getSrcSpan $ iSpec x) typInstErr))
+                   local_info
+
        ; return ( addTcgDUs gbl_env deriv_dus,
                   deriv_inst_info ++ local_info,
                   aux_binds `plusHsValBinds` deriv_binds)