diff options
| -rw-r--r-- | compiler/prelude/PrelRules.lhs | 5 | ||||
| -rw-r--r-- | compiler/typecheck/TcHsType.lhs | 1 | ||||
| -rw-r--r-- | compiler/typecheck/TcRnMonad.lhs | 5 | ||||
| -rw-r--r-- | compiler/typecheck/TcSimplify.lhs | 7 | ||||
| -rw-r--r-- | compiler/typecheck/TcTyClsDecls.lhs | 17 | ||||
| -rw-r--r-- | compiler/types/Class.lhs | 25 |
6 files changed, 47 insertions, 13 deletions
diff --git a/compiler/prelude/PrelRules.lhs b/compiler/prelude/PrelRules.lhs index dab34fc69d..7aeb920e0c 100644 --- a/compiler/prelude/PrelRules.lhs +++ b/compiler/prelude/PrelRules.lhs @@ -779,7 +779,11 @@ match_inline _ (Type _ : e : _) match_inline _ _ = Nothing +------------------------------------------------- -- Integer rules +-- smallInteger (79::Int#) = 79::Integer +-- wordToInteger (79::Word#) = 79::Integer +-- Similarly Int64, Word64 match_IntToInteger :: Id -> IdUnfoldingFun @@ -833,6 +837,7 @@ match_Word64ToInteger id id_unf [xl] panic "match_Word64ToInteger: Id has the wrong type" match_Word64ToInteger _ _ _ = Nothing +------------------------------------------------- match_Integer_convert :: Num a => (a -> Expr CoreBndr) -> Id diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs index 1e30d7c328..8b4004490b 100644 --- a/compiler/typecheck/TcHsType.lhs +++ b/compiler/typecheck/TcHsType.lhs @@ -850,6 +850,7 @@ tcHsTyVarBndr :: LHsTyVarBndr Name -> TcM TyVar -- instance C (a,b) where -- type F (a,b) c = ... -- Here a,b will be in scope when processing the associated type instance for F. +-- See Note [Associated type tyvar names] in TyCon tcHsTyVarBndr (L _ hs_tv) = do { let name = hsTyVarName hs_tv ; mb_tv <- tcLookupLcl_maybe name diff --git a/compiler/typecheck/TcRnMonad.lhs b/compiler/typecheck/TcRnMonad.lhs index f68599898e..1b60061675 100644 --- a/compiler/typecheck/TcRnMonad.lhs +++ b/compiler/typecheck/TcRnMonad.lhs @@ -1031,11 +1031,6 @@ emitImplication ct = do { lie_var <- getConstraintVar ; updTcRef lie_var (`addImplics` unitBag ct) } -emitWC :: WantedConstraints -> TcM () -emitWC wc - = do { emitFlats (keepWanted (wc_flat wc)) - ; emitImplications (wc_impl wc) } - emitImplications :: Bag Implication -> TcM () emitImplications ct = do { lie_var <- getConstraintVar ; diff --git a/compiler/typecheck/TcSimplify.lhs b/compiler/typecheck/TcSimplify.lhs index 2c4d318335..4417408100 100644 --- a/compiler/typecheck/TcSimplify.lhs +++ b/compiler/typecheck/TcSimplify.lhs @@ -416,9 +416,10 @@ simplifyInfer _top_lvl apply_mr name_taus (untch,wanteds) ; if isEmptyVarSet qtvs && isEmptyBag bound - then ASSERT( isEmptyBag (wc_insol wanted_transformed) ) - do { traceTc "} simplifyInfer/no quantification" empty - ; emitWC wanted_transformed + then do { traceTc "} simplifyInfer/no quantification" empty + ; emitConstraints wanted_transformed + -- Includes insolubles (if -fdefer-type-errors) + -- as well as flats and implications ; return ([], [], mr_bites, TcEvBinds ev_binds_var) } else do diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index ab2880488d..2872f46a3e 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -1484,14 +1484,29 @@ checkValidClass cls ; tcAddDefaultAssocDeclCtxt (tyConName fam_tc) $ mapM_ (check_loc_at_def fam_tc) defs } + -- Check that the index of the type instance is the same as on + -- its parent class. Eg + -- class C a b where + -- type F b x a ::* + -- instnace C Int Bool where + -- type F Bool Char Int = Int + -- type F Bool Bool Int = Bool + -- Here the first and third args should match + -- the (C Int Bool) header + -- This is not to do with soundness; it's just checking that the + -- type instance arg is the sam check_loc_at_def fam_tc (ATD _tvs pats _rhs loc) -- Set the location for each of the default declarations = setSrcSpan loc $ zipWithM_ check_arg (tyConTyVars fam_tc) pats -- We only want to check this on the *class* TyVars, -- not the *family* TyVars (there may be more of these) + -- Nor do we want to check kind vars, for which we don't enforce + -- the "same name as parent" rule as we do for type variables + -- c.f. Trac #7073 check_arg fam_tc_tv at_ty - = checkTc ( not (fam_tc_tv `elem` tyvars) + = checkTc ( isKindVar fam_tc_tv + || not (fam_tc_tv `elem` tyvars) || mkTyVarTy fam_tc_tv `eqType` at_ty) (wrongATArgErr at_ty (mkTyVarTy fam_tc_tv)) diff --git a/compiler/types/Class.lhs b/compiler/types/Class.lhs index 136ecec81a..c70f16dbc6 100644 --- a/compiler/types/Class.lhs +++ b/compiler/types/Class.lhs @@ -96,10 +96,8 @@ data DefMeth = NoDefMeth -- No default method | GenDefMeth Name -- A generic default method deriving Eq -type ClassATItem = (TyCon, [ATDefault]) - -- Default associated types from these templates. If the template list is empty, - -- we assume that there is no default -- not that the default is to generate no - -- instances (this only makes a difference for warnings). +type ClassATItem = (TyCon, -- See Note [Associated type tyvar names] + [ATDefault]) -- Default associated types from these templates -- We can have more than one default per type; see -- Note [Associated type defaults] in TcTyClsDecls @@ -149,6 +147,25 @@ mkClass tyvars fds super_classes superdict_sels at_stuff classTyCon = tycon } \end{code} +Note [Associated type tyvar names] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +The TyCon of an associated type should use the same variable names as its +parent class. Thus + class C a b where + type F b x a :: * +We make F use the same Name for 'a' as C does, and similary 'b'. + +The only reason for this is when checking instances it's easier to match +them up, to ensure they match. Eg + instance C Int [d] where + type F [d] x Int = .... +we should make sure that the first and third args match the instance +header. + +This is the reason we use the Name and TyVar from the parent declaration, +in both class and instance decls: just to make this check easier. + + %************************************************************************ %* * \subsection[Class-selectors]{@Class@: simple selectors} |