From a6c32f649d2284a29dda1f0b0cfb1221b142aa7d Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Fri, 10 Apr 1998 16:29:49 +0000
Subject: [PATCH] [project @ 1998-04-10 16:29:46 by simonpj] Another obscure
-prof bug in SimplVar
---
ghc/compiler/basicTypes/MkId.lhs | 4 +++-
ghc/compiler/simplCore/SimplVar.lhs | 13 +++++++------
2 files changed, 10 insertions(+), 7 deletions(-)
diff --git a/ghc/compiler/basicTypes/MkId.lhs b/ghc/compiler/basicTypes/MkId.lhs
index 414ef2e6638a..f9f7710703ca 100644
--- a/ghc/compiler/basicTypes/MkId.lhs
+++ b/ghc/compiler/basicTypes/MkId.lhs
@@ -322,9 +322,11 @@ mkDictSelId name clas ty
field_lbl = mkFieldLabel name ty tag
tag = assoc "MkId.mkDictSelId" ((sc_sel_ids ++ op_sel_ids) `zip` allFieldLabelTags) sel_id
- info = setInlinePragInfo IWantToBeINLINEd $
+ info = setInlinePragInfo IMustBeINLINEd $
setUnfoldingInfo unfolding noIdInfo
-- The always-inline thing means we don't need any other IdInfo
+ -- We need "Must" inline because we don't create any bindigs for
+ -- the selectors.
unfolding = mkUnfolding rhs
diff --git a/ghc/compiler/simplCore/SimplVar.lhs b/ghc/compiler/simplCore/SimplVar.lhs
index 7c1340b92bf7..0a7b85ad297c 100644
--- a/ghc/compiler/simplCore/SimplVar.lhs
+++ b/ghc/compiler/simplCore/SimplVar.lhs
@@ -72,12 +72,13 @@ completeVar env inline_call var args result_ty
-- Look for an unfolding. There's a binding for the
-- thing, but perhaps we want to inline it anyway
| has_unfolding
- && (not essential_unfoldings_only || idMustBeINLINEd var)
- -- If "essential_unfoldings_only" is true we do no inlinings at all,
- -- EXCEPT for things that absolutely have to be done
- -- (see comments with idMustBeINLINEd)
- && (inline_call || ok_to_inline)
- && costCentreOk (getEnclosingCC env) (coreExprCc unf_template)
+ && (idMustBeINLINEd var ||
+ (not essential_unfoldings_only
+ -- If "essential_unfoldings_only" is true we do no inlinings at all,
+ -- EXCEPT for things that absolutely have to be done
+ -- (see comments with idMustBeINLINEd)
+ && (inline_call || ok_to_inline)
+ && costCentreOk (getEnclosingCC env) (coreExprCc unf_template)))
=
{-
pprTrace "Unfolding" (ppr var) $
--
GitLab