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