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