- endPass "Tidy Core" (opt_D_dump_simpl || opt_D_verbose_core2core) binds_out
- return (binds_out, rules_out)
- where
- -- We also make sure to avoid any exported binders. Consider
- -- f{-u1-} = 1 -- Local decl
- -- ...
- -- f{-u2-} = 2 -- Exported decl
- --
- -- The second exported decl must 'get' the name 'f', so we
- -- have to put 'f' in the avoids list before we get to the first
- -- decl. tidyTopId then does a no-op on exported binders.
- init_tidy_env = (initTidyOccEnv avoids, emptyVarEnv)
- avoids = [getOccName bndr | bndr <- bindersOfBinds binds_in,
- isUserExportedId bndr]
-
-tidyBind :: Maybe Module -- (Just m) for top level, Nothing for nested
- -> TidyEnv
- -> CoreBind
- -> (TidyEnv, CoreBind)
-tidyBind maybe_mod env (NonRec bndr rhs)
- = let
- (env', bndr') = tidy_bndr maybe_mod env env bndr
- rhs' = tidyExpr env rhs
- in
- (env', NonRec bndr' rhs')
-
-tidyBind maybe_mod env (Rec pairs)
- = let
- -- We use env' when tidying the rhss
- -- When tidying the binder itself we may tidy it's
- -- specialisations; if any of these mention other binders
- -- in the group we should really feed env' to them too;
- -- but that seems (a) unlikely and (b) a bit tiresome.
- -- So I left it out for now
-
- (bndrs, rhss) = unzip pairs
- (env', bndrs') = mapAccumL (tidy_bndr maybe_mod env') env bndrs
- rhss' = map (tidyExpr env') rhss
- in
- (env', Rec (zip bndrs' rhss'))
-
-tidyExpr env (Type ty) = Type (tidyType env ty)
-tidyExpr env (Con con args) = Con con (map (tidyExpr env) args)
-tidyExpr env (App f a) = App (tidyExpr env f) (tidyExpr env a)
-tidyExpr env (Note n e) = Note (tidyNote env n) (tidyExpr env e)
-
-tidyExpr env (Let b e) = Let b' (tidyExpr env' e)
- where
- (env', b') = tidyBind Nothing env b
-
-tidyExpr env (Case e b alts) = Case (tidyExpr env e) b' (map (tidyAlt env') alts)
- where
- (env', b') = tidyBndr env b
-
-tidyExpr env (Var v) = Var (tidyVarOcc env v)
-
-tidyExpr env (Lam b e) = Lam b' (tidyExpr env' e)
- where
- (env', b') = tidyBndr env b
-
-tidyAlt env (con, vs, rhs) = (con, vs', tidyExpr env' rhs)
- where
- (env', vs') = tidyBndrs env vs