summaryrefslogtreecommitdiff
path: root/compiler/deSugar/Check.hs
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/deSugar/Check.hs')
-rw-r--r--compiler/deSugar/Check.hs14
1 files changed, 14 insertions, 0 deletions
diff --git a/compiler/deSugar/Check.hs b/compiler/deSugar/Check.hs
index 2b1995cdd5..b0155d3e2f 100644
--- a/compiler/deSugar/Check.hs
+++ b/compiler/deSugar/Check.hs
@@ -27,6 +27,7 @@ import Id
import ConLike
import Name
import FamInstEnv
+import TysPrim (tYPETyCon)
import TysWiredIn
import TyCon
import SrcLoc
@@ -440,6 +441,19 @@ inhabitationCandidates fam_insts ty
(_:_) -> do var <- liftD $ mkPmId (toTcType core_ty)
let va = build_tm (PmVar var) dcs
return $ Right [(va, mkIdEq var, emptyBag)]
+
+ -- TYPE (which is the underlying kind behind Type, among others)
+ -- is conceptually an empty datatype, so one would expect this code
+ -- (from #14086) to compile without warnings:
+ --
+ -- f :: Type -> Int
+ -- f x = case x of {}
+ --
+ -- However, since TYPE is a primitive builtin type, not an actual
+ -- datatype, we must convince the coverage checker of this fact by
+ -- adding a special case here.
+ | tc == tYPETyCon -> pure (Right [])
+
| isClosedAlgType core_ty -> liftD $ do
var <- mkPmId (toTcType core_ty) -- it would be wrong to unify x
alts <- mapM (mkOneConFull var . RealDataCon) (tyConDataCons tc)