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, idType, idCoreRules )
  23 import IdInfo           ( vanillaIdInfo, setArityInfo,
  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 tidyCoreExpr :: CoreExpr -> IO CoreExpr
  64 tidyCoreExpr expr = return (tidyExpr emptyTidyEnv expr)
  65
  66 tidyExpr env (Var v)    =  Var (tidyVarOcc env v)
  67 tidyExpr env (Type ty)  =  Type (tidyType env ty)
  68 tidyExpr env (Lit lit)  =  Lit lit
  69 tidyExpr env (App f a)  =  App (tidyExpr env f) (tidyExpr env a)
  70 tidyExpr env (Note n e) =  Note (tidyNote env n) (tidyExpr env e)
  71
  72 tidyExpr env (Let b e)
  73   = tidyBind env b      =: \ (env', b') ->
  74     Let b' (tidyExpr env' e)
  75
  76 tidyExpr env (Case e b alts)
  77   = tidyBndr env b      =: \ (env', b) ->
  78     Case (tidyExpr env e) b (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 demand info
 141         -- because later on we may need to use it when 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     final_id = new_id `setIdInfo` new_info
 152     idinfo   = idInfo id
 153     new_info = vanillaIdInfo
 154                 `setArityInfo`          exprArity rhs
 155                 `setAllStrictnessInfo`  newStrictnessInfo idinfo
 156                 `setNewDemandInfo`      newDemandInfo idinfo
 157
 158     -- Override the env we get back from tidyId with the new IdInfo
 159     -- so it gets propagated to the usage sites.
 160     new_var_env = extendVarEnv var_env id final_id
 161
 162 -- Non-top-level variables
 163 tidyIdBndr :: TidyEnv -> Id -> (TidyEnv, Id)
 164 tidyIdBndr env@(tidy_env, var_env) id
 165   = -- do this pattern match strictly, otherwise we end up holding on to
 166     -- stuff in the OccName.
 167     case tidyOccName tidy_env (getOccName id) of { (tidy_env', occ') ->
 168     let
 169         -- Give the Id a fresh print-name, *and* rename its type
 170         -- The SrcLoc isn't important now,
 171         -- though we could extract it from the Id
 172         --
 173         -- All nested Ids now have the same IdInfo, namely none,
 174         -- which should save some space.
 175         -- But note that tidyLetBndr puts some of it back.
 176         ty'               = tidyType env (idType id)
 177         id'               = mkUserLocal occ' (idUnique id) ty' noSrcLoc
 178         var_env'          = extendVarEnv var_env id id'
 179     in
 180      ((tidy_env', var_env'), id')
 181    }
 182 \end{code}
 183
 184 \begin{code}
 185 m =: k = m `seq` k m
 186 \end{code}
 187
 188