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 )
  28 import PprAbsC          ( dumpRealC, writeRealC )
  29 import UniqSupply       ( UniqSupply )
  30 import Module           ( Module )
  31 import CmdLineOpts
  32 import ErrUtils         ( dumpIfSet_dyn )
  33 import Outputable
  34 import CmdLineOpts      ( DynFlags(..), HscLang(..) )
  35 import TmpFiles         ( newTmpName )
  36
  37 import IO               ( IOMode(..), hClose, openFile, Handle )
  38 \end{code}
  39
  40
  41 %************************************************************************
  42 %*                                                                      *
  43 \subsection{Steering}
  44 %*                                                                      *
  45 %************************************************************************
  46
  47 \begin{code}
  48 codeOutput :: DynFlags
  49            -> Module
  50            -> [TyCon] -> [Class]        -- Local tycons and classes
  51            -> [CoreBind]                -- Core bindings
  52            -> [(StgBinding,[Id])]       -- The STG program with SRTs
  53            -> SDoc              -- C stubs for foreign exported functions
  54            -> SDoc              -- Header file prototype for foreign exported functions
  55            -> AbstractC         -- Compiled abstract C
  56            -> UniqSupply
  57            -> IO (Maybe FilePath, Maybe FilePath)
  58 codeOutput dflags mod_name tycons classes core_binds stg_binds
  59            c_code h_code flat_abstractC ncg_uniqs
  60   = -- You can have C (c_output) or assembly-language (ncg_output),
  61     -- but not both.  [Allowing for both gives a space leak on
  62     -- flat_abstractC.  WDP 94/10]
  63
  64     -- Dunno if the above comment is still meaningful now.  JRS 001024.
  65
  66     do stub_names <- outputForeignStubs c_code h_code
  67        case dopt_HscLang dflags of
  68           HscInterpreter -> return stub_names
  69           HscAsm  filenm -> outputAsm dflags filenm flat_abstractC ncg_uniqs
  70                             >> return stub_names
  71           HscC    filenm -> outputC dflags filenm flat_abstractC
  72                             >> return stub_names
  73           HscJava filenm -> outputJava dflags filenm mod_name tycons core_binds
  74                             >> return stub_names
  75
  76 doOutput :: (Handle -> IO ()) -> IO ()
  77 doOutput filenm io_action
  78   = (do handle <- openFile filenm WriteMode
  79         io_action handle
  80         hClose handle)
  81     `catch` (\err -> pprPanic "Failed to open or write code output file"
  82                               (text filenm))
  83 \end{code}
  84
  85
  86 %************************************************************************
  87 %*                                                                      *
  88 \subsection{C}
  89 %*                                                                      *
  90 %************************************************************************
  91
  92 \begin{code}
  93 outputC dflags filenm flat_absC
  94   = do dumpIfSet_dyn Opt_D_dump_realC dflags "Real C" (dumpRealC flat_absC)
  95        doOutput filenm (\ h -> writeRealC h flat_absC)
  96 \end{code}
  97
  98
  99 %************************************************************************
 100 %*                                                                      *
 101 \subsection{Assembler}
 102 %*                                                                      *
 103 %************************************************************************
 104
 105 \begin{code}
 106 outputAsm dflags filenm flat_absC ncg_uniqs
 107
 108 #ifndef OMIT_NATIVE_CODEGEN
 109
 110   = do dumpIfSet_dyn Opt_D_dump_stix dflags "Final stix code" stix_final
 111        dumpIfSet_dyn Opt_D_dump_asm dflags "Asm code" ncg_output_d
 112        doOutput filenm ( \f -> printForAsm f ncg_output_d)
 113   where
 114     (stix_final, ncg_output_d) = nativeCodeGen flat_absC ncg_uniqs
 115
 116 #else /* OMIT_NATIVE_CODEGEN */
 117
 118   = pprPanic "This compiler was built without a native code generator"
 119              (text "Use -fvia-C instead")
 120
 121 #endif
 122 \end{code}
 123
 124
 125 %************************************************************************
 126 %*                                                                      *
 127 \subsection{Java}
 128 %*                                                                      *
 129 %************************************************************************
 130
 131 \begin{code}
 132 outputJava dflags filenm mod tycons core_binds
 133   = doOutput filenm (\ f -> printForUser f pp_java)
 134         -- User style printing for now to keep indentation
 135   where
 136     java_code = javaGen mod [{- Should be imports-}] tycons core_binds
 137     pp_java   = PrintJava.compilationUnit java_code
 138 \end{code}
 139
 140
 141 %************************************************************************
 142 %*                                                                      *
 143 \subsection{Foreign import/export}
 144 %*                                                                      *
 145 %************************************************************************
 146
 147 \begin{code}
 148 outputForeignStubs dflags c_code h_code
 149   = do
 150         dumpIfSet_dyn Opt_D_dump_foreign dflags
 151                       "Foreign export header file" stub_h_output_d
 152
 153         maybe_stub_h_file
 154            <- outputForeignStubs_help True{-.h output-} stub_h_output_w
 155
 156         dumpIfSet_dyn Opt_D_dump_foreign dflags
 157                       "Foreign export stubs" stub_c_output_d
 158
 159         maybe_stub_c_file
 160            <- outputForeignStubs_help False{-not .h-} stub_c_output_w
 161
 162         return (maybe_stub_h_file, maybe_stub_c_file)
 163   where
 164     -- C stubs for "foreign export"ed functions.
 165     stub_c_output_d = pprCode CStyle c_code
 166     stub_c_output_w = showSDoc stub_c_output_d
 167
 168     -- Header file protos for "foreign export"ed functions.
 169     stub_h_output_d = pprCode CStyle h_code
 170     stub_h_output_w = showSDoc stub_h_output_d
 171
 172
 173 -- Don't use doOutput for dumping the f. export stubs
 174 -- since it is more than likely that the stubs file will
 175 -- turn out to be empty, in which case no file should be created.
 176 outputForeignStubs_help is_header switch ""      = return Nothing
 177 outputForeignStubs_help is_header switch doc_str =
 178   case switch of
 179     Nothing    -> return Nothing
 180     Just fname -> newTempName suffix >>= \ fname ->
 181                   writeFile fname (include_prefix ++ doc_str) >>
 182                   return (Just suffix)
 183   where
 184     suffix
 185        | is_header   = "h_stub"
 186        | otherwise   = "c_stub"
 187     include_prefix
 188        | is_header   = "#include \"Rts.h\"\n"
 189        | otherwise   = "#include \"RtsAPI.h\"\n"
 190 \end{code}
 191