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 )
  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 io_action
  73   = (do handle <- openFile opt_OutputFile WriteMode
  74         io_action handle
  75         hClose handle)
  76     `catch` (\err -> pprPanic "Failed to open or write code output file" (text opt_OutputFile))
  77 \end{code}
  78
  79
  80 %************************************************************************
  81 %*                                                                      *
  82 \subsection{C}
  83 %*                                                                      *
  84 %************************************************************************
  85
  86 \begin{code}
  87 outputC flat_absC
  88   = do
  89        dumpIfSet opt_D_dump_realC "Real C" (dumpRealC flat_absC)
  90        doOutput (\ h -> writeRealC h flat_absC)
  91 \end{code}
  92
  93
  94 %************************************************************************
  95 %*                                                                      *
  96 \subsection{Assembler}
  97 %*                                                                      *
  98 %************************************************************************
  99
 100 \begin{code}
 101 outputAsm flat_absC ncg_uniqs
 102 #ifndef OMIT_NATIVE_CODEGEN
 103
 104   = do  dumpIfSet opt_D_dump_stix "Final stix code" stix_final
 105         dumpIfSet opt_D_dump_asm "Asm code" ncg_output_d
 106         doOutput (\ f -> printForAsm f ncg_output_d)
 107   where
 108     (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
 109
 110 #else /* OMIT_NATIVE_CODEGEN */
 111
 112   = pprPanic "This compiler was built without a native code generator"
 113              (text "Use -fvia-C instead")
 114
 115 #endif
 116 \end{code}
 117
 118
 119 %************************************************************************
 120 %*                                                                      *
 121 \subsection{Java}
 122 %*                                                                      *
 123 %************************************************************************
 124
 125 \begin{code}
 126 outputJava mod tycons core_binds
 127   = doOutput (\ f -> printForUser f pp_java)
 128         -- User style printing for now to keep indentation
 129   where
 130     java_code = javaGen mod [{- Should be imports-}] tycons core_binds
 131     pp_java   = PrintJava.compilationUnit java_code
 132 \end{code}
 133
 134
 135 %************************************************************************
 136 %*                                                                      *
 137 \subsection{Foreign import/export}
 138 %*                                                                      *
 139 %************************************************************************
 140
 141 \begin{code}
 142 outputForeignStubs c_code h_code
 143   = do
 144         dumpIfSet opt_D_dump_foreign "Foreign export header file" stub_h_output_d
 145         outputForeignStubs_help True{-.h output-} opt_ProduceExportHStubs stub_h_output_w
 146
 147         dumpIfSet opt_D_dump_foreign "Foreign export stubs" stub_c_output_d
 148         outputForeignStubs_help False{-not .h-}   opt_ProduceExportCStubs stub_c_output_w
 149   where
 150     -- C stubs for "foreign export"ed functions.
 151     stub_c_output_d = pprCode CStyle c_code
 152     stub_c_output_w = showSDoc stub_c_output_d
 153
 154     -- Header file protos for "foreign export"ed functions.
 155     stub_h_output_d = pprCode CStyle h_code
 156     stub_h_output_w = showSDoc stub_h_output_d
 157
 158
 159 -- Don't use doOutput for dumping the f. export stubs
 160 -- since it is more than likely that the stubs file will
 161 -- turn out to be empty, in which case no file should be created.
 162 outputForeignStubs_help is_header switch ""      = return ()
 163 outputForeignStubs_help is_header switch doc_str =
 164   case switch of
 165     Nothing    -> return ()
 166     Just fname -> writeFile fname (include_prefix ++ doc_str)
 167  where
 168   include_prefix
 169    | is_header   = "#include \"Rts.h\"\n"
 170    | otherwise   = "#include \"RtsAPI.h\"\n"
 171 \end{code}
 172