compiler/llvmGen/LlvmCodeGen/Ppr.hs

   1 -- ----------------------------------------------------------------------------
   2 -- | Pretty print helpers for the LLVM Code generator.
   3 --
   4
   5 module LlvmCodeGen.Ppr (
   6         pprLlvmHeader, pprLlvmCmmTop, pprLlvmData
   7     ) where
   8
   9 #include "HsVersions.h"
  10
  11 import Llvm
  12 import LlvmCodeGen.Base
  13 import LlvmCodeGen.Data
  14
  15 import CLabel
  16 import Cmm
  17
  18 import DynFlags
  19 import Pretty
  20 import Unique
  21
  22 -- ----------------------------------------------------------------------------
  23 -- * Top level
  24 --
  25
  26 -- | LLVM module layout description for the host target
  27 moduleLayout :: Doc
  28 moduleLayout =
  29 #ifdef i386_TARGET_ARCH
  30
  31 #ifdef darwin_TARGET_OS
  32     (text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:128:128\"")
  33     $+$ (text "target triple = \"i386-apple-darwin9.8\"")
  34 #else
  35     (text "target datalayout = \"e-p:32:32:32-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:32:64-f32:32:32-f64:32:64-v64:64:64-v128:128:128-a0:0:64-f80:32:32\"")
  36     $+$ (text "target triple = \"i386-linux-gnu\"")
  37 #endif
  38
  39 #else
  40
  41 #ifdef x86_64_TARGET_ARCH
  42     (text "target datalayout = \"e-p:64:64:64-i1:8:8-i8:8:8-i16:16:16-i32:32:32-i64:64:64-f32:32:32-f64:64:64-v64:64:64-v128:128:128-a0:0:64-s0:64:64-f80:128:128\"")
  43     $+$ (text "target triple = \"x86_64-linux-gnu\"")
  44
  45 #else /* Not i386 */
  46     -- FIX: Other targets
  47     empty
  48 #endif
  49
  50 #endif
  51
  52 -- | Header code for LLVM modules
  53 pprLlvmHeader :: Doc
  54 pprLlvmHeader = moduleLayout
  55
  56 -- | Pretty print LLVM code
  57 pprLlvmCmmTop :: DynFlags -> LlvmCmmTop -> Doc
  58 pprLlvmCmmTop dflags (CmmData _ lmdata)
  59   = vcat $ map (pprLlvmData dflags) lmdata
  60
  61 pprLlvmCmmTop dflags (CmmProc info lbl _ (ListGraph blocks))
  62   = (
  63         let static = CmmDataLabel (entryLblToInfoLbl lbl) : info
  64         in if not (null info)
  65             then pprCmmStatic dflags static
  66             else empty
  67     ) $+$ (
  68         let link = if (externallyVisibleCLabel lbl)
  69                         then ExternallyVisible else Internal
  70             funDec = llvmFunSig lbl link
  71             lmblocks = map (\(BasicBlock id stmts) -> LlvmBlock (getUnique id) stmts) blocks
  72             fun = LlvmFunction funDec [NoUnwind] lmblocks
  73         in ppLlvmFunction fun
  74     )
  75
  76
  77 -- | Pretty print LLVM data code
  78 pprLlvmData :: DynFlags -> LlvmData -> Doc
  79 pprLlvmData _ (globals, types ) =
  80     let globals' = ppLlvmGlobals globals
  81         types'   = ppLlvmTypes types
  82     in types' $+$ globals'
  83
  84
  85 -- | Pretty print CmmStatic
  86 pprCmmStatic :: DynFlags -> [CmmStatic] -> Doc
  87 pprCmmStatic dflags stat
  88   = let unres = genLlvmData dflags (Data,stat)
  89         (_, ldata) = resolveLlvmData dflags initLlvmEnv unres
  90     in pprLlvmData dflags ldata
  91