[commit: ghc] master: Dont allow hand-written Generic instances in Safe Haskell. (578fbec)

[Simon Peyton Jones]

David

Thanks for doing this. 

I'm a bit concerned, though, that there is quite a bit of Safe-Haskell special-casing in GHC, but no single place to look for a list of what the choices are, and why they are made.  Even the paragraph you wrote as a commit comment would make a helpful Note to accompany the code changes.

The worry is that in five years time someone will look at this code and wonder "why exactly is this special case there?".  They may look in the paper, but Generics post-dates it.

Would it be worth Wiki page to collect the choices?  Or more detailed Notes with the individual tests?

Thanks

Simon
	
| -----Original Message-----
| From: ghc-commits [mailto:ghc-commits-bounces at haskell.org] On Behalf Of
| git at git.haskell.org
| Sent: 02 August 2014 03:06
| To: ghc-commits at haskell.org
| Subject: [commit: ghc] master: Dont allow hand-written Generic
| instances in Safe Haskell. (578fbec)
| 
| Repository : ssh://git@git.haskell.org/ghc
| 
| On branch  : master
| Link       :
| http://ghc.haskell.org/trac/ghc/changeset/578fbeca31dd3d755e24e910c3a73
| 27f92bc4ee3/ghc
| 
| >---------------------------------------------------------------
| 
| commit 578fbeca31dd3d755e24e910c3a7327f92bc4ee3
| Author: David Terei <code at davidterei.com>
| Date:   Thu Dec 5 17:27:17 2013 -0800
| 
|     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.
| 
| 
| >---------------------------------------------------------------
| 
| 578fbeca31dd3d755e24e910c3a7327f92bc4ee3
|  compiler/prelude/PrelNames.lhs    |  3 +++
|  compiler/typecheck/TcInstDcls.lhs | 31 +++++++++++++++++++++----------
|  2 files changed, 24 insertions(+), 10 deletions(-)
| 
| diff --git a/compiler/prelude/PrelNames.lhs
| b/compiler/prelude/PrelNames.lhs index 2c84e40..b2dec88 100644
| --- a/compiler/prelude/PrelNames.lhs
| +++ b/compiler/prelude/PrelNames.lhs
| @@ -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 diff --git
| a/compiler/typecheck/TcInstDcls.lhs b/compiler/typecheck/TcInstDcls.lhs
| index c3ba825..6ff8a2b 100644
| --- a/compiler/typecheck/TcInstDcls.lhs
| +++ b/compiler/typecheck/TcInstDcls.lhs
| @@ -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:"))
| 
| _______________________________________________
| ghc-commits mailing list
| ghc-commits at haskell.org
| http://www.haskell.org/mailman/listinfo/ghc-commits