[commit: ghc] wip/T5462: Use MINIMAL to decide whether we can derive or not, and do not reject newtypes (ffb4520)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/T5462
Link       : http://ghc.haskell.org/trac/ghc/changeset/ffb45204de1841ff1aff7c8e3c04acf3f7081595/ghc

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

commit ffb45204de1841ff1aff7c8e3c04acf3f7081595
Author: Jose Pedro Magalhaes <jpm at cs.ox.ac.uk>
Date:   Wed Nov 5 16:25:25 2014 +0000

    Use MINIMAL to decide whether we can derive or not, and do not reject newtypes


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

ffb45204de1841ff1aff7c8e3c04acf3f7081595
 compiler/typecheck/TcDeriv.lhs    |  7 +++----
 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 231f928..ef12d55 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 88c2929..232bfe8 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}