CoreTidy.lhs 8.04 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3
% (c) The AQUA Project, Glasgow University, 1996-1998
4 5
%

Simon Marlow's avatar
Simon Marlow committed
6 7 8
This module contains "tidying" code for *nested* expressions, bindings, rules.
The code for *top-level* bindings is in TidyPgm.

9
\begin{code}
Ian Lynagh's avatar
Ian Lynagh committed
10 11 12 13 14 15 16
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details

17
module CoreTidy (
18
	tidyExpr, tidyVarOcc, tidyRule, tidyRules, tidyUnfolding
19 20 21 22 23
    ) where

#include "HsVersions.h"

import CoreSyn
24
import CoreArity
Simon Marlow's avatar
Simon Marlow committed
25 26
import Id
import IdInfo
Simon Peyton Jones's avatar
Simon Peyton Jones committed
27 28
import Type( tidyType, tidyTyVarBndr )
import Coercion( tidyCo )
Simon Marlow's avatar
Simon Marlow committed
29
import Var
30
import VarEnv
31
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
32 33 34
import Name hiding (tidyNameOcc)
import SrcLoc
import Maybes
35
import Data.List
36
import Outputable
37 38 39
\end{code}


40 41
%************************************************************************
%*									*
42
\subsection{Tidying expressions, rules}
43 44 45 46 47
%*									*
%************************************************************************

\begin{code}
tidyBind :: TidyEnv
48
	 -> CoreBind
49 50
	 ->  (TidyEnv, CoreBind)

51
tidyBind env (NonRec bndr rhs)
52
  = tidyLetBndr env env (bndr,rhs) =: \ (env', bndr') ->
