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 tidyExpr env (Case e b alts)
  75   = tidyBndr env b      =: \ (env', b) ->
  76     Case (tidyExpr env e) b (map (tidyAlt env') alts)
  77
  78 tidyExpr env (Lam b e)
  79   = tidyBndr env b      =: \ (env', b) ->
  80     Lam b (tidyExpr env' e)
  81
  82 ------------  Case alternatives  --------------
  83 tidyAlt env (con, vs, rhs)
  84   = tidyBndrs env vs    =: \ (env', vs) ->
  85     (con, vs, tidyExpr env' rhs)
  86
  87 ------------  Notes  --------------
  88 tidyNote env (Coerce t1 t2)  = Coerce (tidyType env t1) (tidyType env t2)
  89 tidyNote env note            = note
  90
  91
  92 ------------  Rules  --------------
  93 tidyIdRules :: TidyEnv -> [IdCoreRule] -> [IdCoreRule]
  94 tidyIdRules env [] = []
  95 tidyIdRules env ((fn,rule) : rules)
  96   = tidyRule env rule           =: \ rule ->
  97     tidyIdRules env rules       =: \ rules ->
  98      ((tidyVarOcc env fn, rule) : rules)
  99
 100 tidyRule :: TidyEnv -> CoreRule -> CoreRule
 101 tidyRule env rule@(BuiltinRule _ _) = rule
 102 tidyRule env (Rule name act vars tpl_args rhs)
 103   = tidyBndrs env vars                  =: \ (env', vars) ->
 104     map (tidyExpr env') tpl_args        =: \ tpl_args ->
 105      (Rule name act vars tpl_args (tidyExpr env' rhs))
 106
 107 pprTidyIdRules :: Id -> SDoc
 108 pprTidyIdRules id = pprIdRules (tidyIdRules emptyTidyEnv (idCoreRules id))
 109 \end{code}
 110
 111
 112 %************************************************************************
 113 %*                                                                      *
 114 \subsection{Tidying non-top-level binders}
 115 %*                                                                      *
 116 %************************************************************************
 117
 118 \begin{code}
 119 tidyVarOcc :: TidyEnv -> Var -> Var
 120 tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
 121
 122 -- tidyBndr is used for lambda and case binders
 123 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 124 tidyBndr env var
 125   | isTyVar var = tidyTyVarBndr env var
 126   | otherwise   = tidyIdBndr env var
 127
 128 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
 129 tidyBndrs env vars = mapAccumL tidyBndr env vars
 130
 131 tidyLetBndr :: TidyEnv -> (Id, CoreExpr) -> (TidyEnv, Var)
 132 -- Used for local (non-top-level) let(rec)s
 133 tidyLetBndr env (id,rhs)
 134   = ((tidy_env,new_var_env), final_id)
 135   where
 136     ((tidy_env,var_env), new_id) = tidyIdBndr env id
 137
 138         -- We need to keep around any interesting strictness and
 139         -- demand info because later on we may need to use it when
 140         -- converting to A-normal form.
 141         -- eg.
 142         --      f (g x),  where f is strict in its argument, will be converted
 143         --      into  case (g x) of z -> f z  by CorePrep, but only if f still
 144         --      has its strictness info.
 145         --
 146         -- Similarly for the demand info - on a let binder, this tells
 147         -- CorePrep to turn the let into a case.
 148         --
 149         -- Similarly arity info for eta expansion in CorePrep
 150         --
 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 vanillaIdInfo,
 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                                 `setIdInfo` vanillaIdInfo
 179         var_env'          = extendVarEnv var_env id id'
 180     in
 181      ((tidy_env', var_env'), id')
 182    }
 183 \end{code}
 184
 185 \begin{code}
 186 m =: k = m `seq` k m
 187 \end{code}