[project @ 2000-06-29 13:08:59 by simonmar]

hi files are now named after the module being compiled, not the
original filename (unless of course the user has specified -ohi <blah>).

diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 25d080e..984ff7b 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -136,7 +136,9 @@ module CmdLineOpts (
        opt_OmitInterfacePragmas,
        opt_ProduceExportCStubs,
        opt_ProduceExportHStubs,
-       opt_ProduceHi,
+       opt_HiFile,
+       opt_HiDir,
+       opt_HiSuf,
        opt_NoPruneTyDecls,
        opt_NoPruneDecls,
        opt_ReportCompile,
@@ -418,7 +420,11 @@ opt_OmitBlackHoling                = lookUp  SLIT("-dno-black-holing")
 opt_OmitInterfacePragmas       = lookUp  SLIT("-fomit-interface-pragmas")
 opt_ProduceExportCStubs                = lookup_str "-F="
 opt_ProduceExportHStubs                = lookup_str "-FH="
-opt_ProduceHi                  = lookup_str "-hifile=" -- the one to produce this time 
+
+-- where to generate the .hi file
+opt_HiFile                     = lookup_str "-hifile="
+opt_HiDir                      = lookup_str "-hidir="
+opt_HiSuf                      = lookup_str "-hisuf="
 
 -- Language for output: "C", "asm", "java", maybe more
 -- Nothing => don't output anything

diff --git a/ghc/compiler/main/MkIface.lhs b/ghc/compiler/main/MkIface.lhs
index 7370529..fbca8ce 100644 (file)
--- a/ghc/compiler/main/MkIface.lhs
+++ b/ghc/compiler/main/MkIface.lhs
@@ -20,7 +20,6 @@ import BasicTypes     ( Fixity(..), FixityDirection(..), NewOrData(..),
                          Version, bumpVersion, initialVersion, isLoopBreaker
                        )
 import RnMonad
-import RnEnv           ( availName )
 
 import TcInstUtil      ( InstInfo(..) )
 
@@ -42,8 +41,7 @@ import IdInfo         ( IdInfo, StrictnessInfo(..), ArityInfo(..), InlinePragInfo(..),
 import CoreSyn         ( CoreExpr, CoreBind, Bind(..), isBuiltinRule, rulesRules, rulesRhsFreeVars )
 import CoreFVs         ( exprSomeFreeVars, ruleSomeLhsFreeVars, ruleSomeFreeVars )
 import CoreUnfold      ( okToUnfoldInHiFile, couldBeSmallEnoughToInline )
-import Module          ( moduleString, pprModule, pprModuleName )
-import RdrName         ( RdrName )
+import Module          ( moduleString, pprModule, pprModuleName, moduleUserString )
 import Name            ( isLocallyDefined, isWiredInName, toRdrName, nameModule,
                          Name, NamedThing(..)
                        )
@@ -59,18 +57,17 @@ import Type         ( mkSigmaTy, splitSigmaTy, mkDictTy, tidyTopType,
                        )
 
 import PprType
-import FunDeps         ( pprFundeps )
 import Rules           ( pprProtoCoreRule, ProtoCoreRule(..) )
 
 import Bag             ( bagToList, isEmptyBag )
 import Maybes          ( catMaybes, maybeToBool )
-import FiniteMap       ( emptyFM, addToFM, addToFM_C, fmToList, FiniteMap )
 import UniqFM          ( lookupUFM, listToUFM )
-import UniqSet         ( uniqSetToList )
 import Util            ( sortLt, mapAccumL )
 import SrcLoc          ( noSrcLoc )
 import Bag
 import Outputable
+
+import Maybe           ( isNothing )
 \end{code}
 
 
@@ -84,10 +81,22 @@ import Outputable
 writeIface this_mod old_iface new_iface
           local_tycons local_classes inst_info
           final_ids tidy_binds tidy_orphan_rules
-  = case opt_ProduceHi of {
-      Nothing -> return () ; -- not producing any .hi file
-
-      Just filename ->
+  = 
+    if isNothing opt_HiDir && isNothing opt_HiFile
+       then return ()  -- not producing any .hi file
+       else 
+
+    let 
+       hi_suf = case opt_HiSuf of { Nothing -> "hi"; Just suf -> suf }
+       filename = case opt_HiFile of {
+                       Just f  -> f;
+                       Nothing -> 
+                  case opt_HiDir of {
+                       Just dir -> dir ++ '/':moduleUserString this_mod 
+                                       ++ '.':hi_suf;
+                       Nothing  -> panic "writeIface"
+               }}
+    in
 
     case checkIface old_iface full_new_iface of {
        Nothing -> do { putStrLn "Interface file unchanged" ;
@@ -105,7 +114,7 @@ writeIface this_mod old_iface new_iface
        if_hdl <- openFile filename WriteMode
        printForIface if_hdl (pprIface final_iface)
        hClose if_hdl
-    }}    
+    }   
   where
     full_new_iface = completeIface new_iface local_tycons local_classes
                                             inst_info final_ids tidy_binds

diff --git a/ghc/driver/Main.hs b/ghc/driver/Main.hs
index 1403830..13ca445 100644 (file)
--- a/ghc/driver/Main.hs
+++ b/ghc/driver/Main.hs
@@ -1273,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)
@@ -1305,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"
@@ -1973,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 '/'