projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix Trac #3017: ensure that we quantify over enough type variables when equalities...
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcTyClsDecls.lhs
diff --git
a/compiler/typecheck/TcTyClsDecls.lhs
b/compiler/typecheck/TcTyClsDecls.lhs
index
4f6e7bd
..
158eb64
100644
(file)
--- a/
compiler/typecheck/TcTyClsDecls.lhs
+++ b/
compiler/typecheck/TcTyClsDecls.lhs
@@
-25,7
+25,6
@@
import TcHsType
import TcMType
import TcType
import TysWiredIn ( unitTy )
import TcMType
import TcType
import TysWiredIn ( unitTy )
-import FunDeps
import Type
import Generics
import Class
import Type
import Generics
import Class
@@
-328,6
+327,10
@@
tcFamInstDecl1 (decl@TyData {tcdND = new_or_data, tcdLName = L loc tc_name,
-- foralls earlier)
; mapM_ checkTyFamFreeness t_typats
-- foralls earlier)
; mapM_ checkTyFamFreeness t_typats
+ -- Check that we don't use GADT syntax in H98 world
+ ; gadt_ok <- doptM Opt_GADTs
+ ; checkTc (gadt_ok || consUseH98Syntax cons) (badGadtDecl tc_name)
+
-- (b) a newtype has exactly one constructor
; checkTc (new_or_data == DataType || isSingleton k_cons) $
newtypeConError tc_name (length k_cons)
-- (b) a newtype has exactly one constructor
; checkTc (new_or_data == DataType || isSingleton k_cons) $
newtypeConError tc_name (length k_cons)
@@
-770,9
+773,7
@@
tcTyClDecl1 calc_isrec
}
where
is_rec = calc_isrec tc_name
}
where
is_rec = calc_isrec tc_name
- h98_syntax = case cons of -- All constructors have same shape
- L _ (ConDecl { con_res = ResTyGADT _ }) : _ -> False
- _ -> True
+ h98_syntax = consUseH98Syntax cons
tcTyClDecl1 calc_isrec
(ClassDecl {tcdLName = L _ class_name, tcdTyVars = tvs,
tcTyClDecl1 calc_isrec
(ClassDecl {tcdLName = L _ class_name, tcdTyVars = tvs,
@@
-919,6
+920,11
@@
tcResultType (tmpl_tvs, res_tmpl) dc_tvs (ResTyGADT res_ty)
name = tyVarName tv
(env', occ') = tidyOccName env (getOccName name)
name = tyVarName tv
(env', occ') = tidyOccName env (getOccName name)
+consUseH98Syntax :: [LConDecl a] -> Bool
+consUseH98Syntax (L _ (ConDecl { con_res = ResTyGADT _ }) : _) = False
+consUseH98Syntax _ = True
+ -- All constructors have same shape
+
-------------------
tcConArg :: Bool -- True <=> -funbox-strict_fields
-> LHsType Name
-------------------
tcConArg :: Bool -- True <=> -funbox-strict_fields
-> LHsType Name
@@
-1165,7
+1171,7
@@
checkValidClass cls
-- class Error e => Game b mv e | b -> mv e where
-- newBoard :: MonadState b m => m ()
-- Here, MonadState has a fundep m->b, so newBoard is fine
-- class Error e => Game b mv e | b -> mv e where
-- newBoard :: MonadState b m => m ()
-- Here, MonadState has a fundep m->b, so newBoard is fine
- ; let grown_tyvars = grow theta (mkVarSet tyvars)
+ ; let grown_tyvars = growThetaTyVars theta (mkVarSet tyvars)
; checkTc (tyVarsOfType tau `intersectsVarSet` grown_tyvars)
(noClassTyVarErr cls sel_id)
; checkTc (tyVarsOfType tau `intersectsVarSet` grown_tyvars)
(noClassTyVarErr cls sel_id)