ghc/compiler/typecheck/TcMType.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section{Monadic type operations}
   5
   6 This module contains monadic operations over types that contain mutable type variables
   7
   8 \begin{code}
   9 module TcMType (
  10   TcTyVar, TcKind, TcType, TcTauType, TcThetaType, TcTyVarSet,
  11
  12   --------------------------------
  13   -- Creating new mutable type variables
  14   newTyVar, newHoleTyVarTy,
  15   newTyVarTy,           -- Kind -> NF_TcM TcType
  16   newTyVarTys,          -- Int -> Kind -> NF_TcM [TcType]
  17   newKindVar, newKindVars, newBoxityVar,
  18   putTcTyVar, getTcTyVar,
  19
  20   --------------------------------
  21   -- Instantiation
  22   tcInstTyVar, tcInstTyVars,
  23   tcInstSigTyVars, tcInstType, tcInstSigType,
  24   tcSplitRhoTyM,
  25
  26   --------------------------------
  27   -- Checking type validity
  28   Rank, UserTypeCtxt(..), checkValidType, pprUserTypeCtxt,
  29   SourceTyCtxt(..), checkValidTheta,
  30   checkValidInstHead, instTypeErr, checkAmbiguity,
  31
  32   --------------------------------
  33   -- Zonking
  34   zonkTcTyVar, zonkTcTyVars, zonkTcTyVarsAndFV, zonkTcSigTyVars,
  35   zonkTcType, zonkTcTypes, zonkTcClassConstraints, zonkTcThetaType,
  36   zonkTcPredType, zonkTcTypeToType, zonkTcTyVarToTyVar, zonkKindEnv,
  37
  38   ) where
  39
  40 #include "HsVersions.h"
  41
  42
  43 -- friends:
  44 import TypeRep          ( Type(..), SourceType(..), TyNote(..),  -- Friend; can see representation
  45                           Kind, ThetaType
  46                         )
  47 import TcType           ( TcType, TcThetaType, TcTauType, TcPredType,
  48                           TcTyVarSet, TcKind, TcTyVar, TyVarDetails(..),
  49                           tcEqType, tcCmpPred,
  50                           tcSplitRhoTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
  51                           tcSplitTyConApp_maybe, tcSplitForAllTys,
  52                           tcGetTyVar, tcIsTyVarTy, tcSplitSigmaTy,
  53                           isUnLiftedType, isIPPred,
  54
  55                           mkAppTy, mkTyVarTy, mkTyVarTys,
  56                           tyVarsOfPred, getClassPredTys_maybe,
  57
  58                           liftedTypeKind, openTypeKind, defaultKind, superKind,
  59                           superBoxity, liftedBoxity, typeKind,
  60                           tyVarsOfType, tyVarsOfTypes,
  61                           eqKind, isTypeKind,
  62
  63                           isFFIArgumentTy, isFFIImportResultTy
  64                         )
  65 import Subst            ( Subst, mkTopTyVarSubst, substTy )
  66 import Class            ( Class, classArity, className )
  67 import TyCon            ( TyCon, mkPrimTyCon, isSynTyCon, isUnboxedTupleTyCon,
  68                           tyConArity, tyConName )
  69 import PrimRep          ( PrimRep(VoidRep) )
  70 import Var              ( TyVar, tyVarKind, tyVarName, isTyVar, mkTyVar, isMutTyVar )
  71
  72 -- others:
  73 import TcMonad          -- TcType, amongst others
  74 import TysWiredIn       ( voidTy )
  75 import PrelNames        ( cCallableClassKey, cReturnableClassKey, hasKey )
  76 import ForeignCall      ( Safety(..) )
  77 import FunDeps          ( grow )
  78 import PprType          ( pprPred, pprSourceType, pprTheta, pprClassPred )
  79 import Name             ( Name, NamedThing(..), setNameUnique, mkSysLocalName,
  80                           mkLocalName, mkDerivedTyConOcc
  81                         )
  82 import VarSet
  83 import CmdLineOpts      ( dopt, DynFlag(..) )
  84 import Unique           ( Uniquable(..) )
  85 import SrcLoc           ( noSrcLoc )
  86 import Util             ( nOfThem, isSingleton, equalLength )
  87 import ListSetOps       ( removeDups )
  88 import Outputable
  89 \end{code}
  90
  91
  92 %************************************************************************
  93 %*                                                                      *
  94 \subsection{New type variables}
  95 %*                                                                      *
  96 %************************************************************************
  97
  98 \begin{code}
  99 newTyVar :: Kind -> NF_TcM TcTyVar
 100 newTyVar kind
 101   = tcGetUnique         `thenNF_Tc` \ uniq ->
 102     tcNewMutTyVar (mkSysLocalName uniq SLIT("t")) kind VanillaTv
 103
 104 newTyVarTy  :: Kind -> NF_TcM TcType
 105 newTyVarTy kind
 106   = newTyVar kind       `thenNF_Tc` \ tc_tyvar ->
 107     returnNF_Tc (TyVarTy tc_tyvar)
 108
 109 newHoleTyVarTy :: NF_TcM TcType
 110   = tcGetUnique         `thenNF_Tc` \ uniq ->
 111     tcNewMutTyVar (mkSysLocalName uniq SLIT("h")) openTypeKind HoleTv   `thenNF_Tc` \ tv ->
 112     returnNF_Tc (TyVarTy tv)
 113
 114 newTyVarTys :: Int -> Kind -> NF_TcM [TcType]
 115 newTyVarTys n kind = mapNF_Tc newTyVarTy (nOfThem n kind)
 116
 117 newKindVar :: NF_TcM TcKind
 118 newKindVar
 119   = tcGetUnique                                                         `thenNF_Tc` \ uniq ->
 120     tcNewMutTyVar (mkSysLocalName uniq SLIT("k")) superKind VanillaTv   `thenNF_Tc` \ kv ->
 121     returnNF_Tc (TyVarTy kv)
 122
 123 newKindVars :: Int -> NF_TcM [TcKind]
 124 newKindVars n = mapNF_Tc (\ _ -> newKindVar) (nOfThem n ())
 125
 126 newBoxityVar :: NF_TcM TcKind
 127 newBoxityVar
 128   = tcGetUnique                                                           `thenNF_Tc` \ uniq ->
 129     tcNewMutTyVar (mkSysLocalName uniq SLIT("bx")) superBoxity VanillaTv  `thenNF_Tc` \ kv ->
 130     returnNF_Tc (TyVarTy kv)
 131 \end{code}
 132
 133
 134 %************************************************************************
 135 %*                                                                      *
 136 \subsection{Type instantiation}
 137 %*                                                                      *
 138 %************************************************************************
 139
 140 I don't understand why this is needed
 141 An old comments says "No need for tcSplitForAllTyM because a type
 142         variable can't be instantiated to a for-all type"
 143 But the same is true of rho types!
 144
 145 \begin{code}
 146 tcSplitRhoTyM :: TcType -> NF_TcM (TcThetaType, TcType)
 147 tcSplitRhoTyM t
 148   = go t t []
 149  where
 150         -- A type variable is never instantiated to a dictionary type,
 151         -- so we don't need to do a tcReadVar on the "arg".
 152     go syn_t (FunTy arg res) ts = case tcSplitPredTy_maybe arg of
 153                                         Just pair -> go res res (pair:ts)
 154                                         Nothing   -> returnNF_Tc (reverse ts, syn_t)
 155     go syn_t (NoteTy n t)    ts = go syn_t t ts
 156     go syn_t (TyVarTy tv)    ts = getTcTyVar tv         `thenNF_Tc` \ maybe_ty ->
 157                                   case maybe_ty of
 158                                     Just ty | not (tcIsTyVarTy ty) -> go syn_t ty ts
 159                                     other                          -> returnNF_Tc (reverse ts, syn_t)
 160     go syn_t t               ts = returnNF_Tc (reverse ts, syn_t)
 161 \end{code}
 162
 163
 164 %************************************************************************
 165 %*                                                                      *
 166 \subsection{Type instantiation}
 167 %*                                                                      *
 168 %************************************************************************
 169
 170 Instantiating a bunch of type variables
 171
 172 \begin{code}
 173 tcInstTyVars :: [TyVar]
 174              -> NF_TcM ([TcTyVar], [TcType], Subst)
 175
 176 tcInstTyVars tyvars
 177   = mapNF_Tc tcInstTyVar tyvars `thenNF_Tc` \ tc_tyvars ->
 178     let
 179         tys = mkTyVarTys tc_tyvars
 180     in
 181     returnNF_Tc (tc_tyvars, tys, mkTopTyVarSubst tyvars tys)
 182                 -- Since the tyvars are freshly made,
 183                 -- they cannot possibly be captured by
 184                 -- any existing for-alls.  Hence mkTopTyVarSubst
 185
 186 tcInstTyVar tyvar
 187   = tcGetUnique                 `thenNF_Tc` \ uniq ->
 188     let
 189         name = setNameUnique (tyVarName tyvar) uniq
 190         -- Note that we don't change the print-name
 191         -- This won't confuse the type checker but there's a chance
 192         -- that two different tyvars will print the same way
 193         -- in an error message.  -dppr-debug will show up the difference
 194         -- Better watch out for this.  If worst comes to worst, just
 195         -- use mkSysLocalName.
 196     in
 197     tcNewMutTyVar name (tyVarKind tyvar) VanillaTv
 198
 199 tcInstSigTyVars :: TyVarDetails -> [TyVar] -> NF_TcM [TcTyVar]
 200 tcInstSigTyVars details tyvars  -- Very similar to tcInstTyVar
 201   = tcGetUniques        `thenNF_Tc` \ uniqs ->
 202     listTc [ ASSERT( not (kind `eqKind` openTypeKind) ) -- Shouldn't happen
 203              tcNewMutTyVar name kind details
 204            | (tyvar, uniq) <- tyvars `zip` uniqs,
 205              let name = setNameUnique (tyVarName tyvar) uniq,
 206              let kind = tyVarKind tyvar
 207            ]
 208 \end{code}
 209
 210 @tcInstType@ instantiates the outer-level for-alls of a TcType with
 211 fresh type variables, splits off the dictionary part, and returns the results.
 212
 213 \begin{code}
 214 tcInstType :: TcType -> NF_TcM ([TcTyVar], TcThetaType, TcType)
 215 tcInstType ty
 216   = case tcSplitForAllTys ty of
 217         ([],     rho) ->        -- There may be overloading but no type variables;
 218                                 --      (?x :: Int) => Int -> Int
 219                          let
 220                            (theta, tau) = tcSplitRhoTy rho      -- Used to be tcSplitRhoTyM
 221                          in
 222                          returnNF_Tc ([], theta, tau)
 223
 224         (tyvars, rho) -> tcInstTyVars tyvars                    `thenNF_Tc` \ (tyvars', _, tenv)  ->
 225                          let
 226                            (theta, tau) = tcSplitRhoTy (substTy tenv rho)       -- Used to be tcSplitRhoTyM
 227                          in
 228                          returnNF_Tc (tyvars', theta, tau)
 229
 230
 231 tcInstSigType :: TyVarDetails -> Type -> NF_TcM ([TcTyVar], TcThetaType, TcType)
 232 -- Very similar to tcInstSigType, but uses signature type variables
 233 -- Also, somewhat arbitrarily, don't deal with the monomorphic case so efficiently
 234 tcInstSigType tv_details poly_ty
 235  = let
 236         (tyvars, rho) = tcSplitForAllTys poly_ty
 237    in
 238    tcInstSigTyVars tv_details tyvars            `thenNF_Tc` \ tyvars' ->
 239         -- Make *signature* type variables
 240
 241    let
 242      tyvar_tys' = mkTyVarTys tyvars'
 243      rho' = substTy (mkTopTyVarSubst tyvars tyvar_tys') rho
 244         -- mkTopTyVarSubst because the tyvars' are fresh
 245
 246      (theta', tau') = tcSplitRhoTy rho'
 247         -- This splitRhoTy tries hard to make sure that tau' is a type synonym
 248         -- wherever possible, which can improve interface files.
 249    in
 250    returnNF_Tc (tyvars', theta', tau')
 251 \end{code}
 252
 253
 254
 255 %************************************************************************
 256 %*                                                                      *
 257 \subsection{Putting and getting  mutable type variables}
 258 %*                                                                      *
 259 %************************************************************************
 260
 261 \begin{code}
 262 putTcTyVar :: TcTyVar -> TcType -> NF_TcM TcType
 263 getTcTyVar :: TcTyVar -> NF_TcM (Maybe TcType)
 264 \end{code}
 265
 266 Putting is easy:
 267
 268 \begin{code}
 269 putTcTyVar tyvar ty
 270   | not (isMutTyVar tyvar)
 271   = pprTrace "putTcTyVar" (ppr tyvar) $
 272     returnNF_Tc ty
 273
 274   | otherwise
 275   = ASSERT( isMutTyVar tyvar )
 276     tcWriteMutTyVar tyvar (Just ty)     `thenNF_Tc_`
 277     returnNF_Tc ty
 278 \end{code}
 279
 280 Getting is more interesting.  The easy thing to do is just to read, thus:
 281
 282 \begin{verbatim}
 283 getTcTyVar tyvar = tcReadMutTyVar tyvar
 284 \end{verbatim}
 285
 286 But it's more fun to short out indirections on the way: If this
 287 version returns a TyVar, then that TyVar is unbound.  If it returns
 288 any other type, then there might be bound TyVars embedded inside it.
 289
 290 We return Nothing iff the original box was unbound.
 291
 292 \begin{code}
 293 getTcTyVar tyvar
 294   | not (isMutTyVar tyvar)
 295   = pprTrace "getTcTyVar" (ppr tyvar) $
 296     returnNF_Tc (Just (mkTyVarTy tyvar))
 297
 298   | otherwise
 299   = ASSERT2( isMutTyVar tyvar, ppr tyvar )
 300     tcReadMutTyVar tyvar                                `thenNF_Tc` \ maybe_ty ->
 301     case maybe_ty of
 302         Just ty -> short_out ty                         `thenNF_Tc` \ ty' ->
 303                    tcWriteMutTyVar tyvar (Just ty')     `thenNF_Tc_`
 304                    returnNF_Tc (Just ty')
 305
 306         Nothing    -> returnNF_Tc Nothing
 307
 308 short_out :: TcType -> NF_TcM TcType
 309 short_out ty@(TyVarTy tyvar)
 310   | not (isMutTyVar tyvar)
 311   = returnNF_Tc ty
 312
 313   | otherwise
 314   = tcReadMutTyVar tyvar        `thenNF_Tc` \ maybe_ty ->
 315     case maybe_ty of
 316         Just ty' -> short_out ty'                       `thenNF_Tc` \ ty' ->
 317                     tcWriteMutTyVar tyvar (Just ty')    `thenNF_Tc_`
 318                     returnNF_Tc ty'
 319
 320         other    -> returnNF_Tc ty
 321
 322 short_out other_ty = returnNF_Tc other_ty
 323 \end{code}
 324
 325
 326 %************************************************************************
 327 %*                                                                      *
 328 \subsection{Zonking -- the exernal interfaces}
 329 %*                                                                      *
 330 %************************************************************************
 331
 332 -----------------  Type variables
 333
 334 \begin{code}
 335 zonkTcTyVars :: [TcTyVar] -> NF_TcM [TcType]
 336 zonkTcTyVars tyvars = mapNF_Tc zonkTcTyVar tyvars
 337
 338 zonkTcTyVarsAndFV :: [TcTyVar] -> NF_TcM TcTyVarSet
 339 zonkTcTyVarsAndFV tyvars = mapNF_Tc zonkTcTyVar tyvars  `thenNF_Tc` \ tys ->
 340                            returnNF_Tc (tyVarsOfTypes tys)
 341
 342 zonkTcTyVar :: TcTyVar -> NF_TcM TcType
 343 zonkTcTyVar tyvar = zonkTyVar (\ tv -> returnNF_Tc (TyVarTy tv)) tyvar
 344
 345 zonkTcSigTyVars :: [TcTyVar] -> NF_TcM [TcTyVar]
 346 -- This guy is to zonk the tyvars we're about to feed into tcSimplify
 347 -- Usually this job is done by checkSigTyVars, but in a couple of places
 348 -- that is overkill, so we use this simpler chap
 349 zonkTcSigTyVars tyvars
 350   = zonkTcTyVars tyvars `thenNF_Tc` \ tys ->
 351     returnNF_Tc (map (tcGetTyVar "zonkTcSigTyVars") tys)
 352 \end{code}
 353
 354 -----------------  Types
 355
 356 \begin{code}
 357 zonkTcType :: TcType -> NF_TcM TcType
 358 zonkTcType ty = zonkType (\ tv -> returnNF_Tc (TyVarTy tv)) ty
 359
 360 zonkTcTypes :: [TcType] -> NF_TcM [TcType]
 361 zonkTcTypes tys = mapNF_Tc zonkTcType tys
 362
 363 zonkTcClassConstraints cts = mapNF_Tc zonk cts
 364     where zonk (clas, tys)
 365             = zonkTcTypes tys   `thenNF_Tc` \ new_tys ->
 366               returnNF_Tc (clas, new_tys)
 367
 368 zonkTcThetaType :: TcThetaType -> NF_TcM TcThetaType
 369 zonkTcThetaType theta = mapNF_Tc zonkTcPredType theta
 370
 371 zonkTcPredType :: TcPredType -> NF_TcM TcPredType
 372 zonkTcPredType (ClassP c ts)
 373   = zonkTcTypes ts      `thenNF_Tc` \ new_ts ->
 374     returnNF_Tc (ClassP c new_ts)
 375 zonkTcPredType (IParam n t)
 376   = zonkTcType t        `thenNF_Tc` \ new_t ->
 377     returnNF_Tc (IParam n new_t)
 378 \end{code}
 379
 380 -------------------  These ...ToType, ...ToKind versions
 381                      are used at the end of type checking
 382
 383 \begin{code}
 384 zonkKindEnv :: [(Name, TcKind)] -> NF_TcM [(Name, Kind)]
 385 zonkKindEnv pairs
 386   = mapNF_Tc zonk_it pairs
 387  where
 388     zonk_it (name, tc_kind) = zonkType zonk_unbound_kind_var tc_kind `thenNF_Tc` \ kind ->
 389                               returnNF_Tc (name, kind)
 390
 391         -- When zonking a kind, we want to
 392         --      zonk a *kind* variable to (Type *)
 393         --      zonk a *boxity* variable to *
 394     zonk_unbound_kind_var kv | tyVarKind kv `eqKind` superKind   = putTcTyVar kv liftedTypeKind
 395                              | tyVarKind kv `eqKind` superBoxity = putTcTyVar kv liftedBoxity
 396                              | otherwise                         = pprPanic "zonkKindEnv" (ppr kv)
 397
 398 zonkTcTypeToType :: TcType -> NF_TcM Type
 399 zonkTcTypeToType ty = zonkType zonk_unbound_tyvar ty
 400   where
 401         -- Zonk a mutable but unbound type variable to
 402         --      Void            if it has kind Lifted
 403         --      :Void           otherwise
 404         -- We know it's unbound even though we don't carry an environment,
 405         -- because at the binding site for a type variable we bind the
 406         -- mutable tyvar to a fresh immutable one.  So the mutable store
 407         -- plays the role of an environment.  If we come across a mutable
 408         -- type variable that isn't so bound, it must be completely free.
 409     zonk_unbound_tyvar tv
 410         | kind `eqKind` liftedTypeKind || kind `eqKind` openTypeKind
 411         = putTcTyVar tv voidTy  -- Just to avoid creating a new tycon in
 412                                 -- this vastly common case
 413         | otherwise
 414         = putTcTyVar tv (TyConApp (mk_void_tycon tv kind) [])
 415         where
 416           kind = tyVarKind tv
 417
 418     mk_void_tycon tv kind       -- Make a new TyCon with the same kind as the
 419                                 -- type variable tv.  Same name too, apart from
 420                                 -- making it start with a colon (sigh)
 421                 -- I dread to think what will happen if this gets out into an
 422                 -- interface file.  Catastrophe likely.  Major sigh.
 423         = pprTrace "Urk! Inventing strangely-kinded void TyCon" (ppr tc_name) $
 424           mkPrimTyCon tc_name kind 0 [] VoidRep
 425         where
 426           tc_name = mkLocalName (getUnique tv) (mkDerivedTyConOcc (getOccName tv)) noSrcLoc
 427
 428 -- zonkTcTyVarToTyVar is applied to the *binding* occurrence
 429 -- of a type variable, at the *end* of type checking.  It changes
 430 -- the *mutable* type variable into an *immutable* one.
 431 --
 432 -- It does this by making an immutable version of tv and binds tv to it.
 433 -- Now any bound occurences of the original type variable will get
 434 -- zonked to the immutable version.
 435
 436 zonkTcTyVarToTyVar :: TcTyVar -> NF_TcM TyVar
 437 zonkTcTyVarToTyVar tv
 438   = let
 439                 -- Make an immutable version, defaulting
 440                 -- the kind to lifted if necessary
 441         immut_tv    = mkTyVar (tyVarName tv) (defaultKind (tyVarKind tv))
 442         immut_tv_ty = mkTyVarTy immut_tv
 443
 444         zap tv = putTcTyVar tv immut_tv_ty
 445                 -- Bind the mutable version to the immutable one
 446     in
 447         -- If the type variable is mutable, then bind it to immut_tv_ty
 448         -- so that all other occurrences of the tyvar will get zapped too
 449     zonkTyVar zap tv            `thenNF_Tc` \ ty2 ->
 450
 451     WARN( not (immut_tv_ty `tcEqType` ty2), ppr tv $$ ppr immut_tv $$ ppr ty2 )
 452
 453     returnNF_Tc immut_tv
 454 \end{code}
 455
 456
 457 %************************************************************************
 458 %*                                                                      *
 459 \subsection{Zonking -- the main work-horses: zonkType, zonkTyVar}
 460 %*                                                                      *
 461 %*              For internal use only!                                  *
 462 %*                                                                      *
 463 %************************************************************************
 464
 465 \begin{code}
 466 -- zonkType is used for Kinds as well
 467
 468 -- For unbound, mutable tyvars, zonkType uses the function given to it
 469 -- For tyvars bound at a for-all, zonkType zonks them to an immutable
 470 --      type variable and zonks the kind too
 471
 472 zonkType :: (TcTyVar -> NF_TcM Type)    -- What to do with unbound mutable type variables
 473                                         -- see zonkTcType, and zonkTcTypeToType
 474          -> TcType
 475          -> NF_TcM Type
 476 zonkType unbound_var_fn ty
 477   = go ty
 478   where
 479     go (TyConApp tycon tys)       = mapNF_Tc go tys     `thenNF_Tc` \ tys' ->
 480                                     returnNF_Tc (TyConApp tycon tys')
 481
 482     go (NoteTy (SynNote ty1) ty2) = go ty1              `thenNF_Tc` \ ty1' ->
 483                                     go ty2              `thenNF_Tc` \ ty2' ->
 484                                     returnNF_Tc (NoteTy (SynNote ty1') ty2')
 485
 486     go (NoteTy (FTVNote _) ty2)   = go ty2      -- Discard free-tyvar annotations
 487
 488     go (SourceTy p)               = go_pred p           `thenNF_Tc` \ p' ->
 489                                     returnNF_Tc (SourceTy p')
 490
 491     go (FunTy arg res)            = go arg              `thenNF_Tc` \ arg' ->
 492                                     go res              `thenNF_Tc` \ res' ->
 493                                     returnNF_Tc (FunTy arg' res')
 494
 495     go (AppTy fun arg)            = go fun              `thenNF_Tc` \ fun' ->
 496                                     go arg              `thenNF_Tc` \ arg' ->
 497                                     returnNF_Tc (mkAppTy fun' arg')
 498
 499         -- The two interesting cases!
 500     go (TyVarTy tyvar)     = zonkTyVar unbound_var_fn tyvar
 501
 502     go (ForAllTy tyvar ty) = zonkTcTyVarToTyVar tyvar   `thenNF_Tc` \ tyvar' ->
 503                              go ty                      `thenNF_Tc` \ ty' ->
 504                              returnNF_Tc (ForAllTy tyvar' ty')
 505
 506     go_pred (ClassP c tys) = mapNF_Tc go tys    `thenNF_Tc` \ tys' ->
 507                              returnNF_Tc (ClassP c tys')
 508     go_pred (NType tc tys) = mapNF_Tc go tys    `thenNF_Tc` \ tys' ->
 509                              returnNF_Tc (NType tc tys')
 510     go_pred (IParam n ty)  = go ty              `thenNF_Tc` \ ty' ->
 511                              returnNF_Tc (IParam n ty')
 512
 513 zonkTyVar :: (TcTyVar -> NF_TcM Type)           -- What to do for an unbound mutable variable
 514           -> TcTyVar -> NF_TcM TcType
 515 zonkTyVar unbound_var_fn tyvar
 516   | not (isMutTyVar tyvar)      -- Not a mutable tyvar.  This can happen when
 517                                 -- zonking a forall type, when the bound type variable
 518                                 -- needn't be mutable
 519   = ASSERT( isTyVar tyvar )             -- Should not be any immutable kind vars
 520     returnNF_Tc (TyVarTy tyvar)
 521
 522   | otherwise
 523   =  getTcTyVar tyvar   `thenNF_Tc` \ maybe_ty ->
 524      case maybe_ty of
 525           Nothing       -> unbound_var_fn tyvar                 -- Mutable and unbound
 526           Just other_ty -> zonkType unbound_var_fn other_ty     -- Bound
 527 \end{code}
 528
 529
 530
 531 %************************************************************************
 532 %*                                                                      *
 533 \subsection{Checking a user type}
 534 %*                                                                      *
 535 %************************************************************************
 536
 537 When dealing with a user-written type, we first translate it from an HsType
 538 to a Type, performing kind checking, and then check various things that should
 539 be true about it.  We don't want to perform these checks at the same time
 540 as the initial translation because (a) they are unnecessary for interface-file
 541 types and (b) when checking a mutually recursive group of type and class decls,
 542 we can't "look" at the tycons/classes yet.  Also, the checks are are rather
 543 diverse, and used to really mess up the other code.
 544
 545 One thing we check for is 'rank'.
 546
 547         Rank 0:         monotypes (no foralls)
 548         Rank 1:         foralls at the front only, Rank 0 inside
 549         Rank 2:         foralls at the front, Rank 1 on left of fn arrow,
 550
 551         basic ::= tyvar | T basic ... basic
 552
 553         r2  ::= forall tvs. cxt => r2a
 554         r2a ::= r1 -> r2a | basic
 555         r1  ::= forall tvs. cxt => r0
 556         r0  ::= r0 -> r0 | basic
 557
 558 Another thing is to check that type synonyms are saturated.
 559 This might not necessarily show up in kind checking.
 560         type A i = i
 561         data T k = MkT (k Int)
 562         f :: T A        -- BAD!
 563
 564
 565 \begin{code}
 566 data UserTypeCtxt
 567   = FunSigCtxt Name     -- Function type signature
 568   | ExprSigCtxt         -- Expression type signature
 569   | ConArgCtxt Name     -- Data constructor argument
 570   | TySynCtxt Name      -- RHS of a type synonym decl
 571   | GenPatCtxt          -- Pattern in generic decl
 572                         --      f{| a+b |} (Inl x) = ...
 573   | PatSigCtxt          -- Type sig in pattern
 574                         --      f (x::t) = ...
 575   | ResSigCtxt          -- Result type sig
 576                         --      f x :: t = ....
 577   | ForSigCtxt Name     -- Foreign inport or export signature
 578   | RuleSigCtxt Name    -- Signature on a forall'd variable in a RULE
 579
 580 -- Notes re TySynCtxt
 581 -- We allow type synonyms that aren't types; e.g.  type List = []
 582 --
 583 -- If the RHS mentions tyvars that aren't in scope, we'll
 584 -- quantify over them:
 585 --      e.g.    type T = a->a
 586 -- will become  type T = forall a. a->a
 587 --
 588 -- With gla-exts that's right, but for H98 we should complain.
 589
 590
 591 pprUserTypeCtxt (FunSigCtxt n)  = ptext SLIT("the type signature for") <+> quotes (ppr n)
 592 pprUserTypeCtxt ExprSigCtxt     = ptext SLIT("an expression type signature")
 593 pprUserTypeCtxt (ConArgCtxt c)  = ptext SLIT("the type of constructor") <+> quotes (ppr c)
 594 pprUserTypeCtxt (TySynCtxt c)   = ptext SLIT("the RHS of a type synonym declaration") <+> quotes (ppr c)
 595 pprUserTypeCtxt GenPatCtxt      = ptext SLIT("the type pattern of a generic definition")
 596 pprUserTypeCtxt PatSigCtxt      = ptext SLIT("a pattern type signature")
 597 pprUserTypeCtxt ResSigCtxt      = ptext SLIT("a result type signature")
 598 pprUserTypeCtxt (ForSigCtxt n)  = ptext SLIT("the foreign signature for") <+> quotes (ppr n)
 599 pprUserTypeCtxt (RuleSigCtxt n) = ptext SLIT("the type signature on") <+> quotes (ppr n)
 600 \end{code}
 601
 602 \begin{code}
 603 checkValidType :: UserTypeCtxt -> Type -> TcM ()
 604 -- Checks that the type is valid for the given context
 605 checkValidType ctxt ty
 606   = doptsTc Opt_GlasgowExts     `thenNF_Tc` \ gla_exts ->
 607     let
 608         rank | gla_exts = Arbitrary
 609              | otherwise
 610              = case ctxt of     -- Haskell 98
 611                  GenPatCtxt     -> Rank 0
 612                  PatSigCtxt     -> Rank 0
 613                  ResSigCtxt     -> Rank 0
 614                  TySynCtxt _    -> Rank 0
 615                  ExprSigCtxt    -> Rank 1
 616                  FunSigCtxt _   -> Rank 1
 617                  ConArgCtxt _   -> Rank 1       -- We are given the type of the entire
 618                                                 -- constructor, hence rank 1
 619                  ForSigCtxt _   -> Rank 1
 620                  RuleSigCtxt _  -> Rank 1
 621
 622         actual_kind = typeKind ty
 623
 624         actual_kind_is_lifted = actual_kind `eqKind` liftedTypeKind
 625
 626         kind_ok = case ctxt of
 627                         TySynCtxt _  -> True    -- Any kind will do
 628                         GenPatCtxt   -> actual_kind_is_lifted
 629                         ForSigCtxt _ -> actual_kind_is_lifted
 630                         other        -> isTypeKind actual_kind
 631
 632         ubx_tup | not gla_exts = UT_NotOk
 633                 | otherwise    = case ctxt of
 634                                    TySynCtxt _ -> UT_Ok
 635                                    other       -> UT_NotOk
 636                 -- Unboxed tuples ok in function results,
 637                 -- but for type synonyms we allow them even at
 638                 -- top level
 639     in
 640     tcAddErrCtxt (checkTypeCtxt ctxt ty)        $
 641
 642         -- Check that the thing has kind Type, and is lifted if necessary
 643     checkTc kind_ok (kindErr actual_kind)       `thenTc_`
 644
 645         -- Check the internal validity of the type itself
 646     check_poly_type rank ubx_tup ty
 647
 648
 649 checkTypeCtxt ctxt ty
 650   = vcat [ptext SLIT("In the type:") <+> ppr_ty ty,
 651           ptext SLIT("While checking") <+> pprUserTypeCtxt ctxt ]
 652
 653         -- Hack alert.  If there are no tyvars, (ppr sigma_ty) will print
 654         -- something strange like {Eq k} -> k -> k, because there is no
 655         -- ForAll at the top of the type.  Since this is going to the user
 656         -- we want it to look like a proper Haskell type even then; hence the hack
 657         --
 658         -- This shows up in the complaint about
 659         --      case C a where
 660         --        op :: Eq a => a -> a
 661 ppr_ty ty | null forall_tvs && not (null theta) = pprTheta theta <+> ptext SLIT("=>") <+> ppr tau
 662           | otherwise                        = ppr ty
 663           where
 664             (forall_tvs, theta, tau) = tcSplitSigmaTy ty
 665 \end{code}
 666
 667
 668 \begin{code}
 669 data Rank = Rank Int | Arbitrary
 670
 671 decRank :: Rank -> Rank
 672 decRank Arbitrary = Arbitrary
 673 decRank (Rank n)  = Rank (n-1)
 674
 675 ----------------------------------------
 676 data UbxTupFlag = UT_Ok | UT_NotOk
 677         -- The "Ok" version means "ok if -fglasgow-exts is on"
 678
 679 ----------------------------------------
 680 check_poly_type :: Rank -> UbxTupFlag -> Type -> TcM ()
 681 check_poly_type (Rank 0) ubx_tup ty
 682   = check_tau_type (Rank 0) ubx_tup ty
 683
 684 check_poly_type rank ubx_tup ty
 685   = let
 686         (tvs, theta, tau) = tcSplitSigmaTy ty
 687     in
 688     check_valid_theta SigmaCtxt theta           `thenTc_`
 689     check_tau_type (decRank rank) ubx_tup tau   `thenTc_`
 690     checkFreeness tvs theta                     `thenTc_`
 691     checkAmbiguity tvs theta (tyVarsOfType tau)
 692
 693 ----------------------------------------
 694 check_arg_type :: Type -> TcM ()
 695 -- The sort of type that can instantiate a type variable,
 696 -- or be the argument of a type constructor.
 697 -- Not an unboxed tuple, not a forall.
 698 -- Other unboxed types are very occasionally allowed as type
 699 -- arguments depending on the kind of the type constructor
 700 --
 701 -- For example, we want to reject things like:
 702 --
 703 --      instance Ord a => Ord (forall s. T s a)
 704 -- and
 705 --      g :: T s (forall b.b)
 706 --
 707 -- NB: unboxed tuples can have polymorphic or unboxed args.
 708 --     This happens in the workers for functions returning
 709 --     product types with polymorphic components.
 710 --     But not in user code.
 711 -- Anyway, they are dealt with by a special case in check_tau_type
 712
 713 check_arg_type ty
 714   = check_tau_type (Rank 0) UT_NotOk ty         `thenTc_`
 715     checkTc (not (isUnLiftedType ty)) (unliftedArgErr ty)
 716
 717 ----------------------------------------
 718 check_tau_type :: Rank -> UbxTupFlag -> Type -> TcM ()
 719 -- Rank is allowed rank for function args
 720 -- No foralls otherwise
 721
 722 check_tau_type rank ubx_tup ty@(ForAllTy _ _) = failWithTc (forAllTyErr ty)
 723 check_tau_type rank ubx_tup (SourceTy sty)    = getDOptsTc              `thenNF_Tc` \ dflags ->
 724                                                 check_source_ty dflags TypeCtxt sty
 725 check_tau_type rank ubx_tup (TyVarTy _)       = returnTc ()
 726 check_tau_type rank ubx_tup ty@(FunTy arg_ty res_ty)
 727   = check_poly_type rank UT_NotOk arg_ty        `thenTc_`
 728     check_tau_type  rank UT_Ok    res_ty
 729
 730 check_tau_type rank ubx_tup (AppTy ty1 ty2)
 731   = check_arg_type ty1 `thenTc_` check_arg_type ty2
 732
 733 check_tau_type rank ubx_tup (NoteTy note ty)
 734   = check_tau_type rank ubx_tup ty
 735         -- Synonym notes are built only when the synonym is
 736         -- saturated (see Type.mkSynTy)
 737         -- Not checking the 'note' part allows us to instantiate a synonym
 738         -- defn with a for-all type, but that seems OK too
 739
 740 check_tau_type rank ubx_tup ty@(TyConApp tc tys)
 741   | isSynTyCon tc
 742   =     -- NB: Type.mkSynTy builds a TyConApp (not a NoteTy) for an unsaturated
 743         -- synonym application, leaving it to checkValidType (i.e. right here
 744         -- to find the error
 745     checkTc syn_arity_ok arity_msg      `thenTc_`
 746     mapTc_ check_arg_type tys
 747
 748   | isUnboxedTupleTyCon tc
 749   = doptsTc Opt_GlasgowExts                     `thenNF_Tc` \ gla_exts ->
 750     checkTc (ubx_tup_ok gla_exts) ubx_tup_msg   `thenTc_`
 751     mapTc_ (check_tau_type (Rank 0) UT_Ok) tys
 752                         -- Args are allowed to be unlifted, or
 753                         -- more unboxed tuples, so can't use check_arg_ty
 754
 755   | otherwise
 756   = mapTc_ check_arg_type tys
 757
 758   where
 759     ubx_tup_ok gla_exts = case ubx_tup of { UT_Ok -> gla_exts; other -> False }
 760
 761     syn_arity_ok = tc_arity <= n_args
 762                 -- It's OK to have an *over-applied* type synonym
 763                 --      data Tree a b = ...
 764                 --      type Foo a = Tree [a]
 765                 --      f :: Foo a b -> ...
 766     n_args    = length tys
 767     tc_arity  = tyConArity tc
 768
 769     arity_msg   = arityErr "Type synonym" (tyConName tc) tc_arity n_args
 770     ubx_tup_msg = ubxArgTyErr ty
 771
 772 ----------------------------------------
 773 forAllTyErr     ty = ptext SLIT("Illegal polymorphic type:") <+> ppr_ty ty
 774 unliftedArgErr  ty = ptext SLIT("Illegal unlifted type argument:") <+> ppr_ty ty
 775 ubxArgTyErr     ty = ptext SLIT("Illegal unboxed tuple type as function argument:") <+> ppr_ty ty
 776 kindErr kind       = ptext SLIT("Expecting an ordinary type, but found a type of kind") <+> ppr kind
 777 \end{code}
 778
 779 Check for ambiguity
 780 ~~~~~~~~~~~~~~~~~~~
 781           forall V. P => tau
 782 is ambiguous if P contains generic variables
 783 (i.e. one of the Vs) that are not mentioned in tau
 784
 785 However, we need to take account of functional dependencies
 786 when we speak of 'mentioned in tau'.  Example:
 787         class C a b | a -> b where ...
 788 Then the type
 789         forall x y. (C x y) => x
 790 is not ambiguous because x is mentioned and x determines y
 791
 792 NB; the ambiguity check is only used for *user* types, not for types
 793 coming from inteface files.  The latter can legitimately have
 794 ambiguous types. Example
 795
 796    class S a where s :: a -> (Int,Int)
 797    instance S Char where s _ = (1,1)
 798    f:: S a => [a] -> Int -> (Int,Int)
 799    f (_::[a]) x = (a*x,b)
 800         where (a,b) = s (undefined::a)
 801
 802 Here the worker for f gets the type
 803         fw :: forall a. S a => Int -> (# Int, Int #)
 804
 805 If the list of tv_names is empty, we have a monotype, and then we
 806 don't need to check for ambiguity either, because the test can't fail
 807 (see is_ambig).
 808
 809 \begin{code}
 810 checkAmbiguity :: [TyVar] -> ThetaType -> TyVarSet -> TcM ()
 811 checkAmbiguity forall_tyvars theta tau_tyvars
 812   = mapTc_ complain (filter is_ambig theta)
 813   where
 814     complain pred     = addErrTc (ambigErr pred)
 815     extended_tau_vars = grow theta tau_tyvars
 816     is_ambig pred     = any ambig_var (varSetElems (tyVarsOfPred pred))
 817
 818     ambig_var ct_var  = (ct_var `elem` forall_tyvars) &&
 819                         not (ct_var `elemVarSet` extended_tau_vars)
 820
 821     is_free ct_var    = not (ct_var `elem` forall_tyvars)
 822
 823 ambigErr pred
 824   = sep [ptext SLIT("Ambiguous constraint") <+> quotes (pprPred pred),
 825          nest 4 (ptext SLIT("At least one of the forall'd type variables mentioned by the constraint") $$
 826                  ptext SLIT("must be reachable from the type after the '=>'"))]
 827 \end{code}
 828
 829 In addition, GHC insists that at least one type variable
 830 in each constraint is in V.  So we disallow a type like
 831         forall a. Eq b => b -> b
 832 even in a scope where b is in scope.
 833
 834 \begin{code}
 835 checkFreeness forall_tyvars theta
 836   = mapTc_ complain (filter is_free theta)
 837   where
 838     is_free pred     =  not (isIPPred pred)
 839                      && not (any bound_var (varSetElems (tyVarsOfPred pred)))
 840     bound_var ct_var = ct_var `elem` forall_tyvars
 841     complain pred    = addErrTc (freeErr pred)
 842
 843 freeErr pred
 844   = sep [ptext SLIT("All of the type variables in the constraint") <+> quotes (pprPred pred) <+>
 845                    ptext SLIT("are already in scope"),
 846          nest 4 (ptext SLIT("At least one must be universally quantified here"))
 847     ]
 848 \end{code}
 849
 850
 851 %************************************************************************
 852 %*                                                                      *
 853 \subsection{Checking a theta or source type}
 854 %*                                                                      *
 855 %************************************************************************
 856
 857 \begin{code}
 858 data SourceTyCtxt
 859   = ClassSCCtxt Name    -- Superclasses of clas
 860   | SigmaCtxt           -- Context of a normal for-all type
 861   | DataTyCtxt Name     -- Context of a data decl
 862   | TypeCtxt            -- Source type in an ordinary type
 863   | InstThetaCtxt       -- Context of an instance decl
 864   | InstHeadCtxt        -- Head of an instance decl
 865
 866 pprSourceTyCtxt (ClassSCCtxt c) = ptext SLIT("the super-classes of class") <+> quotes (ppr c)
 867 pprSourceTyCtxt SigmaCtxt       = ptext SLIT("the context of a polymorphic type")
 868 pprSourceTyCtxt (DataTyCtxt tc) = ptext SLIT("the context of the data type declaration for") <+> quotes (ppr tc)
 869 pprSourceTyCtxt InstThetaCtxt   = ptext SLIT("the context of an instance declaration")
 870 pprSourceTyCtxt InstHeadCtxt    = ptext SLIT("the head of an instance declaration")
 871 pprSourceTyCtxt TypeCtxt        = ptext SLIT("the context of a type")
 872 \end{code}
 873
 874 \begin{code}
 875 checkValidTheta :: SourceTyCtxt -> ThetaType -> TcM ()
 876 checkValidTheta ctxt theta
 877   = tcAddErrCtxt (checkThetaCtxt ctxt theta) (check_valid_theta ctxt theta)
 878
 879 -------------------------
 880 check_valid_theta ctxt []
 881   = returnTc ()
 882 check_valid_theta ctxt theta
 883   = getDOptsTc                                  `thenNF_Tc` \ dflags ->
 884     warnTc (not (null dups)) (dupPredWarn dups) `thenNF_Tc_`
 885     mapTc_ (check_source_ty dflags ctxt) theta
 886   where
 887     (_,dups) = removeDups tcCmpPred theta
 888
 889 -------------------------
 890 check_source_ty dflags ctxt pred@(ClassP cls tys)
 891   =     -- Class predicates are valid in all contexts
 892     mapTc_ check_arg_type tys           `thenTc_`
 893     checkTc (arity == n_tys) arity_err          `thenTc_`
 894     checkTc (all tyvar_head tys || arby_preds_ok)
 895             (predTyVarErr pred $$ how_to_allow)
 896
 897   where
 898     class_name = className cls
 899     arity      = classArity cls
 900     n_tys      = length tys
 901     arity_err  = arityErr "Class" class_name arity n_tys
 902
 903     arby_preds_ok = case ctxt of
 904                         InstHeadCtxt  -> True   -- We check for instance-head formation
 905                                                 -- in checkValidInstHead
 906                         InstThetaCtxt -> dopt Opt_AllowUndecidableInstances dflags
 907                         other         -> dopt Opt_GlasgowExts               dflags
 908
 909     how_to_allow = case ctxt of
 910                      InstHeadCtxt  -> empty     -- Should not happen
 911                      InstThetaCtxt -> parens undecidableMsg
 912                      other         -> parens (ptext SLIT("Use -fglasgow-exts to permit this"))
 913
 914 check_source_ty dflags SigmaCtxt (IParam _ ty) = check_arg_type ty
 915         -- Implicit parameters only allows in type
 916         -- signatures; not in instance decls, superclasses etc
 917         -- The reason for not allowing implicit params in instances is a bit subtle
 918         -- If we allowed        instance (?x::Int, Eq a) => Foo [a] where ...
 919         -- then when we saw (e :: (?x::Int) => t) it would be unclear how to
 920         -- discharge all the potential usas of the ?x in e.   For example, a
 921         -- constraint Foo [Int] might come out of e,and applying the
 922         -- instance decl would show up two uses of ?x.
 923
 924 check_source_ty dflags TypeCtxt  (NType tc tys)   = mapTc_ check_arg_type tys
 925
 926 -- Catch-all
 927 check_source_ty dflags ctxt sty = failWithTc (badSourceTyErr sty)
 928
 929 -------------------------
 930 tyvar_head ty                   -- Haskell 98 allows predicates of form
 931   | tcIsTyVarTy ty = True       --      C (a ty1 .. tyn)
 932   | otherwise                   -- where a is a type variable
 933   = case tcSplitAppTy_maybe ty of
 934         Just (ty, _) -> tyvar_head ty
 935         Nothing      -> False
 936 \end{code}
 937
 938 \begin{code}
 939 badSourceTyErr sty = ptext SLIT("Illegal constraint") <+> pprSourceType sty
 940 predTyVarErr pred  = ptext SLIT("Non-type variables in constraint:") <+> pprPred pred
 941 dupPredWarn dups   = ptext SLIT("Duplicate constraint(s):") <+> pprWithCommas pprPred (map head dups)
 942
 943 checkThetaCtxt ctxt theta
 944   = vcat [ptext SLIT("In the context:") <+> pprTheta theta,
 945           ptext SLIT("While checking") <+> pprSourceTyCtxt ctxt ]
 946 \end{code}
 947
 948
 949 %************************************************************************
 950 %*                                                                      *
 951 \subsection{Checking for a decent instance head type}
 952 %*                                                                      *
 953 %************************************************************************
 954
 955 @checkValidInstHead@ checks the type {\em and} its syntactic constraints:
 956 it must normally look like: @instance Foo (Tycon a b c ...) ...@
 957
 958 The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
 959 flag is on, or (2)~the instance is imported (they must have been
 960 compiled elsewhere). In these cases, we let them go through anyway.
 961
 962 We can also have instances for functions: @instance Foo (a -> b) ...@.
 963
 964 \begin{code}
 965 checkValidInstHead :: Type -> TcM (Class, [TcType])
 966
 967 checkValidInstHead ty   -- Should be a source type
 968   = case tcSplitPredTy_maybe ty of {
 969         Nothing -> failWithTc (instTypeErr (ppr ty) empty) ;
 970         Just pred ->
 971
 972     case getClassPredTys_maybe pred of {
 973         Nothing -> failWithTc (instTypeErr (pprPred pred) empty) ;
 974         Just (clas,tys) ->
 975
 976     getDOptsTc                                  `thenNF_Tc` \ dflags ->
 977     mapTc_ check_arg_type tys                   `thenTc_`
 978     check_inst_head dflags clas tys             `thenTc_`
 979     returnTc (clas, tys)
 980     }}
 981
 982 check_inst_head dflags clas tys
 983   |     -- CCALL CHECK
 984         -- A user declaration of a CCallable/CReturnable instance
 985         -- must be for a "boxed primitive" type.
 986         (clas `hasKey` cCallableClassKey
 987             && not (ccallable_type first_ty))
 988   ||    (clas `hasKey` cReturnableClassKey
 989             && not (creturnable_type first_ty))
 990   = failWithTc (nonBoxedPrimCCallErr clas first_ty)
 991
 992         -- If GlasgowExts then check at least one isn't a type variable
 993   | dopt Opt_GlasgowExts dflags
 994   = check_tyvars dflags clas tys
 995
 996         -- WITH HASKELL 1.4, MUST HAVE C (T a b c)
 997   | isSingleton tys,
 998     Just (tycon, arg_tys) <- tcSplitTyConApp_maybe first_ty,
 999     not (isSynTyCon tycon),             -- ...but not a synonym
1000     all tcIsTyVarTy arg_tys,            -- Applied to type variables
1001     equalLength (varSetElems (tyVarsOfTypes arg_tys)) arg_tys
1002           -- This last condition checks that all the type variables are distinct
1003   = returnTc ()
1004
1005   | otherwise
1006   = failWithTc (instTypeErr (pprClassPred clas tys) head_shape_msg)
1007
1008   where
1009     (first_ty : _)       = tys
1010
1011     ccallable_type   ty = isFFIArgumentTy dflags PlayRisky ty
1012     creturnable_type ty = isFFIImportResultTy dflags ty
1013
1014     head_shape_msg = parens (text "The instance type must be of form (T a b c)" $$
1015                              text "where T is not a synonym, and a,b,c are distinct type variables")
1016
1017 check_tyvars dflags clas tys
1018         -- Check that at least one isn't a type variable
1019         -- unless -fallow-undecideable-instances
1020   | dopt Opt_AllowUndecidableInstances dflags = returnTc ()
1021   | not (all tcIsTyVarTy tys)                 = returnTc ()
1022   | otherwise                                 = failWithTc (instTypeErr (pprClassPred clas tys) msg)
1023   where
1024     msg =  parens (ptext SLIT("There must be at least one non-type-variable in the instance head")
1025                    $$ undecidableMsg)
1026
1027 undecidableMsg = ptext SLIT("Use -fallow-undecidable-instances to permit this")
1028 \end{code}
1029
1030 \begin{code}
1031 instTypeErr pp_ty msg
1032   = sep [ptext SLIT("Illegal instance declaration for") <+> quotes pp_ty,
1033          nest 4 msg]
1034
1035 nonBoxedPrimCCallErr clas inst_ty
1036   = hang (ptext SLIT("Unacceptable instance type for ccall-ish class"))
1037          4 (pprClassPred clas [inst_ty])
1038 \end{code}
1039
1040