ghc/compiler/typecheck/TcGenDeriv.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
   3 %
   4 \section[TcGenDeriv]{Generating derived instance declarations}
   5
   6 This module is nominally ``subordinate'' to @TcDeriv@, which is the
   7 ``official'' interface to deriving-related things.
   8
   9 This is where we do all the grimy bindings' generation.
  10
  11 \begin{code}
  12 #include "HsVersions.h"
  13
  14 module TcGenDeriv (
  15         gen_Bounded_binds,
  16         gen_Enum_binds,
  17         gen_Eval_binds,
  18         gen_Eq_binds,
  19         gen_Ix_binds,
  20         gen_Ord_binds,
  21         gen_Read_binds,
  22         gen_Show_binds,
  23         gen_tag_n_con_monobind,
  24
  25         con2tag_RDR, tag2con_RDR, maxtag_RDR,
  26
  27         TagThingWanted(..)
  28     ) where
  29
  30 IMP_Ubiq()
  31 IMPORT_1_3(List(partition))
  32
  33 import HsSyn            ( HsBinds(..), Bind(..), MonoBinds(..), Match(..), GRHSsAndBinds(..),
  34                           GRHS(..), HsExpr(..), HsLit(..), InPat(..), Qualifier(..), Stmt,
  35                           ArithSeqInfo, Sig, HsType, FixityDecl, Fixity, Fake )
  36 import RdrHsSyn         ( RdrName(..), varQual, varUnqual, mkOpApp,
  37                           SYN_IE(RdrNameMonoBinds), SYN_IE(RdrNameHsExpr), SYN_IE(RdrNamePat)
  38                         )
  39 -- import RnHsSyn               ( RenamedFixityDecl(..) )
  40
  41 import Id               ( GenId, dataConNumFields, isNullaryDataCon, dataConTag,
  42                           dataConRawArgTys, fIRST_TAG,
  43                           isDataCon, SYN_IE(DataCon), SYN_IE(ConTag) )
  44 import Maybes           ( maybeToBool )
  45 import Name             ( getOccString, getOccName, getSrcLoc, occNameString, modAndOcc, OccName, Name )
  46
  47 import PrimOp           ( PrimOp(..) )
  48 import PrelInfo         -- Lots of RdrNames
  49 import SrcLoc           ( mkGeneratedSrcLoc )
  50 import TyCon            ( TyCon, tyConDataCons, isEnumerationTyCon, maybeTyConSingleCon )
  51 import Type             ( eqTy, isPrimType )
  52 import TysPrim          ( charPrimTy, intPrimTy, wordPrimTy, addrPrimTy,
  53                           floatPrimTy, doublePrimTy
  54                         )
  55 import Util             ( mapAccumL, zipEqual, zipWith3Equal, nOfThem, panic, assertPanic )
  56 \end{code}
  57
  58 %************************************************************************
  59 %*                                                                      *
  60 \subsection{Generating code, by derivable class}
  61 %*                                                                      *
  62 %************************************************************************
  63
  64 %************************************************************************
  65 %*                                                                      *
  66 \subsubsection{Generating @Eq@ instance declarations}
  67 %*                                                                      *
  68 %************************************************************************
  69
  70 Here are the heuristics for the code we generate for @Eq@:
  71 \begin{itemize}
  72 \item
  73   Let's assume we have a data type with some (possibly zero) nullary
  74   data constructors and some ordinary, non-nullary ones (the rest,
  75   also possibly zero of them).  Here's an example, with both \tr{N}ullary
  76   and \tr{O}rdinary data cons.
  77 \begin{verbatim}
  78 data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
  79 \end{verbatim}
  80
  81 \item
  82   For the ordinary constructors (if any), we emit clauses to do The
  83   Usual Thing, e.g.,:
  84
  85 \begin{verbatim}
  86 (==) (O1 a1 b1)    (O1 a2 b2)    = a1 == a2 && b1 == b2
  87 (==) (O2 a1)       (O2 a2)       = a1 == a2
  88 (==) (O3 a1 b1 c1) (O3 a2 b2 c2) = a1 == a2 && b1 == b2 && c1 == c2
  89 \end{verbatim}
  90
  91   Note: if we're comparing unboxed things, e.g., if \tr{a1} and
  92   \tr{a2} are \tr{Float#}s, then we have to generate
  93 \begin{verbatim}
  94 case (a1 `eqFloat#` a2) of
  95   r -> r
  96 \end{verbatim}
  97   for that particular test.
  98
  99 \item
 100   If there are any nullary constructors, we emit a catch-all clause of
 101   the form:
 102
 103 \begin{verbatim}
 104 (==) a b  = case (con2tag_Foo a) of { a# ->
 105             case (con2tag_Foo b) of { b# ->
 106             case (a# ==# b#)     of {
 107               r -> r
 108             }}}
 109 \end{verbatim}
 110
 111   If there aren't any nullary constructors, we emit a simpler
 112   catch-all:
 113 \begin{verbatim}
 114 (==) a b  = False
 115 \end{verbatim}
 116
 117 \item
 118   For the @(/=)@ method, we normally just use the default method.
 119
 120   If the type is an enumeration type, we could/may/should? generate
 121   special code that calls @con2tag_Foo@, much like for @(==)@ shown
 122   above.
 123
 124 \item
 125   We thought about doing this: If we're also deriving @Ord@ for this
 126   tycon, we generate:
 127 \begin{verbatim}
 128 instance ... Eq (Foo ...) where
 129   (==) a b  = case (compare a b) of { _LT -> False; _EQ -> True ; _GT -> False}
 130   (/=) a b  = case (compare a b) of { _LT -> True ; _EQ -> False; _GT -> True }
 131 \begin{verbatim}
 132   However, that requires that \tr{Ord <whatever>} was put in the context
 133   for the instance decl, which it probably wasn't, so the decls
 134   produced don't get through the typechecker.
 135 \end{itemize}
 136
 137 \begin{code}
 138 gen_Eq_binds :: TyCon -> RdrNameMonoBinds
 139
 140 gen_Eq_binds tycon
 141   = let
 142         tycon_loc = getSrcLoc tycon
 143         (nullary_cons, nonnullary_cons)
 144           = partition isNullaryDataCon (tyConDataCons tycon)
 145
 146         rest
 147           = if (null nullary_cons) then
 148                 case maybeTyConSingleCon tycon of
 149                   Just _ -> []
 150                   Nothing -> -- if cons don't match, then False
 151                      [([a_Pat, b_Pat], false_Expr)]
 152             else -- calc. and compare the tags
 153                  [([a_Pat, b_Pat],
 154                     untag_Expr tycon [(a_RDR,ah_RDR), (b_RDR,bh_RDR)]
 155                       (cmp_tags_Expr eqH_Int_RDR ah_RDR bh_RDR true_Expr false_Expr))]
 156     in
 157     mk_FunMonoBind tycon_loc eq_RDR ((map pats_etc nonnullary_cons) ++ rest)
 158             `AndMonoBinds`
 159     mk_easy_FunMonoBind tycon_loc ne_RDR [a_Pat, b_Pat] [] (
 160         HsApp (HsVar not_RDR) (HsPar (mk_easy_App eq_RDR [a_RDR, b_RDR])))
 161   where
 162     ------------------------------------------------------------------
 163     pats_etc data_con
 164       = let
 165             con1_pat = ConPatIn data_con_RDR (map VarPatIn as_needed)
 166             con2_pat = ConPatIn data_con_RDR (map VarPatIn bs_needed)
 167
 168             data_con_RDR = qual_orig_name data_con
 169             con_arity   = length tys_needed
 170             as_needed   = take con_arity as_RDRs
 171             bs_needed   = take con_arity bs_RDRs
 172             tys_needed  = dataConRawArgTys data_con
 173         in
 174         ([con1_pat, con2_pat], nested_eq_expr tys_needed as_needed bs_needed)
 175       where
 176         nested_eq_expr []  [] [] = true_Expr
 177         nested_eq_expr tys as bs
 178           = foldl1 and_Expr (zipWith3Equal "nested_eq" nested_eq tys as bs)
 179           where
 180             nested_eq ty a b = HsPar (eq_Expr ty (HsVar a) (HsVar b))
 181 \end{code}
 182
 183 %************************************************************************
 184 %*                                                                      *
 185 \subsubsection{Generating @Ord@ instance declarations}
 186 %*                                                                      *
 187 %************************************************************************
 188
 189 For a derived @Ord@, we concentrate our attentions on @compare@
 190 \begin{verbatim}
 191 compare :: a -> a -> Ordering
 192 data Ordering = LT | EQ | GT deriving ()
 193 \end{verbatim}
 194
 195 We will use the same example data type as above:
 196 \begin{verbatim}
 197 data Foo ... = N1 | N2 ... | Nn | O1 a b | O2 Int | O3 Double b b | ...
 198 \end{verbatim}
 199
 200 \begin{itemize}
 201 \item
 202   We do all the other @Ord@ methods with calls to @compare@:
 203 \begin{verbatim}
 204 instance ... (Ord <wurble> <wurble>) where
 205     a <  b  = case (compare a b) of { LT -> True;  EQ -> False; GT -> False }
 206     a <= b  = case (compare a b) of { LT -> True;  EQ -> True;  GT -> False }
 207     a >= b  = case (compare a b) of { LT -> False; EQ -> True;  GT -> True  }
 208     a >  b  = case (compare a b) of { LT -> False; EQ -> False; GT -> True  }
 209
 210     max a b = case (compare a b) of { LT -> b; EQ -> a;  GT -> a }
 211     min a b = case (compare a b) of { LT -> a; EQ -> b;  GT -> b }
 212
 213     -- compare to come...
 214 \end{verbatim}
 215
 216 \item
 217   @compare@ always has two parts.  First, we use the compared
 218   data-constructors' tags to deal with the case of different
 219   constructors:
 220 \begin{verbatim}
 221 compare a b = case (con2tag_Foo a) of { a# ->
 222               case (con2tag_Foo b) of { b# ->
 223               case (a# ==# b#)     of {
 224                True  -> cmp_eq a b
 225                False -> case (a# <# b#) of
 226                          True  -> _LT
 227                          False -> _GT
 228               }}}
 229   where
 230     cmp_eq = ... to come ...
 231 \end{verbatim}
 232
 233 \item
 234   We are only left with the ``help'' function @cmp_eq@, to deal with
 235   comparing data constructors with the same tag.
 236
 237   For the ordinary constructors (if any), we emit the sorta-obvious
 238   compare-style stuff; for our example:
 239 \begin{verbatim}
 240 cmp_eq (O1 a1 b1) (O1 a2 b2)
 241   = case (compare a1 a2) of { LT -> LT; EQ -> compare b1 b2; GT -> GT }
 242
 243 cmp_eq (O2 a1) (O2 a2)
 244   = compare a1 a2
 245
 246 cmp_eq (O3 a1 b1 c1) (O3 a2 b2 c2)
 247   = case (compare a1 a2) of {
 248       LT -> LT;
 249       GT -> GT;
 250       EQ -> case compare b1 b2 of {
 251               LT -> LT;
 252               GT -> GT;
 253               EQ -> compare c1 c2
 254             }
 255     }
 256 \end{verbatim}
 257
 258   Again, we must be careful about unboxed comparisons.  For example,
 259   if \tr{a1} and \tr{a2} were \tr{Int#}s in the 2nd example above, we'd need to
 260   generate:
 261 \begin{verbatim}
 262 cmp_eq lt eq gt (O2 a1) (O2 a2)
 263   = compareInt# a1 a2
 264   -- or maybe the unfolded equivalent
 265 \end{verbatim}
 266
 267 \item
 268   For the remaining nullary constructors, we already know that the
 269   tags are equal so:
 270 \begin{verbatim}
 271 cmp_eq _ _ = EQ
 272 \end{verbatim}
 273 \end{itemize}
 274
 275 \begin{code}
 276 gen_Ord_binds :: TyCon -> RdrNameMonoBinds
 277
 278 gen_Ord_binds tycon
 279   = defaulted `AndMonoBinds` compare
 280   where
 281     tycon_loc = getSrcLoc tycon
 282     --------------------------------------------------------------------
 283     compare = mk_easy_FunMonoBind tycon_loc compare_RDR
 284                 [a_Pat, b_Pat]
 285                 [cmp_eq]
 286             (if maybeToBool (maybeTyConSingleCon tycon) then
 287                 cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
 288              else
 289                 untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)]
 290                   (cmp_tags_Expr eqH_Int_RDR ah_RDR bh_RDR
 291                         -- True case; they are equal
 292                         -- If an enumeration type we are done; else
 293                         -- recursively compare their components
 294                     (if isEnumerationTyCon tycon then
 295                         eqTag_Expr
 296                      else
 297                         cmp_eq_Expr ltTag_Expr eqTag_Expr gtTag_Expr a_Expr b_Expr
 298                     )
 299                         -- False case; they aren't equal
 300                         -- So we need to do a less-than comparison on the tags
 301                     (cmp_tags_Expr ltH_Int_RDR ah_RDR bh_RDR ltTag_Expr gtTag_Expr)))
 302
 303     (nullary_cons, nonnullary_cons)
 304       = partition isNullaryDataCon (tyConDataCons tycon)
 305
 306     cmp_eq
 307       = mk_FunMonoBind tycon_loc cmp_eq_RDR (map pats_etc nonnullary_cons ++ deflt_pats_etc)
 308       where
 309         pats_etc data_con
 310           = ([con1_pat, con2_pat],
 311              nested_compare_expr tys_needed as_needed bs_needed)
 312           where
 313             con1_pat = ConPatIn data_con_RDR (map VarPatIn as_needed)
 314             con2_pat = ConPatIn data_con_RDR (map VarPatIn bs_needed)
 315
 316             data_con_RDR = qual_orig_name data_con
 317             con_arity   = length tys_needed
 318             as_needed   = take con_arity as_RDRs
 319             bs_needed   = take con_arity bs_RDRs
 320             tys_needed  = dataConRawArgTys data_con
 321
 322             nested_compare_expr [ty] [a] [b]
 323               = careful_compare_Case ty ltTag_Expr eqTag_Expr gtTag_Expr (HsVar a) (HsVar b)
 324
 325             nested_compare_expr (ty:tys) (a:as) (b:bs)
 326               = let eq_expr = nested_compare_expr tys as bs
 327                 in  careful_compare_Case ty ltTag_Expr eq_expr gtTag_Expr (HsVar a) (HsVar b)
 328
 329         deflt_pats_etc
 330           = if null nullary_cons
 331             then []
 332             else [([a_Pat, b_Pat], eqTag_Expr)]
 333     --------------------------------------------------------------------
 334
 335 defaulted = foldr1 AndMonoBinds [lt, le, ge, gt, max_, min_]
 336
 337 lt = mk_easy_FunMonoBind mkGeneratedSrcLoc lt_RDR [a_Pat, b_Pat] [] (
 338             compare_Case true_Expr  false_Expr false_Expr a_Expr b_Expr)
 339 le = mk_easy_FunMonoBind mkGeneratedSrcLoc le_RDR [a_Pat, b_Pat] [] (
 340             compare_Case true_Expr  true_Expr  false_Expr a_Expr b_Expr)
 341 ge = mk_easy_FunMonoBind mkGeneratedSrcLoc ge_RDR [a_Pat, b_Pat] [] (
 342             compare_Case false_Expr true_Expr  true_Expr  a_Expr b_Expr)
 343 gt = mk_easy_FunMonoBind mkGeneratedSrcLoc gt_RDR [a_Pat, b_Pat] [] (
 344             compare_Case false_Expr false_Expr true_Expr  a_Expr b_Expr)
 345
 346 max_ = mk_easy_FunMonoBind mkGeneratedSrcLoc max_RDR [a_Pat, b_Pat] [] (
 347             compare_Case b_Expr a_Expr a_Expr a_Expr b_Expr)
 348 min_ = mk_easy_FunMonoBind mkGeneratedSrcLoc min_RDR [a_Pat, b_Pat] [] (
 349             compare_Case a_Expr b_Expr b_Expr a_Expr b_Expr)
 350 \end{code}
 351
 352 %************************************************************************
 353 %*                                                                      *
 354 \subsubsection{Generating @Enum@ instance declarations}
 355 %*                                                                      *
 356 %************************************************************************
 357
 358 @Enum@ can only be derived for enumeration types.  For a type
 359 \begin{verbatim}
 360 data Foo ... = N1 | N2 | ... | Nn
 361 \end{verbatim}
 362
 363 we use both @con2tag_Foo@ and @tag2con_Foo@ functions, as well as a
 364 @maxtag_Foo@ variable (all generated by @gen_tag_n_con_binds@).
 365
 366 \begin{verbatim}
 367 instance ... Enum (Foo ...) where
 368     enumFrom a = map tag2con_Foo [con2tag_Foo a .. maxtag_Foo]
 369
 370     -- or, really...
 371     enumFrom a
 372       = case con2tag_Foo a of
 373           a# -> map tag2con_Foo (enumFromTo (I# a#) maxtag_Foo)
 374
 375    enumFromThen a b
 376      = map tag2con_Foo [con2tag_Foo a, con2tag_Foo b .. maxtag_Foo]
 377
 378     -- or, really...
 379     enumFromThen a b
 380       = case con2tag_Foo a of { a# ->
 381         case con2tag_Foo b of { b# ->
 382         map tag2con_Foo (enumFromThenTo (I# a#) (I# b#) maxtag_Foo)
 383         }}
 384 \end{verbatim}
 385
 386 For @enumFromTo@ and @enumFromThenTo@, we use the default methods.
 387
 388 \begin{code}
 389 gen_Enum_binds :: TyCon -> RdrNameMonoBinds
 390
 391 gen_Enum_binds tycon
 392   = enum_from           `AndMonoBinds`
 393     enum_from_then      `AndMonoBinds`
 394     from_enum
 395   where
 396     tycon_loc = getSrcLoc tycon
 397     enum_from
 398       = mk_easy_FunMonoBind tycon_loc enumFrom_RDR [a_Pat] [] $
 399           untag_Expr tycon [(a_RDR, ah_RDR)] $
 400           HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
 401             HsPar (enum_from_to_Expr
 402                     (mk_easy_App mkInt_RDR [ah_RDR])
 403                     (HsVar (maxtag_RDR tycon)))
 404
 405     enum_from_then
 406       = mk_easy_FunMonoBind tycon_loc enumFromThen_RDR [a_Pat, b_Pat] [] $
 407           untag_Expr tycon [(a_RDR, ah_RDR), (b_RDR, bh_RDR)] $
 408           HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
 409             HsPar (enum_from_then_to_Expr
 410                     (mk_easy_App mkInt_RDR [ah_RDR])
 411                     (mk_easy_App mkInt_RDR [bh_RDR])
 412                     (HsVar (maxtag_RDR tycon)))
 413
 414     from_enum
 415       = mk_easy_FunMonoBind tycon_loc fromEnum_RDR [a_Pat] [] $
 416           untag_Expr tycon [(a_RDR, ah_RDR)] $
 417           (mk_easy_App mkInt_RDR [ah_RDR])
 418 \end{code}
 419
 420 %************************************************************************
 421 %*                                                                      *
 422 \subsubsection{Generating @Eval@ instance declarations}
 423 %*                                                                      *
 424 %************************************************************************
 425
 426 \begin{code}
 427 gen_Eval_binds tycon = EmptyMonoBinds
 428 \end{code}
 429
 430 %************************************************************************
 431 %*                                                                      *
 432 \subsubsection{Generating @Bounded@ instance declarations}
 433 %*                                                                      *
 434 %************************************************************************
 435
 436 \begin{code}
 437 gen_Bounded_binds tycon
 438   = if isEnumerationTyCon tycon then
 439         min_bound_enum `AndMonoBinds` max_bound_enum
 440     else
 441         ASSERT(length data_cons == 1)
 442         min_bound_1con `AndMonoBinds` max_bound_1con
 443   where
 444     data_cons = tyConDataCons tycon
 445     tycon_loc = getSrcLoc tycon
 446
 447     ----- enum-flavored: ---------------------------
 448     min_bound_enum = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] (HsVar data_con_1_RDR)
 449     max_bound_enum = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] (HsVar data_con_N_RDR)
 450
 451     data_con_1    = head data_cons
 452     data_con_N    = last data_cons
 453     data_con_1_RDR = qual_orig_name data_con_1
 454     data_con_N_RDR = qual_orig_name data_con_N
 455
 456     ----- single-constructor-flavored: -------------
 457     arity          = dataConNumFields data_con_1
 458
 459     min_bound_1con = mk_easy_FunMonoBind tycon_loc minBound_RDR [] [] $
 460                      mk_easy_App data_con_1_RDR (nOfThem arity minBound_RDR)
 461     max_bound_1con = mk_easy_FunMonoBind tycon_loc maxBound_RDR [] [] $
 462                      mk_easy_App data_con_1_RDR (nOfThem arity maxBound_RDR)
 463 \end{code}
 464
 465 %************************************************************************
 466 %*                                                                      *
 467 \subsubsection{Generating @Ix@ instance declarations}
 468 %*                                                                      *
 469 %************************************************************************
 470
 471 Deriving @Ix@ is only possible for enumeration types and
 472 single-constructor types.  We deal with them in turn.
 473
 474 For an enumeration type, e.g.,
 475 \begin{verbatim}
 476     data Foo ... = N1 | N2 | ... | Nn
 477 \end{verbatim}
 478 things go not too differently from @Enum@:
 479 \begin{verbatim}
 480 instance ... Ix (Foo ...) where
 481     range (a, b)
 482       = map tag2con_Foo [con2tag_Foo a .. con2tag_Foo b]
 483
 484     -- or, really...
 485     range (a, b)
 486       = case (con2tag_Foo a) of { a# ->
 487         case (con2tag_Foo b) of { b# ->
 488         map tag2con_Foo (enumFromTo (I# a#) (I# b#))
 489         }}
 490
 491     index c@(a, b) d
 492       = if inRange c d
 493         then case (con2tag_Foo d -# con2tag_Foo a) of
 494                r# -> I# r#
 495         else error "Ix.Foo.index: out of range"
 496
 497     inRange (a, b) c
 498       = let
 499             p_tag = con2tag_Foo c
 500         in
 501         p_tag >= con2tag_Foo a && p_tag <= con2tag_Foo b
 502
 503     -- or, really...
 504     inRange (a, b) c
 505       = case (con2tag_Foo a)   of { a_tag ->
 506         case (con2tag_Foo b)   of { b_tag ->
 507         case (con2tag_Foo c)   of { c_tag ->
 508         if (c_tag >=# a_tag) then
 509           c_tag <=# b_tag
 510         else
 511           False
 512         }}}
 513 \end{verbatim}
 514 (modulo suitable case-ification to handle the unboxed tags)
 515
 516 For a single-constructor type (NB: this includes all tuples), e.g.,
 517 \begin{verbatim}
 518     data Foo ... = MkFoo a b Int Double c c
 519 \end{verbatim}
 520 we follow the scheme given in Figure~19 of the Haskell~1.2 report
 521 (p.~147).
 522
 523 \begin{code}
 524 gen_Ix_binds :: TyCon -> RdrNameMonoBinds
 525
 526 gen_Ix_binds tycon
 527   = if isEnumerationTyCon tycon
 528     then enum_ixes
 529     else single_con_ixes
 530   where
 531     tycon_str = getOccString tycon
 532     tycon_loc = getSrcLoc tycon
 533
 534     --------------------------------------------------------------
 535     enum_ixes = enum_range `AndMonoBinds`
 536                 enum_index `AndMonoBinds` enum_inRange
 537
 538     enum_range
 539       = mk_easy_FunMonoBind tycon_loc range_RDR [TuplePatIn [a_Pat, b_Pat]] [] $
 540           untag_Expr tycon [(a_RDR, ah_RDR)] $
 541           untag_Expr tycon [(b_RDR, bh_RDR)] $
 542           HsApp (mk_easy_App map_RDR [tag2con_RDR tycon]) $
 543               HsPar (enum_from_to_Expr
 544                         (mk_easy_App mkInt_RDR [ah_RDR])
 545                         (mk_easy_App mkInt_RDR [bh_RDR]))
 546
 547     enum_index
 548       = mk_easy_FunMonoBind tycon_loc index_RDR [AsPatIn c_RDR (TuplePatIn [a_Pat, b_Pat]), d_Pat] [] (
 549         HsIf (HsPar (mk_easy_App inRange_RDR [c_RDR, d_RDR])) (
 550            untag_Expr tycon [(a_RDR, ah_RDR)] (
 551            untag_Expr tycon [(d_RDR, dh_RDR)] (
 552            let
 553                 grhs = [OtherwiseGRHS (mk_easy_App mkInt_RDR [c_RDR]) tycon_loc]
 554            in
 555            HsCase
 556              (genOpApp (HsVar dh_RDR) minusH_RDR (HsVar ah_RDR))
 557              [PatMatch (VarPatIn c_RDR)
 558                                 (GRHSMatch (GRHSsAndBindsIn grhs EmptyBinds))]
 559              tycon_loc
 560            ))
 561         ) {-else-} (
 562            HsApp (HsVar error_RDR) (HsLit (HsString (_PK_ ("Ix."++tycon_str++".index: out of range\n"))))
 563         )
 564         tycon_loc)
 565
 566     enum_inRange
 567       = mk_easy_FunMonoBind tycon_loc inRange_RDR [TuplePatIn [a_Pat, b_Pat], c_Pat] [] (
 568           untag_Expr tycon [(a_RDR, ah_RDR)] (
 569           untag_Expr tycon [(b_RDR, bh_RDR)] (
 570           untag_Expr tycon [(c_RDR, ch_RDR)] (
 571           HsIf (genOpApp (HsVar ch_RDR) geH_RDR (HsVar ah_RDR)) (
 572              (genOpApp (HsVar ch_RDR) leH_RDR (HsVar bh_RDR))
 573           ) {-else-} (
 574              false_Expr
 575           ) tycon_loc))))
 576
 577     --------------------------------------------------------------
 578     single_con_ixes = single_con_range `AndMonoBinds`
 579                 single_con_index `AndMonoBinds` single_con_inRange
 580
 581     data_con
 582       = case maybeTyConSingleCon tycon of -- just checking...
 583           Nothing -> panic "get_Ix_binds"
 584           Just dc -> if (any isPrimType (dataConRawArgTys dc)) then
 585                          error ("ERROR: Can't derive Ix for a single-constructor type with primitive argument types: "++tycon_str)
 586                      else
 587                          dc
 588
 589     con_arity   = dataConNumFields data_con
 590     data_con_RDR = qual_orig_name data_con
 591     con_pat  xs = ConPatIn data_con_RDR (map VarPatIn xs)
 592     con_expr xs = mk_easy_App data_con_RDR xs
 593
 594     as_needed = take con_arity as_RDRs
 595     bs_needed = take con_arity bs_RDRs
 596     cs_needed = take con_arity cs_RDRs
 597
 598     --------------------------------------------------------------
 599     single_con_range
 600       = mk_easy_FunMonoBind tycon_loc range_RDR [TuplePatIn [con_pat as_needed, con_pat bs_needed]] [] (
 601           ListComp (con_expr cs_needed) (zipWith3Equal "single_con_range" mk_qual as_needed bs_needed cs_needed)
 602         )
 603       where
 604         mk_qual a b c = GeneratorQual (VarPatIn c)
 605                             (HsApp (HsVar range_RDR) (ExplicitTuple [HsVar a, HsVar b]))
 606
 607     ----------------
 608     single_con_index
 609       = mk_easy_FunMonoBind tycon_loc index_RDR [TuplePatIn [con_pat as_needed, con_pat bs_needed], con_pat cs_needed] [range_size] (
 610         foldl mk_index (HsLit (HsInt 0)) (zip3 as_needed bs_needed cs_needed))
 611       where
 612         mk_index multiply_by (l, u, i)
 613           = genOpApp (
 614                 (HsApp (HsApp (HsVar index_RDR) (ExplicitTuple [HsVar l, HsVar u])) (HsVar i))
 615            ) plus_RDR (
 616                 genOpApp (
 617                     (HsApp (HsVar rangeSize_RDR) (ExplicitTuple [HsVar l, HsVar u]))
 618                 ) times_RDR multiply_by
 619            )
 620
 621         range_size
 622           = mk_easy_FunMonoBind tycon_loc rangeSize_RDR [TuplePatIn [a_Pat, b_Pat]] [] (
 623                 genOpApp (
 624                     (HsApp (HsApp (HsVar index_RDR) (ExplicitTuple [a_Expr, b_Expr])) b_Expr)
 625                 ) plus_RDR (HsLit (HsInt 1)))
 626
 627     ------------------
 628     single_con_inRange
 629       = mk_easy_FunMonoBind tycon_loc inRange_RDR
 630                            [TuplePatIn [con_pat as_needed, con_pat bs_needed], con_pat cs_needed]
 631                            [] (
 632           foldl1 and_Expr (zipWith3Equal "single_con_inRange" in_range as_needed bs_needed cs_needed))
 633       where
 634         in_range a b c = HsApp (HsApp (HsVar inRange_RDR) (ExplicitTuple [HsVar a, HsVar b])) (HsVar c)
 635 \end{code}
 636
 637 %************************************************************************
 638 %*                                                                      *
 639 \subsubsection{Generating @Read@ instance declarations}
 640 %*                                                                      *
 641 %************************************************************************
 642
 643 Ignoring all the infix-ery mumbo jumbo (ToDo)
 644
 645 \begin{code}
 646 gen_Read_binds :: TyCon -> RdrNameMonoBinds
 647
 648 gen_Read_binds tycon
 649   = reads_prec `AndMonoBinds` read_list
 650   where
 651     tycon_loc = getSrcLoc tycon
 652     -----------------------------------------------------------------------
 653     read_list = mk_easy_FunMonoBind tycon_loc readList_RDR [] []
 654                   (HsApp (HsVar readList___RDR) (HsPar (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt 0)))))
 655     -----------------------------------------------------------------------
 656     reads_prec
 657       = let
 658             read_con_comprehensions
 659               = map read_con (tyConDataCons tycon)
 660         in
 661         mk_easy_FunMonoBind tycon_loc readsPrec_RDR [a_Pat, b_Pat] [] (
 662               foldr1 append_Expr read_con_comprehensions
 663         )
 664       where
 665         read_con data_con   -- note: "b" is the string being "read"
 666           = let
 667                 data_con_RDR = qual_orig_name data_con
 668                 data_con_str= occNameString (getOccName data_con)
 669                 con_arity   = dataConNumFields data_con
 670                 as_needed   = take con_arity as_RDRs
 671                 bs_needed   = take con_arity bs_RDRs
 672                 con_expr    = mk_easy_App data_con_RDR as_needed
 673                 nullary_con = isNullaryDataCon data_con
 674
 675                 con_qual
 676                   = GeneratorQual
 677                       (TuplePatIn [LitPatIn (HsString data_con_str), d_Pat])
 678                       (HsApp (HsVar lex_RDR) c_Expr)
 679
 680                 field_quals = snd (mapAccumL mk_qual d_Expr (zipEqual "as_needed" as_needed bs_needed))
 681
 682                 read_paren_arg
 683                   = if nullary_con then -- must be False (parens are surely optional)
 684                        false_Expr
 685                     else -- parens depend on precedence...
 686                        HsPar (genOpApp a_Expr gt_RDR (HsLit (HsInt 9)))
 687             in
 688             HsApp (
 689               readParen_Expr read_paren_arg $ HsPar $
 690                  HsLam (mk_easy_Match tycon_loc [c_Pat] []  (
 691                    ListComp (ExplicitTuple [con_expr,
 692                             if null bs_needed then d_Expr else HsVar (last bs_needed)])
 693                     (con_qual : field_quals)))
 694               ) (HsVar b_RDR)
 695           where
 696             mk_qual draw_from (con_field, str_left)
 697               = (HsVar str_left,        -- what to draw from down the line...
 698                  GeneratorQual
 699                   (TuplePatIn [VarPatIn con_field, VarPatIn str_left])
 700                   (HsApp (HsApp (HsVar readsPrec_RDR) (HsLit (HsInt 10))) draw_from))
 701 \end{code}
 702
 703 %************************************************************************
 704 %*                                                                      *
 705 \subsubsection{Generating @Show@ instance declarations}
 706 %*                                                                      *
 707 %************************************************************************
 708
 709 Ignoring all the infix-ery mumbo jumbo (ToDo)
 710
 711 \begin{code}
 712 gen_Show_binds :: TyCon -> RdrNameMonoBinds
 713
 714 gen_Show_binds tycon
 715   = shows_prec `AndMonoBinds` show_list
 716   where
 717     tycon_loc = getSrcLoc tycon
 718     -----------------------------------------------------------------------
 719     show_list = mk_easy_FunMonoBind tycon_loc showList_RDR [] []
 720                   (HsApp (HsVar showList___RDR) (HsPar (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt 0)))))
 721     -----------------------------------------------------------------------
 722     shows_prec
 723       = mk_FunMonoBind tycon_loc showsPrec_RDR (map pats_etc (tyConDataCons tycon))
 724       where
 725         pats_etc data_con
 726           = let
 727                 data_con_RDR = qual_orig_name data_con
 728                 con_arity   = dataConNumFields data_con
 729                 bs_needed   = take con_arity bs_RDRs
 730                 con_pat     = ConPatIn data_con_RDR (map VarPatIn bs_needed)
 731                 nullary_con = isNullaryDataCon data_con
 732
 733                 show_con
 734                   = let nm = occNameString (getOccName data_con)
 735                         space_maybe = if nullary_con then _NIL_ else SLIT(" ")
 736                     in
 737                         HsApp (HsVar showString_RDR) (HsLit (HsString (nm _APPEND_ space_maybe)))
 738
 739                 show_thingies = show_con : (spacified real_show_thingies)
 740
 741                 real_show_thingies
 742                   = [ HsApp (HsApp (HsVar showsPrec_RDR) (HsLit (HsInt 10))) (HsVar b)
 743                   | b <- bs_needed ]
 744             in
 745             if nullary_con then  -- skip the showParen junk...
 746                 ASSERT(null bs_needed)
 747                 ([a_Pat, con_pat], show_con)
 748             else
 749                 ([a_Pat, con_pat],
 750                     showParen_Expr (HsPar (genOpApp a_Expr ge_RDR (HsLit (HsInt 10))))
 751                                    (HsPar (nested_compose_Expr show_thingies)))
 752           where
 753             spacified []     = []
 754             spacified [x]    = [x]
 755             spacified (x:xs) = (x : (HsVar showSpace_RDR) : spacified xs)
 756 \end{code}
 757
 758 %************************************************************************
 759 %*                                                                      *
 760 \subsection{Generating extra binds (@con2tag@ and @tag2con@)}
 761 %*                                                                      *
 762 %************************************************************************
 763
 764 \begin{verbatim}
 765 data Foo ... = ...
 766
 767 con2tag_Foo :: Foo ... -> Int#
 768 tag2con_Foo :: Int -> Foo ...   -- easier if Int, not Int#
 769 maxtag_Foo  :: Int              -- ditto (NB: not unboxed)
 770 \end{verbatim}
 771
 772 The `tags' here start at zero, hence the @fIRST_TAG@ (currently one)
 773 fiddling around.
 774
 775 \begin{code}
 776 data TagThingWanted
 777   = GenCon2Tag | GenTag2Con | GenMaxTag
 778
 779 gen_tag_n_con_monobind
 780     :: (RdrName,            -- (proto)Name for the thing in question
 781         TyCon,              -- tycon in question
 782         TagThingWanted)
 783     -> RdrNameMonoBinds
 784
 785 gen_tag_n_con_monobind (rdr_name, tycon, GenCon2Tag)
 786   = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon))
 787   where
 788     mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
 789
 790     mk_stuff var
 791       = ASSERT(isDataCon var)
 792         ([pat], HsLit (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG))))
 793       where
 794         pat    = ConPatIn var_RDR (nOfThem (dataConNumFields var) WildPatIn)
 795         var_RDR = qual_orig_name var
 796
 797 gen_tag_n_con_monobind (rdr_name, tycon, GenTag2Con)
 798   = mk_FunMonoBind (getSrcLoc tycon) rdr_name (map mk_stuff (tyConDataCons tycon))
 799   where
 800     mk_stuff :: DataCon -> ([RdrNamePat], RdrNameHsExpr)
 801
 802     mk_stuff var
 803       = ASSERT(isDataCon var)
 804         ([lit_pat], HsVar var_RDR)
 805       where
 806         lit_pat = ConPatIn mkInt_RDR [LitPatIn (HsIntPrim (toInteger ((dataConTag var) - fIRST_TAG)))]
 807         var_RDR  = qual_orig_name var
 808
 809 gen_tag_n_con_monobind (rdr_name, tycon, GenMaxTag)
 810   = mk_easy_FunMonoBind (getSrcLoc tycon)
 811                 rdr_name [] [] (HsApp (HsVar mkInt_RDR) (HsLit (HsIntPrim max_tag)))
 812   where
 813     max_tag =  case (tyConDataCons tycon) of
 814                  data_cons -> toInteger ((length data_cons) - fIRST_TAG)
 815 \end{code}
 816
 817 %************************************************************************
 818 %*                                                                      *
 819 \subsection{Utility bits for generating bindings}
 820 %*                                                                      *
 821 %************************************************************************
 822
 823 @mk_easy_FunMonoBind fun pats binds expr@ generates:
 824 \begin{verbatim}
 825     fun pat1 pat2 ... patN = expr where binds
 826 \end{verbatim}
 827
 828 @mk_FunMonoBind fun [([p1a, p1b, ...], e1), ...]@ is for
 829 multi-clause definitions; it generates:
 830 \begin{verbatim}
 831     fun p1a p1b ... p1N = e1
 832     fun p2a p2b ... p2N = e2
 833     ...
 834     fun pMa pMb ... pMN = eM
 835 \end{verbatim}
 836
 837 \begin{code}
 838 mk_easy_FunMonoBind :: SrcLoc -> RdrName -> [RdrNamePat]
 839                     -> [RdrNameMonoBinds] -> RdrNameHsExpr
 840                     -> RdrNameMonoBinds
 841
 842 mk_easy_FunMonoBind loc fun pats binds expr
 843   = FunMonoBind fun False{-not infix-} [mk_easy_Match loc pats binds expr] loc
 844
 845 mk_easy_Match loc pats binds expr
 846   = mk_match loc pats expr (mkbind binds)
 847   where
 848     mkbind [] = EmptyBinds
 849     mkbind bs = SingleBind (RecBind (foldr1 AndMonoBinds bs))
 850         -- The renamer expects everything in its input to be a
 851         -- "recursive" MonoBinds, and it is its job to sort things out
 852         -- from there.
 853
 854 mk_FunMonoBind  :: SrcLoc -> RdrName
 855                 -> [([RdrNamePat], RdrNameHsExpr)]
 856                 -> RdrNameMonoBinds
 857
 858 mk_FunMonoBind loc fun [] = panic "TcGenDeriv:mk_FunMonoBind"
 859 mk_FunMonoBind loc fun pats_and_exprs
 860   = FunMonoBind fun False{-not infix-}
 861                 [ mk_match loc p e EmptyBinds | (p,e) <-pats_and_exprs ]
 862                 loc
 863
 864 mk_match loc pats expr binds
 865   = foldr PatMatch
 866           (GRHSMatch (GRHSsAndBindsIn [OtherwiseGRHS expr loc] binds))
 867           (map paren pats)
 868   where
 869     paren p@(VarPatIn _) = p
 870     paren other_p        = ParPatIn other_p
 871 \end{code}
 872
 873 \begin{code}
 874 mk_easy_App f xs = foldl HsApp (HsVar f) (map HsVar xs)
 875 \end{code}
 876
 877 ToDo: Better SrcLocs.
 878
 879 \begin{code}
 880 compare_Case, cmp_eq_Expr ::
 881           RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
 882           -> RdrNameHsExpr -> RdrNameHsExpr
 883           -> RdrNameHsExpr
 884 compare_gen_Case ::
 885           RdrName
 886           -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
 887           -> RdrNameHsExpr -> RdrNameHsExpr
 888           -> RdrNameHsExpr
 889 careful_compare_Case :: -- checks for primitive types...
 890           Type
 891           -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
 892           -> RdrNameHsExpr -> RdrNameHsExpr
 893           -> RdrNameHsExpr
 894
 895 compare_Case = compare_gen_Case compare_RDR
 896 cmp_eq_Expr = compare_gen_Case cmp_eq_RDR
 897
 898 compare_gen_Case fun lt eq gt a b
 899   = HsCase (HsPar (HsApp (HsApp (HsVar fun) a) b)) {-of-}
 900       [PatMatch (ConPatIn ltTag_RDR [])
 901           (GRHSMatch (GRHSsAndBindsIn [OtherwiseGRHS lt mkGeneratedSrcLoc] EmptyBinds)),
 902
 903        PatMatch (ConPatIn eqTag_RDR [])
 904           (GRHSMatch (GRHSsAndBindsIn [OtherwiseGRHS eq mkGeneratedSrcLoc] EmptyBinds)),
 905
 906        PatMatch (ConPatIn gtTag_RDR [])
 907           (GRHSMatch (GRHSsAndBindsIn [OtherwiseGRHS gt mkGeneratedSrcLoc] EmptyBinds))]
 908        mkGeneratedSrcLoc
 909
 910 careful_compare_Case ty lt eq gt a b
 911   = if not (isPrimType ty) then
 912        compare_gen_Case compare_RDR lt eq gt a b
 913
 914     else -- we have to do something special for primitive things...
 915        HsIf (genOpApp a relevant_eq_op b)
 916             eq
 917             (HsIf (genOpApp a relevant_lt_op b) lt gt mkGeneratedSrcLoc)
 918             mkGeneratedSrcLoc
 919   where
 920     relevant_eq_op = assoc_ty_id eq_op_tbl ty
 921     relevant_lt_op = assoc_ty_id lt_op_tbl ty
 922
 923 assoc_ty_id tyids ty
 924   = if null res then panic "assoc_ty"
 925     else head res
 926   where
 927     res = [id | (ty',id) <- tyids, eqTy ty ty']
 928
 929 eq_op_tbl =
 930     [(charPrimTy,       eqH_Char_RDR)
 931     ,(intPrimTy,        eqH_Int_RDR)
 932     ,(wordPrimTy,       eqH_Word_RDR)
 933     ,(addrPrimTy,       eqH_Addr_RDR)
 934     ,(floatPrimTy,      eqH_Float_RDR)
 935     ,(doublePrimTy,     eqH_Double_RDR)
 936     ]
 937
 938 lt_op_tbl =
 939     [(charPrimTy,       ltH_Char_RDR)
 940     ,(intPrimTy,        ltH_Int_RDR)
 941     ,(wordPrimTy,       ltH_Word_RDR)
 942     ,(addrPrimTy,       ltH_Addr_RDR)
 943     ,(floatPrimTy,      ltH_Float_RDR)
 944     ,(doublePrimTy,     ltH_Double_RDR)
 945     ]
 946
 947 -----------------------------------------------------------------------
 948
 949 and_Expr, append_Expr :: RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
 950
 951 and_Expr    a b = genOpApp a and_RDR    b
 952 append_Expr a b = genOpApp a append_RDR b
 953
 954 -----------------------------------------------------------------------
 955
 956 eq_Expr :: Type -> RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
 957 eq_Expr ty a b
 958   = if not (isPrimType ty) then
 959        genOpApp a eq_RDR  b
 960     else -- we have to do something special for primitive things...
 961        genOpApp a relevant_eq_op b
 962   where
 963     relevant_eq_op = assoc_ty_id eq_op_tbl ty
 964 \end{code}
 965
 966 \begin{code}
 967 untag_Expr :: TyCon -> [(RdrName, RdrName)] -> RdrNameHsExpr -> RdrNameHsExpr
 968 untag_Expr tycon [] expr = expr
 969 untag_Expr tycon ((untag_this, put_tag_here) : more) expr
 970   = HsCase (HsPar (HsApp (con2tag_Expr tycon) (HsVar untag_this))) {-of-}
 971       [PatMatch (VarPatIn put_tag_here)
 972                         (GRHSMatch (GRHSsAndBindsIn grhs EmptyBinds))]
 973       mkGeneratedSrcLoc
 974   where
 975     grhs = [OtherwiseGRHS (untag_Expr tycon more expr) mkGeneratedSrcLoc]
 976
 977 cmp_tags_Expr :: RdrName                -- Comparison op
 978              -> RdrName -> RdrName      -- Things to compare
 979              -> RdrNameHsExpr           -- What to return if true
 980              -> RdrNameHsExpr           -- What to return if false
 981              -> RdrNameHsExpr
 982
 983 cmp_tags_Expr op a b true_case false_case
 984   = HsIf (genOpApp (HsVar a) op (HsVar b)) true_case false_case mkGeneratedSrcLoc
 985
 986 enum_from_to_Expr
 987         :: RdrNameHsExpr -> RdrNameHsExpr
 988         -> RdrNameHsExpr
 989 enum_from_then_to_Expr
 990         :: RdrNameHsExpr -> RdrNameHsExpr -> RdrNameHsExpr
 991         -> RdrNameHsExpr
 992
 993 enum_from_to_Expr      f   t2 = HsApp (HsApp (HsVar enumFromTo_RDR) f) t2
 994 enum_from_then_to_Expr f t t2 = HsApp (HsApp (HsApp (HsVar enumFromThenTo_RDR) f) t) t2
 995
 996 showParen_Expr, readParen_Expr
 997         :: RdrNameHsExpr -> RdrNameHsExpr
 998         -> RdrNameHsExpr
 999
1000 showParen_Expr e1 e2 = HsApp (HsApp (HsVar showParen_RDR) e1) e2
1001 readParen_Expr e1 e2 = HsApp (HsApp (HsVar readParen_RDR) e1) e2
1002
1003 nested_compose_Expr :: [RdrNameHsExpr] -> RdrNameHsExpr
1004
1005 nested_compose_Expr [e] = parenify e
1006 nested_compose_Expr (e:es)
1007   = HsApp (HsApp (HsVar compose_RDR) (parenify e)) (nested_compose_Expr es)
1008
1009 parenify e@(HsVar _) = e
1010 parenify e           = HsPar e
1011
1012 -- genOpApp wraps brackets round the operator application, so that the
1013 -- renamer won't subsequently try to re-associate it.
1014 -- For some reason the renamer doesn't reassociate it right, and I can't
1015 -- be bothered to find out why just now.
1016
1017 genOpApp e1 op e2 = mkOpApp e1 op e2
1018 \end{code}
1019
1020 \begin{code}
1021 qual_orig_name n = case modAndOcc n of { (m,n) -> Qual m n }
1022
1023 a_RDR           = varUnqual SLIT("a")
1024 b_RDR           = varUnqual SLIT("b")
1025 c_RDR           = varUnqual SLIT("c")
1026 d_RDR           = varUnqual SLIT("d")
1027 ah_RDR          = varUnqual SLIT("a#")
1028 bh_RDR          = varUnqual SLIT("b#")
1029 ch_RDR          = varUnqual SLIT("c#")
1030 dh_RDR          = varUnqual SLIT("d#")
1031 cmp_eq_RDR      = varUnqual SLIT("cmp_eq")
1032 rangeSize_RDR   = varUnqual SLIT("rangeSize")
1033
1034 as_RDRs         = [ varUnqual (_PK_ ("a"++show i)) | i <- [(1::Int) .. ] ]
1035 bs_RDRs         = [ varUnqual (_PK_ ("b"++show i)) | i <- [(1::Int) .. ] ]
1036 cs_RDRs         = [ varUnqual (_PK_ ("c"++show i)) | i <- [(1::Int) .. ] ]
1037
1038 a_Expr          = HsVar a_RDR
1039 b_Expr          = HsVar b_RDR
1040 c_Expr          = HsVar c_RDR
1041 d_Expr          = HsVar d_RDR
1042 ltTag_Expr      = HsVar ltTag_RDR
1043 eqTag_Expr      = HsVar eqTag_RDR
1044 gtTag_Expr      = HsVar gtTag_RDR
1045 false_Expr      = HsVar false_RDR
1046 true_Expr       = HsVar true_RDR
1047
1048 con2tag_Expr tycon = HsVar (con2tag_RDR tycon)
1049
1050 a_Pat           = VarPatIn a_RDR
1051 b_Pat           = VarPatIn b_RDR
1052 c_Pat           = VarPatIn c_RDR
1053 d_Pat           = VarPatIn d_RDR
1054
1055 con2tag_RDR, tag2con_RDR, maxtag_RDR :: TyCon -> RdrName
1056
1057 con2tag_RDR tycon = varUnqual (SLIT("con2tag_") _APPEND_ occNameString (getOccName tycon) _APPEND_ SLIT("#"))
1058 tag2con_RDR tycon = varUnqual (SLIT("tag2con_") _APPEND_ occNameString (getOccName tycon) _APPEND_ SLIT("#"))
1059 maxtag_RDR tycon  = varUnqual (SLIT("maxtag_")  _APPEND_ occNameString (getOccName tycon) _APPEND_ SLIT("#"))
1060 \end{code}