Commit 0075a4cd authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-30 13:46:24 by sewardj]

Only pass a ModuleLocation into hscMain, not a ModSummary, so as to
facilitate Main.main not necessarily being in Main.hs.
parent 6eaf5c6c
......@@ -81,7 +81,7 @@ summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
= if isModuleInThisPackage mod
then do
let source_fn = hs_file location
let source_fn = hs_preprocd_file location
-- ToDo:
-- ppsource_fn <- preprocess source_fn
modsrc <- readFile source_fn
......
......@@ -48,6 +48,8 @@ instance (Outputable name) => Outputable (ImportDecl name) where
= parens (interpp'SP spec)
pp_spec (Just (True, spec))
= ptext SLIT("hiding") <+> parens (interpp'SP spec)
ideclName (ImportDecl mod_nm _ _ _ _ _) = mod_nm
\end{code}
%************************************************************************
......
......@@ -24,7 +24,8 @@ module HsSyn (
module HsTypes,
Fixity, NewOrData,
collectTopBinders, collectMonoBinders, collectLocatedMonoBinders
collectTopBinders, collectMonoBinders, collectLocatedMonoBinders,
hsModuleName, hsModuleImports
) where
#include "HsVersions.h"
......@@ -91,6 +92,9 @@ instance (Outputable name, Outputable pat)
pp_nonnull [] = empty
pp_nonnull xs = vcat (map ppr xs)
hsModuleName (HsModule mod_name _ _ _ _ _ _) = mod_name
hsModuleImports (HsModule mod_name vers exports imports decls deprec src_loc) = imports
\end{code}
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.11 2000/10/30 11:18:14 sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.12 2000/10/30 13:46:24 sewardj Exp $
--
-- GHC Driver
--
......@@ -37,7 +37,6 @@ import Module
import CmdLineOpts
import Config
import Util
import MkIface ( pprIface )
import Directory
import System
......@@ -433,14 +432,12 @@ run_phase Hsc basename suff input_fn output_fn
then return "-fsource-unchanged"
else return ""
-- build a bogus ModSummary to pass to hscMain.
let summary = ModSummary {
ms_mod = (mkModuleInThisPackage . mkModuleName)
{-ToDo: modname!!-}basename,
ms_location = error "no loc",
ms_ppsource = Just (input_fn, error "no fingerprint"),
ms_imports = error "no imports"
}
-- build a bogus ModuleLocation to pass to hscMain.
let location = ModuleLocation {
hs_preprocd_file = input_fn,
hi_file = hifile,
obj_file = o_file
}
-- get the DynFlags
dyn_flags <- readIORef v_DynFlags
......@@ -449,7 +446,7 @@ run_phase Hsc basename suff input_fn output_fn
pcs <- initPersistentCompilerState
result <- hscMain dyn_flags{ hscOutName = output_fn }
(source_unchanged == "-fsource-unchanged")
summary
location
Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable
emptyModuleEnv -- HomeIfaceTable
......@@ -733,7 +730,7 @@ compile summary old_iface hst hit pcs = do
let input_fn = case ms_ppsource summary of
Just (ppsource, fingerprint) -> ppsource
Nothing -> hs_file (ms_location summary)
Nothing -> hs_preprocd_file (ms_location summary)
when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
......@@ -751,7 +748,7 @@ compile summary old_iface hst hit pcs = do
-- run the compiler
hsc_result <- hscMain dyn_flags{ hscOutName = output_fn }
(panic "compile:source_unchanged")
summary old_iface hst hit pcs
(ms_location summary) old_iface hst hit pcs
case hsc_result of {
HscFail pcs -> return (CompErrs pcs);
......@@ -764,7 +761,7 @@ compile summary old_iface hst hit pcs = do
Nothing -> return (CompOK details Nothing pcs);
Just iface -> do
let (basename, _) = splitFilename (hs_file (ms_location summary))
let (basename, _) = splitFilename (hs_preprocd_file (ms_location summary))
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
let stub_unlinked = case maybe_stub_o of
Nothing -> []
......
......@@ -123,9 +123,9 @@ mkHomeModuleLocn mod_name basename source_fn = do
return (Just (mkHomeModule mod_name,
ModuleLocation{
hs_file = source_fn,
hi_file = hifile,
obj_file = o_file
hs_preprocd_file = source_fn,
hi_file = hifile,
obj_file = o_file
}
))
......@@ -165,9 +165,9 @@ maybePackageModule mod_name = do
Just (pkg_name,path) ->
return (Just (mkModule mod_name pkg_name,
ModuleLocation{
hs_file = "error:_package_module;_no_source",
hi_file = path ++ '/':hi,
obj_file = "error:_package_module;_no_object"
hs_preprocd_file = "error:_package_module;_no_source",
hi_file = path ++ '/':hi,
obj_file = "error:_package_module;_no_object"
}
))
......
......@@ -19,7 +19,6 @@ import Lex ( PState(..), ParseResult(..) )
import SrcLoc ( mkSrcLoc )
import Rename ( renameModule, checkOldIface, closeIfaceDecls )
import Rules ( emptyRuleBase )
import PrelInfo ( wiredInThings )
import PrelNames ( knownKeyNames )
......@@ -39,7 +38,7 @@ import SimplStg ( stg2stg )
import CodeGen ( codeGen )
import CodeOutput ( codeOutput )
import Module ( ModuleName, moduleName, emptyModuleEnv )
import Module ( ModuleName, moduleName, emptyModuleEnv, mkModuleInThisPackage )
import CmdLineOpts
import ErrUtils ( dumpIfSet_dyn )
import UniqSupply ( mkSplitUniqSupply )
......@@ -49,12 +48,11 @@ import Outputable
import StgInterp ( stgToInterpSyn )
import HscStats ( ppSourceStats )
import HscTypes ( ModDetails, ModIface(..), PersistentCompilerState(..),
PersistentRenamerState(..),
PersistentRenamerState(..), ModuleLocation(..),
HomeSymbolTable, PackageSymbolTable,
OrigNameEnv(..), PackageRuleBase, HomeIfaceTable,
extendTypeEnv, groupTyThings,
typeEnvClasses, typeEnvTyCons, emptyIfaceTable )
import CmSummarise ( ModSummary(..), ms_get_imports, mimp_name )
import InterpSyn ( UnlinkedIBind )
import StgInterp ( ItblEnv )
import FiniteMap ( FiniteMap, plusFM, emptyFM, addToFM )
......@@ -86,22 +84,19 @@ data HscResult
hscMain
:: DynFlags
-> Bool -- source unchanged?
-> ModSummary -- summary, including source filename
-> Maybe ModIface -- old interface, if available
-> Bool -- source unchanged?
-> ModuleLocation -- location info
-> Maybe ModIface -- old interface, if available
-> HomeSymbolTable -- for home module ModDetails
-> HomeIfaceTable
-> PersistentCompilerState -- IN: persistent compiler state
-> IO HscResult
hscMain dflags source_unchanged summary maybe_old_iface hst hit pcs
hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
= do {
-- ????? source_unchanged :: Bool -- extracted from summary?
--let source_unchanged = trace "WARNING: source_unchanged?!" False
--;
putStrLn "checking old iface ...";
(pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
<- checkOldIface dflags hit hst pcs (ms_mod summary)
<- checkOldIface dflags hit hst pcs (hi_file location)
source_unchanged maybe_old_iface;
if check_errs then
return (HscFail pcs_ch)
......@@ -112,17 +107,18 @@ hscMain dflags source_unchanged summary maybe_old_iface hst hit pcs
| otherwise = hscNoRecomp
;
putStrLn "doing what_next ...";
what_next dflags summary maybe_checked_iface
what_next dflags location maybe_checked_iface
hst hit pcs_ch
}}
hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
hscNoRecomp dflags location maybe_checked_iface hst hit pcs_ch
= do {
-- we definitely expect to have the old interface available
let old_iface = case maybe_checked_iface of
Just old_if -> old_if
Nothing -> panic "hscNoRecomp:old_iface"
this_mod = mi_module old_iface
;
-- CLOSURE
(pcs_cl, closure_errs, cl_hs_decls)
......@@ -133,15 +129,15 @@ hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
-- TYPECHECK
maybe_tc_result
<- typecheckModule dflags (ms_mod summary) pcs_cl hst hit cl_hs_decls;
<- typecheckModule dflags this_mod pcs_cl hst hit cl_hs_decls;
case maybe_tc_result of {
Nothing -> return (HscFail pcs_cl);
Just tc_result -> do {
let pcs_tc = tc_pcs tc_result
env_tc = tc_env tc_result
local_insts = tc_insts tc_result
local_rules = tc_rules tc_result
let pcs_tc = tc_pcs tc_result
env_tc = tc_env tc_result
local_insts = tc_insts tc_result
local_rules = tc_rules tc_result
;
-- create a new details from the closed, typechecked, old iface
let new_details = mkModDetailsFromIface env_tc local_insts local_rules
......@@ -154,19 +150,21 @@ hscNoRecomp dflags summary maybe_checked_iface hst hit pcs_ch
}}}}
hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
= do {
-- what target are we shooting for?
let toInterp = dopt_HscLang dflags == HscInterpreted
this_mod = ms_mod summary
;
-- putStrLn ("toInterp = " ++ show toInterp);
-- PARSE
maybe_parsed <- myParseModule dflags summary;
maybe_parsed <- myParseModule dflags (hs_preprocd_file location);
case maybe_parsed of {
Nothing -> return (HscFail pcs_ch);
Just rdr_module -> do {
-- RENAME
let this_mod = mkModuleInThisPackage (hsModuleName rdr_module)
;
show_pass dflags "Renamer";
(pcs_rn, maybe_rn_result)
<- renameModule dflags hit hst pcs_ch this_mod rdr_module;
......@@ -212,7 +210,8 @@ hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
;
-- do the rest of code generation/emission
(maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
<- restOfCodeGeneration dflags toInterp summary
<- restOfCodeGeneration dflags toInterp this_mod
(map ideclName (hsModuleImports rdr_module))
cost_centre_info foreign_stuff env_tc stg_binds oa_tidy_binds
hit (pcs_PIT pcs_tc)
;
......@@ -223,18 +222,11 @@ hscRecomp dflags summary maybe_checked_iface hst hit pcs_ch
}}}}}}}
myParseModule dflags summary
myParseModule dflags src_filename
= do -------------------------- Parser ----------------
show_pass dflags "Parser"
-- _scc_ "Parser"
let src_filename -- name of the preprocessed source file
= case ms_ppsource summary of
Just (filename, fingerprint) -> filename
Nothing -> pprPanic
"myParseModule:summary is not of a source module"
(ppr summary)
buf <- hGetStringBuffer True{-expand tabs-} src_filename
let glaexts | dopt Opt_GlasgowExts dflags = 1#
......@@ -257,7 +249,7 @@ myParseModule dflags summary
}}
restOfCodeGeneration dflags toInterp summary cost_centre_info
restOfCodeGeneration dflags toInterp this_mod imported_module_names cost_centre_info
foreign_stuff env_tc stg_binds oa_tidy_binds
hit pit -- these last two for mapping ModNames to Modules
| toInterp
......@@ -285,9 +277,7 @@ restOfCodeGeneration dflags toInterp summary cost_centre_info
where
local_tycons = typeEnvTyCons env_tc
local_classes = typeEnvClasses env_tc
this_mod = ms_mod summary
imported_modules = map (mod_name_to_Module.mimp_name)
(ms_get_imports summary)
imported_modules = map mod_name_to_Module imported_module_names
(fe_binders,h_code,c_code) = foreign_stuff
mod_name_to_Module :: ModuleName -> Module
......
......@@ -87,9 +87,9 @@ import UniqSupply ( UniqSupply )
\begin{code}
data ModuleLocation
= ModuleLocation {
hs_file :: FilePath,
hi_file :: FilePath,
obj_file :: FilePath
hs_preprocd_file :: FilePath, -- location after preprocessing
hi_file :: FilePath,
obj_file :: FilePath
}
deriving Show
......
......@@ -25,7 +25,8 @@ import RnIfaces ( slurpImpDecls, mkImportInfo,
getInterfaceExports, closeDecls,
RecompileRequired, recompileRequired
)
import RnHiFiles ( findAndReadIface, removeContext, loadExports, loadFixDecls, loadDeprecs )
import RnHiFiles ( readIface, removeContext,
loadExports, loadFixDecls, loadDeprecs )
import RnEnv ( availName,
emptyAvailEnv, unitAvailEnv, availEnvElts, plusAvailEnv, groupAvails,
warnUnusedImports, warnUnusedLocalBinds, warnUnusedModules,
......@@ -367,41 +368,45 @@ rnDeprecs gbl_env Nothing decls
checkOldIface :: DynFlags
-> HomeIfaceTable -> HomeSymbolTable
-> PersistentCompilerState
-> Module
-> FilePath
-> Bool -- Source unchanged
-> Maybe ModIface -- Old interface from compilation manager, if any
-> IO (PersistentCompilerState, Bool, (RecompileRequired, Maybe ModIface))
-- True <=> errors happened
checkOldIface dflags hit hst pcs mod source_unchanged maybe_iface
= initRn dflags hit hst pcs mod $
checkOldIface dflags hit hst pcs iface_path source_unchanged maybe_iface
= initRn dflags hit hst pcs (panic "checkOldIface: bogus mod") $
-- Load the old interface file, if we havn't already got it
loadOldIface mod maybe_iface `thenRn` \ maybe_iface ->
loadOldIface iface_path maybe_iface `thenRn` \ maybe_iface2 ->
-- Check versions
recompileRequired mod source_unchanged maybe_iface `thenRn` \ recompile ->
recompileRequired iface_path source_unchanged maybe_iface2 `thenRn` \ recompile ->
returnRn (recompile, maybe_iface)
returnRn (recompile, maybe_iface2)
\end{code}
\begin{code}
loadOldIface :: Module -> Maybe ModIface -> RnMG (Maybe ModIface)
loadOldIface mod (Just iface)
loadOldIface :: FilePath -> Maybe ModIface -> RnMG (Maybe ModIface)
loadOldIface iface_path (Just iface)
= returnRn (Just iface)
loadOldIface mod Nothing
loadOldIface iface_path Nothing
= -- LOAD THE OLD INTERFACE FILE
findAndReadIface doc_str (moduleName mod) False {- Not hi-boot -} `thenRn` \ read_result ->
-- call readIface ...
readIface iface_path `thenRn` \ read_result ->
case read_result of {
Left err -> -- Old interface file not found, or garbled, so we'd better bail out
traceRn (vcat [ptext SLIT("No old interface file:"), err]) `thenRn_`
returnRn Nothing ;
Right (_, iface) ->
Right iface ->
-- RENAME IT
let mod = pi_mod iface
doc_str = ptext SLIT("need usage info from") <+> ppr mod
in
initIfaceRnMS mod (
loadHomeDecls (pi_decls iface) `thenRn` \ decls ->
loadHomeRules (pi_rules iface) `thenRn` \ rules ->
......@@ -433,10 +438,6 @@ loadOldIface mod Nothing
in
returnRn (Just mod_iface)
}
where
doc_str = ptext SLIT("need usage info from") <+> ppr mod
\end{code}
\begin{code}
......
......@@ -5,7 +5,7 @@
\begin{code}
module RnHiFiles (
findAndReadIface, loadInterface, loadHomeInterface,
readIface, findAndReadIface, loadInterface, loadHomeInterface,
tryLoadInterface, loadOrphanModules,
loadExports, loadFixDecls, loadDeprecs,
......@@ -485,10 +485,17 @@ findAndReadIface doc_str mod_name hi_boot_file
ioToRnM (findModule mod_name) `thenRn` \ maybe_found ->
case maybe_found of
Right (Just (mod,locn))
| hi_boot_file -> readIface mod (hi_file locn ++ "-boot")
| otherwise -> readIface mod (hi_file locn)
Right (Just (wanted_mod,locn))
-> readIface (hi_file locn ++ if hi_boot_file then "-boot" else "")
`thenRn` \ read_result ->
case read_result of
Left bad -> returnRn (Left bad)
Right iface
-> let read_mod = pi_mod iface
in warnCheckRn (wanted_mod == read_mod)
(hiModuleNameMismatchWarn wanted_mod read_mod)
`thenRn_`
returnRn (Right (wanted_mod, iface))
-- Can't find it
other -> traceRn (ptext SLIT("...not found")) `thenRn_`
returnRn (Left (noIfaceErr mod_name hi_boot_file))
......@@ -504,12 +511,12 @@ findAndReadIface doc_str mod_name hi_boot_file
@readIface@ tries just the one file.
\begin{code}
readIface :: Module -> String -> RnM d (Either Message (Module, ParsedIface))
readIface :: String -> RnM d (Either Message ParsedIface)
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
readIface wanted_mod file_path
= traceRn (ptext SLIT("...reading from") <+> text file_path) `thenRn_`
ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
readIface file_path
= traceRn (ptext SLIT("readIFace") <+> text file_path) `thenRn_`
ioToRnM (hGetStringBuffer False file_path) `thenRn` \ read_result ->
case read_result of
Right contents ->
case parseIface contents
......@@ -517,13 +524,7 @@ readIface wanted_mod file_path
context = [],
glasgow_exts = 1#,
loc = mkSrcLoc (mkFastString file_path) 1 } of
POk _ (PIface iface) ->
warnCheckRn (wanted_mod == read_mod)
(hiModuleNameMismatchWarn wanted_mod read_mod) `thenRn_`
returnRn (Right (wanted_mod, iface))
where
read_mod = pi_mod iface
POk _ (PIface iface) -> returnRn (Right iface)
PFailed err -> bale_out err
parse_result -> bale_out empty
-- This last case can happen if the interface file is (say) empty
......
......@@ -18,7 +18,7 @@ where
#include "HsVersions.h"
import CmdLineOpts ( DynFlags, opt_NoPruneDecls, opt_NoPruneTyDecls, opt_IgnoreIfacePragmas )
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import HscTypes
import HsSyn ( HsDecl(..), Sig(..), TyClDecl(..), ConDecl(..), ConDetails(..),
InstDecl(..), HsType(..), hsTyVarNames, getBangType
......@@ -785,12 +785,12 @@ type RecompileRequired = Bool
upToDate = False -- Recompile not required
outOfDate = True -- Recompile required
recompileRequired :: Module
recompileRequired :: FilePath -- Only needed for debug msgs
-> Bool -- Source unchanged
-> Maybe ModIface -- Old interface, if any
-> RnMG RecompileRequired
recompileRequired mod source_unchanged maybe_iface
= traceRn (text "Considering whether compilation is required for" <+> ppr mod <> colon) `thenRn_`
recompileRequired iface_path source_unchanged maybe_iface
= traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
-- CHECK WHETHER THE SOURCE HAS CHANGED
if not source_unchanged then
......
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