2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1995
4 \section[Core2Def]{Translate the CoreProgram into a DefProgram}
6 >#include "HsVersions.h"
12 > GenCoreBinding, Id, DefBindee ) where
17 > import BinderInfo -- ( BinderInfo(..), isFun, isDupDanger )
18 > import CmdLineOpts ( switchIsOn, SwitchResult, SimplifierSwitch )
19 > import OccurAnal ( occurAnalyseBinds )
20 > import SimplEnv ( SwitchChecker(..) )
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
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).
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.
40 2.1. Also, what about these lit things that occur at the top level,
41 and are usually marked as macros?
43 3. No recusrive functions are unfolded.
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'..
51 > core2def :: (GlobalSwitch -> SwitchResult) -> [CoreBinding] -> DefProgram
53 > map coreBinding2def tagged_program
55 > tagged_program = occurAnalyseBinds prog switch_is_on (const False)
56 > switch_is_on = switchIsOn sw
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)
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))
69 > isTrivial (Con c [] []) = True
70 > isTrivial (Var v) = True
71 > isTrivial (Lit l) = True
74 > c2d :: IdEnv DefExpr -> SimplifiableCoreExpr -> DefExpr
81 > Con c ts es -> Con c ts (map (coreAtom2def p) es)
83 > Prim op ts es -> Prim op ts (map (coreAtom2def p) es)
85 > Lam vs e -> Lam (map fst vs) (c2d p e)
87 > CoTyLam alpha e -> CoTyLam alpha (c2d p e)
89 > App e v -> App (c2d p e) (coreAtom2def p v)
91 > CoTyApp e t -> CoTyApp (c2d p e) t
93 > Case e ps -> Case (c2d p e) (coreCaseAlts2def p ps)
95 > Let (NonRec (v,ManyOcc _) e) e'
96 > | isTrivial e -> c2d (addOneToIdEnv p v (c2d p e)) e'
98 > pprTrace "Not inlining ManyOcc " (ppr PprDebug v) $
99 > Let (NonRec v (c2d p e)) (c2d p e')
101 > Let (NonRec (v,DeadCode) e) e' ->
102 > panic "Core2Def(c2d): oops, unexpected DeadCode"
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'
114 > Let (Rec bs) e -> Let (Rec (map recBind2def bs)) (c2d p e)
115 > where recBind2def ((v,_),e) = (v, c2d p e)
117 > SCC l e -> SCC l (c2d p e)
118 > Coerce _ _ _ -> panic "Core2Def:Coerce"
123 > -> SimplifiableCoreCaseAlts
124 > -> DefCaseAlternatives
126 > coreCaseAlts2def p alts = case alts of
127 > AlgAlts as def -> AlgAlts (map algAlt2def as) (defAlt2def def)
128 > PrimAlts as def -> PrimAlts (map primAlt2def as) (defAlt2def def)
132 > algAlt2def (c, vs, e) = (c, (map fst vs), c2d p e)
133 > primAlt2def (l, e) = (l, c2d p e)
135 > defAlt2def NoDefault = NoDefault
136 > defAlt2def (BindDefault (v,_) e) = BindDefault v (c2d p e)
139 > lookup :: IdEnv DefExpr -> Id -> DefExpr
140 > lookup p v = case lookupIdEnv p v of
141 > Nothing -> Var (DefArgVar v)