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