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