ghc/compiler/main/CodeOutput.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section{Code output phase}
   5
   6 \begin{code}
   7 module CodeOutput( codeOutput ) where
   8
   9 #include "HsVersions.h"
  10
  11 #ifndef OMIT_NATIVE_CODEGEN
  12 import AsmCodeGen       ( nativeCodeGen )
  13 #endif
  14
  15 #ifdef ILX
  16 import IlxGen           ( ilxGen )
  17 #endif
  18
  19 import JavaGen          ( javaGen )
  20 import qualified PrintJava
  21
  22 import TyCon            ( TyCon )
  23 import Id               ( Id )
  24 import Class            ( Class )
  25 import CoreSyn          ( CoreBind )
  26 import StgSyn           ( StgBinding )
  27 import AbsCSyn          ( AbstractC, absCNop )
  28 import PprAbsC          ( dumpRealC, writeRealC )
  29 import UniqSupply       ( UniqSupply )
  30 import Module           ( Module, moduleString )
  31 import CmdLineOpts
  32 import Maybes           ( maybeToBool )
  33 import ErrUtils         ( doIfSet, dumpIfSet )
  34 import Outputable
  35 import IO               ( IOMode(..), hClose, openFile, Handle )
  36 \end{code}
  37
  38
  39 %************************************************************************
  40 %*                                                                      *
  41 \subsection{Steering}
  42 %*                                                                      *
  43 %************************************************************************
  44
  45 \begin{code}
  46 codeOutput :: Module
  47            -> [TyCon] -> [Class]        -- Local tycons and classes
  48            -> [CoreBind]                -- Core bindings
  49            -> [(StgBinding,[Id])]       -- The STG program with SRTs
  50            -> SDoc              -- C stubs for foreign exported functions
  51            -> SDoc              -- Header file prototype for foreign exported functions
  52            -> AbstractC         -- Compiled abstract C
  53            -> UniqSupply
  54            -> IO ()
  55 codeOutput mod_name tycons classes core_binds stg_binds
  56            c_code h_code flat_abstractC ncg_uniqs
  57   = -- You can have C (c_output) or assembly-language (ncg_output),
  58     -- but not both.  [Allowing for both gives a space leak on
  59     -- flat_abstractC.  WDP 94/10]
  60
  61     do  {
  62         outputForeignStubs c_code h_code ;
  63         case opt_OutputLanguage of {
  64           Nothing     -> return ()      -- No -olang=xxx flag; so no-op
  65         ; Just "asm"  -> outputAsm flat_abstractC ncg_uniqs
  66         ; Just "C"    -> outputC flat_abstractC
  67         ; Just "java" -> outputJava mod_name tycons core_binds
  68         ; Just foo    -> pprPanic "Don't understand output language" (quotes (text foo))
  69         } }
  70
  71
  72 doOutput :: (Handle -> IO ()) -> IO ()
  73 doOutput io_action
  74   = (do handle <- openFile opt_OutputFile WriteMode
  75         io_action handle
  76         hClose handle)
  77     `catch` (\err -> pprPanic "Failed to open or write code output file" (text opt_OutputFile))
  78 \end{code}
  79
  80
  81 %************************************************************************
  82 %*                                                                      *
  83 \subsection{C}
  84 %*                                                                      *
  85 %************************************************************************
  86
  87 \begin{code}
  88 outputC flat_absC
  89   = do
  90        dumpIfSet opt_D_dump_realC "Real C" (dumpRealC flat_absC)
  91        doOutput (\ h -> writeRealC h flat_absC)
  92 \end{code}
  93
  94
  95 %************************************************************************
  96 %*                                                                      *
  97 \subsection{Assembler}
  98 %*                                                                      *
  99 %************************************************************************
 100
 101 \begin{code}
 102 outputAsm flat_absC ncg_uniqs
 103 #ifndef OMIT_NATIVE_CODEGEN
 104
 105   = do dumpIfSet opt_D_dump_stix "Final stix code" stix_final
 106        dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d
 107        doOutput ( \f -> printForAsm f ncg_output_d)
 108   where
 109     (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
 110
 111 #else /* OMIT_NATIVE_CODEGEN */
 112
 113   = pprPanic "This compiler was built without a native code generator"
 114              (text "Use -fvia-C instead")
 115
 116 #endif
 117 \end{code}
 118
 119
 120 %************************************************************************
 121 %*                                                                      *
 122 \subsection{Java}
 123 %*                                                                      *
 124 %************************************************************************
 125
 126 \begin{code}
 127 outputJava mod tycons core_binds
 128   = doOutput (\ f -> printForUser f pp_java)
 129         -- User style printing for now to keep indentation
 130   where
 131     java_code = javaGen mod [{- Should be imports-}] tycons core_binds
 132     pp_java   = PrintJava.compilationUnit java_code
 133 \end{code}
 134
 135
 136 %************************************************************************
 137 %*                                                                      *
 138 \subsection{Foreign import/export}
 139 %*                                                                      *
 140 %************************************************************************
 141
 142 \begin{code}
 143 outputForeignStubs c_code h_code
 144   = do
 145         dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d
 146         outputForeignStubs_help True{-.h output-} opt_ProduceExportHStubs stub_h_output_w
 147
 148         dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d
 149         outputForeignStubs_help False{-not .h-}   opt_ProduceExportCStubs stub_c_output_w
 150   where
 151     -- C stubs for "foreign export"ed functions.
 152     stub_c_output_d = pprCode CStyle c_code
 153     stub_c_output_w = showSDoc stub_c_output_d
 154
 155     -- Header file protos for "foreign export"ed functions.
 156     stub_h_output_d = pprCode CStyle h_code
 157     stub_h_output_w = showSDoc stub_h_output_d
 158
 159
 160 -- Don't use doOutput for dumping the f. export stubs
 161 -- since it is more than likely that the stubs file will
 162 -- turn out to be empty, in which case no file should be created.
 163 outputForeignStubs_help is_header switch ""      = return ()
 164 outputForeignStubs_help is_header switch doc_str =
 165   case switch of
 166     Nothing    -> return ()
 167     Just fname -> writeFile fname (include_prefix ++ doc_str)
 168  where
 169   include_prefix
 170    | is_header   = "#include \"Rts.h\"\n"
 171    | otherwise   = "#include \"RtsAPI.h\"\n"
 172 \end{code}
 173