Move check for dcUserTyVarBinders invariant

Previously, this check was done in mkDataCon. But this
sometimes caused assertion failures if an invalid data
con was made. I've moved the check to checkValidDataCon,
where we can be sure the datacon is otherwise valid first.

2 files changed, 22 insertions, 16 deletions

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 5e7b4cb971..f174130cec 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -87,7 +87,6 @@ import qualified Data.Data as Data
 import Data.Char
 import Data.Word
 import Data.List( find )
-import qualified Data.Set as Set
 
 {-
 Data constructor representation
@@ -887,24 +886,12 @@ mkDataCon name declared_infix prom_info
   = con
   where
     is_vanilla = null ex_tvs && null eq_spec && null theta
-    -- Check the dcUserTyVarBinders invariant
-    -- (see Note [DataCon user type variable binders])
-    user_tvbs_invariant =
-         Set.fromList (filterEqSpec eq_spec univ_tvs ++ ex_tvs)
-      == Set.fromList (binderVars user_tvbs)
-    user_tvbs' =
-      ASSERT2( user_tvbs_invariant
-             , (vcat [ ppr name
-                     , ppr univ_tvs
-                     , ppr ex_tvs
-                     , ppr eq_spec
-                     , ppr user_tvbs ]) )
-      user_tvbs
+
     con = MkData {dcName = name, dcUnique = nameUnique name,
                   dcVanilla = is_vanilla, dcInfix = declared_infix,
                   dcUnivTyVars = univ_tvs,
                   dcExTyVars = ex_tvs,
-                  dcUserTyVarBinders = user_tvbs',
+                  dcUserTyVarBinders = user_tvbs,
                   dcEqSpec = eq_spec,
                   dcOtherTheta = theta,
                   dcStupidTheta = stupid_theta,
@@ -937,7 +924,7 @@ mkDataCon name declared_infix prom_info
 
       -- See Note [Promoted data constructors] in TyCon
     prom_tv_bndrs = [ mkNamedTyConBinder vis tv
-                    | TvBndr tv vis <- user_tvbs' ]
+                    | TvBndr tv vis <- user_tvbs ]
 
     prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
     prom_res_kind  = orig_res_ty
diff --git a/compiler/typecheck/TcTyClsDecls.hs b/compiler/typecheck/TcTyClsDecls.hs
index 308fbb953e..bb350a71ec 100644
--- a/compiler/typecheck/TcTyClsDecls.hs
+++ b/compiler/typecheck/TcTyClsDecls.hs
@@ -76,6 +76,8 @@ import qualified GHC.LanguageExtensions as LangExt
 import Control.Monad
 import Data.List
 import Data.List.NonEmpty ( NonEmpty(..) )
+import qualified Data.Set as Set
+
 
 {-
 ************************************************************************
@@ -2720,6 +2722,23 @@ checkValidDataCon dflags existential_ok tc con
           --                data T = MkT {-# UNPACK #-} !a      -- Can't unpack
         ; zipWith3M_ check_bang (dataConSrcBangs con) (dataConImplBangs con) [1..]
 
+          -- Check the dcUserTyVarBinders invariant
+          -- See Note [DataCon user type variable binders] in DataCon
+          -- checked here because we sometimes build invalid DataCons before
+          -- erroring above here
+        ; when debugIsOn $
+          do { let (univs, exs, eq_spec, _, _, _) = dataConFullSig con
+                   user_tvs                       = dataConUserTyVars con
+                   user_tvbs_invariant
+                     =    Set.fromList (filterEqSpec eq_spec univs ++ exs)
+                       == Set.fromList user_tvs
+             ; MASSERT2( user_tvbs_invariant
+                       , vcat ([ ppr con
+                               , ppr univs
+                               , ppr exs
+                               , ppr eq_spec
+                               , ppr user_tvs ])) }
+
         ; traceTc "Done validity of data con" $
           vcat [ ppr con
                , text "Datacon user type:" <+> ppr (dataConUserType con)