projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix egregious bug in deeplyInstantiate
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcDeriv.lhs
diff --git
a/compiler/typecheck/TcDeriv.lhs
b/compiler/typecheck/TcDeriv.lhs
index
8fa8c0b
..
86194c0
100644
(file)
--- a/
compiler/typecheck/TcDeriv.lhs
+++ b/
compiler/typecheck/TcDeriv.lhs
@@
-830,11
+830,11
@@
type Condition = (DynFlags, TyCon) -> Maybe SDoc
orCond :: Condition -> Condition -> Condition
orCond c1 c2 tc
= case c1 tc of
orCond :: Condition -> Condition -> Condition
orCond c1 c2 tc
= case c1 tc of
- Nothing -> Nothing -- c1 succeeds
- Just x -> case c2 tc of -- c1 fails
+ Nothing -> Nothing -- c1 succeeds
+ Just x -> case c2 tc of -- c1 fails
Nothing -> Nothing
Just y -> Just (x $$ ptext (sLit " and") $$ y)
Nothing -> Nothing
Just y -> Just (x $$ ptext (sLit " and") $$ y)
- -- Both fail
+ -- Both fail
andCond :: Condition -> Condition -> Condition
andCond c1 c2 tc = case c1 tc of
andCond :: Condition -> Condition -> Condition
andCond c1 c2 tc = case c1 tc of
@@
-845,16
+845,14
@@
cond_stdOK :: DerivContext -> Condition
cond_stdOK (Just _) _
= Nothing -- Don't check these conservative conditions for
-- standalone deriving; just generate the code
cond_stdOK (Just _) _
= Nothing -- Don't check these conservative conditions for
-- standalone deriving; just generate the code
+ -- and let the typechecker handle the result
cond_stdOK Nothing (_, rep_tc)
cond_stdOK Nothing (_, rep_tc)
- | null data_cons = Just (no_cons_why $$ suggestion)
+ | null data_cons = Just (no_cons_why rep_tc $$ suggestion)
| not (null con_whys) = Just (vcat con_whys $$ suggestion)
| otherwise = Nothing
where
suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
data_cons = tyConDataCons rep_tc
| not (null con_whys) = Just (vcat con_whys $$ suggestion)
| otherwise = Nothing
where
suggestion = ptext (sLit "Possible fix: use a standalone deriving declaration instead")
data_cons = tyConDataCons rep_tc
- no_cons_why = quotes (pprSourceTyCon rep_tc) <+>
- ptext (sLit "has no data constructors")
-
con_whys = mapCatMaybes check_con data_cons
check_con :: DataCon -> Maybe SDoc
con_whys = mapCatMaybes check_con data_cons
check_con :: DataCon -> Maybe SDoc
@@
-863,6
+861,10
@@
cond_stdOK Nothing (_, rep_tc)
, all isTauTy (dataConOrigArgTys con) = Nothing
| otherwise = Just (badCon con (ptext (sLit "does not have a Haskell-98 type")))
, all isTauTy (dataConOrigArgTys con) = Nothing
| otherwise = Just (badCon con (ptext (sLit "does not have a Haskell-98 type")))
+no_cons_why :: TyCon -> SDoc
+no_cons_why rep_tc = quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "has no data constructors")
+
cond_enumOrProduct :: Condition
cond_enumOrProduct = cond_isEnumeration `orCond`
(cond_isProduct `andCond` cond_noUnliftedArgs)
cond_enumOrProduct :: Condition
cond_enumOrProduct = cond_isEnumeration `orCond`
(cond_isProduct `andCond` cond_noUnliftedArgs)
@@
-880,11
+882,13
@@
cond_noUnliftedArgs (_, tc)
cond_isEnumeration :: Condition
cond_isEnumeration (_, rep_tc)
cond_isEnumeration :: Condition
cond_isEnumeration (_, rep_tc)
- | isEnumerationTyCon rep_tc = Nothing
- | otherwise = Just why
+ | isEnumerationTyCon rep_tc = Nothing
+ | otherwise = Just why
where
where
- why = quotes (pprSourceTyCon rep_tc) <+>
- ptext (sLit "has non-nullary constructors")
+ why = sep [ quotes (pprSourceTyCon rep_tc) <+>
+ ptext (sLit "is not an enumeration type")
+ , nest 2 $ ptext (sLit "(an enumeration consists of one or more nullary constructors)") ]
+ -- See Note [Enumeration types] in TyCon
cond_isProduct :: Condition
cond_isProduct (_, rep_tc)
cond_isProduct :: Condition
cond_isProduct (_, rep_tc)
@@
-892,7
+896,7
@@
cond_isProduct (_, rep_tc)
| otherwise = Just why
where
why = quotes (pprSourceTyCon rep_tc) <+>
| otherwise = Just why
where
why = quotes (pprSourceTyCon rep_tc) <+>
- ptext (sLit "has more than one constructor")
+ ptext (sLit "does not have precisely one constructor")
cond_typeableOK :: Condition
-- OK for Typeable class
cond_typeableOK :: Condition
-- OK for Typeable class