compiler/coreSyn/CoreTidy.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The AQUA Project, Glasgow University, 1996-1998
   4 %
   5
   6 This module contains "tidying" code for *nested* expressions, bindings, rules.
   7 The code for *top-level* bindings is in TidyPgm.
   8
   9 \begin{code}
  10 module CoreTidy (
  11         tidyExpr, tidyVarOcc, tidyRule, tidyRules
  12     ) where
  13
  14 -- XXX This define is a bit of a hack, and should be done more nicely
  15 #define FAST_STRING_NOT_NEEDED 1
  16 #include "HsVersions.h"
  17
  18 import CoreSyn
  19 import CoreUtils
  20 import Id
  21 import IdInfo
  22 import Type
  23 import Var
  24 import VarEnv
  25 import UniqFM
  26 import Name hiding (tidyNameOcc)
  27 import OccName
  28 import SrcLoc
  29 import Maybes
  30
  31 import Data.List
  32 \end{code}
  33
  34
  35 %************************************************************************
  36 %*                                                                      *
  37 \subsection{Tidying expressions, rules}
  38 %*                                                                      *
  39 %************************************************************************
  40
  41 \begin{code}
  42 tidyBind :: TidyEnv
  43          -> CoreBind
  44          ->  (TidyEnv, CoreBind)
  45
  46 tidyBind env (NonRec bndr rhs)
  47   = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
  48     (env', NonRec bndr' (tidyExpr env' rhs))
  49
  50 tidyBind env (Rec prs)
  51   = mapAccumL tidyLetBndr  env prs      =: \ (env', bndrs') ->
  52     map (tidyExpr env') (map snd prs)   =: \ rhss' ->
  53     (env', Rec (zip bndrs' rhss'))
  54
  55
  56 ------------  Expressions  --------------
  57 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
  58 tidyExpr env (Var v)     =  Var (tidyVarOcc env v)
  59 tidyExpr env (Type ty)   =  Type (tidyType env ty)
  60 tidyExpr _   (Lit lit)   =  Lit lit
  61 tidyExpr env (App f a)   =  App (tidyExpr env f) (tidyExpr env a)
  62 tidyExpr env (Note n e)  =  Note (tidyNote env n) (tidyExpr env e)
  63 tidyExpr env (Cast e co) =  Cast (tidyExpr env e) (tidyType env co)
  64
  65 tidyExpr env (Let b e)
  66   = tidyBind env b      =: \ (env', b') ->
  67     Let b' (tidyExpr env' e)
  68
  69 tidyExpr env (Case e b ty alts)
  70   = tidyBndr env b      =: \ (env', b) ->
  71     Case (tidyExpr env e) b (tidyType env ty)
  72          (map (tidyAlt b env') alts)
  73
  74 tidyExpr env (Lam b e)
  75   = tidyBndr env b      =: \ (env', b) ->
  76     Lam b (tidyExpr env' e)
  77
  78 ------------  Case alternatives  --------------
  79 tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt
  80 tidyAlt _case_bndr env (con, vs, rhs)
  81   = tidyBndrs env vs    =: \ (env', vs) ->
  82     (con, vs, tidyExpr env' rhs)
  83
  84 ------------  Notes  --------------
  85 tidyNote :: TidyEnv -> Note -> Note
  86 tidyNote _ note            = note
  87
  88 ------------  Rules  --------------
  89 tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule]
  90 tidyRules _   [] = []
  91 tidyRules env (rule : rules)
  92   = tidyRule env rule           =: \ rule ->
  93     tidyRules env rules         =: \ rules ->
  94     (rule : rules)
  95
  96 tidyRule :: TidyEnv -> CoreRule -> CoreRule
  97 tidyRule _   rule@(BuiltinRule {}) = rule
  98 tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs,
  99                           ru_fn = fn, ru_rough = mb_ns })
 100   = tidyBndrs env bndrs         =: \ (env', bndrs) ->
 101     map (tidyExpr env') args    =: \ args ->
 102     rule { ru_bndrs = bndrs, ru_args = args,
 103            ru_rhs   = tidyExpr env' rhs,
 104            ru_fn    = tidyNameOcc env fn,
 105            ru_rough = map (fmap (tidyNameOcc env')) mb_ns }
 106 \end{code}
 107
 108
 109 %************************************************************************
 110 %*                                                                      *
 111 \subsection{Tidying non-top-level binders}
 112 %*                                                                      *
 113 %************************************************************************
 114
 115 \begin{code}
 116 tidyNameOcc :: TidyEnv -> Name -> Name
 117 -- In rules and instances, we have Names, and we must tidy them too
 118 -- Fortunately, we can lookup in the VarEnv with a name
 119 tidyNameOcc (_, var_env) n = case lookupUFM var_env n of
 120                                 Nothing -> n
 121                                 Just v  -> idName v
 122
 123 tidyVarOcc :: TidyEnv -> Var -> Var
 124 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
 125
 126 -- tidyBndr is used for lambda and case binders
 127 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 128 tidyBndr env var
 129   | isTyVar var = tidyTyVarBndr env var
 130   | otherwise   = tidyIdBndr env var
 131
 132 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 133 tidyBndrs env vars = mapAccumL tidyBndr env vars
 134
 135 tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
 136 -- Used for local (non-top-level) let(rec)s
 137 tidyLetBndr env (id,rhs)
 138   = ((tidy_env,new_var_env), final_id)
 139   where
 140     ((tidy_env,var_env), new_id) = tidyIdBndr env id
 141
 142         -- We need to keep around any interesting strictness and
 143         -- demand info because later on we may need to use it when
 144         -- converting to A-normal form.
 145         -- eg.
 146         --      f (g x),  where f is strict in its argument, will be converted
 147         --      into  case (g x) of z -> f z  by CorePrep, but only if f still
 148         --      has its strictness info.
 149         --
 150         -- Similarly for the demand info - on a let binder, this tells
 151         -- CorePrep to turn the let into a case.
 152         --
 153         -- Similarly arity info for eta expansion in CorePrep
 154         --
 155         -- Set inline-prag info so that we preseve it across
 156         -- separate compilation boundaries
 157     final_id = new_id `setIdInfo` new_info
 158     idinfo   = idInfo id
 159     new_info = vanillaIdInfo
 160                 `setArityInfo`          exprArity rhs
 161                 `setAllStrictnessInfo`  newStrictnessInfo idinfo
 162                 `setNewDemandInfo`      newDemandInfo idinfo
 163                 `setInlinePragInfo`     inlinePragInfo idinfo
 164
 165     -- Override the env we get back from tidyId with the new IdInfo
 166     -- so it gets propagated to the usage sites.
 167     new_var_env = extendVarEnv var_env id final_id
 168
 169 -- Non-top-level variables
 170 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
 171 tidyIdBndr env@(tidy_env, var_env) id
 172   = -- do this pattern match strictly, otherwise we end up holding on to
 173     -- stuff in the OccName.
 174     case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
 175     let
 176         -- Give the Id a fresh print-name, *and* rename its type
 177         -- The SrcLoc isn't important now,
 178         -- though we could extract it from the Id
 179         --
 180         -- All nested Ids now have the same IdInfo, namely vanillaIdInfo,
 181         -- which should save some space.
 182         -- But note that tidyLetBndr puts some of it back.
 183         ty'               = tidyType env (idType id)
 184         id'               = mkUserLocal occ' (idUnique id) ty' noSrcSpan
 185                                 `setIdInfo` vanillaIdInfo
 186         var_env'          = extendVarEnv var_env id id'
 187     in
 188      ((tidy_env', var_env'), id')
 189    }
 190 \end{code}
 191
 192 \begin{code}
 193 (=:) :: a -> (a -> b) -> b
 194 m =: k = m `seq` k m
 195 \end{code}