2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[TcMonoType]{Typechecking user-specified @MonoTypes@}
7 #include "HsVersions.h"
9 module TcMonoType ( tcMonoType, tcInstanceType ) where
11 IMPORT_Trace -- ToDo: rm (debugging)
15 import TcMonad -- typechecking monad machinery
16 import AbsSyn -- the stuff being typechecked
19 import AbsPrel ( mkListTy, mkTupleTy, mkFunTy )
21 import AbsPrel ( mkListTy, mkTupleTy, mkFunTy, mkProcessorTy, mkPodTy )
22 #endif {- Data Parallel Haskell -}
23 import AbsUniType ( applySynTyCon, applyNonSynTyCon, mkDictTy,
24 getTyConArity, isSynTyCon, isTyVarTemplateTy,
25 getUniDataTyCon_maybe, maybeUnpackFunTy
26 IF_ATTACK_PRAGMAS(COMMA pprTyCon COMMA pprUniType)
27 IF_ATTACK_PRAGMAS(COMMA cmpUniType)
29 import UniType ( UniType(..) ) -- ******** CHEATING **** could be undone
30 import TyCon --( TyCon(..) ) -- ditto, only more so
32 import CE ( lookupCE, CE(..) )
33 import CmdLineOpts ( GlobalSwitch(..) )
34 import Errors ( confusedNameErr, tyConArityErr, instTypeErr,
37 import Maybes ( Maybe(..) )
38 import TcPolyType ( tcPolyType )
39 import TCE ( lookupTCE, TCE(..), UniqFM )
40 import TVE ( lookupTVE, TVE(..) )
45 tcMonoType :: CE -> TCE -> TVE -> RenamedMonoType -> Baby_TcM UniType
47 tcMonoType rec_ce rec_tce tve (MonoTyVar name)
48 = returnB_Tc (lookupTVE tve name)
50 tcMonoType rec_ce rec_tce tve (ListMonoTy ty)
51 = tcMonoType rec_ce rec_tce tve ty `thenB_Tc` \ tau_ty ->
52 returnB_Tc (mkListTy tau_ty)
54 tcMonoType rec_ce rec_tce tve (TupleMonoTy tys)
55 = mapB_Tc (tcPolyType rec_ce rec_tce tve) tys `thenB_Tc` \ tau_tys ->
56 returnB_Tc (mkTupleTy (length tau_tys) tau_tys)
58 tcMonoType rec_ce rec_tce tve (FunMonoTy ty1 ty2)
59 = tcMonoType rec_ce rec_tce tve ty1 `thenB_Tc` \ tau_ty1 ->
60 tcMonoType rec_ce rec_tce tve ty2 `thenB_Tc` \ tau_ty2 ->
61 returnB_Tc (mkFunTy tau_ty1 tau_ty2)
63 tcMonoType rec_ce rec_tce tve (MonoTyCon name@(WiredInTyCon tycon) tys)
65 arity = getTyConArity tycon
66 is_syn_tycon = isSynTyCon tycon
68 tcMonoType_help rec_ce rec_tce tve name tycon arity is_syn_tycon tys
70 tcMonoType rec_ce rec_tce tve (MonoTyCon name@(PreludeTyCon _ _ arity is_data_tycon) tys)
71 = tcMonoType_help rec_ce rec_tce tve name
72 (lookupTCE rec_tce name)
73 arity (not is_data_tycon) tys
76 tcMonoType rec_ce rec_tce tve (MonoTyCon name@(OtherTyCon _ _ arity is_data_tycon _) tys)
77 = tcMonoType_help rec_ce rec_tce tve name
78 (lookupTCE rec_tce name)
79 arity (not is_data_tycon) tys
81 tcMonoType rec_ce rec_tce tve (MonoTyCon bad_name tys)
82 = getSrcLocB_Tc `thenB_Tc` \ locn ->
83 failB_Tc (confusedNameErr
84 "Bad name for a type constructor (a class, or a Prelude name?)"
87 -- two for unfoldings only:
88 tcMonoType rec_ce rec_tce tve (MonoDict c ty)
89 = tcMonoType rec_ce rec_tce tve ty `thenB_Tc` \ new_ty ->
91 clas = lookupCE rec_ce c
93 returnB_Tc (mkDictTy clas new_ty)
95 tcMonoType rec_ce rec_tce tve (MonoTyVarTemplate tv_tmpl)
96 = returnB_Tc (lookupTVE tve tv_tmpl)
99 tcMonoType ce tce tve (MonoTyProc tys ty)
100 = tcMonoTypes ce tce tve tys `thenB_Tc` \ tau_tys ->
101 tcMonoType ce tce tve ty `thenB_Tc` \ tau_ty ->
102 returnB_Tc (mkProcessorTy tau_tys tau_ty)
104 tcMonoType ce tce tve (MonoTyPod ty)
105 = tcMonoType ce tce tve ty `thenB_Tc` \ tau_ty ->
106 returnB_Tc (mkPodTy tau_ty)
107 #endif {- Data Parallel Haskell -}
110 tcMonoType rec_ce rec_tce tve bad_ty
111 = pprPanic "tcMonoType:" (ppr PprShowAll bad_ty)
116 tcMonoType_help rec_ce rec_tce tve name tycon arity is_syn_tycon tys
117 = tcMonoTypes rec_ce rec_tce tve tys `thenB_Tc` \ tau_tys ->
118 let cur_arity = length tys in
119 getSrcLocB_Tc `thenB_Tc` \ loc ->
121 checkB_Tc (arity /= cur_arity)
122 (tyConArityErr name arity cur_arity loc) `thenB_Tc_`
124 returnB_Tc (if is_syn_tycon then
125 applySynTyCon tycon tau_tys
127 applyNonSynTyCon tycon tau_tys)
130 tcMonoTypes rec_ce rec_tce tve monotypes
131 = mapB_Tc (tcMonoType rec_ce rec_tce tve) monotypes
134 @tcInstanceType@ checks the type {\em and} its syntactic constraints:
135 it must normally look like: @instance Foo (Tycon a b c ...) ...@
136 (We're checking the @Tycon a b c ...@ part here...)
138 The exceptions to this syntactic checking: (1)~if the @GlasgowExts@
139 flag is on, or (2)~the instance is imported (they must have been
140 compiled elsewhere). In these cases, we let them go through anyway.
142 We can also have instances for functions: @instance Foo (a -> b) ...@.
145 tcInstanceType :: CE -> TCE -> TVE
146 -> Bool{-True <=> from this module-} -> SrcLoc
150 tcInstanceType ce tce tve from_here locn mono_ty
151 = tcMonoType ce tce tve mono_ty `thenB_Tc` \ tau_ty ->
153 (naughty, unkosher) = bad_shape tau_ty
155 getSwitchCheckerB_Tc `thenB_Tc` \ sw_chkr ->
157 (if not from_here || sw_chkr GlasgowExts then -- no "shape" checking
162 (instTypeErr tau_ty locn) `thenB_Tc_`
165 -- "naughty" if the type is really unacceptable, no
166 -- matter what (e.g., a type synonym); "unkosher" if
167 -- the Haskell report forbids it, but we allow it through
168 -- under -fglasgow-exts.
171 = if (is_syn_type ty) then
173 else case (getUniDataTyCon_maybe ty) of
174 Just (_,tys,_) -> (False, not (all isTyVarTemplateTy tys))
175 Nothing -> case maybeUnpackFunTy ty of
176 Just (t1, t2) -> (False,
177 not (all isTyVarTemplateTy [t1, t2]))
178 Nothing -> (True, bottom)
180 bottom = panic "bad_shape"
182 is_syn_type ty -- ToDo: move to AbsUniType (or friend)?