{-# OPTIONS -#include "Linker.h" #-}
-----------------------------------------------------------------------------
--- $Id: InteractiveUI.hs,v 1.152 2003/05/07 08:29:48 simonpj Exp $
+-- $Id: InteractiveUI.hs,v 1.153 2003/05/19 15:39:17 simonpj Exp $
--
-- GHC Interactive User Interface
--
--
-----------------------------------------------------------------------------
module InteractiveUI (
- interactiveUI, -- :: CmState -> [FilePath] -> [LibrarySpec] -> IO ()
+ interactiveUI, -- :: CmState -> [FilePath] -> IO ()
ghciWelcomeMsg
) where
import CompManager
import HscTypes ( TyThing(..), HomeModInfo(hm_linkable), HomePackageTable,
- isObjectLinkable )
+ isObjectLinkable, GhciMode(..) )
import HsSyn ( TyClDecl(..), ConDecl(..), Sig(..) )
import MkIface ( ifaceTyThing )
import DriverFlags
import DriverState
import DriverUtil ( remove_spaces, handle )
-import Linker ( initLinker, showLinkerState, linkLibraries,
- linkPackages )
+import Linker ( showLinkerState, linkPackages )
import Util
import IdInfo ( GlobalIdDetails(..) )
import Id ( isImplicitId, idName, globalIdDetails )
\ (eg. -v2, -fglasgow-exts, etc.)\n\
\"
-interactiveUI :: CmState -> [FilePath] -> [FilePath] -> IO ()
-interactiveUI cmstate paths cmdline_objs = do
- hFlush stdout
- hSetBuffering stdout NoBuffering
-
+interactiveUI :: [FilePath] -> IO ()
+interactiveUI srcs = do
dflags <- getDynFlags
+ saveDynFlags -- Save the dynamic flags, so that
+ -- the later restore will find them
+ cmstate <- cmInit Interactive;
- initLinker
-
- -- link packages requested explicitly on the command-line
- expl <- readIORef v_ExplicitPackages
- linkPackages dflags expl
-
- -- link libraries from the command-line
- linkLibraries dflags cmdline_objs
+ hFlush stdout
+ hSetBuffering stdout NoBuffering
-- Initialise buffering for the *interpreted* I/O system
cmstate <- initInterpBuffering cmstate dflags
Readline.initialize
#endif
- startGHCi (runGHCi paths dflags)
+ startGHCi (runGHCi srcs dflags)
GHCiState{ progname = "<interactive>",
args = [],
- targets = paths,
+ targets = srcs,
cmstate = cmstate,
options = [] }
Left e -> return ()
Right hdl -> fileLoop hdl False
- -- perform a :load for files given on the GHCi command line
+ -- Perform a :load for files given on the GHCi command line
when (not (null paths)) $
ghciHandle showException $
loadModule paths
-- enter the interactive loop
#if defined(mingw32_HOST_OS)
- -- always show prompt, since hIsTerminalDevice returns True for Consoles
+ -- Always show prompt, since hIsTerminalDevice returns True for Consoles
-- only, which we may or may not be running under (cf. Emacs sub-shells.)
interactiveLoop True
#else
interactiveLoop is_tty = do
- -- ignore ^C exceptions caught here
+ -- Ignore ^C exceptions caught here
ghciHandleDyn (\e -> case e of
Interrupted -> ghciUnblock (interactiveLoop is_tty)
_other -> return ()) $ do
{-# OPTIONS -optc-DNON_POSIX_SOURCE -#include "Linker.h" #-}
-module Linker ( HValue, initLinker, showLinkerState,
- linkLibraries, linkExpr,
- unload, extendLinkEnv,
- LibrarySpec(..),
+module Linker ( HValue, initDynLinker, showLinkerState,
+ linkExpr, unload, extendLinkEnv,
linkPackages,
) where
#include "../includes/config.h"
#include "HsVersions.h"
-import ObjLink ( loadDLL, loadObj, unloadObj, resolveObjs, initLinker )
+import ObjLink ( loadDLL, loadObj, unloadObj, resolveObjs, initObjLinker )
import ByteCodeLink ( HValue, ClosureEnv, extendClosureEnv, linkBCO )
import ByteCodeItbls ( ItblEnv )
import ByteCodeAsm ( CompiledByteCode(..), bcoFreeNames, UnlinkedBCO(..))
import Packages
-import DriverState ( v_Library_paths, v_Opt_l, getStaticOpts )
+import DriverState ( v_Library_paths, v_Opt_l, v_Ld_inputs, getStaticOpts, v_ExplicitPackages )
#ifdef darwin_TARGET_OS
import DriverState ( v_Cmdline_frameworks, v_Framework_paths )
#endif
import Module
import FastString ( FastString(..), unpackFS )
import ListSetOps ( minusList )
-import CmdLineOpts ( DynFlags(verbosity) )
+import CmdLineOpts ( DynFlags(verbosity), getDynFlags )
import BasicTypes ( SuccessFlag(..), succeeded, failed )
import Outputable
import Panic ( GhcException(..) )
interpreted code only), for use during linking.
\begin{code}
-GLOBAL_VAR(v_PersistentLinkerState, emptyPLS, PersistentLinkerState)
+GLOBAL_VAR(v_PersistentLinkerState, panic "Dynamic linker not initialised", PersistentLinkerState)
+GLOBAL_VAR(v_InitLinkerDone, False, Bool) -- Set True when dynamic linker is initialised
data PersistentLinkerState
= PersistentLinkerState {
+
+%************************************************************************
+%* *
+\subsection{Initialisation}
+%* *
+%************************************************************************
+
+We initialise the dynamic linker by
+
+a) calling the C initialisation procedure
+
+b) Loading any packages specified on the command line,
+ now held in v_ExplicitPackages
+
+c) Loading any packages specified on the command line,
+ now held in the -l options in v_Opt_l
+
+d) Loading any .o/.dll files specified on the command line,
+ now held in v_Ld_inputs
+
+e) Loading any MacOS frameworks
+
+\begin{code}
+initDynLinker :: IO ()
+-- This function is idempotent; if called more than once, it does nothing
+-- This is useful in Template Haskell, where we call it before trying to link
+initDynLinker
+ = do { done <- readIORef v_InitLinkerDone
+ ; if done then return ()
+ else do { writeIORef v_InitLinkerDone True
+ ; reallyInitDynLinker }
+ }
+
+reallyInitDynLinker
+ = do { dflags <- getDynFlags
+
+ -- Initialise the linker state
+ ; writeIORef v_PersistentLinkerState emptyPLS
+
+ -- (a) initialise the C dynamic linker
+ ; initObjLinker
+
+ -- (b) Load packages from the command-line
+ ; expl <- readIORef v_ExplicitPackages
+ ; linkPackages dflags expl
+
+ -- (c) Link libraries from the command-line
+ ; opt_l <- getStaticOpts v_Opt_l
+ ; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
+
+ -- (d) Link .o files from the command-line
+ ; lib_paths <- readIORef v_Library_paths
+ ; cmdline_objs <- readIORef v_Ld_inputs
+
+ -- (e) Link any MacOS frameworks
+#ifdef darwin_TARGET_OS
+ ; framework_paths <- readIORef v_Framework_paths
+ ; frameworks <- readIORef v_Cmdline_frameworks
+#else
+ ; let frameworks = []
+ ; let framework_paths = []
+#endif
+ -- Finally do (c),(d),(e)
+ ; let cmdline_lib_specs = map Object cmdline_objs
+ ++ map DLL minus_ls
+ ++ map Framework frameworks
+ ; if null cmdline_lib_specs then return ()
+ else do
+
+ { mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
+ ; maybePutStr dflags "final link ... "
+ ; ok <- resolveObjs
+
+ ; if succeeded ok then maybePutStrLn dflags "done"
+ else throwDyn (InstallationError "linking extra libraries/objects failed")
+ }}
+
+preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
+preloadLib dflags lib_paths framework_paths lib_spec
+ = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
+ case lib_spec of
+ Object static_ish
+ -> do b <- preload_static lib_paths static_ish
+ maybePutStrLn dflags (if b then "done"
+ else "not found")
+
+ DLL dll_unadorned
+ -> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
+ case maybe_errstr of
+ Nothing -> maybePutStrLn dflags "done"
+ Just mm -> preloadFailed mm lib_paths lib_spec
+
+#ifdef darwin_TARGET_OS
+ Framework framework
+ -> do maybe_errstr <- loadFramework framework_paths framework
+ case maybe_errstr of
+ Nothing -> maybePutStrLn dflags "done"
+ Just mm -> preloadFailed mm framework_paths lib_spec
+#endif
+ where
+ preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
+ preloadFailed sys_errmsg paths spec
+ = do maybePutStr dflags
+ ("failed.\nDynamic linker error message was:\n "
+ ++ sys_errmsg ++ "\nWhilst trying to load: "
+ ++ showLS spec ++ "\nDirectories to search are:\n"
+ ++ unlines (map (" "++) paths) )
+ give_up
+
+ -- Not interested in the paths in the static case.
+ preload_static paths name
+ = do b <- doesFileExist name
+ if not b then return False
+ else loadObj name >> return True
+
+ give_up = throwDyn $
+ CmdLineError "user specified .o/.so/.DLL could not be loaded."
+\end{code}
+
+
%************************************************************************
%* *
Link a byte-code expression
linkExpr hsc_env pcs root_ul_bco
= do {
+ -- Initialise the linker (if it's not been done already)
+ initDynLinker
+
-- Find what packages and linkables are required
- (lnks, pkgs) <- getLinkDeps hpt pit needed_mods ;
+ ; (lnks, pkgs) <- getLinkDeps hpt pit needed_mods
-- Link the packages and modules required
- linkPackages dflags pkgs
- ; ok <- linkModules dflags lnks
+ ; linkPackages dflags pkgs
+ ; ok <- linkModules dflags lnks
; if failed ok then
dieWith empty
else do {
| otherwise = go (l:already) (l:extras) ls
\end{code}
-
-\begin{code}
-linkLibraries :: DynFlags
- -> [String] -- foo.o files specified on command line
- -> IO ()
--- Used just at initialisation time to link in libraries
--- specified on the command line.
-linkLibraries dflags objs
- = do { lib_paths <- readIORef v_Library_paths
- ; opt_l <- getStaticOpts v_Opt_l
- ; let minus_ls = [ lib | '-':'l':lib <- opt_l ]
-#ifdef darwin_TARGET_OS
- ; framework_paths <- readIORef v_Framework_paths
- ; frameworks <- readIORef v_Cmdline_frameworks
-#endif
- ; let cmdline_lib_specs = map Object objs ++ map DLL minus_ls
-#ifdef darwin_TARGET_OS
- ++ map Framework frameworks
-#endif
- ; if (null cmdline_lib_specs) then return ()
- else do {
-
- -- Now link them
-#ifdef darwin_TARGET_OS
- ; mapM_ (preloadLib dflags lib_paths framework_paths) cmdline_lib_specs
-#else
- ; mapM_ (preloadLib dflags lib_paths) cmdline_lib_specs
-#endif
- ; maybePutStr dflags "final link ... "
- ; ok <- resolveObjs
- ; if succeeded ok then maybePutStrLn dflags "done."
- else throwDyn (InstallationError "linking extra libraries/objects failed")
- }}
- where
-#ifdef darwin_TARGET_OS
- preloadLib :: DynFlags -> [String] -> [String] -> LibrarySpec -> IO ()
- preloadLib dflags lib_paths framework_paths lib_spec
-#else
- preloadLib :: DynFlags -> [String] -> LibrarySpec -> IO ()
- preloadLib dflags lib_paths lib_spec
-#endif
- = do maybePutStr dflags ("Loading object " ++ showLS lib_spec ++ " ... ")
- case lib_spec of
- Object static_ish
- -> do b <- preload_static lib_paths static_ish
- maybePutStrLn dflags (if b then "done."
- else "not found")
- DLL dll_unadorned
- -> do maybe_errstr <- loadDynamic lib_paths dll_unadorned
- case maybe_errstr of
- Nothing -> return ()
- Just mm -> preloadFailed mm lib_paths lib_spec
- maybePutStrLn dflags "done"
-#ifdef darwin_TARGET_OS
- Framework framework
- -> do maybe_errstr <- loadFramework framework_paths framework
- case maybe_errstr of
- Nothing -> return ()
- Just mm -> preloadFailed mm framework_paths lib_spec
- maybePutStrLn dflags "done"
-#endif
- preloadFailed :: String -> [String] -> LibrarySpec -> IO ()
- preloadFailed sys_errmsg paths spec
- = do maybePutStr dflags
- ("failed.\nDynamic linker error message was:\n "
- ++ sys_errmsg ++ "\nWhilst trying to load: "
- ++ showLS spec ++ "\nDirectories to search are:\n"
- ++ unlines (map (" "++) paths) )
- give_up
-
- -- not interested in the paths in the static case.
- preload_static paths name
- = do b <- doesFileExist name
- if not b then return False
- else loadObj name >> return True
-
- give_up
- = (throwDyn . CmdLineError)
- "user specified .o/.so/.DLL could not be loaded."
-\end{code}
-
-
%************************************************************************
%* *
\subsection{The byte-code linker}
-- On WinDoze "burble" denotes "burble.DLL"
-- loadDLL is platform-specific and adds the lib/.so/.DLL
-- suffixes platform-dependently
-#ifdef darwin_TARGET_OS
- | Framework String
-#endif
+
+ | Framework String -- Only used for darwin, but does no harm
-- If this package is already part of the GHCi binary, we'll already
-- have the right DLLs for this package loaded, so don't try to
= [ "base", "haskell98", "haskell-src", "readline" ]
# endif
-showLS (Object nm) = "(static) " ++ nm
-showLS (DLL nm) = "(dynamic) " ++ nm
-#ifdef darwin_TARGET_OS
+showLS (Object nm) = "(static) " ++ nm
+showLS (DLL nm) = "(dynamic) " ++ nm
showLS (Framework nm) = "(framework) " ++ nm
-#endif
linkPackages :: DynFlags -> [PackageName] -> IO ()
-- Link exactly the specified packages, and their dependents
let libs = Packages.hs_libraries pkg ++ extra_libraries pkg
++ [ lib | '-':'l':lib <- extra_ld_opts pkg ]
classifieds <- mapM (locateOneObj dirs) libs
-#ifdef darwin_TARGET_OS
- let fwDirs = Packages.framework_dirs pkg
- let frameworks= Packages.extra_frameworks pkg
-#endif
-- Complication: all the .so's must be loaded before any of the .o's.
let dlls = [ dll | DLL dll <- classifieds ]
-- See comments with partOfGHCi
when (Packages.name pkg `notElem` partOfGHCi) $ do
-#ifdef darwin_TARGET_OS
- loadFrameworks fwDirs frameworks
-#endif
- loadDynamics dirs dlls
+ loadFrameworks pkg
+ mapM_ (load_dyn dirs) dlls
-- After loading all the DLLs, we can load the static objects.
mapM_ loadObj objs
if succeeded ok then maybePutStrLn dflags "done."
else panic ("can't load package `" ++ name pkg ++ "'")
-loadDynamics dirs [] = return ()
-loadDynamics dirs (dll:dlls) = do
- r <- loadDynamic dirs dll
- case r of
- Nothing -> loadDynamics dirs dlls
- Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: "
- ++ dll ++ " (" ++ err ++ ")" ))
-#ifdef darwin_TARGET_OS
-loadFrameworks dirs [] = return ()
-loadFrameworks dirs (fw:fws) = do
- r <- loadFramework dirs fw
- case r of
- Nothing -> loadFrameworks dirs fws
- Just err -> throwDyn (CmdLineError ("can't load framework: "
- ++ fw ++ " (" ++ err ++ ")" ))
+load_dyn dirs dll = do r <- loadDynamic dirs dll
+ case r of
+ Nothing -> return ()
+ Just err -> throwDyn (CmdLineError ("can't load .so/.DLL for: "
+ ++ dll ++ " (" ++ err ++ ")" ))
+#ifndef darwin_TARGET_OS
+loadFrameworks pkg = return ()
+#else
+loadFrameworks pkg = mapM_ load frameworks
+ where
+ fw_dirs = Packages.framework_dirs pkg
+ frameworks = Packages.extra_frameworks pkg
+
+ load fw = do r <- loadFramework fw_dirs fw
+ case r of
+ Nothing -> return ()
+ Just err -> throwDyn (CmdLineError ("can't load framework: "
+ ++ fw ++ " (" ++ err ++ ")" ))
#endif
-- Try to find an object file for a given library in the given paths.
= do { mb_obj_path <- findFile mk_obj_path dirs
; case mb_obj_path of
Just obj_path -> return (Object obj_path)
- Nothing -> return (DLL lib) } -- we assume
+ Nothing -> return (DLL lib) } -- We assume
where
mk_obj_path dir = dir ++ '/':lib ++ ".o"
{-# OPTIONS -#include "Linker.h" #-}
module ObjLink (
- initLinker, -- :: IO ()
- loadDLL, -- :: String -> IO (Maybe String)
- loadObj, -- :: String -> IO ()
- unloadObj, -- :: String -> IO ()
- lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
- resolveObjs -- :: IO SuccessFlag
+ initObjLinker, -- :: IO ()
+ loadDLL, -- :: String -> IO (Maybe String)
+ loadObj, -- :: String -> IO ()
+ unloadObj, -- :: String -> IO ()
+ lookupSymbol, -- :: String -> IO (Maybe (Ptr a))
+ resolveObjs -- :: IO SuccessFlag
) where
import Monad ( when )
#if __GLASGOW_HASKELL__ >= 504
foreign import ccall unsafe "addDLL" c_addDLL :: CString -> IO CString
-foreign import ccall unsafe "initLinker" initLinker :: IO ()
+foreign import ccall unsafe "initLinker" initObjLinker :: IO ()
foreign import ccall unsafe "lookupSymbol" c_lookupSymbol :: CString -> IO (Ptr a)
foreign import ccall unsafe "loadObj" c_loadObj :: CString -> IO Int
foreign import ccall unsafe "unloadObj" c_unloadObj :: CString -> IO Int
{-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
-----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.119 2003/02/17 12:24:27 simonmar Exp $
+-- $Id: Main.hs,v 1.120 2003/05/19 15:39:18 simonpj Exp $
--
-- GHC Driver program
--
#ifdef GHCI
-import InteractiveUI
-import DriverPhases( objish_file )
+import InteractiveUI( ghciWelcomeMsg, interactiveUI )
#endif
dynamic_flags, processArgs, static_flags)
import DriverMkDepend ( beginMkDependHS, endMkDependHS )
-import DriverPhases ( Phase(HsPp, Hsc), haskellish_src_file, isSourceFile )
+import DriverPhases ( Phase(HsPp, Hsc), haskellish_src_file, objish_file, isSourceFile )
import DriverUtil ( add, handle, handleDyn, later, splitFilename,
unknownFlagsErr, getFileSuffix )
conf_file <- getPackageConfigPath
readPackageConf conf_file
- -- process all the other arguments, and get the source files
+ -- Process all the other arguments, and get the source files
non_static <- processArgs static_flags argv' []
mode <- readIORef v_GhcMode
- stop_flag <- readIORef v_GhcModeFlag
-- -O and --interactive are not a good combination
-- ditto with any kind of way selection
verbosity = 1
})
- -- the rest of the arguments are "dynamic"
- srcs <- processArgs dynamic_flags (extra_non_static ++ non_static) []
+ -- The rest of the arguments are "dynamic"
+ -- Leftover ones are presumably files
+ fileish_args <- processArgs dynamic_flags (extra_non_static ++ non_static) []
+
+ -- We split out the object files (.o, .dll) and add them
+ -- to v_Ld_inputs for use by the linker
+ let (objs, srcs) = partition objish_file fileish_args
+ mapM_ (add v_Ld_inputs) objs
+
+ ---------------- Display banners and configuration -----------
+ showBanners mode conf_file static_opts
+
+ ---------------- Final sanity checking -----------
+ checkOptions mode srcs objs
+
+ ---------------- Do the business -----------
+ case mode of
+ DoMake -> doMake srcs
+ DoMkDependHS -> do { beginMkDependHS ;
+ compileFiles mode srcs;
+ endMkDependHS }
+ StopBefore p -> do { compileFiles mode srcs; return () }
+ DoMkDLL -> do { o_files <- compileFiles mode srcs;
+ doMkDLL o_files }
+ DoLink -> do { o_files <- compileFiles mode srcs;
+ omit_linking <- readIORef v_NoLink;
+ when (not omit_linking)
+ (staticLink o_files [basePackage, haskell98Package]) }
+ -- We always link in the base package in one-shot linking.
+ -- Any other packages required must be given using -package
+ -- options on the command-line.
+#ifndef GHCI
+ DoInteractive -> throwDyn (CmdLineError "not built for interactive use")
+#else
+ DoInteractive -> interactiveUI srcs
+#endif
+
+--------------------------------------------------------------------------------------
+checkOptions :: GhcMode -> [String] -> [String] -> IO ()
+ -- Final sanity checking before kicking of a compilation (pipeline).
+checkOptions mode srcs objs = do
+ -- -ohi sanity check
+ ohi <- readIORef v_Output_hi
+ if (isJust ohi &&
+ (mode == DoMake || mode == DoInteractive || srcs `lengthExceeds` 1))
+ then throwDyn (UsageError "-ohi can only be used when compiling a single source file")
+ else do
+
+ -- -o sanity checking
+ o_file <- readIORef v_Output_file
+ if (srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL)
+ then throwDyn (UsageError "can't apply -o to multiple source files")
+ else do
- -- save the "initial DynFlags" away
+ -- Check that there are some input files (except in the interactive case)
+ if null srcs && null objs && mode /= DoInteractive
+ then throwDyn (UsageError "no input files")
+ else do
+
+ -- Complain about any unknown flags
+ let unknown_opts = [ f | f@('-':_) <- srcs ]
+ when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+
+ -- Verify that output files point somewhere sensible.
+ verifyOutputFiles
+
+
+--------------------------------------------------------------------------------------
+compileFiles :: GhcMode
+ -> [String] -- Source files
+ -> IO [String] -- Object files
+compileFiles mode srcs = do
+ stop_flag <- readIORef v_GhcModeFlag
+
+ -- Do the business; save the DynFlags at the
+ -- start, so we can restore them before each file
saveDynFlags
+ mapM (compileFile mode stop_flag) srcs
+
- -- perform some checks of the options set / report unknowns.
- checkOptions srcs
+compileFile mode stop_flag src = do
+ restoreDynFlags
+
+ exists <- doesFileExist src
+ when (not exists) $
+ throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
+ -- We compile in two stages, because the file may have an
+ -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
+ let (basename, suffix) = splitFilename src
+
+ -- just preprocess (Haskell source only)
+ let src_and_suff = (src, getFileSuffix src)
+ let not_hs_file = not (haskellish_src_file src)
+ pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
+ then return src_and_suff else do
+ phases <- genPipeline (StopBefore Hsc) stop_flag
+ False{-not persistent-} defaultHscLang
+ src_and_suff
+ pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
+ basename suffix
+
+ -- rest of compilation
+ hsc_lang <- dynFlag hscLang
+ phases <- genPipeline mode stop_flag True hsc_lang pp
+ (r,_) <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
+ True{-use -o flag-} basename suffix
+ return r
+
+
+--------------------------------------------------------------------------------------
+doMake :: [String] -> IO ()
+doMake [] = throwDyn (UsageError "no input files")
+doMake srcs = do
+ dflags <- getDynFlags
+ state <- cmInit Batch
+ graph <- cmDepAnal state dflags srcs
+ (_, ok_flag, _) <- cmLoadModules state dflags graph
+ when (failed ok_flag) (exitWith (ExitFailure 1))
+ return ()
+
+
+
+--------------------------------------------------------------------------------------
+showBanners :: GhcMode -> FilePath -> [String] -> IO ()
+showBanners mode conf_file static_opts = do
verb <- dynFlag verbosity
-- Show the GHCi banner
when (verb >= 3)
(hPutStrLn stderr ("Hsc static flags: " ++ unwords static_opts))
-
- -- mkdependHS is special
- when (mode == DoMkDependHS) beginMkDependHS
-
- -- -ohi sanity checking
- ohi <- readIORef v_Output_hi
- if (isJust ohi &&
- (mode == DoMake || mode == DoInteractive || srcs `lengthExceeds` 1))
- then throwDyn (UsageError "-ohi can only be used when compiling a single source file")
- else do
-
- -- make/interactive require invoking the compilation manager
- if (mode == DoMake) then beginMake srcs else do
- if (mode == DoInteractive) then beginInteractive srcs else do
-
- -- -o sanity checking
- let real_srcs = filter isSourceFile srcs -- filters out .a and .o that might appear
- o_file <- readIORef v_Output_file
- if (real_srcs `lengthExceeds` 1 && isJust o_file && mode /= DoLink && mode /= DoMkDLL)
- then throwDyn (UsageError "can't apply -o to multiple source files")
- else do
-
- if null srcs then throwDyn (UsageError "no input files") else do
-
- let compileFile src = do
- restoreDynFlags
-
- exists <- doesFileExist src
- when (not exists) $
- throwDyn (CmdLineError ("file `" ++ src ++ "' does not exist"))
-
- -- We compile in two stages, because the file may have an
- -- OPTIONS pragma that affects the compilation pipeline (eg. -fvia-C)
- let (basename, suffix) = splitFilename src
-
- -- just preprocess (Haskell source only)
- let src_and_suff = (src, getFileSuffix src)
- let not_hs_file = not (haskellish_src_file src)
- pp <- if not_hs_file || mode == StopBefore Hsc || mode == StopBefore HsPp
- then return src_and_suff else do
- phases <- genPipeline (StopBefore Hsc) stop_flag
- False{-not persistent-} defaultHscLang
- src_and_suff
- pipeLoop phases src_and_suff False{-no linking-} False{-no -o flag-}
- basename suffix
-
- -- rest of compilation
- hsc_lang <- dynFlag hscLang
- phases <- genPipeline mode stop_flag True hsc_lang pp
- (r,_) <- pipeLoop phases pp (mode==DoLink || mode==DoMkDLL)
- True{-use -o flag-} basename suffix
- return r
-
- o_files <- mapM compileFile srcs
-
- when (mode == DoMkDependHS) endMkDependHS
-
- omit_linking <- readIORef v_NoLink
- when (mode == DoLink && not omit_linking)
- (staticLink o_files [basePackage, haskell98Package])
- -- we always link in the base package in one-shot linking.
- -- any other packages required must be given using -package
- -- options on the command-line.
-
- when (mode == DoMkDLL) (doMkDLL o_files)
-
-
-
-beginMake :: [String] -> IO ()
-beginMake fileish_args = do
- -- anything that doesn't look like a Haskell source filename or
- -- a module name is passed straight through to the linker
- let (inputs, objects) = partition looks_like_an_input fileish_args
- mapM_ (add v_Ld_inputs) objects
-
- case inputs of
- [] -> throwDyn (UsageError "no input files")
- _ -> do dflags <- getDynFlags
- state <- cmInit Batch
- graph <- cmDepAnal state dflags inputs
- (_, ok_flag, _) <- cmLoadModules state dflags graph
- when (failed ok_flag) (exitWith (ExitFailure 1))
- return ()
- where
- {-
- The following things should be considered compilation manager inputs:
-
- - haskell source files (strings ending in .hs, .lhs or other
- haskellish extension),
-
- - module names (not forgetting hierarchical module names),
-
- - and finally we consider everything not containing a '.' to be
- a comp manager input, as shorthand for a .hs or .lhs filename.
-
- Everything else is considered to be a linker object, and passed
- straight through to the linker.
- -}
- looks_like_an_input m = haskellish_src_file m
- || looksLikeModuleName m
- || '.' `notElem` m
-
-
-beginInteractive :: [String] -> IO ()
-#ifndef GHCI
-beginInteractive = throwDyn (CmdLineError "not built for interactive use")
-#else
-beginInteractive fileish_args
- = do state <- cmInit Interactive
-
- let (objs, mods) = partition objish_file fileish_args
-
- interactiveUI state mods objs
-#endif
-
-checkOptions :: [String] -> IO ()
-checkOptions srcs = do
- -- complain about any unknown flags
- let unknown_opts = [ f | f@('-':_) <- srcs ]
- when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
- -- verify that output files point somewhere sensible.
- verifyOutputFiles
- -- and anything else that it might be worth checking for
- -- before kicking of a compilation (pipeline).
-
projects / ghc-hetmet.git / commitdiff