summaryrefslogtreecommitdiff
path: root/compiler/GHC/Tc
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/GHC/Tc')
-rw-r--r--compiler/GHC/Tc/Errors/Hole.hs2
-rw-r--r--compiler/GHC/Tc/Gen/App.hs2
-rw-r--r--compiler/GHC/Tc/Gen/Head.hs2
-rw-r--r--compiler/GHC/Tc/Solver/Interact.hs1
-rw-r--r--compiler/GHC/Tc/Solver/Monad.hs2
-rw-r--r--compiler/GHC/Tc/Solver/Rewrite.hs2
-rw-r--r--compiler/GHC/Tc/Solver/Types.hs2
-rw-r--r--compiler/GHC/Tc/TyCl/Instance.hs5
-rw-r--r--compiler/GHC/Tc/TyCl/PatSyn.hs2
-rw-r--r--compiler/GHC/Tc/Types/Constraint.hs2
-rw-r--r--compiler/GHC/Tc/Types/Origin.hs3
-rw-r--r--compiler/GHC/Tc/Utils/Instantiate.hs1
-rw-r--r--compiler/GHC/Tc/Utils/Monad.hs1
-rw-r--r--compiler/GHC/Tc/Utils/TcType.hs2
-rw-r--r--compiler/GHC/Tc/Utils/Unify.hs3
-rw-r--r--compiler/GHC/Tc/Validity.hs20
16 files changed, 10 insertions, 42 deletions
diff --git a/compiler/GHC/Tc/Errors/Hole.hs b/compiler/GHC/Tc/Errors/Hole.hs
index c2181e5c32..d4ee8abef2 100644
--- a/compiler/GHC/Tc/Errors/Hole.hs
+++ b/compiler/GHC/Tc/Errors/Hole.hs
@@ -2,8 +2,6 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ExistentialQuantification #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
module GHC.Tc.Errors.Hole
( findValidHoleFits
, tcCheckHoleFit
diff --git a/compiler/GHC/Tc/Gen/App.hs b/compiler/GHC/Tc/Gen/App.hs
index c44fb65a29..06158cace3 100644
--- a/compiler/GHC/Tc/Gen/App.hs
+++ b/compiler/GHC/Tc/Gen/App.hs
@@ -6,8 +6,6 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-} -- Wrinkle in Note [Trees That Grow]
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
{-
%
(c) The University of Glasgow 2006
diff --git a/compiler/GHC/Tc/Gen/Head.hs b/compiler/GHC/Tc/Gen/Head.hs
index 99b09487b1..5154d7c98a 100644
--- a/compiler/GHC/Tc/Gen/Head.hs
+++ b/compiler/GHC/Tc/Gen/Head.hs
@@ -9,8 +9,6 @@
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DisambiguateRecordFields #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
{-
%
(c) The University of Glasgow 2006
diff --git a/compiler/GHC/Tc/Solver/Interact.hs b/compiler/GHC/Tc/Solver/Interact.hs
index 8db260182d..139bb3b6b8 100644
--- a/compiler/GHC/Tc/Solver/Interact.hs
+++ b/compiler/GHC/Tc/Solver/Interact.hs
@@ -1,4 +1,3 @@
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Tc.Solver.Interact (
diff --git a/compiler/GHC/Tc/Solver/Monad.hs b/compiler/GHC/Tc/Solver/Monad.hs
index 63f8216633..12b6fcc69f 100644
--- a/compiler/GHC/Tc/Solver/Monad.hs
+++ b/compiler/GHC/Tc/Solver/Monad.hs
@@ -8,7 +8,7 @@
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates -Wno-orphans #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
-- | Monadic definitions for the constraint solver
module GHC.Tc.Solver.Monad (
diff --git a/compiler/GHC/Tc/Solver/Rewrite.hs b/compiler/GHC/Tc/Solver/Rewrite.hs
index 33b25f29a7..252e2aba52 100644
--- a/compiler/GHC/Tc/Solver/Rewrite.hs
+++ b/compiler/GHC/Tc/Solver/Rewrite.hs
@@ -2,8 +2,6 @@
{-# LANGUAGE DeriveFunctor #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
module GHC.Tc.Solver.Rewrite(
rewrite, rewriteArgsNom,
rewriteType
diff --git a/compiler/GHC/Tc/Solver/Types.hs b/compiler/GHC/Tc/Solver/Types.hs
index d7a46a7c61..4c52721638 100644
--- a/compiler/GHC/Tc/Solver/Types.hs
+++ b/compiler/GHC/Tc/Solver/Types.hs
@@ -1,8 +1,6 @@
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GADTs #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
-- | Utility types used within the constraint solver
module GHC.Tc.Solver.Types (
-- Inert CDictCans
diff --git a/compiler/GHC/Tc/TyCl/Instance.hs b/compiler/GHC/Tc/TyCl/Instance.hs
index 06a06a0fad..6fda868642 100644
--- a/compiler/GHC/Tc/TyCl/Instance.hs
+++ b/compiler/GHC/Tc/TyCl/Instance.hs
@@ -8,7 +8,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-- | Typechecking instance declarations
@@ -1284,7 +1283,7 @@ tcInstDecl2 (InstInfo { iSpec = ispec, iBinds = ibinds })
; self_dict <- newDict clas inst_tys
; let class_tc = classTyCon clas
loc' = noAnnSrcSpan loc
- [dict_constr] = tyConDataCons class_tc
+ dict_constr = tyConSingleDataCon class_tc
dict_bind = mkVarBind self_dict (L loc' con_app_args)
-- We don't produce a binding for the dict_constr; instead we
@@ -1368,7 +1367,7 @@ addDFunPrags dfun_id sc_meth_ids
ev_ids = mkTemplateLocalsNum 1 dfun_theta
dfun_bndrs = dfun_tvs ++ ev_ids
clas_tc = classTyCon clas
- [dict_con] = tyConDataCons clas_tc
+ dict_con = tyConSingleDataCon clas_tc
is_newtype = isNewTyCon clas_tc
wrapId :: HsWrapper -> Id -> HsExpr GhcTc
diff --git a/compiler/GHC/Tc/TyCl/PatSyn.hs b/compiler/GHC/Tc/TyCl/PatSyn.hs
index fdc4e59f1e..4c691185aa 100644
--- a/compiler/GHC/Tc/TyCl/PatSyn.hs
+++ b/compiler/GHC/Tc/TyCl/PatSyn.hs
@@ -2,8 +2,6 @@
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
diff --git a/compiler/GHC/Tc/Types/Constraint.hs b/compiler/GHC/Tc/Types/Constraint.hs
index 572efd34d4..475437701c 100644
--- a/compiler/GHC/Tc/Types/Constraint.hs
+++ b/compiler/GHC/Tc/Types/Constraint.hs
@@ -3,8 +3,6 @@
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
-- | This module defines types and simple operations over constraints, as used
-- in the type-checker and constraint solver.
module GHC.Tc.Types.Constraint (
diff --git a/compiler/GHC/Tc/Types/Origin.hs b/compiler/GHC/Tc/Types/Origin.hs
index ce16837805..6c7759db31 100644
--- a/compiler/GHC/Tc/Types/Origin.hs
+++ b/compiler/GHC/Tc/Types/Origin.hs
@@ -3,9 +3,6 @@
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PolyKinds #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-
-- | Describes the provenance of types as they flow through the type-checker.
-- The datatypes here are mainly used for error message generation.
module GHC.Tc.Types.Origin (
diff --git a/compiler/GHC/Tc/Utils/Instantiate.hs b/compiler/GHC/Tc/Utils/Instantiate.hs
index d5e8e182e9..abbee42526 100644
--- a/compiler/GHC/Tc/Utils/Instantiate.hs
+++ b/compiler/GHC/Tc/Utils/Instantiate.hs
@@ -2,7 +2,6 @@
{-# LANGUAGE DisambiguateRecordFields #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-
(c) The University of Glasgow 2006
diff --git a/compiler/GHC/Tc/Utils/Monad.hs b/compiler/GHC/Tc/Utils/Monad.hs
index 2f61ff8777..2c34b15f6f 100644
--- a/compiler/GHC/Tc/Utils/Monad.hs
+++ b/compiler/GHC/Tc/Utils/Monad.hs
@@ -4,7 +4,6 @@
{-# LANGUAGE RecordWildCards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-
(c) The University of Glasgow 2006
diff --git a/compiler/GHC/Tc/Utils/TcType.hs b/compiler/GHC/Tc/Utils/TcType.hs
index 5c1e13ab76..98b8e2ae76 100644
--- a/compiler/GHC/Tc/Utils/TcType.hs
+++ b/compiler/GHC/Tc/Utils/TcType.hs
@@ -3,8 +3,6 @@
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
diff --git a/compiler/GHC/Tc/Utils/Unify.hs b/compiler/GHC/Tc/Utils/Unify.hs
index 61787d299f..f7e1ec938a 100644
--- a/compiler/GHC/Tc/Utils/Unify.hs
+++ b/compiler/GHC/Tc/Utils/Unify.hs
@@ -2,9 +2,6 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE RecursiveDo #-}
-{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
-{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
-
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
diff --git a/compiler/GHC/Tc/Validity.hs b/compiler/GHC/Tc/Validity.hs
index 5072b8eeff..15168ddd2f 100644
--- a/compiler/GHC/Tc/Validity.hs
+++ b/compiler/GHC/Tc/Validity.hs
@@ -1734,15 +1734,12 @@ synonyms, by matching on TyConApp directly.
-}
checkValidInstance :: UserTypeCtxt -> LHsSigType GhcRn -> Type -> TcM ()
-checkValidInstance ctxt hs_type ty
- | not is_tc_app
- = failWithTc (TcRnNoClassInstHead tau)
-
- | isNothing mb_cls
- = failWithTc (TcRnIllegalClassInst (tyConFlavour tc))
-
- | otherwise
- = do { setSrcSpanA head_loc $
+checkValidInstance ctxt hs_type ty = case tau of
+ -- See Note [Instances and constraint synonyms]
+ TyConApp tc inst_tys -> case tyConClass_maybe tc of
+ Nothing -> failWithTc (TcRnIllegalClassInst (tyConFlavour tc))
+ Just clas -> do
+ { setSrcSpanA head_loc $
checkValidInstHead ctxt clas inst_tys
; traceTc "checkValidInstance {" (ppr ty)
@@ -1775,12 +1772,9 @@ checkValidInstance ctxt hs_type ty
; traceTc "End checkValidInstance }" empty
; return () }
+ _ -> failWithTc (TcRnNoClassInstHead tau)
where
(_tvs, theta, tau) = tcSplitSigmaTy ty
- is_tc_app = case tau of { TyConApp {} -> True; _ -> False }
- TyConApp tc inst_tys = tau -- See Note [Instances and constraint synonyms]
- mb_cls = tyConClass_maybe tc
- Just clas = mb_cls
-- The location of the "head" of the instance
head_loc = getLoc (getLHsInstDeclHead hs_type)