X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2FcoreSyn%2FCoreTidy.lhs;h=3f8402131a47ae74cb1fa9984354960eda8a78a4;hp=bacf64fc27f207b07c512aba9e854e4cc7885353;hb=e4417dcd4679da9c6b18c02ff667199c572bed89;hpb=f37e239fb5e81fc493e0ea1af98178bf1f7ceaba diff --git a/compiler/coreSyn/CoreTidy.lhs b/compiler/coreSyn/CoreTidy.lhs index bacf64f..3f84021 100644 --- a/compiler/coreSyn/CoreTidy.lhs +++ b/compiler/coreSyn/CoreTidy.lhs @@ -1,7 +1,11 @@ % +% (c) The University of Glasgow 2006 % (c) The AQUA Project, Glasgow University, 1996-1998 % +This module contains "tidying" code for *nested* expressions, bindings, rules. +The code for *top-level* bindings is in TidyPgm. + \begin{code} module CoreTidy ( tidyExpr, tidyVarOcc, tidyRule, tidyRules @@ -10,27 +14,22 @@ module CoreTidy ( #include "HsVersions.h" import CoreSyn -import CoreUtils ( exprArity ) -import Id ( Id, mkUserLocal, idInfo, setIdInfo, idUnique, idType ) -import IdInfo ( setArityInfo, vanillaIdInfo, - newStrictnessInfo, setAllStrictnessInfo, - newDemandInfo, setNewDemandInfo ) -import Type ( tidyType, tidyTyVarBndr ) -import Var ( Var, varName ) +import CoreUtils +import Id +import IdInfo +import Type +import Var import VarEnv -import UniqFM ( lookupUFM ) -import Name ( Name, getOccName ) -import OccName ( tidyOccName ) -import SrcLoc ( noSrcLoc ) -import Maybes ( orElse ) -import Outputable -import Util ( mapAccumL ) +import UniqFM +import Name hiding (tidyNameOcc) +import OccName +import SrcLoc +import Maybes + +import Data.List \end{code} -This module contains "tidying" code for *nested* expressions, bindings, rules. -The code for *top-level* bindings is in TidyPgm. - %************************************************************************ %* * \subsection{Tidying expressions, rules} @@ -56,7 +55,7 @@ tidyBind env (Rec prs) tidyExpr :: TidyEnv -> CoreExpr -> CoreExpr tidyExpr env (Var v) = Var (tidyVarOcc env v) tidyExpr env (Type ty) = Type (tidyType env ty) -tidyExpr env (Lit lit) = Lit lit +tidyExpr _ (Lit lit) = Lit lit 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 (Cast e co) = Cast (tidyExpr env e) (tidyType env co) @@ -75,23 +74,25 @@ tidyExpr env (Lam b e) Lam b (tidyExpr env' e) ------------ Case alternatives -------------- -tidyAlt case_bndr env (con, vs, rhs) +tidyAlt :: CoreBndr -> TidyEnv -> CoreAlt -> CoreAlt +tidyAlt _case_bndr env (con, vs, rhs) = tidyBndrs env vs =: \ (env', vs) -> (con, vs, tidyExpr env' rhs) ------------ Notes -------------- -tidyNote env note = note +tidyNote :: TidyEnv -> Note -> Note +tidyNote _ note = note ------------ Rules -------------- tidyRules :: TidyEnv -> [CoreRule] -> [CoreRule] -tidyRules env [] = [] +tidyRules _ [] = [] tidyRules env (rule : rules) = tidyRule env rule =: \ rule -> tidyRules env rules =: \ rules -> (rule : rules) tidyRule :: TidyEnv -> CoreRule -> CoreRule -tidyRule env rule@(BuiltinRule {}) = rule +tidyRule _ rule@(BuiltinRule {}) = rule tidyRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs, ru_fn = fn, ru_rough = mb_ns }) = tidyBndrs env bndrs =: \ (env', bndrs) -> @@ -115,7 +116,7 @@ tidyNameOcc :: TidyEnv -> Name -> Name -- Fortunately, we can lookup in the VarEnv with a name tidyNameOcc (_, var_env) n = case lookupUFM var_env n of Nothing -> n - Just v -> varName v + Just v -> idName v tidyVarOcc :: TidyEnv -> Var -> Var tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v @@ -148,13 +149,16 @@ tidyLetBndr env (id,rhs) -- CorePrep to turn the let into a case. -- -- Similarly arity info for eta expansion in CorePrep - -- + -- + -- Set inline-prag info so that we preseve it across + -- separate compilation boundaries final_id = new_id `setIdInfo` new_info idinfo = idInfo id new_info = vanillaIdInfo `setArityInfo` exprArity rhs `setAllStrictnessInfo` newStrictnessInfo idinfo `setNewDemandInfo` newDemandInfo idinfo + `setInlinePragInfo` inlinePragInfo idinfo -- Override the env we get back from tidyId with the new IdInfo -- so it gets propagated to the usage sites. @@ -175,7 +179,7 @@ tidyIdBndr env@(tidy_env, var_env) id -- which should save some space. -- But note that tidyLetBndr puts some of it back. ty' = tidyType env (idType id) - id' = mkUserLocal occ' (idUnique id) ty' noSrcLoc + id' = mkUserLocal occ' (idUnique id) ty' noSrcSpan `setIdInfo` vanillaIdInfo var_env' = extendVarEnv var_env id id' in @@ -184,5 +188,6 @@ tidyIdBndr env@(tidy_env, var_env) id \end{code} \begin{code} +(=:) :: a -> (a -> b) -> b m =: k = m `seq` k m \end{code}