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, tyVarsOfTypes,
  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       | isTyVarTy ty    = True
 206       | no_tyvars_in_ty = True
 207       | otherwise       = case tcSplitTyConApp_maybe ty of
 208                                 Just (tc,tys) -> valid_tycon tc && all valid tys
 209                                 Nothing       -> False
 210       where
 211         no_tyvars_in_ty = all (`elem` local_tvs) (varSetElems (tyVarsOfType ty))
 212
 213     valid_tycon tc = tc == funTyCon || tc == listTyCon || isBoxedTupleTyCon tc
 214         -- Compare bimapApp, below
 215 \end{code}
 216
 217
 218 %************************************************************************
 219 %*                                                                      *
 220 \subsection{Generating representation types}
 221 %*                                                                      *
 222 %************************************************************************
 223
 224 \begin{code}
 225 canDoGenerics :: [DataCon] -> Bool
 226 -- Called on source-code data types, to see if we should generate
 227 -- generic functions for them.  (This info is recorded in the interface file for
 228 -- imported data types.)
 229
 230 canDoGenerics data_cons
 231   =  not (any bad_con data_cons)        -- See comment below
 232   && not (null data_cons)               -- No values of the type
 233   where
 234     bad_con dc = any bad_arg_type (dataConOrigArgTys dc) || not (isVanillaDataCon dc)
 235         -- If any of the constructor has an unboxed type as argument,
 236         -- then we can't build the embedding-projection pair, because
 237         -- it relies on instantiating *polymorphic* sum and product types
 238         -- at the argument types of the constructors
 239
 240         -- Nor can we do the job if it's an existential data constructor,
 241
 242         -- Nor if the args are polymorphic types (I don't think)
 243     bad_arg_type ty = isUnLiftedType ty || not (isTauTy ty)
 244 \end{code}
 245
 246 %************************************************************************
 247 %*                                                                      *
 248 \subsection{Generating the RHS of a generic default method}
 249 %*                                                                      *
 250 %************************************************************************
 251
 252 \begin{code}
 253 type US = Int   -- Local unique supply, just a plain Int
 254 type FromAlt = (LPat RdrName, LHsExpr RdrName)
 255
 256 mkTyConGenericBinds :: TyCon -> LHsBinds RdrName
 257 mkTyConGenericBinds tycon
 258   = unitBag (L loc (mkFunBind (L loc from_RDR) from_matches))
 259         `unionBags`
 260     unitBag (L loc (mkFunBind (L loc to_RDR) to_matches))
 261   where
 262     from_matches = [mkSimpleHsAlt pat rhs | (pat,rhs) <- from_alts]
 263     to_matches   = [mkSimpleHsAlt to_pat to_body]
 264     loc      = srcLocSpan (getSrcLoc tycon)
 265     datacons = tyConDataCons tycon
 266     (from_RDR, to_RDR) = mkGenericNames tycon
 267
 268     -- Recurse over the sum first
 269     from_alts :: [FromAlt]
 270     (from_alts, to_pat, to_body) = mk_sum_stuff init_us datacons
 271     init_us = 1::Int            -- Unique supply
 272
 273 ----------------------------------------------------
 274 --      Dealing with sums
 275 ----------------------------------------------------
 276
 277 mk_sum_stuff :: US                      -- Base for generating unique names
 278              -> [DataCon]               -- The data constructors
 279              -> ([FromAlt],                             -- Alternatives for the T->Trep "from" function
 280                  InPat RdrName, LHsExpr RdrName)        -- Arg and body of the Trep->T "to" function
 281
 282 -- For example, given
 283 --      data T = C | D Int Int Int
 284 --
 285 -- mk_sum_stuff v [C,D] = ([C -> Inl Unit, D a b c -> Inr (a :*: (b :*: c))],
 286 --                         case cd of { Inl u -> C;
 287 --                                      Inr abc -> case abc of { a :*: bc ->
 288 --                                                 case bc  of { b :*: c ->
 289 --                                                 D a b c }} },
 290 --                         cd)
 291
 292 mk_sum_stuff us [datacon]
 293    = ([from_alt], to_pat, to_body_fn app_exp)
 294    where
 295      n_args = dataConSourceArity datacon        -- Existentials already excluded
 296
 297      datacon_vars = map mkGenericLocal [us .. us+n_args-1]
 298      us'          = us + n_args
 299
 300      datacon_rdr  = getRdrName datacon
 301      app_exp      = nlHsVarApps datacon_rdr datacon_vars
 302      from_alt     = (nlConVarPat datacon_rdr datacon_vars, from_alt_rhs)
 303
 304      (_, from_alt_rhs, to_pat, to_body_fn) = mk_prod_stuff us' datacon_vars
 305
 306 mk_sum_stuff us datacons
 307   = (wrap inlDataCon_RDR l_from_alts ++ wrap inrDataCon_RDR r_from_alts,
 308      nlVarPat to_arg,
 309      noLoc (HsCase (nlHsVar to_arg)
 310             (mkMatchGroup [mkSimpleHsAlt (nlConPat inlDataCon_RDR [l_to_pat]) l_to_body,
 311                            mkSimpleHsAlt (nlConPat inrDataCon_RDR [r_to_pat]) r_to_body])))
 312   where
 313     (l_datacons, r_datacons)            = splitInHalf datacons
 314     (l_from_alts, l_to_pat, l_to_body)  = mk_sum_stuff us' l_datacons
 315     (r_from_alts, r_to_pat, r_to_body)  = mk_sum_stuff us' r_datacons
 316
 317     to_arg = mkGenericLocal us
 318     us'    = us+1
 319
 320     wrap :: RdrName -> [FromAlt] -> [FromAlt]
 321         -- Wrap an application of the Inl or Inr constructor round each alternative
 322     wrap dc alts = [(pat, noLoc (HsApp (nlHsVar dc) rhs)) | (pat,rhs) <- alts]
 323
 324
 325 ----------------------------------------------------
 326 --      Dealing with products
 327 ----------------------------------------------------
 328 mk_prod_stuff :: US                     -- Base for unique names
 329               -> [RdrName]              -- arg-ids; args of the original user-defined constructor
 330                                         --      They are bound enclosing from_rhs
 331                                         --      Please bind these in the to_body_fn
 332               -> (US,                   -- Depleted unique-name supply
 333                   LHsExpr RdrName,                      -- from-rhs: puts together the representation from the arg_ids
 334                   InPat RdrName,                        -- to_pat:
 335                   LHsExpr RdrName -> LHsExpr RdrName)   -- to_body_fn: takes apart the representation
 336
 337 -- For example:
 338 -- mk_prod_stuff abc [a,b,c] = ( a :*: (b :*: c),
 339 --                               abc,
 340 --                               \<body-code> -> case abc of { a :*: bc ->
 341 --                                               case bc  of { b :*: c  ->
 342 --                                               <body-code> )
 343
 344 -- We need to use different uniques in the branches
 345 -- because the returned to_body_fns are nested.
 346 -- Hence the returned unqique-name supply
 347
 348 mk_prod_stuff us []             -- Unit case
 349   = (us+1,
 350      nlHsVar genUnitDataCon_RDR,
 351      noLoc (SigPatIn (nlVarPat (mkGenericLocal us))
 352                      (noLoc (HsTyVar (getRdrName genUnitTyConName)))),
 353         -- Give a signature to the pattern so we get
 354         --      data S a = Nil | S a
 355         --      toS = \x -> case x of { Inl (g :: Unit) -> Nil
 356         --                              Inr x -> S x }
 357         -- The (:: Unit) signature ensures that we'll infer the right
 358         -- type for toS. If we leave it out, the type is too polymorphic
 359
 360      \x -> x)
 361
 362 mk_prod_stuff us [arg_var]      -- Singleton case
 363   = (us, nlHsVar arg_var, nlVarPat arg_var, \x -> x)
 364
 365 mk_prod_stuff us arg_vars       -- Two or more
 366   = (us'',
 367      nlHsApps crossDataCon_RDR [l_alt_rhs, r_alt_rhs],
 368      nlVarPat to_arg,
 369 -- gaw 2004 FIX?
 370      \x -> noLoc (HsCase (nlHsVar to_arg)
 371                   (mkMatchGroup [mkSimpleHsAlt pat (l_to_body_fn (r_to_body_fn x))])))
 372   where
 373     to_arg = mkGenericLocal us
 374     (l_arg_vars, r_arg_vars)                  = splitInHalf arg_vars
 375     (us',  l_alt_rhs, l_to_pat, l_to_body_fn) = mk_prod_stuff (us+1)  l_arg_vars
 376     (us'', r_alt_rhs, r_to_pat, r_to_body_fn) = mk_prod_stuff us' r_arg_vars
 377     pat = nlConPat crossDataCon_RDR [l_to_pat, r_to_pat]
 378
 379 splitInHalf :: [a] -> ([a],[a])
 380 splitInHalf list = (left, right)
 381                  where
 382                    half  = length list `div` 2
 383                    left  = take half list
 384                    right = drop half list
 385
 386 mkGenericLocal :: US -> RdrName
 387 mkGenericLocal u = mkVarUnqual (mkFastString ("g" ++ show u))
 388
 389 mkGenericNames tycon
 390   = (from_RDR, to_RDR)
 391   where
 392     tc_name  = tyConName tycon
 393     tc_occ   = nameOccName tc_name
 394     tc_mod   = nameModule tc_name
 395     from_RDR = mkOrig tc_mod (mkGenOcc1 tc_occ)
 396     to_RDR   = mkOrig tc_mod (mkGenOcc2 tc_occ)
 397 \end{code}
 398
 399 %************************************************************************
 400 %*                                                                      *
 401 \subsection{Generating the RHS of a generic default method}
 402 %*                                                                      *
 403 %************************************************************************
 404
 405 Generating the Generic default method.  Uses the bimaps to generate the
 406 actual method. All of this is rather incomplete, but it would be nice
 407 to make even this work.  Example
 408
 409         class Foo a where
 410           op :: Op a
 411
 412         instance Foo T
 413
 414 Then we fill in the RHS for op, RenamedHsExpr, by calling mkGenericRhs:
 415
 416         instance Foo T where
 417            op = <mkGenericRhs op a T>
 418
 419 To do this, we generate a pair of RenamedHsExprs (EP toOp fromOp), where
 420
 421         toOp   :: Op Trep -> Op T
 422         fromOp :: Op T    -> Op Trep
 423
 424 (the bimap) and then fill in the RHS with
 425
 426         instance Foo T where
 427            op = toOp op
 428
 429 Remember, we're generating a RenamedHsExpr, so the result of all this
 430 will be fed to the type checker.  So the 'op' on the RHS will be
 431 at the representation type for T, Trep.
 432
 433
 434 Note [Polymorphic methods]
 435 ~~~~~~~~~~~~~~~~~~~~~~~~~~
 436 Suppose the class op is polymorphic:
 437
 438         class Baz a where
 439           op :: forall b. Ord b => a -> b -> b
 440
 441 Then we can still generate a bimap with
 442
 443         toOP :: forall b. (Trep -> b -> b) -> (T -> b -> b)
 444
 445 and fill in the instance decl thus
 446
 447         instance Foo T where
 448            op = toOp op
 449
 450 By the time the type checker has done its stuff we'll get
 451
 452         instance Foo T where
 453            op = \b. \dict::Ord b. toOp b (op Trep b dict)
 454
 455 \begin{code}
 456 mkGenericRhs :: Id -> TyVar -> TyCon -> LHsExpr RdrName
 457 mkGenericRhs sel_id tyvar tycon
 458   = ASSERT( isSingleton ctxt )  -- Checks shape of selector-id context
 459 --    pprTrace "mkGenericRhs" (vcat [ppr sel_id, ppr (idType sel_id), ppr tyvar, ppr tycon, ppr local_tvs, ppr final_ty]) $
 460     mkHsApp (toEP bimap) (nlHsVar (getRdrName sel_id))
 461   where
 462         -- Initialising the "Environment" with the from/to functions
 463         -- on the datatype (actually tycon) in question
 464         (from_RDR, to_RDR) = mkGenericNames tycon
 465
 466         -- Instantiate the selector type, and strip off its class context
 467         (ctxt, op_ty) = tcSplitPhiTy (applyTy (idType sel_id) (mkTyVarTy tyvar))
 468
 469         -- Do it again!  This deals with the case where the method type
 470         -- is polymorphic -- see Note [Polymorphic methods] above
 471         (local_tvs,_,final_ty) = tcSplitSigmaTy op_ty
 472
 473         -- Now we probably have a tycon in front
 474         -- of us, quite probably a FunTyCon.
 475         ep    = EP (nlHsVar from_RDR) (nlHsVar to_RDR)
 476         bimap = generate_bimap (tyvar, ep, local_tvs) final_ty
 477
 478 type EPEnv = (TyVar,                    -- The class type variable
 479               EP (LHsExpr RdrName),     -- The EP it maps to
 480               [TyVar]                   -- Other in-scope tyvars; they have an identity EP
 481              )
 482
 483 -------------------
 484 generate_bimap :: EPEnv
 485                -> Type
 486                -> EP (LHsExpr RdrName)
 487 -- Top level case - splitting the TyCon.
 488 generate_bimap env@(tv,ep,local_tvs) ty
 489   = case getTyVar_maybe ty of
 490         Just tv1 |  tv == tv1 -> ep                             -- The class tyvar
 491                  |  otherwise -> ASSERT( tv1 `elem` local_tvs)  -- One of the polymorphic tyvars of the method
 492                                  idEP
 493         Nothing  -> bimapApp env (tcSplitTyConApp_maybe ty)
 494
 495 -------------------
 496 bimapApp :: EPEnv -> Maybe (TyCon, [Type]) -> EP (LHsExpr RdrName)
 497 bimapApp env Nothing                = panic "TcClassDecl: Type Application!"
 498 bimapApp env (Just (tycon, ty_args))
 499   | tycon == funTyCon       = bimapArrow arg_eps
 500   | tycon == listTyCon      = bimapList arg_eps
 501   | isBoxedTupleTyCon tycon = bimapTuple arg_eps
 502   | otherwise               =   -- Otherwise validGenericMethodType will
 503                                 -- have checked that the type is a constant type
 504                               ASSERT( all (`elem` local_tvs) (varSetElems (tyVarsOfTypes ty_args)) )
 505                               idEP
 506     where
 507       arg_eps = map (generate_bimap env) ty_args
 508       (_,_,local_tvs) = env
 509
 510 -------------------
 511 -- bimapArrow :: [EP a a', EP b b'] -> EP (a->b) (a'->b')
 512 bimapArrow [ep1, ep2]
 513   = EP { fromEP = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] from_body,
 514          toEP   = mkHsLam [nlVarPat a_RDR, nlVarPat b_RDR] to_body }
 515   where
 516     from_body = fromEP ep2 `mkHsApp` (mkHsPar $ nlHsVar a_RDR `mkHsApp` (mkHsPar $ toEP   ep1 `mkHsApp` nlHsVar b_RDR))
 517     to_body   = toEP   ep2 `mkHsApp` (mkHsPar $ nlHsVar a_RDR `mkHsApp` (mkHsPar $ fromEP ep1 `mkHsApp` nlHsVar b_RDR))
 518
 519 -------------------
 520 -- bimapTuple :: [EP a1 b1, ... EP an bn] -> EP (a1,...an) (b1,..bn)
 521 bimapTuple eps
 522   = EP { fromEP = mkHsLam [noLoc tuple_pat] (noLoc from_body),
 523          toEP   = mkHsLam [noLoc tuple_pat] (noLoc to_body) }
 524   where
 525     names       = takeList eps gs_RDR
 526     tuple_pat   = TuplePat (map nlVarPat names) Boxed placeHolderType
 527     eps_w_names = eps `zip` names
 528     to_body     = ExplicitTuple [toEP   ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed
 529     from_body   = ExplicitTuple [fromEP ep `mkHsApp` nlHsVar g | (ep,g) <- eps_w_names] Boxed
 530
 531 -------------------
 532 -- bimapList :: EP a b -> EP [a] [b]
 533 bimapList [ep]
 534   = EP { fromEP = nlHsApp (nlHsVar map_RDR) (fromEP ep),
 535          toEP   = nlHsApp (nlHsVar map_RDR) (toEP ep) }
 536
 537 -------------------
 538 a_RDR   = mkVarUnqual FSLIT("a")
 539 b_RDR   = mkVarUnqual FSLIT("b")
 540 gs_RDR  = [ mkVarUnqual (mkFastString ("g"++show i)) | i <- [(1::Int) .. ] ]
 541
 542 idEP :: EP (LHsExpr RdrName)
 543 idEP = EP idexpr idexpr
 544      where
 545        idexpr = mkHsLam [nlVarPat a_RDR] (nlHsVar a_RDR)
 546 \end{code}