X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FCodeOutput.lhs;h=2c8a399a1b6c3aac12721891754054560fad06a3;hb=b8c0cca3b6d0203144bf4ef213be4597ce86eb33;hp=30f273ebaafc1879063f622cbea65b62b1cc56d1;hpb=61d2625ae2e6a4cdae2ffc92df828905e81c24cc;p=ghc-hetmet.git diff --git a/compiler/main/CodeOutput.lhs b/compiler/main/CodeOutput.lhs index 30f273e..2c8a399 100644 --- a/compiler/main/CodeOutput.lhs +++ b/compiler/main/CodeOutput.lhs @@ -4,6 +4,13 @@ \section{Code output phase} \begin{code} +{-# OPTIONS_GHC -w #-} +-- The above warning supression flag is a temporary kludge. +-- While working on this module you are encouraged to remove it and fix +-- any warnings in the module. See +-- http://hackage.haskell.org/trac/ghc/wiki/WorkingConventions#Warnings +-- for details + module CodeOutput( codeOutput, outputForeignStubs ) where #include "HsVersions.h" @@ -13,10 +20,6 @@ import UniqSupply ( mkSplitUniqSupply ) import AsmCodeGen ( nativeCodeGen ) #endif -#ifdef ILX -import IlxGen ( ilxGen ) -#endif - #ifdef JAVA import JavaGen ( javaGen ) import qualified PrintJava @@ -30,9 +33,10 @@ import Packages import PackageConfig ( rtsPackageId ) import Util import FastString ( unpackFS ) -import Cmm ( Cmm ) +import Cmm ( RawCmm ) import HscTypes import DynFlags + import ErrUtils ( dumpIfSet_dyn, showPass, ghcExit ) import Outputable import Pretty ( Mode(..), printDoc ) @@ -58,7 +62,7 @@ codeOutput :: DynFlags -> ModLocation -> ForeignStubs -> [PackageId] - -> [Cmm] -- Compiled C-- + -> [RawCmm] -- Compiled C-- -> IO (Bool{-stub_h_exists-}, Bool{-stub_c_exists-}) codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC @@ -94,13 +98,6 @@ codeOutput dflags this_mod location foreign_stubs pkg_deps flat_abstractC #else panic "Java support not compiled into this ghc"; #endif - HscILX -> -#ifdef ILX - let tycons = typeEnvTyCons type_env in - outputIlx dflags filenm mod_name tycons stg_binds; -#else - panic "ILX support not compiled into this ghc"; -#endif } ; return stubs_exist } @@ -126,7 +123,7 @@ outputC dflags filenm mod location flat_absC -- * -#include options from the cmdline and OPTIONS pragmas -- * the _stub.h file, if there is one. -- - pkg_configs <- getExplicitPackagesAnd dflags packages + pkg_configs <- getPreloadPackagesAnd dflags packages let pkg_names = map (showPackageId.package) pkg_configs c_includes <- getPackageCIncludes pkg_configs @@ -134,15 +131,15 @@ outputC dflags filenm mod location flat_absC ffi_decl_headers = case foreign_stubs of - NoStubs -> [] - ForeignStubs _ _ fdhs _ -> map unpackFS (nub fdhs) + NoStubs -> [] + ForeignStubs _ _ fdhs -> map unpackFS (nub fdhs) -- Remove duplicates, because distinct foreign import decls -- may cite the same #include. Order doesn't matter. all_headers = c_includes ++ reverse cmdline_includes ++ ffi_decl_headers - + let cc_injects = unlines (map mk_include all_headers) mk_include h_file = case h_file of @@ -173,11 +170,10 @@ outputAsm dflags filenm flat_absC #ifndef OMIT_NATIVE_CODEGEN = do ncg_uniqs <- mkSplitUniqSupply 'n' - ncg_output_d <- _scc_ "NativeCodeGen" - nativeCodeGen dflags flat_absC ncg_uniqs - dumpIfSet_dyn dflags Opt_D_dump_asm "Asm code" (docToSDoc ncg_output_d) - _scc_ "OutputAsm" doOutput filenm $ - \f -> printDoc LeftMode f ncg_output_d + + {-# SCC "OutputAsm" #-} doOutput filenm $ + \f -> {-# SCC "NativeCodeGen" #-} + nativeCodeGen dflags f ncg_uniqs flat_absC where #else /* OMIT_NATIVE_CODEGEN */ @@ -211,22 +207,6 @@ outputJava dflags filenm mod tycons core_binds %************************************************************************ %* * -\subsection{Ilx} -%* * -%************************************************************************ - -\begin{code} -#ifdef ILX -outputIlx dflags filename mod tycons stg_binds - = doOutput filename (\ f -> printForC f pp_ilx) - where - pp_ilx = ilxGen mod tycons stg_binds -#endif -\end{code} - - -%************************************************************************ -%* * \subsection{Foreign import/export} %* * %************************************************************************ @@ -243,7 +223,7 @@ outputForeignStubs dflags mod location stubs stub_h_exists <- doesFileExist stub_h return (stub_h_exists, stub_c_exists) - | ForeignStubs h_code c_code _ _ <- stubs + | ForeignStubs h_code c_code _ <- stubs = do let stub_c_output_d = pprCode CStyle c_code