compiler/types/Generics.lhs

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