diff options
author | Jose Pedro Magalhaes <jpm@cs.ox.ac.uk> | 2014-11-05 16:25:25 +0000 |
---|---|---|
committer | Jose Pedro Magalhaes <jpm@cs.ox.ac.uk> | 2014-11-14 16:34:32 +0000 |
commit | ffb45204de1841ff1aff7c8e3c04acf3f7081595 (patch) | |
tree | 4726644a0589efd88a4df1d82c4468eb1b0f41ed | |
parent | 2ad051866b5e5bc7751f7f9210e026bb989509f4 (diff) | |
download | haskell-ffb45204de1841ff1aff7c8e3c04acf3f7081595.tar.gz |
Use MINIMAL to decide whether we can derive or not, and do not reject newtypes
-rw-r--r-- | compiler/typecheck/TcDeriv.lhs | 7 | ||||
-rw-r--r-- | compiler/typecheck/TcGenDeriv.lhs | 14 |
2 files changed, 12 insertions, 9 deletions
diff --git a/compiler/typecheck/TcDeriv.lhs b/compiler/typecheck/TcDeriv.lhs index 231f928568..ef12d5587f 100644 --- a/compiler/typecheck/TcDeriv.lhs +++ b/compiler/typecheck/TcDeriv.lhs @@ -1568,7 +1568,6 @@ mkNewTypeEqn dflags overlap_mode tvs , ds_newtype = True } | otherwise = case checkSideConditions dflags mtheta cls cls_tys rep_tycon rep_tc_args of - CanDerive -> go_for_it -- Use the standard H98 method DerivableClassError msg -- Error with standard class | might_derive_via_coercible -> bale_out (msg $$ suggest_nd) | otherwise -> bale_out msg @@ -1577,7 +1576,7 @@ mkNewTypeEqn dflags overlap_mode tvs | might_derive_via_coercible -> bale_out (non_std $$ suggest_nd) -- Try newtype deriving! | derivingViaGenerics -> bale_out msg | otherwise -> bale_out non_std - DerivableViaGenerics -> panicGenericsNewtype + _ -> go_for_it -- CanDerive/DerivableViaGenerics where newtype_deriving = xopt Opt_GeneralizedNewtypeDeriving dflags derivingViaGenerics = xopt Opt_DerivingViaGenerics dflags @@ -1586,8 +1585,8 @@ mkNewTypeEqn dflags overlap_mode tvs non_std = nonStdErr cls suggest_nd = ptext (sLit "Try GeneralizedNewtypeDeriving for GHC's newtype-deriving extension") - panicGenericsNewtype = pprPanic "mkNewTypeEqn: DerivableViaGenerics" - (ppr (cls, rep_tycon)) + -- panicGenericsNewtype = pprPanic "mkNewTypeEqn: DerivableViaGenerics" + -- (ppr (cls, rep_tycon)) -- Here is the plan for newtype derivings. We see -- newtype T a1...an = MkT (t ak+1...an) deriving (.., C s1 .. sm, ...) diff --git a/compiler/typecheck/TcGenDeriv.lhs b/compiler/typecheck/TcGenDeriv.lhs index 88c2929876..232bfe8ef5 100644 --- a/compiler/typecheck/TcGenDeriv.lhs +++ b/compiler/typecheck/TcGenDeriv.lhs @@ -69,6 +69,7 @@ import TcEnv (InstInfo) import ListSetOps ( assocMaybe ) import Data.List ( partition, intersperse ) import Data.Maybe ( isNothing ) +import BooleanFormula ( isTrue ) \end{code} \begin{code} @@ -132,7 +133,7 @@ genDerivedBinds dflags fix_env clas loc tycon -- We can derive a given class via Generics iff canDeriveViaGenerics :: DynFlags -> TyCon -> Class -> Maybe SDoc canDeriveViaGenerics dflags tycon clas = - let dfs = map (defMethSpecOfDefMeth . snd) . classOpItems $ clas + let _dfs = map (defMethSpecOfDefMeth . snd) . classOpItems $ clas b `orElse` s = if b then Nothing else Just (ptext (sLit s)) Just m <> _ = Just m Nothing <> n = n @@ -141,11 +142,14 @@ canDeriveViaGenerics dflags tycon clas = -- 2) Opt_DerivingViaGenerics is on <> (xopt Opt_DerivingViaGenerics dflags `orElse` "Try enabling DerivingViaGenerics") -- 3) It has no non-default methods - <> (all (/= NoDM) dfs `orElse` "There are methods without a default definition") + -- <> (all (/= NoDM) dfs `orElse` "There are methods without a default definition") -- 4) It has at least one generic default method - <> (any (== GenericDM) dfs `orElse` "There must be at least one method with a default signature") - -- 5) It's not a newtype (that conflicts with GeneralizedNewtypeDeriving) - <> (not (isNewTyCon tycon) `orElse` "DerivingViaGenerics is not supported for newtypes") + -- <> (any (== GenericDM) dfs `orElse` "There must be at least one method with a default signature") + -- 3/4) Its MINIMAL set is empty + <> (isTrue (classMinimalDef clas) `orElse` "because its MINIMAL set is not empty") + -- 5) It a newtype and GND is enabled + <> (not (isNewTyCon tycon && xopt Opt_GeneralizedNewtypeDeriving dflags) + `orElse` "I don't know whether to use DerivingViaGenerics or GeneralizedNewtypeDeriving") -- Nothing: we can derive it via Generics -- Just s: we can't, reason s \end{code} |