Following Trac #2905, we now require -XGADTs for *pattern matches* on
GADTs, not just on *definitions*.
Also I found that -XGADTs wasn't being checked when declaring type families,
so I fixed that too.
import DataCon
import PrelNames
import BasicTypes hiding (SuccessFlag(..))
import DataCon
import PrelNames
import BasicTypes hiding (SuccessFlag(..))
+import DynFlags ( DynFlag( Opt_GADTs ) )
import SrcLoc
import ErrUtils
import Util
import SrcLoc
import ErrUtils
import Util
pstate' | no_equalities = pstate
| otherwise = pstate { pat_eqs = True }
pstate' | no_equalities = pstate
| otherwise = pstate { pat_eqs = True }
+ ; gadts_on <- doptM Opt_GADTs
+ ; checkTc (no_equalities || gadts_on)
+ (ptext (sLit "A pattern match on a GADT requires -XGADTs"))
+ -- Trac #2905 decided that a *pattern-match* of a GADT
+ -- should require the GADT language flag
+
; unless no_equalities $ checkTc (isRigidTy pat_ty) $
nonRigidMatch (pat_ctxt pstate) data_con
; unless no_equalities $ checkTc (isRigidTy pat_ty) $
nonRigidMatch (pat_ctxt pstate) data_con
-- 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)
}
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,
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