Commit 96f33e63 authored by unknown's avatar unknown
Browse files

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.
parent e276ed78
......@@ -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]
......
......@@ -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}
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment