[project @ 1996-01-08 20:28:12 by partain]
[ghc.git] / 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 >       PlainCoreProgram(..), DefProgram(..),
12 >       CoreBinding, Id, DefBindee ) where
13
14 > import DefSyn
15 >#ifdef __HBC__
16 > import Trace
17 >#endif
18
19 > import CoreSyn
20 > import IdEnv
21 > import PlainCore
22 > import TaggedCore
23 > import BinderInfo     -- ( BinderInfo(..), isFun, isDupDanger )
24 > import CmdLineOpts    ( switchIsOn, SwitchResult, SimplifierSwitch )
25 > import OccurAnal      ( occurAnalyseBinds )
26 > import SimplEnv       ( SwitchChecker(..) )
27 > import Util
28 > import Pretty
29 > import Outputable
30
31 This module translates the PlainCoreProgram into a DefCoreProgram,
32 which includes non-atomic right-hand sides.  The decisions about which
33 expressions to inline are left to the substitution analyser, which we
34 run beforehand.
35
36 Current thinking:
37
38 1.  Inline all non-recursive non-top-level lets that occur only
39     once (including inside lambdas, hoping full laziness
40     will sort things out later).
41
42 2.  We don't inline top-level lets that occur only once, because these
43     might not be pulled out again by the let-floater, due to non-
44     garbage collection of CAFs.  
45
46 2.1.  Also, what about these lit things that occur at the top level,
47     and are usually marked as macros?
48
49 3.  No recusrive functions are unfolded.
50
51 ToDo:
52 4.  Lambdas and case alternatives that bind a variable that occurs 
53     multiple times are transformed:
54     \x -> ..x..x..  ===>  \x -> let x' = x in ..x'..x'..
55
56
57 > core2def :: (GlobalSwitch -> SwitchResult) -> PlainCoreProgram -> DefProgram
58 > core2def sw prog = 
59 >       map coreBinding2def tagged_program
60 >   where  
61 >       tagged_program = occurAnalyseBinds prog switch_is_on (const False)
62 >       switch_is_on   = switchIsOn sw
63
64
65 > coreBinding2def :: SimplifiableCoreBinding -> DefBinding
66 > coreBinding2def (CoNonRec (v,_) e) = CoNonRec v (c2d nullIdEnv e)
67 > coreBinding2def (CoRec bs) = CoRec (map recBind2def bs)
68 >       where recBind2def ((v,_),e) = (v, c2d nullIdEnv e)
69
70
71 > coreAtom2def :: IdEnv DefExpr -> PlainCoreAtom -> DefAtom
72 > coreAtom2def p (CoVarAtom v) = CoVarAtom (DefArgExpr (lookup p v))
73 > coreAtom2def p (CoLitAtom l) = CoVarAtom (DefArgExpr (CoLit l))
74
75 > isTrivial (CoCon c [] []) = True
76 > isTrivial (CoVar v)       = True
77 > isTrivial (CoLit l)       = True
78 > isTrivial _               = False
79
80 > c2d :: IdEnv DefExpr -> SimplifiableCoreExpr -> DefExpr
81 > c2d p e = case e of
82
83 >       CoVar v         -> lookup p v 
84 >       
85 >       CoLit l         -> CoLit l
86 >       
87 >       CoCon c ts es   -> CoCon c ts (map (coreAtom2def p) es)
88 >       
89 >       CoPrim op ts es -> CoPrim op ts (map (coreAtom2def p) es)
90 >       
91 >       CoLam vs e      -> CoLam (map fst vs) (c2d p e)
92 >       
93 >       CoTyLam alpha e -> CoTyLam alpha (c2d p e)
94 >       
95 >       CoApp e v       -> CoApp (c2d p e) (coreAtom2def p v)
96 >       
97 >       CoTyApp e t     -> CoTyApp (c2d p e) t
98 >       
99 >       CoCase e ps     -> CoCase (c2d p e) (coreCaseAlts2def p ps)
100 >       
101 >       CoLet (CoNonRec (v,ManyOcc _) e) e' 
102 >               | isTrivial e -> c2d (addOneToIdEnv p v (c2d p e)) e'
103 >               | otherwise ->
104 >               trace ("Not inlining ManyOcc " ++ ppShow 80 (ppr PprDebug v)) (
105 >               CoLet (CoNonRec v (c2d p e)) (c2d p e'))
106 >               
107 >       CoLet (CoNonRec (v,DeadCode) e) e' ->
108 >               panic "Core2Def(c2d): oops, unexpected DeadCode"
109 >               
110 >       CoLet (CoNonRec (v,OneOcc fun_or_arg dup_danger _ _ _) e) e'
111 >          | isTrivial e -> inline_it
112 >          | isDupDanger dup_danger ->
113 >               trace ("Not inlining DupDanger " ++ ppShow 80 (ppr PprDebug v))(
114 >               CoLet (CoNonRec v (c2d p e)) (c2d p e'))
115 >          | isFun fun_or_arg ->
116 >               panic "Core2Def(c2d): oops, unexpected Macro"
117 >          | otherwise -> inline_it
118 >        where inline_it = c2d (addOneToIdEnv p v (c2d p e)) e'
119 >        
120 >       CoLet (CoRec bs) e -> CoLet (CoRec (map recBind2def bs)) (c2d p e)
121 >               where recBind2def ((v,_),e) = (v, c2d p e)
122 >               
123 >       CoSCC l e       -> CoSCC l (c2d p e)
124
125
126 > coreCaseAlts2def 
127 >       :: IdEnv DefExpr 
128 >       -> SimplifiableCoreCaseAlternatives
129 >       -> DefCaseAlternatives
130 >       
131 > coreCaseAlts2def p alts = case alts of
132 >       CoAlgAlts as def  -> CoAlgAlts (map algAlt2def as) (defAlt2def def)
133 >       CoPrimAlts as def -> CoPrimAlts (map primAlt2def as) (defAlt2def def)
134 >       
135 >   where 
136 >       
137 >       algAlt2def  (c, vs, e) = (c, (map fst vs), c2d p e)
138 >       primAlt2def (l, e)     = (l, c2d p e)
139
140 >       defAlt2def CoNoDefault = CoNoDefault
141 >       defAlt2def (CoBindDefault (v,_) e) = CoBindDefault v (c2d p e)
142
143
144 > lookup :: IdEnv DefExpr -> Id -> DefExpr
145 > lookup p v = case lookupIdEnv p v of
146 >                       Nothing -> CoVar (DefArgVar v)
147 >                       Just e  -> e