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