X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FTidyPgm.lhs;h=4ab553d46c6b407f7b48f80e55825497b886a2ae;hb=9ba922ee06b048774d7a82964867ff768a78126e;hp=a03098322ba18b6928dbfd98f39df054c5bf893c;hpb=9e6ca39b5e90b7a4acc755e3e95cc3ef60940070;p=ghc-hetmet.git diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs index a030983..4ab553d 100644 --- a/compiler/main/TidyPgm.lhs +++ b/compiler/main/TidyPgm.lhs @@ -854,10 +854,9 @@ tidyTopName mod nc_var maybe_ref occ_env id (occ_env', occ') = tidyOccName occ_env new_occ - mk_new_local nc = (nc { nsUniqs = us2 }, mkInternalName uniq occ' loc) + mk_new_local nc = (nc { nsUniqs = us }, mkInternalName uniq occ' loc) where - (us1, us2) = splitUniqSupply (nsUniqs nc) - uniq = uniqFromSupply us1 + (uniq, us) = takeUniqFromSupply (nsUniqs nc) mk_new_external nc = allocateGlobalBinder nc mod occ' loc -- If we want to externalise a currently-local name, check @@ -1066,8 +1065,12 @@ tidyTopIdInfo rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_info --------- Unfolding ------------ unf_info = unfoldingInfo idinfo - unfold_info | show_unfold = tidyUnfolding rhs_tidy_env tidy_rhs final_sig unf_info + unfold_info | show_unfold = tidyUnfolding rhs_tidy_env unf_info unf_from_rhs | otherwise = noUnfolding + unf_from_rhs = mkTopUnfolding is_bot tidy_rhs + is_bot = case final_sig of + Just sig -> isBottomingSig sig + Nothing -> False -- NB: do *not* expose the worker if show_unfold is off, -- because that means this thing is a loop breaker or -- marked NOINLINE or something like that @@ -1090,30 +1093,6 @@ tidyTopIdInfo rhs_tidy_env name orig_rhs tidy_rhs idinfo show_unfold caf_info -- it to the top level. So it seems more robust just to -- fix it here. arity = exprArity orig_rhs - - - ------------- Unfolding -------------- -tidyUnfolding :: TidyEnv -> CoreExpr -> Maybe StrictSig -> Unfolding -> Unfolding -tidyUnfolding tidy_env _ _ (DFunUnfolding ar con ids) - = DFunUnfolding ar con (map (tidyExpr tidy_env) ids) -tidyUnfolding tidy_env tidy_rhs strict_sig - unf@(CoreUnfolding { uf_tmpl = unf_rhs, uf_src = src }) - | isStableSource src - = unf { uf_tmpl = tidyExpr tidy_env unf_rhs, -- Preserves OccInfo - uf_src = tidyInl tidy_env src } - | otherwise - = mkTopUnfolding is_bot tidy_rhs - where - is_bot = case strict_sig of - Just sig -> isBottomingSig sig - Nothing -> False - -tidyUnfolding _ _ _ unf = unf - -tidyInl :: TidyEnv -> UnfoldingSource -> UnfoldingSource -tidyInl tidy_env (InlineWrapper w) = InlineWrapper (tidyVarOcc tidy_env w) -tidyInl _ inl_info = inl_info \end{code} %************************************************************************