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         tidyBind, tidyExpr,
  13         tidyBndr, tidyBndrs, tidyVarOcc,
  14         tidyIdRules, pprTidyIdRules
  15     ) where
  16
  17 #include "HsVersions.h"
  18
  19 import CoreSyn
  20 import CoreUtils        ( exprArity )
  21 import PprCore          ( pprIdRules )
  22 import Id               ( Id, mkUserLocal, idInfo, setIdInfo, idUnique,
  23                           idType, idCoreRules )
  24 import IdInfo           ( setArityInfo, noCafIdInfo,
  25                           newStrictnessInfo, setAllStrictnessInfo,
  26                           newDemandInfo, setNewDemandInfo )
  27 import Type             ( tidyType, tidyTyVarBndr )
  28 import Var              ( Var )
  29 import VarEnv
  30 import Name             ( getOccName )
  31 import OccName          ( tidyOccName )
  32 import SrcLoc           ( noSrcLoc )
  33 import Maybes           ( orElse )
  34 import Outputable
  35 import Util             ( mapAccumL )
  36 \end{code}
  37
  38
  39 This module contains "tidying" code for *nested* expressions, bindings, rules.
  40 The code for *top-level* bindings is in TidyPgm.
  41
  42 %************************************************************************
  43 %*                                                                      *
  44 \subsection{Tidying expressions, rules}
  45 %*                                                                      *
  46 %************************************************************************
  47
  48 \begin{code}
  49 tidyBind :: TidyEnv
  50          -> CoreBind
  51          ->  (TidyEnv, CoreBind)
  52
  53 tidyBind env (NonRec bndr rhs)
  54   = tidyLetBndr env (bndr,rhs) =: \ (env', bndr') ->
  55     (env', NonRec bndr' (tidyExpr env' rhs))
  56
  57 tidyBind env (Rec prs)
  58   = mapAccumL tidyLetBndr  env prs      =: \ (env', bndrs') ->
  59     map (tidyExpr env') (map snd prs)   =: \ rhss' ->
  60     (env', Rec (zip bndrs' rhss'))
  61
  62
  63 ------------  Expressions  --------------
  64 tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr
  65 tidyExpr env (Var v)    =  Var (tidyVarOcc env v)
  66 tidyExpr env (Type ty)  =  Type (tidyType env ty)
  67 tidyExpr env (Lit lit)  =  Lit lit
  68 tidyExpr env (App f a)  =  App (tidyExpr env f) (tidyExpr env a)
  69 tidyExpr env (Note n e) =  Note (tidyNote env n) (tidyExpr env e)
  70
  71 tidyExpr env (Let b e)
  72   = tidyBind env b      =: \ (env', b') ->
  73     Let b' (tidyExpr env' e)
  74
  75 tidyExpr env (Case e b alts)
  76   = tidyBndr env b      =: \ (env', b) ->
  77     Case (tidyExpr env e) b (map (tidyAlt 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 env (con, vs, rhs)
  85   = tidyBndrs env vs    =: \ (env', vs) ->
  86     (con, vs, tidyExpr env' rhs)
  87
  88 ------------  Notes  --------------
  89 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
  90 tidyNote env note            = note
  91
  92
  93 ------------  Rules  --------------
  94 tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
  95 tidyIdRules env [] = []
  96 tidyIdRules env ((fn,rule) : rules)
  97   = tidyRule env rule           =: \ rule ->
  98     tidyIdRules env rules       =: \ rules ->
  99      ((tidyVarOcc env fn, rule) : rules)
 100
 101 tidyRule :: TidyEnv -> CoreRule -> CoreRule
 102 tidyRule env rule@(BuiltinRule _ _) = rule
 103 tidyRule env (Rule name act vars tpl_args rhs)
 104   = tidyBndrs env vars                  =: \ (env', vars) ->
 105     map (tidyExpr env') tpl_args        =: \ tpl_args ->
 106      (Rule name act vars tpl_args (tidyExpr env' rhs))
 107
 108 pprTidyIdRules :: Id -> SDoc
 109 pprTidyIdRules id = pprIdRules (tidyIdRules emptyTidyEnv (idCoreRules id))
 110 \end{code}
 111
 112
 113 %************************************************************************
 114 %*                                                                      *
 115 \subsection{Tidying non-top-level binders}
 116 %*                                                                      *
 117 %************************************************************************
 118
 119 \begin{code}
 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         -- CafInfo is NoCafRefs, because this is not a top-level Id.
 153         --
 154     final_id = new_id `setIdInfo` new_info
 155     idinfo   = idInfo id
 156     new_info = noCafIdInfo -- NB. no CAF refs!
 157                 `setArityInfo`          exprArity rhs
 158                 `setAllStrictnessInfo`  newStrictnessInfo idinfo
 159                 `setNewDemandInfo`      newDemandInfo 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 noCafIdInfo,
 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' noSrcLoc
 181                                 `setIdInfo` noCafIdInfo
 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}