Commit 6eed5169 authored by sewardj's avatar sewardj

[project @ 2000-10-24 13:23:33 by sewardj]

Compile everything needed by main/HscMain.
parent 4e114182
......@@ -28,6 +28,7 @@ module CmdLineOpts (
dopt_CoreToDo,
dopt_StgToDo,
dopt_HscLang,
dopt_OutName,
-- profiling opts
opt_AutoSccsOnAllToplevs,
......@@ -276,10 +277,11 @@ data DynFlag
deriving (Eq)
data DynFlags = DynFlags {
coreToDo :: CoreToDo,
stgToDo :: StgToDo,
hscLang :: HscLang,
flags :: [DynFlag]
coreToDo :: CoreToDo,
stgToDo :: StgToDo,
hscLang :: HscLang,
hscOutName :: String, -- name of the file in which to place output
flags :: [DynFlag]
}
dopt :: DynFlag -> DynFlags -> Bool
......@@ -291,10 +293,13 @@ dopt_CoreToDo = coreToDo
dopt_StgToDo :: DynFlags -> StgToDo
dopt_StgToDo = stgToDo
dopt_OutName :: DynFlags -> String
dopt_OutName = hscOutName
data HscLang
= HscC String -- String is the filename to put output into
| HscAsm String -- ditto
| HscJava String -- ditto
= HscC
| HscAsm
| HscJava
| HscInterpreter
dopt_HscLang :: DynFlags -> HscLang
......
......@@ -31,8 +31,8 @@ import Module ( Module )
import CmdLineOpts
import ErrUtils ( dumpIfSet_dyn )
import Outputable
import CmdLineOpts ( DynFlags(..), HscLang(..) )
import TmpFiles ( newTmpName )
import CmdLineOpts ( DynFlags, HscLang(..), dopt_OutName )
import TmpFiles ( newTempName )
import IO ( IOMode(..), hClose, openFile, Handle )
\end{code}
......@@ -63,17 +63,18 @@ codeOutput dflags mod_name tycons classes core_binds stg_binds
-- Dunno if the above comment is still meaningful now. JRS 001024.
do stub_names <- outputForeignStubs c_code h_code
do let filenm = dopt_OutName dflags
stub_names <- outputForeignStubs dflags c_code h_code
case dopt_HscLang dflags of
HscInterpreter -> return stub_names
HscAsm filenm -> outputAsm dflags filenm flat_abstractC ncg_uniqs
HscAsm -> outputAsm dflags filenm flat_abstractC ncg_uniqs
>> return stub_names
HscC filenm -> outputC dflags filenm flat_abstractC
HscC -> outputC dflags filenm flat_abstractC
>> return stub_names
HscJava filenm -> outputJava dflags filenm mod_name tycons core_binds
HscJava -> outputJava dflags filenm mod_name tycons core_binds
>> return stub_names
doOutput :: (Handle -> IO ()) -> IO ()
doOutput :: String -> (Handle -> IO ()) -> IO ()
doOutput filenm io_action
= (do handle <- openFile filenm WriteMode
io_action handle
......@@ -91,7 +92,7 @@ doOutput filenm io_action
\begin{code}
outputC dflags filenm flat_absC
= do dumpIfSet_dyn Opt_D_dump_realC dflags "Real C" (dumpRealC flat_absC)
= do dumpIfSet_dyn dflags Opt_D_dump_realC "Real C" (dumpRealC flat_absC)
doOutput filenm (\ h -> writeRealC h flat_absC)
\end{code}
......@@ -107,8 +108,8 @@ outputAsm dflags filenm flat_absC ncg_uniqs
#ifndef OMIT_NATIVE_CODEGEN
= do dumpIfSet_dyn Opt_D_dump_stix dflags "Final stix code" stix_final
dumpIfSet_dyn Opt_D_dump_asm dflags "Asm code" ncg_output_d
= do dumpIfSet_dyn dflags Opt_D_dump_stix "Final stix code" stix_final
dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" ncg_output_d
doOutput filenm ( \f -> printForAsm f ncg_output_d)
where
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
......@@ -147,13 +148,13 @@ outputJava dflags filenm mod tycons core_binds
\begin{code}
outputForeignStubs dflags c_code h_code
= do
dumpIfSet_dyn Opt_D_dump_foreign dflags
dumpIfSet_dyn dflags Opt_D_dump_foreign
"Foreign export header file" stub_h_output_d
maybe_stub_h_file
<- outputForeignStubs_help True{-.h output-} stub_h_output_w
dumpIfSet_dyn Opt_D_dump_foreign dflags
dumpIfSet_dyn dflags Opt_D_dump_foreign
"Foreign export stubs" stub_c_output_d
maybe_stub_c_file
......@@ -173,13 +174,11 @@ outputForeignStubs dflags c_code h_code
-- Don't use doOutput for dumping the f. export stubs
-- since it is more than likely that the stubs file will
-- turn out to be empty, in which case no file should be created.
outputForeignStubs_help is_header switch "" = return Nothing
outputForeignStubs_help is_header switch doc_str =
case switch of
Nothing -> return Nothing
Just fname -> newTempName suffix >>= \ fname ->
writeFile fname (include_prefix ++ doc_str) >>
return (Just suffix)
outputForeignStubs_help is_header "" = return Nothing
outputForeignStubs_help is_header doc_str
= newTempName suffix >>= \ fname ->
writeFile fname (include_prefix ++ doc_str) >>
return (Just suffix)
where
suffix
| is_header = "h_stub"
......
-----------------------------------------------------------------------------
-- $Id: TmpFiles.hs,v 1.3 2000/10/23 09:03:27 simonpj Exp $
-- $Id: TmpFiles.hs,v 1.4 2000/10/24 13:23:33 sewardj Exp $
--
-- Temporary file management
--
......@@ -21,7 +21,9 @@ import Config
import Util
-- hslibs
-- import Posix commented out SLPJ
#ifndef mingw32_TARGET_OS
import Posix ( getProcessID )
#endif
import Exception
import IOExts
......@@ -57,6 +59,13 @@ cleanTempFiles verbose = do
type Suffix = String
-- find a temporary name that doesn't already exist.
#ifdef mingw32_TARGET_OS
getProcessID :: IO Int
getProcessID
= do putStr "warning: faking getProcessID in main/TmpFiles.lhs"
return 12345
#endif
newTempName :: Suffix -> IO FilePath
newTempName extn = do
x <- getProcessID
......
{-
-----------------------------------------------------------------------------
$Id: Parser.y,v 1.43 2000/10/24 08:40:10 simonpj Exp $
$Id: Parser.y,v 1.44 2000/10/24 13:23:33 sewardj Exp $
Haskell grammar.
......@@ -278,7 +278,7 @@ importdecls :: { [RdrNameImportDecl] }
importdecl :: { RdrNameImportDecl }
: 'import' srcloc maybe_src optqualified CONID maybeas maybeimpspec
{ ImportDecl (mkSrcModuleFS $5) $3 $4 $6 $7 $2 }
{ ImportDecl (mkModuleNameFS $5) $3 $4 $6 $7 $2 }
maybe_src :: { WhereFrom }
: '{-# SOURCE' '#-}' { ImportByUserSource }
......@@ -875,7 +875,7 @@ dbind : ipvar '=' exp { ($1, $3) }
depreclist :: { [RdrName] }
depreclist : deprec_var { [$1] }
| deprec_var ',' depreclist { $1 : $2 }
| deprec_var ',' depreclist { $1 : $3 }
deprec_var :: { RdrName }
deprec_var : var { $1 }
......@@ -1061,7 +1061,7 @@ layout_on_for_do :: { () } : {% layoutOn False }
-- Miscellaneous (mostly renamings)
modid :: { ModuleName }
: CONID { mkSrcModuleFS $1 }
: CONID { mkModuleNameFS $1 }
tycon :: { RdrName }
: CONID { mkUnqual tcClsName $1 }
......
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