ghc/compiler/specialise/SpecConstr.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[SpecConstr]{Specialise over constructors}
   5
   6 \begin{code}
   7 module SpecConstr(
   8         specConstrProgram
   9     ) where
  10
  11 #include "HsVersions.h"
  12
  13 import CoreSyn
  14 import CoreLint         ( showPass, endPass )
  15 import CoreUtils        ( exprType, eqExpr, mkPiTypes )
  16 import CoreFVs          ( exprsFreeVars )
  17 import CoreTidy         ( pprTidyIdRules )
  18 import WwLib            ( mkWorkerArgs )
  19 import DataCon          ( dataConRepArity )
  20 import Type             ( tyConAppArgs )
  21 import Id               ( Id, idName, idType,
  22                           isDataConWorkId_maybe,
  23                           mkUserLocal, mkSysLocal )
  24 import Var              ( Var )
  25 import VarEnv
  26 import VarSet
  27 import Name             ( nameOccName, nameSrcLoc )
  28 import Rules            ( addIdSpecialisations )
  29 import OccName          ( mkSpecOcc )
  30 import ErrUtils         ( dumpIfSet_dyn )
  31 import CmdLineOpts      ( DynFlags, DynFlag(..) )
  32 import BasicTypes       ( Activation(..) )
  33 import Outputable
  34
  35 import Maybes           ( orElse )
  36 import Util             ( mapAccumL, lengthAtLeast, notNull )
  37 import List             ( nubBy, partition )
  38 import UniqSupply
  39 import Outputable
  40 import FastString
  41 \end{code}
  42
  43 -----------------------------------------------------
  44                         Game plan
  45 -----------------------------------------------------
  46
  47 Consider
  48         drop n []     = []
  49         drop 0 xs     = []
  50         drop n (x:xs) = drop (n-1) xs
  51
  52 After the first time round, we could pass n unboxed.  This happens in
  53 numerical code too.  Here's what it looks like in Core:
  54
  55         drop n xs = case xs of
  56                       []     -> []
  57                       (y:ys) -> case n of
  58                                   I# n# -> case n# of
  59                                              0 -> []
  60                                              _ -> drop (I# (n# -# 1#)) xs
  61
  62 Notice that the recursive call has an explicit constructor as argument.
  63 Noticing this, we can make a specialised version of drop
  64
  65         RULE: drop (I# n#) xs ==> drop' n# xs
  66
  67         drop' n# xs = let n = I# n# in ...orig RHS...
  68
  69 Now the simplifier will apply the specialisation in the rhs of drop', giving
  70
  71         drop' n# xs = case xs of
  72                       []     -> []
  73                       (y:ys) -> case n# of
  74                                   0 -> []
  75                                   _ -> drop (n# -# 1#) xs
  76
  77 Much better!
  78
  79 We'd also like to catch cases where a parameter is carried along unchanged,
  80 but evaluated each time round the loop:
  81
  82         f i n = if i>0 || i>n then i else f (i*2) n
  83
  84 Here f isn't strict in n, but we'd like to avoid evaluating it each iteration.
  85 In Core, by the time we've w/wd (f is strict in i) we get
  86
  87         f i# n = case i# ># 0 of
  88                    False -> I# i#
  89                    True  -> case n of n' { I# n# ->
  90                             case i# ># n# of
  91                                 False -> I# i#
  92                                 True  -> f (i# *# 2#) n'
  93
  94 At the call to f, we see that the argument, n is know to be (I# n#),
  95 and n is evaluated elsewhere in the body of f, so we can play the same
  96 trick as above.  However we don't want to do that if the boxed version
  97 of n is needed (else we'd avoid the eval but pay more for re-boxing n).
  98 So in this case we want that the *only* uses of n are in case statements.
  99
 100
 101 So we look for
 102
 103 * A self-recursive function.  Ignore mutual recursion for now,
 104   because it's less common, and the code is simpler for self-recursion.
 105
 106 * EITHER
 107
 108    a) At a recursive call, one or more parameters is an explicit
 109       constructor application
 110         AND
 111       That same parameter is scrutinised by a case somewhere in
 112       the RHS of the function
 113
 114   OR
 115
 116     b) At a recursive call, one or more parameters has an unfolding
 117        that is an explicit constructor application
 118         AND
 119       That same parameter is scrutinised by a case somewhere in
 120       the RHS of the function
 121         AND
 122       Those are the only uses of the parameter
 123
 124
 125 There's a bit of a complication with type arguments.  If the call
 126 site looks like
 127
 128         f p = ...f ((:) [a] x xs)...
 129
 130 then our specialised function look like
 131
 132         f_spec x xs = let p = (:) [a] x xs in ....as before....
 133
 134 This only makes sense if either
 135   a) the type variable 'a' is in scope at the top of f, or
 136   b) the type variable 'a' is an argument to f (and hence fs)
 137
 138 Actually, (a) may hold for value arguments too, in which case
 139 we may not want to pass them.  Supose 'x' is in scope at f's
 140 defn, but xs is not.  Then we'd like
 141
 142         f_spec xs = let p = (:) [a] x xs in ....as before....
 143
 144 Similarly (b) may hold too.  If x is already an argument at the
 145 call, no need to pass it again.
 146
 147 Finally, if 'a' is not in scope at the call site, we could abstract
 148 it as we do the term variables:
 149
 150         f_spec a x xs = let p = (:) [a] x xs in ...as before...
 151
 152 So the grand plan is:
 153
 154         * abstract the call site to a constructor-only pattern
 155           e.g.  C x (D (f p) (g q))  ==>  C s1 (D s2 s3)
 156
 157         * Find the free variables of the abstracted pattern
 158
 159         * Pass these variables, less any that are in scope at
 160           the fn defn.
 161
 162
 163 NOTICE that we only abstract over variables that are not in scope,
 164 so we're in no danger of shadowing variables used in "higher up"
 165 in f_spec's RHS.
 166
 167
 168 %************************************************************************
 169 %*                                                                      *
 170 \subsection{Top level wrapper stuff}
 171 %*                                                                      *
 172 %************************************************************************
 173
 174 \begin{code}
 175 specConstrProgram :: DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]
 176 specConstrProgram dflags us binds
 177   = do
 178         showPass dflags "SpecConstr"
 179
 180         let (binds', _) = initUs us (go emptyScEnv binds)
 181
 182         endPass dflags "SpecConstr" Opt_D_dump_spec binds'
 183
 184         dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
 185                   (vcat (map pprTidyIdRules (concat (map bindersOf binds'))))
 186
 187         return binds'
 188   where
 189     go env []           = returnUs []
 190     go env (bind:binds) = scBind env bind       `thenUs` \ (env', _, bind') ->
 191                           go env' binds         `thenUs` \ binds' ->
 192                           returnUs (bind' : binds')
 193 \end{code}
 194
 195
 196 %************************************************************************
 197 %*                                                                      *
 198 \subsection{Environment: goes downwards}
 199 %*                                                                      *
 200 %************************************************************************
 201
 202 \begin{code}
 203 data ScEnv = SCE { scope :: VarEnv HowBound,
 204                         -- Binds all non-top-level variables in scope
 205
 206                    cons  :: ConstrEnv
 207              }
 208
 209 type ConstrEnv = IdEnv (AltCon, [CoreArg])
 210         -- Variables known to be bound to a constructor
 211         -- in a particular case alternative
 212
 213 emptyScEnv = SCE { scope = emptyVarEnv, cons = emptyVarEnv }
 214
 215 data HowBound = RecFun          -- These are the recursive functions for which
 216                                 -- we seek interesting call patterns
 217
 218               | RecArg          -- These are those functions' arguments; we are
 219                                 -- interested to see if those arguments are scrutinised
 220
 221               | Other           -- We track all others so we know what's in scope
 222                                 -- This is used in spec_one to check what needs to be
 223                                 -- passed as a parameter and what is in scope at the
 224                                 -- function definition site
 225
 226 instance Outputable HowBound where
 227   ppr RecFun = text "RecFun"
 228   ppr RecArg = text "RecArg"
 229   ppr Other = text "Other"
 230
 231 lookupScopeEnv env v = lookupVarEnv (scope env) v
 232
 233 extendBndrs env bndrs = env { scope = extendVarEnvList (scope env) [(b,Other) | b <- bndrs] }
 234 extendBndr  env bndr  = env { scope = extendVarEnv (scope env) bndr Other }
 235
 236     -- When we encounter
 237     --  case scrut of b
 238     --      C x y -> ...
 239     -- we want to bind b, and perhaps scrut too, to (C x y)
 240 extendCaseBndrs :: ScEnv -> Id -> CoreExpr -> AltCon -> [Var] -> ScEnv
 241 extendCaseBndrs env case_bndr scrut DEFAULT alt_bndrs
 242   = extendBndrs env (case_bndr : alt_bndrs)
 243
 244 extendCaseBndrs env case_bndr scrut con alt_bndrs
 245   = case scrut of
 246         Var v ->   -- Bind the scrutinee in the ConstrEnv if it's a variable
 247                    -- Also forget if the scrutinee is a RecArg, because we're
 248                    -- now in the branch of a case, and we don't want to
 249                    -- record a non-scrutinee use of v if we have
 250                    --   case v of { (a,b) -> ...(f v)... }
 251                  SCE { scope = extendVarEnv (scope env1) v Other,
 252                        cons  = extendVarEnv (cons env1)  v (con,args) }
 253         other -> env1
 254
 255   where
 256     env1 = SCE { scope = extendVarEnvList (scope env) [(b,Other) | b <- case_bndr : alt_bndrs],
 257                  cons  = extendVarEnv     (cons  env) case_bndr (con,args) }
 258
 259     args = map Type (tyConAppArgs (idType case_bndr)) ++
 260            map varToCoreExpr alt_bndrs
 261
 262     -- When we encounter a recursive function binding
 263     --  f = \x y -> ...
 264     -- we want to extend the scope env with bindings
 265     -- that record that f is a RecFn and x,y are RecArgs
 266 extendRecBndr env fn bndrs
 267   =  env { scope = scope env `extendVarEnvList`
 268                    ((fn,RecFun): [(bndr,RecArg) | bndr <- bndrs]) }
 269 \end{code}
 270
 271
 272 %************************************************************************
 273 %*                                                                      *
 274 \subsection{Usage information: flows upwards}
 275 %*                                                                      *
 276 %************************************************************************
 277
 278 \begin{code}
 279 data ScUsage
 280    = SCU {
 281         calls :: !(IdEnv ([Call])),     -- Calls
 282                                         -- The functions are a subset of the
 283                                         --      RecFuns in the ScEnv
 284
 285         occs :: !(IdEnv ArgOcc)         -- Information on argument occurrences
 286      }                                  -- The variables are a subset of the
 287                                         --      RecArg in the ScEnv
 288
 289 type Call = (ConstrEnv, [CoreArg])
 290         -- The arguments of the call, together with the
 291         -- env giving the constructor bindings at the call site
 292
 293 nullUsage = SCU { calls = emptyVarEnv, occs = emptyVarEnv }
 294
 295 combineUsage u1 u2 = SCU { calls = plusVarEnv_C (++) (calls u1) (calls u2),
 296                            occs  = plusVarEnv_C combineOcc (occs u1) (occs u2) }
 297
 298 combineUsages [] = nullUsage
 299 combineUsages us = foldr1 combineUsage us
 300
 301 data ArgOcc = CaseScrut
 302             | OtherOcc
 303             | Both
 304
 305 instance Outputable ArgOcc where
 306   ppr CaseScrut = ptext SLIT("case-scrut")
 307   ppr OtherOcc  = ptext SLIT("other-occ")
 308   ppr Both      = ptext SLIT("case-scrut and other")
 309
 310 combineOcc CaseScrut CaseScrut = CaseScrut
 311 combineOcc OtherOcc  OtherOcc  = OtherOcc
 312 combineOcc _         _         = Both
 313 \end{code}
 314
 315
 316 %************************************************************************
 317 %*                                                                      *
 318 \subsection{The main recursive function}
 319 %*                                                                      *
 320 %************************************************************************
 321
 322 The main recursive function gathers up usage information, and
 323 creates specialised versions of functions.
 324
 325 \begin{code}
 326 scExpr :: ScEnv -> CoreExpr -> UniqSM (ScUsage, CoreExpr)
 327         -- The unique supply is needed when we invent
 328         -- a new name for the specialised function and its args
 329
 330 scExpr env e@(Type t) = returnUs (nullUsage, e)
 331 scExpr env e@(Lit l)  = returnUs (nullUsage, e)
 332 scExpr env e@(Var v)  = returnUs (varUsage env v OtherOcc, e)
 333 scExpr env (Note n e) = scExpr env e    `thenUs` \ (usg,e') ->
 334                         returnUs (usg, Note n e')
 335 scExpr env (Lam b e)  = scExpr (extendBndr env b) e     `thenUs` \ (usg,e') ->
 336                         returnUs (usg, Lam b e')
 337
 338 -- gaw 2004
 339 scExpr env (Case scrut b ty alts)
 340   = sc_scrut scrut              `thenUs` \ (scrut_usg, scrut') ->
 341     mapAndUnzipUs sc_alt alts   `thenUs` \ (alts_usgs, alts') ->
 342 -- gaw 2004
 343     returnUs (combineUsages alts_usgs `combineUsage` scrut_usg,
 344               Case scrut' b ty alts')
 345   where
 346     sc_scrut e@(Var v) = returnUs (varUsage env v CaseScrut, e)
 347     sc_scrut e         = scExpr env e
 348
 349     sc_alt (con,bs,rhs) = scExpr env1 rhs       `thenUs` \ (usg,rhs') ->
 350                           returnUs (usg, (con,bs,rhs'))
 351                         where
 352                           env1 = extendCaseBndrs env b scrut con bs
 353
 354 scExpr env (Let bind body)
 355   = scBind env bind     `thenUs` \ (env', bind_usg, bind') ->
 356     scExpr env' body    `thenUs` \ (body_usg, body') ->
 357     returnUs (bind_usg `combineUsage` body_usg, Let bind' body')
 358
 359 scExpr env e@(App _ _)
 360   = let
 361         (fn, args) = collectArgs e
 362     in
 363     mapAndUnzipUs (scExpr env) args     `thenUs` \ (usgs, args') ->
 364     let
 365         arg_usg = combineUsages usgs
 366         fn_usg  | Var f <- fn,
 367                   Just RecFun <- lookupScopeEnv env f
 368                 = SCU { calls = unitVarEnv f [(cons env, args)],
 369                         occs  = emptyVarEnv }
 370                 | otherwise
 371                 = nullUsage
 372     in
 373     returnUs (arg_usg `combineUsage` fn_usg, mkApps fn args')
 374         -- Don't bother to look inside fn;
 375         -- it's almost always a variable
 376
 377 ----------------------
 378 scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
 379 scBind env (Rec [(fn,rhs)])
 380   | notNull val_bndrs
 381   = scExpr env_fn_body body             `thenUs` \ (usg, body') ->
 382     let
 383         SCU { calls = calls, occs = occs } = usg
 384     in
 385     specialise env fn bndrs body usg    `thenUs` \ (rules, spec_prs) ->
 386     returnUs (extendBndr env fn,        -- For the body of the letrec, just
 387                                         -- extend the env with Other to record
 388                                         -- that it's in scope; no funny RecFun business
 389               SCU { calls = calls `delVarEnv` fn, occs = occs `delVarEnvList` val_bndrs},
 390               Rec ((fn `addIdSpecialisations` rules, mkLams bndrs body') : spec_prs))
 391   where
 392     (bndrs,body) = collectBinders rhs
 393     val_bndrs    = filter isId bndrs
 394     env_fn_body  = extendRecBndr env fn bndrs
 395
 396 scBind env (Rec prs)
 397   = mapAndUnzipUs do_one prs    `thenUs` \ (usgs, prs') ->
 398     returnUs (extendBndrs env (map fst prs), combineUsages usgs, Rec prs')
 399   where
 400     do_one (bndr,rhs) = scExpr env rhs  `thenUs` \ (usg, rhs') ->
 401                         returnUs (usg, (bndr,rhs'))
 402
 403 scBind env (NonRec bndr rhs)
 404   = scExpr env rhs      `thenUs` \ (usg, rhs') ->
 405     returnUs (extendBndr env bndr, usg, NonRec bndr rhs')
 406
 407 ----------------------
 408 varUsage env v use
 409   | Just RecArg <- lookupScopeEnv env v = SCU { calls = emptyVarEnv,
 410                                                 occs = unitVarEnv v use }
 411   | otherwise                           = nullUsage
 412 \end{code}
 413
 414
 415 %************************************************************************
 416 %*                                                                      *
 417 \subsection{The specialiser}
 418 %*                                                                      *
 419 %************************************************************************
 420
 421 \begin{code}
 422 specialise :: ScEnv
 423            -> Id                        -- Functionn
 424            -> [CoreBndr] -> CoreExpr    -- Its RHS
 425            -> ScUsage                   -- Info on usage
 426            -> UniqSM ([CoreRule],       -- Rules
 427                       [(Id,CoreExpr)])  -- Bindings
 428
 429 specialise env fn bndrs body (SCU {calls=calls, occs=occs})
 430   = getUs               `thenUs` \ us ->
 431     let
 432         all_calls = lookupVarEnv calls fn `orElse` []
 433
 434         good_calls :: [[CoreArg]]
 435         good_calls = [ pats
 436                      | (con_env, call_args) <- all_calls,
 437                        call_args `lengthAtLeast` n_bndrs,           -- App is saturated
 438                        let call = (bndrs `zip` call_args),
 439                        any (good_arg con_env occs) call,    -- At least one arg is a constr app
 440                        let (_, pats) = argsToPats con_env us call_args
 441                      ]
 442     in
 443     mapAndUnzipUs (spec_one env fn (mkLams bndrs body))
 444                   (nubBy same_call good_calls `zip` [1..])
 445   where
 446     n_bndrs  = length bndrs
 447     same_call as1 as2 = and (zipWith eqExpr as1 as2)
 448
 449 ---------------------
 450 good_arg :: ConstrEnv -> IdEnv ArgOcc -> (CoreBndr, CoreArg) -> Bool
 451 good_arg con_env arg_occs (bndr, arg)
 452   = case is_con_app_maybe con_env arg of
 453         Just _ ->  bndr_usg_ok arg_occs bndr arg
 454         other   -> False
 455
 456 bndr_usg_ok :: IdEnv ArgOcc -> Var -> CoreArg -> Bool
 457 bndr_usg_ok arg_occs bndr arg
 458   = case lookupVarEnv arg_occs bndr of
 459         Just CaseScrut -> True                  -- Used only by case scrutiny
 460         Just Both      -> case arg of           -- Used by case and elsewhere
 461                             App _ _ -> True     -- so the arg should be an explicit con app
 462                             other   -> False
 463         other -> False                          -- Not used, or used wonkily
 464
 465
 466 ---------------------
 467 spec_one :: ScEnv
 468          -> Id                                  -- Function
 469          -> CoreExpr                            -- Rhs of the original function
 470          -> ([CoreArg], Int)
 471          -> UniqSM (CoreRule, (Id,CoreExpr))    -- Rule and binding
 472
 473 -- spec_one creates a specialised copy of the function, together
 474 -- with a rule for using it.  I'm very proud of how short this
 475 -- function is, considering what it does :-).
 476
 477 {-
 478   Example
 479
 480      In-scope: a, x::a
 481      f = /\b \y::[(a,b)] -> ....f (b,c) ((:) (a,(b,c)) (x,v) (h w))...
 482           [c::*, v::(b,c) are presumably bound by the (...) part]
 483   ==>
 484      f_spec = /\ b c \ v::(b,c) hw::[(a,(b,c))] ->
 485                   (...entire RHS of f...) (b,c) ((:) (a,(b,c)) (x,v) hw)
 486
 487      RULE:  forall b::* c::*,           -- Note, *not* forall a, x
 488                    v::(b,c),
 489                    hw::[(a,(b,c))] .
 490
 491             f (b,c) ((:) (a,(b,c)) (x,v) hw) = f_spec b c v hw
 492 -}
 493
 494 spec_one env fn rhs (pats, rule_number)
 495   = getUniqueUs                 `thenUs` \ spec_uniq ->
 496     let
 497         fn_name      = idName fn
 498         fn_loc       = nameSrcLoc fn_name
 499         spec_occ     = mkSpecOcc (nameOccName fn_name)
 500         pat_fvs      = varSetElems (exprsFreeVars pats)
 501         vars_to_bind = filter not_avail pat_fvs
 502         not_avail v  = not (v `elemVarEnv` scope env)
 503                 -- Put the type variables first; the type of a term
 504                 -- variable may mention a type variable
 505         (tvs, ids)   = partition isTyVar vars_to_bind
 506         bndrs        = tvs ++ ids
 507         spec_body    = mkApps rhs pats
 508         body_ty      = exprType spec_body
 509
 510         (spec_lam_args, spec_call_args) = mkWorkerArgs bndrs body_ty
 511                 -- Usual w/w hack to avoid generating
 512                 -- a spec_rhs of unlifted type and no args
 513
 514         rule_name = mkFastString ("SC:" ++ showSDoc (ppr fn <> int rule_number))
 515         spec_rhs  = mkLams spec_lam_args spec_body
 516         spec_id   = mkUserLocal spec_occ spec_uniq (mkPiTypes spec_lam_args body_ty) fn_loc
 517         rule      = Rule rule_name specConstrActivation
 518                          bndrs pats (mkVarApps (Var spec_id) spec_call_args)
 519     in
 520     returnUs (rule, (spec_id, spec_rhs))
 521
 522 -- In which phase should the specialise-constructor rules be active?
 523 -- Originally I made them always-active, but Manuel found that
 524 -- this defeated some clever user-written rules.  So Plan B
 525 -- is to make them active only in Phase 0; after all, currently,
 526 -- the specConstr transformation is only run after the simplifier
 527 -- has reached Phase 0.  In general one would want it to be
 528 -- flag-controllable, but for now I'm leaving it baked in
 529 --                                      [SLPJ Oct 01]
 530 specConstrActivation :: Activation
 531 specConstrActivation = ActiveAfter 0    -- Baked in; see comments above
 532 \end{code}
 533
 534 %************************************************************************
 535 %*                                                                      *
 536 \subsection{Argument analysis}
 537 %*                                                                      *
 538 %************************************************************************
 539
 540 This code deals with analysing call-site arguments to see whether
 541 they are constructor applications.
 542
 543 \begin{code}
 544     -- argToPat takes an actual argument, and returns an abstracted
 545     -- version, consisting of just the "constructor skeleton" of the
 546     -- argument, with non-constructor sub-expression replaced by new
 547     -- placeholder variables.  For example:
 548     --    C a (D (f x) (g y))  ==>  C p1 (D p2 p3)
 549
 550 argToPat   :: ConstrEnv -> UniqSupply -> CoreArg   -> (UniqSupply, CoreExpr)
 551 argToPat env us (Type ty)
 552   = (us, Type ty)
 553
 554 argToPat env us arg
 555   | Just (dc,args) <- is_con_app_maybe env arg
 556   = let
 557         (us',args') = argsToPats env us args
 558     in
 559     (us', mk_con_app dc args')
 560
 561 argToPat env us (Var v) -- Don't uniqify existing vars,
 562   = (us, Var v)         -- so that we can spot when we pass them twice
 563
 564 argToPat env us arg
 565   = (us1, Var (mkSysLocal FSLIT("sc") (uniqFromSupply us2) (exprType arg)))
 566   where
 567     (us1,us2) = splitUniqSupply us
 568
 569 argsToPats :: ConstrEnv -> UniqSupply -> [CoreArg] -> (UniqSupply, [CoreExpr])
 570 argsToPats env us args = mapAccumL (argToPat env) us args
 571 \end{code}
 572
 573
 574 \begin{code}
 575 is_con_app_maybe :: ConstrEnv -> CoreExpr -> Maybe (AltCon, [CoreExpr])
 576 is_con_app_maybe env (Var v)
 577   = lookupVarEnv env v
 578         -- You might think we could look in the idUnfolding here
 579         -- but that doesn't take account of which branch of a
 580         -- case we are in, which is the whole point
 581
 582 is_con_app_maybe env (Lit lit)
 583   = Just (LitAlt lit, [])
 584
 585 is_con_app_maybe env expr
 586   = case collectArgs expr of
 587         (Var fun, args) | Just con <- isDataConWorkId_maybe fun,
 588                           args `lengthAtLeast` dataConRepArity con
 589                 -- Might be > because the arity excludes type args
 590                         -> Just (DataAlt con,args)
 591
 592         other -> Nothing
 593
 594 mk_con_app :: AltCon -> [CoreArg] -> CoreExpr
 595 mk_con_app (LitAlt lit)  []   = Lit lit
 596 mk_con_app (DataAlt con) args = mkConApp con args
 597 \end{code}