[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>).

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

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

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 '/'