[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