First shot at wiring up 'ghc --make'.
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 '}'
]
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}
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 )
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
--
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,
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
: 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
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-}
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 ]
])
-- 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-}
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
--
import DriverUtil
import DriverPhases ( Phase(..) )
import CmdLineOpts ( HscLang(..), DynFlags(..), v_Static_hsc_opts )
+import Module ( mkModuleName )
import TmpFiles
import Finder ( initFinder )
import CmStaticInfo
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
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"
projects / ghc-hetmet.git / commitdiff