Use SDoc for all LLVM pretty-printing

This patch reworks some parts of the LLVM pretty-printing code that were
still using Show and String. Now we should be using SDoc and Outputable
throughout. Note that many get*Name functions become pp*Name
here as a side-effect.

7 files changed, 291 insertions, 284 deletions

diff --git a/compiler/llvmGen/Llvm.hs b/compiler/llvmGen/Llvm.hs
index 04f810d369..8951d88869 100644
--- a/compiler/llvmGen/Llvm.hs
+++ b/compiler/llvmGen/Llvm.hs
@@ -41,11 +41,12 @@ module Llvm (
         MetaExpr(..), MetaAnnot(..), MetaDecl(..),
 
         -- ** Operations on the type system.
-        isGlobal, getLitType, getLit, getName, getPlainName, getVarType,
+        isGlobal, getLitType, getVarType,
         getLink, getStatType, getGlobalVar, getGlobalType, pVarLift, pVarLower,
         pLift, pLower, isInt, isFloat, isPointer, isVector, llvmWidthInBits,
 
         -- * Pretty Printing
+        ppLit, ppName, ppPlainName,
         ppLlvmModule, ppLlvmComments, ppLlvmComment, ppLlvmGlobals,
         ppLlvmGlobal, ppLlvmFunctionDecls, ppLlvmFunctionDecl, ppLlvmFunctions,
         ppLlvmFunction, ppLlvmAlias, ppLlvmAliases, ppLlvmMetas, ppLlvmMeta,
diff --git a/compiler/llvmGen/Llvm/MetaData.hs b/compiler/llvmGen/Llvm/MetaData.hs
index b81bd8f6e5..364403e579 100644
--- a/compiler/llvmGen/Llvm/MetaData.hs
+++ b/compiler/llvmGen/Llvm/MetaData.hs
@@ -52,11 +52,10 @@
 --
 module Llvm.MetaData where
 
-import Data.List (intercalate)
-
 import Llvm.Types
 
 import FastString
+import Outputable
 
 -- | LLVM metadata expressions
 data MetaExpr = MetaStr LMString
@@ -65,11 +64,11 @@ data MetaExpr = MetaStr LMString
               | MetaStruct [MetaExpr]
               deriving (Eq)
 
-instance Show MetaExpr where
-  show (MetaStr    s ) = "metadata !\"" ++ unpackFS s ++ "\""
-  show (MetaNode   n ) = "metadata !" ++ show n
-  show (MetaVar    v ) = show v
-  show (MetaStruct es) = "metadata !{ " ++ intercalate ", " (map show es) ++ "}"
+instance Outputable MetaExpr where
+  ppr (MetaStr    s ) = text "metadata !\"" <> ftext s <> char '"'
+  ppr (MetaNode   n ) = text "metadata !" <> int n
+  ppr (MetaVar    v ) = ppr v
+  ppr (MetaStruct es) = text "metadata !{ " <> ppCommaJoin es <> char '}'
 
 -- | Associates some metadata with a specific label for attaching to an
 -- instruction.
diff --git a/compiler/llvmGen/Llvm/PpLlvm.hs b/compiler/llvmGen/Llvm/PpLlvm.hs
index b43e44df52..dc5e92222d 100644
--- a/compiler/llvmGen/Llvm/PpLlvm.hs
+++ b/compiler/llvmGen/Llvm/PpLlvm.hs
@@ -30,6 +30,7 @@ import Llvm.Types
 import Data.List ( intersperse )
 import Outputable
 import Unique
+import FastString ( sLit )
 
 --------------------------------------------------------------------------------
 -- * Top Level Print functions
@@ -70,15 +71,17 @@ ppLlvmGlobal (var@(LMGlobalVar _ _ link x a c), dat) =
             Nothing -> empty
 
         rhs = case dat of
-            Just stat -> texts stat
-            Nothing   -> texts (pLower $ getVarType var)
+            Just stat -> ppr stat
+            Nothing   -> ppr (pLower $ getVarType var)
 
         const' = if c then text "constant" else text "global"
 
-    in ppAssignment var $ texts link <+> const' <+> rhs <> sect <> align
+    in ppAssignment var $ ppr link <+> const' <+> rhs <> sect <> align
        $+$ newLine
 
-ppLlvmGlobal oth = error $ "Non Global var ppr as global! " ++ show oth
+ppLlvmGlobal (var, val) = sdocWithDynFlags $ \dflags ->
+  error $ "Non Global var ppr as global! "
+          ++ showSDoc dflags (ppr var) ++ " " ++ showSDoc dflags (ppr val)
 
 
 -- | Print out a list of LLVM type aliases.
@@ -88,7 +91,7 @@ ppLlvmAliases tys = vcat $ map ppLlvmAlias tys
 -- | Print out an LLVM type alias.
 ppLlvmAlias :: LlvmAlias -> SDoc
 ppLlvmAlias (name, ty)
-  = text "%" <> ftext name <+> equals <+> text "type" <+> texts ty
+  = char '%' <> ftext name <+> equals <+> text "type" <+> ppr ty
 
 
 -- | Print out a list of LLVM metadata.
@@ -110,7 +113,7 @@ ppLlvmMeta (MetaNamed n m)
 ppLlvmMetaExpr :: MetaExpr -> SDoc
 ppLlvmMetaExpr (MetaStr    s ) = text "metadata !" <> doubleQuotes (ftext s)
 ppLlvmMetaExpr (MetaNode   n ) = text "metadata !" <> int n
-ppLlvmMetaExpr (MetaVar    v ) = texts v
+ppLlvmMetaExpr (MetaVar    v ) = ppr v
 ppLlvmMetaExpr (MetaStruct es) =
     text "metadata !{" <> hsep (punctuate comma (map ppLlvmMetaExpr es)) <> char '}'
 
@@ -138,17 +141,17 @@ ppLlvmFunction (LlvmFunction dec args attrs sec body) =
 ppLlvmFunctionHeader :: LlvmFunctionDecl -> [LMString] -> SDoc
 ppLlvmFunctionHeader (LlvmFunctionDecl n l c r varg p a) args
   = let varg' = case varg of
-                      VarArgs | null p    -> text "..."
-                              | otherwise -> text ", ..."
-                      _otherwise          -> empty
+                      VarArgs | null p    -> sLit "..."
+                              | otherwise -> sLit ", ..."
+                      _otherwise          -> sLit ""
         align = case a of
-                     Just a' -> text " align" <+> texts a'
+                     Just a' -> text " align " <> ppr a'
                      Nothing -> empty
-        args' = map (\((ty,p),n) -> texts ty <+> ppSpaceJoin p <+> text "%"
+        args' = map (\((ty,p),n) -> ppr ty <+> ppSpaceJoin p <+> char '%'
                                     <> ftext n)
                     (zip p args)
