[commit: ghc] master: Move defaultClassMinimalDef from BuildTyCl to TcClassDcl (96f33e6)

git at git.haskell.org git
Tue Oct 1 15:55:15 UTC 2013


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

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/96f33e63fe913298becbef33bf95daee98fbe44d/ghc

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

commit 96f33e63fe913298becbef33bf95daee98fbe44d
Author: unknown <simonpj at MSRC-4971295.europe.corp.microsoft.com>
Date:   Tue Sep 24 20:01:31 2013 +0100

    Move defaultClassMinimalDef from BuildTyCl to TcClassDcl
    
    Simple refactoring.
    
    Also in Vectorise.Types/TyConDecl, simply propagate the classMinimalDef
    from the class we are vectorising. Simpler and more direct.


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

96f33e63fe913298becbef33bf95daee98fbe44d
 compiler/iface/BuildTyCl.lhs                   |   12 +-----------
 compiler/typecheck/TcClassDcl.lhs              |   18 +++++++++++++-----
 compiler/vectorise/Vectorise/Type/TyConDecl.hs |    4 ++--
 3 files changed, 16 insertions(+), 18 deletions(-)

diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 970ad46..38bb930 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -18,8 +18,7 @@ module BuildTyCl (
         TcMethInfo, buildClass,
         distinctAbstractTyConRhs, totallyAbstractTyConRhs,
         mkNewTyConRhs, mkDataTyConRhs, 
-        newImplicitBinder,
-        defaultClassMinimalDef
+        newImplicitBinder
     ) where
 
 #include "HsVersions.h"
@@ -36,7 +35,6 @@ import Class
 import TyCon
 import Type
 import Coercion
-import BooleanFormula( mkAnd, mkVar )
 
 import DynFlags
 import TcRnMonad
@@ -289,14 +287,6 @@ buildClass no_unf tycon_name tvs roles sc_theta fds at_items sig_stuff mindef tc
                           VanillaDM -> do { dm_name <- newImplicitBinder op_name mkDefaultMethodOcc
 			  	          ; return (DefMeth dm_name) }
            ; return (mkDictSelId dflags no_unf op_name rec_clas, dm_info) }
-
--- by default require all methods without a defaul implementation who's names don't start with '_'
-defaultClassMinimalDef :: [TcMethInfo] -> ClassMinimalDef
-defaultClassMinimalDef meths
-  = mkAnd
-      [ mkVar name
-      | (name, NoDM, _) <- meths
-      , not (startsWithUnderscore (getOccName name)) ]
 \end{code}
 
 Note [Class newtypes and equality predicates]
diff --git a/compiler/typecheck/TcClassDcl.lhs b/compiler/typecheck/TcClassDcl.lhs
index 2202022..835043a 100644
--- a/compiler/typecheck/TcClassDcl.lhs
+++ b/compiler/typecheck/TcClassDcl.lhs
@@ -33,7 +33,7 @@ import TcMType
 import Type     ( getClassPredTys_maybe )
 import TcType
 import TcRnMonad
-import BuildTyCl( TcMethInfo, defaultClassMinimalDef )
+import BuildTyCl( TcMethInfo )
 import Class
 import Id
 import Name
@@ -46,7 +46,7 @@ import Maybes
 import BasicTypes
 import Bag
 import FastString
-import BooleanFormula (impliesAtom, isUnsatisfied, pprBooleanFormulaNice)
+import BooleanFormula
 import Util
 
 import Control.Monad
@@ -269,12 +269,20 @@ tcClassMinimalDef _clas sigs op_info
   = case findMinimalDef sigs of
       Nothing -> return defMindef
       Just mindef -> do
-        -- warn if the given mindef does not imply the default one
+        -- Warn if the given mindef does not imply the default one
+        -- That is, the given mindef should at least ensure that the
+        -- class ops without default methods are required, since we
+        -- have no way to fill them in otherwise
         whenIsJust (isUnsatisfied (mindef `impliesAtom`) defMindef) $
-          warnTc True . warningMinimalDefIncomplete
+                   (\bf -> addWarnTc (warningMinimalDefIncomplete bf))
         return mindef
   where
-    defMindef = defaultClassMinimalDef op_info
+    -- By default require all methods without a default 
+    -- implementation whose names don't start with '_'
+    defMindef :: ClassMinimalDef
+    defMindef = mkAnd [ mkVar name
+                      | (name, NoDM, _) <- op_info
+                      , not (startsWithUnderscore (getOccName name)) ]
 \end{code}
 
 \begin{code}
diff --git a/compiler/vectorise/Vectorise/Type/TyConDecl.hs b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
index 29d54a0..a8159b0 100644
--- a/compiler/vectorise/Vectorise/Type/TyConDecl.hs
+++ b/compiler/vectorise/Vectorise/Type/TyConDecl.hs
@@ -6,7 +6,7 @@ module Vectorise.Type.TyConDecl (
 import Vectorise.Type.Type
 import Vectorise.Monad
 import Vectorise.Env( GlobalEnv( global_fam_inst_env ) )
-import BuildTyCl
+import BuildTyCl( buildClass, buildDataCon )
 import Class
 import Type
 import TyCon
@@ -67,7 +67,7 @@ vectTyConDecl tycon name'
                      (snd . classTvsFds $ cls)  -- keep the original functional dependencies
                      []                         -- no associated types (for the moment)
                      methods'                   -- method info
-                     (defaultClassMinimalDef methods') -- default minimal complete definition
+                     (classMinimalDef cls)      -- Inherit minimal complete definition from cls
                      rec_flag                   -- whether recursive
 
            -- the original dictionary constructor must map to the vectorised one




More information about the ghc-commits mailing list