From b0f84f7b1970cdcbe70d366c47f5ef14bcadb12b Mon Sep 17 00:00:00 2001 From: sewardj Date: Mon, 13 Nov 2000 12:43:20 +0000 Subject: [PATCH] [project @ 2000-11-13 12:43:20 by sewardj] First shot at wiring up 'ghc --make'. --- ghc/compiler/compMan/CmSummarise.lhs | 17 +++++++++++------ ghc/compiler/compMan/CompManager.lhs | 5 +++-- ghc/compiler/main/DriverPipeline.hs | 18 ++++++++++-------- ghc/compiler/main/HscMain.lhs | 4 +++- ghc/compiler/main/Main.hs | 26 +++++++++++++++----------- 5 files changed, 42 insertions(+), 28 deletions(-) diff --git a/ghc/compiler/compMan/CmSummarise.lhs b/ghc/compiler/compMan/CmSummarise.lhs index eb75ca4..9971fdf 100644 --- a/ghc/compiler/compMan/CmSummarise.lhs +++ b/ghc/compiler/compMan/CmSummarise.lhs @@ -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} diff --git a/ghc/compiler/compMan/CompManager.lhs b/ghc/compiler/compMan/CompManager.lhs index 327f716..97622da 100644 --- a/ghc/compiler/compMan/CompManager.lhs +++ b/ghc/compiler/compMan/CompManager.lhs @@ -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) ++ "'") diff --git a/ghc/compiler/main/DriverPipeline.hs b/ghc/compiler/main/DriverPipeline.hs index 2542e10..8995e13 100644 --- a/ghc/compiler/main/DriverPipeline.hs +++ b/ghc/compiler/main/DriverPipeline.hs @@ -1,5 +1,5 @@ ----------------------------------------------------------------------------- --- $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-} diff --git a/ghc/compiler/main/HscMain.lhs b/ghc/compiler/main/HscMain.lhs index e762afd..b2ba003 100644 --- a/ghc/compiler/main/HscMain.lhs +++ b/ghc/compiler/main/HscMain.lhs @@ -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; diff --git a/ghc/compiler/main/Main.hs b/ghc/compiler/main/Main.hs index efaf532..83c8ea6 100644 --- a/ghc/compiler/main/Main.hs +++ b/ghc/compiler/main/Main.hs @@ -1,6 +1,6 @@ {-# 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" -- 1.7.10.4