compiler/coreSyn/CoreTidy.lhs

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