summaryrefslogtreecommitdiff
path: root/compiler
diff options
context:
space:
mode:
authorIan Lynagh <ian@well-typed.com>2012-09-03 17:02:18 +0100
committerIan Lynagh <ian@well-typed.com>2012-09-03 17:02:18 +0100
commit46258b406fcc17c4ba50d512894989f4c387ea33 (patch)
tree6b7fa024ccd0deb6fbf282e16d218ee1ee0bbdb4 /compiler
parent494eb3dc2bdbe76170044631b98884c56e9acfd3 (diff)
downloadhaskell-46258b406fcc17c4ba50d512894989f4c387ea33.tar.gz
Make the ways dynamic
Diffstat (limited to 'compiler')
-rw-r--r--compiler/cmm/CLabel.hs11
-rw-r--r--compiler/main/DriverPipeline.hs14
-rw-r--r--compiler/main/DynFlags.hs252
-rw-r--r--compiler/main/Packages.lhs9
-rw-r--r--compiler/main/StaticFlagParser.hs44
-rw-r--r--compiler/main/StaticFlags.hs220
-rw-r--r--compiler/main/TidyPgm.lhs25
-rw-r--r--compiler/nativeGen/PIC.hs15
-rw-r--r--compiler/simplCore/CoreMonad.lhs2
-rw-r--r--compiler/stgSyn/StgSyn.lhs4
10 files changed, 278 insertions, 318 deletions
diff --git a/compiler/cmm/CLabel.hs b/compiler/cmm/CLabel.hs
index 6ffbbc774d..ed4b56767a 100644
--- a/compiler/cmm/CLabel.hs
+++ b/compiler/cmm/CLabel.hs
@@ -104,7 +104,6 @@ module CLabel (
) where
import IdInfo
-import StaticFlags
import BasicTypes
import Packages
import DataCon
@@ -808,15 +807,15 @@ labelDynamic :: DynFlags -> PackageId -> CLabel -> Bool
labelDynamic dflags this_pkg lbl =
case lbl of
-- is the RTS in a DLL or not?
- RtsLabel _ -> not opt_Static && (this_pkg /= rtsPackageId)
+ RtsLabel _ -> not (dopt Opt_Static dflags) && (this_pkg /= rtsPackageId)
- IdLabel n _ _ -> isDllName this_pkg n
+ IdLabel n _ _ -> isDllName dflags this_pkg n
-- When compiling in the "dyn" way, each package is to be linked into
-- its own shared library.
CmmLabel pkg _ _
| os == OSMinGW32 ->
- not opt_Static && (this_pkg /= pkg)
+ not (dopt Opt_Static dflags) && (this_pkg /= pkg)
| otherwise ->
True
@@ -834,14 +833,14 @@ labelDynamic dflags this_pkg lbl =
-- When compiling in the "dyn" way, each package is to be
-- linked into its own DLL.
ForeignLabelInPackage pkgId ->
- (not opt_Static) && (this_pkg /= pkgId)
+ (not (dopt Opt_Static dflags)) && (this_pkg /= pkgId)
else -- On Mac OS X and on ELF platforms, false positives are OK,
-- so we claim that all foreign imports come from dynamic
-- libraries
True
- PlainModuleInitLabel m -> not opt_Static && this_pkg /= (modulePackageId m)
+ PlainModuleInitLabel m -> not (dopt Opt_Static dflags) && this_pkg /= (modulePackageId m)
-- Note that DynamicLinkerLabels do NOT require dynamic linking themselves.
_ -> False
diff --git a/compiler/main/DriverPipeline.hs b/compiler/main/DriverPipeline.hs
index 6eff097bfb..a579519ae6 100644
--- a/compiler/main/DriverPipeline.hs
+++ b/compiler/main/DriverPipeline.hs
@@ -39,7 +39,7 @@ import Module
import UniqFM ( eltsUFM )
import ErrUtils
import DynFlags
-import StaticFlags ( v_Ld_inputs, opt_Static, Way(..) )
+import StaticFlags ( v_Ld_inputs )
import Config
import Panic
import Util
@@ -1352,9 +1352,9 @@ runPhase LlvmLlc input_fn dflags
let lc_opts = getOpts dflags opt_lc
opt_lvl = max 0 (min 2 $ optLevel dflags)
- rmodel | dopt Opt_PIC dflags = "pic"
- | not opt_Static = "dynamic-no-pic"
- | otherwise = "static"
+ rmodel | dopt Opt_PIC dflags = "pic"
+ | not (dopt Opt_Static dflags) = "dynamic-no-pic"
+ | otherwise = "static"
tbaa | ver < 29 = "" -- no tbaa in 2.8 and earlier
| dopt Opt_LlvmTBAA dflags = "--enable-tbaa=true"
| otherwise = "--enable-tbaa=false"
@@ -1448,7 +1448,7 @@ maybeMergeStub
runPhase_MoveBinary :: DynFlags -> FilePath -> IO Bool
runPhase_MoveBinary dflags input_fn
- | WayPar `elem` ways dflags && not opt_Static =
+ | WayPar `elem` ways dflags && not (dopt Opt_Static dflags) =
panic ("Don't know how to combine PVM wrapper and dynamic wrapper")
| WayPar `elem` ways dflags = do
let sysMan = pgm_sysman dflags
@@ -1668,7 +1668,7 @@ linkBinary dflags o_files dep_packages = do
get_pkg_lib_path_opts l
| osElfTarget (platformOS platform) &&
dynLibLoader dflags == SystemDependent &&
- not opt_Static
+ not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l]
@@ -1891,7 +1891,7 @@ linkDynLib dflags o_files dep_packages
get_pkg_lib_path_opts l
| osElfTarget (platformOS (targetPlatform dflags)) &&
dynLibLoader dflags == SystemDependent &&
- not opt_Static
+ not (dopt Opt_Static dflags)
= ["-L" ++ l, "-Wl,-rpath", "-Wl," ++ l]
| otherwise = ["-L" ++ l]
diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index b227172264..8a87188452 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -50,6 +50,8 @@ module DynFlags (
printOutputForUser, printInfoForUser,
+ Way(..), mkBuildTag, wayRTSOnly,
+
-- ** Safe Haskell
SafeHaskellMode(..),
safeHaskellOn, safeImportsOn, safeLanguageOn, safeInferOn,
@@ -122,7 +124,6 @@ import Platform
import Module
import PackageConfig
import PrelNames ( mAIN )
-import StaticFlags
import {-# SOURCE #-} Packages (PackageState)
import DriverPhases ( Phase(..), phaseInputExt )
import Config
@@ -144,7 +145,7 @@ import {-# SOURCE #-} ErrUtils ( Severity(..), MsgDoc, mkLocMessage )
import System.IO.Unsafe ( unsafePerformIO )
#endif
import Data.IORef
-import Control.Monad ( when )
+import Control.Monad
import Data.Char
import Data.List
@@ -325,6 +326,8 @@ data DynFlag
| Opt_GranMacros
| Opt_PIC
| Opt_SccProfilingOn
+ | Opt_Ticky
+ | Opt_Static
-- output style opts
| Opt_PprCaseAsLet
@@ -852,12 +855,8 @@ isNoLink :: GhcLink -> Bool
isNoLink NoLink = True
isNoLink _ = False
--- Is it worth evaluating this Bool and caching it in the DynFlags value
--- during initDynFlags?
doingTickyProfiling :: DynFlags -> Bool
-doingTickyProfiling _ = opt_Ticky
- -- XXX -ticky is a static flag, because it implies -debug which is also
- -- static. If the way flags were made dynamic, we could fix this.
+doingTickyProfiling dflags = dopt Opt_Ticky dflags
data PackageFlag
= ExposePackage String
@@ -899,19 +898,184 @@ data DynLibLoader
data RtsOptsEnabled = RtsOptsNone | RtsOptsSafeOnly | RtsOptsAll
deriving (Show)
+-----------------------------------------------------------------------------
+-- Ways
+
+-- The central concept of a "way" is that all objects in a given
+-- program must be compiled in the same "way". Certain options change
+-- parameters of the virtual machine, eg. profiling adds an extra word
+-- to the object header, so profiling objects cannot be linked with
+-- non-profiling objects.
+
+-- After parsing the command-line options, we determine which "way" we
+-- are building - this might be a combination way, eg. profiling+threaded.
+
+-- We then find the "build-tag" associated with this way, and this
+-- becomes the suffix used to find .hi files and libraries used in
+-- this compilation.
+
+data Way
+ = WayThreaded
+ | WayDebug
+ | WayProf
+ | WayEventLog
+ | WayPar
+ | WayGran
+ | WayNDP
+ | WayDyn
+ deriving (Eq,Ord)
+
+allowed_combination :: [Way] -> Bool
+allowed_combination way = and [ x `allowedWith` y
+ | x <- way, y <- way, x < y ]
+ where
+ -- Note ordering in these tests: the left argument is
+ -- <= the right argument, according to the Ord instance
+ -- on Way above.
+
+ -- dyn is allowed with everything
+ _ `allowedWith` WayDyn = True
+ WayDyn `allowedWith` _ = True
+
+ -- debug is allowed with everything
+ _ `allowedWith` WayDebug = True
+ WayDebug `allowedWith` _ = True
+
+ WayProf `allowedWith` WayNDP = True
+ WayThreaded `allowedWith` WayProf = True
+ WayThreaded `allowedWith` WayEventLog = True
+ _ `allowedWith` _ = False
+
+mkBuildTag :: [Way] -> String
+mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
+
+wayTag :: Way -> String
+wayTag WayThreaded = "thr"
+wayTag WayDebug = "debug"
+wayTag WayDyn = "dyn"
+wayTag WayProf = "p"
+wayTag WayEventLog = "l"
+wayTag WayPar = "mp"
+-- wayTag WayPar = "mt"
+-- wayTag WayPar = "md"
+wayTag WayGran = "mg"
+wayTag WayNDP = "ndp"
+
+wayRTSOnly :: Way -> Bool
+wayRTSOnly WayThreaded = True
+wayRTSOnly WayDebug = True
+wayRTSOnly WayDyn = False
+wayRTSOnly WayProf = False
+wayRTSOnly WayEventLog = True
+wayRTSOnly WayPar = False
+-- wayRTSOnly WayPar = False
+-- wayRTSOnly WayPar = False
+wayRTSOnly WayGran = False
+wayRTSOnly WayNDP = False
+
+wayDesc :: Way -> String
+wayDesc WayThreaded = "Threaded"
+wayDesc WayDebug = "Debug"
+wayDesc WayDyn = "Dynamic"
+wayDesc WayProf = "Profiling"
+wayDesc WayEventLog = "RTS Event Logging"
+wayDesc WayPar = "Parallel"
+-- wayDesc WayPar = "Parallel ticky profiling"
+-- wayDesc WayPar = "Distributed"
+wayDesc WayGran = "GranSim"
+wayDesc WayNDP = "Nested data parallelism"
+
+wayOpts :: Way -> DynP ()
+wayOpts WayThreaded = do
+#if defined(freebsd_TARGET_OS)
+-- "-optc-pthread"
+-- , "-optl-pthread"
+ -- FreeBSD's default threading library is the KSE-based M:N libpthread,
+ -- which GHC has some problems with. It's currently not clear whether
+ -- the problems are our fault or theirs, but it seems that using the
+ -- alternative 1:1 threading library libthr works around it:
+ upd $ addOptl "-lthr"
+#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
+ upd $ addOptc "-pthread"
+ upd $ addOptl "-pthread"
+#elif defined(solaris2_TARGET_OS)
+ upd $ addOptl "-lrt"
+#endif
+ return ()
+wayOpts WayDebug = return ()
+wayOpts WayDyn = do
+ upd $ addOptP "-DDYNAMIC"
+ upd $ addOptc "-DDYNAMIC"
+#if defined(mingw32_TARGET_OS)
+ -- On Windows, code that is to be linked into a dynamic library must be compiled
+ -- with -fPIC. Labels not in the current package are assumed to be in a DLL
+ -- different from the current one.
+ setFPIC
+#elif defined(darwin_TARGET_OS)
+ setFPIC
+#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
+ -- Without this, linking the shared libHSffi fails because
+ -- it uses pthread mutexes.
+ upd $ addOptl "-optl-pthread"
+#endif
+wayOpts WayProf = do
+ setDynFlag Opt_SccProfilingOn
+ upd $ addOptP "-DPROFILING"
+ upd $ addOptc "-DPROFILING"
+wayOpts WayEventLog = do
+ upd $ addOptP "-DTRACING"
+ upd $ addOptc "-DTRACING"
+wayOpts WayPar = do
+ setDynFlag Opt_Parallel
+ upd $ addOptP "-D__PARALLEL_HASKELL__"
+ upd $ addOptc "-DPAR"
+ exposePackage "concurrent"
+ upd $ addOptc "-w"
+ upd $ addOptl "-L${PVM_ROOT}/lib/${PVM_ARCH}"
+ upd $ addOptl "-lpvm3"
+ upd $ addOptl "-lgpvm3"
+{-
+wayOpts WayPar =
+ [ "-fparallel"
+ , "-D__PARALLEL_HASKELL__"
+ , "-optc-DPAR"
+ , "-optc-DPAR_TICKY"
+ , "-package concurrent"
+ , "-optc-w"
+ , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
+ , "-optl-lpvm3"
+ , "-optl-lgpvm3" ]
+wayOpts WayPar =
+ [ "-fparallel"
+ , "-D__PARALLEL_HASKELL__"
+ , "-D__DISTRIBUTED_HASKELL__"
+ , "-optc-DPAR"
+ , "-optc-DDIST"
+ , "-package concurrent"
+ , "-optc-w"
+ , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
+ , "-optl-lpvm3"
+ , "-optl-lgpvm3" ]
+-}
+wayOpts WayGran = do
+ setDynFlag Opt_GranMacros
+ upd $ addOptP "-D__GRANSIM__"
+ upd $ addOptc "-DGRAN"
+ exposePackage "concurrent"
+wayOpts WayNDP = do
+ setExtensionFlag Opt_ParallelArrays
+ setDynFlag Opt_Vectorise
+
+-----------------------------------------------------------------------------
+
-- | Used by 'GHC.newSession' to partially initialize a new 'DynFlags' value
initDynFlags :: DynFlags -> IO DynFlags
initDynFlags dflags = do
- -- someday these will be dynamic flags
- ways <- readIORef v_Ways
refFilesToClean <- newIORef []
refDirsToClean <- newIORef Map.empty
refGeneratedDumps <- newIORef Set.empty
refLlvmVersion <- newIORef 28
return dflags{
- ways = ways,
- buildTag = mkBuildTag (filter (not . wayRTSOnly) ways),
- rtsBuildTag = mkBuildTag ways,
filesToClean = refFilesToClean,
dirsToClean = refDirsToClean,
generatedDumps = refGeneratedDumps,
@@ -980,7 +1144,7 @@ defaultDynFlags mySettings =
packageFlags = [],
pkgDatabase = Nothing,
pkgState = panic "no package state yet: call GHC.setSessionDynFlags",
- ways = panic "defaultDynFlags: No ways",
+ ways = [],
buildTag = panic "defaultDynFlags: No buildTag",
rtsBuildTag = panic "defaultDynFlags: No rtsBuildTag",
splitInfo = Nothing,
@@ -1286,7 +1450,7 @@ getVerbFlags dflags
setObjectDir, setHiDir, setStubDir, setDumpDir, setOutputDir,
setDylibInstallName,
setObjectSuf, setHiSuf, setHcSuf, parseDynLibLoaderMode,
- setPgmP, addOptl, addOptP,
+ setPgmP, addOptl, addOptc, addOptP,
addCmdlineFramework, addHaddockOpts, addGhciScript,
setInteractivePrint
:: String -> DynFlags -> DynFlags
@@ -1332,6 +1496,7 @@ setDumpPrefixForce f d = d { dumpPrefixForce = f}
-- Config.hs should really use Option.
setPgmP f = let (pgm:args) = words f in alterSettings (\s -> s { sPgm_P = (pgm, map Option args)})
addOptl f = alterSettings (\s -> s { sOpt_l = f : sOpt_l s})
+addOptc f = alterSettings (\s -> s { sOpt_c = f : sOpt_c s})
addOptP f = alterSettings (\s -> s { sOpt_P = f : sOpt_P s})
@@ -1483,7 +1648,19 @@ parseDynamicFlagsFull activeFlags cmdline dflags0 args = do
-- check for disabled flags in safe haskell
let (dflags2, sh_warns) = safeFlagCheck cmdline dflags1
- return (dflags2, leftover, sh_warns ++ warns)
+ theWays = sort $ nub $ ways dflags2
+ theBuildTag = mkBuildTag (filter (not . wayRTSOnly) theWays)
+ dflags3 = dflags2 {
+ ways = theWays,
+ buildTag = theBuildTag,
+ rtsBuildTag = mkBuildTag theWays
+ }
+
+ unless (allowed_combination theWays) $
+ ghcError (CmdLineError ("combination not supported: " ++
+ intercalate "/" (map wayDesc theWays)))
+
+ return (dflags3, leftover, sh_warns ++ warns)
-- | Check (and potentially disable) any extensions that aren't allowed
@@ -1579,6 +1756,32 @@ dynamic_flags = [
addWarn "-#include and INCLUDE pragmas are deprecated: They no longer have any effect"))
, Flag "v" (OptIntSuffix setVerbosity)
+ ------- ways --------------------------------------------------------
+ , Flag "prof" (NoArg (addWay WayProf))
+ , Flag "eventlog" (NoArg (addWay WayEventLog))
+ , Flag "parallel" (NoArg (addWay WayPar))
+ , Flag "gransim" (NoArg (addWay WayGran))
+ , Flag "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
+ , Flag "debug" (NoArg (addWay WayDebug))
+ , Flag "ndp" (NoArg (addWay WayNDP))
+ , Flag "threaded" (NoArg (addWay WayThreaded))
+
+ , Flag "ticky" (NoArg (setDynFlag Opt_Ticky >> addWay WayDebug))
+
+ -- -ticky enables ticky-ticky code generation, and also implies -debug which
+ -- is required to get the RTS ticky support.
+
+ ----- Linker --------------------------------------------------------
+ -- -static is the default. If -dynamic has been given then, due to the
+ -- way wayOpts is currently used, we've already set -DDYNAMIC etc.
+ -- It's too fiddly to undo that, so we just give an error if
+ -- Opt_Static has been unset.
+ , Flag "static" (noArgM (\dfs -> do unless (dopt Opt_Static dfs) (addErr "Can't use -static after -dynamic")
+ return dfs))
+ , Flag "dynamic" (NoArg (unSetDynFlag Opt_Static >> addWay WayDyn))
+ -- ignored for compat w/ gcc:
+ , Flag "rdynamic" (NoArg (return ()))
+
------- Specific phases --------------------------------------------
-- need to appear before -pgmL to be parsed as LLVM flags.
, Flag "pgmlo" (hasArg (\f -> alterSettings (\s -> s { sPgm_lo = (f,[])})))
@@ -1600,7 +1803,7 @@ dynamic_flags = [
, Flag "optL" (hasArg (\f -> alterSettings (\s -> s { sOpt_L = f : sOpt_L s})))
, Flag "optP" (hasArg addOptP)
, Flag "optF" (hasArg (\f -> alterSettings (\s -> s { sOpt_F = f : sOpt_F s})))
- , Flag "optc" (hasArg (\f -> alterSettings (\s -> s { sOpt_c = f : sOpt_c s})))
+ , Flag "optc" (hasArg addOptc)
, Flag "optm" (HasArg (\_ -> addWarn "The -optm flag does nothing; it will be removed in a future GHC release"))
, Flag "opta" (hasArg (\f -> alterSettings (\s -> s { sOpt_a = f : sOpt_a s})))
, Flag "optl" (hasArg addOptl)
@@ -2064,9 +2267,6 @@ fFlags = [
( "ghci-history", Opt_GhciHistory, nop ),
( "helpful-errors", Opt_HelpfulErrors, nop ),
( "defer-type-errors", Opt_DeferTypeErrors, nop ),
- ( "parallel", Opt_Parallel, nop ),
- ( "scc-profiling", Opt_SccProfilingOn, nop ),
- ( "gransim", Opt_GranMacros, nop ),
( "building-cabal-package", Opt_BuildingCabalPackage, nop ),
( "implicit-import-qualified", Opt_ImplicitImportQualified, nop ),
( "prof-count-entries", Opt_ProfCountEntries, nop ),
@@ -2239,6 +2439,7 @@ xFlags = [
defaultFlags :: Platform -> [DynFlag]
defaultFlags platform
= [ Opt_AutoLinkPackages,
+ Opt_Static,
Opt_SharedImplib,
@@ -2260,7 +2461,6 @@ defaultFlags platform
OSDarwin ->
case platformArch platform of
ArchX86_64 -> [Opt_PIC]
- _ | not opt_Static -> [Opt_PIC]
_ -> []
_ -> [])
@@ -2524,6 +2724,11 @@ setDumpFlag :: DynFlag -> OptKind (CmdLineP DynFlags)
setDumpFlag dump_flag = NoArg (setDumpFlag' dump_flag)
--------------------------
+addWay :: Way -> DynP ()
+addWay w = do upd (\dfs -> dfs { ways = w : ways dfs })
+ wayOpts w
+
+--------------------------
setDynFlag, unSetDynFlag :: DynFlag -> DynP ()
setDynFlag f = upd (\dfs -> dopt_set dfs f)
unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
@@ -2667,7 +2872,7 @@ setObjTarget l = updM set
return dflags
HscLlvm
| not ((arch == ArchX86_64) && (os == OSLinux || os == OSDarwin)) &&
- (not opt_Static || dopt Opt_PIC dflags)
+ (not (dopt Opt_Static dflags) || dopt Opt_PIC dflags)
->
do addWarn ("Ignoring " ++ flag ++ " as it is incompatible with -fPIC and -dynamic on this platform")
return dflags
@@ -2704,7 +2909,7 @@ unSetFPIC = updM set
| platformArch platform == ArchX86_64 ->
do addWarn "Ignoring -fno-PIC on this platform"
return dflags
- _ | not opt_Static ->
+ _ | not (dopt Opt_Static dflags) ->
do addWarn "Ignoring -fno-PIC as -fstatic is off"
return dflags
_ -> return $ dopt_unset dflags Opt_PIC
@@ -2879,7 +3084,8 @@ picCCOpts dflags
-- correctly. They need to reference data in the Haskell
-- objects, but can't without -fPIC. See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/PositionIndependentCode
- | dopt Opt_PIC dflags || not opt_Static -> ["-fPIC", "-U __PIC__", "-D__PIC__"]
+ | dopt Opt_PIC dflags || not (dopt Opt_Static dflags) ->
+ ["-fPIC", "-U __PIC__", "-D__PIC__"]
| otherwise -> []
picPOpts :: DynFlags -> [String]
diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs
index 0f9ab3647b..87e573e628 100644
--- a/compiler/main/Packages.lhs
+++ b/compiler/main/Packages.lhs
@@ -37,7 +37,6 @@ where
import PackageConfig
import DynFlags
-import StaticFlags
import Config ( cProjectVersion )
import Name ( Name, nameModule_maybe )
import UniqFM
@@ -896,7 +895,7 @@ packageHsLibs dflags p = map (mkDynName . addSuffix) (hsLibraries p)
tag = mkBuildTag (filter (not . wayRTSOnly) ways2)
rts_tag = mkBuildTag ways2
- mkDynName | opt_Static = id
+ mkDynName | dopt Opt_Static dflags = id
| otherwise = (++ ("-ghc" ++ cProjectVersion))
addSuffix rts@"HSrts" = rts ++ (expandTag rts_tag)
@@ -1031,12 +1030,12 @@ missingDependencyMsg (Just parent)
-- -----------------------------------------------------------------------------
-- | Will the 'Name' come from a dynamically linked library?
-isDllName :: PackageId -> Name -> Bool
+isDllName :: DynFlags -> PackageId -> Name -> Bool
-- Despite the "dll", I think this function just means that
-- the synbol comes from another dynamically-linked package,
-- and applies on all platforms, not just Windows
-isDllName this_pkg name
- | opt_Static = False
+isDllName dflags this_pkg name
+ | dopt Opt_Static dflags = False
| Just mod <- nameModule_maybe name = modulePackageId mod /= this_pkg
| otherwise = False -- no, it is not even an external name
diff --git a/compiler/main/StaticFlagParser.hs b/compiler/main/StaticFlagParser.hs
index 8f6ff84ec8..05a463957e 100644
--- a/compiler/main/StaticFlagParser.hs
+++ b/compiler/main/StaticFlagParser.hs
@@ -18,8 +18,7 @@ module StaticFlagParser (
#include "HsVersions.h"
import qualified StaticFlags as SF
-import StaticFlags ( v_opt_C_ready, getWayFlags, Way(..)
- , opt_SimplExcessPrecision )
+import StaticFlags ( v_opt_C_ready, opt_SimplExcessPrecision )
import CmdLineParser
import SrcLoc
import Util
@@ -60,18 +59,9 @@ parseStaticFlagsFull flagsAvailable args = do
ready <- readIORef v_opt_C_ready
when ready $ ghcError (ProgramError "Too late for parseStaticFlags: call it before newSession")
- (leftover, errs, warns1) <- processArgs flagsAvailable args
+ (leftover, errs, warns) <- processArgs flagsAvailable args
when (not (null errs)) $ ghcError $ errorsToGhcException errs
- -- deal with the way flags: the way (eg. prof) gives rise to
- -- further flags, some of which might be static.
- way_flags <- getWayFlags
- let way_flags' = map (mkGeneralLocated "in way flags") way_flags
-
- -- as these are GHC generated flags, we parse them with all static flags
- -- in scope, regardless of what availableFlags are passed in.
- (more_leftover, errs, warns2) <- processArgs flagsStatic way_flags'
-
-- see sanity code in staticOpts
writeIORef v_opt_C_ready True
@@ -83,9 +73,7 @@ parseStaticFlagsFull flagsAvailable args = do
["-fexcess-precision"]
| otherwise = []
- when (not (null errs)) $ ghcError $ errorsToGhcException errs
- return (excess_prec ++ more_leftover ++ leftover,
- warns1 ++ warns2)
+ return (excess_prec ++ leftover, warns)
flagsStatic :: [Flag IO]
-- All the static flags should appear in this list. It describes how each
@@ -102,22 +90,8 @@ flagsStatic :: [Flag IO]
-- flags further down the list with the same prefix.
flagsStatic = [
- ------- ways --------------------------------------------------------
- Flag "prof" (NoArg (addWay WayProf))
- , Flag "eventlog" (NoArg (addWay WayEventLog))
- , Flag "parallel" (NoArg (addWay WayPar))
- , Flag "gransim" (NoArg (addWay WayGran))
- , Flag "smp" (NoArg (addWay WayThreaded >> deprecate "Use -threaded instead"))
- , Flag "debug" (NoArg (addWay WayDebug))
- , Flag "ndp" (NoArg (addWay WayNDP))
- , Flag "threaded" (NoArg (addWay WayThreaded))
-
- , Flag "ticky" (PassFlag (\f -> do addOpt f; addWay WayDebug))
- -- -ticky enables ticky-ticky code generation, and also implies -debug which
- -- is required to get the RTS ticky support.
-
------ Debugging ----------------------------------------------------
- , Flag "dppr-debug" (PassFlag addOpt)
+ Flag "dppr-debug" (PassFlag addOpt)
, Flag "dsuppress-all" (PassFlag addOpt)
, Flag "dsuppress-uniques" (PassFlag addOpt)
, Flag "dsuppress-coercions" (PassFlag addOpt)
@@ -131,12 +105,6 @@ flagsStatic = [
, Flag "dstub-dead-values" (PassFlag addOpt)
-- rest of the debugging flags are dynamic
- ----- Linker --------------------------------------------------------
- , Flag "static" (PassFlag addOpt)
- , Flag "dynamic" (NoArg (removeOpt "-static" >> addWay WayDyn))
- -- ignored for compat w/ gcc:
- , Flag "rdynamic" (NoArg (return ()))
-
----- RTS opts ------------------------------------------------------
, Flag "H" (HasArg (\s -> liftEwM (setHeapSize (fromIntegral (decodeSize s)))))
@@ -166,7 +134,6 @@ isStaticFlag f =
"fno-pre-inlining",
"fno-opt-coercion",
"fexcess-precision",
- "static",
"fhardwire-lib-paths",
"fcpr-off",
"ferror-spans",
@@ -203,9 +170,6 @@ type StaticP = EwM IO
addOpt :: String -> StaticP ()
addOpt = liftEwM . SF.addOpt
-addWay :: Way -> StaticP ()
-addWay = liftEwM . SF.addWay
-
removeOpt :: String -> StaticP ()
removeOpt = liftEwM . SF.removeOpt
diff --git a/compiler/main/StaticFlags.hs b/compiler/main/StaticFlags.hs
index ec5be5fa3b..34acd98b8a 100644
--- a/compiler/main/StaticFlags.hs
+++ b/compiler/main/StaticFlags.hs
@@ -23,9 +23,6 @@ module StaticFlags (
staticFlags,
initStaticOpts,
- -- Ways
- Way(..), v_Ways, mkBuildTag, wayRTSOnly,
-
-- Output style options
opt_PprStyle_Debug,
opt_NoDebugOutput,
@@ -66,18 +63,14 @@ module StaticFlags (
-- Optimization fuel controls
opt_Fuel,
- -- Related to linking
- opt_Static,
-
-- misc opts
opt_ErrorSpans,
opt_HistorySize,
v_Ld_inputs,
opt_StubDeadValues,
- opt_Ticky,
-- For the parser
- addOpt, removeOpt, addWay, getWayFlags, v_opt_C_ready,
+ addOpt, removeOpt, v_opt_C_ready,
-- Saving/restoring globals
saveStaticFlagGlobals, restoreStaticFlagGlobals
@@ -90,7 +83,7 @@ import Util
import Maybes ( firstJusts )
import Panic
-import Control.Monad ( liftM3 )
+import Control.Monad
import Data.IORef
import System.IO.Unsafe ( unsafePerformIO )
import Data.List
@@ -104,9 +97,6 @@ initStaticOpts = writeIORef v_opt_C_ready True
addOpt :: String -> IO ()
addOpt = consIORef v_opt_C
-addWay :: Way -> IO ()
-addWay = consIORef v_Ways
-
removeOpt :: String -> IO ()
removeOpt f = do
fs <- readIORef v_opt_C
@@ -119,7 +109,7 @@ lookup_str :: String -> Maybe String
-- holds the static opts while they're being collected, before
-- being unsafely read by unpacked_static_opts below.
-GLOBAL_VAR(v_opt_C, defaultStaticOpts, [String])
+GLOBAL_VAR(v_opt_C, [], [String])
GLOBAL_VAR(v_opt_C_ready, False, Bool)
staticFlags :: [String]
@@ -129,10 +119,6 @@ staticFlags = unsafePerformIO $ do
then panic "Static flags have not been initialised!\n Please call GHC.newSession or GHC.parseStaticFlags early enough."
else readIORef v_opt_C
--- -static is the default
-defaultStaticOpts :: [String]
-defaultStaticOpts = ["-static"]
-
packed_static_opts :: [FastString]
packed_static_opts = map mkFastString staticFlags
@@ -303,207 +289,16 @@ opt_UF_KeenessFactor = lookup_def_float "-funfolding-keeness-factor" (1.5::Fl
opt_UF_DearOp = ( 40 :: Int)
--- Related to linking
-opt_Static :: Bool
-opt_Static = lookUp (fsLit "-static")
-
-- Include full span info in error messages, instead of just the start position.
opt_ErrorSpans :: Bool
opt_ErrorSpans = lookUp (fsLit "-ferror-spans")
-opt_Ticky :: Bool
-opt_Ticky = lookUp (fsLit "-ticky")
-
-- object files and libraries to be linked in are collected here.
-- ToDo: perhaps this could be done without a global, it wasn't obvious
-- how to do it though --SDM.
GLOBAL_VAR(v_Ld_inputs, [], [String])
-----------------------------------------------------------------------------
--- Ways
-
--- The central concept of a "way" is that all objects in a given
--- program must be compiled in the same "way". Certain options change
--- parameters of the virtual machine, eg. profiling adds an extra word
--- to the object header, so profiling objects cannot be linked with
--- non-profiling objects.
-
--- After parsing the command-line options, we determine which "way" we
--- are building - this might be a combination way, eg. profiling+threaded.
-
--- We then find the "build-tag" associated with this way, and this
--- becomes the suffix used to find .hi files and libraries used in
--- this compilation.
-
-data Way
- = WayThreaded
- | WayDebug
- | WayProf
- | WayEventLog
- | WayPar
- | WayGran
- | WayNDP
- | WayDyn
- deriving (Eq,Ord)
-
-GLOBAL_VAR(v_Ways, [] ,[Way])
-
-allowed_combination :: [Way] -> Bool
-allowed_combination way = and [ x `allowedWith` y
- | x <- way, y <- way, x < y ]
- where
- -- Note ordering in these tests: the left argument is
- -- <= the right argument, according to the Ord instance
- -- on Way above.
-
- -- dyn is allowed with everything
- _ `allowedWith` WayDyn = True
- WayDyn `allowedWith` _ = True
-
- -- debug is allowed with everything
- _ `allowedWith` WayDebug = True
- WayDebug `allowedWith` _ = True
-
- WayProf `allowedWith` WayNDP = True
- WayThreaded `allowedWith` WayProf = True
- WayThreaded `allowedWith` WayEventLog = True
- _ `allowedWith` _ = False
-
-
-getWayFlags :: IO [String] -- new options
-getWayFlags = do
- unsorted <- readIORef v_Ways
- let ways = sort $ nub $ unsorted
- writeIORef v_Ways ways
-
- if not (allowed_combination ways)
- then ghcError (CmdLineError $
- "combination not supported: " ++
- foldr1 (\a b -> a ++ '/':b)
- (map wayDesc ways))
- else
- return (concatMap wayOpts ways)
-
-mkBuildTag :: [Way] -> String
-mkBuildTag ways = concat (intersperse "_" (map wayTag ways))
-
-wayTag :: Way -> String
-wayTag WayThreaded = "thr"
-wayTag WayDebug = "debug"
-wayTag WayDyn = "dyn"
-wayTag WayProf = "p"
-wayTag WayEventLog = "l"
-wayTag WayPar = "mp"
--- wayTag WayPar = "mt"
--- wayTag WayPar = "md"
-wayTag WayGran = "mg"
-wayTag WayNDP = "ndp"
-
-wayRTSOnly :: Way -> Bool
-wayRTSOnly WayThreaded = True
-wayRTSOnly WayDebug = True
-wayRTSOnly WayDyn = False
-wayRTSOnly WayProf = False
-wayRTSOnly WayEventLog = True
-wayRTSOnly WayPar = False
--- wayRTSOnly WayPar = False
--- wayRTSOnly WayPar = False
-wayRTSOnly WayGran = False
-wayRTSOnly WayNDP = False
-
-wayDesc :: Way -> String
-wayDesc WayThreaded = "Threaded"
-wayDesc WayDebug = "Debug"
-wayDesc WayDyn = "Dynamic"
-wayDesc WayProf = "Profiling"
-wayDesc WayEventLog = "RTS Event Logging"
-wayDesc WayPar = "Parallel"
--- wayDesc WayPar = "Parallel ticky profiling"
--- wayDesc WayPar = "Distributed"
-wayDesc WayGran = "GranSim"
-wayDesc WayNDP = "Nested data parallelism"
-
-wayOpts :: Way -> [String]
-wayOpts WayThreaded = [
-#if defined(freebsd_TARGET_OS)
--- "-optc-pthread"
--- , "-optl-pthread"
- -- FreeBSD's default threading library is the KSE-based M:N libpthread,
- -- which GHC has some problems with. It's currently not clear whether
- -- the problems are our fault or theirs, but it seems that using the
- -- alternative 1:1 threading library libthr works around it:
- "-optl-lthr"
-#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
- "-optc-pthread"
- , "-optl-pthread"
-#elif defined(solaris2_TARGET_OS)
- "-optl-lrt"
-#endif
- ]
-wayOpts WayDebug = []
-wayOpts WayDyn =
- [ "-DDYNAMIC"
- , "-optc-DDYNAMIC"
-#if defined(mingw32_TARGET_OS)
- -- On Windows, code that is to be linked into a dynamic library must be compiled
- -- with -fPIC. Labels not in the current package are assumed to be in a DLL
- -- different from the current one.
- , "-fPIC"
-#elif defined(openbsd_TARGET_OS) || defined(netbsd_TARGET_OS)
- -- Without this, linking the shared libHSffi fails because
- -- it uses pthread mutexes.
- , "-optl-pthread"
-#endif
- ]
-wayOpts WayProf =
- [ "-fscc-profiling"
- , "-DPROFILING"
- , "-optc-DPROFILING" ]
-wayOpts WayEventLog =
- [ "-DTRACING"
- , "-optc-DTRACING" ]
-wayOpts WayPar =
- [ "-fparallel"
- , "-D__PARALLEL_HASKELL__"
- , "-optc-DPAR"
- , "-package concurrent"
- , "-optc-w"
- , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
- , "-optl-lpvm3"
- , "-optl-lgpvm3" ]
-{-
-wayOpts WayPar =
- [ "-fparallel"
- , "-D__PARALLEL_HASKELL__"
- , "-optc-DPAR"
- , "-optc-DPAR_TICKY"
- , "-package concurrent"
- , "-optc-w"
- , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
- , "-optl-lpvm3"
- , "-optl-lgpvm3" ]
-wayOpts WayPar =
- [ "-fparallel"
- , "-D__PARALLEL_HASKELL__"
- , "-D__DISTRIBUTED_HASKELL__"
- , "-optc-DPAR"
- , "-optc-DDIST"
- , "-package concurrent"
- , "-optc-w"
- , "-optl-L${PVM_ROOT}/lib/${PVM_ARCH}"
- , "-optl-lpvm3"
- , "-optl-lgpvm3" ]
--}
-wayOpts WayGran =
- [ "-fgransim"
- , "-D__GRANSIM__"
- , "-optc-DGRAN"
- , "-package concurrent" ]
-wayOpts WayNDP =
- [ "-XParr"
- , "-fvectorise"]
-
------------------------------------------------------------------------------
-- Tunneling our global variables into a new instance of the GHC library
-- Ignore the v_Ld_inputs global because:
@@ -512,12 +307,11 @@ wayOpts WayNDP =
-- b) We can get away without sharing it because it only affects the link,
-- and is mutated by the GHC exe. Users who load up a new copy of the GHC
-- library while another is running almost certainly won't actually access it.
-saveStaticFlagGlobals :: IO (Bool, [String], [Way])
-saveStaticFlagGlobals = liftM3 (,,) (readIORef v_opt_C_ready) (readIORef v_opt_C) (readIORef v_Ways)
+saveStaticFlagGlobals :: IO (Bool, [String])
+saveStaticFlagGlobals = liftM2 (,) (readIORef v_opt_C_ready) (readIORef v_opt_C)
-restoreStaticFlagGlobals :: (Bool, [String], [Way]) -> IO ()
-restoreStaticFlagGlobals (c_ready, c, ways) = do
+restoreStaticFlagGlobals :: (Bool, [String]) -> IO ()
+restoreStaticFlagGlobals (c_ready, c) = do
writeIORef v_opt_C_ready c_ready
writeIORef v_opt_C c
- writeIORef v_Ways ways
diff --git a/compiler/main/TidyPgm.lhs b/compiler/main/TidyPgm.lhs
index bea9f14ee6..ffd5de809d 100644
--- a/compiler/main/TidyPgm.lhs
+++ b/compiler/main/TidyPgm.lhs
@@ -47,7 +47,6 @@ import Module
import Packages( isDllName )
import HscTypes
import Maybes
-import Platform
import UniqSupply
import ErrUtils (Severity(..))
import Outputable
@@ -1049,20 +1048,20 @@ tidyTopBinds hsc_env unfold_env init_occ_env binds
$ initTcForLookup hsc_env (tcLookupGlobal mkIntegerName)
return $ tidy mkIntegerId init_env binds
where
- platform = targetPlatform (hsc_dflags hsc_env)
+ dflags = hsc_dflags hsc_env
init_env = (init_occ_env, emptyVarEnv)
- this_pkg = thisPackage (hsc_dflags hsc_env)
+ this_pkg = thisPackage dflags
tidy _ env [] = (env, [])
- tidy mkIntegerId env (b:bs) = let (env1, b') = tidyTopBind platform this_pkg mkIntegerId unfold_env env b
+ tidy mkIntegerId env (b:bs) = let (env1, b') = tidyTopBind dflags this_pkg mkIntegerId unfold_env env b
(env2, bs') = tidy mkIntegerId env1 bs
in
(env2, b':bs')
------------------------
-tidyTopBind :: Platform
+tidyTopBind :: DynFlags
-> PackageId
-> Id
-> UnfoldEnv
@@ -1070,16 +1069,16 @@ tidyTopBind :: Platform
-> CoreBind
-> (TidyEnv, CoreBind)
-tidyTopBind platform this_pkg mkIntegerId unfold_env (occ_env,subst1) (NonRec bndr rhs)
+tidyTopBind dflags this_pkg mkIntegerId unfold_env (occ_env,subst1) (NonRec bndr rhs)
= (tidy_env2, NonRec bndr' rhs')
where
Just (name',show_unfold) = lookupVarEnv unfold_env bndr
- caf_info = hasCafRefs platform this_pkg (mkIntegerId, subst1) (idArity bndr) rhs
+ caf_info = hasCafRefs dflags this_pkg (mkIntegerId, subst1) (idArity bndr) rhs
(bndr', rhs') = tidyTopPair show_unfold tidy_env2 caf_info name' (bndr, rhs)
subst2 = extendVarEnv subst1 bndr bndr'
tidy_env2 = (occ_env, subst2)
-tidyTopBind platform this_pkg mkIntegerId unfold_env (occ_env,subst1) (Rec prs)
+tidyTopBind dflags this_pkg mkIntegerId unfold_env (occ_env,subst1) (Rec prs)
= (tidy_env2, Rec prs')
where
prs' = [ tidyTopPair show_unfold tidy_env2 caf_info name' (id,rhs)
@@ -1096,7 +1095,7 @@ tidyTopBind platform this_pkg mkIntegerId unfold_env (occ_env,subst1) (Rec prs)
-- the CafInfo for a recursive group says whether *any* rhs in
-- the group may refer indirectly to a CAF (because then, they all do).
caf_info
- | or [ mayHaveCafRefs (hasCafRefs platform this_pkg (mkIntegerId, subst1) (idArity bndr) rhs)
+ | or [ mayHaveCafRefs (hasCafRefs dflags this_pkg (mkIntegerId, subst1) (idArity bndr) rhs)
| (bndr,rhs) <- prs ] = MayHaveCafRefs
| otherwise = NoCafRefs
@@ -1233,15 +1232,15 @@ it as a CAF. In these cases however, we would need to use an additional
CAF list to keep track of non-collectable CAFs.
\begin{code}
-hasCafRefs :: Platform -> PackageId -> (Id, VarEnv Var) -> Arity -> CoreExpr
+hasCafRefs :: DynFlags -> PackageId -> (Id, VarEnv Var) -> Arity -> CoreExpr
-> CafInfo
-hasCafRefs platform this_pkg p arity expr
+hasCafRefs dflags this_pkg p arity expr
| is_caf || mentions_cafs = MayHaveCafRefs
| otherwise = NoCafRefs
where
mentions_cafs = isFastTrue (cafRefsE p expr)
- is_dynamic_name = isDllName this_pkg
- is_caf = not (arity > 0 || rhsIsStatic platform is_dynamic_name expr)
+ is_dynamic_name = isDllName dflags this_pkg
+ is_caf = not (arity > 0 || rhsIsStatic (targetPlatform dflags) is_dynamic_name expr)
-- NB. we pass in the arity of the expression, which is expected
-- to be calculated by exprArity. This is because exprArity
diff --git a/compiler/nativeGen/PIC.hs b/compiler/nativeGen/PIC.hs
index fb75d87c77..0b5ffcd0d1 100644
--- a/compiler/nativeGen/PIC.hs
+++ b/compiler/nativeGen/PIC.hs
@@ -75,7 +75,6 @@ import CLabel ( CLabel, ForeignLabelSource(..), pprCLabel,
import CLabel ( mkForeignLabel )
-import StaticFlags ( opt_Static )
import BasicTypes
import Outputable
@@ -161,7 +160,7 @@ cmmMakePicReference dflags lbl
= CmmLit $ CmmLabel lbl
- | (dopt Opt_PIC dflags || not opt_Static) && absoluteLabel lbl
+ | (dopt Opt_PIC dflags || not (dopt Opt_Static dflags)) && absoluteLabel lbl
= CmmMachOp (MO_Add wordWidth)
[ CmmReg (CmmGlobal PicBaseReg)
, CmmLit $ picRelative
@@ -214,14 +213,14 @@ howToAccessLabel
-- To access the function at SYMBOL from our local module, we just need to
-- dereference the local __imp_SYMBOL.
--
--- If opt_Static is set then we assume that all our code will be linked
+-- If Opt_Static is set then we assume that all our code will be linked
-- into the same .exe file. In this case we always access symbols directly,
-- and never use __imp_SYMBOL.
--
howToAccessLabel dflags _ OSMinGW32 _ lbl
-- Assume all symbols will be in the same PE, so just access them directly.
- | opt_Static
+ | dopt Opt_Static dflags
= AccessDirectly
-- If the target symbol is in another PE we need to access it via the
@@ -307,7 +306,7 @@ howToAccessLabel dflags _ os _ _
-- if we don't dynamically link to Haskell code,
-- it actually manages to do so without messing thins up.
| osElfTarget os
- , not (dopt Opt_PIC dflags) && opt_Static
+ , not (dopt Opt_PIC dflags) && dopt Opt_Static dflags
= AccessDirectly
howToAccessLabel dflags arch os DataReference lbl
@@ -429,12 +428,12 @@ needImportedSymbols dflags arch os
-- PowerPC Linux: -fPIC or -dynamic
| osElfTarget os
, arch == ArchPPC
- = dopt Opt_PIC dflags || not opt_Static
+ = dopt Opt_PIC dflags || not (dopt Opt_Static dflags)
-- i386 (and others?): -dynamic but not -fPIC
| osElfTarget os
, arch /= ArchPPC_64
- = not opt_Static && not (dopt Opt_PIC dflags)
+ = not (dopt Opt_Static dflags) && not (dopt Opt_PIC dflags)
| otherwise
= False
@@ -623,7 +622,7 @@ pprImportedSymbol _ (Platform { platformOS = OSDarwin }) _
-- section.
-- The "official" GOT mechanism (label@got) isn't intended to be used
-- in position dependent code, so we have to create our own "fake GOT"
--- when not Opt_PIC && not opt_Static.
+-- when not Opt_PIC && not (dopt Opt_Static dflags).
--
-- 2) PowerPC Linux is just plain broken.
-- While it's theoretically possible to use GOT offsets larger
diff --git a/compiler/simplCore/CoreMonad.lhs b/compiler/simplCore/CoreMonad.lhs
index b1429c5dbf..5c97fbdbf3 100644
--- a/compiler/simplCore/CoreMonad.lhs
+++ b/compiler/simplCore/CoreMonad.lhs
@@ -720,7 +720,7 @@ data CoreReader = CoreReader {
cr_hsc_env :: HscEnv,
cr_rule_base :: RuleBase,
cr_module :: Module,
- cr_globals :: ((Bool, [String], [Way]),
+ cr_globals :: ((Bool, [String]),
#ifdef GHCI
(MVar PersistentLinkerState, Bool))
#else
diff --git a/compiler/stgSyn/StgSyn.lhs b/compiler/stgSyn/StgSyn.lhs
index 84a4c69af9..e5c525e4c3 100644
--- a/compiler/stgSyn/StgSyn.lhs
+++ b/compiler/stgSyn/StgSyn.lhs
@@ -106,14 +106,14 @@ data GenStgArg occ
isDllConApp :: DynFlags -> DataCon -> [StgArg] -> Bool
isDllConApp dflags con args
| platformOS (targetPlatform dflags) == OSMinGW32
- = isDllName this_pkg (dataConName con) || any is_dll_arg args
+ = isDllName dflags this_pkg (dataConName con) || any is_dll_arg args
| otherwise = False
where
-- NB: typePrimRep is legit because any free variables won't have
-- unlifted type (there are no unlifted things at top level)
is_dll_arg :: StgArg -> Bool
is_dll_arg (StgVarArg v) = isAddrRep (typePrimRep (idType v))
- && isDllName this_pkg (idName v)
+ && isDllName dflags this_pkg (idName v)
is_dll_arg _ = False
this_pkg = thisPackage dflags