ghc/compiler/deforest/Core2Def.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
   3 %
   4 \section[Core2Def]{Translate the CoreProgram into a DefProgram}
   5
   6 >#include "HsVersions.h"
   7 >
   8 > module Core2Def (
   9 >       core2def, c2d,
  10 >
  11 >       DefProgram(..),
  12 >       GenCoreBinding, Id, DefBindee ) where
  13 >
  14 > import DefSyn
  15
  16 > import CoreSyn
  17 > import BinderInfo     -- ( BinderInfo(..), isFun, isDupDanger )
  18 > import CmdLineOpts    ( switchIsOn, SwitchResult, SimplifierSwitch )
  19 > import OccurAnal      ( occurAnalyseBinds )
  20 > import SimplEnv       ( SwitchChecker(..) )
  21 > import Util
  22 > import Pretty
  23 > import Outputable
  24
  25 This module translates the CoreProgram into a DefCoreProgram,
  26 which includes non-atomic right-hand sides.  The decisions about which
  27 expressions to inline are left to the substitution analyser, which we
  28 run beforehand.
  29
  30 Current thinking:
  31
  32 1.  Inline all non-recursive non-top-level lets that occur only
  33     once (including inside lambdas, hoping full laziness
  34     will sort things out later).
  35
  36 2.  We don't inline top-level lets that occur only once, because these
  37     might not be pulled out again by the let-floater, due to non-
  38     garbage collection of CAFs.
  39
  40 2.1.  Also, what about these lit things that occur at the top level,
  41     and are usually marked as macros?
  42
  43 3.  No recusrive functions are unfolded.
  44
  45 ToDo:
  46 4.  Lambdas and case alternatives that bind a variable that occurs
  47     multiple times are transformed:
  48     \x -> ..x..x..  ===>  \x -> let x' = x in ..x'..x'..
  49
  50
  51 > core2def :: (GlobalSwitch -> SwitchResult) -> [CoreBinding] -> DefProgram
  52 > core2def sw prog =
  53 >       map coreBinding2def tagged_program
  54 >   where
  55 >       tagged_program = occurAnalyseBinds prog switch_is_on (const False)
  56 >       switch_is_on   = switchIsOn sw
  57
  58
  59 > coreBinding2def :: SimplifiableCoreBinding -> DefBinding
  60 > coreBinding2def (NonRec (v,_) e) = NonRec v (c2d nullIdEnv e)
  61 > coreBinding2def (Rec bs) = Rec (map recBind2def bs)
  62 >       where recBind2def ((v,_),e) = (v, c2d nullIdEnv e)
  63
  64
  65 > coreAtom2def :: IdEnv DefExpr -> CoreArg -> DefAtom
  66 > coreAtom2def p (VarArg v) = VarArg (DefArgExpr (lookup p v))
  67 > coreAtom2def p (LitArg l) = VarArg (DefArgExpr (Lit l))
  68
  69 > isTrivial (Con c [] []) = True
  70 > isTrivial (Var v)       = True
  71 > isTrivial (Lit l)       = True
  72 > isTrivial _               = False
  73
  74 > c2d :: IdEnv DefExpr -> SimplifiableCoreExpr -> DefExpr
  75 > c2d p e = case e of
  76 >
  77 >       Var v         -> lookup p v
  78 >
  79 >       Lit l         -> Lit l
  80 >
  81 >       Con c ts es   -> Con c ts (map (coreAtom2def p) es)
  82 >
  83 >       Prim op ts es -> Prim op ts (map (coreAtom2def p) es)
  84 >
  85 >       Lam vs e      -> Lam (map fst vs) (c2d p e)
  86 >
  87 >       CoTyLam alpha e -> CoTyLam alpha (c2d p e)
  88 >
  89 >       App e v       -> App (c2d p e) (coreAtom2def p v)
  90 >
  91 >       CoTyApp e t     -> CoTyApp (c2d p e) t
  92 >
  93 >       Case e ps     -> Case (c2d p e) (coreCaseAlts2def p ps)
  94 >
  95 >       Let (NonRec (v,ManyOcc _) e) e'
  96 >               | isTrivial e -> c2d (addOneToIdEnv p v (c2d p e)) e'
  97 >               | otherwise ->
  98 >               pprTrace "Not inlining ManyOcc " (ppr PprDebug v) $
  99 >               Let (NonRec v (c2d p e)) (c2d p e')
 100 >
 101 >       Let (NonRec (v,DeadCode) e) e' ->
 102 >               panic "Core2Def(c2d): oops, unexpected DeadCode"
 103 >
 104 >       Let (NonRec (v,OneOcc fun_or_arg dup_danger _ _ _) e) e'
 105 >          | isTrivial e -> inline_it
 106 >          | isDupDanger dup_danger ->
 107 >               pprTrace "Not inlining DupDanger " (ppr PprDebug v) $
 108 >               Let (NonRec v (c2d p e)) (c2d p e')
 109 >          | isFun fun_or_arg ->
 110 >               panic "Core2Def(c2d): oops, unexpected Macro"
 111 >          | otherwise -> inline_it
 112 >        where inline_it = c2d (addOneToIdEnv p v (c2d p e)) e'
 113 >
 114 >       Let (Rec bs) e -> Let (Rec (map recBind2def bs)) (c2d p e)
 115 >               where recBind2def ((v,_),e) = (v, c2d p e)
 116 >
 117 >       SCC l e       -> SCC l (c2d p e)
 118
 119
 120 > coreCaseAlts2def
 121 >       :: IdEnv DefExpr
 122 >       -> SimplifiableCoreCaseAlts
 123 >       -> DefCaseAlternatives
 124 >
 125 > coreCaseAlts2def p alts = case alts of
 126 >       AlgAlts as def  -> AlgAlts (map algAlt2def as) (defAlt2def def)
 127 >       PrimAlts as def -> PrimAlts (map primAlt2def as) (defAlt2def def)
 128 >
 129 >   where
 130 >
 131 >       algAlt2def  (c, vs, e) = (c, (map fst vs), c2d p e)
 132 >       primAlt2def (l, e)     = (l, c2d p e)
 133
 134 >       defAlt2def NoDefault = NoDefault
 135 >       defAlt2def (BindDefault (v,_) e) = BindDefault v (c2d p e)
 136
 137
 138 > lookup :: IdEnv DefExpr -> Id -> DefExpr
 139 > lookup p v = case lookupIdEnv p v of
 140 >                       Nothing -> Var (DefArgVar v)
 141 >                       Just e  -> e