ghc/compiler/types/Generics.lhs

   1 \begin{code}
   2 module Generics ( mkTyConGenInfo, mkGenericRhs,
   3                   validGenericInstanceType, validGenericMethodType
   4     ) where
   5
   6
   7 import RnHsSyn          ( RenamedHsExpr )
   8 import HsSyn            ( HsExpr(..), Pat(..), mkSimpleMatch, placeHolderType )
   9
  10 import Type             ( Type, isUnLiftedType, tyVarsOfType, tyVarsOfTypes,
  11                           mkTyVarTys, mkForAllTys, mkTyConApp,
  12                           mkFunTy, isTyVarTy, getTyVar_maybe,
  13                           funTyCon
  14                         )
  15 import TcType           ( tcSplitTyConApp_maybe, tcSplitSigmaTy, tcSplitSigmaTy )
  16 import DataCon          ( DataCon, dataConOrigArgTys, dataConWrapId, isExistentialDataCon )
  17
  18 import TyCon            ( TyCon, tyConTyVars, tyConDataCons_maybe,
  19                           tyConGenInfo, isNewTyCon, isBoxedTupleTyCon
  20                         )
  21 import Name             ( Name, mkSystemName )
  22 import CoreSyn          ( mkLams, Expr(..), CoreExpr, AltCon(..),
  23                           mkConApp, Alt, mkTyApps, mkVarApps )
  24 import CoreUtils        ( exprArity )
  25 import BasicTypes       ( EP(..), Boxity(..) )
  26 import Var              ( TyVar )
  27 import VarSet           ( varSetElems )
  28 import Id               ( Id, mkVanillaGlobal, idType, idName, mkSysLocal )
  29 import MkId             ( mkReboxingAlt, mkNewTypeBody )
  30 import TysWiredIn       ( genericTyCons,
  31                           genUnitTyCon, genUnitDataCon, plusTyCon, inrDataCon,
  32                           inlDataCon, crossTyCon, crossDataCon
  33                         )
  34 import IdInfo           ( noCafIdInfo, setUnfoldingInfo, setArityInfo )
  35 import CoreUnfold       ( mkTopUnfolding )
  36
  37 import Maybe            ( isNothing )
  38 import SrcLoc           ( noSrcLoc )
  39 import Unique           ( Unique, builtinUniques, mkBuiltinUnique )
  40 import Util             ( takeList, dropList )
  41 import Outputable
  42 import FastString
  43
  44 #include "HsVersions.h"
  45 \end{code}
  46
  47 Roadmap of what's where in the Generics work.
  48 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  49
  50 Parser
  51 No real checks.
  52
  53 RnSource.rnHsType
  54   Checks that HsNumTy has a "1" in it.
  55
  56 TcInstDcls.mkGenericInstance:
  57   Checks for invalid type patterns, such as f {| Int |}
  58
  59 TcClassDcl.tcClassSig
  60   Checks for a method type that is too complicated;
  61         e.g. has for-alls or lists in it
  62   We could lift this restriction
  63
  64 TcClassDecl.mkDefMethRhs
  65   Checks that the instance type is simple, in an instance decl
  66   where we let the compiler fill in a generic method.
  67         e.g.  instance C (T Int)
  68         is not valid if C has generic methods.
  69
  70 TcClassDecl.checkGenericClassIsUnary
  71   Checks that we don't have generic methods in a multi-parameter class
  72
  73 TcClassDecl.checkDefaultBinds
  74   Checks that all the equations for a method in a class decl
  75   are generic, or all are non-generic
  76
  77
  78
  79 Checking that the type constructors which are present in Generic
  80 patterns (not Unit, this is done differently) is done in mk_inst_info
  81 (TcInstDecls) in a call to tcHsType (TcMonoBinds). This means that
  82 HsOpTy is tied to Generic definitions which is not a very good design
  83 feature, indeed a bug. However, the check is easy to move from
  84 tcHsType back to mk_inst_info and everything will be fine. Also see
  85 bug #5. [I don't think that this is the case anymore after SPJ's latest
  86 changes in that regard.  Delete this comment?  -=chak/7Jun2]
  87
  88 Generics.lhs
  89
  90 Making generic information to put into a tycon. Constructs the
  91 representation type, which, I think, are not used later. Perhaps it is
  92 worth removing them from the GI datatype. Although it does get used in
  93 the construction of conversion functions (internally).
  94
  95 TyCon.lhs
  96
  97 Just stores generic information, accessible by tyConGenInfo or tyConGenIds.
  98
  99 TysWiredIn.lhs
 100
 101 Defines generic and other type and data constructors.
 102
 103 This is sadly incomplete, but will be added to.
 104
 105
 106 Bugs & shortcomings of existing implementation:
 107 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 108
 109 2. Another pretty big bug I dscovered at the last minute when I was
 110 testing the code is that at the moment the type variable of the class
 111 is scoped over the entire declaration, including the patterns. For
 112 instance, if I have the following code,
 113
 114 class Er a where
 115  ...
 116   er {| Plus a b |} (Inl x) (Inl y) = er x y
 117   er {| Plus a b |} (Inr x) (Inr y) = er x y
 118   er {| Plus a b |} _ _ = False
 119
 120 and I print out the types of the generic patterns, I get the
 121 following.  Note that all the variable names for "a" are the same,
 122 while for "b" they are all different.
 123
 124 check_ty
 125     [std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7g-},
 126      std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7m-},
 127      std.Generics.Plus{-33u,i-} a{-r6Z-} b{-r7p-}]
 128
 129 This is a bug as if I change the code to
 130
 131  er {| Plus c b |} (Inl x)  (Inl y) = er x y
 132
 133 all the names come out to be different.
 134
 135 Thus, all the types (Plus a b) come out to be different, so I cannot
 136 compare them and test whether they are all the same and thus cannot
 137 return an error if the type variables are different.
 138
 139 Temporary fix/hack. I am not checking for this, I just assume they are
 140 the same, see line "check_ty = True" in TcInstDecls. When we resolve
 141 the issue with variables, though - I assume that we will make them to
 142 be the same in all the type patterns, jus uncomment the check and
 143 everything should work smoothly.
 144
 145 Hence, I have also left the rather silly construction of:
 146 * extracting all the type variables from all the types
 147 * putting them *all* into the environment
 148 * typechecking all the types
 149 * selecting one of them and using it as the instance_ty.
 150
 151 (the alternative is to make sure that all the types are the same,
 152 taking one, extracting its variables, putting them into the environment,
 153 type checking it, using it as the instance_ty)
 154
 155 6. What happens if we do not supply all of the generic patterns? At
 156 the moment, the compiler crashes with an error message "Non-exhaustive
 157 patterns in a generic declaration"
 158
 159
 160 What has not been addressed:
 161 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 162
 163 Contexts. In the generated instance declarations for the 3 primitive
 164 type constructors, we need contexts. It is unclear what those should
 165 be. At the moment, we always say eg. (Eq a, Eq b) => Eq (Plus a b)
 166
 167 Type application. We have type application in expressions
 168 (essentially) on the lhs of an equation. Do we want to allow it on the
 169 RHS?
 170
 171 Scoping of type variables in a generic definition. At the moment, (see
 172 TcInstDecls) we extract the type variables inside the type patterns
 173 and add them to the environment. See my bug #2 above. This seems pretty
 174 important.
 175
 176
 177
 178 %************************************************************************
 179 %*                                                                      *
 180 \subsection{Getting the representation type out}
 181 %*                                                                      *
 182 %************************************************************************
 183
 184 \begin{code}
 185 validGenericInstanceType :: Type -> Bool
 186   -- Checks for validity of the type pattern in a generic
 187   -- declaration.  It's ok to have
 188   --    f {| a + b |} ...
 189   -- but it's not OK to have
 190   --    f {| a + Int |}
 191
 192 validGenericInstanceType inst_ty
 193   = case tcSplitTyConApp_maybe inst_ty of
 194         Just (tycon, tys) ->  all isTyVarTy tys && tycon `elem` genericTyCons
 195         Nothing           ->  False
 196
 197 validGenericMethodType :: Type -> Bool
 198   -- At the moment we only allow method types built from
 199   --    * type variables
 200   --    * function arrow
 201   --    * boxed tuples
 202   --    * an arbitrary type not involving the class type variables
 203   --            e.g. this is ok:        forall b. Ord b => [b] -> a
 204   --                 where a is the class variable
 205 validGenericMethodType ty
 206   = valid tau
 207   where
 208     (local_tvs, _, tau) = tcSplitSigmaTy ty
 209
 210     valid ty
 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 || 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 mkTyConGenInfo :: TyCon -> [Name] -> Maybe (EP Id)
 232 -- mkTyConGenInfo is called twice
 233 --      once from TysWiredIn for Tuples
 234 --      once the typechecker TcTyDecls
 235 -- to generate generic types and conversion functions for all datatypes.
 236 --
 237 -- Must only be called with an algebraic type.
 238 --
 239 -- The two names are the names constructed by the renamer
 240 -- for the fromT and toT conversion functions.
 241
 242 mkTyConGenInfo tycon []
 243   = Nothing     -- This happens when we deal with the interface-file type
 244                 -- decl for a module compiled without -fgenerics
 245
 246 mkTyConGenInfo tycon [from_name, to_name]
 247   | isNothing maybe_datacons    -- Abstractly imported types don't have
 248   = Nothing                     -- to/from operations, (and should not need them)
 249
 250         -- If any of the constructor has an unboxed type as argument,
 251         -- then we can't build the embedding-projection pair, because
 252         -- it relies on instantiating *polymorphic* sum and product types
 253         -- at the argument types of the constructors
 254         -- Nor can we do the job if it's an existential data constructor,
 255   | or [ any isUnLiftedType (dataConOrigArgTys dc) || isExistentialDataCon dc
 256        | dc <- datacons ]
 257   = Nothing
 258
 259   | null datacons       -- There are no constructors;
 260   = Nothing             -- there are no values of this type
 261
 262   | otherwise
 263   = ASSERT( not (null datacons) )       -- mk_sum_stuff loops if no datacons
 264     Just (EP { fromEP = mkVanillaGlobal from_name from_ty from_id_info,
 265                toEP   = mkVanillaGlobal to_name   to_ty   to_id_info })
 266   where
 267     maybe_datacons = tyConDataCons_maybe tycon
 268     Just datacons  = maybe_datacons             -- [C, D]
 269
 270     tyvars         = tyConTyVars tycon          -- [a, b, c]
 271     tycon_ty       = mkTyConApp tycon tyvar_tys -- T a b c
 272     tyvar_tys      = mkTyVarTys tyvars
 273
 274     from_id_info = noCafIdInfo `setUnfoldingInfo` mkTopUnfolding from_fn
 275                                       `setArityInfo`     exprArity from_fn
 276     to_id_info   = noCafIdInfo `setUnfoldingInfo` mkTopUnfolding to_fn
 277                                       `setArityInfo`     exprArity to_fn
 278         -- It's important to set the arity info, so that
 279         -- the calling convention (gotten from arity)
 280         -- matches reality.
 281
 282     from_ty = mkForAllTys tyvars (mkFunTy tycon_ty rep_ty)
 283     to_ty   = mkForAllTys tyvars (mkFunTy rep_ty tycon_ty)
 284
 285     (from_fn, to_fn, rep_ty)
 286         | isNewTyCon tycon
 287         = ( mkLams tyvars $ Lam x  $ mkNewTypeBody tycon the_arg_ty (Var x),
 288             Var (dataConWrapId the_datacon),
 289             the_arg_ty )
 290
 291         | otherwise
 292         = ( mkLams tyvars $ Lam x     $ Case (Var x) x from_alts,
 293             mkLams tyvars $ Lam rep_var to_inner,
 294             idType rep_var )
 295
 296     -- x :: T a b c
 297     x = mkGenericLocal u1 tycon_ty
 298     (u1 : uniqs) = builtinUniques
 299
 300             ----------------------
 301             --  Newtypes only
 302     [the_datacon]  = datacons
 303     the_arg_ty     = head (dataConOrigArgTys the_datacon)
 304                 -- NB: we use the arg type of the data constructor, rather than
 305                 --     the representation type of the newtype; in degnerate (recursive)
 306                 --     cases the rep type might be (), but the arg type is still T:
 307                 --              newtype T = MkT T
 308
 309             ----------------------
 310             --  Non-newtypes only
 311     -- Recurse over the sum first
 312     -- The "2" is the first free unique
 313     (from_alts, to_inner, rep_var) = mk_sum_stuff uniqs tyvars datacons
 314
 315 mkTyConGenInfo tycon names = pprPanic "mkTyConGenInfo" (ppr tycon <+> ppr names)
 316
 317
 318 ----------------------------------------------------
 319 --      Dealing with sums
 320 ----------------------------------------------------
 321 mk_sum_stuff :: [Unique]        -- Base for generating unique names
 322              -> [TyVar]         -- Type variables over which the tycon is abstracted
 323              -> [DataCon]       -- The data constructors
 324              -> ([Alt Id], CoreExpr, Id)
 325
 326 -- For example, given
 327 --      data T = C | D Int Int Int
 328 --
 329 -- mk_sum_stuff v [C,D] = ([C -> Inl Unit, D a b c -> Inr (a :*: (b :*: c))],
 330 --                         case cd of { Inl u -> C;
 331 --                                      Inr abc -> case abc of { a :*: bc ->
 332 --                                                 case bc  of { b :*: c ->
 333 --                                                 D a b c }} },
 334 --                         cd)
 335
 336 mk_sum_stuff us tyvars [datacon]
 337    = ([from_alt], to_body_fn app_exp, rep_var)
 338    where
 339      types        = dataConOrigArgTys datacon   -- Existentials already excluded
 340      datacon_vars = zipWith mkGenericLocal us types
 341      us'          = dropList types us
 342
 343      app_exp      = mkVarApps (Var (dataConWrapId datacon)) (tyvars ++ datacon_vars)
 344      from_alt     = mkReboxingAlt us' datacon datacon_vars from_alt_rhs
 345                         -- We are talking about *user* datacons here; hence
 346                         --      dataConWrapId
 347                         --      mkReboxingAlt
 348
 349      (_,args',_)  = from_alt
 350      us''         = dropList args' us'  -- Conservative, but safe
 351
 352      (_, from_alt_rhs, to_body_fn, rep_var) = mk_prod_stuff us'' datacon_vars
 353
 354 mk_sum_stuff (u:us) tyvars datacons
 355   = (wrap inlDataCon l_from_alts ++ wrap inrDataCon r_from_alts,
 356      Case (Var rep_var) rep_var [(DataAlt inlDataCon, [l_rep_var], l_to_body),
 357                                  (DataAlt inrDataCon, [r_rep_var], r_to_body)],
 358      rep_var)
 359   where
 360     (l_datacons, r_datacons)            = splitInHalf datacons
 361     (l_from_alts, l_to_body, l_rep_var) = mk_sum_stuff us tyvars l_datacons
 362     (r_from_alts, r_to_body, r_rep_var) = mk_sum_stuff us tyvars r_datacons
 363     rep_tys                             = [idType l_rep_var, idType r_rep_var]
 364     rep_ty                              = mkTyConApp plusTyCon rep_tys
 365     rep_var                             = mkGenericLocal u rep_ty
 366
 367     wrap :: DataCon -> [Alt Id] -> [Alt Id]
 368         -- Wrap an application of the Inl or Inr constructor round each alternative
 369     wrap datacon alts
 370         = [(dc, args, App datacon_app rhs) | (dc,args,rhs) <- alts]
 371         where
 372           datacon_app = mkTyApps (Var (dataConWrapId datacon)) rep_tys
 373
 374 ----------------------------------------------------
 375 --      Dealing with products
 376 ----------------------------------------------------
 377 mk_prod_stuff :: [Unique]               -- Base for unique names
 378               -> [Id]                   -- arg-ids; args of the original user-defined constructor
 379                                         --      They are bound enclosing from_rhs
 380                                         --      Please bind these in the to_body_fn
 381               -> ([Unique],             -- Depleted unique-name supply
 382                   CoreExpr,             -- from-rhs: puts together the representation from the arg_ids
 383                   CoreExpr -> CoreExpr, -- to_body_fn: takes apart the representation
 384                   Id)                   -- The rep-id; please bind this to the representation
 385
 386 -- For example:
 387 -- mk_prod_stuff [a,b,c] = ( a :*: (b :*: c),
 388 --                           \x -> case abc of { a :*: bc ->
 389 --                                 case bc  of { b :*: c  ->
 390 --                                 x,
 391 --                           abc )
 392
 393 -- We need to use different uqiques in the branches
 394 -- because the returned to_body_fns are nested.
 395 -- Hence the returned unqique-name supply
 396
 397 mk_prod_stuff (u:us) []         -- Unit case
 398   = (us,
 399      Var (dataConWrapId genUnitDataCon),
 400      \x -> x,
 401      mkGenericLocal u (mkTyConApp genUnitTyCon []))
 402
 403 mk_prod_stuff us [arg_var]      -- Singleton case
 404   = (us, Var arg_var, \x -> x, arg_var)
 405
 406 mk_prod_stuff (u:us) arg_vars   -- Two or more
 407   = (us'',
 408      mkConApp crossDataCon (map Type rep_tys ++ [l_alt_rhs, r_alt_rhs]),
 409      \x -> Case (Var rep_var) rep_var
 410                 [(DataAlt crossDataCon, [l_rep_var, r_rep_var], l_to_body_fn (r_to_body_fn x))],
 411      rep_var)
 412   where
 413     (l_arg_vars, r_arg_vars)             = splitInHalf arg_vars
 414     (us', l_alt_rhs, l_to_body_fn, l_rep_var) = mk_prod_stuff us  l_arg_vars
 415     (us'', r_alt_rhs, r_to_body_fn, r_rep_var) = mk_prod_stuff us' r_arg_vars
 416     rep_var = mkGenericLocal u (mkTyConApp crossTyCon rep_tys)
 417     rep_tys = [idType l_rep_var, idType r_rep_var]
 418 \end{code}
 419
 420 A little utility function
 421
 422 \begin{code}
 423 splitInHalf :: [a] -> ([a],[a])
 424 splitInHalf list = (left, right)
 425                  where
 426                    half  = length list `div` 2
 427                    left  = take half list
 428                    right = drop half list
 429
 430 mkGenericLocal :: Unique -> Type -> Id
 431 mkGenericLocal uniq ty = mkSysLocal FSLIT("g") uniq ty
 432 \end{code}
 433
 434 %************************************************************************
 435 %*                                                                      *
 436 \subsection{Generating the RHS of a generic default method}
 437 %*                                                                      *
 438 %************************************************************************
 439
 440 Generating the Generic default method.  Uses the bimaps to generate the
 441 actual method. All of this is rather incomplete, but it would be nice
 442 to make even this work.  Example
 443
 444         class Foo a where
 445           op :: Op a
 446
 447         instance Foo T
 448
 449 Then we fill in the RHS for op, RenamedHsExpr, by calling mkGenericRhs:
 450
 451         instance Foo T where
 452            op = <mkGenericRhs op a T>
 453
 454 To do this, we generate a pair of RenamedHsExprs (EP toOp fromOp), where
 455
 456         toOp   :: Op Trep -> Op T
 457         fromOp :: Op T    -> Op Trep
 458
 459 (the bimap) and then fill in the RHS with
 460
 461         instance Foo T where
 462            op = toOp op
 463
 464 Remember, we're generating a RenamedHsExpr, so the result of all this
 465 will be fed to the type checker.  So the 'op' on the RHS will be
 466 at the representation type for T, Trep.
 467
 468
 469 A note about polymorphism.  Suppose the class op is polymorphic:
 470
 471         class Baz a where
 472           op :: forall b. Ord b => a -> b -> b
 473
 474 Then we can still generate a bimap with
 475
 476         toOP :: forall b. (Trep -> b -> b) -> (T -> b -> b)
 477
 478 and fill in the instance decl thus
 479
 480         instance Foo T where
 481            op = toOp op
 482
 483 By the time the type checker has done its stuff we'll get
 484
 485         instance Foo T where
 486            op = \b. \dict::Ord b. toOp b (op Trep b dict)
 487
 488 \begin{code}
 489 mkGenericRhs :: Id -> TyVar -> TyCon -> RenamedHsExpr
 490 mkGenericRhs sel_id tyvar tycon
 491   = HsApp (toEP bimap) (HsVar (idName sel_id))
 492   where
 493         -- Initialising the "Environment" with the from/to functions
 494         -- on the datatype (actually tycon) in question
 495         Just (EP from to) = tyConGenInfo tycon  -- Caller checked this will succeed
 496         ep                = EP (HsVar (idName from)) (HsVar (idName to))
 497
 498         -- Takes out the ForAll and the Class restrictions
 499         -- in front of the type of the method.
 500         (_,_,op_ty) = tcSplitSigmaTy (idType sel_id)
 501
 502         -- Do it again!  This deals with the case where the method type
 503         -- is polymorphic -- see notes above
 504         (local_tvs,_,final_ty) = tcSplitSigmaTy op_ty
 505
 506         -- Now we probably have a tycon in front
 507         -- of us, quite probably a FunTyCon.
 508         bimap = generate_bimap (tyvar, ep, local_tvs) final_ty
 509
 510 type EPEnv = (TyVar,            -- The class type variable
 511               EP RenamedHsExpr, -- The EP it maps to
 512               [TyVar]           -- Other in-scope tyvars; they have an identity EP
 513              )
 514
 515 -------------------
 516 generate_bimap :: EPEnv
 517                -> Type
 518                -> EP RenamedHsExpr
 519 -- Top level case - splitting the TyCon.
 520 generate_bimap env@(tv,ep,local_tvs) ty
 521   = case getTyVar_maybe ty of
 522         Just tv1 |  tv == tv1 -> ep                             -- The class tyvar
 523                  |  otherwise -> ASSERT( tv1 `elem` local_tvs)  -- One of the polymorphic tyvars of the method
 524                                  idEP
 525         Nothing  -> bimapApp env (tcSplitTyConApp_maybe ty)
 526
 527 -------------------
 528 bimapApp :: EPEnv -> Maybe (TyCon, [Type]) -> EP RenamedHsExpr
 529 bimapApp env Nothing                = panic "TcClassDecl: Type Application!"
 530 bimapApp env (Just (tycon, ty_args))
 531   | tycon == funTyCon       = bimapArrow arg_eps
 532   | isBoxedTupleTyCon tycon = bimapTuple arg_eps
 533   | otherwise               =   -- Otherwise validGenericMethodType will
 534                                 -- have checked that the type is a constant type
 535                               ASSERT( all (`elem` local_tvs) (varSetElems (tyVarsOfTypes ty_args)) )
 536                               idEP
 537     where
 538       arg_eps = map (generate_bimap env) ty_args
 539       (_,_,local_tvs) = env
 540
 541 -------------------
 542 -- bimapArrow :: [EP a a', EP b b'] -> EP (a->b) (a'->b')
 543 bimapArrow [ep1, ep2]
 544   = EP { fromEP = mk_hs_lam [VarPat g1, VarPat g2] from_body,
 545          toEP   = mk_hs_lam [VarPat g1, VarPat g2] to_body }
 546   where
 547     from_body = fromEP ep2 `HsApp` (HsPar $ HsVar g1 `HsApp` (HsPar $ toEP   ep1 `HsApp` HsVar g2))
 548     to_body   = toEP   ep2 `HsApp` (HsPar $ HsVar g1 `HsApp` (HsPar $ fromEP ep1 `HsApp` HsVar g2))
 549
 550 -------------------
 551 bimapTuple eps
 552   = EP { fromEP = mk_hs_lam [tuple_pat] from_body,
 553          toEP   = mk_hs_lam [tuple_pat] to_body }
 554   where
 555     names       = takeList eps genericNames
 556     tuple_pat   = TuplePat (map VarPat names) Boxed
 557     eps_w_names = eps `zip` names
 558     to_body     = ExplicitTuple [toEP   ep `HsApp` HsVar g | (ep,g) <- eps_w_names] Boxed
 559     from_body   = ExplicitTuple [fromEP ep `HsApp` HsVar g | (ep,g) <- eps_w_names] Boxed
 560
 561 -------------------
 562 genericNames :: [Name]
 563 genericNames = [mkSystemName (mkBuiltinUnique i) (mkFastString ('g' : show i)) | i <- [1..]]
 564 (g1:g2:g3:_) = genericNames
 565
 566 mk_hs_lam pats body = HsPar (HsLam (mkSimpleMatch pats body placeHolderType noSrcLoc))
 567
 568 idEP :: EP RenamedHsExpr
 569 idEP = EP idexpr idexpr
 570      where
 571        idexpr = mk_hs_lam [VarPat g3] (HsVar g3)
 572 \end{code}