Commit 5955510e authored by Simon Peyton Jones's avatar Simon Peyton Jones

Improve constraint-used-as-type error msg

This responds to Trac #11112 by improving the error message
when the kind checker discovers something of kind Constraint
used when a type is expected
parent 94715623
......@@ -450,7 +450,7 @@ tc_hs_type hs_ty@(HsTupleTy HsBoxedOrConstraintTuple hs_tys) exp_kind@(EK exp_k
; sequence_ [ setSrcSpan loc $
checkExpectedKind ty kind
(expArgKind (ptext (sLit "a tuple")) arg_kind n)
| (ty@(L loc _),kind,n) <- zip3 hs_tys kinds [1..] ]
| (L loc ty, kind, n) <- zip3 hs_tys kinds [1..] ]
; finish_tuple hs_ty tup_sort tys exp_kind }
......@@ -466,10 +466,9 @@ tc_hs_type hs_ty@(HsTupleTy hs_tup_sort tys) exp_kind
--------- Promoted lists and tuples
tc_hs_type hs_ty@(HsExplicitListTy _k tys) exp_kind
= do { tks <- mapM tc_infer_lhs_type tys
; let taus = map fst tks
; kind <- unifyKinds (ptext (sLit "In a promoted list")) tks
tc_hs_type hs_ty@(HsExplicitListTy _k hs_tys) exp_kind
= do { (taus, kinds) <- mapAndUnzipM tc_infer_lhs_type hs_tys
; kind <- unifyKinds (ptext (sLit "In a promoted list")) hs_tys kinds
; checkExpectedKind hs_ty (mkPromotedListTy kind) exp_kind
; return (foldr (mk_cons kind) (mk_nil kind) taus) }
where
......@@ -497,7 +496,7 @@ tc_hs_type ipTy@(HsIParamTy n ty) exp_kind
tc_hs_type ty@(HsEqTy ty1 ty2) exp_kind
= do { (ty1', kind1) <- tc_infer_lhs_type ty1
; (ty2', kind2) <- tc_infer_lhs_type ty2
; checkExpectedKind ty2 kind2
; checkExpectedKind (unLoc ty2) kind2
(EK kind1 msg_fn)
; checkExpectedKind ty constraintKind exp_kind
; return (mkNakedTyConApp eqTyCon [kind1, ty1', ty2']) }
......@@ -508,14 +507,14 @@ tc_hs_type ty@(HsEqTy ty1 ty2) exp_kind
--------- Misc
tc_hs_type (HsKindSig ty sig_k) exp_kind
= do { sig_k' <- tcLHsKind sig_k
; checkExpectedKind ty sig_k' exp_kind
; checkExpectedKind (unLoc ty) sig_k' exp_kind
; tc_lhs_type ty (EK sig_k' msg_fn) }
where
msg_fn pkind = ptext (sLit "The signature specified kind")
<+> quotes (pprKind pkind)
tc_hs_type (HsCoreTy ty) exp_kind
= do { checkExpectedKind ty (typeKind ty) exp_kind
tc_hs_type hs_ty@(HsCoreTy ty) exp_kind
= do { checkExpectedKind hs_ty (typeKind ty) exp_kind
; return ty }
......@@ -1454,12 +1453,12 @@ expArgKind exp kind arg_no = EK kind msg_fn
, nest 2 $ ptext (sLit "should have kind")
<+> quotes (pprKind pkind) ]
unifyKinds :: SDoc -> [(TcType, TcKind)] -> TcM TcKind
unifyKinds fun act_kinds
unifyKinds :: SDoc -> [LHsType Name] -> [TcKind] -> TcM TcKind
unifyKinds fun hs_tys act_kinds
= do { kind <- newMetaKindVar
; let check (arg_no, (ty, act_kind))
= checkExpectedKind ty act_kind (expArgKind (quotes fun) kind arg_no)
; mapM_ check (zip [1..] act_kinds)
; let check (arg_no, L _ hs_ty, act_kind)
= checkExpectedKind hs_ty act_kind (expArgKind (quotes fun) kind arg_no)
; mapM_ check (zip3 [1..] hs_tys act_kinds)
; return kind }
checkKind :: TcKind -> TcKind -> TcM ()
......@@ -1469,7 +1468,7 @@ checkKind act_kind exp_kind
Just EQ -> return ()
_ -> unifyKindMisMatch act_kind exp_kind }
checkExpectedKind :: Outputable a => a -> TcKind -> ExpKind -> TcM ()
checkExpectedKind :: HsType Name -> TcKind -> ExpKind -> TcM ()
-- A fancy wrapper for 'unifyKindX', which tries
-- to give decent error messages.
-- (checkExpectedKind ty act_kind exp_kind)
......@@ -1513,15 +1512,7 @@ checkExpectedKind ty act_kind (EK exp_kind ek_ctxt)
OC_Occurs -> True
_bad -> False
err | isLiftedTypeKind exp_kind && isUnliftedTypeKind act_kind
= ptext (sLit "Expecting a lifted type, but") <+> quotes (ppr ty)
<+> ptext (sLit "is unlifted")
| isUnliftedTypeKind exp_kind && isLiftedTypeKind act_kind
= ptext (sLit "Expecting an unlifted type, but") <+> quotes (ppr ty)
<+> ptext (sLit "is lifted")
| occurs_check -- Must precede the "more args expected" check
err | occurs_check -- Must precede the "more args expected" check
= ptext (sLit "Kind occurs check") $$ more_info
| n_exp_as < n_act_as -- E.g. [Maybe]
......@@ -1536,9 +1527,24 @@ checkExpectedKind ty act_kind (EK exp_kind ek_ctxt)
| otherwise -- E.g. Monad [Int]
= more_info
more_info = sep [ ek_ctxt tidy_exp_kind <> comma
, nest 2 $ ptext (sLit "but") <+> quotes (ppr ty)
<+> ptext (sLit "has kind") <+> quotes (pprKind tidy_act_kind)]
more_info
| isLiftedTypeKind exp_kind && isUnliftedTypeKind act_kind
= ptext (sLit "Expecting a lifted type, but") <+> quotes (ppr ty)
<+> ptext (sLit "is unlifted")
| isUnliftedTypeKind exp_kind && isLiftedTypeKind act_kind
= ptext (sLit "Expecting an unlifted type, but") <+> quotes (ppr ty)
<+> ptext (sLit "is lifted")
| isSubOpenTypeKind exp_kind
, isConstraintKind act_kind
= ptext (sLit "Constraint") <+> quotes (ppr ty)
<+> ptext (sLit "used as a type")
| otherwise
= sep [ ek_ctxt tidy_exp_kind <> comma
, nest 2 $ ptext (sLit "but") <+> quotes (ppr ty)
<+> ptext (sLit "has kind") <+> quotes (pprKind tidy_act_kind) ]
; traceTc "checkExpectedKind 1" (ppr ty $$ ppr tidy_act_kind $$ ppr tidy_exp_kind $$ ppr env1 $$ ppr env2)
; failWithTcM (env2, err) } } }
......
SimpleFail14.hs:5:15:
Expected a type, but ‘a ~ a’ has kind ‘Constraint’
SimpleFail14.hs:5:15: error:
Constraint ‘a ~ a’ used as a type
In the type ‘a ~ a’
In the definition of data constructor ‘T’
In the data declaration for ‘T’
module T11112 where
sort :: Ord s -> [s] -> [s]
sort xs = xs
T11112.hs:3:9: error:
Constraint ‘Ord s’ used as a type
In the type signature for ‘sort’: sort :: Ord s -> [s] -> [s]
T3540.hs:4:12:
Expected a type, but ‘a ~ Int’ has kind ‘Constraint’
T3540.hs:4:12: error:
Constraint ‘a ~ Int’ used as a type
In the type signature for ‘thing’: thing :: a ~ Int
T3540.hs:7:20:
Expected a type, but ‘a ~ Int’ has kind ‘Constraint’
T3540.hs:7:20: error:
Constraint ‘a ~ Int’ used as a type
In the type signature for ‘thing1’: thing1 :: Int -> (a ~ Int)
T3540.hs:10:13:
Expected a type, but ‘a ~ Int’ has kind ‘Constraint’
T3540.hs:10:13: error:
Constraint ‘a ~ Int’ used as a type
In the type signature for ‘thing2’: thing2 :: (a ~ Int) -> Int
T3540.hs:13:12:
Expected a type, but ‘?dude :: Int’ has kind ‘Constraint’
T3540.hs:13:12: error:
Constraint ‘?dude :: Int’ used as a type
In the type signature for ‘thing3’: thing3 :: (?dude :: Int) -> Int
T3540.hs:16:11:
Expected a type, but ‘Eq a’ has kind ‘Constraint’
T3540.hs:16:11: error:
Constraint ‘Eq a’ used as a type
In the type signature for ‘thing4’: thing4 :: (Eq a) -> Int
......@@ -393,5 +393,6 @@ test('T10971d', extra_clean(['T10971c.hi', 'T10971c.o']), multimod_compile_fail,
test('CustomTypeErrors01', normal, compile_fail, [''])
test('CustomTypeErrors02', normal, compile_fail, [''])
test('CustomTypeErrors03', normal, compile_fail, [''])
test('T11112', normal, compile_fail, [''])
tcfail057.hs:5:7:
Expected a type, but ‘RealFrac a’ has kind ‘Constraint’
tcfail057.hs:5:7: error:
Constraint ‘RealFrac a’ used as a type
In the type signature for ‘f’: f :: (RealFrac a) -> a -> a
tcfail146.hs:7:22:
Expected a type, but ‘SClass a’ has kind ‘Constraint’
tcfail146.hs:7:22: error:
Constraint ‘SClass a’ used as a type
In the type ‘SClass a’
In the definition of data constructor ‘SCon’
In the data declaration for ‘SData’
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