Commit 01379cdc authored by simonmar's avatar simonmar
Browse files

[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>).
parent e23315b8
......@@ -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
......
......@@ -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
......
......@@ -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 '/'
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment