- InfixCon bty1 bty2 -> tc_datacon True [] [bty1,bty2]
- RecCon fields -> do { checkTc is_vanilla (exRecConErr name)
- ; let { (field_names, btys) = unzip fields }
- ; tc_datacon False field_names btys } }
-
-tcConDecl unbox_strict new_or_data tycon tc_tvs
- decl@(GadtDecl name con_ty)
- = do { traceTc (text "tcConDecl" <+> ppr name)
- ; (tvs, theta, bangs, arg_tys, tc, res_tys) <- tcLHsConSig con_ty
-
- ; traceTc (text "tcConDecl1" <+> ppr name)
- ; let -- Now dis-assemble the type, and check its form
- is_vanilla = null theta && mkTyVarTys tvs `tcEqTypes` res_tys
-
- -- Vanilla datacons guarantee to use the same
- -- type variables as the parent tycon
- (tvs', arg_tys', res_tys')
- | is_vanilla = (tc_tvs, substTys subst arg_tys, substTys subst res_tys)
- | otherwise = (tvs, arg_tys, res_tys)
- subst = zipTopTvSubst tvs (mkTyVarTys tc_tvs)
-
- ; traceTc (text "tcConDecl3" <+> ppr name)
- ; buildDataCon (unLoc name) False {- Not infix -} is_vanilla
- (argStrictness unbox_strict tycon bangs arg_tys)
- [{- No field labels -}]
- tvs' theta arg_tys' tycon res_tys' }
-
-tcStupidTheta :: LHsContext Name -> [LConDecl Name] -> TcM (Maybe ThetaType)
--- For GADTs we don't allow a context on the data declaration
--- whereas for standard Haskell style data declarations, we do
-tcStupidTheta ctxt (L _ (ConDecl _ _ _ _) : _)
- = do { theta <- tcHsKindedContext ctxt; return (Just theta) }
-tcStupidTheta ctxt other -- Includes an empty constructor list
- = ASSERT( null (unLoc ctxt) ) return Nothing
+ InfixCon bty1 bty2 -> tc_datacon True [] [bty1,bty2]
+ RecCon fields -> tc_datacon False field_names btys
+ where
+ (field_names, btys) = unzip fields
+
+ }
+
+tcResultType :: TyCon -> [TyVar] -> ResType Name -> TcM (TyCon, [TcType])
+tcResultType tycon tvs ResTyH98 = return (tycon, mkTyVarTys tvs)
+tcResultType _ _ (ResTyGADT res_ty) = tcLHsConResTy res_ty
+
+tryVanilla :: [TyVar] -> [TcType] -> [TyVar]
+-- (tryVanilla tvs tys) returns a permutation of tvs.
+-- It tries to re-order the tvs so that it exactly
+-- matches the [Type], if that is possible
+tryVanilla tvs (ty:tys) | Just tv <- tcGetTyVar_maybe ty -- The type is a tyvar
+ , tv `elem` tvs -- That tyvar is in the list
+ = tv : tryVanilla (delete tv tvs) tys
+tryVanilla tvs tys = tvs -- Fall through case
+