[project @ 2003-07-21 15:14:18 by ross]
[ghc-hetmet.git] / ghc / compiler / main / Main.hs
index 23bbec1..7da0074 100644 (file)
@@ -1,7 +1,7 @@
 {-# OPTIONS -fno-warn-incomplete-patterns -optc-DNON_POSIX_SOURCE #-}
 
 -----------------------------------------------------------------------------
--- $Id: Main.hs,v 1.122 2003/05/21 12:38:36 simonmar Exp $
+-- $Id: Main.hs,v 1.131 2003/07/21 15:14:18 ross Exp $
 --
 -- GHC Driver program
 --
@@ -25,11 +25,12 @@ import InteractiveUI( ghciWelcomeMsg, interactiveUI )
 import CompManager     ( cmInit, cmLoadModules, cmDepAnal )
 import HscTypes                ( GhciMode(..) )
 import Config          ( cBooterVersion, cGhcUnregisterised, cProjectVersion )
-import SysTools                ( getPackageConfigPath, initSysTools, cleanTempFiles )
+import SysTools                ( getPackageConfigPath, initSysTools, cleanTempFiles,
+                         normalisePath )
 import Packages                ( showPackages, getPackageConfigMap, basePackage,
                          haskell98Package
                        )
-import DriverPipeline  ( staticLink, doMkDLL, genPipeline, pipeLoop )
+import DriverPipeline  ( staticLink, doMkDLL, runPipeline )
 import DriverState     ( buildCoreToDo, buildStgToDo,
                          findBuildTag, 
                          getPackageExtraGhcOpts, unregFlags, 
@@ -43,14 +44,12 @@ import DriverFlags  ( buildStaticHscOpts,
                          dynamic_flags, processArgs, static_flags)
 
 import DriverMkDepend  ( beginMkDependHS, endMkDependHS )
-import DriverPhases    ( Phase(HsPp, Hsc), haskellish_src_file, objish_file, isSourceFile )
+import DriverPhases    ( isSourceFile )
 
-import DriverUtil      ( add, handle, handleDyn, later, splitFilename,
-                         unknownFlagsErr, getFileSuffix )
+import DriverUtil      ( add, handle, handleDyn, later, unknownFlagsErr )
 import CmdLineOpts     ( dynFlag, restoreDynFlags,
                          saveDynFlags, setDynFlags, getDynFlags, dynFlag,
-                         DynFlags(..), HscLang(..), v_Static_hsc_opts,
-                         defaultHscLang
+                         DynFlags(..), HscLang(..), v_Static_hsc_opts
                        )
 import BasicTypes      ( failed )
 import Outputable
@@ -98,7 +97,7 @@ main =
           hFlush stdout
           case exception of
                -- an IO exception probably isn't our fault, so don't panic
-               IOException _ ->  hPutStr stderr (show exception)
+               IOException _ ->  hPutStrLn stderr (show exception)
                AsyncException StackOverflow ->
                        hPutStrLn stderr "stack overflow: use +RTS -K<size> \ 
                                         \to increase it"
@@ -161,7 +160,7 @@ main =
    extra_non_static <- processArgs static_flags 
                           (unreg_opts ++ way_opts ++ pkg_extra_opts) []
 
-       -- give the static flags to hsc
+       -- Give the static flags to hsc
    static_opts <- buildStaticHscOpts
    writeIORef v_Static_hsc_opts static_opts
 
@@ -198,9 +197,34 @@ main =
        -- save the "initial DynFlags" away
    saveDynFlags
 
-       -- 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
+   let
+    {-
+      We split out the object files (.o, .dll) and add them
+      to v_Ld_inputs for use by the linker.
+
+      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 =  isSourceFile m 
+                         || looksLikeModuleName m
+                         || '.' `notElem` m
+
+     -- To simplify the handling of filepaths, we normalise all filepaths right 
+     -- away - e.g., for win32 platforms, backslashes are converted
+     -- into forward slashes.
+    normal_fileish_paths = map normalisePath fileish_args
+    (srcs, objs)         = partition looks_like_an_input normal_fileish_paths
+
    mapM_ (add v_Ld_inputs) objs
 
        ---------------- Display banners and configuration -----------
@@ -209,6 +233,12 @@ main =
        ---------------- Final sanity checking -----------
    checkOptions mode srcs objs
 
+    -- 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.
+   let def_hs_pkgs = [basePackage, haskell98Package]
+
        ---------------- Do the business -----------
    case mode of
        DoMake         -> doMake srcs
@@ -218,16 +248,11 @@ main =
                               endMkDependHS }
        StopBefore p   -> do { compileFiles mode srcs; return () }
        DoMkDLL        -> do { o_files <- compileFiles mode srcs; 
-                              doMkDLL o_files }
+                              doMkDLL o_files def_hs_pkgs }
        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.
+                                   (staticLink o_files def_hs_pkgs) }
 
 #ifndef GHCI
        DoInteractive -> throwDyn (CmdLineError "not built for interactive use")
@@ -241,6 +266,10 @@ main =
 checkOptions :: GhcMode -> [String] -> [String] -> IO ()
      -- Final sanity checking before kicking off a compilation (pipeline).
 checkOptions mode srcs objs = do
+     -- Complain about any unknown flags
+   let unknown_opts = [ f | f@('-':_) <- srcs ]
+   when (notNull unknown_opts) (unknownFlagsErr unknown_opts)
+
        -- -ohi sanity check
    ohi <- readIORef v_Output_hi
    if (isJust ohi && 
@@ -260,10 +289,6 @@ checkOptions mode srcs objs = do
        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
 
@@ -286,27 +311,14 @@ compileFile mode stop_flag src = do
    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_file   <- readIORef v_Output_file
+       -- when linking, the -o argument refers to the linker's output. 
+       -- otherwise, we use it as the name for the pipeline's output.
+   let maybe_o_file
+         | mode==DoLink || mode==DoMkDLL  = Nothing
+         | otherwise                      = o_file
+
+   runPipeline mode stop_flag True maybe_o_file src Nothing{-no ModLocation-}
 
 
 -- ----------------------------------------------------------------------------