Commit f2e730f3 authored by simonmar's avatar simonmar
Browse files

[project @ 2005-10-28 15:22:39 by simonmar]

Add -stubdir option to control location of generated stub files.  Also
do some clean up while I'm here - remove hscStubCOut/hscStubHOut from
DynFlags, and add

  mkStubPaths :: DynFlags -> Module -> ModLocation -> (FilePath,FilePath)

to Finder.  (this seemed better than caching the stub paths in every
ModLocation, because they are rarely needed and only present in home
modules, and are easily calculated from other available information).

-stubdir behaves in exactly the same way as -odir and -hidir.
parent 55495951
...@@ -23,11 +23,11 @@ import qualified PrintJava ...@@ -23,11 +23,11 @@ import qualified PrintJava
import OccurAnal ( occurAnalyseBinds ) import OccurAnal ( occurAnalyseBinds )
#endif #endif
import Distribution.Package ( showPackageId ) import Finder ( mkStubPaths )
import PprC ( writeCs ) import PprC ( writeCs )
import CmmLint ( cmmLint ) import CmmLint ( cmmLint )
import Packages import Packages
import Util ( filenameOf ) import Util
import FastString ( unpackFS ) import FastString ( unpackFS )
import Cmm ( Cmm ) import Cmm ( Cmm )
import HscTypes import HscTypes
...@@ -35,10 +35,11 @@ import DynFlags ...@@ -35,10 +35,11 @@ import DynFlags
import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit ) import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit )
import Outputable import Outputable
import Pretty ( Mode(..), printDoc ) import Pretty ( Mode(..), printDoc )
import Module ( Module ) import Module ( Module, ModLocation(..) )
import List ( nub ) import List ( nub )
import Maybes ( firstJust ) import Maybes ( firstJust )
import Distribution.Package ( showPackageId )
import Directory ( doesFileExist ) import Directory ( doesFileExist )
import Monad ( when ) import Monad ( when )
import IO import IO
...@@ -53,12 +54,13 @@ import IO ...@@ -53,12 +54,13 @@ import IO
\begin{code} \begin{code}
codeOutput :: DynFlags codeOutput :: DynFlags
-> Module -> Module
-> ModLocation
-> ForeignStubs -> ForeignStubs
-> [PackageId] -> [PackageId]
-> [Cmm] -- Compiled C-- -> [Cmm] -- Compiled C--
-> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-}) -> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-})
codeOutput dflags this_mod foreign_stubs pkg_deps flat_abstractC codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC
= =
-- You can have C (c_output) or assembly-language (ncg_output), -- You can have C (c_output) or assembly-language (ncg_output),
-- but not both. [Allowing for both gives a space leak on -- but not both. [Allowing for both gives a space leak on
...@@ -78,12 +80,13 @@ codeOutput dflags this_mod foreign_stubs pkg_deps flat_abstractC ...@@ -78,12 +80,13 @@ codeOutput dflags this_mod foreign_stubs pkg_deps flat_abstractC
; showPass dflags "CodeOutput" ; showPass dflags "CodeOutput"
; let filenm = hscOutName dflags ; let filenm = hscOutName dflags
; stubs_exist <- outputForeignStubs dflags foreign_stubs ; stubs_exist <- outputForeignStubs dflags this_mod location foreign_stubs
; case hscTarget dflags of { ; case hscTarget dflags of {
HscInterpreted -> return (); HscInterpreted -> return ();
HscAsm -> outputAsm dflags filenm flat_abstractC; HscAsm -> outputAsm dflags filenm flat_abstractC;
HscC -> outputC dflags filenm flat_abstractC stubs_exist HscC -> outputC dflags filenm this_mod location
pkg_deps foreign_stubs; flat_abstractC stubs_exist pkg_deps
foreign_stubs;
HscJava -> HscJava ->
#ifdef JAVA #ifdef JAVA
outputJava dflags filenm mod_name tycons core_binds; outputJava dflags filenm mod_name tycons core_binds;
...@@ -113,7 +116,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action ...@@ -113,7 +116,7 @@ doOutput filenm io_action = bracket (openFile filenm WriteMode) hClose io_action
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
outputC dflags filenm flat_absC outputC dflags filenm mod location flat_absC
(stub_h_exists, _) packages foreign_stubs (stub_h_exists, _) packages foreign_stubs
= do = do
-- figure out which header files to #include in the generated .hc file: -- figure out which header files to #include in the generated .hc file:
...@@ -150,8 +153,10 @@ outputC dflags filenm flat_absC ...@@ -150,8 +153,10 @@ outputC dflags filenm flat_absC
hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n") hPutStr h ("/* GHC_PACKAGES " ++ unwords pkg_names ++ "\n*/\n")
hPutStr h cc_injects hPutStr h cc_injects
when stub_h_exists $ when stub_h_exists $
hPutStrLn h ("#include \"" ++ (filenameOf (hscStubHOutName dflags)) ++ "\"") hPutStrLn h ("#include \"" ++ (filenameOf stub_h) ++ "\"")
writeCs dflags h flat_absC writeCs dflags h flat_absC
where
(_, stub_h) = mkStubPaths dflags mod location
\end{code} \end{code}
...@@ -226,17 +231,30 @@ outputIlx dflags filename mod tycons stg_binds ...@@ -226,17 +231,30 @@ outputIlx dflags filename mod tycons stg_binds
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
outputForeignStubs :: DynFlags -> ForeignStubs outputForeignStubs :: DynFlags -> Module -> ModLocation -> ForeignStubs
-> IO (Bool, -- Header file created -> IO (Bool, -- Header file created
Bool) -- C file created Bool) -- C file created
outputForeignStubs dflags NoStubs = do outputForeignStubs dflags mod location stubs
-- When compiling External Core files, may need to use stub files from a | NoStubs <- stubs = do
-- previous compilation -- When compiling External Core files, may need to use stub
hFileExists <- doesFileExist (hscStubHOutName dflags) -- files from a previous compilation
cFileExists <- doesFileExist (hscStubCOutName dflags) stub_c_exists <- doesFileExist stub_c
return (hFileExists, cFileExists) stub_h_exists <- doesFileExist stub_h
outputForeignStubs dflags (ForeignStubs h_code c_code _ _) return (stub_h_exists, stub_c_exists)
| ForeignStubs h_code c_code _ _ <- stubs
= do = do
let
stub_c_output_d = pprCode CStyle c_code
stub_c_output_w = showSDoc stub_c_output_d
-- Header file protos for "foreign export"ed functions.
stub_h_output_d = pprCode CStyle h_code
stub_h_output_w = showSDoc stub_h_output_d
-- in
createDirectoryHierarchy (directoryOf stub_c)
dumpIfSet_dyn dflags Opt_D_dump_foreign dumpIfSet_dyn dflags Opt_D_dump_foreign
"Foreign export header file" stub_h_output_d "Foreign export header file" stub_h_output_d
...@@ -250,14 +268,14 @@ outputForeignStubs dflags (ForeignStubs h_code c_code _ _) ...@@ -250,14 +268,14 @@ outputForeignStubs dflags (ForeignStubs h_code c_code _ _)
mk_include i = "#include \"" ++ i ++ "\"\n" mk_include i = "#include \"" ++ i ++ "\"\n"
stub_h_file_exists stub_h_file_exists
<- outputForeignStubs_help (hscStubHOutName dflags) stub_h_output_w <- outputForeignStubs_help stub_h stub_h_output_w
("#include \"HsFFI.h\"\n" ++ cplusplus_hdr) cplusplus_ftr ("#include \"HsFFI.h\"\n" ++ cplusplus_hdr) cplusplus_ftr
dumpIfSet_dyn dflags Opt_D_dump_foreign dumpIfSet_dyn dflags Opt_D_dump_foreign
"Foreign export stubs" stub_c_output_d "Foreign export stubs" stub_c_output_d
stub_c_file_exists stub_c_file_exists
<- outputForeignStubs_help (hscStubCOutName dflags) stub_c_output_w <- outputForeignStubs_help stub_c stub_c_output_w
("#define IN_STG_CODE 0\n" ++ ("#define IN_STG_CODE 0\n" ++
"#include \"Rts.h\"\n" ++ "#include \"Rts.h\"\n" ++
rts_includes ++ rts_includes ++
...@@ -269,13 +287,7 @@ outputForeignStubs dflags (ForeignStubs h_code c_code _ _) ...@@ -269,13 +287,7 @@ outputForeignStubs dflags (ForeignStubs h_code c_code _ _)
return (stub_h_file_exists, stub_c_file_exists) return (stub_h_file_exists, stub_c_file_exists)
where where
-- C stubs for "foreign export"ed functions. (stub_c, stub_h) = mkStubPaths dflags mod location
stub_c_output_d = pprCode CStyle c_code
stub_c_output_w = showSDoc stub_c_output_d
-- Header file protos for "foreign export"ed functions.
stub_h_output_d = pprCode CStyle h_code
stub_h_output_w = showSDoc stub_h_output_d
cplusplus_hdr = "#ifdef __cplusplus\nextern \"C\" {\n#endif\n" cplusplus_hdr = "#ifdef __cplusplus\nextern \"C\" {\n#endif\n"
cplusplus_ftr = "#ifdef __cplusplus\n}\n#endif\n" cplusplus_ftr = "#ifdef __cplusplus\n}\n#endif\n"
......
...@@ -157,8 +157,6 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do ...@@ -157,8 +157,6 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
let dflags' = dflags { hscTarget = hsc_lang, let dflags' = dflags { hscTarget = hsc_lang,
hscOutName = output_fn, hscOutName = output_fn,
hscStubCOutName = basename ++ "_stub.c",
hscStubHOutName = basename ++ "_stub.h",
extCoreName = basename ++ ".hcr" } extCoreName = basename ++ ".hcr" }
-- -no-recomp should also work with --make -- -no-recomp should also work with --make
...@@ -192,7 +190,7 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do ...@@ -192,7 +190,7 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
-> do -> do
stub_unlinked <- stub_unlinked <-
if stub_c_exists then do if stub_c_exists then do
stub_o <- compileStub dflags' object_filename stub_o <- compileStub dflags' this_mod location
return [ DotO stub_o ] return [ DotO stub_o ]
else else
return [] return []
...@@ -235,8 +233,9 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do ...@@ -235,8 +233,9 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
-- stub .h and .c files (for foreign export support) -- stub .h and .c files (for foreign export support)
-- The _stub.c file is derived from the haskell source file (but stored -- The _stub.c file is derived from the haskell source file, possibly taking
-- in hscStubCOutName in the dflags for some reason, probably historical). -- into account the -stubdir option.
--
-- Consequently, we derive the _stub.o filename from the haskell object -- Consequently, we derive the _stub.o filename from the haskell object
-- filename. -- filename.
-- --
...@@ -250,12 +249,13 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do ...@@ -250,12 +249,13 @@ compile hsc_env mod_summary maybe_old_linkable old_iface mod_index nmods = do
-- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want -- -odir obj, we would get obj/src/A_stub.o, which is wrong; we want
-- obj/A_stub.o. -- obj/A_stub.o.
compileStub dflags object_filename = do compileStub :: DynFlags -> Module -> ModLocation -> IO FilePath
let (o_base, o_ext) = splitFilename object_filename compileStub dflags mod location = do
let (o_base, o_ext) = splitFilename (ml_obj_file location)
stub_o = o_base ++ "_stub" `joinFileExt` o_ext stub_o = o_base ++ "_stub" `joinFileExt` o_ext
-- compile the _stub.c file w/ gcc -- compile the _stub.c file w/ gcc
let stub_c = hscStubCOutName dflags let (stub_c,_) = mkStubPaths dflags mod location
runPipeline StopLn dflags (stub_c,Nothing) runPipeline StopLn dflags (stub_c,Nothing)
(SpecificFile stub_o) Nothing{-no ModLocation-} (SpecificFile stub_o) Nothing{-no ModLocation-}
...@@ -509,7 +509,7 @@ getOutputFilename dflags stop_phase output basename ...@@ -509,7 +509,7 @@ getOutputFilename dflags stop_phase output basename
= func = func
where where
hcsuf = hcSuf dflags hcsuf = hcSuf dflags
odir = outputDir dflags odir = objectDir dflags
osuf = objectSuf dflags osuf = objectSuf dflags
keep_hc = dopt Opt_KeepHcFiles dflags keep_hc = dopt Opt_KeepHcFiles dflags
keep_raw_s = dopt Opt_KeepRawSFiles dflags keep_raw_s = dopt Opt_KeepRawSFiles dflags
...@@ -742,8 +742,6 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma ...@@ -742,8 +742,6 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
let dflags' = dflags { hscTarget = hsc_lang, let dflags' = dflags { hscTarget = hsc_lang,
hscOutName = output_fn, hscOutName = output_fn,
hscStubCOutName = basename ++ "_stub.c",
hscStubHOutName = basename ++ "_stub.h",
extCoreName = basename ++ ".hcr" } extCoreName = basename ++ ".hcr" }
hsc_env <- newHscEnv dflags' hsc_env <- newHscEnv dflags'
...@@ -774,7 +772,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma ...@@ -774,7 +772,7 @@ runPhase (Hsc src_flavour) stop dflags0 basename suff input_fn get_output_fn _ma
_maybe_interpreted_code -> do _maybe_interpreted_code -> do
when stub_c_exists $ do when stub_c_exists $ do
stub_o <- compileStub dflags' o_file stub_o <- compileStub dflags' mod_name location4
consIORef v_Ld_inputs stub_o consIORef v_Ld_inputs stub_o
-- In the case of hs-boot files, generate a dummy .o-boot -- In the case of hs-boot files, generate a dummy .o-boot
...@@ -802,8 +800,6 @@ runPhase Cmm stop dflags basename suff input_fn get_output_fn maybe_loc ...@@ -802,8 +800,6 @@ runPhase Cmm stop dflags basename suff input_fn get_output_fn maybe_loc
let dflags' = dflags { hscTarget = hsc_lang, let dflags' = dflags { hscTarget = hsc_lang,
hscOutName = output_fn, hscOutName = output_fn,
hscStubCOutName = basename ++ "_stub.c",
hscStubHOutName = basename ++ "_stub.h",
extCoreName = basename ++ ".hcr" } extCoreName = basename ++ ".hcr" }
ok <- hscCmmFile dflags' input_fn ok <- hscCmmFile dflags' input_fn
...@@ -969,7 +965,7 @@ runPhase SplitAs stop dflags basename _suff _input_fn get_output_fn maybe_loc ...@@ -969,7 +965,7 @@ runPhase SplitAs stop dflags basename _suff _input_fn get_output_fn maybe_loc
(split_s_prefix, n) <- readIORef v_Split_info (split_s_prefix, n) <- readIORef v_Split_info
let real_odir let real_odir
| Just d <- outputDir dflags = d | Just d <- objectDir dflags = d
| otherwise = basename ++ "_split" | otherwise = basename ++ "_split"
let assemble_file n let assemble_file n
......
...@@ -194,8 +194,6 @@ data DynFlags = DynFlags { ...@@ -194,8 +194,6 @@ data DynFlags = DynFlags {
stgToDo :: Maybe [StgToDo], -- similarly stgToDo :: Maybe [StgToDo], -- similarly
hscTarget :: HscTarget, hscTarget :: HscTarget,
hscOutName :: String, -- name of the output file hscOutName :: String, -- name of the output file
hscStubHOutName :: String, -- name of the .stub_h output file
hscStubCOutName :: String, -- name of the .stub_c output file
extCoreName :: String, -- name of the .core output file extCoreName :: String, -- name of the .core output file
verbosity :: Int, -- verbosity level verbosity :: Int, -- verbosity level
optLevel :: Int, -- optimisation level optLevel :: Int, -- optimisation level
...@@ -213,13 +211,17 @@ data DynFlags = DynFlags { ...@@ -213,13 +211,17 @@ data DynFlags = DynFlags {
rtsBuildTag :: String, -- the RTS "way" rtsBuildTag :: String, -- the RTS "way"
-- paths etc. -- paths etc.
outputDir :: Maybe String, objectDir :: Maybe String,
outputFile :: Maybe String, hiDir :: Maybe String,
outputHi :: Maybe String, stubDir :: Maybe String,
objectSuf :: String, objectSuf :: String,
hcSuf :: String, hcSuf :: String,
hiDir :: Maybe String,
hiSuf :: String, hiSuf :: String,
outputFile :: Maybe String,
outputHi :: Maybe String,
includePaths :: [String], includePaths :: [String],
libraryPaths :: [String], libraryPaths :: [String],
frameworkPaths :: [String], -- used on darwin only frameworkPaths :: [String], -- used on darwin only
...@@ -326,8 +328,6 @@ defaultDynFlags = ...@@ -326,8 +328,6 @@ defaultDynFlags =
stgToDo = Nothing, stgToDo = Nothing,
hscTarget = defaultHscTarget, hscTarget = defaultHscTarget,
hscOutName = "", hscOutName = "",
hscStubHOutName = "",
hscStubCOutName = "",
extCoreName = "", extCoreName = "",
verbosity = 0, verbosity = 0,
optLevel = 0, optLevel = 0,
...@@ -343,13 +343,16 @@ defaultDynFlags = ...@@ -343,13 +343,16 @@ defaultDynFlags =
buildTag = panic "buildTag", buildTag = panic "buildTag",
rtsBuildTag = panic "rtsBuildTag", rtsBuildTag = panic "rtsBuildTag",
outputDir = Nothing, objectDir = Nothing,
outputFile = Nothing, hiDir = Nothing,
outputHi = Nothing, stubDir = Nothing,
objectSuf = phaseInputExt StopLn, objectSuf = phaseInputExt StopLn,
hcSuf = phaseInputExt HCc, hcSuf = phaseInputExt HCc,
hiDir = Nothing,
hiSuf = "hi", hiSuf = "hi",
outputFile = Nothing,
outputHi = Nothing,
includePaths = [], includePaths = [],
libraryPaths = [], libraryPaths = [],
frameworkPaths = [], frameworkPaths = [],
...@@ -442,13 +445,16 @@ getVerbFlag dflags ...@@ -442,13 +445,16 @@ getVerbFlag dflags
| verbosity dflags >= 3 = "-v" | verbosity dflags >= 3 = "-v"
| otherwise = "" | otherwise = ""
setOutputDir f d = d{ outputDir = f} setObjectDir f d = d{ objectDir = f}
setOutputFile f d = d{ outputFile = f} setHiDir f d = d{ hiDir = f}
setOutputHi f d = d{ outputHi = f} setStubDir f d = d{ stubDir = f}
setObjectSuf f d = d{ objectSuf = f} setObjectSuf f d = d{ objectSuf = f}
setHcSuf f d = d{ hcSuf = f}
setHiSuf f d = d{ hiSuf = f} setHiSuf f d = d{ hiSuf = f}
setHiDir f d = d{ hiDir = f} setHcSuf f d = d{ hcSuf = f}
setOutputFile f d = d{ outputFile = f}
setOutputHi f d = d{ outputHi = f}
-- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"] -- XXX HACK: Prelude> words "'does not' work" ===> ["'does","not'","work"]
-- Config.hs should really use Option. -- Config.hs should really use Option.
...@@ -805,7 +811,7 @@ dynamic_flags = [ ...@@ -805,7 +811,7 @@ dynamic_flags = [
, ( "framework" , HasArg (upd . addCmdlineFramework) ) , ( "framework" , HasArg (upd . addCmdlineFramework) )
------- Output Redirection ------------------------------------------ ------- Output Redirection ------------------------------------------
, ( "odir" , HasArg (upd . setOutputDir . Just)) , ( "odir" , HasArg (upd . setObjectDir . Just))
, ( "o" , SepArg (upd . setOutputFile . Just)) , ( "o" , SepArg (upd . setOutputFile . Just))
, ( "ohi" , HasArg (upd . setOutputHi . Just )) , ( "ohi" , HasArg (upd . setOutputHi . Just ))
, ( "osuf" , HasArg (upd . setObjectSuf)) , ( "osuf" , HasArg (upd . setObjectSuf))
...@@ -813,6 +819,7 @@ dynamic_flags = [ ...@@ -813,6 +819,7 @@ dynamic_flags = [
, ( "hisuf" , HasArg (upd . setHiSuf)) , ( "hisuf" , HasArg (upd . setHiSuf))
, ( "hidir" , HasArg (upd . setHiDir . Just)) , ( "hidir" , HasArg (upd . setHiDir . Just))
, ( "tmpdir" , HasArg (upd . setTmpDir)) , ( "tmpdir" , HasArg (upd . setTmpDir))
, ( "stubdir" , HasArg (upd . setStubDir . Just))
------- Keeping temporary files ------------------------------------- ------- Keeping temporary files -------------------------------------
, ( "keep-hc-file" , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles)) , ( "keep-hc-file" , AnySuffix (\_ -> setDynFlag Opt_KeepHcFiles))
......
...@@ -13,6 +13,7 @@ module Finder ( ...@@ -13,6 +13,7 @@ module Finder (
mkHomeModLocation2, -- :: ModuleName -> FilePath -> String -> IO ModLocation mkHomeModLocation2, -- :: ModuleName -> FilePath -> String -> IO ModLocation
addHomeModuleToFinder, -- :: HscEnv -> Module -> ModLocation -> IO () addHomeModuleToFinder, -- :: HscEnv -> Module -> ModLocation -> IO ()
uncacheModule, -- :: HscEnv -> Module -> IO () uncacheModule, -- :: HscEnv -> Module -> IO ()
mkStubPaths,
findObjectLinkableMaybe, findObjectLinkableMaybe,
findObjectLinkable, findObjectLinkable,
...@@ -30,6 +31,7 @@ import FastString ...@@ -30,6 +31,7 @@ import FastString
import Util import Util
import DynFlags ( DynFlags(..), isOneShot, GhcMode(..) ) import DynFlags ( DynFlags(..), isOneShot, GhcMode(..) )
import Outputable import Outputable
import Maybes ( expectJust )
import DATA_IOREF ( IORef, writeIORef, readIORef ) import DATA_IOREF ( IORef, writeIORef, readIORef )
...@@ -347,8 +349,8 @@ mkHomeModLocation2 :: DynFlags ...@@ -347,8 +349,8 @@ mkHomeModLocation2 :: DynFlags
mkHomeModLocation2 dflags mod src_basename ext = do mkHomeModLocation2 dflags mod src_basename ext = do
let mod_basename = dots_to_slashes (moduleUserString mod) let mod_basename = dots_to_slashes (moduleUserString mod)
obj_fn <- mkObjPath dflags src_basename mod_basename obj_fn <- mkObjPath dflags src_basename mod_basename
hi_fn <- mkHiPath dflags src_basename mod_basename hi_fn <- mkHiPath dflags src_basename mod_basename
return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext), return (ModLocation{ ml_hs_file = Just (src_basename `joinFileExt` ext),
ml_hi_file = hi_fn, ml_hi_file = hi_fn,
...@@ -357,7 +359,7 @@ mkHomeModLocation2 dflags mod src_basename ext = do ...@@ -357,7 +359,7 @@ mkHomeModLocation2 dflags mod src_basename ext = do
hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation hiOnlyModLocation :: DynFlags -> FilePath -> String -> Suffix -> IO ModLocation
hiOnlyModLocation dflags path basename hisuf hiOnlyModLocation dflags path basename hisuf
= do let full_basename = path `joinFileName` basename = do let full_basename = path `joinFileName` basename
obj_fn <- mkObjPath dflags full_basename basename obj_fn <- mkObjPath dflags full_basename basename
return ModLocation{ ml_hs_file = Nothing, return ModLocation{ ml_hs_file = Nothing,
ml_hi_file = full_basename `joinFileExt` hisuf, ml_hi_file = full_basename `joinFileExt` hisuf,
-- Remove the .hi-boot suffix from -- Remove the .hi-boot suffix from
...@@ -376,7 +378,7 @@ mkObjPath ...@@ -376,7 +378,7 @@ mkObjPath
-> IO FilePath -> IO FilePath
mkObjPath dflags basename mod_basename mkObjPath dflags basename mod_basename
= do let = do let
odir = outputDir dflags odir = objectDir dflags
osuf = objectSuf dflags osuf = objectSuf dflags
obj_basename | Just dir <- odir = dir `joinFileName` mod_basename obj_basename | Just dir <- odir = dir `joinFileName` mod_basename
...@@ -402,6 +404,36 @@ mkHiPath dflags basename mod_basename ...@@ -402,6 +404,36 @@ mkHiPath dflags basename mod_basename
return (hi_basename `joinFileExt` hisuf) return (hi_basename `joinFileExt` hisuf)
-- -----------------------------------------------------------------------------
-- Filenames of the stub files
-- We don't have to store these in ModLocations, because they can be derived
-- from other available information, and they're only rarely needed.
mkStubPaths
:: DynFlags
-> Module
-> ModLocation
-> (FilePath,FilePath)
mkStubPaths dflags mod location
= let
stubdir = stubDir dflags
mod_basename = dots_to_slashes (moduleUserString mod)
src_basename = basenameOf (expectJust "mkStubPaths"
(ml_hs_file location))
stub_basename0
| Just dir <- stubdir = dir `joinFileName` mod_basename
| otherwise = src_basename
stub_basename = stub_basename0 ++ "_stub"
in
(stub_basename `joinFileExt` "c",
stub_basename `joinFileExt` "h")
-- the _stub.o filename is derived from the ml_obj_file.
-- ----------------------------------------------------------------------------- -- -----------------------------------------------------------------------------
-- findLinkable isn't related to the other stuff in here, -- findLinkable isn't related to the other stuff in here,
-- but there's no other obvious place for it -- but there's no other obvious place for it
......
...@@ -456,7 +456,7 @@ hscBackEnd hsc_env mod_summary maybe_old_iface (Just ds_result) ...@@ -456,7 +456,7 @@ hscBackEnd hsc_env mod_summary maybe_old_iface (Just ds_result)
------------------- -------------------
-- CONVERT TO STG and COMPLETE CODE GENERATION -- CONVERT TO STG and COMPLETE CODE GENERATION
; (stub_h_exists, stub_c_exists, maybe_bcos) ; (stub_h_exists, stub_c_exists, maybe_bcos)
<- hscCodeGen dflags cg_guts <- hscCodeGen dflags (ms_location mod_summary) cg_guts
-- And the answer is ... -- And the answer is ...
; dumpIfaceStats hsc_env ; dumpIfaceStats hsc_env
...@@ -469,7 +469,7 @@ hscBackEnd hsc_env mod_summary maybe_old_iface (Just ds_result) ...@@ -469,7 +469,7 @@ hscBackEnd hsc_env mod_summary maybe_old_iface (Just ds_result)
hscCodeGen dflags hscCodeGen dflags location
CgGuts{ -- This is the last use of the ModGuts in a compilation. CgGuts{ -- This is the last use of the ModGuts in a compilation.
-- From now on, we just use the bits we need. -- From now on, we just use the bits we need.
cg_module = this_mod, cg_module = this_mod,
...@@ -500,7 +500,7 @@ hscCodeGen dflags ...@@ -500,7 +500,7 @@ hscCodeGen dflags
------------------ Create f-x-dynamic C-side stuff --- ------------------ Create f-x-dynamic C-side stuff ---
(istub_h_exists, istub_c_exists) (istub_h_exists, istub_c_exists)
<- outputForeignStubs dflags foreign_stubs <- outputForeignStubs dflags this_mod location foreign_stubs
return ( istub_h_exists, istub_c_exists, Just comp_bc ) return ( istub_h_exists, istub_c_exists, Just comp_bc )
#else #else
...@@ -521,7 +521,7 @@ hscCodeGen dflags ...@@ -521,7 +521,7 @@ hscCodeGen dflags
------------------ Code output ----------------------- ------------------ Code output -----------------------
(stub_h_exists, stub_c_exists) (stub_h_exists, stub_c_exists)
<- codeOutput dflags this_mod foreign_stubs <- codeOutput dflags this_mod location foreign_stubs
dependencies abstractC