diff options
| -rw-r--r-- | compiler/deSugar/DsForeign.lhs | 20 | ||||
| -rw-r--r-- | compiler/main/DynFlags.hs | 11 |
2 files changed, 23 insertions, 8 deletions
diff --git a/compiler/deSugar/DsForeign.lhs b/compiler/deSugar/DsForeign.lhs index 0cf4b97159..42aa740414 100644 --- a/compiler/deSugar/DsForeign.lhs +++ b/compiler/deSugar/DsForeign.lhs @@ -44,10 +44,12 @@ 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} @@ -211,11 +213,19 @@ dsFCall fn_id co fcall mDeclHeader = do (fcall', cDoc) <- case fcall of CCall (CCallSpec (StaticTarget cName mPackageId isFun) CApiConv safety) -> - do fcall_uniq <- newUnique - let wrapperName = mkFastString "ghc_wrapper_" `appendFS` - mkFastString (showPpr dflags fcall_uniq) `appendFS` - mkFastString "_" `appendFS` - cName + do let wrapperRef = nextWrapperNum dflags + wrapperNum <- liftIO $ readIORef wrapperRef + liftIO $ writeIORef wrapperRef (wrapperNum + 1) + 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) c = includes $$ fun_proto <+> braces (cRet <> semi) diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 4810ce85b1..07ebd4013e 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -690,7 +690,9 @@ data DynFlags = DynFlags { interactivePrint :: Maybe String, - llvmVersion :: IORef (Int) + llvmVersion :: IORef (Int), + + nextWrapperNum :: IORef Int } class HasDynFlags m where @@ -1111,12 +1113,14 @@ initDynFlags dflags = do refFilesToNotIntermediateClean <- newIORef [] refGeneratedDumps <- newIORef Set.empty refLlvmVersion <- newIORef 28 + wrapperNum <- newIORef 0 return dflags{ filesToClean = refFilesToClean, dirsToClean = refDirsToClean, filesToNotIntermediateClean = refFilesToNotIntermediateClean, generatedDumps = refGeneratedDumps, - llvmVersion = refLlvmVersion + llvmVersion = refLlvmVersion, + nextWrapperNum = wrapperNum } -- | The normal 'DynFlags'. Note that they is not suitable for use in this form @@ -1239,7 +1243,8 @@ defaultDynFlags mySettings = traceLevel = 1, profAuto = NoProfAuto, llvmVersion = panic "defaultDynFlags: No llvmVersion", - interactivePrint = Nothing + interactivePrint = Nothing, + nextWrapperNum = panic "defaultDynFlags: No nextWrapperNum" } defaultWays :: Settings -> [Way] |