From 40437a76ae66881f01e68bbe6b4671ea3dc7e93d Mon Sep 17 00:00:00 2001
From: Max Bolingbroke <batterseapower@hotmail.com>
Date: Thu, 31 Jul 2008 05:44:37 +0000
Subject: [PATCH] Minor refactorings in TcEnv

---
 compiler/typecheck/TcEnv.lhs |   32 ++++++++++++++++++++++++++++----
 1 file changed, 28 insertions(+), 4 deletions(-)

diff --git a/compiler/typecheck/TcEnv.lhs b/compiler/typecheck/TcEnv.lhs
index 98db64c..feafc2e 100644
--- a/compiler/typecheck/TcEnv.lhs
+++ b/compiler/typecheck/TcEnv.lhs
@@ -42,7 +42,8 @@ module TcEnv(
 	topIdLvl, thTopLevelId,
 
 	-- New Ids
-	newLocalName, newDFunName, newFamInstTyConName,
+	newLocalName, newDFunName, newFamInstTyConName, 
+	mkStableIdFromString, mkStableIdFromName
   ) where
 
 #include "HsVersions.h"
@@ -55,6 +56,7 @@ import TcMType
 import TcType
 -- import TcSuspension
 import qualified Type
+import Id
 import Var
 import VarSet
 import VarEnv
@@ -73,6 +75,7 @@ import HscTypes
 import SrcLoc
 import Outputable
 import Maybes
+import Unique
 import FastString
 \end{code}
 
@@ -106,9 +109,9 @@ tcLookupGlobal name
 		Nothing	   -> do 
 	 
 		-- Try global envt
-	{ (eps,hpt) <- getEpsAndHpt
-	; dflags <- getDOpts
-	; case lookupType dflags hpt (eps_PTE eps) name of  {
+	{ hsc_env <- getTopEnv
+        ; mb_thing <- liftIO (lookupTypeHscEnv hsc_env name)
+	; case mb_thing of  {
 	    Just thing -> return thing ;
 	    Nothing    -> do
 
@@ -673,6 +676,27 @@ newFamInstTyConName tc_name loc
 	; newGlobalBinder mod (mkInstTyTcOcc index occ) loc }
 \end{code}
 
+Stable names used for foreign exports and annotations.
+For stable names, the name must be unique (see #1533).  If the
+same thing has several stable Ids based on it, the
+top-level bindings generated must not have the same name.
+Hence we create an External name (doesn't change), and we
+append a Unique to the string right here.
+
+\begin{code}
+mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
+mkStableIdFromString str sig_ty loc occ_wrapper = do
+    uniq <- newUnique
+    mod <- getModule
+    let uniq_str = showSDoc (pprUnique uniq) :: String
+        occ = mkVarOcc (str ++ '_' : uniq_str) :: OccName
+        gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
+	id  = mkExportedLocalId gnm sig_ty :: Id
+    return id
+
+mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcId
+mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
+\end{code}
 
 %************************************************************************
 %*									*
-- 
1.7.10.4