ghc/compiler/coreSyn/CoreTidy.lhs

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