compiler/types/Generics.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 %
   4
   5 \begin{code}
   6 {-# OPTIONS -fno-warn-incomplete-patterns #-}
   7 -- The above warning supression flag is a temporary kludge.
   8 -- While working on this module you are encouraged to remove it and fix
   9 -- any warnings in the module. See
  10 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  11 -- for details
  12
  13 module Generics ( canDoGenerics, mkTyConGenericBinds,
  14                   mkGenericRhs,
  15                   validGenericInstanceType, validGenericMethodType
  16     ) where
  17
  18
  19 import HsSyn
  20 import Type
  21 import TcHsSyn
  22 import TcType
  23 import DataCon
  24
  25 import TyCon
  26 import Name
  27 import OccName
  28 import RdrName
  29 import BasicTypes
  30 import Var
  31 import VarSet
  32 import Id
  33 import TysWiredIn
  34 import PrelNames
  35
  36 import SrcLoc
  37 import Util
  38 import Bag
  39 import Outputable
  40 import FastString
  41
  42 #include "HsVersions.h"
  43 \end{code}
  44
  45 Roadmap of what's where in the Generics work.
  46 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  47
  48 Parser
  49 No real checks.
  50
  51 RnSource.rnHsType
  52   Checks that HsNumTy has a "1" in it.
  53
  54 TcInstDcls.mkGenericInstance:
  55   Checks for invalid type patterns, such as f {| Int |}
  56
  57 TcClassDcl.tcClassSig
  58   Checks for a method type that is too complicated;
  59         e.g. has for-alls or lists in it
  60   We could lift this restriction
  61
  62 TcClassDecl.mkDefMethRhs
  63   Checks that the instance type is simple, in an instance decl
  64   where we let the compiler fill in a generic method.
  65         e.g.  instance C (T Int)
  66         is not valid if C has generic methods.
  67
  68 TcClassDecl.checkGenericClassIsUnary
  69   Checks that we don't have generic methods in a multi-parameter class
  70
  71 TcClassDecl.checkDefaultBinds
  72   Checks that all the equations for a method in a class decl
  73   are generic, or all are non-generic
  74
  75
  76
  77 Checking that the type constructors which are present in Generic
  78 patterns (not Unit, this is done differently) is done in mk_inst_info
  79 (TcInstDecls) in a call to tcHsType (TcMonoBinds). This means that
  80 HsOpTy is tied to Generic definitions which is not a very good design
  81 feature, indeed a bug. However, the check is easy to move from
  82 tcHsType back to mk_inst_info and everything will be fine. Also see
  83 bug #5. [I don't think that this is the case anymore after SPJ's latest
  84 changes in that regard.  Delete this comment?  -=chak/7Jun2]
  85
  86 Generics.lhs
  87
  88 Making generic information to put into a tycon. Constructs the
  89 representation type, which, I think, are not used later. Perhaps it is
  90 worth removing them from the GI datatype. Although it does get used in
  91 the construction of conversion functions (internally).
  92
  93 TyCon.lhs
  94
  95 Just stores generic information, accessible by tyConGenInfo or tyConGenIds.
  96
  97 TysWiredIn.lhs
  98
  99 Defines generic and other type and data constructors.
 100
 101 This is sadly incomplete, but will be added to.
 102
 103
 104 Bugs & shortcomings of existing implementation:
 105 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 106
 107 2. Another pretty big bug I dscovered at the last minute when I was
 108 testing the code is that at the moment the type variable of the class
 109 is scoped over the entire declaration, including the patterns. For
 110 instance, if I have the following code,
 111
 112 class Er a where
 113  ...
 114   er {| Plus a b |} (Inl x) (Inl y) = er x y
 115   er {| Plus a b |} (Inr x) (Inr y) = er x y
 116   er {| Plus a b |} _ _ = False
 117
 118 and I print out the types of the generic patterns, I get the
 119 following.  Note that all the variable names for "a" are the same,
 120 while for "b" they are all different.
 121
 122 check_ty
 123     [std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7g-},
 124      std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7m-},
 125      std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7p-}]
 126
 127 This is a bug as if I change the code to
 128
 129  er {| Plus c b |} (Inl x)  (Inl y) = er x y
 130
 131 all the names come out to be different.
 132
 133 Thus, all the types (Plus a b) come out to be different, so I cannot
 134 compare them and test whether they are all the same and thus cannot
 135 return an error if the type variables are different.
 136
 137 Temporary fix/hack. I am not checking for this, I just assume they are
 138 the same, see line "check_ty = True" in TcInstDecls. When we resolve
 139 the issue with variables, though - I assume that we will make them to
 140 be the same in all the type patterns, jus uncomment the check and
 141 everything should work smoothly.
 142
 143 Hence, I have also left the rather silly construction of:
 144 * extracting all the type variables from all the types
 145 * putting them *all* into the environment
 146 * typechecking all the types
 147 * selecting one of them and using it as the instance_ty.
 148
 149 (the alternative is to make sure that all the types are the same,
 150 taking one, extracting its variables, putting them into the environment,
 151 type checking it, using it as the instance_ty)
 152
 153 6. What happens if we do not supply all of the generic patterns? At
 154 the moment, the compiler crashes with an error message "Non-exhaustive
 155 patterns in a generic declaration"
 156
 157
 158 What has not been addressed:
 159 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 160
 161 Contexts. In the generated instance declarations for the 3 primitive
 162 type constructors, we need contexts. It is unclear what those should
 163 be. At the moment, we always say eg. (Eq a, Eq b) => Eq (Plus a b)
 164
 165 Type application. We have type application in expressions
 166 (essentially) on the lhs of an equation. Do we want to allow it on the
 167 RHS?
 168
 169 Scoping of type variables in a generic definition. At the moment, (see
 170 TcInstDecls) we extract the type variables inside the type patterns
 171 and add them to the environment. See my bug #2 above. This seems pretty
 172 important.
 173
 174
 175
 176 %************************************************************************
 177 %*                                                                      *
 178 \subsection{Getting the representation type out}
 179 %*                                                                      *
 180 %************************************************************************
 181
 182 \begin{code}
 183 validGenericInstanceType :: Type -> Bool
 184   -- Checks for validity of the type pattern in a generic
 185   -- declaration.  It's ok to have
 186   --    f {| a + b |} ...
 187   -- but it's not OK to have
 188   --    f {| a + Int |}
 189
 190 validGenericInstanceType inst_ty
 191   = case tcSplitTyConApp_maybe inst_ty of
 192         Just (tycon, tys) ->  all isTyVarTy tys && tyConName tycon `elem` genericTyConNames
 193         Nothing           ->  False
 194
 195 validGenericMethodType :: Type -> Bool
 196   -- At the moment we only allow method types built from
 197   --    * type variables
 198   --    * function arrow
 199   --    * boxed tuples
 200   --    * lists
 201   --    * an arbitrary type not involving the class type variables
 202   --            e.g. this is ok:        forall b. Ord b => [b] -> a
 203   --                 where a is the class variable
 204 validGenericMethodType ty
 205   = valid tau
 206   where
 207     (local_tvs, _, tau) = tcSplitSigmaTy ty
 208
 209     valid ty
 210       | not (isTauTy ty) = False        -- Note [Higher ramk methods]
 211       | isTyVarTy ty     = True
 212       | no_tyvars_in_ty  = True
 213       | otherwise        = case tcSplitTyConApp_maybe ty of
 214                                 Just (tc,tys) -> valid_tycon tc && all valid tys
 215                                 Nothing       -> False
 216       where
 217         no_tyvars_in_ty = all (`elem` local_tvs) (varSetElems (tyVarsOfType ty))
 218
 219     valid_tycon tc = tc == funTyCon || tc == listTyCon || isBoxedTupleTyCon tc
 220         -- Compare bimapApp, below
 221 \end{code}
 222
 223
 224 %************************************************************************
 225 %*                                                                      *
 226 \subsection{Generating representation types}
 227 %*                                                                      *
 228 %************************************************************************
 229
 230 \begin{code}
 231 canDoGenerics :: [DataCon] -> Bool
 232 -- Called on source-code data types, to see if we should generate
 233 -- generic functions for them.  (This info is recorded in the interface file for
 234 -- imported data types.)
 235
 236 canDoGenerics data_cons
 237   =  not (any bad_con data_cons)        -- See comment below
 238   && not (null data_cons)               -- No values of the type
 239   where
 240     bad_con dc = any bad_arg_type (dataConOrigArgTys dc) || not (isVanillaDataCon dc)
 241         -- If any of the constructor has an unboxed type as argument,
 242         -- then we can't build the embedding-projection pair, because
 243         -- it relies on instantiating *polymorphic* sum and product types
 244         -- at the argument types of the constructors
 245
 246         -- Nor can we do the job if it's an existential data constructor,
 247
 248         -- Nor if the args are polymorphic types (I don't think)
 249     bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty)
 250 \end{code}
 251
 252 %************************************************************************
 253 %*                                                                      *
 254 \subsection{Generating the RHS of a generic default method}
 255 %*                                                                      *
 256 %************************************************************************
 257
 258 \begin{code}
 259 type US = Int   -- Local unique supply, just a plain Int
 260 type FromAlt = (LPat RdrName, LHsExpr RdrName)
 261
 262 mkTyConGenericBinds :: TyCon -> LHsBinds RdrName
 263 mkTyConGenericBinds tycon
 264   = unitBag (L loc (mkFunBind (L loc from_RDR) from_matches))
 265         `unionBags`
 266     unitBag (L loc (mkFunBind (L loc to_RDR) to_matches))
 267   where
 268     from_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- from_alts]
 269     to_matches   = [mkSimpleHsAlt to_pat to_body]
 270     loc      = srcLocSpan (getSrcLoc tycon)
 271     datacons = tyConDataCons tycon
 272     (from_RDR, to_RDR) = mkGenericNames tycon
 273
 274     -- Recurse over the sum first
 275     from_alts :: [FromAlt]
 276     (from_alts, to_pat, to_body) = mk_sum_stuff init_us datacons
 277     init_us = 1::Int            -- Unique supply
 278
 279 ----------------------------------------------------
 280 --      Dealing with sums
 281 ----------------------------------------------------
 282
 283 mk_sum_stuff :: US                      -- Base for generating unique names
 284              -> [DataCon]               -- The data constructors
 285              -> ([FromAlt],                             -- Alternatives for the T->Trep "from" function
 286                  InPat RdrName, LHsExpr RdrName)        -- Arg and body of the Trep->T "to" function
 287
 288 -- For example, given
 289 --      data T = C | D Int Int Int
 290 --
 291 -- mk_sum_stuff v [C,D] = ([C -> Inl Unit, D a b c -> Inr (a :*: (b :*: c))],
 292 --                         case cd of { Inl u -> C;
 293 --                                      Inr abc -> case abc of { a :*: bc ->
 294 --                                                 case bc  of { b :*: c ->
 295 --                                                 D a b c }} },
 296 --                         cd)
 297
 298 mk_sum_stuff us [datacon]
 299    = ([from_alt], to_pat, to_body_fn app_exp)
 300    where
 301      n_args = dataConSourceArity datacon        -- Existentials already excluded
 302
 303      datacon_vars = map mkGenericLocal [us .. us+n_args-1]
 304      us'          = us + n_args
 305
 306      datacon_rdr  = getRdrName datacon
 307      app_exp      = nlHsVarApps datacon_rdr datacon_vars
 308      from_alt     = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)
 309
 310      (_, from_alt_rhs, to_pat, to_body_fn) = mk_prod_stuff us' datacon_vars
 311
 312 mk_sum_stuff us datacons
 313   = (wrap inlDataCon_RDR l_from_alts ++ wrap inrDataCon_RDR r_from_alts,
 314      nlVarPat to_arg,
 315      noLoc (HsCase (nlHsVar to_arg)
 316             (mkMatchGroup [mkSimpleHsAlt (nlConPat inlDataCon_RDR [l_to_pat]) l_to_body,
 317                            mkSimpleHsAlt (nlConPat inrDataCon_RDR [r_to_pat]) r_to_body])))
 318   where
 319     (l_datacons, r_datacons)            = splitInHalf datacons
 320     (l_from_alts, l_to_pat, l_to_body)  = mk_sum_stuff us' l_datacons
 321     (r_from_alts, r_to_pat, r_to_body)  = mk_sum_stuff us' r_datacons
 322
 323     to_arg = mkGenericLocal us
 324     us'    = us+1
 325
 326     wrap :: RdrName -> [FromAlt] -> [FromAlt]
 327         -- Wrap an application of the Inl or Inr constructor round each alternative
 328     wrap dc alts = [(pat, noLoc (HsApp (nlHsVar dc) rhs)) | (pat,rhs) <- alts]
 329
 330
 331 ----------------------------------------------------
 332 --      Dealing with products
 333 ----------------------------------------------------
 334 mk_prod_stuff :: US                     -- Base for unique names
 335               -> [RdrName]              -- arg-ids; args of the original user-defined constructor
 336                                         --      They are bound enclosing from_rhs
 337                                         --      Please bind these in the to_body_fn
 338               -> (US,                   -- Depleted unique-name supply
 339                   LHsExpr RdrName,                      -- from-rhs: puts together the representation from the arg_ids
 340                   InPat RdrName,                        -- to_pat:
 341                   LHsExpr RdrName -> LHsExpr RdrName)   -- to_body_fn: takes apart the representation
 342
 343 -- For example:
 344 -- mk_prod_stuff abc [a,b,c] = ( a :*: (b :*: c),
 345 --                               abc,
 346 --                               \<body-code> -> case abc of { a :*: bc ->
 347 --                                               case bc  of { b :*: c  ->
 348 --                                               <body-code> )
 349
 350 -- We need to use different uniques in the branches
 351 -- because the returned to_body_fns are nested.
 352 -- Hence the returned unqique-name supply
 353
 354 mk_prod_stuff us []             -- Unit case
 355   = (us+1,
 356      nlHsVar genUnitDataCon_RDR,
 357      noLoc (SigPatIn (nlVarPat (mkGenericLocal us))
 358                      (noLoc (HsTyVar (getRdrName genUnitTyConName)))),
 359         -- Give a signature to the pattern so we get
 360         --      data S a = Nil | S a
 361         --      toS = \x -> case x of { Inl (g :: Unit) -> Nil
 362         --                              Inr x -> S x }
 363         -- The (:: Unit) signature ensures that we'll infer the right
 364         -- type for toS. If we leave it out, the type is too polymorphic
 365
 366      \x -> x)
 367
 368 mk_prod_stuff us [arg_var]      -- Singleton case
 369   = (us, nlHsVar arg_var, nlVarPat arg_var, \x -> x)
 370
 371 mk_prod_stuff us arg_vars       -- Two or more
 372   = (us'',
 373      nlHsApps crossDataCon_RDR [l_alt_rhs, r_alt_rhs],
 374      nlVarPat to_arg,
 375 -- gaw 2004 FIX?
 376      \x -> noLoc (HsCase (nlHsVar to_arg)
 377                   (mkMatchGroup [mkSimpleHsAlt pat (l_to_body_fn (r_to_body_fn x))])))
 378   where
 379     to_arg = mkGenericLocal us
 380     (l_arg_vars, r_arg_vars)                  = splitInHalf arg_vars
 381     (us',  l_alt_rhs, l_to_pat, l_to_body_fn) = mk_prod_stuff (us+1)  l_arg_vars
 382     (us'', r_alt_rhs, r_to_pat, r_to_body_fn) = mk_prod_stuff us' r_arg_vars
 383     pat = nlConPat crossDataCon_RDR [l_to_pat, r_to_pat]
 384
 385 splitInHalf :: [a] -> ([a],[a])
 386 splitInHalf list = (left, right)
 387                  where
 388                    half  = length list `div` 2
 389                    left  = take half list
 390                    right = drop half list
 391
 392 mkGenericLocal :: US -> RdrName
 393 mkGenericLocal u = mkVarUnqual (mkFastString ("g" ++ show u))
 394
 395 mkGenericNames :: TyCon -> (RdrName, RdrName)
 396 mkGenericNames tycon
 397   = (from_RDR, to_RDR)
 398   where
 399     tc_name  = tyConName tycon
 400     tc_occ   = nameOccName tc_name
 401     tc_mod   = ASSERT( isExternalName tc_name ) nameModule tc_name
 402     from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
 403     to_RDR   = mkOrig tc_mod (mkGenOcc2 tc_occ)
 404 \end{code}
 405
 406 %************************************************************************
 407 %*                                                                      *
 408 \subsection{Generating the RHS of a generic default method}
 409 %*                                                                      *
 410 %************************************************************************
 411
 412 Generating the Generic default method.  Uses the bimaps to generate the
 413 actual method. All of this is rather incomplete, but it would be nice
 414 to make even this work.  Example
 415
 416         class Foo a where
 417           op :: Op a
 418
 419         instance Foo T
 420
 421 Then we fill in the RHS for op, RenamedHsExpr, by calling mkGenericRhs:
 422
 423         instance Foo T where
 424            op = <mkGenericRhs op a T>
 425
 426 To do this, we generate a pair of RenamedHsExprs (EP toOp fromOp), where
 427
 428         toOp   :: Op Trep -> Op T
 429         fromOp :: Op T    -> Op Trep
 430
 431 (the bimap) and then fill in the RHS with
 432
 433         instance Foo T where
 434            op = toOp op
 435
 436 Remember, we're generating a RenamedHsExpr, so the result of all this
 437 will be fed to the type checker.  So the 'op' on the RHS will be
 438 at the representation type for T, Trep.
 439
 440
 441 Note [Polymorphic methods]
 442 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 443 Suppose the class op is polymorphic:
 444
 445         class Baz a where
 446           op :: forall b. Ord b => a -> b -> b
 447
 448 Then we can still generate a bimap with
 449
 450         toOP :: forall b. (Trep -> b -> b) -> (T -> b -> b)
 451
 452 and fill in the instance decl thus
 453
 454         instance Foo T where
 455            op = toOp op
 456
 457 By the time the type checker has done its stuff we'll get
 458
 459         instance Foo T where
 460            op = \b. \dict::Ord b. toOp b (op Trep b dict)
 461
 462 Note [Higher rank methods]
 463 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 464 Higher-rank method types don't work, because we'd generate a bimap that
 465 needs impredicative polymorphism.  In principle that should be possible
 466 (with boxy types and all) but it would take a bit of working out.   Here's
 467 an example:
 468   class ChurchEncode k where
 469     match :: k -> z
 470           -> (forall a b z. a -> b -> z)  {- product -}
 471           -> (forall a   z. a -> z)       {- left -}
 472           -> (forall a   z. a -> z)       {- right -}
 473           -> z
 474
 475     match {| Unit    |} Unit      unit prod left right = unit
 476     match {| a :*: b |} (x :*: y) unit prod left right = prod x y
 477     match {| a :+: b |} (Inl l)   unit prod left right = left l
 478     match {| a :+: b |} (Inr r)   unit prod left right = right r
 479
 480 \begin{code}
 481 mkGenericRhs :: Id -> TyVar -> TyCon -> LHsExpr RdrName
 482 mkGenericRhs sel_id tyvar tycon
 483   = ASSERT( isSingleton ctxt )  -- Checks shape of selector-id context
 484 --    pprTrace "mkGenericRhs" (vcat [ppr sel_id, ppr (idType sel_id), ppr tyvar, ppr tycon, ppr local_tvs, ppr final_ty]) $
 485     mkHsApp (toEP bimap) (nlHsVar (getRdrName sel_id))
 486   where
 487         -- Initialising the "Environment" with the from/to functions
 488         -- on the datatype (actually tycon) in question
 489         (from_RDR, to_RDR) = mkGenericNames tycon
 490
 491         -- Instantiate the selector type, and strip off its class context
 492         (ctxt, op_ty) = tcSplitPhiTy (applyTy (idType sel_id) (mkTyVarTy tyvar))
 493
 494         -- Do it again!  This deals with the case where the method type
 495         -- is polymorphic -- see Note [Polymorphic methods] above
 496         (local_tvs,_,final_ty) = tcSplitSigmaTy op_ty
 497
 498         -- Now we probably have a tycon in front
 499         -- of us, quite probably a FunTyCon.
 500         ep    = EP (nlHsVar from_RDR) (nlHsVar to_RDR)
 501         bimap = generate_bimap (tyvar, ep, local_tvs) final_ty
 502
 503 type EPEnv = (TyVar,                    -- The class type variable
 504               EP (LHsExpr RdrName),     -- The EP it maps to
 505               [TyVar]                   -- Other in-scope tyvars; they have an identity EP
 506              )
 507
 508 -------------------
 509 generate_bimap :: EPEnv
 510                -> Type
 511                -> EP (LHsExpr RdrName)
 512 -- Top level case - splitting the TyCon.
 513 generate_bimap env@(tv,ep,local_tvs) ty
 514   | all (`elem` local_tvs) (varSetElems (tyVarsOfType ty))
 515   = idEP        -- A constant type
 516
 517   | Just tv1 <- getTyVar_maybe ty
 518   = ASSERT( tv == tv1 ) ep                                      -- The class tyvar
 519
 520   | Just (tycon, ty_args) <- tcSplitTyConApp_maybe ty
 521   = bimapTyCon tycon (map (generate_bimap env) ty_args)
 522
 523   | otherwise
 524   = pprPanic "generate_bimap" (ppr ty)
 525
 526 -------------------
 527 bimapTyCon :: TyCon -> [EP  (LHsExpr RdrName)] -> EP (LHsExpr RdrName)
 528 bimapTyCon tycon arg_eps
 529   | tycon == funTyCon       = bimapArrow arg_eps
 530   | tycon == listTyCon      = bimapList arg_eps
 531   | isBoxedTupleTyCon tycon = bimapTuple arg_eps
 532   | otherwise               = pprPanic "bimapTyCon" (ppr tycon)
 533
 534 -------------------
 535 -- bimapArrow :: [EP a a', EP b b'] -> EP (a->b) (a'->b')
 536 bimapArrow :: [EP (LHsExpr RdrName)] -> EP (LHsExpr RdrName)
 537 bimapArrow [ep1, ep2]
 538   = EP { fromEP = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] from_body,
 539          toEP   = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] to_body }
 540   where
 541     from_body = fromEP ep2 `mkHsApp` (mkHsPar $ nlHsVar a_RDR `mkHsApp` (mkHsPar $ toEP   ep1 `mkHsApp` nlHsVar b_RDR))
 542     to_body   = toEP   ep2 `mkHsApp` (mkHsPar $ nlHsVar a_RDR `mkHsApp` (mkHsPar $ fromEP ep1 `mkHsApp` nlHsVar b_RDR))
 543
 544 -------------------
 545 -- bimapTuple :: [EP a1 b1, ... EP an bn] -> EP (a1,...an) (b1,..bn)
 546 bimapTuple :: [EP (LHsExpr RdrName)] -> EP (LHsExpr RdrName)
 547 bimapTuple eps
 548   = EP { fromEP = mkHsLam [noLoc tuple_pat] (noLoc from_body),
 549          toEP   = mkHsLam [noLoc tuple_pat] (noLoc to_body) }
 550   where
 551     names       = takeList eps gs_RDR
 552     tuple_pat   = TuplePat (map nlVarPat names) Boxed placeHolderType
 553     eps_w_names = eps `zip` names
 554     to_body     = ExplicitTuple [toEP   ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed
 555     from_body   = ExplicitTuple [fromEP ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed
 556
 557 -------------------
 558 -- bimapList :: EP a b -> EP [a] [b]
 559 bimapList :: [EP (LHsExpr RdrName)] -> EP (LHsExpr RdrName)
 560 bimapList [ep]
 561   = EP { fromEP = nlHsApp (nlHsVar map_RDR) (fromEP ep),
 562          toEP   = nlHsApp (nlHsVar map_RDR) (toEP ep) }
 563
 564 -------------------
 565 a_RDR, b_RDR :: RdrName
 566 a_RDR   = mkVarUnqual (fsLit "a")
 567 b_RDR   = mkVarUnqual (fsLit "b")
 568
 569 gs_RDR :: [RdrName]
 570 gs_RDR  = [ mkVarUnqual (mkFastString ("g"++show i)) | i <- [(1::Int) .. ] ]
 571
 572 idEP :: EP (LHsExpr RdrName)
 573 idEP = EP idexpr idexpr
 574      where
 575        idexpr = mkHsLam [nlVarPat a_RDR] (nlHsVar a_RDR)
 576 \end{code}