Commit b0f84f7b authored by sewardj's avatar sewardj
Browse files

[project @ 2000-11-13 12:43:20 by sewardj]

First shot at wiring up 'ghc --make'.
parent ae034542
......@@ -41,8 +41,8 @@ data ModSummary
instance Outputable ModSummary where
ppr ms
= sep [text "ModSummary {",
nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms),
text "ms_imports=" <+> ppr (ms_imports ms)]),
nest 3 (sep [text "ms_mod =" <+> ppr (ms_mod ms) <> comma,
text "ms_imports =" <+> ppr (ms_imports ms)]),
char '}'
]
......@@ -70,13 +70,18 @@ ms_get_imports summ
type Fingerprint = Int
summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
-- The first arg is supposed to be DriverPipeline.preprocess.
-- Passed in here to avoid a hard-to-avoid circular dependency
-- between CmSummarise and DriverPipeline.
summarise :: (FilePath -> IO FilePath)
-> Module -> ModuleLocation -> IO ModSummary
summarise preprocess mod location
| isModuleInThisPackage mod
= do let hspp_fn = unJust (ml_hspp_file location) "summarise"
= do let hs_fn = unJust (ml_hs_file location) "summarise"
hspp_fn <- preprocess hs_fn
modsrc <- readFile hspp_fn
let imps = getImports modsrc
return (ModSummary mod location (Just imps))
return (ModSummary mod location{ml_hspp_file=Just hspp_fn} (Just imps))
| otherwise
= return (ModSummary mod location Nothing)
\end{code}
......
......@@ -30,7 +30,7 @@ import CmSummarise ( summarise, ModSummary(..),
import Module ( ModuleName, moduleName, packageOfModule,
isModuleInThisPackage, PackageName )
import CmStaticInfo ( Package(..), PackageConfigInfo )
import DriverPipeline ( compile, CompResult(..) )
import DriverPipeline ( compile, preprocess, CompResult(..) )
import HscTypes ( HomeSymbolTable, HomeIfaceTable,
PersistentCompilerState )
import HscMain ( initPersistentCompilerState )
......@@ -492,9 +492,10 @@ downsweep rootNm
where
getSummary :: ModuleName -> IO ModSummary
getSummary nm
| trace ("getSummary: "++ showSDoc (ppr nm)) True
= do found <- findModule nm
case found of
Just (mod, location) -> summarise mod location
Just (mod, location) -> summarise preprocess mod location
Nothing -> panic ("CompManager: can't find module `" ++
showSDoc (ppr nm) ++ "'")
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.18 2000/11/09 12:54:08 simonmar Exp $
-- $Id: DriverPipeline.hs,v 1.19 2000/11/13 12:43:20 sewardj Exp $
--
-- GHC Driver
--
......@@ -119,6 +119,7 @@ data IntermediateFileType
genPipeline
:: GhcMode -- when to stop
-> String -- "stop after" flag (for error messages)
-> Bool -- True => output is persistent
-> String -- original filename
-> IO [ -- list of phases to run for this file
(Phase,
......@@ -126,7 +127,7 @@ genPipeline
String) -- output file suffix
]
genPipeline todo stop_flag filename
genPipeline todo stop_flag persistent_output filename
= do
split <- readIORef v_Split_object_files
mangle <- readIORef v_Do_asm_mangling
......@@ -211,9 +212,10 @@ genPipeline todo stop_flag filename
: annotatePipeline (next_phase:ps) stop
where
keep_this_output
| next_phase == stop = Persistent
| otherwise =
case next_phase of
| next_phase == stop
= if persistent_output then Persistent else Temporary
| otherwise
= case next_phase of
Ln -> Persistent
Mangle | keep_raw_s -> Persistent
As | keep_s -> Persistent
......@@ -723,7 +725,7 @@ doLink o_files = do
preprocess :: FilePath -> IO FilePath
preprocess filename =
ASSERT(haskellish_file filename)
do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") filename
do pipeline <- genPipeline (StopBefore Hsc) ("preprocess") False filename
runPipeline pipeline filename False{-no linking-} False{-no -o flag-}
......@@ -816,7 +818,7 @@ compile summary old_iface hst hit pcs = do
Nothing -> panic "compile: no interpreted code"
-- we're in batch mode: finish the compilation pipeline.
_other -> do pipe <- genPipeline (StopBefore Ln) "" output_fn
_other -> do pipe <- genPipeline (StopBefore Ln) "" True output_fn
o_file <- runPipeline pipe output_fn False False
return [ DotO o_file ]
......@@ -857,7 +859,7 @@ dealWithStubs basename maybe_stub_h maybe_stub_c
])
-- compile the _stub.c file w/ gcc
pipeline <- genPipeline (StopBefore Ln) "" stub_c
pipeline <- genPipeline (StopBefore Ln) "" True stub_c
stub_o <- runPipeline pipeline stub_c False{-no linking-}
False{-no -o option-}
......
......@@ -92,7 +92,9 @@ hscMain
hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
= do {
putStrLn "CHECKING OLD IFACE";
putStrLn ("CHECKING OLD IFACE for hs = " ++ show (ml_hs_file location)
++ ", hspp = " ++ show (ml_hspp_file location));
(pcs_ch, errs_found, (recomp_reqd, maybe_checked_iface))
<- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
source_unchanged maybe_old_iface;
......
{-# OPTIONS -W -fno-warn-incomplete-patterns #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.19 2000/11/10 14:29:21 simonmar Exp $
-- $Id: Main.hs,v 1.20 2000/11/13 12:43:20 sewardj Exp $
--
-- GHC Driver program
--
......@@ -23,6 +23,7 @@ import DriverMkDepend
import DriverUtil
import DriverPhases ( Phase(..) )
import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
import Module ( mkModuleName )
import TmpFiles
import Finder ( initFinder )
import CmStaticInfo
......@@ -221,11 +222,11 @@ main =
when (mode == DoMkDependHS) beginMkDependHS
-- make/interactive require invoking the compilation manager
if (mode == DoMake) then beginMake srcs else do
if (mode == DoInteractive) then beginInteractive srcs else do
if (mode == DoMake) then beginMake pkg_details srcs else do
if (mode == DoInteractive) then beginInteractive srcs else do
-- for each source file, find which phases to run
pipelines <- mapM (genPipeline mode stop_flag) srcs
pipelines <- mapM (genPipeline mode stop_flag True) srcs
let src_pipelines = zip srcs pipelines
-- sanity checking
......@@ -263,12 +264,15 @@ setTopDir args = do
some -> writeIORef v_TopDir (drop 2 (last some)))
return others
beginMake [] = throwDyn (UsageError "no input files")
beginMake (_:_:_) = throwDyn (UsageError "only one module allowed with --make")
{-
beginMake [mod] = do
state <- cmInit ""{-ToDo:remove-} pkg_details
cmLoadModule state (mkModuleName mod)
-}
beginMake :: PackageConfigInfo -> [String] -> IO ()
beginMake pkg_details mods
| null mods
= throwDyn (UsageError "no input files")
| not (null (tail mods))
= throwDyn (UsageError "only one module allowed with --make")
| otherwise
= do state <- cmInit pkg_details
cmLoadModule state (mkModuleName (head mods))
return ()
beginInteractive srcs = panic "`ghc --interactive' unimplemented"
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