Commit f4161297 authored by ian@well-typed.com's avatar ian@well-typed.com

Don't use a unique in the stable name of a foreign export

These names end up in the ABI, and hence part of the ABI hash.
We don't want uniques in them so that we don't get spurious ABI
hash changes.
parent 7c4157a5
......@@ -28,6 +28,7 @@ import Name
import Type
import TyCon
import Coercion
import TcEnv
import TcType
import CmmExpr
......@@ -44,12 +45,10 @@ import FastString
import DynFlags
import Platform
import Config
import Encoding
import OrdList
import Pair
import Util
import Data.IORef
import Data.Maybe
import Data.List
\end{code}
......@@ -213,20 +212,12 @@ dsFCall fn_id co fcall mDeclHeader = do
(fcall', cDoc) <-
case fcall of
CCall (CCallSpec (StaticTarget cName mPackageId isFun) CApiConv safety) ->
do let wrapperRef = nextWrapperNum dflags
wrapperNum <- liftIO $ readIORef wrapperRef
liftIO $ writeIORef wrapperRef (wrapperNum + 1)
thisMod <- getModuleDs
do thisMod <- getModuleDs
let pkg = packageIdString (modulePackageId thisMod)
mod = moduleNameString (moduleName thisMod)
wrapperNameComponents = ["ghc_wrapper",
show wrapperNum,
pkg, mod,
unpackFS cName]
wrapperName = mkFastString
$ zEncodeString
$ intercalate ":" wrapperNameComponents
fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageId True) CApiConv safety)
wrapperNameComponents = [pkg, mod, unpackFS cName]
wrapperName <- mkWrapperName "ghc_wrapper" wrapperNameComponents
let fcall' = CCall (CCallSpec (StaticTarget wrapperName mPackageId True) CApiConv safety)
c = includes
$$ fun_proto <+> braces (cRet <> semi)
includes = vcat [ text "#include <" <> ftext h <> text ">"
......
......@@ -50,7 +50,8 @@ module TcEnv(
-- New Ids
newLocalName, newDFunName, newFamInstTyConName, newFamInstAxiomName,
mkStableIdFromString, mkStableIdFromName
mkStableIdFromString, mkStableIdFromName,
mkWrapperName
) where
#include "HsVersions.h"
......@@ -80,10 +81,15 @@ import HscTypes
import DynFlags
import SrcLoc
import BasicTypes
import Module
import Outputable
import Encoding
import FastString
import ListSetOps
import Util
import Data.IORef
import Data.List
\end{code}
......@@ -750,7 +756,10 @@ mkStableIdFromString :: String -> Type -> SrcSpan -> (OccName -> OccName) -> TcM
mkStableIdFromString str sig_ty loc occ_wrapper = do
uniq <- newUnique
mod <- getModule
let occ = mkVarOcc (str ++ '_' : show uniq) :: OccName
name <- mkWrapperName "stable" [packageIdString (modulePackageId mod),
moduleNameString (moduleName mod),
str]
let occ = mkVarOccFS name :: OccName
gnm = mkExternalName uniq mod (occ_wrapper occ) loc :: Name
id = mkExportedLocalId gnm sig_ty :: Id
return id
......@@ -759,6 +768,18 @@ mkStableIdFromName :: Name -> Type -> SrcSpan -> (OccName -> OccName) -> TcM TcI
mkStableIdFromName nm = mkStableIdFromString (getOccString nm)
\end{code}
\begin{code}
mkWrapperName :: (MonadIO m, HasDynFlags m)
=> String -> [String] -> m FastString
mkWrapperName what components
= do dflags <- getDynFlags
let wrapperRef = nextWrapperNum dflags
wrapperNum <- liftIO $ readIORef wrapperRef
liftIO $ writeIORef wrapperRef (wrapperNum + 1)
let allComponents = what : show wrapperNum : components
return $ mkFastString $ zEncodeString $ intercalate ":" allComponents
\end{code}
%************************************************************************
%* *
\subsection{Errors}
......
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment