d4713a707d40a1d3fbaaa8bcf0c82fbc37d9bc39
[ghc.git] / compiler / typecheck / TcEnv.lhs
1 %
2 % (c) The University of Glasgow 2006
3 %
4
5 \begin{code}
6 module TcEnv(
7         TyThing(..), TcTyThing(..), TcId,
8
9         -- Instance environment, and InstInfo type
10         InstInfo(..), iDFunId, pprInstInfo, pprInstInfoDetails,
11         simpleInstInfoClsTy, simpleInstInfoTy, simpleInstInfoTyCon, 
12         InstBindings(..),
13
14         -- Global environment
15         tcExtendGlobalEnv, tcExtendGlobalEnvImplicit, setGlobalTypeEnv,
16         tcExtendGlobalValEnv,
17         tcLookupLocatedGlobal,  tcLookupGlobal, 
18         tcLookupField, tcLookupTyCon, tcLookupClass, tcLookupDataCon,
19         tcLookupLocatedGlobalId, tcLookupLocatedTyCon,
20         tcLookupLocatedClass, 
21         
22         -- Local environment
23         tcExtendKindEnv, tcExtendKindEnvTvs,
24         tcExtendTyVarEnv, tcExtendTyVarEnv2, 
25         tcExtendGhciEnv, tcExtendLetEnv,
26         tcExtendIdEnv, tcExtendIdEnv1, tcExtendIdEnv2, 
27         tcLookup, tcLookupLocated, tcLookupLocalIds, 
28         tcLookupId, tcLookupTyVar, getScopedTyVarBinds,
29         getInLocalScope,
30         wrongThingErr, pprBinders,
31
32         tcExtendRecEnv,         -- For knot-tying
33
34         -- Rules
35         tcExtendRules,
36
37         -- Defaults
38         tcGetDefaultTys,
39
40         -- Global type variables
41         tcGetGlobalTyVars,
42
43         -- Template Haskell stuff
44         checkWellStaged, tcMetaTy, thLevel, 
45         topIdLvl, thTopLevelId, thRnBrack, isBrackStage,
46
47         -- New Ids
48         newLocalName, newDFunName, newFamInstTyConName, 
49         mkStableIdFromString, mkStableIdFromName
50   ) where
51
52 #include "HsVersions.h"
53
54 import HsSyn
55 import IfaceEnv
56 import TcRnMonad
57 import TcMType
58 import TcType
59 import TcIface  
60 import PrelNames
61 import TysWiredIn
62 import Id
63 import Coercion
64 import Var
65 import VarSet
66 import RdrName
67 import InstEnv
68 import DataCon
69 import TyCon
70 import TypeRep
71 import Class
72 import Name
73 import NameEnv
74 import HscTypes
75 import DynFlags
76 import SrcLoc
77 import BasicTypes
78 import Outputable
79 import Unique
80 import FastString
81 \end{code}
82
83
84 %************************************************************************
85 %*                                                                      *
86 %*                      tcLookupGlobal                                  *
87 %*                                                                      *
88 %************************************************************************
89
90 Using the Located versions (eg. tcLookupLocatedGlobal) is preferred,
91 unless you know that the SrcSpan in the monad is already set to the
92 span of the Name.
93
94 \begin{code}
95 tcLookupLocatedGlobal :: Located Name -> TcM TyThing
96 -- c.f. IfaceEnvEnv.tcIfaceGlobal
97 tcLookupLocatedGlobal name
98   = addLocM tcLookupGlobal name
99
100 tcLookupGlobal :: Name -> TcM TyThing
101 -- The Name is almost always an ExternalName, but not always
102 -- In GHCi, we may make command-line bindings (ghci> let x = True)
103 -- that bind a GlobalId, but with an InternalName
104 tcLookupGlobal name
105   = do  { env <- getGblEnv
106         
107                 -- Try local envt
108         ; case lookupNameEnv (tcg_type_env env) name of { 
109                 Just thing -> return thing ;
110                 Nothing    -> do 
111          
112                 -- Try global envt
113         { hsc_env <- getTopEnv
114         ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
115         ; case mb_thing of  {
116             Just thing -> return thing ;
117             Nothing    -> do
118
119                 -- Should it have been in the local envt?
120         { case nameModule_maybe name of
121                 Nothing -> notFound name -- Internal names can happen in GHCi
122
123                 Just mod | mod == tcg_mod env   -- Names from this module 
124                          -> notFound name -- should be in tcg_type_env
125                          | otherwise
126                          -> tcImportDecl name   -- Go find it in an interface
127         }}}}}
128
129 tcLookupField :: Name -> TcM Id         -- Returns the selector Id
130 tcLookupField name 
131   = tcLookupId name     -- Note [Record field lookup]
132
133 {- Note [Record field lookup]
134    ~~~~~~~~~~~~~~~~~~~~~~~~~~
135 You might think we should have tcLookupGlobal here, since record fields
136 are always top level.  But consider
137         f = e { f = True }
138 Then the renamer (which does not keep track of what is a record selector
139 and what is not) will rename the definition thus
140         f_7 = e { f_7 = True }
141 Now the type checker will find f_7 in the *local* type environment, not
142 the global (imported) one. It's wrong, of course, but we want to report a tidy
143 error, not in TcEnv.notFound.  -}
144
145 tcLookupDataCon :: Name -> TcM DataCon
146 tcLookupDataCon name = do
147     thing <- tcLookupGlobal name
148     case thing of
149         ADataCon con -> return con
150         _            -> wrongThingErr "data constructor" (AGlobal thing) name
151
152 tcLookupClass :: Name -> TcM Class
153 tcLookupClass name = do
154     thing <- tcLookupGlobal name
155     case thing of
156         ATyCon tc | Just cls <- tyConClass_maybe tc -> return cls
157         _                                           -> wrongThingErr "class" (AGlobal thing) name
158
159 tcLookupTyCon :: Name -> TcM TyCon
160 tcLookupTyCon name = do
161     thing <- tcLookupGlobal name
162     case thing of
163         ATyCon tc -> return tc
164         _         -> wrongThingErr "type constructor" (AGlobal thing) name
165
166 tcLookupLocatedGlobalId :: Located Name -> TcM Id
167 tcLookupLocatedGlobalId = addLocM tcLookupId
168
169 tcLookupLocatedClass :: Located Name -> TcM Class
170 tcLookupLocatedClass = addLocM tcLookupClass
171
172 tcLookupLocatedTyCon :: Located Name -> TcM TyCon
173 tcLookupLocatedTyCon = addLocM tcLookupTyCon
174 \end{code}
175
176 \begin{code}
177 instance MonadThings (IOEnv (Env TcGblEnv TcLclEnv)) where
178     lookupThing = tcLookupGlobal
179 \end{code}
180
181 %************************************************************************
182 %*                                                                      *
183                 Extending the global environment
184 %*                                                                      *
185 %************************************************************************
186
187
188 \begin{code}
189 setGlobalTypeEnv :: TcGblEnv -> TypeEnv -> TcM TcGblEnv
190 -- Use this to update the global type env 
191 -- It updates both  * the normal tcg_type_env field
192 --                  * the tcg_type_env_var field seen by interface files
193 setGlobalTypeEnv tcg_env new_type_env
194   = do  {     -- Sync the type-envt variable seen by interface files
195            writeMutVar (tcg_type_env_var tcg_env) new_type_env
196          ; return (tcg_env { tcg_type_env = new_type_env }) }
197
198
199 tcExtendGlobalEnv :: [TyThing] -> TcM r -> TcM r
200   -- Given a mixture of Ids, TyCons, Classes, all defined in the
201   -- module being compiled, extend the global environment
202 tcExtendGlobalEnv things thing_inside
203   = do { env <- getGblEnv
204        ; let env' = env { tcg_tcs  = [ tc | ATyCon tc <- things,
205                                             not (isClassTyCon tc)]
206                                       ++ tcg_tcs env
207                         , tcg_clss = [ cl | ATyCon tc <- things,
208                                             Just cl <- [tyConClass_maybe tc]]
209                                       ++ tcg_clss env }
210        ; setGblEnv env' $
211             tcExtendGlobalEnvImplicit things thing_inside
212        }
213
214 tcExtendGlobalEnvImplicit :: [TyThing] -> TcM r -> TcM r
215   -- Extend the global environment with some TyThings that can be obtained
216   -- via implicitTyThings from other entities in the environment.  Examples
217   -- are dfuns, famInstTyCons, data cons, etc.
218   -- These TyThings are not added to tcg_tcs or tcg_clss.
219 tcExtendGlobalEnvImplicit things thing_inside
220    = do { tcg_env <- getGblEnv
221         ; let ge'  = extendTypeEnvList (tcg_type_env tcg_env) things
222         ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
223         ; setGblEnv tcg_env' thing_inside }
224
225 tcExtendGlobalValEnv :: [Id] -> TcM a -> TcM a
226   -- Same deal as tcExtendGlobalEnv, but for Ids
227 tcExtendGlobalValEnv ids thing_inside 
228   = tcExtendGlobalEnv [AnId id | id <- ids] thing_inside
229
230 tcExtendRecEnv :: [(Name,TyThing)] -> TcM r -> TcM r
231 -- Extend the global environments for the type/class knot tying game
232 -- Just like tcExtendGlobalEnv, except the argument is a list of pairs
233 tcExtendRecEnv gbl_stuff thing_inside
234  = do  { tcg_env <- getGblEnv
235        ; let ge' = extendNameEnvList (tcg_type_env tcg_env) gbl_stuff 
236        ; tcg_env' <- setGlobalTypeEnv tcg_env ge'
237        ; setGblEnv tcg_env' thing_inside }
238 \end{code}
239
240
241 %************************************************************************
242 %*                                                                      *
243 \subsection{The local environment}
244 %*                                                                      *
245 %************************************************************************
246
247 \begin{code}
248 tcLookupLocated :: Located Name -> TcM TcTyThing
249 tcLookupLocated = addLocM tcLookup
250
251 tcLookup :: Name -> TcM TcTyThing
252 tcLookup name = do
253     local_env <- getLclTypeEnv
254     case lookupNameEnv local_env name of
255         Just thing -> return thing
256         Nothing    -> AGlobal <$> tcLookupGlobal name
257
258 tcLookupTyVar :: Name -> TcM TcTyVar
259 tcLookupTyVar name = do
260     thing <- tcLookup name
261     case thing of
262         ATyVar _ ty -> return (tcGetTyVar "tcLookupTyVar" ty)
263         _           -> pprPanic "tcLookupTyVar" (ppr name)
264
265 tcLookupId :: Name -> TcM Id
266 -- Used when we aren't interested in the binding level, nor refinement. 
267 -- The "no refinement" part means that we return the un-refined Id regardless
268 -- 
269 -- The Id is never a DataCon. (Why does that matter? see TcExpr.tcId)
270 tcLookupId name = do
271     thing <- tcLookup name
272     case thing of
273         ATcId { tct_id = id} -> return id
274         AGlobal (AnId id)    -> return id
275         _                    -> pprPanic "tcLookupId" (ppr name)
276
277 tcLookupLocalIds :: [Name] -> TcM [TcId]
278 -- We expect the variables to all be bound, and all at
279 -- the same level as the lookup.  Only used in one place...
280 tcLookupLocalIds ns = do
281     env <- getLclEnv
282     return (map (lookup (tcl_env env) (thLevel (tcl_th_ctxt env))) ns)
283   where
284     lookup lenv lvl name 
285         = case lookupNameEnv lenv name of
286                 Just (ATcId { tct_id = id, tct_level = lvl1 }) 
287                         -> ASSERT( lvl == lvl1 ) id
288                 _ -> pprPanic "tcLookupLocalIds" (ppr name)
289
290 getInLocalScope :: TcM (Name -> Bool)
291   -- Ids only
292 getInLocalScope = do { lcl_env <- getLclTypeEnv
293                      ; return (`elemNameEnv` lcl_env) }
294 \end{code}
295
296 \begin{code}
297 tcExtendKindEnv :: [(Name, TcKind)] -> TcM r -> TcM r
298 tcExtendKindEnv things thing_inside
299   = updLclEnv upd thing_inside
300   where
301     upd lcl_env = lcl_env { tcl_env = extend (tcl_env lcl_env) }
302     extend env  = extendNameEnvList env [(n, AThing k) | (n,k) <- things]
303
304 tcExtendKindEnvTvs :: [LHsTyVarBndr Name] -> ([LHsTyVarBndr Name] -> TcM r) -> TcM r
305 tcExtendKindEnvTvs bndrs thing_inside
306   = tcExtendKindEnv (map (hsTyVarNameKind . unLoc) bndrs)
307                     (thing_inside bndrs)
308
309 tcExtendTyVarEnv :: [TyVar] -> TcM r -> TcM r
310 tcExtendTyVarEnv tvs thing_inside
311   = tcExtendTyVarEnv2 [(tyVarName tv, mkTyVarTy tv) | tv <- tvs] thing_inside
312
313 tcExtendTyVarEnv2 :: [(Name,TcType)] -> TcM r -> TcM r
314 tcExtendTyVarEnv2 binds thing_inside 
315   = tc_extend_local_env [(name, ATyVar name ty) | (name, ty) <- binds] thing_inside
316
317 getScopedTyVarBinds :: TcM [(Name, TcType)]
318 getScopedTyVarBinds
319   = do  { lcl_env <- getLclEnv
320         ; return [(name, ty) | ATyVar name ty <- nameEnvElts (tcl_env lcl_env)] }
321 \end{code}
322
323
324 \begin{code}
325 tcExtendLetEnv :: TopLevelFlag -> [TcId] -> TcM a -> TcM a
326 tcExtendLetEnv closed ids thing_inside 
327   = do  { stage <- getStage
328         ; tc_extend_local_env [ (idName id, ATcId { tct_id = id 
329                                                   , tct_closed = closed
330                                                   , tct_level = thLevel stage })
331                                  | id <- ids]
332           thing_inside }
333
334 tcExtendIdEnv :: [TcId] -> TcM a -> TcM a
335 tcExtendIdEnv ids thing_inside 
336   = tcExtendIdEnv2 [(idName id, id) | id <- ids] thing_inside
337
338 tcExtendIdEnv1 :: Name -> TcId -> TcM a -> TcM a
339 tcExtendIdEnv1 name id thing_inside 
340   = tcExtendIdEnv2 [(name,id)] thing_inside
341
342 tcExtendIdEnv2 :: [(Name,TcId)] -> TcM a -> TcM a
343 -- Invariant: the TcIds are fully zonked (see tcExtendIdEnv above)
344 tcExtendIdEnv2 names_w_ids thing_inside
345   = do  { stage <- getStage
346         ; tc_extend_local_env [ (name, ATcId { tct_id = id 
347                                              , tct_closed = NotTopLevel
348                                              , tct_level = thLevel stage })
349                                  | (name,id) <- names_w_ids]
350           thing_inside }
351
352 tcExtendGhciEnv :: [TcId] -> TcM a -> TcM a
353 -- Used to bind Ids for GHCi identifiers bound earlier in the user interaction
354 -- Note especially that we bind them at 
355 --  * TH level 'impLevel'.  That's because it's OK to use a variable bound
356 --    earlier in the interaction in a splice, because
357 --    GHCi has already compiled it to bytecode
358 --  * Closedness flag is TopLevel.  The thing's type is closed
359
360 tcExtendGhciEnv ids thing_inside
361   = tc_extend_local_env [ (idName id, ATcId { tct_id     = id 
362                                             , tct_closed = is_top id
363                                             , tct_level  = impLevel })
364                         | id <- ids]
365     thing_inside
366   where
367     is_top id | isEmptyVarSet (tcTyVarsOfType (idType id)) = TopLevel
368               | otherwise                                  = NotTopLevel
369
370
371 tc_extend_local_env :: [(Name, TcTyThing)] -> TcM a -> TcM a
372 -- This is the guy who does the work
373 -- Invariant: the TcIds are fully zonked. Reasons:
374 --      (a) The kinds of the forall'd type variables are defaulted
375 --          (see Kind.defaultKind, done in zonkQuantifiedTyVar)
376 --      (b) There are no via-Indirect occurrences of the bound variables
377 --          in the types, because instantiation does not look through such things
378 --      (c) The call to tyVarsOfTypes is ok without looking through refs
379
380 tc_extend_local_env extra_env thing_inside
381   = do  { traceTc "env2" (ppr extra_env)
382         ; env1 <- getLclEnv
383         ; let le'      = extendNameEnvList     (tcl_env env1) extra_env
384               rdr_env' = extendLocalRdrEnvList (tcl_rdr env1) (map fst extra_env)
385               env2     = env1 {tcl_env = le', tcl_rdr = rdr_env'}
386         ; env3 <- extend_gtvs env2
387         ; setLclEnv env3 thing_inside }
388   where
389     extend_gtvs env 
390       | isEmptyVarSet extra_tvs 
391       = return env
392       | otherwise               
393       = do { g_var <- tcExtendGlobalTyVars (tcl_tyvars env) extra_tvs
394            ; return (env { tcl_tyvars = g_var }) }
395
396     extra_tvs = foldr (unionVarSet . get_tvs) emptyVarSet extra_env
397
398     get_tvs (_, ATcId { tct_id = id, tct_closed = closed })
399       = case closed of
400           TopLevel    -> ASSERT2( isEmptyVarSet id_tvs, ppr id $$ ppr (idType id) ) 
401                          emptyVarSet
402           NotTopLevel -> id_tvs
403       where
404         id_tvs = tcTyVarsOfType (idType id)
405     get_tvs (_, ATyVar _ ty) = tcTyVarsOfType ty        -- See Note [Global TyVars]
406     get_tvs other = pprPanic "get_tvs" (ppr other)
407         
408         -- Note [Global TyVars]
409         -- It's important to add the in-scope tyvars to the global tyvar set
410         -- as well.  Consider
411         --      f (_::r) = let g y = y::r in ...
412         -- Here, g mustn't be generalised.  This is also important during
413         -- class and instance decls, when we mustn't generalise the class tyvars
414         -- when typechecking the methods.
415
416 tcExtendGlobalTyVars :: IORef VarSet -> VarSet -> TcM (IORef VarSet)
417 tcExtendGlobalTyVars gtv_var extra_global_tvs
418   = do { global_tvs <- readMutVar gtv_var
419        ; newMutVar (global_tvs `unionVarSet` extra_global_tvs) }
420 \end{code}
421
422
423 %************************************************************************
424 %*                                                                      *
425 \subsection{Rules}
426 %*                                                                      *
427 %************************************************************************
428
429 \begin{code}
430 tcExtendRules :: [LRuleDecl Id] -> TcM a -> TcM a
431         -- Just pop the new rules into the EPS and envt resp
432         -- All the rules come from an interface file, not source
433         -- Nevertheless, some may be for this module, if we read
434         -- its interface instead of its source code
435 tcExtendRules lcl_rules thing_inside
436  = do { env <- getGblEnv
437       ; let
438           env' = env { tcg_rules = lcl_rules ++ tcg_rules env }
439       ; setGblEnv env' thing_inside }
440 \end{code}
441
442
443 %************************************************************************
444 %*                                                                      *
445                 Meta level
446 %*                                                                      *
447 %************************************************************************
448
449 \begin{code}
450 checkWellStaged :: SDoc         -- What the stage check is for
451                 -> ThLevel      -- Binding level (increases inside brackets)
452                 -> ThLevel      -- Use stage
453                 -> TcM ()       -- Fail if badly staged, adding an error
454 checkWellStaged pp_thing bind_lvl use_lvl
455   | use_lvl >= bind_lvl         -- OK! Used later than bound
456   = return ()                   -- E.g.  \x -> [| $(f x) |]
457
458   | bind_lvl == outerLevel      -- GHC restriction on top level splices
459   = failWithTc $ 
460     sep [ptext (sLit "GHC stage restriction:") <+>  pp_thing,
461          nest 2 (vcat [ ptext (sLit "is used in a top-level splice or annotation,")
462                       , ptext (sLit "and must be imported, not defined locally")])]
463
464   | otherwise                   -- Badly staged
465   = failWithTc $                -- E.g.  \x -> $(f x)
466     ptext (sLit "Stage error:") <+> pp_thing <+> 
467         hsep   [ptext (sLit "is bound at stage") <+> ppr bind_lvl,
468                 ptext (sLit "but used at stage") <+> ppr use_lvl]
469
470 topIdLvl :: Id -> ThLevel
471 -- Globals may either be imported, or may be from an earlier "chunk" 
472 -- (separated by declaration splices) of this module.  The former
473 --  *can* be used inside a top-level splice, but the latter cannot.
474 -- Hence we give the former impLevel, but the latter topLevel
475 -- E.g. this is bad:
476 --      x = [| foo |]
477 --      $( f x )
478 -- By the time we are prcessing the $(f x), the binding for "x" 
479 -- will be in the global env, not the local one.
480 topIdLvl id | isLocalId id = outerLevel
481             | otherwise    = impLevel
482
483 tcMetaTy :: Name -> TcM Type
484 -- Given the name of a Template Haskell data type, 
485 -- return the type
486 -- E.g. given the name "Expr" return the type "Expr"
487 tcMetaTy tc_name = do
488     t <- tcLookupTyCon tc_name
489     return (mkTyConApp t [])
490
491 thRnBrack :: ThStage
492 -- Used *only* to indicate that we are inside a TH bracket during renaming
493 -- Tested by TcEnv.isBrackStage
494 -- See Note [Top-level Names in Template Haskell decl quotes]
495 thRnBrack = Brack (panic "thRnBrack1") (panic "thRnBrack2") (panic "thRnBrack3") 
496
497 isBrackStage :: ThStage -> Bool
498 isBrackStage (Brack {}) = True
499 isBrackStage _other     = False
500
501 thTopLevelId :: Id -> Bool
502 -- See Note [What is a top-level Id?] in TcSplice
503 thTopLevelId id = isGlobalId id || isExternalName (idName id)
504 \end{code}
505
506
507 %************************************************************************
508 %*                                                                      *
509                  getDefaultTys                                                                          
510 %*                                                                      *
511 %************************************************************************
512
513 \begin{code}
514 tcGetDefaultTys :: Bool         -- True <=> interactive context
515                 -> TcM ([Type], -- Default types
516                         (Bool,  -- True <=> Use overloaded strings
517                          Bool)) -- True <=> Use extended defaulting rules
518 tcGetDefaultTys interactive
519   = do  { dflags <- getDOpts
520         ; let ovl_strings = xopt Opt_OverloadedStrings dflags
521               extended_defaults = interactive
522                                || xopt Opt_ExtendedDefaultRules dflags
523                                         -- See also Trac #1974 
524               flags = (ovl_strings, extended_defaults)
525     
526         ; mb_defaults <- getDeclaredDefaultTys
527         ; case mb_defaults of {
528            Just tys -> return (tys, flags) ;
529                                 -- User-supplied defaults
530            Nothing  -> do
531
532         -- No use-supplied default
533         -- Use [Integer, Double], plus modifications
534         { integer_ty <- tcMetaTy integerTyConName
535         ; checkWiredInTyCon doubleTyCon
536         ; string_ty <- tcMetaTy stringTyConName
537         ; let deflt_tys = opt_deflt extended_defaults unitTy  -- Note [Default unitTy]
538                           ++ [integer_ty, doubleTy]
539                           ++ opt_deflt ovl_strings string_ty
540         ; return (deflt_tys, flags) } } }
541   where
542     opt_deflt True  ty = [ty]
543     opt_deflt False _  = []
544 \end{code}
545
546 Note [Default unitTy]
547 ~~~~~~~~~~~~~~~~~~~~~
548 In interative mode (or with -XExtendedDefaultRules) we add () as the first type we
549 try when defaulting.  This has very little real impact, except in the following case.
550 Consider: 
551         Text.Printf.printf "hello"
552 This has type (forall a. IO a); it prints "hello", and returns 'undefined'.  We don't
553 want the GHCi repl loop to try to print that 'undefined'.  The neatest thing is to
554 default the 'a' to (), rather than to Integer (which is what would otherwise happen;
555 and then GHCi doesn't attempt to print the ().  So in interactive mode, we add
556 () to the list of defaulting types.  See Trac #1200.
557
558
559 %************************************************************************
560 %*                                                                      *
561 \subsection{The InstInfo type}
562 %*                                                                      *
563 %************************************************************************
564
565 The InstInfo type summarises the information in an instance declaration
566
567     instance c => k (t tvs) where b
568
569 It is used just for *local* instance decls (not ones from interface files).
570 But local instance decls includes
571         - derived ones
572         - generic ones
573 as well as explicit user written ones.
574
575 \begin{code}
576 data InstInfo a
577   = InstInfo {
578       iSpec   :: Instance,        -- Includes the dfun id.  Its forall'd type
579       iBinds  :: InstBindings a   -- variables scope over the stuff in InstBindings!
580     }
581
582 iDFunId :: InstInfo a -> DFunId
583 iDFunId info = instanceDFunId (iSpec info)
584
585 data InstBindings a
586   = VanillaInst                 -- The normal case
587         (LHsBinds a)            -- Bindings for the instance methods
588         [LSig a]                -- User pragmas recorded for generating 
589                                 -- specialised instances
590         Bool                    -- True <=> This code came from a standalone deriving clause
591                                 --          Used only to improve error messages
592
593   | NewTypeDerived      -- Used for deriving instances of newtypes, where the
594                         -- witness dictionary is identical to the argument 
595                         -- dictionary.  Hence no bindings, no pragmas.
596
597         Coercion        -- The coercion maps from newtype to the representation type
598                         -- (mentioning type variables bound by the forall'd iSpec variables)
599                         -- E.g.   newtype instance N [a] = N1 (Tree a)
600                         --        co : N [a] ~ Tree a
601
602         TyCon           -- The TyCon is the newtype N.  If it's indexed, then it's the 
603                         -- representation TyCon, so that tyConDataCons returns [N1], 
604                         -- the "data constructor".
605                         -- See Note [Newtype deriving and unused constructors]
606                         -- in TcDeriv
607
608 pprInstInfo :: InstInfo a -> SDoc
609 pprInstInfo info = hang (ptext (sLit "instance"))
610                       2 (sep [ ifPprDebug (pprForAll tvs)
611                              , pprThetaArrowTy theta, ppr tau
612                              , ptext (sLit "where")])
613   where
614     (tvs, theta, tau) = tcSplitSigmaTy (idType (iDFunId info))
615
616
617 pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
618 pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
619   where
620     details (VanillaInst b _ _) = pprLHsBinds b
621     details (NewTypeDerived {}) = text "Derived from the representation type"
622
623 simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
624 simpleInstInfoClsTy info = case instanceHead (iSpec info) of
625                            (_, _, cls, [ty]) -> (cls, ty)
626                            _ -> panic "simpleInstInfoClsTy"
627
628 simpleInstInfoTy :: InstInfo a -> Type
629 simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
630
631 simpleInstInfoTyCon :: InstInfo a -> TyCon
632   -- Gets the type constructor for a simple instance declaration,
633   -- i.e. one of the form       instance (...) => C (T a b c) where ...
634 simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
635 \end{code}
636
637 Make a name for the dict fun for an instance decl.  It's an *external*
638 name, like otber top-level names, and hence must be made with newGlobalBinder.
639
640 \begin{code}
641 newDFunName :: Class -> [Type] -> SrcSpan -> TcM Name
642 newDFunName clas tys loc
643   = do  { is_boot <- tcIsHsBoot
644         ; mod     <- getModule
645         ; let info_string = occNameString (getOccName clas) ++ 
646                             concatMap (occNameString.getDFunTyKey) tys
647         ; dfun_occ <- chooseUniqueOccTc (mkDFunOcc info_string is_boot)
648         ; newGlobalBinder mod dfun_occ loc }
649 \end{code}
650
651 Make a name for the representation tycon of a family instance.  It's an
652 *external* name, like other top-level names, and hence must be made with
653 newGlobalBinder.
654
655 \begin{code}
656 newFamInstTyConName :: Located Name -> [Type] -> TcM Name
657 newFamInstTyConName (L loc tc_name) tys
658   = do  { mod   <- getModule
659         ; let info_string = occNameString (getOccName tc_name) ++ 
660                             concatMap (occNameString.getDFunTyKey) tys
661         ; occ   <- chooseUniqueOccTc (mkInstTyTcOcc info_string)
662         ; newGlobalBinder mod occ loc }
663 \end{code}
664
665 Stable names used for foreign exports and annotations.
666 For stable names, the name must be unique (see #1533).  If the
667 same thing has several stable Ids based on it, the
668 top-level bindings generated must not have the same name.
669 Hence we create an External name (doesn't change), and we
670 append a Unique to the string right here.
671
672 \begin{code}
673 mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
674 mkStableIdFromString str sig_ty loc occ_wrapper = do
675     uniq <- newUnique
676     mod <- getModule
677     let uniq_str = showSDoc (pprUnique uniq) :: String
678         occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
679         gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
680         id  = mkExportedLocalId gnm sig_ty :: Id
681     return id
682
683 mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
684 mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
685 \end{code}
686
687 %************************************************************************
688 %*                                                                      *
689 \subsection{Errors}
690 %*                                                                      *
691 %************************************************************************
692
693 \begin{code}
694 pprBinders :: [Name] -> SDoc
695 -- Used in error messages
696 -- Use quotes for a single one; they look a bit "busy" for several
697 pprBinders [bndr] = quotes (ppr bndr)
698 pprBinders bndrs  = pprWithCommas ppr bndrs
699
700 notFound :: Name -> TcM TyThing
701 notFound name 
702   = do { (gbl,lcl) <- getEnvs
703        ; failWithTc (vcat[ptext (sLit "GHC internal error:") <+> quotes (ppr name) <+> 
704                      ptext (sLit "is not in scope during type checking, but it passed the renamer"),
705                      ptext (sLit "tcg_type_env of environment:") <+> ppr (tcg_type_env gbl),
706                      ptext (sLit "tcl_env of environment:") <+> ppr (tcl_env lcl)]
707                     ) }
708
709 wrongThingErr :: String -> TcTyThing -> Name -> TcM a
710 wrongThingErr expected thing name
711   = failWithTc (pprTcTyThingCategory thing <+> quotes (ppr name) <+> 
712                 ptext (sLit "used as a") <+> text expected)
713 \end{code}