[project @ 1996-01-08 20:28:12 by partain]
[ghc.git] / 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}