topIdLvl, thTopLevelId,
-- New Ids
- newLocalName, newDFunName, newFamInstTyConName,
+ newLocalName, newDFunName, newFamInstTyConName,
+ mkStableIdFromString, mkStableIdFromName
) where
#include "HsVersions.h"
import TcType
-- import TcSuspension
import qualified Type
+import Id
import Var
import VarSet
import VarEnv
import SrcLoc
import Outputable
import Maybes
+import Unique
import FastString
\end{code}
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
; 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}
%************************************************************************
%* *