-    in texts l <+> texts c <+> texts r <+> text "@" <> ftext n <> lparen <>
-        (hcat $ intersperse (comma <> space) args') <> varg' <> rparen <> align
+    in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <> lparen <>
+        (hsep $ punctuate comma args') <> ptext varg' <> rparen <> align
 
 -- | Print out a list of function declaration.
 ppLlvmFunctionDecls :: LlvmFunctionDecls -> SDoc
@@ -160,16 +163,16 @@ ppLlvmFunctionDecls decs = vcat $ map ppLlvmFunctionDecl decs
 ppLlvmFunctionDecl :: LlvmFunctionDecl -> SDoc
 ppLlvmFunctionDecl (LlvmFunctionDecl n l c r varg p a)
   = let varg' = case varg of
-                      VarArgs | null p    -> text "..."
-                              | otherwise -> text ", ..."
-                      _otherwise          -> empty
+                      VarArgs | null p    -> sLit "..."
+                              | otherwise -> sLit ", ..."
+                      _otherwise          -> sLit ""
         align = case a of
-                     Just a' -> text " align" <+> texts a'
+                     Just a' -> text " align" <+> ppr a'
                      Nothing -> empty
         args = hcat $ intersperse (comma <> space) $
-                  map (\(t,a) -> texts t <+> ppSpaceJoin a) p
-    in text "declare" <+> texts l <+> texts c <+> texts r <+> text "@" <>
-        ftext n <> lparen <> args <> varg' <> rparen <> align $+$ newLine
+                  map (\(t,a) -> ppr t <+> ppSpaceJoin a) p
+    in text "declare" <+> ppr l <+> ppr c <+> ppr r <+> char '@' <>
+        ftext n <> lparen <> args <> ptext varg' <> rparen <> align $+$ newLine
 
 
 -- | Print out a list of LLVM blocks.
@@ -227,7 +230,7 @@ ppLlvmExpression expr
   = case expr of
         Alloca     tp amount        -> ppAlloca tp amount
         LlvmOp     op left right    -> ppMachOp op left right
-        Call       tp fp args attrs -> ppCall tp fp args attrs
+        Call       tp fp args attrs -> ppCall tp fp (map MetaVar args) attrs
         CallM      tp fp args attrs -> ppCall tp fp args attrs
         Cast       op from to       -> ppCast op from to
         Compare    op left right    -> ppCmpOp op left right
@@ -247,7 +250,7 @@ ppLlvmExpression expr
 
 -- | Should always be a function pointer. So a global var of function type
 -- (since globals are always pointers) or a local var of pointer function type.
-ppCall :: (Show a) => LlvmCallType -> LlvmVar -> [a] -> [LlvmFuncAttr] -> SDoc
+ppCall :: LlvmCallType -> LlvmVar -> [MetaExpr] -> [LlvmFuncAttr] -> SDoc
 ppCall ct fptr args attrs = case fptr of
                            --
     -- if local var function pointer, unwrap
@@ -265,22 +268,21 @@ ppCall ct fptr args attrs = case fptr of
         ppCall' (LlvmFunctionDecl _ _ cc ret argTy params _) =
             let tc = if ct == TailCall then text "tail " else empty
                 ppValues = ppCommaJoin args
-                ppParams = map (texts . fst) params
-                ppArgTy  = (hcat $ intersperse comma ppParams) <>
+                ppArgTy  = (ppCommaJoin $ map fst params) <>
                            (case argTy of
                                VarArgs   -> text ", ..."
                                FixedArgs -> empty)
-                fnty = space <> lparen <> ppArgTy <> rparen <> text "*"
+                fnty = space <> lparen <> ppArgTy <> rparen <> char '*'
                 attrDoc = ppSpaceJoin attrs
-            in  tc <> text "call" <+> texts cc <+> texts ret
-                    <> fnty <+> (text $ getName fptr) <> lparen <+> ppValues
+            in  tc <> text "call" <+> ppr cc <+> ppr ret
+                    <> fnty <+> ppName fptr <> lparen <+> ppValues
                     <+> rparen <+> attrDoc
 
 
 ppMachOp :: LlvmMachOp -> LlvmVar -> LlvmVar -> SDoc
 ppMachOp op left right =
-  (texts op) <+> (texts (getVarType left)) <+> (text $ getName left)
-        <> comma <+> (text $ getName right)
+  (ppr op) <+> (ppr (getVarType left)) <+> ppName left
+        <> comma <+> ppName right
 
 
 ppCmpOp :: LlvmCmpOp -> LlvmVar -> LlvmVar -> SDoc
@@ -294,12 +296,12 @@ ppCmpOp op left right =
                 ++ (show $ getVarType left) ++ ", right = "
                 ++ (show $ getVarType right))
         -}
-  in cmpOp <+> texts op <+> texts (getVarType left)
-        <+> (text $ getName left) <> comma <+> (text $ getName right)
+  in cmpOp <+> ppr op <+> ppr (getVarType left)
+        <+> ppName left <> comma <+> ppName right
 
 
 ppAssignment :: LlvmVar -> SDoc -> SDoc
-ppAssignment var expr = (text $ getName var) <+> equals <+> expr
+ppAssignment var expr = ppName var <+> equals <+> expr
 
 ppFence :: Bool -> LlvmSyncOrdering -> SDoc
 ppFence st ord =
@@ -325,72 +327,71 @@ ppSyncOrdering SyncSeqCst    = text "seq_cst"
 
 ppLoad :: LlvmVar -> SDoc
 ppLoad var
-    | isVecPtrVar var = text "load" <+> texts var <>
+    | isVecPtrVar var = text "load" <+> ppr var <>
                         comma <+> text "align 1"
-    | otherwise       = text "load" <+> texts var
+    | otherwise       = text "load" <+> ppr var
   where
     isVecPtrVar :: LlvmVar -> Bool
     isVecPtrVar = isVector . pLower . getVarType
 
 ppStore :: LlvmVar -> LlvmVar -> SDoc
 ppStore val dst
-    | isVecPtrVar dst = text "store" <+> texts val <> comma <+> texts dst <>
+    | isVecPtrVar dst = text "store" <+> ppr val <> comma <+> ppr dst <>
                         comma <+> text "align 1"
-    | otherwise       = text "store" <+> texts val <> comma <+> texts dst
+    | otherwise       = text "store" <+> ppr val <> comma <+> ppr dst
   where
     isVecPtrVar :: LlvmVar -> Bool
     isVecPtrVar = isVector . pLower . getVarType
 
 
 ppCast :: LlvmCastOp -> LlvmVar -> LlvmType -> SDoc
-ppCast op from to = texts op <+> texts from <+> text "to" <+> texts to
+ppCast op from to = ppr op <+> ppr from <+> text "to" <+> ppr to
 
 
 ppMalloc :: LlvmType -> Int -> SDoc
 ppMalloc tp amount =
   let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
-  in text "malloc" <+> texts tp <> comma <+> texts amount'
+  in text "malloc" <+> ppr tp <> comma <+> ppr amount'
 
 
 ppAlloca :: LlvmType -> Int -> SDoc
 ppAlloca tp amount =
   let amount' = LMLitVar $ LMIntLit (toInteger amount) i32
-  in text "alloca" <+> texts tp <> comma <+> texts amount'
+  in text "alloca" <+> ppr tp <> comma <+> ppr amount'
 
 
 ppGetElementPtr :: Bool -> LlvmVar -> [LlvmVar] -> SDoc
 ppGetElementPtr inb ptr idx =
   let indexes = comma <+> ppCommaJoin idx
       inbound = if inb then text "inbounds" else empty
-  in text "getelementptr" <+> inbound <+> texts ptr <> indexes
+  in text "getelementptr" <+> inbound <+> ppr ptr <> indexes
 
 
 ppReturn :: Maybe LlvmVar -> SDoc
-ppReturn (Just var) = text "ret" <+> texts var
-ppReturn Nothing    = text "ret" <+> texts LMVoid
+ppReturn (Just var) = text "ret" <+> ppr var
+ppReturn Nothing    = text "ret" <+> ppr LMVoid
 
 
 ppBranch :: LlvmVar -> SDoc
-ppBranch var = text "br" <+> texts var
+ppBranch var = text "br" <+> ppr var
 
 
 ppBranchIf :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
 ppBranchIf cond trueT falseT
-  = text "br" <+> texts cond <> comma <+> texts trueT <> comma <+> texts falseT
+  = text "br" <+> ppr cond <> comma <+> ppr trueT <> comma <+> ppr falseT
 
 
 ppPhi :: LlvmType -> [(LlvmVar,LlvmVar)] -> SDoc
 ppPhi tp preds =
-  let ppPreds (val, label) = brackets $ (text $ getName val) <> comma
-        <+> (text $ getName label)
-  in text "phi" <+> texts tp <+> hcat (intersperse comma $ map ppPreds preds)
+  let ppPreds (val, label) = brackets $ ppName val <> comma <+> ppName label
+  in text "phi" <+> ppr tp <+> hsep (punctuate comma $ map ppPreds preds)
 
 
 ppSwitch :: LlvmVar -> LlvmVar -> [(LlvmVar,LlvmVar)] -> SDoc
 ppSwitch scrut dflt targets =
-  let ppTarget  (val, lab) = texts val <> comma <+> texts lab
+  let ppTarget  (val, lab) = ppr val <> comma <+> ppr lab
       ppTargets  xs        = brackets $ vcat (map ppTarget xs)
-  in text "switch" <+> texts scrut <> comma <+> texts dflt
+  in text "switch" <+> ppr scrut <> comma <+> ppr dflt
         <+> ppTargets targets
 
 
@@ -398,7 +399,7 @@ ppAsm :: LMString -> LMString -> LlvmType -> [LlvmVar] -> Bool -> Bool -> SDoc
 ppAsm asm constraints rty vars sideeffect alignstack =
   let asm'  = doubleQuotes $ ftext asm
       cons  = doubleQuotes $ ftext constraints
-      rty'  = texts rty 
+      rty'  = ppr rty
       vars' = lparen <+> ppCommaJoin vars <+> rparen
       side  = if sideeffect then text "sideeffect" else empty
       align = if alignstack then text "alignstack" else empty
@@ -408,15 +409,15 @@ ppAsm asm constraints rty vars sideeffect alignstack =
 ppExtract :: LlvmVar -> LlvmVar -> SDoc
 ppExtract vec idx =
     text "extractelement"
-    <+> texts (getVarType vec) <+> text (getName vec) <> comma
-    <+> texts idx
+    <+> ppr (getVarType vec) <+> ppName vec <> comma
+    <+> ppr idx
 
 ppInsert :: LlvmVar -> LlvmVar -> LlvmVar -> SDoc
 ppInsert vec elt idx =
     text "insertelement"
-    <+> texts (getVarType vec) <+> text (getName vec) <> comma
-    <+> texts (getVarType elt) <+> text (getName elt) <> comma
-    <+> texts idx
+    <+> ppr (getVarType vec) <+> ppName vec <> comma
+    <+> ppr (getVarType elt) <+> ppName elt <> comma
+    <+> ppr idx
 
 
 ppMetaStatement :: [MetaAnnot] -> LlvmStatement -> SDoc
@@ -433,27 +434,17 @@ ppMetaAnnots meta = hcat $ map ppMeta meta
           case e of
             MetaNode n    -> exclamation <> int n
             MetaStruct ms -> exclamation <> braces (ppCommaJoin ms)
-            other         -> exclamation <> braces (texts other) -- possible?
+            other         -> exclamation <> braces (ppr other) -- possible?
 
 
 --------------------------------------------------------------------------------
 -- * Misc functions
 --------------------------------------------------------------------------------
-ppCommaJoin :: (Show a) => [a] -> SDoc
-ppCommaJoin strs = hcat $ intersperse (comma <> space) (map texts strs)
-
-ppSpaceJoin :: (Show a) => [a] -> SDoc
-ppSpaceJoin strs = hcat $ intersperse space (map texts strs)
-
--- | Showable to SDoc
-texts :: (Show a) => a -> SDoc
-texts = (text . show)
 
 -- | Blank line.
 newLine :: SDoc
-newLine = text ""
+newLine = empty
 
 -- | Exclamation point.
 exclamation :: SDoc
-exclamation = text "!"
-
+exclamation = char '!'
diff --git a/compiler/llvmGen/Llvm/Types.hs b/compiler/llvmGen/Llvm/Types.hs
index 01c16fa1ad..2f165a2240 100644
--- a/compiler/llvmGen/Llvm/Types.hs
+++ b/compiler/llvmGen/Llvm/Types.hs
@@ -1,3 +1,5 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
 --------------------------------------------------------------------------------
 -- | The LLVM Type System.
 --
@@ -8,12 +10,11 @@ module Llvm.Types where
 
 import Data.Char
 import Data.Int
-import Data.List (intercalate)
 import Numeric
 
 import DynFlags
 import FastString
-import Outputable (panic)
+import Outputable
 import Unique
 
 -- from NCG
@@ -53,30 +54,34 @@ data LlvmType
   | LMFunction LlvmFunctionDecl
   deriving (Eq)
 
-instance Show LlvmType where
-  show (LMInt size     ) = "i" ++ show size
-  show (LMFloat        ) = "float"
-  show (LMDouble       ) = "double"
-  show (LMFloat80      ) = "x86_fp80"
-  show (LMFloat128     ) = "fp128"
-  show (LMPointer x    ) = show x ++ "*"
-  show (LMArray nr tp  ) = "[" ++ show nr ++ " x " ++ show tp ++ "]"
-  show (LMVector nr tp ) = "<" ++ show nr ++ " x " ++ show tp ++ ">"
-  show (LMLabel        ) = "label"
-  show (LMVoid         ) = "void"
-  show (LMStruct tys   ) = "<{" ++ (commaCat tys) ++ "}>"
-  show (LMAlias (s,_)  ) = "%" ++ unpackFS s
-  show (LMMetadata     ) = "metadata"
-
-  show (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
-    = let varg' = case varg of
-                        VarArgs | null args -> "..."
-                                | otherwise -> ", ..."
-                        _otherwise          -> ""
-          -- by default we don't print param attributes
-          args = intercalate ", " $ map (show . fst) p
-      in show r ++ " (" ++ args ++ varg' ++ ")"
-
+instance Outputable LlvmType where
+  ppr (LMInt size     ) = char 'i' <> ppr size
+  ppr (LMFloat        ) = text "float"
+  ppr (LMDouble       ) = text "double"
+  ppr (LMFloat80      ) = text "x86_fp80"
+  ppr (LMFloat128     ) = text "fp128"
+  ppr (LMPointer x    ) = ppr x <> char '*'
+  ppr (LMArray nr tp  ) = char '[' <> ppr nr <> text " x " <> ppr tp <> char ']'
+  ppr (LMVector nr tp ) = char '<' <> ppr nr <> text " x " <> ppr tp <> char '>'
+  ppr (LMLabel        ) = text "label"
+  ppr (LMVoid         ) = text "void"
+  ppr (LMStruct tys   ) = text "<{" <> ppCommaJoin tys <> text "}>"
+  ppr (LMMetadata     ) = text "metadata"
+
+  ppr (LMFunction (LlvmFunctionDecl _ _ _ r varg p _))
+    = ppr r <+> lparen <> ppParams varg p <> rparen
+
+  ppr (LMAlias (s,_)) = char '%' <> ftext s
+
+ppParams :: LlvmParameterListType -> [LlvmParameter] -> SDoc
+ppParams varg p
+  = let varg' = case varg of
+          VarArgs | null args -> sLit "..."
+                  | otherwise -> sLit ", ..."
+          _otherwise          -> sLit ""
+        -- by default we don't print param attributes
+        args = map fst p
+    in ppCommaJoin args <> ptext varg'
 
 -- | An LLVM section definition. If Nothing then let LLVM decide the section
 type LMSection = Maybe LMString
@@ -96,9 +101,9 @@ data LlvmVar
   | LMLitVar LlvmLit
   deriving (Eq)
 
-instance Show LlvmVar where
-  show (LMLitVar x) = show x
-  show (x         ) = show (getVarType x) ++ " " ++ getName x
+instance Outputable LlvmVar where
+  ppr (LMLitVar x)  = ppr x
+  ppr (x         )  = ppr (getVarType x) <+> ppName x
 
 
 -- | Llvm Literal Data.
@@ -117,9 +122,9 @@ data LlvmLit
   | LMUndefLit LlvmType
   deriving (Eq)
 
-instance Show LlvmLit where
-  show l@(LMVectorLit {}) = getLit l
-  show l                  = show (getLitType l) ++ " " ++ getLit l
+instance Outputable LlvmLit where
+  ppr l@(LMVectorLit {}) = ppLit l
+  ppr l                  = ppr (getLitType l) <+> ppLit l
 
 
 -- | Llvm Static Data.
@@ -142,37 +147,33 @@ data LlvmStatic
   | LMAdd LlvmStatic LlvmStatic        -- ^ Constant addition operation
   | LMSub LlvmStatic LlvmStatic        -- ^ Constant subtraction operation
 
-instance Show LlvmStatic where
-  show (LMComment       s) = "; " ++ unpackFS s
-  show (LMStaticLit   l  ) = show l
-  show (LMUninitType    t) = show t ++ " undef"
-  show (LMStaticStr   s t) = show t ++ " c\"" ++ unpackFS s ++ "\\00\""
-  show (LMStaticArray d t) = show t ++ " [" ++ commaCat d ++ "]"
-  show (LMStaticStruc d t) = show t ++ "<{" ++ commaCat d ++ "}>"
-  show (LMStaticPointer v) = show v
-  show (LMBitc v t)
-      = show t ++ " bitcast (" ++ show v ++ " to " ++ show t ++ ")"
-  show (LMPtoI v t)
-      = show t ++ " ptrtoint (" ++ show v ++ " to " ++ show t ++ ")"
-  show (LMAdd s1 s2)
-      = let ty1 = getStatType s1
-            op  = if isFloat ty1 then " fadd (" else " add ("
-        in if ty1 == getStatType s2
-                then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")"
-                else error $ "LMAdd with different types! s1: "
-                        ++ show s1 ++ ", s2: " ++ show s2
-  show (LMSub s1 s2)
-      = let ty1 = getStatType s1
-            op  = if isFloat ty1 then " fsub (" else " sub ("
-        in if ty1 == getStatType s2
-                then show ty1 ++ op ++ show s1 ++ "," ++ show s2 ++ ")"
-                else error $ "LMSub with different types! s1: "
-                        ++ show s1 ++ ", s2: " ++ show s2
-
-
--- | Concatenate an array together, separated by commas
-commaCat :: Show a => [a] -> String
-commaCat xs = intercalate ", " $ map show xs
+instance Outputable LlvmStatic where
+  ppr (LMComment       s) = text "; " <> ftext s
+  ppr (LMStaticLit   l  ) = ppr l
+  ppr (LMUninitType    t) = ppr t <> text " undef"
+  ppr (LMStaticStr   s t) = ppr t <> text " c\"" <> ftext s <> text "\\00\""
+  ppr (LMStaticArray d t) = ppr t <> text " [" <> ppCommaJoin d <> char ']'
+  ppr (LMStaticStruc d t) = ppr t <> text "<{" <> ppCommaJoin d <> text "}>"
+  ppr (LMStaticPointer v) = ppr v
+  ppr (LMBitc v t)
+      = ppr t <> text " bitcast (" <> ppr v <> text " to " <> ppr t <> char ')'
+  ppr (LMPtoI v t)
+      = ppr t <> text " ptrtoint (" <> ppr v <> text " to " <> ppr t <> char ')'
+
+  ppr (LMAdd s1 s2)
+      = pprStaticArith s1 s2 (sLit "add") (sLit "fadd") "LMAdd"
+  ppr (LMSub s1 s2)
+      = pprStaticArith s1 s2 (sLit "sub") (sLit "fsub") "LMSub"
+
+pprStaticArith :: LlvmStatic -> LlvmStatic -> LitString -> LitString -> String -> SDoc
+pprStaticArith s1 s2 int_op float_op op_name =
+  let ty1 = getStatType s1
+      op  = if isFloat ty1 then float_op else int_op
+  in if ty1 == getStatType s2
+     then ppr ty1 <+> ptext op <+> lparen <> ppr s1 <> comma <> ppr s2 <> rparen
+     else sdocWithDynFlags $ \dflags ->
+            error $ op_name ++ " with different types! s1: "
+                    ++ showSDoc dflags (ppr s1) ++ ", s2: " ++ showSDoc dflags (ppr s2)
 
 -- -----------------------------------------------------------------------------
 -- ** Operations on LLVM Basic Types and Variables
@@ -180,33 +181,33 @@ commaCat xs = intercalate ", " $ map show xs
 
 -- | Return the variable name or value of the 'LlvmVar'
 -- in Llvm IR textual representation (e.g. @\@x@, @%y@ or @42@).
-getName :: LlvmVar -> String
-getName v@(LMGlobalVar _ _ _ _ _ _) = "@" ++ getPlainName v
-getName v@(LMLocalVar  _ _        ) = "%" ++ getPlainName v
-getName v@(LMNLocalVar _ _        ) = "%" ++ getPlainName v
-getName v@(LMLitVar    _          ) = getPlainName v
+ppName :: LlvmVar -> SDoc
+ppName v@(LMGlobalVar {}) = char '@' <> ppPlainName v
+ppName v@(LMLocalVar  {}) = char '%' <> ppPlainName v
+ppName v@(LMNLocalVar {}) = char '%' <> ppPlainName v
+ppName v@(LMLitVar    {}) =             ppPlainName v
 
 -- | Return the variable name or value of the 'LlvmVar'
 -- in a plain textual representation (e.g. @x@, @y@ or @42@).
-getPlainName :: LlvmVar -> String
-getPlainName (LMGlobalVar x _ _ _ _ _) = unpackFS x
-getPlainName (LMLocalVar  x LMLabel  ) = show x
-getPlainName (LMLocalVar  x _        ) = "l" ++ show x
-getPlainName (LMNLocalVar x _        ) = unpackFS x
-getPlainName (LMLitVar    x          ) = getLit x
+ppPlainName :: LlvmVar -> SDoc
+ppPlainName (LMGlobalVar x _ _ _ _ _) = ftext x
+ppPlainName (LMLocalVar  x LMLabel  ) = text (show x)
+ppPlainName (LMLocalVar  x _        ) = text ('l' : show x)
+ppPlainName (LMNLocalVar x _        ) = ftext x
+ppPlainName (LMLitVar    x          ) = ppLit x
 
 -- | Print a literal value. No type.
-getLit :: LlvmLit -> String
-getLit (LMIntLit i (LMInt 32)) = show (fromInteger i :: Int32)
-getLit (LMIntLit i (LMInt 64)) = show (fromInteger i :: Int64)
-getLit (LMIntLit i _         ) = show (fromInteger i :: Int)
--- See Note [LLVM Float Types].
-getLit (LMFloatLit r LMFloat ) = (dToStr . widenFp . narrowFp) r
-getLit (LMFloatLit r LMDouble) = dToStr r
-getLit f@(LMFloatLit _ _) = error $ "Can't print this float literal!" ++ show f
-getLit (LMVectorLit ls  ) = "< " ++ commaCat ls ++ " >"
-getLit (LMNullLit _     ) = "null"
-getLit (LMUndefLit _    ) = "undef"
+ppLit :: LlvmLit -> SDoc
+ppLit (LMIntLit i (LMInt 32))  = ppr (fromInteger i :: Int32)
+ppLit (LMIntLit i (LMInt 64))  = ppr (fromInteger i :: Int64)
+ppLit (LMIntLit   i _       )  = ppr ((fromInteger i)::Int)
+ppLit (LMFloatLit r LMFloat )  = ppFloat $ narrowFp r
+ppLit (LMFloatLit r LMDouble)  = ppDouble r
+ppLit f@(LMFloatLit _ _)       = sdocWithDynFlags (\dflags ->
+                                   error $ "Can't print this float literal!" ++ showSDoc dflags (ppr f))
+ppLit (LMVectorLit ls  )       = char '<' <+> ppCommaJoin ls <+> char '>'
+ppLit (LMNullLit _     )       = text "null"
+ppLit (LMUndefLit _    )       = text "undef"
 
 -- | Return the 'LlvmType' of the 'LlvmVar'
 getVarType :: LlvmVar -> LlvmType
@@ -217,12 +218,12 @@ getVarType (LMLitVar    l          ) = getLitType l
 
 -- | Return the 'LlvmType' of a 'LlvmLit'
 getLitType :: LlvmLit -> LlvmType
-getLitType (LMIntLit    _ t) = t
-getLitType (LMFloatLit  _ t) = t
+getLitType (LMIntLit   _ t) = t
+getLitType (LMFloatLit _ t) = t
 getLitType (LMVectorLit [])  = panic "getLitType"
 getLitType (LMVectorLit ls)  = LMVector (length ls) (getLitType (head ls))
-getLitType (LMNullLit     t) = t
-getLitType (LMUndefLit    t) = t
+getLitType (LMNullLit    t) = t
+getLitType (LMUndefLit   t) = t
 
 -- | Return the 'LlvmType' of the 'LlvmStatic'
 getStatType :: LlvmStatic -> LlvmType
@@ -270,7 +271,7 @@ pVarLift (LMLitVar    _          ) = error $ "Can't lower a literal type!"
 -- constructors can be lowered.
 pLower :: LlvmType -> LlvmType
 pLower (LMPointer x) = x
-pLower x  = error $ show x ++ " is a unlowerable type, need a pointer"
+pLower x  = error $ showSDoc undefined (ppr x) ++ " is a unlowerable type, need a pointer"
 
 -- | Lower a variable of 'LMPointer' type.
 pVarLower :: LlvmVar -> LlvmVar
@@ -368,19 +369,13 @@ data LlvmFunctionDecl = LlvmFunctionDecl {
   }
   deriving (Eq)
 
-instance Show LlvmFunctionDecl where
-  show (LlvmFunctionDecl n l c r varg p a)
-    = let varg' = case varg of
-                        VarArgs | null args -> "..."
-                                | otherwise -> ", ..."
-                        _otherwise          -> ""
-          align = case a of
-                       Just a' -> " align " ++ show a'
-                       Nothing -> ""
-          -- by default we don't print param attributes
-          args = intercalate ", " $ map (show . fst) p
-      in show l ++ " " ++ show c ++ " " ++ show r ++ " @" ++ unpackFS n ++
-             "(" ++ args ++ varg' ++ ")" ++ align
+instance Outputable LlvmFunctionDecl where
+  ppr (LlvmFunctionDecl n l c r varg p a)
+    = let align = case a of
+                       Just a' -> text " align " <> ppr a'
+                       Nothing -> empty
+      in ppr l <+> ppr c <+> ppr r <+> char '@' <> ftext n <>
+             lparen <> ppParams varg p <> rparen <> align
 
 type LlvmFunctionDecls = [LlvmFunctionDecl]
 
@@ -421,15 +416,15 @@ data LlvmParamAttr
   | Nest
   deriving (Eq)
 
-instance Show LlvmParamAttr where
-  show ZeroExt   = "zeroext"
-  show SignExt   = "signext"
-  show InReg     = "inreg"
-  show ByVal     = "byval"
-  show SRet      = "sret"
-  show NoAlias   = "noalias"
-  show NoCapture = "nocapture"
-  show Nest      = "nest"
+instance Outputable LlvmParamAttr where
+  ppr ZeroExt   = text "zeroext"
+  ppr SignExt   = text "signext"
+  ppr InReg     = text "inreg"
+  ppr ByVal     = text "byval"
+  ppr SRet      = text "sret"
+  ppr NoAlias   = text "noalias"
+  ppr NoCapture = text "nocapture"
+  ppr Nest      = text "nest"
 
 -- | Llvm Function Attributes.
 --
@@ -509,20 +504,20 @@ data LlvmFuncAttr
   | Naked
   deriving (Eq)
 
-instance Show LlvmFuncAttr where
-  show AlwaysInline       = "alwaysinline"
-  show InlineHint         = "inlinehint"
-  show NoInline           = "noinline"
-  show OptSize            = "optsize"
-  show NoReturn           = "noreturn"
-  show NoUnwind           = "nounwind"
-  show ReadNone           = "readnon"
-  show ReadOnly           = "readonly"
-  show Ssp                = "ssp"
-  show SspReq             = "ssqreq"
-  show NoRedZone          = "noredzone"
-  show NoImplicitFloat    = "noimplicitfloat"
-  show Naked              = "naked"
+instance Outputable LlvmFuncAttr where
+  ppr AlwaysInline       = text "alwaysinline"
+  ppr InlineHint         = text "inlinehint"
+  ppr NoInline           = text "noinline"
+  ppr OptSize            = text "optsize"
+  ppr NoReturn           = text "noreturn"
+  ppr NoUnwind           = text "nounwind"
+  ppr ReadNone           = text "readnon"
+  ppr ReadOnly           = text "readonly"
+  ppr Ssp                = text "ssp"
+  ppr SspReq             = text "ssqreq"
+  ppr NoRedZone          = text "noredzone"
+  ppr NoImplicitFloat    = text "noimplicitfloat"
+  ppr Naked              = text "naked"
 
 
 -- | Different types to call a function.
@@ -567,12 +562,12 @@ data LlvmCallConvention
   | CC_X86_Stdcc
   deriving (Eq)
 
-instance Show LlvmCallConvention where
-  show CC_Ccc       = "ccc"
-  show CC_Fastcc    = "fastcc"
-  show CC_Coldcc    = "coldcc"
-  show (CC_Ncc i)   = "cc " ++ show i
-  show CC_X86_Stdcc = "x86_stdcallcc"
+instance Outputable LlvmCallConvention where
+  ppr CC_Ccc       = text "ccc"
+  ppr CC_Fastcc    = text "fastcc"
+  ppr CC_Coldcc    = text "coldcc"
+  ppr (CC_Ncc i)   = text "cc " <> ppr i
+  ppr CC_X86_Stdcc = text "x86_stdcallcc"
 
 
 -- | Functions can have a fixed amount of parameters, or a variable amount.
@@ -628,17 +623,17 @@ data LlvmLinkageType
   | External
   deriving (Eq)
 
-instance Show LlvmLinkageType where
-  show Internal          = "internal"
-  show LinkOnce          = "linkonce"
-  show Weak              = "weak"
-  show Appending         = "appending"
-  show ExternWeak        = "extern_weak"
+instance Outputable LlvmLinkageType where
+  ppr Internal          = text "internal"
+  ppr LinkOnce          = text "linkonce"
+  ppr Weak              = text "weak"
+  ppr Appending         = text "appending"
+  ppr ExternWeak        = text "extern_weak"
   -- ExternallyVisible does not have a textual representation, it is
   -- the linkage type a function resolves to if no other is specified
   -- in Llvm.
-  show ExternallyVisible = ""
-  show External          = "external"
+  ppr ExternallyVisible = empty
+  ppr External          = text "external"
 
 
 -- -----------------------------------------------------------------------------
@@ -676,25 +671,25 @@ data LlvmMachOp
   | LM_MO_Xor -- ^ XOR bitwise logical operation.
   deriving (Eq)
 
-instance Show LlvmMachOp where
-  show LM_MO_Add  = "add"
-  show LM_MO_Sub  = "sub"
-  show LM_MO_Mul  = "mul"
-  show LM_MO_UDiv = "udiv"
-  show LM_MO_SDiv = "sdiv"
-  show LM_MO_URem = "urem"
-  show LM_MO_SRem = "srem"
-  show LM_MO_FAdd = "fadd"
-  show LM_MO_FSub = "fsub"
-  show LM_MO_FMul = "fmul"
-  show LM_MO_FDiv = "fdiv"
-  show LM_MO_FRem = "frem"
-  show LM_MO_Shl  = "shl"
-  show LM_MO_LShr = "lshr"
-  show LM_MO_AShr = "ashr"
-  show LM_MO_And  = "and"
-  show LM_MO_Or   = "or"
-  show LM_MO_Xor  = "xor"
+instance Outputable LlvmMachOp where
+  ppr LM_MO_Add  = text "add"
+  ppr LM_MO_Sub  = text "sub"
+  ppr LM_MO_Mul  = text "mul"
+  ppr LM_MO_UDiv = text "udiv"
+  ppr LM_MO_SDiv = text "sdiv"
+  ppr LM_MO_URem = text "urem"
+  ppr LM_MO_SRem = text "srem"
+  ppr LM_MO_FAdd = text "fadd"
+  ppr LM_MO_FSub = text "fsub"
+  ppr LM_MO_FMul = text "fmul"
+  ppr LM_MO_FDiv = text "fdiv"
+  ppr LM_MO_FRem = text "frem"
+  ppr LM_MO_Shl  = text "shl"
+  ppr LM_MO_LShr = text "lshr"
+  ppr LM_MO_AShr = text "ashr"
+  ppr LM_MO_And  = text "and"
+  ppr LM_MO_Or   = text "or"
+  ppr LM_MO_Xor  = text "xor"
 
 
 -- | Llvm compare operations.
@@ -720,23 +715,23 @@ data LlvmCmpOp
   | LM_CMP_Fle -- ^ Float less than or equal
   deriving (Eq)
 
-instance Show LlvmCmpOp where
-  show LM_CMP_Eq  = "eq"
-  show LM_CMP_Ne  = "ne"
-  show LM_CMP_Ugt = "ugt"
-  show LM_CMP_Uge = "uge"
-  show LM_CMP_Ult = "ult"
-  show LM_CMP_Ule = "ule"
-  show LM_CMP_Sgt = "sgt"
-  show LM_CMP_Sge = "sge"
-  show LM_CMP_Slt = "slt"
-  show LM_CMP_Sle = "sle"
-  show LM_CMP_Feq = "oeq"
-  show LM_CMP_Fne = "une"
-  show LM_CMP_Fgt = "ogt"
-  show LM_CMP_Fge = "oge"
-  show LM_CMP_Flt = "olt"
-  show LM_CMP_Fle = "ole"
+instance Outputable LlvmCmpOp where
+  ppr LM_CMP_Eq  = text "eq"
+  ppr LM_CMP_Ne  = text "ne"
+  ppr LM_CMP_Ugt = text "ugt"
+  ppr LM_CMP_Uge = text "uge"
+  ppr LM_CMP_Ult = text "ult"
+  ppr LM_CMP_Ule = text "ule"
+  ppr LM_CMP_Sgt = text "sgt"
+  ppr LM_CMP_Sge = text "sge"
+  ppr LM_CMP_Slt = text "slt"
+  ppr LM_CMP_Sle = text "sle"
+  ppr LM_CMP_Feq = text "oeq"
+  ppr LM_CMP_Fne = text "une"
+  ppr LM_CMP_Fgt = text "ogt"
+  ppr LM_CMP_Fge = text "oge"
+  ppr LM_CMP_Flt = text "olt"
+  ppr LM_CMP_Fle = text "ole"
 
 
 -- | Llvm cast operations.
@@ -755,19 +750,19 @@ data LlvmCastOp
   | LM_Bitcast  -- ^ Cast between types where no bit manipulation is needed
   deriving (Eq)
 
-instance Show LlvmCastOp where
-  show LM_Trunc    = "trunc"
-  show LM_Zext     = "zext"
-  show LM_Sext     = "sext"
-  show LM_Fptrunc  = "fptrunc"
-  show LM_Fpext    = "fpext"
-  show LM_Fptoui   = "fptoui"
-  show LM_Fptosi   = "fptosi"
-  show LM_Uitofp   = "uitofp"
-  show LM_Sitofp   = "sitofp"
-  show LM_Ptrtoint = "ptrtoint"
-  show LM_Inttoptr = "inttoptr"
-  show LM_Bitcast  = "bitcast"
+instance Outputable LlvmCastOp where
+  ppr LM_Trunc    = text "trunc"
+  ppr LM_Zext     = text "zext"
+  ppr LM_Sext     = text "sext"
+  ppr LM_Fptrunc  = text "fptrunc"
+  ppr LM_Fpext    = text "fpext"
+  ppr LM_Fptoui   = text "fptoui"
+  ppr LM_Fptosi   = text "fptosi"
+  ppr LM_Uitofp   = text "uitofp"
+  ppr LM_Sitofp   = text "sitofp"
+  ppr LM_Ptrtoint = text "ptrtoint"
+  ppr LM_Inttoptr = text "inttoptr"
+  ppr LM_Bitcast  = text "bitcast"
 
 
 -- -----------------------------------------------------------------------------
@@ -779,8 +774,8 @@ instance Show LlvmCastOp where
 -- regardless of underlying architecture.
 --
 -- See Note [LLVM Float Types].
-dToStr :: Double -> String
-dToStr d
+ppDouble :: Double -> SDoc
+ppDouble d
   = let bs     = doubleToBytes d
         hex d' = case showHex d' "" of
                      []    -> error "dToStr: too few hex digits for float"
@@ -788,12 +783,12 @@ dToStr d
                      [x,y] -> [x,y]
                      _     -> error "dToStr: too many hex digits for float"
 
-        str  = map toUpper $ concat . fixEndian . (map hex) $ bs
-    in  "0x" ++ str
+        str  = map toUpper $ concat $ fixEndian $ map hex bs
+    in  text "0x" <> text str
 
 -- Note [LLVM Float Types]
 -- ~~~~~~~~~~~~~~~~~~~~~~~
--- We use 'dToStr' for both printing Float and Double floating point types. This is
+-- We use 'ppDouble' for both printing Float and Double floating point types. This is
 -- as LLVM expects all floating point constants (single & double) to be in IEEE
 -- 754 Double precision format. However, for single precision numbers (Float)
 -- they should be *representable* in IEEE 754 Single precision format. So the
@@ -816,6 +811,9 @@ widenFp :: Float -> Double
 {-# NOINLINE widenFp #-}
 widenFp = float2Double
 
+ppFloat :: Float -> SDoc
+ppFloat = ppDouble . widenFp
+
 -- | Reverse or leave byte data alone to fix endianness on this target.
 fixEndian :: [a] -> [a]
 #ifdef WORDS_BIGENDIAN
@@ -824,3 +822,13 @@ fixEndian = id
 fixEndian = reverse
 #endif
 
+
+--------------------------------------------------------------------------------
+-- * Misc functions
+--------------------------------------------------------------------------------
+
+ppCommaJoin :: (Outputable a) => [a] -> SDoc
+ppCommaJoin strs = hsep $ punctuate comma (map ppr strs)
+
+ppSpaceJoin :: (Outputable a) => [a] -> SDoc
+ppSpaceJoin strs = hsep (map ppr strs)
diff --git a/compiler/llvmGen/LlvmCodeGen/Base.hs b/compiler/llvmGen/LlvmCodeGen/Base.hs
index bcfce3401e..7cac844490 100644
--- a/compiler/llvmGen/LlvmCodeGen/Base.hs
+++ b/compiler/llvmGen/LlvmCodeGen/Base.hs
@@ -115,7 +115,7 @@ mkLlvmFunc :: LlvmEnv -> LiveGlobalRegs -> CLabel -> LlvmLinkageType -> LMSectio
 mkLlvmFunc env live lbl link sec blks
   = let dflags = getDflags env
         funDec = llvmFunSig env live lbl link
-        funArgs = map (fsLit . getPlainName) (llvmFunArgs dflags live)
+        funArgs = map (fsLit . Outp.showSDoc dflags . ppPlainName) (llvmFunArgs dflags live)
     in LlvmFunction funDec funArgs llvmStdFunAttrs sec blks
 
 -- | Alignment to use for functions
diff --git a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
index bf3b4fefa6..84ada2435c 100644
--- a/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
+++ b/compiler/llvmGen/LlvmCodeGen/CodeGen.hs
@@ -404,7 +404,7 @@ getFunPtr env funTy targ = case targ of
                 ty | isInt ty     -> LM_Inttoptr
 
                 ty -> panic $ "genCall: Expr is of bad type for function"
-                              ++ " call! (" ++ show (ty) ++ ")"
+                              ++ " call! (" ++ showSDoc (getDflags env) (ppr ty) ++ ")"
 
         (v2,s1) <- doExpr (pLift fty) $ Cast cast v1 (pLift fty)
         return (env', v2, stmts `snocOL` s1, top)
@@ -455,7 +455,7 @@ arg_vars env ((e, AddrHint):rest) (vars, stmts, tops)
                ty | isInt ty     -> LM_Inttoptr
 
                a  -> panic $ "genCall: Can't cast llvmType to i8*! ("
-                           ++ show a ++ ")"
+                           ++ showSDoc (getDflags env) (ppr a) ++ ")"
 
        (v2, s1) <- doExpr i8Ptr $ Cast op v1 i8Ptr
        arg_vars env' rest (vars ++ [v2], stmts `appOL` stmts' `snocOL` s1,
@@ -495,7 +495,7 @@ castVar dflags v t
                       (vt, _) | isVector vt && isVector t   -> LM_Bitcast
 
                       (vt, _) -> panic $ "castVars: Can't cast this type ("
-                                  ++ show vt ++ ") to (" ++ show t ++ ")"
+                                  ++ showSDoc dflags (ppr vt) ++ ") to (" ++ showSDoc dflags (ppr t) ++ ")"
               in doExpr t $ Cast op v t
 
 
@@ -541,7 +541,7 @@ cmmPrimOpFunctions env mop
     MO_Memmove    -> fsLit $ "llvm.memmove." ++ intrinTy1
     MO_Memset     -> fsLit $ "llvm.memset."  ++ intrinTy2
 
-    (MO_PopCnt w) -> fsLit $ "llvm.ctpop."  ++ show (widthToLlvmInt w)
+    (MO_PopCnt w) -> fsLit $ "llvm.ctpop."  ++ showSDoc dflags (ppr $ widthToLlvmInt w)
 
     MO_Prefetch_Data -> fsLit "llvm.prefetch"
 
@@ -557,9 +557,9 @@ cmmPrimOpFunctions env mop
     where
         dflags = getDflags env
         intrinTy1 = (if getLlvmVer env >= 28
-                       then "p0i8.p0i8." else "") ++ show (llvmWord dflags)
+                       then "p0i8.p0i8." else "") ++ showSDoc dflags (ppr $ llvmWord dflags)
         intrinTy2 = (if getLlvmVer env >= 28
-                       then "p0i8." else "") ++ show (llvmWord dflags)
+                       then "p0i8." else "") ++ showSDoc dflags (ppr $ llvmWord dflags)
         unsupported = panic ("cmmPrimOpFunctions: " ++ show mop
                           ++ " not supported here")
 
@@ -585,7 +585,7 @@ genJump env expr live = do
          ty | isInt ty     -> LM_Inttoptr
 
          ty -> panic $ "genJump: Expr is of bad type for function call! ("
-                     ++ show (ty) ++ ")"
+                     ++ showSDoc (getDflags env) (ppr ty) ++ ")"
 
     (v1, s1) <- doExpr (pLift fty) $ Cast cast vf (pLift fty)
     (stgRegs, stgStmts) <- funEpilogue env live
@@ -719,7 +719,7 @@ genStore_slow env addr val meta = do
                     (PprCmm.pprExpr addr <+> text (
                         "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
                         ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
-                        ", Var: " ++ show vaddr))
+                        ", Var: " ++ showSDoc dflags (ppr vaddr)))
     where dflags = getDflags env
 
 
@@ -741,8 +741,9 @@ genCondBranch env cond idT idF = do
         then do
             let s1 = BranchIf vc labelT labelF
             return $ (env', stmts `snocOL` s1, top)
-        else
-            panic $ "genCondBranch: Cond expr not bool! (" ++ show vc ++ ")"
+        else do
+            let dflags = getDflags env
+            panic $ "genCondBranch: Cond expr not bool! (" ++ showSDoc dflags (ppr vc) ++ ")"
 
 {- Note [Literals and branch conditions]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -1226,7 +1227,7 @@ genMachOp_slow env opt op [x, y] = case op of
                         return (env', v2, stmts `snocOL` s1, top)
                 else
                     panic $ "genBinComp: Compare returned type other then i1! "
-                        ++ (show $ getVarType v1)
+                        ++ (showSDoc dflags $ ppr $ getVarType v1)
 
         genBinMach op = binLlvmOp getVarType (LlvmOp op)
 
@@ -1263,7 +1264,7 @@ genMachOp_slow env opt op [x, y] = case op of
                         top1 ++ top2)
 
                 else
-                    panic $ "isSMulOK: Not bit type! (" ++ show word ++ ")"
+                    panic $ "isSMulOK: Not bit type! (" ++ showSDoc dflags (ppr word) ++ ")"
 
         panicOp = panic $ "LLVM.CodeGen.genMachOp_slow: unary op encourntered"
                        ++ "with two arguments! (" ++ show op ++ ")"
@@ -1359,7 +1360,7 @@ genLoad_slow env e ty meta = do
                         (PprCmm.pprExpr e <+> text (
                             "Size of Ptr: " ++ show (llvmPtrBits dflags) ++
                             ", Size of var: " ++ show (llvmWidthInBits dflags other) ++
-                            ", Var: " ++ show iptr))
+                            ", Var: " ++ showSDoc dflags (ppr iptr)))
     where dflags = getDflags env
 
 -- | Handle CmmReg expression
diff --git a/compiler/utils/Outputable.lhs b/compiler/utils/Outputable.lhs
index 88a8a75c62..da8ffb3f10 100644
--- a/compiler/utils/Outputable.lhs
+++ b/compiler/utils/Outputable.lhs
@@ -90,6 +90,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString as BS
 import Data.Char
 import qualified Data.Map as M
+import Data.Int
 import qualified Data.IntMap as IM
 import Data.Set (Set)
 import qualified Data.Set as Set
@@ -619,6 +620,12 @@ instance Outputable Bool where
     ppr True  = ptext (sLit "True")
     ppr False = ptext (sLit "False")
 
+instance Outputable Int32 where
+   ppr n = integer $ fromIntegral n
+
+instance Outputable Int64 where
+   ppr n = integer $ fromIntegral n
+
 instance Outputable Int where
     ppr n = int n