From a16366224ffc106c9440d6d2cd7dc15ce5accc42 Mon Sep 17 00:00:00 2001
From: simonpj <unknown>
Date: Mon, 7 Mar 2005 17:46:24 +0000
Subject: [PATCH] [project @ 2005-03-07 17:46:24 by simonpj]
 -----------------------------------------        Make sure
 that LiberateCase only binds Internal Names 
 -----------------------------------------

	Merge to STABLE

The nested bindings generated by LiberateCase should be Internal as
well as not-exported.  Otherwise an External Name can float to top level,
where it might name-clash with another one.
---
 ghc/compiler/simplCore/LiberateCase.lhs |   21 ++++++++++++++-------
 1 file changed, 14 insertions(+), 7 deletions(-)

diff --git a/ghc/compiler/simplCore/LiberateCase.lhs b/ghc/compiler/simplCore/LiberateCase.lhs
index 3139b44..a5aab26 100644
--- a/ghc/compiler/simplCore/LiberateCase.lhs
+++ b/ghc/compiler/simplCore/LiberateCase.lhs
@@ -12,8 +12,9 @@ import CmdLineOpts	( DynFlags, DynFlag(..), opt_LiberateCaseThreshold )
 import CoreLint		( showPass, endPass )
 import CoreSyn
 import CoreUnfold	( couldBeSmallEnoughToInline )
-import Var		( Id, setIdNotExported )
+import Id		( Id, setIdName, idName, setIdNotExported )
 import VarEnv
+import Name		( localiseName )
 import Outputable
 import Util             ( notNull )
 \end{code}
@@ -190,15 +191,21 @@ libCaseBind env (Rec pairs)
 	-- processing the rhs with an *un-extended* environment, so
 	-- that the same process doesn't occur for ever!
 	--
-	-- Furthermore (subtle!) reset the export flags on the binders so
-	-- that we don't get name clashes on exported things if the 
-	-- local binding floats out to top level.  This is most unlikely
-	-- to happen, since the whole point concerns free variables. 
-	-- But resetting the export flag is right regardless.
-
     extended_env = addRecBinds env [ (setIdNotExported binder, libCase env_body rhs)
 				   | (binder, rhs) <- pairs ]
 
+	-- Two subtle things: 
+	-- (a)  Reset the export flags on the binders so
+	-- 	that we don't get name clashes on exported things if the 
+	-- 	local binding floats out to top level.  This is most unlikely
+	-- 	to happen, since the whole point concerns free variables. 
+	-- 	But resetting the export flag is right regardless.
+	-- 
+	-- (b)  Make the name an Internal one.  External Names should never be
+	--	nested; if it were floated to the top level, we'd get a name
+	-- 	clash at code generation time.
+    adjust bndr = setIdNotExported (setIdName bndr (localiseName (idName bndr)))
+
     rhs_small_enough rhs = couldBeSmallEnoughToInline lIBERATE_BOMB_SIZE rhs
     lIBERATE_BOMB_SIZE   = bombOutSize env
 \end{code}
-- 
1.7.10.4