1 -- ----------------------------------------------------------------------------
2 -- | Pretty print helpers for the LLVM Code generator.
5 module LlvmCodeGen.Ppr (
6 pprLlvmHeader, pprLlvmCmmTop, pprLlvmData
9 #include "HsVersions.h"
12 import LlvmCodeGen.Base
13 import LlvmCodeGen.Data
22 -- ----------------------------------------------------------------------------
26 -- | LLVM module layout description for the host target
29 #ifdef i386_TARGET_ARCH
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\"")
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\"")
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\"")
52 -- | Header code for LLVM modules
54 pprLlvmHeader = moduleLayout
56 -- | Pretty print LLVM code
57 pprLlvmCmmTop :: DynFlags -> LlvmCmmTop -> Doc
58 pprLlvmCmmTop dflags (CmmData _ lmdata)
59 = vcat $ map (pprLlvmData dflags) lmdata
61 pprLlvmCmmTop dflags (CmmProc info lbl _ (ListGraph blocks))
63 let static = CmmDataLabel (entryLblToInfoLbl lbl) : info
65 then pprCmmStatic dflags static
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
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'
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