Skip to content
GitLab
Menu
Projects
Groups
Snippets
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Menu
Open sidebar
Glasgow Haskell Compiler
GHC
Commits
4e114182
Commit
4e114182
authored
Oct 24, 2000
by
sewardj
Browse files
[project @ 2000-10-24 12:36:03 by sewardj]
Changes to make CodeOutput compile.
parent
a76db2a0
Changes
3
Hide whitespace changes
Inline
Side-by-side
ghc/compiler/main/CmdLineOpts.lhs
View file @
4e114182
...
...
@@ -12,7 +12,7 @@ module CmdLineOpts (
SwitchResult(..),
HscLang(..),
DynFlag(..), -- needed non-abstractly by DriverFlags
DynFlags
(..),
DynFlags
, -- abstract
intSwitchSet,
switchIsOn,
...
...
@@ -27,6 +27,7 @@ module CmdLineOpts (
-- other dynamic flags
dopt_CoreToDo,
dopt_StgToDo,
dopt_HscLang,
-- profiling opts
opt_AutoSccsOnAllToplevs,
...
...
@@ -291,11 +292,10 @@ dopt_StgToDo :: DynFlags -> StgToDo
dopt_StgToDo = stgToDo
data HscLang
= HscC
| HscAsm
| HscJava
= HscC
String -- String is the filename to put output into
| HscAsm
String -- ditto
| HscJava
String -- ditto
| HscInterpreter
deriving Eq
dopt_HscLang :: DynFlags -> HscLang
dopt_HscLang = hscLang
...
...
ghc/compiler/main/CodeOutput.lhs
View file @
4e114182
...
...
@@ -29,8 +29,11 @@ import PprAbsC ( dumpRealC, writeRealC )
import UniqSupply ( UniqSupply )
import Module ( Module )
import CmdLineOpts
import ErrUtils ( dumpIfSet )
import ErrUtils ( dumpIfSet
_dyn
)
import Outputable
import CmdLineOpts ( DynFlags(..), HscLang(..) )
import TmpFiles ( newTmpName )
import IO ( IOMode(..), hClose, openFile, Handle )
\end{code}
...
...
@@ -42,7 +45,8 @@ import IO ( IOMode(..), hClose, openFile, Handle )
%************************************************************************
\begin{code}
codeOutput :: Module
codeOutput :: DynFlags
-> Module
-> [TyCon] -> [Class] -- Local tycons and classes
-> [CoreBind] -- Core bindings
-> [(StgBinding,[Id])] -- The STG program with SRTs
...
...
@@ -50,30 +54,32 @@ codeOutput :: Module
-> SDoc -- Header file prototype for foreign exported functions
-> AbstractC -- Compiled abstract C
-> UniqSupply
-> IO ()
codeOutput mod_name tycons classes core_binds stg_binds
-> IO (
Maybe FilePath, Maybe FilePath
)
codeOutput
dflags
mod_name tycons classes core_binds stg_binds
c_code h_code flat_abstractC ncg_uniqs
= -- You can have C (c_output) or assembly-language (ncg_output),
-- but not both. [Allowing for both gives a space leak on
-- flat_abstractC. WDP 94/10]
do {
outputForeignStubs c_code h_code ;
case opt_OutputLanguage of {
Nothing -> return () -- No -olang=xxx flag; so no-op
; Just "asm" -> outputAsm flat_abstractC ncg_uniqs
; Just "C" -> outputC flat_abstractC
; Just "java" -> outputJava mod_name tycons core_binds
; Just foo -> pprPanic "Don't understand output language" (quotes (text foo))
} }
-- Dunno if the above comment is still meaningful now. JRS 001024.
do stub_names <- outputForeignStubs c_code h_code
case dopt_HscLang dflags of
HscInterpreter -> return stub_names
HscAsm filenm -> outputAsm dflags filenm flat_abstractC ncg_uniqs
>> return stub_names
HscC filenm -> outputC dflags filenm flat_abstractC
>> return stub_names
HscJava filenm -> outputJava dflags filenm mod_name tycons core_binds
>> return stub_names
doOutput :: (Handle -> IO ()) -> IO ()
doOutput io_action
= (do handle <- openFile
opt_OutputF
ile WriteMode
doOutput
filenm
io_action
= (do handle <- openFile
f
ile
nm
WriteMode
io_action handle
hClose handle)
`catch` (\err -> pprPanic "Failed to open or write code output file" (text opt_OutputFile))
`catch` (\err -> pprPanic "Failed to open or write code output file"
(text filenm))
\end{code}
...
...
@@ -84,10 +90,9 @@ doOutput io_action
%************************************************************************
\begin{code}
outputC flat_absC
= do
dumpIfSet opt_D_dump_realC "Real C" (dumpRealC flat_absC)
doOutput (\ h -> writeRealC h flat_absC)
outputC dflags filenm flat_absC
= do dumpIfSet_dyn Opt_D_dump_realC dflags "Real C" (dumpRealC flat_absC)
doOutput filenm (\ h -> writeRealC h flat_absC)
\end{code}
...
...
@@ -98,12 +103,13 @@ outputC flat_absC
%************************************************************************
\begin{code}
outputAsm flat_absC ncg_uniqs
outputAsm dflags filenm flat_absC ncg_uniqs
#ifndef OMIT_NATIVE_CODEGEN
= do dumpIfSet
o
pt_D_dump_stix "Final stix code" stix_final
dumpIfSet
o
pt_D_dump_asm "Asm code" ncg_output_d
doOutput ( \f -> printForAsm f ncg_output_d)
= do dumpIfSet
_dyn O
pt_D_dump_stix
dflags
"Final stix code" stix_final
dumpIfSet
_dyn O
pt_D_dump_asm
dflags
"Asm code" ncg_output_d
doOutput
filenm
( \f -> printForAsm f ncg_output_d)
where
(stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
...
...
@@ -123,8 +129,8 @@ outputAsm flat_absC ncg_uniqs
%************************************************************************
\begin{code}
outputJava mod tycons core_binds
= doOutput (\ f -> printForUser f pp_java)
outputJava
dflags filenm
mod tycons core_binds
= doOutput
filenm
(\ f -> printForUser f pp_java)
-- User style printing for now to keep indentation
where
java_code = javaGen mod [{- Should be imports-}] tycons core_binds
...
...
@@ -139,13 +145,21 @@ outputJava mod tycons core_binds
%************************************************************************
\begin{code}
outputForeignStubs c_code h_code
outputForeignStubs
dflags
c_code h_code
= do
dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d
outputForeignStubs_help True{-.h output-} opt_ProduceExportHStubs stub_h_output_w
dumpIfSet_dyn Opt_D_dump_foreign dflags
"Foreign export header file" stub_h_output_d
maybe_stub_h_file
<- outputForeignStubs_help True{-.h output-} stub_h_output_w
dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d
outputForeignStubs_help False{-not .h-} opt_ProduceExportCStubs stub_c_output_w
dumpIfSet_dyn Opt_D_dump_foreign dflags
"Foreign export stubs" stub_c_output_d
maybe_stub_c_file
<- outputForeignStubs_help False{-not .h-} stub_c_output_w
return (maybe_stub_h_file, maybe_stub_c_file)
where
-- C stubs for "foreign export"ed functions.
stub_c_output_d = pprCode CStyle c_code
...
...
@@ -159,14 +173,19 @@ outputForeignStubs 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
()
outputForeignStubs_help is_header switch "" = return
Nothing
outputForeignStubs_help is_header switch doc_str =
case switch of
Nothing -> return ()
Just fname -> writeFile fname (include_prefix ++ doc_str)
where
include_prefix
| is_header = "#include \"Rts.h\"\n"
| otherwise = "#include \"RtsAPI.h\"\n"
Nothing -> return Nothing
Just fname -> newTempName suffix >>= \ fname ->
writeFile fname (include_prefix ++ doc_str) >>
return (Just suffix)
where
suffix
| is_header = "h_stub"
| otherwise = "c_stub"
include_prefix
| is_header = "#include \"Rts.h\"\n"
| otherwise = "#include \"RtsAPI.h\"\n"
\end{code}
ghc/compiler/rename/RnHiFiles.lhs
View file @
4e114182
...
...
@@ -596,7 +596,7 @@ readIface wanted_mod file_path
noIfaceErr mod_name boot_file
= ptext SLIT("Could not find interface file for") <+> quotes (ppr mod_name)
-- We used to print the search path, but we can't do that
-- now, bec
u
ase it's hidden inside the finder.
-- now, beca
u
se it's hidden inside the finder.
-- Maybe the finder should expose more functions.
badIfaceFile file err
...
...
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment