[project @ 2000-07-03 16:45:04 by keithw]

[ghc-hetmet.git] / ghc / driver / Main.hs

diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 0a06293..6c982ad 100644 (file)
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -51,7 +51,7 @@ name = global (value) :: IORef (ty); \
 -----------------------------------------------------------------------------
 -- non-configured things
 
-_Haskell1Version = "5" -- i.e., Haskell 98
+cHaskell1Version = "5" -- i.e., Haskell 98
 
 -----------------------------------------------------------------------------
 -- Usage Message
@@ -61,8 +61,9 @@ short_usage = do
   exitWith ExitSuccess
    
 long_usage = do
-  let usage_dir = findFile "ghc-usage.txt" (cGHC_DRIVER_DIR++"/ghc-usage.txt")
-  usage <- readFile (usage_dir++"/ghc-usage.txt")
+  let usage_filename = "ghc-usage.txt"
+      usage_dir = findFile usage_filename cGHC_DRIVER_DIR
+  usage <- readFile (usage_dir ++ "/" ++ usage_filename)
   dump usage
   exitWith ExitSuccess
   where
@@ -200,7 +201,7 @@ getStopAfter flags
        -- Cpp-related flags
 GLOBAL_VAR(cpp_flag, False, Bool)
 hs_source_cpp_opts = global
-       [ "-D__HASKELL1__="++_Haskell1Version
+       [ "-D__HASKELL1__="++cHaskell1Version
        , "-D__GLASGOW_HASKELL__="++cProjectVersionInt                          
        , "-D__HASKELL98__"
        , "-D__CONCURRENT_HASKELL__"
@@ -755,7 +756,7 @@ way_details =
 
 GLOBAL_VAR(pgm_dep, findFile "mkdependHS" cGHC_MKDEPENDHS, String)
 GLOBAL_VAR(pgm_L,   findFile "unlit"      cGHC_UNLIT,      String)
-GLOBAL_VAR(pgm_P,   findFile "hscpp"      cGHC_HSCPP,      String)
+GLOBAL_VAR(pgm_P,   cRAWCPP,                              String)
 GLOBAL_VAR(pgm_C,   findFile "hsc"        cGHC_HSC,        String)
 GLOBAL_VAR(pgm_c,   cGCC,                                 String)
 GLOBAL_VAR(pgm_m,   findFile "ghc-asm"    cGHC_MANGLER,    String)
@@ -945,6 +946,7 @@ getOptionsFromSource file
            l <- hGetLine h
            case () of
                () | null l -> look h
+                  | prefixMatch "#" l -> look h
                   | prefixMatch "{-# LINE" l -> look h
                   | Just (opts:_) <- matchRegex optionRegex l
                        -> return (words opts)
@@ -1121,7 +1123,8 @@ run_pipeline last_phase do_linking use_ofile orig_basename (phase, input_fn)
          case phase of
                Hsc -> case lang of
                            HscC   -> HCc
-                           HscAsm -> As
+                           HscAsm | split     -> SplitMangle
+                                  | otherwise -> As
 
                HCc  | mangle    -> Mangle
                     | otherwise -> As
@@ -1200,11 +1203,9 @@ newTempName extn = do
 
 do_mkdependHS :: [String] -> [String] -> IO ()
 do_mkdependHS cmd_opts srcs = do
-
-    --         # They're not (currently) needed, but we need to quote any -#include options
-    -- foreach (@Cmd_opts) {
-    --            s/-#include.*$/'$&'/g;
-    -- };  
+   -- HACK
+   let quote_include_opt o | prefixMatch "-#include" o = "'" ++ o ++ "'"
+                           | otherwise                 = o
 
    mkdependHS      <- readIORef pgm_dep
    mkdependHS_opts <- getOpts opt_dep
@@ -1214,7 +1215,7 @@ do_mkdependHS cmd_opts srcs = do
        (unwords (mkdependHS : 
                      mkdependHS_opts
                   ++ hs_src_cpp_opts
-                  ++ ("--" : cmd_opts )
+                  ++ ("--" : map quote_include_opt cmd_opts )
                   ++ ("--" : srcs)
        ))
 
@@ -1225,11 +1226,11 @@ run_phase Unlit basename input_fn output_fn
   = do unlit <- readIORef pgm_L
        unlit_flags <- getOpts opt_L
        run_something "Literate pre-processor"
-         ("echo '{-# LINE 1 \"" ++input_fn++"\" -}' > "++output_fn++" && "
+         ("echo '# 1 \"" ++input_fn++"\"' > "++output_fn++" && "
           ++ unlit ++ ' ':input_fn ++ " - >> " ++ output_fn)
 
 -------------------------------------------------------------------------------
--- HsCpp phase 
+-- Cpp phase 
 
 run_phase Cpp basename input_fn output_fn
   = do src_opts <- getOptionsFromSource input_fn
@@ -1255,7 +1256,7 @@ run_phase Cpp basename input_fn output_fn
                    ++ include_paths
                    ++ hs_src_cpp_opts
                    ++ hscpp_opts
-                   ++ [ input_fn, ">>", output_fn ]
+                   ++ [ "-x", "c", input_fn, ">>", output_fn ]
                   ))
          else do
            run_something "Inefective C pre-processor"
@@ -1272,8 +1273,7 @@ run_phase Hsc     basename input_fn output_fn
   -- we add the current directory (i.e. the directory in which
   -- the .hs files resides) to the import path, since this is
   -- what gcc does, and it's probably what you want.
-       let (root,dir) = break (=='/') (reverse basename)
-           current_dir = if null dir then "." else reverse dir
+       let current_dir = getdir basename
        
        paths <- readIORef include_paths
        writeIORef include_paths (current_dir : paths)
@@ -1304,27 +1304,26 @@ run_phase Hsc   basename input_fn output_fn
        add files_to_clean tmp_stub_h
        add files_to_clean tmp_stub_c
        
+  -- figure out where to put the .hi file
+       ohi    <- readIORef output_hi
+       hisuf  <- readIORef hi_suf
+       let hi_flags = case ohi of
+                          Nothing -> [ "-hidir="++current_dir, "-hisuf="++hisuf ]
+                          Just fn -> [ "-hifile="++fn ]
+
+  -- run the compiler!
        run_something "Haskell Compiler" 
                 (unwords (hsc : input_fn : (
                    hsc_opts
-                   ++ [ hi_flag, " -ofile="++output_fn ]
-                   ++ [ "-F="++tmp_stub_c, "-FH="++tmp_stub_h ]
+                   ++ hi_flags
+                   ++ [ 
+                         "-ofile="++output_fn, 
+                         "-F="++tmp_stub_c, 
+                         "-FH="++tmp_stub_h 
+                      ]
                    ++ stat_opts
                 )))
 
-  -- Copy the .hi file into the current dir if it changed
-       on doing_hi 
-                 (do ohi <- readIORef output_hi
-                     hisuf <- readIORef hi_suf
-                     let hi_target = case ohi of
-                                       Nothing -> basename ++ '.':hisuf
-                                       Just fn -> fn
-                     new_hi_file <- fileExist tmp_hi_file
-                     on new_hi_file
-                            (run_something "Copy hi file"
-                               (unwords ["mv", tmp_hi_file, hi_target]))
-                 )     
-       
   -- Generate -Rghc-timing info
        on (timing) (
            run_something "Generate timing stats"
@@ -1550,10 +1549,12 @@ do_link o_files unknown_srcs = do
        -- probably _stub.o files
     extra_ld_inputs <- readIORef ld_inputs
 
+       -- opts from -optl-<blah>
+    extra_ld_opts <- getOpts opt_l
+
     run_something "Linker"
        (unwords 
         ([ ln, verb, "-o", output_fn ]
-            -- ToDo: -u <blah> options
         ++ o_files
         ++ unknown_srcs
         ++ extra_ld_inputs
@@ -1562,6 +1563,7 @@ do_link o_files unknown_srcs = do
         ++ pkg_lib_path_opts
         ++ pkg_lib_opts
         ++ pkg_extra_ld_opts
+        ++ extra_ld_opts
        )
        )
 
@@ -1969,6 +1971,11 @@ take_longest_prefix s c = reverse pre
 newsuf :: String -> String -> String
 newsuf suf s = remove_suffix s '.' ++ suf
 
+-- getdir strips the filename off the input string, returning the directory.
+getdir :: String -> String
+getdir s = if null dir then "." else init dir
+  where dir = take_longest_prefix s '/'
+
 newdir :: String -> String -> String
 newdir dir s = dir ++ '/':drop_longest_prefix s '/'