Commit 70b6c54b authored by simonmar's avatar simonmar

[project @ 2003-06-04 15:47:58 by simonmar]

Grrr, started off making a small bugfix and ended up doing a major
cleanup operartion.

Anyway, the problem was that -odir wasn't putting the object files in
the right place when the module in question has a hierarchical name.
This was due to the object filename being generated in two different
places: once by the compilation pipeline machinery, and again in the
Finder.  It now works properly when --make is used; I haven't managed
to fix it for one-shot compilations though (some replumbing is
needed).

While I was here, I cleaned up the compilation pipeline machinery
somewhat.  The previous scheme of generating a data structure
representing the phases that need to be executed before actually
executing them was wrong because the structure of the pipeline can
change while it is being executed (eg. if we see {-# OPTIONS -fasm #-}
during the CPP phase).  There were various hacks to deal with this,
but it turned out to be quite messy.

So the new story is that each compilation phase returns the name of
the next phase to execute, and also figures out which file to put its
output in.  This unfortunately means that the knowledge about what
phases are done in what order is now spread throughout the module, but
there are fewer hacks at the higher levels, and overall it seems to be
an improvement.
parent 4d65dec8
-----------------------------------------------------------------------------
-- $Id: DriverMkDepend.hs,v 1.27 2003/01/08 15:28:05 simonmar Exp $
-- $Id: DriverMkDepend.hs,v 1.28 2003/06/04 15:47:58 simonmar Exp $
--
-- GHC Driver
--
......@@ -11,8 +11,9 @@ module DriverMkDepend where
#include "HsVersions.h"
import GetImports ( getImports )
import DriverState
import DriverUtil ( add, softGetDirectoryContents, replaceFilenameSuffix )
import DriverUtil
import DriverFlags
import SysTools ( newTempName )
import qualified SysTools
......@@ -128,6 +129,63 @@ beginMkDependHS = do
return ()
doMkDependHSPhase basename suff input_fn
= do src <- readFile input_fn
let (import_sources, import_normals, _) = getImports src
let orig_fn = basename ++ '.':suff
deps_sources <- mapM (findDependency True orig_fn) import_sources
deps_normals <- mapM (findDependency False orig_fn) import_normals
let deps = deps_sources ++ deps_normals
osuf <- readIORef v_Object_suf
extra_suffixes <- readIORef v_Dep_suffixes
let suffixes = osuf : map (++ ('_':osuf)) extra_suffixes
ofiles = map (\suf -> basename ++ '.':suf) suffixes
objs <- mapM odir_ify ofiles
-- Handle for file that accumulates dependencies
hdl <- readIORef v_Dep_tmp_hdl
-- std dependency of the object(s) on the source file
hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
escapeSpaces (basename ++ '.':suff))
let genDep (dep, False {- not an hi file -}) =
hPutStrLn hdl (unwords (map escapeSpaces objs) ++ " : " ++
escapeSpaces dep)
genDep (dep, True {- is an hi file -}) = do
hisuf <- readIORef v_Hi_suf
let dep_base = remove_suffix '.' dep
deps = (dep_base ++ hisuf)
: map (\suf -> dep_base ++ suf ++ '_':hisuf) extra_suffixes
-- length objs should be == length deps
sequence_ (zipWith (\o d -> hPutStrLn hdl (escapeSpaces o ++ " : " ++ escapeSpaces d)) objs deps)
sequence_ (map genDep [ d | Just d <- deps ])
return True
-- add the lines to dep_makefile:
-- always:
-- this.o : this.hs
-- if the dependency is on something other than a .hi file:
-- this.o this.p_o ... : dep
-- otherwise
-- if the import is {-# SOURCE #-}
-- this.o this.p_o ... : dep.hi-boot[-$vers]
-- else
-- this.o ... : dep.hi
-- this.p_o ... : dep.p_hi
-- ...
-- (where .o is $osuf, and the other suffixes come from
-- the cmdline -s options).
endMkDependHS :: IO ()
endMkDependHS = do
makefile <- readIORef v_Dep_makefile
......
-----------------------------------------------------------------------------
-- $Id: DriverPhases.hs,v 1.24 2003/05/21 12:46:19 simonmar Exp $
-- $Id: DriverPhases.hs,v 1.25 2003/06/04 15:47:59 simonmar Exp $
--
-- GHC Driver
--
......@@ -11,6 +11,7 @@
module DriverPhases (
Phase(..),
happensBefore,
startPhase, -- :: String -> Phase
phaseInputExt, -- :: Phase -> String
......@@ -40,8 +41,7 @@ import DriverUtil
-}
data Phase
= MkDependHS -- haskell dependency generation
| Unlit
= Unlit
| Cpp
| HsPp
| Hsc
......@@ -58,6 +58,17 @@ data Phase
#endif
deriving (Eq, Show)
-- Partial ordering on phases: we want to know which phases will occur before
-- which others. This is used for sanity checking, to ensure that the
-- pipeline will stop at some point (see DriverPipeline.runPipeline).
x `happensBefore` y
| x `elem` haskell_pipe = y `elem` tail (dropWhile (/= x) haskell_pipe)
| x `elem` c_pipe = y `elem` tail (dropWhile (/= x) c_pipe)
| otherwise = False
haskell_pipe = [Unlit,Cpp,HsPp,Hsc,HCc,Mangle,As,Ln]
c_pipe = [Cc,As,Ln]
-- the first compilation phase for a given file is determined
-- by its suffix.
startPhase "lhs" = Unlit
......@@ -90,7 +101,6 @@ phaseInputExt SplitMangle = "split_s" -- not really generated
phaseInputExt As = "s"
phaseInputExt SplitAs = "split_s" -- not really generated
phaseInputExt Ln = "o"
phaseInputExt MkDependHS = "dep"
#ifdef ILX
phaseInputExt Ilx2Il = "ilx"
phaseInputExt Ilasm = "il"
......
This diff is collapsed.
-----------------------------------------------------------------------------
-- $Id: DriverUtil.hs,v 1.37 2003/03/04 11:12:11 simonmar Exp $
-- $Id: DriverUtil.hs,v 1.38 2003/06/04 15:47:59 simonmar Exp $
--
-- Utils for the driver
--
......@@ -21,7 +21,7 @@ import qualified EXCEPTION as Exception
import DYNAMIC
import DATA_IOREF ( IORef, readIORef, writeIORef )
import Directory ( getDirectoryContents, doesDirectoryExist )
import Directory
import IO
import List
import Char
......@@ -69,6 +69,16 @@ softGetDirectoryContents d
return []
)
-----------------------------------------------------------------------------
-- Create a hierarchy of directories
createDirectoryHierarchy :: FilePath -> IO ()
createDirectoryHierarchy dir = do
b <- doesDirectoryExist dir
when (not b) $ do
createDirectoryHierarchy (directoryOf dir)
createDirectory dir
-----------------------------------------------------------------------------
-- Verify that the 'dirname' portion of a FilePath exists.
--
......
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.123 2003/05/21 13:05:49 simonmar Exp $
-- $Id: Main.hs,v 1.124 2003/06/04 15:47:59 simonmar Exp $
--
-- GHC Driver program
--
......@@ -29,7 +29,7 @@ import SysTools ( getPackageConfigPath, initSysTools, cleanTempFiles )
import Packages ( showPackages, getPackageConfigMap, basePackage,
haskell98Package
)
import DriverPipeline ( staticLink, doMkDLL, genPipeline, pipeLoop )
import DriverPipeline ( staticLink, doMkDLL, runPipeline )
import DriverState ( buildCoreToDo, buildStgToDo,
findBuildTag,
getPackageExtraGhcOpts, unregFlags,
......@@ -43,14 +43,12 @@ import DriverFlags ( buildStaticHscOpts,
dynamic_flags, processArgs, static_flags)
import DriverMkDepend ( beginMkDependHS, endMkDependHS )
import DriverPhases ( Phase(HsPp, Hsc), haskellish_src_file, objish_file, isSourceFile )
import DriverPhases ( isSourceFile )
import DriverUtil ( add, handle, handleDyn, later, splitFilename,
unknownFlagsErr, getFileSuffix )
import DriverUtil ( add, handle, handleDyn, later, unknownFlagsErr )
import CmdLineOpts ( dynFlag, restoreDynFlags,
saveDynFlags, setDynFlags, getDynFlags, dynFlag,
DynFlags(..), HscLang(..), v_Static_hsc_opts,
defaultHscLang
DynFlags(..), HscLang(..), v_Static_hsc_opts
)
import BasicTypes ( failed )
import Outputable
......@@ -307,27 +305,14 @@ compileFile mode stop_flag src = do
when (not exists) $
throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
-- We compile in two stages, because the file may have an
-- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
let (basename, suffix) = splitFilename src
-- just preprocess (Haskell source only)
let src_and_suff = (src, getFileSuffix src)
let not_hs_file = not (haskellish_src_file src)
pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
then return src_and_suff else do
phases <- genPipeline (StopBefore Hsc) stop_flag
False{-not persistent-} defaultHscLang
src_and_suff
pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
basename suffix
-- rest of compilation
hsc_lang <- dynFlag hscLang
phases <- genPipeline mode stop_flag True hsc_lang pp
(r,_) <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
True{-use -o flag-} basename suffix
return r
o_file <- readIORef v_Output_file
-- when linking, the -o argument refers to the linker's output.
-- otherwise, we use it as the name for the pipeline's output.
let maybe_o_file
| mode==DoLink || mode==DoMkDLL = Nothing
| otherwise = o_file
runPipeline mode stop_flag True maybe_o_file src
-- ----------------------------------------------------------------------------
......
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