Compile everything needed by main/HscMain.
dopt_CoreToDo,
dopt_StgToDo,
dopt_HscLang,
dopt_CoreToDo,
dopt_StgToDo,
dopt_HscLang,
-- profiling opts
opt_AutoSccsOnAllToplevs,
-- profiling opts
opt_AutoSccsOnAllToplevs,
deriving (Eq)
data DynFlags = DynFlags {
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
}
dopt :: DynFlag -> DynFlags -> Bool
dopt_StgToDo :: DynFlags -> StgToDo
dopt_StgToDo = stgToDo
dopt_StgToDo :: DynFlags -> StgToDo
dopt_StgToDo = stgToDo
+dopt_OutName :: DynFlags -> String
+dopt_OutName = hscOutName
+
- = HscC String -- String is the filename to put output into
- | HscAsm String -- ditto
- | HscJava String -- ditto
+ = HscC
+ | HscAsm
+ | HscJava
| HscInterpreter
dopt_HscLang :: DynFlags -> HscLang
| HscInterpreter
dopt_HscLang :: DynFlags -> HscLang
import CmdLineOpts
import ErrUtils ( dumpIfSet_dyn )
import Outputable
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}
import IO ( IOMode(..), hClose, openFile, Handle )
\end{code}
-- Dunno if the above comment is still meaningful now. JRS 001024.
-- 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
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
- HscC filenm -> outputC dflags filenm flat_abstractC
+ HscC -> outputC dflags filenm flat_abstractC
- HscJava filenm -> outputJava dflags filenm mod_name tycons core_binds
+ HscJava -> outputJava dflags filenm mod_name tycons core_binds
-doOutput :: (Handle -> IO ()) -> IO ()
+doOutput :: String -> (Handle -> IO ()) -> IO ()
doOutput filenm io_action
= (do handle <- openFile filenm WriteMode
io_action handle
doOutput filenm io_action
= (do handle <- openFile filenm WriteMode
io_action handle
\begin{code}
outputC dflags filenm flat_absC
\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}
doOutput filenm (\ h -> writeRealC h flat_absC)
\end{code}
#ifndef OMIT_NATIVE_CODEGEN
#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
doOutput filenm ( \f -> printForAsm f ncg_output_d)
where
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
\begin{code}
outputForeignStubs dflags c_code h_code
= do
\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
"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
"Foreign export stubs" stub_c_output_d
maybe_stub_c_file
-- 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.
-- 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"
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
--
--
-- Temporary file management
--
--- import Posix commented out SLPJ
+#ifndef mingw32_TARGET_OS
+import Posix ( getProcessID )
+#endif
import Exception
import IOExts
import Exception
import IOExts
type Suffix = String
-- find a temporary name that doesn't already exist.
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
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 $
importdecl :: { RdrNameImportDecl }
: 'import' srcloc maybe_src optqualified CONID maybeas maybeimpspec
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 }
maybe_src :: { WhereFrom }
: '{-# SOURCE' '#-}' { ImportByUserSource }
depreclist :: { [RdrName] }
depreclist : deprec_var { [$1] }
depreclist :: { [RdrName] }
depreclist : deprec_var { [$1] }
- | deprec_var ',' depreclist { $1 : $2 }
+ | deprec_var ',' depreclist { $1 : $3 }
deprec_var :: { RdrName }
deprec_var : var { $1 }
deprec_var :: { RdrName }
deprec_var : var { $1 }
-- Miscellaneous (mostly renamings)
modid :: { ModuleName }
-- Miscellaneous (mostly renamings)
modid :: { ModuleName }
- : CONID { mkSrcModuleFS $1 }
+ : CONID { mkModuleNameFS $1 }
tycon :: { RdrName }
: CONID { mkUnqual tcClsName $1 }
tycon :: { RdrName }
: CONID { mkUnqual tcClsName $1 }