#include "HsVersions.h"
import DriverPipeline ( CompResult(..), preprocess, compile, link )
-import DriverState ( v_Output_file )
+import DriverState ( v_Output_file, v_NoHsMain )
import DriverPhases
import DriverUtil
import Finder
import HscMain ( hscThing, hscStmt, hscTcExpr )
import Module ( moduleUserString )
import TcRnDriver ( mkGlobalContext, getModuleContents )
-import Name ( Name, NamedThing(..), isExternalName )
+import Name ( Name, NamedThing(..), isExternalName, nameModule )
import Id ( idType )
import Type ( tidyType )
import VarEnv ( emptyTidyEnv )
_not_a_home_module -> do
maybe_stuff <- findModule mn
case maybe_stuff of
- Nothing -> throwDyn (CmdLineError ("can't find module `"
+ Left _ -> throwDyn (CmdLineError ("can't find module `"
++ moduleNameUserString mn ++ "'"))
- Just (m,_) -> return m
+ Right (m,_) -> return m
cmGetContext :: CmState -> IO ([String],[String])
cmGetContext CmState{ic=ic} =
cmInfoThing :: CmState -> DynFlags -> String -> IO (CmState, [(TyThing,Fixity)])
cmInfoThing cmstate dflags id
= do (new_pcs, things) <- hscThing hsc_env pcs icontext id
- let pairs = map (\x -> (x, getFixity new_pcs (getName x))) things
+ let new_pit = eps_PIT (pcs_EPS new_pcs)
+ pairs = map (\x -> (x, getFixity new_pit (getName x))) things
return (cmstate{ pcs=new_pcs }, pairs)
where
CmState{ hpt=hpt, pcs=pcs, ic=icontext } = cmstate
hsc_env = HscEnv { hsc_mode = Interactive,
hsc_dflags = dflags,
hsc_HPT = hpt }
- pit = eps_PIT (pcs_EPS pcs)
- getFixity :: PersistentCompilerState -> Name -> Fixity
- getFixity pcs name
+
+ getFixity :: PackageIfaceTable -> Name -> Fixity
+ getFixity pit name
| isExternalName name,
- Just iface <- lookupIface hpt pit name,
+ Just iface <- lookupIface hpt pit (nameModule name),
Just (FixitySig _ fixity _) <- lookupNameEnv (mi_fixities iface) name
= fixity
| otherwise
case either_hvals of
Left e -> do
- return ( cmstate{ pcs=new_pcs, ic=new_ic },
- CmRunException e )
+ -- on error, keep the *old* interactive context,
+ -- so that 'it' is not bound to something
+ -- that doesn't exist.
+ return ( cmstate{ pcs=new_pcs }, CmRunException e )
+
Right hvals -> do
-- Get the newly bound things, and bind them.
-- Don't need to delete any shadowed bindings;
cmUnload :: CmState -> DynFlags -> IO CmState
cmUnload state@CmState{ gmode=mode, pcs=pcs } dflags
= do -- Throw away the old home dir cache
- emptyHomeDirCache
+ flushFinderCache
-- Unload everything the linker knows about
cm_unload mode dflags []
= do showPass dflags "Chasing dependencies"
when (verbosity dflags >= 1 && gmode cmstate == Batch) $
hPutStrLn stderr (showSDoc (hcat [
- text progName, text ": chasing modules from: ",
+ text "Chasing modules from: ",
hcat (punctuate comma (map text rootnames))]))
downsweep rootnames (mg cmstate)
valid_old_linkables
when (verb >= 2) $
- putStrLn (showSDoc (text "Stable modules:"
+ hPutStrLn stderr (showSDoc (text "Stable modules:"
<+> sep (map (text.moduleNameUserString) stable_mods)))
-- Unload any modules which are going to be re-linked this
-- clean up after ourselves
cleanTempFilesExcept verb (ppFilesFromSummaries modsDone)
- -- issue a warning for the confusing case where the user said '-o foo'
- -- but we're not going to do any linking.
ofile <- readIORef v_Output_file
- when (ghci_mode == Batch && isJust ofile && not a_root_is_Main
+ no_hs_main <- readIORef v_NoHsMain
+
+ -- Issue a warning for the confusing case where the user
+ -- said '-o foo' but we're not going to do any linking.
+ -- We attempt linking if either (a) one of the modules is
+ -- called Main, or (b) the user said -no-hs-main, indicating
+ -- that main() is going to come from somewhere else.
+ --
+ let do_linking = a_root_is_Main || no_hs_main
+ when (ghci_mode == Batch && isJust ofile && not do_linking
&& verb > 0) $
hPutStrLn stderr "Warning: output was redirected with -o, but no output will be generated\nbecause there is no Main module."
-- link everything together
- linkresult <- link ghci_mode dflags a_root_is_Main (hptLinkables hpt3)
+ linkresult <- link ghci_mode dflags do_linking hpt3
cmLoadFinish Succeeded linkresult
hpt3 modsDone ghci_mode pcs3
cleanTempFilesExcept verb (ppFilesFromSummaries mods_to_keep)
-- Link everything together
- linkresult <- link ghci_mode dflags False (hptLinkables hpt4)
+ linkresult <- link ghci_mode dflags False hpt4
cmLoadFinish Failed linkresult
hpt4 mods_to_keep ghci_mode pcs3
<- if (not objects_allowed)
then return Nothing
- else case ml_obj_file (ms_location summary) of
- Just obj_fn -> maybe_getFileLinkable mod_name obj_fn
- Nothing -> return Nothing
+ else findLinkable mod_name (ms_location summary)
let old_linkable = findModuleLinkable_maybe old_linkables mod_name
return (new_linkables' ++ new_linkables)
-maybe_getFileLinkable :: ModuleName -> FilePath -> IO (Maybe Linkable)
-maybe_getFileLinkable mod obj_fn
- = do obj_exist <- doesFileExist obj_fn
- if not obj_exist
- then return Nothing
- else
- do let stub_fn = case splitFilename3 obj_fn of
- (dir, base, ext) -> dir ++ "/" ++ base ++ ".stub_o"
- stub_exist <- doesFileExist stub_fn
- obj_time <- getModificationTime obj_fn
- if stub_exist
- then return (Just (LM obj_time mod [DotO obj_fn, DotO stub_fn]))
- else return (Just (LM obj_time mod [DotO obj_fn]))
-
hptLinkables :: HomePackageTable -> [Linkable]
-- Get all the linkables from the home package table, one for each module
-- Once the HPT is up to date, these are the ones we should link
getSummary (currentMod,nm)
= do found <- findModule nm
case found of
- Just (mod, location) -> do
+ Right (mod, location) -> do
let old_summary = findModInSummaries old_summaries mod
summarise mod location old_summary
- Nothing ->
- throwDyn (CmdLineError
- ("can't find module `"
- ++ showSDoc (ppr nm) ++ "' (while processing "
- ++ show currentMod ++ ")"))
+ Left files -> do
+ dflags <- getDynFlags
+ throwDyn (noModError dflags currentMod nm files)
-- loop invariant: env doesn't contain package modules
loop :: [(FilePath,ModuleName)] -> ModuleEnv ModSummary -> IO [ModSummary]
loop new_imps (extendModuleEnvList env
[ (ms_mod s, s) | s <- new_home_summaries ])
+-- ToDo: we don't have a proper line number for this error
+noModError dflags loc mod_nm files = ProgramError (showSDoc (
+ hang (text loc <> colon) 4 $
+ (text "Can't find module" <+> quotes (ppr mod_nm) $$ extra)
+ ))
+ where
+ extra
+ | verbosity dflags < 3 =
+ text "(use -v to see a list of the files searched for)"
+ | otherwise =
+ hang (ptext SLIT("locations searched:")) 4 (vcat (map text files))
+
-----------------------------------------------------------------------------
-- Summarising modules
= do hspp_fn <- preprocess file
(srcimps,imps,mod_name) <- getImportsFromFile hspp_fn
- let (path, basename, _ext) = splitFilename3 file
+ let (path, basename, ext) = splitFilename3 file
-- GHC.Prim doesn't exist physically, so don't go looking for it.
the_imps = filter (/= gHC_PRIM_Name) imps
- (mod, location)
- <- mkHomeModuleLocn mod_name (path ++ '/':basename) file
+ (mod, location) <- mkHomeModLocation mod_name True{-is a root-}
+ path basename ext
src_timestamp
<- case ml_hs_file location of
Nothing -> noHsFileErr mod_name
Just src_fn -> getModificationTime src_fn
- return (ModSummary mod
- location{ml_hspp_file=Just hspp_fn}
- srcimps the_imps src_timestamp)
+ return (ModSummary { ms_mod = mod,
+ ms_location = location{ml_hspp_file=Just hspp_fn},
+ ms_srcimps = srcimps, ms_imps = the_imps,
+ ms_hs_date = src_timestamp })
-- Summarise a module, and pick up source and timestamp.
summarise :: Module -> ModLocation -> Maybe ModSummary