Commit 156d9133 authored by sewardj's avatar sewardj
Browse files

[project @ 2000-10-30 18:13:15 by sewardj]

Move readIface from RnM to IO, and commensurate changes.  Also, add a
field to ModuleLocation to hold preprocessed source locations.
parent 430e22a7
......@@ -14,6 +14,7 @@ where
import List ( nub )
import Char ( ord, isAlphaNum )
import Util ( unJust )
import HscTypes ( ModuleLocation(..) )
import FastTypes
......@@ -81,9 +82,7 @@ summarise :: Module -> ModuleLocation -> IO ModSummary
summarise mod location
= if isModuleInThisPackage mod
then do
let source_fn = hs_preprocd_file location
-- ToDo:
-- ppsource_fn <- preprocess source_fn
let source_fn = unJust (ml_hspp_file location) "summarise"
modsrc <- readFile source_fn
let imps = getImports modsrc
fp = fingerprint modsrc
......
-----------------------------------------------------------------------------
-- $Id: DriverPipeline.hs,v 1.12 2000/10/30 13:46:24 sewardj Exp $
-- $Id: DriverPipeline.hs,v 1.13 2000/10/30 18:13:15 sewardj Exp $
--
-- GHC Driver
--
......@@ -404,8 +404,8 @@ run_phase Hsc basename suff input_fn output_fn
ohi <- readIORef v_Output_hi
hisuf <- readIORef v_Hi_suf
let hifile = case ohi of
Nothing -> current_dir ++ {-ToDo: modname!!-}basename
++ hisuf
Nothing -> current_dir ++ "/" ++ basename
++ "." ++ hisuf
Just fn -> fn
-- figure out if the source has changed, for recompilation avoidance.
......@@ -434,9 +434,10 @@ run_phase Hsc basename suff input_fn output_fn
-- build a bogus ModuleLocation to pass to hscMain.
let location = ModuleLocation {
hs_preprocd_file = input_fn,
hi_file = hifile,
obj_file = o_file
ml_hs_file = Nothing,
ml_hspp_file = Just input_fn,
ml_hi_file = Just hifile,
ml_obj_file = Just o_file
}
-- get the DynFlags
......@@ -727,10 +728,9 @@ compile summary old_iface hst hit pcs = do
init_dyn_flags <- readIORef v_InitDynFlags
writeIORef v_DynFlags init_dyn_flags
let input_fn = case ms_ppsource summary of
Just (ppsource, fingerprint) -> ppsource
Nothing -> hs_preprocd_file (ms_location summary)
let location = ms_location summary
let input_fn = unJust (ml_hs_file location) "compile:hs"
when verb (hPutStrLn stderr ("compile: input file " ++ input_fn))
......@@ -748,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")
(ms_location summary) old_iface hst hit pcs
location old_iface hst hit pcs
case hsc_result of {
HscFail pcs -> return (CompErrs pcs);
......@@ -761,7 +761,7 @@ compile summary old_iface hst hit pcs = do
Nothing -> return (CompOK details Nothing pcs);
Just iface -> do
let (basename, _) = splitFilename (hs_preprocd_file (ms_location summary))
let (basename, _) = splitFilename input_fn
maybe_stub_o <- dealWithStubs basename maybe_stub_h maybe_stub_c
let stub_unlinked = case maybe_stub_o of
Nothing -> []
......
......@@ -123,9 +123,10 @@ mkHomeModuleLocn mod_name basename source_fn = do
return (Just (mkHomeModule mod_name,
ModuleLocation{
hs_preprocd_file = source_fn,
hi_file = hifile,
obj_file = o_file
ml_hspp_file = Nothing,
ml_hs_file = Just source_fn,
ml_hi_file = Just hifile,
ml_obj_file = Just o_file
}
))
......@@ -165,9 +166,10 @@ maybePackageModule mod_name = do
Just (pkg_name,path) ->
return (Just (mkModule mod_name pkg_name,
ModuleLocation{
hs_preprocd_file = "error:_package_module;_no_source",
hi_file = path ++ '/':hi,
obj_file = "error:_package_module;_no_object"
ml_hspp_file = Nothing,
ml_hs_file = Nothing,
ml_hi_file = Just (path ++ '/':hi),
ml_obj_file = Nothing
}
))
......
......@@ -41,6 +41,7 @@ import CodeOutput ( codeOutput )
import Module ( ModuleName, moduleName, mkModuleInThisPackage )
import CmdLineOpts
import ErrUtils ( dumpIfSet_dyn )
import Util ( unJust )
import UniqSupply ( mkSplitUniqSupply )
import Bag ( emptyBag )
......@@ -93,9 +94,10 @@ hscMain
hscMain dflags source_unchanged location maybe_old_iface hst hit pcs
= do {
putStrLn ( "hscMain: location =\n" ++ show location);
putStrLn "checking old iface ...";
(pcs_ch, check_errs, (recomp_reqd, maybe_checked_iface))
<- checkOldIface dflags hit hst pcs (hi_file location)
<- checkOldIface dflags hit hst pcs (unJust (ml_hi_file location) "hscMain")
source_unchanged maybe_old_iface;
if check_errs then
return (HscFail pcs_ch)
......@@ -156,7 +158,8 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
;
-- putStrLn ("toInterp = " ++ show toInterp);
-- PARSE
maybe_parsed <- myParseModule dflags (hs_preprocd_file location);
maybe_parsed
<- myParseModule dflags (unJust (ml_hspp_file location) "hscRecomp:hspp");
case maybe_parsed of {
Nothing -> return (HscFail pcs_ch);
Just rdr_module -> do {
......@@ -205,7 +208,7 @@ hscRecomp dflags location maybe_checked_iface hst hit pcs_ch
Just (fif, sdoc) -> Just fif; Nothing -> Nothing
;
-- Write the interface file
writeIface maybe_final_iface
writeIface (unJust (ml_hi_file location) "hscRecomp:hi") maybe_final_iface
;
-- do the rest of code generation/emission
(maybe_stub_h_filename, maybe_stub_c_filename, maybe_ibinds)
......
......@@ -88,9 +88,10 @@ import UniqSupply ( UniqSupply )
\begin{code}
data ModuleLocation
= ModuleLocation {
hs_preprocd_file :: FilePath, -- location after preprocessing
hi_file :: FilePath,
obj_file :: FilePath
ml_hs_file :: Maybe FilePath,
ml_hspp_file :: Maybe FilePath, -- path of preprocessed source
ml_hi_file :: Maybe FilePath,
ml_obj_file :: Maybe FilePath
}
deriving Show
......
......@@ -605,23 +605,15 @@ diffDecls old_vers old_fixities new_fixities old new
%************************************************************************
\begin{code}
writeIface :: Maybe ModIface -> IO ()
writeIface Nothing
writeIface :: FilePath -> Maybe ModIface -> IO ()
writeIface hi_path Nothing
= return ()
writeIface (Just mod_iface)
= do { maybe_found <- findModule mod_name ;
; case maybe_found of {
Nothing -> printErrs (text "Can't write interface file for" <+> ppr mod_name) ;
Just (_, locn) ->
do { let filename = hi_file locn
; if_hdl <- openFile filename WriteMode
writeIface hi_path (Just mod_iface)
= do { if_hdl <- openFile hi_path WriteMode
; printForIface if_hdl (pprIface mod_iface)
; hClose if_hdl
}}}
where
mod_name = moduleName (mi_module mod_iface)
}
pprIface :: ModIface -> SDoc
pprIface iface
......
......@@ -17,13 +17,13 @@ import RnHsSyn ( RenamedHsDecl, RenamedTyClDecl, RenamedRuleDecl, RenamedInstDe
instDeclFVs, tyClDeclFVs, ruleDeclFVs
)
import CmdLineOpts ( DynFlags, DynFlag(..) )
import CmdLineOpts ( DynFlags, DynFlag(..), dopt )
import RnMonad
import RnNames ( getGlobalNames )
import RnSource ( rnSourceDecls, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl )
import RnIfaces ( slurpImpDecls, mkImportInfo,
getInterfaceExports, closeDecls,
RecompileRequired, recompileRequired
RecompileRequired, outOfDate, recompileRequired
)
import RnHiFiles ( readIface, removeContext,
loadExports, loadFixDecls, loadDeprecs )
......@@ -33,7 +33,8 @@ import RnEnv ( availName,
lookupOrigNames, lookupGlobalRn, newGlobalName
)
import Module ( Module, ModuleName, WhereFrom(..),
moduleNameUserString, moduleName, moduleEnvElts
moduleNameUserString, moduleName,
mkModuleInThisPackage, mkModuleName, moduleEnvElts
)
import Name ( Name, isLocallyDefined, NamedThing(..), getSrcLoc,
nameOccName, nameModule,
......@@ -376,35 +377,41 @@ checkOldIface :: DynFlags
-- True <=> errors happened
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 iface_path maybe_iface `thenRn` \ maybe_iface2 ->
-- Check versions
recompileRequired iface_path source_unchanged maybe_iface2 `thenRn` \ recompile ->
returnRn (recompile, maybe_iface2)
= case maybe_iface of
Just old_iface -> -- Use the one we already have
startRn (mi_module old_iface) $
check_versions old_iface
Nothing -- try and read it from a file
-> do read_result <- readIface do_traceRn iface_path
case read_result of
Left err -> -- Old interface file not found, or garbled; give up
return (pcs, False, (outOfDate, Nothing))
Right parsed_iface
-> startRn (pi_mod parsed_iface) $
loadOldIface parsed_iface `thenRn` \ m_iface ->
check_versions m_iface
where
check_versions :: ModIface -> RnMG (RecompileRequired, Maybe ModIface)
check_versions iface
= -- Check versions
recompileRequired iface_path source_unchanged iface
`thenRn` \ recompile ->
returnRn (recompile, Just iface)
do_traceRn = dopt Opt_D_dump_rn_trace dflags
ioTraceRn sdoc = if do_traceRn then printErrs sdoc else return ()
startRn mod = initRn dflags hit hst pcs mod
\end{code}
I think the following function should now have a more representative name,
but what?
\begin{code}
loadOldIface :: FilePath -> Maybe ModIface -> RnMG (Maybe ModIface)
loadOldIface iface_path (Just iface)
= returnRn (Just iface)
loadOldIface iface_path Nothing
= -- LOAD THE OLD INTERFACE FILE
-- 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 ->
-- RENAME IT
loadOldIface :: ParsedIface -> RnMG ModIface
loadOldIface parsed_iface
= let iface = parsed_iface
in -- RENAME IT
let mod = pi_mod iface
doc_str = ptext SLIT("need usage info from") <+> ppr mod
in
......@@ -413,10 +420,11 @@ loadOldIface iface_path Nothing
loadHomeRules (pi_rules iface) `thenRn` \ rules ->
loadHomeInsts (pi_insts iface) `thenRn` \ insts ->
returnRn (decls, rules, insts)
) `thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
)
`thenRn` \ ((decls_vers, new_decls), (rule_vers, new_rules), new_insts) ->
mapRn loadHomeUsage (pi_usages iface) `thenRn` \ usages ->
loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
loadExports (pi_exports iface) `thenRn` \ (export_vers, avails) ->
loadFixDecls mod (pi_fixity iface) `thenRn` \ fix_env ->
loadDeprecs mod (pi_deprecs iface) `thenRn` \ deprec_env ->
let
......@@ -437,8 +445,7 @@ loadOldIface iface_path Nothing
mi_globals = panic "No mi_globals in old interface"
}
in
returnRn (Just mod_iface)
}
returnRn mod_iface
\end{code}
\begin{code}
......
......@@ -17,7 +17,7 @@ module RnHiFiles (
#include "HsVersions.h"
import CmdLineOpts ( opt_IgnoreIfacePragmas )
import CmdLineOpts ( DynFlag(..), opt_IgnoreIfacePragmas )
import HscTypes ( ModuleLocation(..),
ModIface(..), emptyModIface,
VersionInfo(..),
......@@ -57,10 +57,13 @@ import StringBuffer ( hGetStringBuffer )
import FastString ( mkFastString )
import ErrUtils ( Message )
import Finder ( findModule )
import Util ( unJust )
import Lex
import FiniteMap
import Outputable
import Bag
import Monad ( when )
\end{code}
......@@ -468,8 +471,6 @@ getSysTyClDeclBinders mod other_decl
= returnRn []
\end{code}
%*********************************************************
%* *
\subsection{Reading an interface file}
......@@ -487,10 +488,14 @@ findAndReadIface :: SDoc -> ModuleName
findAndReadIface doc_str mod_name hi_boot_file
= traceRn trace_msg `thenRn_`
ioToRnM (findModule mod_name) `thenRn` \ maybe_found ->
doptRn Opt_D_dump_rn_trace `thenRn` \ rn_trace ->
case maybe_found of
Right (Just (wanted_mod,locn))
-> readIface (hi_file locn ++ if hi_boot_file then "-boot" else "")
-> ioToRnM_no_fail (
readIface rn_trace
(unJust (ml_hi_file locn) "findAndReadIface"
++ if hi_boot_file then "-boot" else "")
)
`thenRn` \ read_result ->
case read_result of
Left bad -> returnRn (Left bad)
......@@ -515,30 +520,30 @@ findAndReadIface doc_str mod_name hi_boot_file
@readIface@ tries just the one file.
\begin{code}
readIface :: String -> RnM d (Either Message ParsedIface)
readIface :: Bool -> String -> IO (Either Message ParsedIface)
-- Nothing <=> file not found, or unreadable, or illegible
-- Just x <=> successfully found and parsed
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
readIface tr file_path
= when tr (printErrs (ptext SLIT("readIFace") <+> text file_path))
>>
((hGetStringBuffer False file_path >>= \ contents ->
case parseIface contents
PState{ bol = 0#, atbol = 1#,
context = [],
glasgow_exts = 1#,
loc = mkSrcLoc (mkFastString file_path) 1 } of
POk _ (PIface iface) -> returnRn (Right iface)
POk _ (PIface iface) -> return (Right iface)
PFailed err -> bale_out err
parse_result -> bale_out empty
-- This last case can happen if the interface file is (say) empty
-- in which case the parser thinks it looks like an IdInfo or
-- something like that. Just an artefact of the fact that the
-- parser is used for several purposes at once.
Left io_err -> bale_out (text (show io_err))
)
`catch`
(\ io_err -> bale_out (text (show io_err))))
where
bale_out err = returnRn (Left (badIfaceFile file_path err))
bale_out err = return (Left (badIfaceFile file_path err))
\end{code}
......
......@@ -787,9 +787,9 @@ outOfDate = True -- Recompile required
recompileRequired :: FilePath -- Only needed for debug msgs
-> Bool -- Source unchanged
-> Maybe ModIface -- Old interface, if any
-> ModIface -- Old interface
-> RnMG RecompileRequired
recompileRequired iface_path source_unchanged maybe_iface
recompileRequired iface_path source_unchanged iface
= traceRn (text "Considering whether compilation is required for" <+> text iface_path <> colon) `thenRn_`
-- CHECK WHETHER THE SOURCE HAS CHANGED
......@@ -799,12 +799,8 @@ recompileRequired iface_path source_unchanged maybe_iface
else
-- CHECK WHETHER WE HAVE AN OLD IFACE
case maybe_iface of
Nothing -> traceRn (nest 4 (ptext SLIT("No old interface file"))) `thenRn_`
returnRn outOfDate ;
Just iface -> -- Source code unchanged and no errors yet... carry on
checkList [checkModUsage u | u <- mi_usages iface]
-- Source code unchanged and no errors yet... carry on
checkList [checkModUsage u | u <- mi_usages iface]
checkList :: [RnMG RecompileRequired] -> RnMG RecompileRequired
checkList [] = returnRn upToDate
......
......@@ -86,6 +86,12 @@ ioToRnM :: IO r -> RnM d (Either IOError r)
ioToRnM io rn_down g_down = (io >>= \ ok -> return (Right ok))
`catch`
(\ err -> return (Left err))
ioToRnM_no_fail :: IO r -> RnM d r
ioToRnM_no_fail io rn_down g_down
= (io >>= \ ok -> return ok)
`catch`
(\ err -> panic "ioToRnM_no_fail: the I/O operation failed!")
traceRn :: SDoc -> RnM d ()
traceRn msg
......
......@@ -24,6 +24,9 @@ module Util (
-- for-loop
nTimes,
-- maybe-ish
unJust,
-- sorting
IF_NOT_GHC(quicksort COMMA stableSortLt COMMA mergesort COMMA)
sortLt,
......@@ -65,8 +68,8 @@ module Util (
#include "HsVersions.h"
import IO ( hPutStrLn, stderr )
import List ( zipWith4 )
import Maybe ( Maybe(..) )
import Panic ( panic )
import IOExts ( IORef, newIORef, unsafePerformIO )
import FastTypes
......@@ -128,6 +131,17 @@ nTimes 1 f = f
nTimes n f = f . nTimes (n-1) f
\end{code}
%************************************************************************
%* *
\subsection{Maybe-ery}
%* *
%************************************************************************
\begin{code}
unJust :: Maybe a -> String -> a
unJust (Just x) who = x
unJust Nothing who = panic ("unJust of Nothing, called by " ++ who)
\end{code}
%************************************************************************
%* *
......
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