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
as well as explicit user written ones.
\begin{code}
-data InstInfo
+data InstInfo a
= InstInfo {
iSpec :: Instance, -- Includes the dfun id. Its forall'd type
- iBinds :: InstBindings -- variables scope over the stuff in InstBindings!
+ iBinds :: InstBindings a -- variables scope over the stuff in InstBindings!
}
-iDFunId :: InstInfo -> DFunId
+iDFunId :: InstInfo a -> DFunId
iDFunId info = instanceDFunId (iSpec info)
-data InstBindings
+data InstBindings a
= VanillaInst -- The normal case
- (LHsBinds Name) -- Bindings for the instance methods
- [LSig Name] -- User pragmas recorded for generating
+ (LHsBinds a) -- Bindings for the instance methods
+ [LSig a] -- User pragmas recorded for generating
-- specialised instances
| NewTypeDerived -- Used for deriving instances of newtypes, where the
-- witness dictionary is identical to the argument
-- dictionary. Hence no bindings, no pragmas.
-pprInstInfo :: InstInfo -> SDoc
+pprInstInfo :: InstInfo a -> SDoc
pprInstInfo info = vcat [ptext (sLit "InstInfo:") <+> ppr (idType (iDFunId info))]
-pprInstInfoDetails :: InstInfo -> SDoc
+pprInstInfoDetails :: OutputableBndr a => InstInfo a -> SDoc
pprInstInfoDetails info = pprInstInfo info $$ nest 2 (details (iBinds info))
where
details (VanillaInst b _) = pprLHsBinds b
details NewTypeDerived = text "Derived from the representation type"
-simpleInstInfoClsTy :: InstInfo -> (Class, Type)
+simpleInstInfoClsTy :: InstInfo a -> (Class, Type)
simpleInstInfoClsTy info = case instanceHead (iSpec info) of
(_, _, cls, [ty]) -> (cls, ty)
_ -> panic "simpleInstInfoClsTy"
-simpleInstInfoTy :: InstInfo -> Type
+simpleInstInfoTy :: InstInfo a -> Type
simpleInstInfoTy info = snd (simpleInstInfoClsTy info)
-simpleInstInfoTyCon :: InstInfo -> TyCon
+simpleInstInfoTyCon :: InstInfo a -> TyCon
-- Gets the type constructor for a simple instance declaration,
-- i.e. one of the form instance (...) => C (T a b c) where ...
simpleInstInfoTyCon inst = tcTyConAppTyCon (simpleInstInfoTy inst)
; 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}
%************************************************************************
%* *