53
    (env', NonRec bndr' (tidyExpr env' rhs))
54

55
tidyBind env (Rec prs)
56 57 58
  = let 
       (env', bndrs') = mapAccumL (tidyLetBndr env') env prs
    in
59 60
    map (tidyExpr env') (map snd prs)	=: \ rhss' ->
    (env', Rec (zip bndrs' rhss'))
61

62

63
------------  Expressions  --------------
64
tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
65
tidyExpr env (Var v)   	 =  Var (tidyVarOcc env v)
66 67
tidyExpr env (Type ty)  =  Type (tidyType env ty)
tidyExpr env (Coercion co) = Coercion (tidyCo env co)
twanvl's avatar
twanvl committed
68
tidyExpr _   (Lit lit)   =  Lit lit
69
tidyExpr env (App f a) 	 =  App (tidyExpr env f) (tidyExpr env a)
70
tidyExpr env (Tick t e) =  Tick (tidyTickish env t) (tidyExpr env e)
71
tidyExpr env (Cast e co) =  Cast (tidyExpr env e) (tidyCo env co)
72

73
tidyExpr env (Let b e) 
74 75
  = tidyBind env b 	=: \ (env', b') ->
    Let b' (tidyExpr env' e)
76

77
tidyExpr env (Case e b ty alts)
78
  = tidyBndr env b 	=: \ (env', b) ->
79 80
    Case (tidyExpr env e) b (tidyType env ty) 
	 (map (tidyAlt b env') alts)
81

82
tidyExpr env (Lam b e)
83 84
  = tidyBndr env b 	=: \ (env', b) ->
    Lam b (tidyExpr env' e)
85

86
------------  Case alternatives  --------------
twanvl's avatar
twanvl committed
87 88
tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
tidyAlt _case_bndr env (con, vs, rhs)
89 90
  = tidyBndrs env vs 	=: \ (env', vs) ->
    (con, vs, tidyExpr env' rhs)
91

92 93 94 95
------------  Tickish  --------------
tidyTickish :: TidyEnv -> Tickish Id -> Tickish Id
tidyTickish env (Breakpoint ix ids) = Breakpoint ix (map (tidyVarOcc env) ids)
tidyTickish _   other_tickish       = other_tickish
96 97

------------  Rules  --------------
98
tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
twanvl's avatar
twanvl committed
99
tidyRules _   [] = []
100
tidyRules env (rule : rules)
101
  = tidyRule env rule  		=: \ rule ->
102 103
    tidyRules env rules 	=: \ rules ->
    (rule : rules)
104 105

tidyRule :: TidyEnv -> CoreRule -> CoreRule
twanvl's avatar
twanvl committed
106
tidyRule _   rule@(BuiltinRule {}) = rule
107 108 109 110 111 112 113 114
tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
			  ru_fn = fn, ru_rough = mb_ns })
  = tidyBndrs env bndrs		=: \ (env', bndrs) ->
    map (tidyExpr env') args  	=: \ args ->
    rule { ru_bndrs = bndrs, ru_args = args, 
	   ru_rhs   = tidyExpr env' rhs,
	   ru_fn    = tidyNameOcc env fn, 
	   ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
115 116 117 118 119
\end{code}


%************************************************************************
%*									*
120
\subsection{Tidying non-top-level binders}
121 122 123 124
%*									*
%************************************************************************

\begin{code}
125 126 127 128 129
tidyNameOcc :: TidyEnv -> Name -> Name
-- In rules and instances, we have Names, and we must tidy them too
-- Fortunately, we can lookup in the VarEnv with a name
tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
				Nothing -> n
Simon Marlow's avatar
Simon Marlow committed
130
				Just v  -> idName v
131

132 133
tidyVarOcc :: TidyEnv -> Var -> Var
tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
134

135
-- tidyBndr is used for lambda and case binders
136
tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
137
tidyBndr env var
138
  | isTyVar var = tidyTyVarBndr env var
139
  | otherwise   = tidyIdBndr env var
140

141 142
tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
tidyBndrs env vars = mapAccumL tidyBndr env vars
143

144 145 146
tidyLetBndr :: TidyEnv	       -- Knot-tied version for unfoldings
            -> TidyEnv 	       -- The one to extend
            -> (Id, CoreExpr) -> (TidyEnv, Var)
147
-- Used for local (non-top-level) let(rec)s
148 149
tidyLetBndr rec_tidy_env env (id,rhs) 
  = ((tidy_occ_env,new_var_env), final_id)
150
  where
151 152 153 154
    ((tidy_occ_env,var_env), new_id) = tidyIdBndr env id
    new_var_env = extendVarEnv var_env id final_id
       -- Override the env we get back from tidyId with the 
       -- new IdInfo so it gets propagated to the usage sites.
155

156 157 158
	-- We need to keep around any interesting strictness and
	-- demand info because later on we may need to use it when
	-- converting to A-normal form.
159 160 161 162 163 164 165
	-- eg.
	--	f (g x),  where f is strict in its argument, will be converted
	--	into  case (g x) of z -> f z  by CorePrep, but only if f still
	-- 	has its strictness info.
	--
	-- Similarly for the demand info - on a let binder, this tells 
	-- CorePrep to turn the let into a case.
166 167
	--
	-- Similarly arity info for eta expansion in CorePrep
168 169 170
	-- 
	-- Set inline-prag info so that we preseve it across 
	-- separate compilation boundaries
171 172
    final_id = new_id `setIdInfo` new_info
    idinfo   = idInfo id
173
    new_info = idInfo new_id
174
		`setArityInfo`		exprArity rhs
175 176
                `setStrictnessInfo`	strictnessInfo idinfo
                `setDemandInfo`	        demandInfo idinfo
177
		`setInlinePragInfo`	inlinePragInfo idinfo
178
		`setUnfoldingInfo`	new_unf
179

180 181 182
    new_unf | isStableUnfolding unf = tidyUnfolding rec_tidy_env unf (panic "tidy_unf")
            | otherwise	            = noUnfolding
    unf = unfoldingInfo idinfo
183

184
-- Non-top-level variables
185 186
tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
tidyIdBndr env@(tidy_env, var_env) id
187
  = -- Do this pattern match strictly, otherwise we end up holding on to
188 189
    -- stuff in the OccName.
    case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') -> 
190 191
    let 
	-- Give the Id a fresh print-name, *and* rename its type
192 193
	-- The SrcLoc isn't important now, 
	-- though we could extract it from the Id
194
	-- 
195 196 197 198
        ty'      = tidyType env (idType id)
        name'    = mkInternalName (idUnique id) occ' noSrcSpan
	id'      = mkLocalIdWithInfo name' ty' new_info
	var_env' = extendVarEnv var_env id id'
199 200 201 202

	-- Note [Tidy IdInfo]
        new_info = vanillaIdInfo `setOccInfo` occInfo old_info
	old_info = idInfo id
203
    in
204
    ((tidy_env', var_env'), id')
205
   }
206 207 208

------------ Unfolding  --------------
tidyUnfolding :: TidyEnv -> Unfolding -> Unfolding -> Unfolding
209 210
tidyUnfolding tidy_env (DFunUnfolding ar con args) _
  = DFunUnfolding ar con (map (fmap (tidyExpr tidy_env)) args)
211 212 213 214 215 216 217 218 219 220 221 222 223
tidyUnfolding tidy_env 
              unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src })
              unf_from_rhs
  | isStableSource src
  = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, 	   -- Preserves OccInfo
	  uf_src  = tidySrc tidy_env src }
  | otherwise
  = unf_from_rhs
tidyUnfolding _ unf _ = unf	-- NoUnfolding or OtherCon

tidySrc :: TidyEnv -> UnfoldingSource -> UnfoldingSource
tidySrc tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w)
tidySrc _        inl_info          = inl_info
224 225
\end{code}

226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
Note [Tidy IdInfo]
~~~~~~~~~~~~~~~~~~
All nested Ids now have the same IdInfo, namely vanillaIdInfo, which
should save some space; except that we preserve occurrence info for
two reasons:

  (a) To make printing tidy core nicer

  (b) Because we tidy RULES and InlineRules, which may then propagate
      via --make into the compilation of the next module, and we want
      the benefit of that occurrence analysis when we use the rule or
      or inline the function.  In particular, it's vital not to lose
      loop-breaker info, else we get an infinite inlining loop
      
Note that tidyLetBndr puts more IdInfo back.


243
\begin{code}
twanvl's avatar
twanvl committed
244
(=:) :: a -> (a -> b) -> b
245
m =: k = m `seq` k m
246
\end{code}