ghc/compiler/typecheck/TcDeriv.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[TcDeriv]{Deriving}
   5
   6 Handles @deriving@ clauses on @data@ declarations.
   7
   8 \begin{code}
   9 #include "HsVersions.h"
  10
  11 module TcDeriv ( tcDeriving ) where
  12
  13 IMP_Ubiq()
  14
  15 import HsSyn            ( HsDecl, FixityDecl, Fixity, InstDecl,
  16                           Sig, HsBinds(..), MonoBinds(..),
  17                           GRHSsAndBinds, Match, HsExpr, HsLit, InPat,
  18                           ArithSeqInfo, Fake, HsType,
  19                           collectMonoBinders
  20                         )
  21 import HsPragmas        ( InstancePragmas(..) )
  22 import RdrHsSyn         ( RdrName, SYN_IE(RdrNameMonoBinds) )
  23 import RnHsSyn          ( SYN_IE(RenamedHsBinds), SYN_IE(RenamedMonoBinds), SYN_IE(RenamedFixityDecl) )
  24
  25 import TcMonad
  26 import Inst             ( SYN_IE(InstanceMapper) )
  27 import TcEnv            ( getEnv_TyCons, tcLookupClassByKey )
  28 import SpecEnv          ( SpecEnv )
  29 import TcKind           ( TcKind )
  30 import TcGenDeriv       -- Deriv stuff
  31 import TcInstUtil       ( InstInfo(..), mkInstanceRelatedIds, buildInstanceEnvs )
  32 import TcSimplify       ( tcSimplifyThetas )
  33 import TcType           ( TcIdOcc )
  34
  35 import RnBinds          ( rnMethodBinds, rnTopMonoBinds )
  36 import RnEnv            ( newDfunName, bindLocatedLocalsRn )
  37 import RnMonad          ( SYN_IE(RnM), RnDown, GDown, SDown, RnNameSupply(..),
  38                           setNameSupplyRn, renameSourceCode, thenRn, mapRn, returnRn )
  39
  40 import Bag              ( Bag, emptyBag, isEmptyBag, unionBags, listToBag )
  41 import Class            ( classKey, GenClass, SYN_IE(Class) )
  42 import ErrUtils         ( addErrLoc, SYN_IE(Error) )
  43 import Id               ( dataConArgTys, isNullaryDataCon, mkDictFunId )
  44 import PrelInfo         ( needsDataDeclCtxtClassKeys )
  45 import Maybes           ( maybeToBool )
  46 import Name             ( isLocallyDefined, getSrcLoc, ExportFlag(..), Provenance,
  47                           Name{--O only-}, SYN_IE(Module)
  48                         )
  49 import Outputable       ( PprStyle(..), Outputable(..){-instances e.g., (,)-} )
  50 import PprType          ( GenType, GenTyVar, GenClass, TyCon )
  51 import Pretty           ( ($$), vcat, hsep, hcat, parens, empty, (<+>),
  52                           ptext, char, hang, Doc )
  53 import SrcLoc           ( mkGeneratedSrcLoc, SrcLoc )
  54 import TyCon            ( tyConTyVars, tyConDataCons, tyConDerivings,
  55                           tyConTheta, maybeTyConSingleCon, isDataTyCon,
  56                           isEnumerationTyCon, isAlgTyCon, TyCon
  57                         )
  58 import Type             ( GenType(..), SYN_IE(TauType), mkTyVarTys, applyTyCon,
  59                           mkSigmaTy, mkDictTy, isPrimType, instantiateTy,
  60                           getAppDataTyCon, getAppTyCon
  61                         )
  62 import TysPrim          ( voidTy )
  63 import TyVar            ( GenTyVar, SYN_IE(TyVar) )
  64 import UniqFM           ( emptyUFM )
  65 import Unique           -- Keys stuff
  66 import Bag              ( bagToList )
  67 import Util             ( zipWithEqual, zipEqual, sortLt, removeDups,  assoc,
  68                           thenCmp, cmpList, panic, panic#, pprPanic, pprPanic#,
  69                           Ord3(..), assertPanic-- , pprTrace{-ToDo:rm-}
  70
  71                         )
  72 \end{code}
  73
  74 %************************************************************************
  75 %*                                                                      *
  76 \subsection[TcDeriv-intro]{Introduction to how we do deriving}
  77 %*                                                                      *
  78 %************************************************************************
  79
  80 Consider
  81
  82         data T a b = C1 (Foo a) (Bar b)
  83                    | C2 Int (T b a)
  84                    | C3 (T a a)
  85                    deriving (Eq)
  86
  87 [NOTE: See end of these comments for what to do with
  88         data (C a, D b) => T a b = ...
  89 ]
  90
  91 We want to come up with an instance declaration of the form
  92
  93         instance (Ping a, Pong b, ...) => Eq (T a b) where
  94                 x == y = ...
  95
  96 It is pretty easy, albeit tedious, to fill in the code "...".  The
  97 trick is to figure out what the context for the instance decl is,
  98 namely @Ping@, @Pong@ and friends.
  99
 100 Let's call the context reqd for the T instance of class C at types
 101 (a,b, ...)  C (T a b).  Thus:
 102
 103         Eq (T a b) = (Ping a, Pong b, ...)
 104
 105 Now we can get a (recursive) equation from the @data@ decl:
 106
 107         Eq (T a b) = Eq (Foo a) u Eq (Bar b)    -- From C1
 108                    u Eq (T b a) u Eq Int        -- From C2
 109                    u Eq (T a a)                 -- From C3
 110
 111 Foo and Bar may have explicit instances for @Eq@, in which case we can
 112 just substitute for them.  Alternatively, either or both may have
 113 their @Eq@ instances given by @deriving@ clauses, in which case they
 114 form part of the system of equations.
 115
 116 Now all we need do is simplify and solve the equations, iterating to
 117 find the least fixpoint.  Notice that the order of the arguments can
 118 switch around, as here in the recursive calls to T.
 119
 120 Let's suppose Eq (Foo a) = Eq a, and Eq (Bar b) = Ping b.
 121
 122 We start with:
 123
 124         Eq (T a b) = {}         -- The empty set
 125
 126 Next iteration:
 127         Eq (T a b) = Eq (Foo a) u Eq (Bar b)    -- From C1
 128                    u Eq (T b a) u Eq Int        -- From C2
 129                    u Eq (T a a)                 -- From C3
 130
 131         After simplification:
 132                    = Eq a u Ping b u {} u {} u {}
 133                    = Eq a u Ping b
 134
 135 Next iteration:
 136
 137         Eq (T a b) = Eq (Foo a) u Eq (Bar b)    -- From C1
 138                    u Eq (T b a) u Eq Int        -- From C2
 139                    u Eq (T a a)                 -- From C3
 140
 141         After simplification:
 142                    = Eq a u Ping b
 143                    u (Eq b u Ping a)
 144                    u (Eq a u Ping a)
 145
 146                    = Eq a u Ping b u Eq b u Ping a
 147
 148 The next iteration gives the same result, so this is the fixpoint.  We
 149 need to make a canonical form of the RHS to ensure convergence.  We do
 150 this by simplifying the RHS to a form in which
 151
 152         - the classes constrain only tyvars
 153         - the list is sorted by tyvar (major key) and then class (minor key)
 154         - no duplicates, of course
 155
 156 So, here are the synonyms for the ``equation'' structures:
 157
 158 \begin{code}
 159 type DerivEqn = (Class, TyCon, [TyVar], DerivRhs)
 160                          -- The tyvars bind all the variables in the RHS
 161                          -- NEW: it's convenient to re-use InstInfo
 162                          -- We'll "panic" out some fields...
 163
 164 type DerivRhs = [(Class, TauType)]      -- Same as a ThetaType!
 165
 166 type DerivSoln = DerivRhs
 167 \end{code}
 168
 169
 170 A note about contexts on data decls
 171 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 172 Consider
 173
 174         data (RealFloat a) => Complex a = !a :+ !a deriving( Read )
 175
 176 We will need an instance decl like:
 177
 178         instance (Read a, RealFloat a) => Read (Complex a) where
 179           ...
 180
 181 The RealFloat in the context is because the read method for Complex is bound
 182 to construct a Complex, and doing that requires that the argument type is
 183 in RealFloat.
 184
 185 But this ain't true for Show, Eq, Ord, etc, since they don't construct
 186 a Complex; they only take them apart.
 187
 188 Our approach: identify the offending classes, and add the data type
 189 context to the instance decl.  The "offending classes" are
 190
 191         Read, Enum?
 192
 193
 194 %************************************************************************
 195 %*                                                                      *
 196 \subsection[TcDeriv-driver]{Top-level function for \tr{derivings}}
 197 %*                                                                      *
 198 %************************************************************************
 199
 200 \begin{code}
 201 tcDeriving  :: Module                   -- name of module under scrutiny
 202             -> RnNameSupply             -- for "renaming" bits of generated code
 203             -> Bag InstInfo             -- What we already know about instances
 204             -> TcM s (Bag InstInfo,     -- The generated "instance decls".
 205                       RenamedHsBinds,   -- Extra generated bindings
 206                       PprStyle -> Doc)  -- Printable derived instance decls;
 207                                            -- for debugging via -ddump-derivings.
 208
 209 tcDeriving modname rn_name_supply inst_decl_infos_in
 210   = recoverTc (returnTc (emptyBag, EmptyBinds, \_ -> empty)) $
 211
 212         -- Fish the "deriving"-related information out of the TcEnv
 213         -- and make the necessary "equations".
 214     makeDerivEqns                               `thenTc` \ eqns ->
 215
 216         -- Take the equation list and solve it, to deliver a list of
 217         -- solutions, a.k.a. the contexts for the instance decls
 218         -- required for the corresponding equations.
 219     solveDerivEqns inst_decl_infos_in eqns      `thenTc` \ new_inst_infos ->
 220
 221         -- Now augment the InstInfos, adding in the rather boring
 222         -- actual-code-to-do-the-methods binds.  We may also need to
 223         -- generate extra not-one-inst-decl-specific binds, notably
 224         -- "con2tag" and/or "tag2con" functions.  We do these
 225         -- separately.
 226
 227     gen_taggery_Names new_inst_infos            `thenTc` \ nm_alist_etc ->
 228
 229
 230     let
 231         extra_mbind_list = map gen_tag_n_con_monobind nm_alist_etc
 232         extra_mbinds     = foldr AndMonoBinds EmptyMonoBinds extra_mbind_list
 233         method_binds_s   = map gen_bind new_inst_infos
 234         mbinders         = bagToList (collectMonoBinders extra_mbinds)
 235
 236         -- Rename to get RenamedBinds.
 237         -- The only tricky bit is that the extra_binds must scope over the
 238         -- method bindings for the instances.
 239         (dfun_names_w_method_binds, rn_extra_binds)
 240                 = renameSourceCode modname rn_name_supply (
 241                         bindLocatedLocalsRn (\_ -> ptext (SLIT("deriving"))) mbinders   $ \ _ ->
 242                         rnTopMonoBinds extra_mbinds []          `thenRn` \ rn_extra_binds ->
 243                         mapRn rn_one method_binds_s             `thenRn` \ dfun_names_w_method_binds ->
 244                         returnRn (dfun_names_w_method_binds, rn_extra_binds)
 245                   )
 246         rn_one meth_binds = newDfunName Nothing mkGeneratedSrcLoc       `thenRn` \ dfun_name ->
 247                             rnMethodBinds meth_binds                    `thenRn` \ rn_meth_binds ->
 248                             returnRn (dfun_name, rn_meth_binds)
 249
 250         really_new_inst_infos = map (gen_inst_info modname)
 251                                     (new_inst_infos `zip` dfun_names_w_method_binds)
 252
 253         ddump_deriv = ddump_deriving really_new_inst_infos rn_extra_binds
 254     in
 255     --pprTrace "derived:\n" (ddump_deriv PprDebug) $
 256
 257     returnTc (listToBag really_new_inst_infos,
 258               rn_extra_binds,
 259               ddump_deriv)
 260   where
 261     ddump_deriving :: [InstInfo] -> RenamedHsBinds -> (PprStyle -> Doc)
 262
 263     ddump_deriving inst_infos extra_binds sty
 264       = vcat ((map pp_info inst_infos) ++ [ppr sty extra_binds])
 265       where
 266         pp_info (InstInfo clas tvs ty inst_decl_theta _ _ mbinds _ _)
 267           = ($$) (ppr sty (mkSigmaTy tvs inst_decl_theta (mkDictTy clas ty)))
 268                     (ppr sty mbinds)
 269 \end{code}
 270
 271
 272 %************************************************************************
 273 %*                                                                      *
 274 \subsection[TcDeriv-eqns]{Forming the equations}
 275 %*                                                                      *
 276 %************************************************************************
 277
 278 @makeDerivEqns@ fishes around to find the info about needed derived
 279 instances.  Complicating factors:
 280 \begin{itemize}
 281 \item
 282 We can only derive @Enum@ if the data type is an enumeration
 283 type (all nullary data constructors).
 284
 285 \item
 286 We can only derive @Ix@ if the data type is an enumeration {\em
 287 or} has just one data constructor (e.g., tuples).
 288 \end{itemize}
 289
 290 [See Appendix~E in the Haskell~1.2 report.] This code here deals w/
 291 all those.
 292
 293 \begin{code}
 294 makeDerivEqns :: TcM s [DerivEqn]
 295
 296 makeDerivEqns
 297   = tcGetEnv                        `thenNF_Tc` \ env ->
 298     let
 299         local_data_tycons = filter (\tc -> isLocallyDefined tc && isAlgTyCon tc)
 300                                    (getEnv_TyCons env)
 301     in
 302     if null local_data_tycons then
 303         -- Bale out now; evalClass may not be loaded if there aren't any
 304         returnTc []
 305     else
 306     tcLookupClassByKey evalClassKey `thenNF_Tc` \ eval_clas ->
 307     let
 308         think_about_deriving = need_deriving eval_clas local_data_tycons
 309         (derive_these, _)    = removeDups cmp_deriv think_about_deriving
 310         eqns                 = map mk_eqn derive_these
 311     in
 312     mapTc chk_out think_about_deriving `thenTc_`
 313     returnTc eqns
 314   where
 315     ------------------------------------------------------------------
 316     need_deriving :: Class -> [TyCon] -> [(Class, TyCon)]
 317         -- find the tycons that have `deriving' clauses;
 318         -- we handle the "every datatype in Eval" by
 319         -- doing a dummy "deriving" for it.
 320
 321     need_deriving eval_clas tycons_to_consider
 322       = foldr ( \ tycon acc ->
 323                    let
 324                         acc_plus = if isLocallyDefined tycon
 325                                    then (eval_clas, tycon) : acc
 326                                    else acc
 327                    in
 328                    case (tyConDerivings tycon) of
 329                      [] -> acc_plus
 330                      cs -> [ (clas,tycon) | clas <- cs ] ++ acc_plus
 331               )
 332               []
 333               tycons_to_consider
 334
 335     ------------------------------------------------------------------
 336     chk_out :: (Class, TyCon) -> TcM s ()
 337     chk_out this_one@(clas, tycon)
 338       = let
 339             clas_key = classKey clas
 340
 341             is_enumeration = isEnumerationTyCon tycon
 342             is_single_con  = maybeToBool (maybeTyConSingleCon tycon)
 343
 344             single_nullary_why = SLIT("one constructor data type or type with all nullary constructors expected")
 345             nullary_why        = SLIT("data type with all nullary constructors expected")
 346
 347             chk_clas clas_uniq clas_str clas_why cond
 348               = if (clas_uniq == clas_key)
 349                 then checkTc cond (derivingThingErr clas_str clas_why tycon)
 350                 else returnTc ()
 351         in
 352             -- Are things OK for deriving Enum (if appropriate)?
 353         chk_clas enumClassKey (SLIT("Enum")) nullary_why is_enumeration `thenTc_`
 354
 355             -- Are things OK for deriving Bounded (if appropriate)?
 356         chk_clas boundedClassKey (SLIT("Bounded")) single_nullary_why
 357                  (is_enumeration || is_single_con) `thenTc_`
 358
 359             -- Are things OK for deriving Ix (if appropriate)?
 360         chk_clas ixClassKey (SLIT("Ix.Ix")) single_nullary_why
 361                  (is_enumeration || is_single_con)
 362
 363     ------------------------------------------------------------------
 364     cmp_deriv :: (Class, TyCon) -> (Class, TyCon) -> TAG_
 365     cmp_deriv (c1, t1) (c2, t2)
 366       = (c1 `cmp` c2) `thenCmp` (t1 `cmp` t2)
 367
 368     ------------------------------------------------------------------
 369     mk_eqn :: (Class, TyCon) -> DerivEqn
 370         -- we swizzle the tyvars and datacons out of the tycon
 371         -- to make the rest of the equation
 372
 373     mk_eqn (clas, tycon)
 374       = (clas, tycon, tyvars, if_not_Eval constraints)
 375       where
 376         clas_key  = classKey clas
 377         tyvars    = tyConTyVars tycon   -- ToDo: Do we need new tyvars ???
 378         tyvar_tys = mkTyVarTys tyvars
 379         data_cons = tyConDataCons tycon
 380
 381         if_not_Eval cs = if clas_key == evalClassKey then [] else cs
 382
 383         constraints = extra_constraints ++ concat (map mk_constraints data_cons)
 384
 385         -- "extra_constraints": see notes above about contexts on data decls
 386         extra_constraints
 387           | offensive_class = tyConTheta tycon
 388           | otherwise       = []
 389            where
 390             offensive_class = clas_key `elem` needsDataDeclCtxtClassKeys
 391
 392         mk_constraints data_con
 393            = [ (clas, arg_ty)
 394              | arg_ty <- instd_arg_tys,
 395                not (isPrimType arg_ty)  -- No constraints for primitive types
 396              ]
 397            where
 398              instd_arg_tys  = dataConArgTys data_con tyvar_tys
 399 \end{code}
 400
 401 %************************************************************************
 402 %*                                                                      *
 403 \subsection[TcDeriv-fixpoint]{Finding the fixed point of \tr{deriving} equations}
 404 %*                                                                      *
 405 %************************************************************************
 406
 407 A ``solution'' (to one of the equations) is a list of (k,TyVarTy tv)
 408 terms, which is the final correct RHS for the corresponding original
 409 equation.
 410 \begin{itemize}
 411 \item
 412 Each (k,TyVarTy tv) in a solution constrains only a type
 413 variable, tv.
 414
 415 \item
 416 The (k,TyVarTy tv) pairs in a solution are canonically
 417 ordered by sorting on type varible, tv, (major key) and then class, k,
 418 (minor key)
 419 \end{itemize}
 420
 421 \begin{code}
 422 solveDerivEqns :: Bag InstInfo
 423                -> [DerivEqn]
 424                -> TcM s [InstInfo]      -- Solns in same order as eqns.
 425                                         -- This bunch is Absolutely minimal...
 426
 427 solveDerivEqns inst_decl_infos_in orig_eqns
 428   = iterateDeriv initial_solutions
 429   where
 430         -- The initial solutions for the equations claim that each
 431         -- instance has an empty context; this solution is certainly
 432         -- in canonical form.
 433     initial_solutions :: [DerivSoln]
 434     initial_solutions = [ [] | _ <- orig_eqns ]
 435
 436     ------------------------------------------------------------------
 437         -- iterateDeriv calculates the next batch of solutions,
 438         -- compares it with the current one; finishes if they are the
 439         -- same, otherwise recurses with the new solutions.
 440         -- It fails if any iteration fails
 441     iterateDeriv :: [DerivSoln] ->TcM s [InstInfo]
 442     iterateDeriv current_solns
 443       = checkNoErrsTc (iterateOnce current_solns)       `thenTc` \ (new_inst_infos, new_solns) ->
 444         if (current_solns `eq_solns` new_solns) then
 445             returnTc new_inst_infos
 446         else
 447             iterateDeriv new_solns
 448
 449     ------------------------------------------------------------------
 450     iterateOnce current_solns
 451       =     -- Extend the inst info from the explicit instance decls
 452             -- with the current set of solutions, giving a
 453
 454         add_solns inst_decl_infos_in orig_eqns current_solns
 455                                 `thenTc` \ (new_inst_infos, inst_mapper) ->
 456         let
 457            class_to_inst_env cls = inst_mapper cls
 458         in
 459             -- Simplify each RHS
 460
 461         listTc [ tcAddErrCtxt (derivCtxt tc) $
 462                  tcSimplifyThetas class_to_inst_env [{-Nothing "given"-}] deriv_rhs
 463                | (_,tc,_,deriv_rhs) <- orig_eqns ]  `thenTc` \ next_solns ->
 464
 465             -- Canonicalise the solutions, so they compare nicely
 466         let canonicalised_next_solns
 467               = [ sortLt lt_rhs next_soln | next_soln <- next_solns ]
 468         in
 469         returnTc (new_inst_infos, canonicalised_next_solns)
 470
 471     ------------------------------------------------------------------
 472     lt_rhs    r1 r2 = case cmp_rhs   r1 r2 of { LT_ -> True; _ -> False }
 473     eq_solns  s1 s2 = case cmp_solns s1 s2 of { EQ_ -> True; _ -> False }
 474     cmp_solns s1 s2 = cmpList (cmpList cmp_rhs) s1 s2
 475     cmp_rhs (c1, TyVarTy tv1) (c2, TyVarTy tv2)
 476           = (tv1 `cmp` tv2) `thenCmp` (c1 `cmp` c2)
 477 #ifdef DEBUG
 478     cmp_rhs other_1 other_2
 479           = panic# "tcDeriv:cmp_rhs:" --(hsep [ppr PprDebug other_1, ppr PprDebug other_2])
 480 #endif
 481
 482 \end{code}
 483
 484 \begin{code}
 485 add_solns :: Bag InstInfo                       -- The global, non-derived ones
 486           -> [DerivEqn] -> [DerivSoln]
 487           -> TcM s ([InstInfo],                 -- The new, derived ones
 488                     InstanceMapper)
 489     -- the eqns and solns move "in lockstep"; we have the eqns
 490     -- because we need the LHS info for addClassInstance.
 491
 492 add_solns inst_infos_in eqns solns
 493
 494 -- ------------------
 495 -- OLD: checkErrsTc above now deals with this
 496 -- = discardErrsTc (buildInstanceEnvs all_inst_infos    `thenTc` \ inst_mapper ->
 497         -- We do the discard-errs so that we don't get repeated error messages
 498         -- about duplicate instances.
 499         -- They'll appear later, when we do the top-level buildInstanceEnvs.
 500 -- ------------------
 501
 502   = buildInstanceEnvs all_inst_infos    `thenTc` \ inst_mapper ->
 503     returnTc (new_inst_infos, inst_mapper)
 504   where
 505     new_inst_infos = zipWithEqual "add_solns" mk_deriv_inst_info eqns solns
 506
 507     all_inst_infos = inst_infos_in `unionBags` listToBag new_inst_infos
 508
 509     mk_deriv_inst_info (clas, tycon, tyvars, _) theta
 510       = InstInfo clas tyvars (applyTyCon tycon (mkTyVarTys tyvars))
 511                  theta
 512                  (my_panic "dfun_theta")
 513
 514                  dummy_dfun_id
 515
 516                  (my_panic "binds") (getSrcLoc tycon)
 517                  (my_panic "upragmas")
 518       where
 519         dummy_dfun_id
 520           = mkDictFunId (getName tycon) dummy_dfun_ty bottom bottom
 521                 -- The name is getSrcLoc'd in an error message
 522           where
 523             bottom = panic "dummy_dfun_id"
 524
 525         dummy_dfun_ty = mkSigmaTy tyvars theta voidTy
 526                 -- All we need from the dfun is its "theta" part, used during
 527                 -- equation simplification (tcSimplifyThetas).  The final
 528                 -- dfun_id will have the superclass dictionaries as arguments too,
 529                 -- but that'll be added after the equations are solved.  For now,
 530                 -- it's enough just to make a dummy dfun with the simple theta part.
 531                 --
 532                 -- The part after the theta is dummied here as voidTy; actually it's
 533                 --      (C (T a b)), but it doesn't seem worth constructing it.
 534                 -- We can't leave it as a panic because to get the theta part we
 535                 -- have to run down the type!
 536
 537         my_panic str = panic "add_soln" -- pprPanic ("add_soln:"++str) (hsep [char ':', ppr PprDebug clas, ppr PprDebug tycon])
 538 \end{code}
 539
 540 %************************************************************************
 541 %*                                                                      *
 542 \subsection[TcDeriv-normal-binds]{Bindings for the various classes}
 543 %*                                                                      *
 544 %************************************************************************
 545
 546 After all the trouble to figure out the required context for the
 547 derived instance declarations, all that's left is to chug along to
 548 produce them.  They will then be shoved into @tcInstDecls2@, which
 549 will do all its usual business.
 550
 551 There are lots of possibilities for code to generate.  Here are
 552 various general remarks.
 553
 554 PRINCIPLES:
 555 \begin{itemize}
 556 \item
 557 We want derived instances of @Eq@ and @Ord@ (both v common) to be
 558 ``you-couldn't-do-better-by-hand'' efficient.
 559
 560 \item
 561 Deriving @Show@---also pretty common--- should also be reasonable good code.
 562
 563 \item
 564 Deriving for the other classes isn't that common or that big a deal.
 565 \end{itemize}
 566
 567 PRAGMATICS:
 568
 569 \begin{itemize}
 570 \item
 571 Deriving @Ord@ is done mostly with the 1.3 @compare@ method.
 572
 573 \item
 574 Deriving @Eq@ also uses @compare@, if we're deriving @Ord@, too.
 575
 576 \item
 577 We {\em normally} generate code only for the non-defaulted methods;
 578 there are some exceptions for @Eq@ and (especially) @Ord@...
 579
 580 \item
 581 Sometimes we use a @_con2tag_<tycon>@ function, which returns a data
 582 constructor's numeric (@Int#@) tag.  These are generated by
 583 @gen_tag_n_con_binds@, and the heuristic for deciding if one of
 584 these is around is given by @hasCon2TagFun@.
 585
 586 The examples under the different sections below will make this
 587 clearer.
 588
 589 \item
 590 Much less often (really just for deriving @Ix@), we use a
 591 @_tag2con_<tycon>@ function.  See the examples.
 592
 593 \item
 594 We use the renamer!!!  Reason: we're supposed to be
 595 producing @RenamedMonoBinds@ for the methods, but that means
 596 producing correctly-uniquified code on the fly.  This is entirely
 597 possible (the @TcM@ monad has a @UniqueSupply@), but it is painful.
 598 So, instead, we produce @RdrNameMonoBinds@ then heave 'em through
 599 the renamer.  What a great hack!
 600 \end{itemize}
 601
 602 \begin{code}
 603 -- Generate the method bindings for the required instance
 604 gen_bind :: InstInfo -> RdrNameMonoBinds
 605 gen_bind (InstInfo clas _ ty _ _ _ _ _ _)
 606   | not from_here
 607   = EmptyMonoBinds
 608   | otherwise
 609   = assoc "gen_inst_info:bad derived class"
 610           [(eqClassKey,      gen_Eq_binds)
 611           ,(ordClassKey,     gen_Ord_binds)
 612           ,(enumClassKey,    gen_Enum_binds)
 613           ,(evalClassKey,    gen_Eval_binds)
 614           ,(boundedClassKey, gen_Bounded_binds)
 615           ,(showClassKey,    gen_Show_binds)
 616           ,(readClassKey,    gen_Read_binds)
 617           ,(ixClassKey,      gen_Ix_binds)
 618           ]
 619           (classKey clas)
 620           tycon
 621   where
 622       from_here   = isLocallyDefined tycon
 623       (tycon,_,_) = getAppDataTyCon ty
 624
 625
 626 gen_inst_info :: Module                                 -- Module name
 627               -> (InstInfo, (Name, RenamedMonoBinds))           -- the main stuff to work on
 628               -> InstInfo                               -- the gen'd (filled-in) "instance decl"
 629
 630 gen_inst_info modname
 631     (InstInfo clas tyvars ty inst_decl_theta _ _ _ locn _, (dfun_name, meth_binds))
 632   =
 633         -- Generate the various instance-related Ids
 634     InstInfo clas tyvars ty inst_decl_theta
 635                dfun_theta dfun_id
 636                meth_binds
 637                locn []
 638   where
 639    (dfun_id, dfun_theta) = mkInstanceRelatedIds
 640                                         dfun_name
 641                                         clas tyvars ty
 642                                         inst_decl_theta
 643
 644    from_here = isLocallyDefined tycon
 645    (tycon,_,_) = getAppDataTyCon ty
 646 \end{code}
 647
 648
 649 %************************************************************************
 650 %*                                                                      *
 651 \subsection[TcDeriv-taggery-Names]{What con2tag/tag2con functions are available?}
 652 %*                                                                      *
 653 %************************************************************************
 654
 655
 656 data Foo ... = ...
 657
 658 con2tag_Foo :: Foo ... -> Int#
 659 tag2con_Foo :: Int -> Foo ...   -- easier if Int, not Int#
 660 maxtag_Foo  :: Int              -- ditto (NB: not unboxed)
 661
 662
 663 We have a @con2tag@ function for a tycon if:
 664 \begin{itemize}
 665 \item
 666 We're deriving @Eq@ and the tycon has nullary data constructors.
 667
 668 \item
 669 Or: we're deriving @Ord@ (unless single-constructor), @Enum@, @Ix@
 670 (enum type only????)
 671 \end{itemize}
 672
 673 We have a @tag2con@ function for a tycon if:
 674 \begin{itemize}
 675 \item
 676 We're deriving @Enum@, or @Ix@ (enum type only???)
 677 \end{itemize}
 678
 679 If we have a @tag2con@ function, we also generate a @maxtag@ constant.
 680
 681 \begin{code}
 682 gen_taggery_Names :: [InstInfo]
 683                   -> TcM s [(RdrName,   -- for an assoc list
 684                              TyCon,     -- related tycon
 685                              TagThingWanted)]
 686
 687 gen_taggery_Names inst_infos
 688   = --pprTrace "gen_taggery:\n" (vcat [hsep [ppr PprDebug c, ppr PprDebug t] | (c,t) <- all_CTs]) $
 689     foldlTc do_con2tag []           tycons_of_interest `thenTc` \ names_so_far ->
 690     foldlTc do_tag2con names_so_far tycons_of_interest
 691   where
 692     all_CTs = [ mk_CT c ty | (InstInfo c _ ty _ _ _ _ _ _) <- inst_infos ]
 693
 694     mk_CT c ty = (c, fst (getAppTyCon ty))
 695
 696     all_tycons = map snd all_CTs
 697     (tycons_of_interest, _) = removeDups cmp all_tycons
 698
 699     do_con2tag acc_Names tycon
 700       | isDataTyCon tycon &&
 701         (we_are_deriving eqClassKey tycon
 702             && any isNullaryDataCon (tyConDataCons tycon))
 703          || (we_are_deriving ordClassKey  tycon
 704             && not (maybeToBool (maybeTyConSingleCon tycon)))
 705          || (we_are_deriving enumClassKey tycon)
 706          || (we_are_deriving ixClassKey   tycon)
 707
 708       = returnTc ((con2tag_RDR tycon, tycon, GenCon2Tag)
 709                    : acc_Names)
 710       | otherwise
 711       = returnTc acc_Names
 712
 713     do_tag2con acc_Names tycon
 714       = if (we_are_deriving enumClassKey tycon)
 715         || (we_are_deriving ixClassKey   tycon)
 716         then
 717           returnTc ( (tag2con_RDR tycon, tycon, GenTag2Con)
 718                    : (maxtag_RDR  tycon, tycon, GenMaxTag)
 719                    : acc_Names)
 720         else
 721           returnTc acc_Names
 722
 723     we_are_deriving clas_key tycon
 724       = is_in_eqns clas_key tycon all_CTs
 725       where
 726         is_in_eqns clas_key tycon [] = False
 727         is_in_eqns clas_key tycon ((c,t):cts)
 728           =  (clas_key == classKey c && tycon == t)
 729           || is_in_eqns clas_key tycon cts
 730
 731 \end{code}
 732
 733 \begin{code}
 734 derivingThingErr :: FAST_STRING -> FAST_STRING -> TyCon -> Error
 735
 736 derivingThingErr thing why tycon sty
 737   = hang (hsep [ptext SLIT("Can't make a derived instance of"), ptext thing])
 738          0 (hang (hsep [ptext SLIT("for the type"), ppr sty tycon])
 739                  0 (parens (ptext why)))
 740
 741 derivCtxt tycon sty
 742   = ptext SLIT("When deriving classes for") <+> ppr sty tycon
 743 \end{code}