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
= parens (interpp'SP spec)
pp_spec (Just (True, spec))
= ptext SLIT("hiding") <+> parens (interpp'SP spec)
+
+ideclName (ImportDecl mod_nm _ _ _ _ _) = mod_nm
\end{code}
%************************************************************************
module HsTypes,
Fixity, NewOrData,
- collectTopBinders, collectMonoBinders, collectLocatedMonoBinders
+ collectTopBinders, collectMonoBinders, collectLocatedMonoBinders,
+ hsModuleName, hsModuleImports
) where
#include "HsVersions.h"
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
--
import CmdLineOpts
import Config
import Util
-import MkIface ( pprIface )
import Directory
import System
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
pcs <- initPersistentCompilerState
result <- hscMain dyn_flags{ hscOutName = output_fn }
(source_unchanged == "-fsource-unchanged")
- summary
+ location
Nothing -- no iface
emptyModuleEnv -- HomeSymbolTable
emptyModuleEnv -- HomeIfaceTable
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))
-- 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);
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 -> []
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
}
))
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"
}
))
import SrcLoc ( mkSrcLoc )
import Rename ( renameModule, checkOldIface, closeIfaceDecls )
-
import Rules ( emptyRuleBase )
import PrelInfo ( wiredInThings )
import PrelNames ( knownKeyNames )
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 )
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 )
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)
| 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)
-- 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
}}}}
-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;
;
-- 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)
;
}}}}}}}
-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#
}}
-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
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
\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
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,
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 ->
in
returnRn (Just mod_iface)
}
-
-
- where
- doc_str = ptext SLIT("need usage info from") <+> ppr mod
\end{code}
\begin{code}
\begin{code}
module RnHiFiles (
- findAndReadIface, loadInterface, loadHomeInterface,
+ readIface, findAndReadIface, loadInterface, loadHomeInterface,
tryLoadInterface, loadOrphanModules,
loadExports, loadFixDecls, loadDeprecs,
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))
@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
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
#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
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
projects / ghc-hetmet.git / commitdiff