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