ghc/compiler/typecheck/TcContext.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[TcContext]{Typecheck a type-class context}
   5
   6 \begin{code}
   7 module TcContext ( tcContext ) where
   8
   9 #include "HsVersions.h"
  10
  11 import TcMonad          -- typechecking monadic machinery
  12 import AbsSyn           -- the stuff being typechecked
  13
  14 import CE               ( lookupCE, CE(..) )
  15 import Errors           ( naughtyCCallContextErr )
  16 import TCE              ( TCE(..), UniqFM )
  17 import TVE              ( TVE(..) )
  18 import TcMonoType       ( tcMonoType )
  19 import Unique           ( cCallableClassKey, cReturnableClassKey )
  20 import Util
  21
  22 tcContext :: CE -> TCE -> TVE -> RenamedContext -> Baby_TcM ThetaType
  23
  24 tcContext ce tce tve context
  25   = mapB_Tc (tcClassAssertion ce tce tve) context
  26
  27 tcClassAssertion ce tce tve (class_name, tyname)
  28   | canBeUsedInContext class_name
  29   = tcMonoType ce tce tve (MonoTyVar tyname) `thenB_Tc` \ ty ->
  30     returnB_Tc (lookupCE ce class_name, ty)
  31
  32   | otherwise
  33   = getSrcLocB_Tc `thenB_Tc` \ locn ->
  34     failB_Tc (naughtyCCallContextErr class_name locn)
  35 \end{code}
  36
  37 HACK warning: Someone discovered that @_CCallable_@ and @_CReturnable@
  38 could be used in contexts such as:
  39 \begin{verbatim}
  40 foo :: _CCallable a => a -> PrimIO Int
  41 \end{verbatim}
  42
  43 Doing this utterly wrecks the whole point of introducing these
  44 classes so we specifically check that this isn't being done.
  45
  46 \begin{code}
  47 canBeUsedInContext :: Name -> Bool
  48
  49 canBeUsedInContext class_name
  50   = class_name /= cCallableClass && class_name /= cReturnableClass
  51  where
  52   cCallableClass   = PreludeClass cCallableClassKey   bottom
  53   cReturnableClass = PreludeClass cReturnableClassKey bottom
  54   bottom           = panic "canBeUsedInContext"
  55 \end{code}