diff --git a/llvm-pretty.cabal b/llvm-pretty.cabal
--- a/llvm-pretty.cabal
+++ b/llvm-pretty.cabal
@@ -1,5 +1,5 @@
 Name:                llvm-pretty
-Version:             0.4.0.1
+Version:             0.5
 License:             BSD3
 License-file:        LICENSE
 Author:              Trevor Elliott
@@ -22,9 +22,11 @@
   Default-language:    Haskell2010
 
   Hs-source-dirs:      src
-  Exposed-modules:     Text.LLVM,
-                       Text.LLVM.AST,
+  Exposed-modules:     Text.LLVM
+                       Text.LLVM.AST
                        Text.LLVM.Labels
+                       Text.LLVM.PP
+  Other-modules:       Text.LLVM.Util
 
   Build-depends:       base       >= 4 && < 5,
                        containers >= 0.4,
diff --git a/src/Text/LLVM.hs b/src/Text/LLVM.hs
--- a/src/Text/LLVM.hs
+++ b/src/Text/LLVM.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecursiveDo #-}
 {-# LANGUAGE TypeOperators #-}
@@ -7,6 +8,10 @@
 {-# LANGUAGE UndecidableInstances #-}
 {-# LANGUAGE TypeSynonymInstances #-}
 
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
 module Text.LLVM (
     -- * LLVM Monad
     LLVM()
@@ -95,6 +100,7 @@
   , select
   , call, call_
   , invoke
+  , switch
   , shuffleVector
 
     -- * Re-exported
@@ -103,7 +109,6 @@
 
 import Text.LLVM.AST
 
-import Control.Applicative ( Applicative )
 import Control.Monad.Fix (MonadFix)
 import Data.Char (ord)
 import Data.Int (Int8,Int16,Int32,Int64)
@@ -114,7 +119,11 @@
 import qualified Data.Sequence as Seq
 import qualified Data.Map.Strict as Map
 
+#if !(MIN_VERSION_base(4,8,0))
+import Control.Applicative ( Applicative )
+#endif
 
+
 -- Fresh Names -----------------------------------------------------------------
 
 type Names = Map.Map String Int
@@ -686,3 +695,8 @@
           Type -> a -> [Typed Value] -> Ident -> Ident -> BB (Typed Value)
 invoke rty sym vs to uw = observe rty
                         $ Invoke rty (toValue sym) vs (Named to) (Named uw)
+
+-- | Emit a call instruction, but don't generate a new variable for its result.
+switch :: IsValue a => Typed a -> Ident -> [(Integer, Ident)] -> BB ()
+switch idx def dests = effect (Switch (toValue `fmap` idx) (Named def)
+                                      (map (\(n, l) -> (n, Named l)) dests))
diff --git a/src/Text/LLVM/AST.hs b/src/Text/LLVM/AST.hs
--- a/src/Text/LLVM/AST.hs
+++ b/src/Text/LLVM/AST.hs
@@ -1,58 +1,30 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE DeriveFunctor #-}
 {-# LANGUAGE PatternGuards #-}
 {-# LANGUAGE RecordWildCards #-}
 
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
 module Text.LLVM.AST where
 
-import Control.Applicative ((<$))
+import Text.LLVM.Util (breaks,uncons)
+
 import Control.Monad (MonadPlus(mzero),(<=<),msum,guard,liftM,liftM3)
-import Data.Char (isAscii,isPrint,ord,toUpper)
-import Data.Foldable (Foldable(foldMap))
 import Data.Int (Int32)
-import Data.List (intersperse,genericIndex,genericLength,unfoldr)
-import Data.Maybe (fromMaybe)
-import Data.Monoid (Monoid(..))
+import Data.List (genericIndex,genericLength)
 import Data.String (IsString(fromString))
+
+#if !(MIN_VERSION_base(4,8,0))
+import Control.Applicative ((<$))
+import Data.Foldable (Foldable(foldMap))
+import Data.Monoid (Monoid(..))
 import Data.Traversable (Traversable(sequenceA))
-import Numeric (showHex)
-import Text.PrettyPrint.HughesPJ
+#endif
 
 
-commas :: [Doc] -> Doc
-commas  = hsep . punctuate (char ',')
-
-colons :: [Doc] -> Doc
-colons  = hcat . intersperse (char ':')
-
-breaks :: (a -> Bool) -> [a] -> [[a]]
-breaks p = unfoldr step
-  where
-  step [] = Nothing
-  step xs = case break p xs of
-    (as,_:bs) -> Just (as,bs)
-    (as,  []) -> Just (as,[])
-
-uncons :: MonadPlus m => [a] -> m (a,[a])
-uncons (a:as) = return (a,as)
-uncons _      = mzero
-
-int32 :: Int32 -> Doc
-int32  = integer . fromIntegral
-
-angles :: Doc -> Doc
-angles d = char '<' <> d <> char '>'
-
-structBraces :: Doc -> Doc
-structBraces body = char '{' <+> body <+> char '}'
-
-ppMaybe :: (a -> Doc) -> Maybe a -> Doc
-ppMaybe  = maybe empty
-
-opt :: Bool -> Doc -> Doc
-opt True  d = d
-opt False _ = empty
-
 -- Modules ---------------------------------------------------------------------
 
 data Module = Module
@@ -94,18 +66,6 @@
   , modAliases    = mempty
   }
 
-ppModule :: Module -> Doc
-ppModule m = foldr ($+$) empty
-  $ ppDataLayout (modDataLayout m)
-  : ppInlineAsm  (modInlineAsm m)
-  : concat [ map ppTypeDecl    (modTypes m)
-           , map ppGlobal      (modGlobals m)
-           , map ppGlobalAlias (modAliases m)
-           , map ppDeclare     (modDeclares m)
-           , map ppDefine      (modDefines m)
-           , map ppNamedMd     (modNamedMd m)
-           , map ppUnnamedMd   (modUnnamedMd m)
-           ]
 
 -- Named Metadata --------------------------------------------------------------
 
@@ -114,10 +74,6 @@
   , nmValues :: [Int]
   } deriving (Show)
 
-ppNamedMd :: NamedMd -> Doc
-ppNamedMd nm =
-  sep [ ppMetadata (text (nmName nm)) <+> char '='
-      , ppMetadata (braces (commas (map (ppMetadata . int) (nmValues nm)))) ]
 
 -- Unnamed Metadata ------------------------------------------------------------
 
@@ -127,13 +83,6 @@
   , umDistinct :: Bool
   } deriving (Show)
 
-ppUnnamedMd :: UnnamedMd -> Doc
-ppUnnamedMd um =
-  sep [ ppMetadata (int (umIndex um)) <+> char '='
-      , distinct <+> ppMetadataNode (umValues um) ]
-  where
-  distinct | umDistinct um = text "distinct"
-           | otherwise     = empty
 
 -- Aliases ---------------------------------------------------------------------
 
@@ -143,24 +92,11 @@
   , aliasTarget :: Value
   } deriving (Show)
 
-ppGlobalAlias :: GlobalAlias -> Doc
-ppGlobalAlias g = ppSymbol (aliasName g) <+> char '=' <+> body
-  where
-  val  = aliasTarget g
-  body = case val of
-    ValSymbol _sym -> ppType (aliasType g) <+> ppValue val
-    _              -> ppValue val
 
 -- Data Layout -----------------------------------------------------------------
 
 type DataLayout = [LayoutSpec]
 
--- | Pretty print a data layout specification.
-ppDataLayout :: DataLayout -> Doc
-ppDataLayout [] = empty
-ppDataLayout ls = text "target" <+> text "datalayout" <+> char '='
-    <+> doubleQuotes (hcat (intersperse (char '-') (map ppLayoutSpec ls)))
-
 data LayoutSpec
   = BigEndian
   | LittleEndian
@@ -181,34 +117,6 @@
               | WindowsCoffMangling
                 deriving (Show,Eq)
 
--- | Pretty print a single layout specification.
-ppLayoutSpec :: LayoutSpec -> Doc
-ppLayoutSpec  BigEndian                  = char 'E'
-ppLayoutSpec  LittleEndian               = char 'e'
-ppLayoutSpec (PointerSize   sz abi pref) = text "p:" <> ppLayoutBody sz abi pref
-ppLayoutSpec (IntegerSize   sz abi pref) = char 'i'  <> ppLayoutBody sz abi pref
-ppLayoutSpec (VectorSize    sz abi pref) = char 'v'  <> ppLayoutBody sz abi pref
-ppLayoutSpec (FloatSize     sz abi pref) = char 'f'  <> ppLayoutBody sz abi pref
-ppLayoutSpec (AggregateSize sz abi pref) = char 'a'  <> ppLayoutBody sz abi pref
-ppLayoutSpec (StackObjSize  sz abi pref) = char 's'  <> ppLayoutBody sz abi pref
-ppLayoutSpec (NativeIntSize szs)         = char 'n'  <> colons (map int szs)
-ppLayoutSpec (StackAlign a)              = char 'S'  <> int a
-ppLayoutSpec (Mangling m)                = char 'm'  <> char ':' <> ppMangling m
-
--- | Pretty-print the common case for data layout specifications.
-ppLayoutBody :: Int -> Int -> Maybe Int -> Doc
-ppLayoutBody size abi mb = int size <> char ':' <> int abi <> pref
-  where
-  pref = case mb of
-    Nothing -> empty
-    Just p  -> char ':' <> int p
-
-ppMangling :: Mangling -> Doc
-ppMangling ElfMangling         = char 'e'
-ppMangling MipsMangling        = char 'm'
-ppMangling MachOMangling       = char 'o'
-ppMangling WindowsCoffMangling = char 'w'
-
 -- | Parse the data layout string.
 parseDataLayout :: MonadPlus m => String -> m DataLayout
 parseDataLayout  = mapM parseLayoutSpec . breaks (== '-')
@@ -263,12 +171,6 @@
 
 type InlineAsm = [String]
 
--- | Pretty-print the inline assembly block.
-ppInlineAsm :: InlineAsm -> Doc
-ppInlineAsm  = foldr ($+$) empty . map ppLine
-  where
-  ppLine l = text "module asm" <+> doubleQuotes (text l)
-
 -- Identifiers -----------------------------------------------------------------
 
 newtype Ident = Ident String
@@ -277,20 +179,18 @@
 instance IsString Ident where
   fromString = Ident
 
-ppIdent :: Ident -> Doc
-ppIdent (Ident n) = char '%' <> text n
-
 -- Symbols ---------------------------------------------------------------------
 
 newtype Symbol = Symbol String
     deriving (Show,Eq,Ord)
 
+instance Monoid Symbol where
+  mappend (Symbol a) (Symbol b) = Symbol (mappend a b)
+  mempty                        = Symbol mempty
+
 instance IsString Symbol where
   fromString = Symbol
 
-ppSymbol :: Symbol -> Doc
-ppSymbol (Symbol n) = char '@' <> text n
-
 -- Types -----------------------------------------------------------------------
 
 data PrimType
@@ -302,14 +202,6 @@
   | Metadata
     deriving (Eq, Ord, Show)
 
-ppPrimType :: PrimType -> Doc
-ppPrimType Label          = text "label"
-ppPrimType Void           = text "void"
-ppPrimType (Integer i)    = char 'i' <> integer (toInteger i)
-ppPrimType (FloatType ft) = ppFloatType ft
-ppPrimType X86mmx         = text "x86mmx"
-ppPrimType Metadata       = text "metadata"
-
 data FloatType
   = Half
   | Float
@@ -319,14 +211,6 @@
   | PPC_fp128
     deriving (Eq, Ord, Show)
 
-ppFloatType :: FloatType -> Doc
-ppFloatType Half      = text "half"
-ppFloatType Float     = text "float"
-ppFloatType Double    = text "double"
-ppFloatType Fp128     = text "fp128"
-ppFloatType X86_fp80  = text "x86_fp80"
-ppFloatType PPC_fp128 = text "ppc_fp128"
-
 type Type = Type' Ident
 
 data Type' ident
@@ -357,17 +241,6 @@
     Opaque           -> Opaque
 
 
-ppType :: Type -> Doc
-ppType (PrimType pt)     = ppPrimType pt
-ppType (Alias i)         = ppIdent i
-ppType (Array len ty)    = brackets (int32 len <+> char 'x' <+> ppType ty)
-ppType (PtrTo ty)        = ppType ty <> char '*'
-ppType (Struct ts)       = structBraces (commas (map ppType ts))
-ppType (PackedStruct ts) = angles (structBraces (commas (map ppType ts)))
-ppType (FunTy r as va)   = ppType r <> ppArgList va (map ppType as)
-ppType (Vector len pt)   = angles (int32 len <+> char 'x' <+> ppType pt)
-ppType Opaque            = text "opaque"
-
 isFloatingPoint :: PrimType -> Bool
 isFloatingPoint (FloatType _) = True
 isFloatingPoint _             = False
@@ -405,10 +278,6 @@
 isPointer (PtrTo _) = True
 isPointer _         = False
 
--- | Build a variable-argument argument list.
-ppArgList :: Bool -> [Doc] -> Doc
-ppArgList True  ds = parens (commas (ds ++ [text "..."]))
-ppArgList False ds = parens (commas ds)
 
 -- Null Values -----------------------------------------------------------------
 
@@ -481,9 +350,6 @@
   , typeValue :: Type
   } deriving (Show)
 
-ppTypeDecl :: TypeDecl -> Doc
-ppTypeDecl td = ppIdent (typeName td) <+> char '='
-            <+> text "type" <+> ppType (typeValue td)
 
 -- Globals ---------------------------------------------------------------------
 
@@ -495,12 +361,6 @@
   , globalAlign :: Maybe Align
   } deriving Show
 
-ppGlobal :: Global -> Doc
-ppGlobal g = ppSymbol (globalSym g) <+> char '='
-         <+> ppGlobalAttrs (globalAttrs g)
-         <+> ppType (globalType g) <+> ppMaybe ppValue (globalValue g)
-          <> ppAlign (globalAlign g)
-
 addGlobal :: Global -> Module -> Module
 addGlobal g m = m { modGlobals = g : modGlobals m }
 
@@ -515,11 +375,6 @@
   , gaConstant = False
   }
 
-ppGlobalAttrs :: GlobalAttrs -> Doc
-ppGlobalAttrs ga = ppMaybe ppLinkage (gaLinkage ga) <+> constant
-  where
-  constant | gaConstant ga = text "constant"
-           | otherwise     = text "global"
 
 -- Declarations ----------------------------------------------------------------
 
@@ -534,11 +389,6 @@
 decFunType :: Declare -> Type
 decFunType Declare { .. } = PtrTo (FunTy decRetType decArgs decVarArgs)
 
-ppDeclare :: Declare -> Doc
-ppDeclare d = text "declare"
-          <+> ppType (decRetType d)
-          <+> ppSymbol (decName d)
-           <> ppArgList (decVarArgs d) (map ppType (decArgs d))
 
 -- Function Definitions --------------------------------------------------------
 
@@ -556,18 +406,6 @@
 defFunType Define { .. } =
   PtrTo (FunTy defRetType (map typedType defArgs) defVarArgs)
 
-ppDefine :: Define -> Doc
-ppDefine d = text "define"
-         <+> ppMaybe ppLinkage (funLinkage (defAttrs d))
-         <+> ppType (defRetType d)
-         <+> ppSymbol (defName d)
-          <> ppArgList (defVarArgs d) (map (ppTyped ppIdent) (defArgs d))
-         <+> ppMaybe (\s  -> text "section" <+> doubleQuotes (text s)) (defSection d)
-         <+> ppMaybe (\gc -> text "gc" <+> ppGC gc) (funGC (defAttrs d))
-         <+> char '{'
-         $+$ vcat (map ppBasicBlock (defBody d))
-         $+$ char '}'
-
 addDefine :: Define -> Module -> Module
 addDefine d m = m { modDefines = d : modDefines m }
 
@@ -592,14 +430,6 @@
 instance IsString BlockLabel where
   fromString str = Named (fromString str)
 
-ppLabelDef :: BlockLabel -> Doc
-ppLabelDef (Named (Ident l)) = text l <> char ':'
-ppLabelDef (Anon i)          = char ';' <+> text "<label>:" <+> int i
-
-ppLabel :: BlockLabel -> Doc
-ppLabel (Named l) = ppIdent l
-ppLabel (Anon i)  = char '%' <> int i
-
 -- Basic Blocks ----------------------------------------------------------------
 
 data BasicBlock' lab = BasicBlock
@@ -609,10 +439,6 @@
 
 type BasicBlock = BasicBlock' BlockLabel
 
-ppBasicBlock :: BasicBlock -> Doc
-ppBasicBlock bb = ppMaybe ppLabelDef (bbLabel bb)
-              $+$ nest 2 (vcat (map ppStmt (bbStmts bb)))
-
 brTargets :: BasicBlock' lab -> [lab]
 brTargets (BasicBlock _ stmts) =
   case stmtInstr (last stmts) of
@@ -645,32 +471,10 @@
   | DLLExport
     deriving (Eq,Show)
 
-ppLinkage :: Linkage -> Doc
-ppLinkage linkage = case linkage of
-  Private                  -> text "private"
-  LinkerPrivate            -> text "linker_private"
-  LinkerPrivateWeak        -> text "linker_private_weak"
-  LinkerPrivateWeakDefAuto -> text "linker_private_weak_def_auto"
-  Internal                 -> text "internal"
-  AvailableExternally      -> text "available_externally"
-  Linkonce                 -> text "linkonce"
-  Weak                     -> text "weak"
-  Common                   -> text "common"
-  Appending                -> text "appending"
-  ExternWeak               -> text "extern_weak"
-  LinkonceODR              -> text "linkonce_ddr"
-  WeakODR                  -> text "weak_odr"
-  External                 -> text "external"
-  DLLImport                -> text "dllimport"
-  DLLExport                -> text "dllexport"
-
 newtype GC = GC
   { getGC :: String
   } deriving (Show)
 
-ppGC :: GC -> Doc
-ppGC  = doubleQuotes . text . getGC
-
 -- Typed Things ----------------------------------------------------------------
 
 data Typed a = Typed
@@ -691,9 +495,6 @@
   b <- f (typedValue t)
   return t { typedValue = b }
 
-ppTyped :: (a -> Doc) -> Typed a -> Doc
-ppTyped fmt ty = ppType (typedType ty) <+> fmt (typedValue ty)
-
 -- Instructions ----------------------------------------------------------------
 
 data ArithOp
@@ -751,26 +552,6 @@
 
     deriving (Eq,Show)
 
-ppSignBits :: Bool -> Bool -> Doc
-ppSignBits nuw nsw = opt nuw (text "nuw") <+> opt nsw (text "nsw")
-
-ppExact :: Bool -> Doc
-ppExact e = opt e (text "exact")
-
-ppArithOp :: ArithOp -> Doc
-ppArithOp (Add nuw nsw) = text "add" <+> ppSignBits nuw nsw
-ppArithOp FAdd          = text "fadd"
-ppArithOp (Sub nuw nsw) = text "sub" <+> ppSignBits nuw nsw
-ppArithOp FSub          = text "fsub"
-ppArithOp (Mul nuw nsw) = text "mul" <+> ppSignBits nuw nsw
-ppArithOp FMul          = text "fmul"
-ppArithOp (UDiv e)      = text "udiv" <+> ppExact e
-ppArithOp (SDiv e)      = text "sdiv" <+> ppExact e
-ppArithOp FDiv          = text "fdiv"
-ppArithOp URem          = text "urem"
-ppArithOp SRem          = text "srem"
-ppArithOp FRem          = text "frem"
-
 isIArith :: ArithOp -> Bool
 isIArith Add{}  = True
 isIArith Sub{}  = True
@@ -820,14 +601,6 @@
   | Xor
     deriving Show
 
-ppBitOp :: BitOp -> Doc
-ppBitOp (Shl nuw nsw) = text "shl"  <+> ppSignBits nuw nsw
-ppBitOp (Lshr e)      = text "lshr" <+> ppExact e
-ppBitOp (Ashr e)      = text "ashr" <+> ppExact e
-ppBitOp And           = text "and"
-ppBitOp Or            = text "or"
-ppBitOp Xor           = text "xor"
-
 data ConvOp
   = Trunc
   | ZExt
@@ -843,20 +616,6 @@
   | BitCast
     deriving Show
 
-ppConvOp :: ConvOp -> Doc
-ppConvOp Trunc    = text "trunc"
-ppConvOp ZExt     = text "zext"
-ppConvOp SExt     = text "sext"
-ppConvOp FpTrunc  = text "fptrunc"
-ppConvOp FpExt    = text "fpext"
-ppConvOp FpToUi   = text "fptoui"
-ppConvOp FpToSi   = text "fptosi"
-ppConvOp UiToFp   = text "uitofp"
-ppConvOp SiToFp   = text "sitofp"
-ppConvOp PtrToInt = text "ptrtoint"
-ppConvOp IntToPtr = text "inttoptr"
-ppConvOp BitCast  = text "bitcast"
-
 type Align = Int
 
 data Instr' lab
@@ -1046,179 +805,14 @@
 isPhi Phi{} = True
 isPhi _     = False
 
-ppInstr :: Instr -> Doc
-ppInstr instr = case instr of
-  Ret tv                 -> text "ret" <+> ppTyped ppValue tv
-  RetVoid                -> text "ret void"
-  Arith op l r           -> ppArithOp op <+> ppTyped ppValue l
-                         <> comma <+> ppValue r
-  Bit op l r             -> ppBitOp op <+> ppTyped ppValue l
-                         <> comma <+> ppValue r
-  Conv op a ty           -> ppConvOp op <+> ppTyped ppValue a
-                        <+> text "to" <+> ppType ty
-  Call tc ty f args      -> ppCall tc ty f args
-  Alloca ty len align    -> ppAlloca ty len align
-  Load ptr ma            -> text "load" <+> ppTyped ppValue ptr
-                         <> ppAlign ma
-  Store a ptr ma         -> text "store" <+> ppTyped ppValue a
-                         <> comma <+> ppTyped ppValue ptr
-                         <> ppAlign ma
-  ICmp op l r            -> text "icmp" <+> ppICmpOp op
-                        <+> ppTyped ppValue l <> comma <+> ppValue r
-  FCmp op l r            -> text "fcmp" <+> ppFCmpOp op
-                        <+> ppTyped ppValue l <> comma <+> ppValue r
-  Phi ty vls             -> text "phi" <+> ppType ty
-                        <+> commas (map ppPhiArg vls)
-  Select c t f           -> text "select" <+> ppTyped ppValue c
-                         <> comma <+> ppTyped ppValue t
-                         <> comma <+> ppTyped ppValue (f <$ t)
-  ExtractValue v is      -> text "extractvalue" <+> ppTyped ppValue v
-                         <> comma <+> (commas (map int32 is))
-  InsertValue a v is     -> text "insertvalue" <+> ppTyped ppValue a
-                         <> comma <+> ppTyped ppValue v
-                         <> comma <+> commas (map int32 is)
-  ShuffleVector a b m    -> text "shufflevector" <+> ppTyped ppValue a
-                         <> comma <+> ppTyped ppValue (b <$ a)
-                         <> comma <+> ppTyped ppValue m
-  GEP ib ptr ixs         -> ppGEP ib ptr ixs
-  Comment str            -> char ';' <+> text str
-  Jump i                 -> text "br"
-                        <+> ppTypedLabel i
-  Br c t f               -> text "br" <+> ppTyped ppValue c
-                         <> comma <+> ppType (PrimType Label)
-                        <+> ppLabel t
-                         <> comma <+> ppType (PrimType Label)
-                        <+> ppLabel f
-  Invoke ty f args to uw -> ppInvoke ty f args to uw
-  Unreachable            -> text "unreachable"
-  Unwind                 -> text "unwind"
-  VaArg al t             -> text "va_arg" <+> ppTyped ppValue al
-                         <> comma <+> ppType t
-  ExtractElt v i         -> text "extractelement"
-                        <+> ppTyped ppValue v
-                         <> comma <+> ppVectorIndex i
-  InsertElt v e i        -> text "insertelement"
-                        <+> ppTyped ppValue v
-                         <> comma <+> ppTyped ppValue e
-                         <> comma <+> ppVectorIndex i
-  IndirectBr d ls        -> text "indirectbr"
-                        <+> ppTyped ppValue d
-                         <> comma <+> commas (map ppTypedLabel ls)
-  Switch c d ls          -> text "switch"
-                        <+> ppTyped ppValue c
-                         <> comma <+> ppTypedLabel d
-                        <+> char '['
-                         $$ nest 2 (vcat (map (ppSwitchEntry (typedType c)) ls))
-                         $$ char ']'
-  LandingPad ty fn c cs  -> text "landingpad"
-                        <+> ppType ty
-                        <+> text "personality"
-                        <+> ppTyped ppValue fn
-                         $$ nest 2 (ppClauses c cs)
-  Resume tv              -> text "resume" <+> ppTyped ppValue tv
-
-ppClauses :: Bool -> [Clause] -> Doc
-ppClauses isCleanup cs = vcat (cleanup : map ppClause cs)
-  where
-  cleanup | isCleanup = text "cleanup"
-          | otherwise = empty
-
-ppClause :: Clause -> Doc
-ppClause c = case c of
-  Catch  tv -> text "catch"  <+> ppTyped ppValue tv
-  Filter tv -> text "filter" <+> ppTyped ppValue tv
-
-
-ppTypedLabel :: BlockLabel -> Doc
-ppTypedLabel i = ppType (PrimType Label) <+> ppLabel i
-
-ppSwitchEntry :: Type -> (Integer,BlockLabel) -> Doc
-ppSwitchEntry ty (i,l) = ppType ty <+> integer i <> comma <+> ppTypedLabel l
-
-ppVectorIndex :: Value -> Doc
-ppVectorIndex i = ppType (PrimType (Integer 32)) <+> ppValue i
-
-ppAlign :: Maybe Align -> Doc
-ppAlign Nothing      = empty
-ppAlign (Just align) = comma <+> text "align" <+> int align
-
-ppAlloca :: Type -> Maybe (Typed Value) -> Maybe Int -> Doc
-ppAlloca ty mbLen mbAlign = text "alloca" <+> ppType ty <> len <> align
-  where
-  len = fromMaybe empty $ do
-    l <- mbLen
-    return (comma <+> ppTyped ppValue l)
-  align = fromMaybe empty $ do
-    a <- mbAlign
-    return (comma <+> text "align" <+> int a)
-
-ppCall :: Bool -> Type -> Value -> [Typed Value] -> Doc
-ppCall tc ty f args
-  | tc        = text "tail" <+> body
-  | otherwise = body
-  where
-  body = text "call" <+> ppCallSym ty f
-      <> parens (commas (map (ppTyped ppValue) args))
-
-ppCallSym :: Type -> Value -> Doc
-ppCallSym (PtrTo (FunTy res _ _)) (ValSymbol sym) = ppType res <+> ppSymbol sym
-ppCallSym ty              val                     = ppType ty  <+> ppValue val
-
-ppGEP :: Bool -> Typed Value -> [Typed Value] -> Doc
-ppGEP ib ptr ixs = text "getelementptr" <+> inbounds
-               <+> commas (map (ppTyped ppValue) (ptr:ixs))
-  where
-  inbounds | ib        = text "inbounds"
-           | otherwise = empty
-
-ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc
-ppInvoke ty f args to uw = body
-  where
-  body = text "invoke" <+> ppType ty <+> ppValue f
-      <> parens (commas (map (ppTyped ppValue) args))
-     <+> text "to" <+> ppType (PrimType Label) <+> ppLabel to
-     <+> text "unwind" <+> ppType (PrimType Label) <+> ppLabel uw
-
-ppPhiArg :: (Value,BlockLabel) -> Doc
-ppPhiArg (v,l) = char '[' <+> ppValue v <> comma <+> ppLabel l <+> char ']'
-
 data ICmpOp = Ieq | Ine | Iugt | Iuge | Iult | Iule | Isgt | Isge | Islt | Isle
   deriving (Show)
 
-ppICmpOp :: ICmpOp -> Doc
-ppICmpOp Ieq  = text "eq"
-ppICmpOp Ine  = text "ne"
-ppICmpOp Iugt = text "ugt"
-ppICmpOp Iuge = text "uge"
-ppICmpOp Iult = text "ult"
-ppICmpOp Iule = text "ule"
-ppICmpOp Isgt = text "sgt"
-ppICmpOp Isge = text "sge"
-ppICmpOp Islt = text "slt"
-ppICmpOp Isle = text "sle"
-
 data FCmpOp = Ffalse  | Foeq | Fogt | Foge | Folt | Fole | Fone
             | Ford    | Fueq | Fugt | Fuge | Fult | Fule | Fune
             | Funo    | Ftrue
     deriving (Show)
 
-ppFCmpOp :: FCmpOp -> Doc
-ppFCmpOp Ffalse = text "false"
-ppFCmpOp Foeq   = text "oeq"
-ppFCmpOp Fogt   = text "ogt"
-ppFCmpOp Foge   = text "oge"
-ppFCmpOp Folt   = text "olt"
-ppFCmpOp Fole   = text "ole"
-ppFCmpOp Fone   = text "one"
-ppFCmpOp Ford   = text "ord"
-ppFCmpOp Fueq   = text "ueq"
-ppFCmpOp Fugt   = text "ugt"
-ppFCmpOp Fuge   = text "uge"
-ppFCmpOp Fult   = text "ult"
-ppFCmpOp Fule   = text "ule"
-ppFCmpOp Fune   = text "une"
-ppFCmpOp Funo   = text "uno"
-ppFCmpOp Ftrue  = text "true"
 
 -- Values ----------------------------------------------------------------------
 
@@ -1274,85 +868,6 @@
 isConst ValNull        = True
 isConst _              = False
 
-ppValue :: Value -> Doc
-ppValue val = case val of
-  ValInteger i       -> integer i
-  ValBool b          -> ppBool b
-  ValFloat i         -> float i
-  ValDouble i        -> double i
-  ValIdent i         -> ppIdent i
-  ValSymbol s        -> ppSymbol s
-  ValNull            -> text "null"
-  ValArray ty es     -> brackets
-                      $ commas (map (ppTyped ppValue . Typed ty) es)
-  ValVector ty es   -> angles $ commas
-                     $ map (ppTyped ppValue . Typed ty) es
-  ValStruct fs       -> structBraces (commas (map (ppTyped ppValue) fs))
-  ValPackedStruct fs -> angles
-                      $ structBraces (commas (map (ppTyped ppValue) fs))
-  ValString s        -> char 'c' <> ppStringLiteral s
-  ValConstExpr ce    -> ppConstExpr ce
-  ValUndef           -> text "undef"
-  ValLabel l         -> ppLabel l
-  ValZeroInit        -> text "zeroinitializer"
-  ValAsm s a i c     -> ppAsm s a i c
-  ValMd m            -> ppValMd m
-
-ppValMd :: ValMd -> Doc
-ppValMd m = case m of
-  ValMdString str -> ppMetadata (ppStringLiteral str)
-  ValMdValue tv   -> ppTyped ppValue tv
-  ValMdRef i      -> ppMetadata (int i)
-  ValMdNode vs    -> ppMetadataNode vs
-  ValMdLoc l      -> ppDebugLoc l
-
-ppDebugLoc :: DebugLoc -> Doc
-ppDebugLoc dl = text "!MDLocation"
-             <> parens (commas [ text "line:"    <+> int32 (dlLine dl)
-                               , text "column:"  <+> int32 (dlCol dl)
-                               , text "scope:"   <+> ppValMd (dlScope dl)
-                               ] <+> mbIA)
-
-  where
-  mbIA = case dlIA dl of
-           Just md -> comma <+> text "inlinedAt:" <+> ppValMd md
-           Nothing -> empty
-
-ppTypedValMd :: ValMd -> Doc
-ppTypedValMd  = ppTyped ppValMd . Typed (PrimType Metadata)
-
-ppMetadata :: Doc -> Doc
-ppMetadata body = char '!' <> body
-
-ppMetadataNode :: [Maybe ValMd] -> Doc
-ppMetadataNode vs = ppMetadata (braces (commas (map arg vs)))
-  where
-  arg = maybe (text "null") ppValMd
-
-ppBool :: Bool -> Doc
-ppBool b | b         = text "true"
-         | otherwise = text "false"
-
-ppStringLiteral :: String -> Doc
-ppStringLiteral  = doubleQuotes . text . concatMap escape
-  where
-  escape c | isAscii c && isPrint c = [c]
-           | otherwise              = '\\' : pad (ord c)
-
-  pad n | n < 0x10  = '0' : map toUpper (showHex n "")
-        | otherwise =       map toUpper (showHex n "")
-
-ppAsm :: Bool -> Bool -> String -> String -> Doc
-ppAsm s a i c =
-  text "asm" <+> sideeffect <+> alignstack
-             <+> ppStringLiteral i <> comma <+> ppStringLiteral c
-  where
-  sideeffect | s         = text "sideeffect"
-             | otherwise = empty
-
-  alignstack | a         = text "alignstack"
-             | otherwise = empty
-
 -- Value Elimination -----------------------------------------------------------
 
 elimValSymbol :: MonadPlus m => Value' lab -> m Symbol
@@ -1386,20 +901,7 @@
   Result r i mds -> Result r i (md:mds)
   Effect i mds   -> Effect i (md:mds)
 
-ppStmt :: Stmt -> Doc
-ppStmt stmt = case stmt of
-  Result var i mds -> ppIdent var <+> char '=' <+> ppInstr i
-                   <> ppAttachedMetadata mds
-  Effect i mds     -> ppInstr i <> ppAttachedMetadata mds
 
-ppAttachedMetadata :: [(String,ValMd)] -> Doc
-ppAttachedMetadata mds
-  | null mds  = empty
-  | otherwise = comma <+> commas (map step mds)
-  where
-  step (l,md) = ppMetadata (text l) <+> ppValMd md
-
-
 -- Constant Expressions --------------------------------------------------------
 
 data ConstExpr' lab
@@ -1411,17 +913,6 @@
 
 type ConstExpr = ConstExpr' BlockLabel
 
-ppConstExpr :: ConstExpr -> Doc
-ppConstExpr (ConstGEP inb ixs)  = text "getelementptr"
-                              <+> opt inb (text "inbounds")
-                              <+> parens (commas (map (ppTyped ppValue) ixs))
-ppConstExpr (ConstConv op tv t) = ppConvOp op <+> parens
-                                 (ppTyped ppValue tv <+> text "to" <+> ppType t)
-ppConstExpr (ConstSelect c l r) = text "select" <+> parens
-                                 (commas [ ppTyped ppValue c, ppTyped ppValue l
-                                         , ppTyped ppValue r])
-ppConstExpr (ConstBlockAddr t l)= text "blockaddress" <+> parens
-                                 (ppSymbol t <> comma <+> ppLabel l)
 
 
 -- Aggregate Utilities ---------------------------------------------------------
@@ -1435,6 +926,21 @@
 isInvalid ir = case ir of
   Invalid -> True
   _       -> False
+
+-- | Resolves the type of a GEP instruction. Type aliases are resolved
+-- using the given function. An invalid use of GEP or one relying
+-- on unknown type aliases will return 'Nothing'
+resolveGepFull ::
+  (Ident -> Maybe Type) {- ^ Type alias resolution -} ->
+  Type                  {- ^ Pointer type          -} ->
+  [Typed (Value' lab)]  {- ^ Path                  -} ->
+  Maybe Type            {- ^ Type of result        -}
+resolveGepFull env t ixs = go (resolveGep t ixs)
+  where
+  go Invalid                = Nothing
+  go (HasType result)       = Just result
+  go (Resolve ident resume) = go . resume =<< env ident
+
 
 -- | Resolve the type of a GEP instruction.  Note that the type produced is the
 -- type of the result, not necessarily a pointer.
diff --git a/src/Text/LLVM/Labels.hs b/src/Text/LLVM/Labels.hs
--- a/src/Text/LLVM/Labels.hs
+++ b/src/Text/LLVM/Labels.hs
@@ -1,111 +1,118 @@
+{-# LANGUAGE CPP #-}
+
+#ifndef MIN_VERSION_base
+#define MIN_VERSION_base(x,y,z) 1
+#endif
+
 module Text.LLVM.Labels where
 
 import Text.LLVM.AST
 
+#if !(MIN_VERSION_base(4,8,0))
 import Control.Applicative ((<$>),Applicative(..))
-import qualified Data.Traversable as T
+import Data.Traversable (traverse)
+#endif
 
 class Functor f => HasLabel f where
   -- | Given a function for resolving labels, where the presence of a symbol
   -- denotes a label in a different function, rename all labels in a function.
-  relabel :: (Applicative m, Monad m)
-          => (Maybe Symbol -> a -> m b) -> f a -> m (f b)
+  relabel :: Applicative m => (Maybe Symbol -> a -> m b) -> f a -> m (f b)
 
 instance HasLabel Stmt' where
   relabel f stmt = case stmt of
-    Result r i mds -> Result r <$> relabel f i <*> T.mapM relabelMd mds
-    Effect i mds   -> Effect   <$> relabel f i <*> T.mapM relabelMd mds
+    Result r i mds -> Result r <$> relabel f i <*> traverse relabelMd mds
+    Effect i mds   -> Effect   <$> relabel f i <*> traverse relabelMd mds
     where
     relabelMd (str,md) = (\md' -> (str,md')) `fmap` relabel f md
 
 instance HasLabel Instr' where
-  relabel _ RetVoid               = return  RetVoid
-  relabel _ Unreachable           = return  Unreachable
-  relabel _ Unwind                = return  Unwind
-  relabel _ (Comment str)         = return (Comment str)
-  relabel f (Ret tv)              = Ret <$> T.mapM (relabel f) tv
+  relabel _ RetVoid               = pure  RetVoid
+  relabel _ Unreachable           = pure  Unreachable
+  relabel _ Unwind                = pure  Unwind
+  relabel _ (Comment str)         = pure (Comment str)
+  relabel f (Ret tv)              = Ret <$> traverse (relabel f) tv
   relabel f (Arith op l r)        = Arith op
-                                <$> T.mapM (relabel f) l
+                                <$> traverse (relabel f) l
                                 <*> relabel f r
   relabel f (Bit op l r)          = Bit op
-                                <$> T.mapM (relabel f) l
+                                <$> traverse (relabel f) l
                                 <*> relabel f r
-  relabel f (Conv op l r)         = Conv op <$> T.mapM (relabel f) l <*> pure r
+  relabel f (Conv op l r)         = Conv op <$> traverse (relabel f) l <*> pure r
   relabel f (Call t r n as)       = Call t r
                                 <$> relabel f n
-                                <*> T.mapM (T.mapM (relabel f)) as
+                                <*> traverse (traverse (relabel f)) as
   relabel f (Alloca t n a)        = Alloca t
-                                <$> T.mapM (T.mapM (relabel f)) n
+                                <$> traverse (traverse (relabel f)) n
                                 <*> pure a
-  relabel f (Load a ma)           = Load <$> T.mapM (relabel f) a <*> pure ma
+  relabel f (Load a ma)           = Load <$> traverse (relabel f) a <*> pure ma
   relabel f (Store d v ma)        = Store
-                                <$> T.mapM (relabel f) d
-                                <*> T.mapM (relabel f) v
+                                <$> traverse (relabel f) d
+                                <*> traverse (relabel f) v
                                 <*> pure ma
   relabel f (ICmp op l r)         = ICmp op
-                                <$> T.mapM (relabel f) l
+                                <$> traverse (relabel f) l
                                 <*> relabel f r
   relabel f (FCmp op l r)         = FCmp op
-                                <$> T.mapM (relabel f) l
+                                <$> traverse (relabel f) l
                                 <*> relabel f r
   relabel f (GEP ib a is)         = GEP ib
-                                <$> T.mapM (relabel f) a
-                                <*> T.mapM (T.mapM (relabel f)) is
+                                <$> traverse (relabel f) a
+                                <*> traverse (traverse (relabel f)) is
   relabel f (Select c l r)        = Select
-                                <$> T.mapM (relabel f) c
-                                <*> T.mapM (relabel f) l <*> relabel f r
+                                <$> traverse (relabel f) c
+                                <*> traverse (relabel f) l <*> relabel f r
   relabel f (ExtractValue a is)   = ExtractValue
-                                <$> T.mapM (relabel f) a
+                                <$> traverse (relabel f) a
                                 <*> pure is
   relabel f (InsertValue a i is)  = InsertValue
-                                <$> T.mapM (relabel f) a
-                                <*> T.mapM (relabel f) i
+                                <$> traverse (relabel f) a
+                                <*> traverse (relabel f) i
                                 <*> pure is
   relabel f (ShuffleVector a b m) = ShuffleVector
-                                <$> T.mapM (relabel f) a
+                                <$> traverse (relabel f) a
                                 <*> relabel f b
-                                <*> T.mapM (relabel f) m
+                                <*> traverse (relabel f) m
   relabel f (Jump lab)            = Jump <$> f Nothing lab
   relabel f (Br c l r)            = Br
-                                <$> T.mapM (relabel f) c
+                                <$> traverse (relabel f) c
                                 <*> f Nothing l
                                 <*> f Nothing r
   relabel f (Invoke r s as u e)   = Invoke r
                                 <$> relabel f s
-                                <*> T.mapM (T.mapM (relabel f)) as
+                                <*> traverse (traverse (relabel f)) as
                                 <*> f Nothing u
                                 <*> f Nothing e
   relabel f (VaArg al t)          = VaArg
-                                <$> T.mapM (relabel f) al
+                                <$> traverse (relabel f) al
                                 <*> pure t
   relabel f (ExtractElt v i)      = ExtractElt
-                                <$> T.mapM (relabel f) v
+                                <$> traverse (relabel f) v
                                 <*> relabel f i
   relabel f (InsertElt v e i)     = InsertElt
-                                <$> T.mapM (relabel f) v
-                                <*> T.mapM (relabel f) e
+                                <$> traverse (relabel f) v
+                                <*> traverse (relabel f) e
                                 <*> relabel f i
   relabel f (IndirectBr d ls)     = IndirectBr
-                                <$> T.mapM (relabel f) d
-                                <*> T.mapM (f Nothing) ls
+                                <$> traverse (relabel f) d
+                                <*> traverse (f Nothing) ls
   relabel f (Switch c d ls)       =
     let step (n,i) = (\l -> (n,l)) <$> f Nothing i
-     in Switch <$> T.mapM (relabel f) c <*> f Nothing d <*> T.mapM step ls
+     in Switch <$> traverse (relabel f) c <*> f Nothing d <*> traverse step ls
   relabel f (Phi t ls)            =
     let step (a,l) = (,) <$> relabel f a <*> f Nothing l
-     in Phi t <$> T.mapM step ls
+     in Phi t <$> traverse step ls
 
   relabel f (LandingPad ty fn c cs) = LandingPad ty
-                                  <$> T.mapM (relabel f) fn
+                                  <$> traverse (relabel f) fn
                                   <*> pure c
-                                  <*> T.mapM (relabel f) cs
+                                  <*> traverse (relabel f) cs
 
-  relabel f (Resume tv)           = Resume <$> T.mapM (relabel f) tv
+  relabel f (Resume tv)           = Resume <$> traverse (relabel f) tv
 
 instance HasLabel Clause' where
   relabel f clause = case clause of
-    Catch  tv -> Catch  <$> T.mapM (relabel f) tv
-    Filter tv -> Filter <$> T.mapM (relabel f) tv
+    Catch  tv -> Catch  <$> traverse (relabel f) tv
+    Filter tv -> Filter <$> traverse (relabel f) tv
 
 instance HasLabel Value' where
   relabel _ (ValInteger i)       = pure (ValInteger i)
@@ -120,25 +127,25 @@
   relabel _  ValZeroInit         = pure ValZeroInit
   relabel _ (ValAsm s a i c)     = pure (ValAsm s a i c)
   relabel f (ValMd m)            = ValMd <$> relabel f m
-  relabel f (ValArray t es)      = ValArray t <$> T.mapM (relabel f) es
-  relabel f (ValVector pt es)    = ValVector pt <$> T.mapM (relabel f) es
-  relabel f (ValStruct fs)       = ValStruct <$> T.mapM (T.mapM (relabel f)) fs
+  relabel f (ValArray t es)      = ValArray t <$> traverse (relabel f) es
+  relabel f (ValVector pt es)    = ValVector pt <$> traverse (relabel f) es
+  relabel f (ValStruct fs)       = ValStruct <$> traverse (traverse (relabel f)) fs
   relabel f (ValConstExpr ce)    = ValConstExpr <$> relabel f ce
   relabel f (ValLabel lab)       = ValLabel <$> f Nothing lab
   relabel f (ValPackedStruct es) =
-    ValPackedStruct <$> T.mapM (T.mapM (relabel f)) es
+    ValPackedStruct <$> traverse (traverse (relabel f)) es
 
 instance HasLabel ValMd' where
   relabel f md = case md of
     ValMdString str -> pure (ValMdString str)
-    ValMdValue tv   -> ValMdValue <$> T.mapM (relabel f) tv
+    ValMdValue tv   -> ValMdValue <$> traverse (relabel f) tv
     ValMdRef i      -> pure (ValMdRef i)
-    ValMdNode es    -> ValMdNode <$> T.mapM (T.mapM (relabel f)) es
+    ValMdNode es    -> ValMdNode <$> traverse (traverse (relabel f)) es
     ValMdLoc dl     -> ValMdLoc <$> relabel f dl
 
 instance HasLabel DebugLoc' where
   relabel f dl = upd <$> relabel f (dlScope dl)
-                     <*> T.mapM (relabel f) (dlIA dl)
+                     <*> traverse (relabel f) (dlIA dl)
     where
     upd scope ia = dl
       { dlScope = scope
@@ -147,13 +154,13 @@
 
 instance HasLabel ConstExpr' where
   relabel f (ConstGEP inb is)   = ConstGEP inb
-                              <$> T.mapM (T.mapM (relabel f)) is
+                              <$> traverse (traverse (relabel f)) is
   relabel f (ConstConv op a t)  = ConstConv op
-                              <$> T.mapM (relabel f) a
+                              <$> traverse (relabel f) a
                               <*> pure t
   relabel f (ConstSelect c l r) = ConstSelect
-                              <$> T.mapM (relabel f) c
-                              <*> T.mapM (relabel f) l
-                              <*> T.mapM (relabel f) r
+                              <$> traverse (relabel f) c
+                              <*> traverse (relabel f) l
+                              <*> traverse (relabel f) r
   relabel f (ConstBlockAddr t l)= ConstBlockAddr t
                               <$> f (Just t) l
diff --git a/src/Text/LLVM/PP.hs b/src/Text/LLVM/PP.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/LLVM/PP.hs
@@ -0,0 +1,647 @@
+{-# LANGUAGE ImplicitParams #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE Rank2Types #-}
+
+-- |
+-- Module      :  Text.LLVM.PP
+-- Copyright   :  Trevor Elliott 2011-2016
+-- License     :  BSD3
+--
+-- Maintainer  :  awesomelyawesome@gmail.com
+-- Stability   :  experimental
+-- Portability :  unknown
+--
+-- This is the pretty-printer for llvm assembly versions 3.6 and lower.
+--
+module Text.LLVM.PP where
+
+import Text.LLVM.AST
+
+import Data.Char (isAscii,isPrint,ord,toUpper)
+import Data.Int (Int32)
+import Data.List (intersperse)
+import Data.Maybe (fromMaybe)
+import Numeric (showHex)
+import Text.PrettyPrint.HughesPJ
+
+
+-- Pretty-printer Config -------------------------------------------------------
+
+type LLVM = ?config :: Config
+
+-- | The differences between various versions of the llvm textual AST.
+data Config = Config { cfgLoadImplicitType :: Bool
+                       -- ^ True when the type of the result of a load is
+                       -- derived from its pointer argument, or supplied
+                       -- implicitly.
+
+                     , cfgGEPImplicitType :: Bool
+                       -- ^ True when the type of the result of the GEP
+                       -- instruction is implied.
+                     }
+
+withConfig :: Config -> (LLVM => a) -> a
+withConfig cfg body = let ?config = cfg in body
+
+
+ppLLVM, ppLLVM35, ppLLVM36, ppLLVM37, ppLLVM38 :: (LLVM => a) -> a
+
+ppLLVM = ppLLVM38
+
+ppLLVM35 = ppLLVM36
+
+ppLLVM36 = withConfig Config { cfgLoadImplicitType = True
+                             , cfgGEPImplicitType  = True
+                             }
+ppLLVM37 = withConfig Config { cfgLoadImplicitType = False
+                             , cfgGEPImplicitType  = False
+                             }
+ppLLVM38 = withConfig Config { cfgLoadImplicitType = False
+                             , cfgGEPImplicitType  = False
+                             }
+
+checkConfig :: LLVM => (Config -> Bool) -> Bool
+checkConfig p = p ?config
+
+
+-- Modules ---------------------------------------------------------------------
+
+ppModule :: LLVM => Module -> Doc
+ppModule m = foldr ($+$) empty
+  $ ppDataLayout (modDataLayout m)
+  : ppInlineAsm  (modInlineAsm m)
+  : concat [ map ppTypeDecl    (modTypes m)
+           , map ppGlobal      (modGlobals m)
+           , map ppGlobalAlias (modAliases m)
+           , map ppDeclare     (modDeclares m)
+           , map ppDefine      (modDefines m)
+           , map ppNamedMd     (modNamedMd m)
+           , map ppUnnamedMd   (modUnnamedMd m)
+           ]
+
+
+-- Metadata --------------------------------------------------------------------
+
+ppNamedMd :: NamedMd -> Doc
+ppNamedMd nm =
+  sep [ ppMetadata (text (nmName nm)) <+> char '='
+      , ppMetadata (braces (commas (map (ppMetadata . int) (nmValues nm)))) ]
+
+ppUnnamedMd :: UnnamedMd -> Doc
+ppUnnamedMd um =
+  sep [ ppMetadata (int (umIndex um)) <+> char '='
+      , distinct <+> ppMetadataNode (umValues um) ]
+  where
+  distinct | umDistinct um = text "distinct"
+           | otherwise     = empty
+
+
+-- Aliases ---------------------------------------------------------------------
+
+ppGlobalAlias :: GlobalAlias -> Doc
+ppGlobalAlias g = ppSymbol (aliasName g) <+> char '=' <+> body
+  where
+  val  = aliasTarget g
+  body = case val of
+    ValSymbol _sym -> ppType (aliasType g) <+> ppValue val
+    _              -> ppValue val
+
+
+-- Data Layout -----------------------------------------------------------------
+
+-- | Pretty print a data layout specification.
+ppDataLayout :: DataLayout -> Doc
+ppDataLayout [] = empty
+ppDataLayout ls = text "target" <+> text "datalayout" <+> char '='
+    <+> doubleQuotes (hcat (intersperse (char '-') (map ppLayoutSpec ls)))
+
+-- | Pretty print a single layout specification.
+ppLayoutSpec :: LayoutSpec -> Doc
+ppLayoutSpec  BigEndian                  = char 'E'
+ppLayoutSpec  LittleEndian               = char 'e'
+ppLayoutSpec (PointerSize   sz abi pref) = text "p:" <> ppLayoutBody sz abi pref
+ppLayoutSpec (IntegerSize   sz abi pref) = char 'i'  <> ppLayoutBody sz abi pref
+ppLayoutSpec (VectorSize    sz abi pref) = char 'v'  <> ppLayoutBody sz abi pref
+ppLayoutSpec (FloatSize     sz abi pref) = char 'f'  <> ppLayoutBody sz abi pref
+ppLayoutSpec (AggregateSize sz abi pref) = char 'a'  <> ppLayoutBody sz abi pref
+ppLayoutSpec (StackObjSize  sz abi pref) = char 's'  <> ppLayoutBody sz abi pref
+ppLayoutSpec (NativeIntSize szs)         = char 'n'  <> colons (map int szs)
+ppLayoutSpec (StackAlign a)              = char 'S'  <> int a
+ppLayoutSpec (Mangling m)                = char 'm'  <> char ':' <> ppMangling m
+
+-- | Pretty-print the common case for data layout specifications.
+ppLayoutBody :: Int -> Int -> Maybe Int -> Doc
+ppLayoutBody size abi mb = int size <> char ':' <> int abi <> pref
+  where
+  pref = case mb of
+    Nothing -> empty
+    Just p  -> char ':' <> int p
+
+ppMangling :: Mangling -> Doc
+ppMangling ElfMangling         = char 'e'
+ppMangling MipsMangling        = char 'm'
+ppMangling MachOMangling       = char 'o'
+ppMangling WindowsCoffMangling = char 'w'
+
+
+-- Inline Assembly -------------------------------------------------------------
+
+-- | Pretty-print the inline assembly block.
+ppInlineAsm :: InlineAsm -> Doc
+ppInlineAsm  = foldr ($+$) empty . map ppLine
+  where
+  ppLine l = text "module asm" <+> doubleQuotes (text l)
+
+
+-- Identifiers -----------------------------------------------------------------
+
+ppIdent :: Ident -> Doc
+ppIdent (Ident n) = char '%' <> text n
+
+
+-- Symbols ---------------------------------------------------------------------
+
+ppSymbol :: Symbol -> Doc
+ppSymbol (Symbol n) = char '@' <> text n
+
+
+-- Types -----------------------------------------------------------------------
+
+ppPrimType :: PrimType -> Doc
+ppPrimType Label          = text "label"
+ppPrimType Void           = text "void"
+ppPrimType (Integer i)    = char 'i' <> integer (toInteger i)
+ppPrimType (FloatType ft) = ppFloatType ft
+ppPrimType X86mmx         = text "x86mmx"
+ppPrimType Metadata       = text "metadata"
+
+ppFloatType :: FloatType -> Doc
+ppFloatType Half      = text "half"
+ppFloatType Float     = text "float"
+ppFloatType Double    = text "double"
+ppFloatType Fp128     = text "fp128"
+ppFloatType X86_fp80  = text "x86_fp80"
+ppFloatType PPC_fp128 = text "ppc_fp128"
+
+ppType :: Type -> Doc
+ppType (PrimType pt)     = ppPrimType pt
+ppType (Alias i)         = ppIdent i
+ppType (Array len ty)    = brackets (int32 len <+> char 'x' <+> ppType ty)
+ppType (PtrTo ty)        = ppType ty <> char '*'
+ppType (Struct ts)       = structBraces (commas (map ppType ts))
+ppType (PackedStruct ts) = angles (structBraces (commas (map ppType ts)))
+ppType (FunTy r as va)   = ppType r <> ppArgList va (map ppType as)
+ppType (Vector len pt)   = angles (int32 len <+> char 'x' <+> ppType pt)
+ppType Opaque            = text "opaque"
+
+ppTypeDecl :: TypeDecl -> Doc
+ppTypeDecl td = ppIdent (typeName td) <+> char '='
+            <+> text "type" <+> ppType (typeValue td)
+
+
+-- Declarations ----------------------------------------------------------------
+
+ppGlobal :: Global -> Doc
+ppGlobal g = ppSymbol (globalSym g) <+> char '='
+         <+> ppGlobalAttrs (globalAttrs g)
+         <+> ppType (globalType g) <+> ppMaybe ppValue (globalValue g)
+          <> ppAlign (globalAlign g)
+
+ppGlobalAttrs :: GlobalAttrs -> Doc
+ppGlobalAttrs ga = ppMaybe ppLinkage (gaLinkage ga) <+> constant
+  where
+  constant | gaConstant ga = text "constant"
+           | otherwise     = text "global"
+
+
+ppDeclare :: Declare -> Doc
+ppDeclare d = text "declare"
+          <+> ppType (decRetType d)
+          <+> ppSymbol (decName d)
+           <> ppArgList (decVarArgs d) (map ppType (decArgs d))
+
+
+ppDefine :: LLVM => Define -> Doc
+ppDefine d = text "define"
+         <+> ppMaybe ppLinkage (funLinkage (defAttrs d))
+         <+> ppType (defRetType d)
+         <+> ppSymbol (defName d)
+          <> ppArgList (defVarArgs d) (map (ppTyped ppIdent) (defArgs d))
+         <+> ppMaybe (\s  -> text "section" <+> doubleQuotes (text s)) (defSection d)
+         <+> ppMaybe (\gc -> text "gc" <+> ppGC gc) (funGC (defAttrs d))
+         <+> char '{'
+         $+$ vcat (map ppBasicBlock (defBody d))
+         $+$ char '}'
+
+
+-- Basic Blocks ----------------------------------------------------------------
+
+ppLabelDef :: BlockLabel -> Doc
+ppLabelDef (Named (Ident l)) = text l <> char ':'
+ppLabelDef (Anon i)          = char ';' <+> text "<label>:" <+> int i
+
+ppLabel :: BlockLabel -> Doc
+ppLabel (Named l) = ppIdent l
+ppLabel (Anon i)  = char '%' <> int i
+
+ppBasicBlock :: LLVM => BasicBlock -> Doc
+ppBasicBlock bb = ppMaybe ppLabelDef (bbLabel bb)
+              $+$ nest 2 (vcat (map ppStmt (bbStmts bb)))
+
+
+-- Statements ------------------------------------------------------------------
+
+ppStmt :: LLVM => Stmt -> Doc
+ppStmt stmt = case stmt of
+  Result var i mds -> ppIdent var <+> char '=' <+> ppInstr i
+                   <> ppAttachedMetadata mds
+  Effect i mds     -> ppInstr i <> ppAttachedMetadata mds
+
+ppAttachedMetadata :: [(String,ValMd)] -> Doc
+ppAttachedMetadata mds
+  | null mds  = empty
+  | otherwise = comma <+> commas (map step mds)
+  where
+  step (l,md) = ppMetadata (text l) <+> ppValMd md
+
+
+-- Linkage ---------------------------------------------------------------------
+
+ppLinkage :: Linkage -> Doc
+ppLinkage linkage = case linkage of
+  Private                  -> text "private"
+  LinkerPrivate            -> text "linker_private"
+  LinkerPrivateWeak        -> text "linker_private_weak"
+  LinkerPrivateWeakDefAuto -> text "linker_private_weak_def_auto"
+  Internal                 -> text "internal"
+  AvailableExternally      -> text "available_externally"
+  Linkonce                 -> text "linkonce"
+  Weak                     -> text "weak"
+  Common                   -> text "common"
+  Appending                -> text "appending"
+  ExternWeak               -> text "extern_weak"
+  LinkonceODR              -> text "linkonce_ddr"
+  WeakODR                  -> text "weak_odr"
+  External                 -> text "external"
+  DLLImport                -> text "dllimport"
+  DLLExport                -> text "dllexport"
+
+ppGC :: GC -> Doc
+ppGC  = doubleQuotes . text . getGC
+
+
+-- Expressions -----------------------------------------------------------------
+
+ppTyped :: (a -> Doc) -> Typed a -> Doc
+ppTyped fmt ty = ppType (typedType ty) <+> fmt (typedValue ty)
+
+ppSignBits :: Bool -> Bool -> Doc
+ppSignBits nuw nsw = opt nuw (text "nuw") <+> opt nsw (text "nsw")
+
+ppExact :: Bool -> Doc
+ppExact e = opt e (text "exact")
+
+ppArithOp :: ArithOp -> Doc
+ppArithOp (Add nuw nsw) = text "add" <+> ppSignBits nuw nsw
+ppArithOp FAdd          = text "fadd"
+ppArithOp (Sub nuw nsw) = text "sub" <+> ppSignBits nuw nsw
+ppArithOp FSub          = text "fsub"
+ppArithOp (Mul nuw nsw) = text "mul" <+> ppSignBits nuw nsw
+ppArithOp FMul          = text "fmul"
+ppArithOp (UDiv e)      = text "udiv" <+> ppExact e
+ppArithOp (SDiv e)      = text "sdiv" <+> ppExact e
+ppArithOp FDiv          = text "fdiv"
+ppArithOp URem          = text "urem"
+ppArithOp SRem          = text "srem"
+ppArithOp FRem          = text "frem"
+
+ppBitOp :: BitOp -> Doc
+ppBitOp (Shl nuw nsw) = text "shl"  <+> ppSignBits nuw nsw
+ppBitOp (Lshr e)      = text "lshr" <+> ppExact e
+ppBitOp (Ashr e)      = text "ashr" <+> ppExact e
+ppBitOp And           = text "and"
+ppBitOp Or            = text "or"
+ppBitOp Xor           = text "xor"
+
+ppConvOp :: ConvOp -> Doc
+ppConvOp Trunc    = text "trunc"
+ppConvOp ZExt     = text "zext"
+ppConvOp SExt     = text "sext"
+ppConvOp FpTrunc  = text "fptrunc"
+ppConvOp FpExt    = text "fpext"
+ppConvOp FpToUi   = text "fptoui"
+ppConvOp FpToSi   = text "fptosi"
+ppConvOp UiToFp   = text "uitofp"
+ppConvOp SiToFp   = text "sitofp"
+ppConvOp PtrToInt = text "ptrtoint"
+ppConvOp IntToPtr = text "inttoptr"
+ppConvOp BitCast  = text "bitcast"
+
+ppInstr :: LLVM => Instr -> Doc
+ppInstr instr = case instr of
+  Ret tv                 -> text "ret" <+> ppTyped ppValue tv
+  RetVoid                -> text "ret void"
+  Arith op l r           -> ppArithOp op <+> ppTyped ppValue l
+                         <> comma <+> ppValue r
+  Bit op l r             -> ppBitOp op <+> ppTyped ppValue l
+                         <> comma <+> ppValue r
+  Conv op a ty           -> ppConvOp op <+> ppTyped ppValue a
+                        <+> text "to" <+> ppType ty
+  Call tc ty f args      -> ppCall tc ty f args
+  Alloca ty len align    -> ppAlloca ty len align
+  Load ptr ma            -> ppLoad ptr ma
+  Store a ptr ma         -> text "store" <+> ppTyped ppValue a
+                         <> comma <+> ppTyped ppValue ptr
+                         <> ppAlign ma
+  ICmp op l r            -> text "icmp" <+> ppICmpOp op
+                        <+> ppTyped ppValue l <> comma <+> ppValue r
+  FCmp op l r            -> text "fcmp" <+> ppFCmpOp op
+                        <+> ppTyped ppValue l <> comma <+> ppValue r
+  Phi ty vls             -> text "phi" <+> ppType ty
+                        <+> commas (map ppPhiArg vls)
+  Select c t f           -> text "select" <+> ppTyped ppValue c
+                         <> comma <+> ppTyped ppValue t
+                         <> comma <+> ppTyped ppValue (f <$ t)
+  ExtractValue v is      -> text "extractvalue" <+> ppTyped ppValue v
+                         <> comma <+> (commas (map int32 is))
+  InsertValue a v is     -> text "insertvalue" <+> ppTyped ppValue a
+                         <> comma <+> ppTyped ppValue v
+                         <> comma <+> commas (map int32 is)
+  ShuffleVector a b m    -> text "shufflevector" <+> ppTyped ppValue a
+                         <> comma <+> ppTyped ppValue (b <$ a)
+                         <> comma <+> ppTyped ppValue m
+  GEP ib ptr ixs         -> ppGEP ib ptr ixs
+  Comment str            -> char ';' <+> text str
+  Jump i                 -> text "br"
+                        <+> ppTypedLabel i
+  Br c t f               -> text "br" <+> ppTyped ppValue c
+                         <> comma <+> ppType (PrimType Label)
+                        <+> ppLabel t
+                         <> comma <+> ppType (PrimType Label)
+                        <+> ppLabel f
+  Invoke ty f args to uw -> ppInvoke ty f args to uw
+  Unreachable            -> text "unreachable"
+  Unwind                 -> text "unwind"
+  VaArg al t             -> text "va_arg" <+> ppTyped ppValue al
+                         <> comma <+> ppType t
+  ExtractElt v i         -> text "extractelement"
+                        <+> ppTyped ppValue v
+                         <> comma <+> ppVectorIndex i
+  InsertElt v e i        -> text "insertelement"
+                        <+> ppTyped ppValue v
+                         <> comma <+> ppTyped ppValue e
+                         <> comma <+> ppVectorIndex i
+  IndirectBr d ls        -> text "indirectbr"
+                        <+> ppTyped ppValue d
+                         <> comma <+> commas (map ppTypedLabel ls)
+  Switch c d ls          -> text "switch"
+                        <+> ppTyped ppValue c
+                         <> comma <+> ppTypedLabel d
+                        <+> char '['
+                         $$ nest 2 (vcat (map (ppSwitchEntry (typedType c)) ls))
+                         $$ char ']'
+  LandingPad ty fn c cs  -> text "landingpad"
+                        <+> ppType ty
+                        <+> text "personality"
+                        <+> ppTyped ppValue fn
+                         $$ nest 2 (ppClauses c cs)
+  Resume tv              -> text "resume" <+> ppTyped ppValue tv
+
+ppLoad :: LLVM => Typed (Value' BlockLabel) -> Maybe Align -> Doc
+ppLoad ptr ma =
+  text "load" <+> (if isImplicit then empty else explicit)
+              <+> ppTyped ppValue ptr
+               <> ppAlign ma
+
+  where
+  isImplicit = checkConfig cfgLoadImplicitType
+
+  explicit =
+    case typedType ptr of
+      PtrTo ty -> ppType ty <> comma
+      ty       -> ppType ty <> comma
+
+ppClauses :: Bool -> [Clause] -> Doc
+ppClauses isCleanup cs = vcat (cleanup : map ppClause cs)
+  where
+  cleanup | isCleanup = text "cleanup"
+          | otherwise = empty
+
+ppClause :: Clause -> Doc
+ppClause c = case c of
+  Catch  tv -> text "catch"  <+> ppTyped ppValue tv
+  Filter tv -> text "filter" <+> ppTyped ppValue tv
+
+
+ppTypedLabel :: BlockLabel -> Doc
+ppTypedLabel i = ppType (PrimType Label) <+> ppLabel i
+
+ppSwitchEntry :: Type -> (Integer,BlockLabel) -> Doc
+ppSwitchEntry ty (i,l) = ppType ty <+> integer i <> comma <+> ppTypedLabel l
+
+ppVectorIndex :: Value -> Doc
+ppVectorIndex i = ppType (PrimType (Integer 32)) <+> ppValue i
+
+ppAlign :: Maybe Align -> Doc
+ppAlign Nothing      = empty
+ppAlign (Just align) = comma <+> text "align" <+> int align
+
+ppAlloca :: Type -> Maybe (Typed Value) -> Maybe Int -> Doc
+ppAlloca ty mbLen mbAlign = text "alloca" <+> ppType ty <> len <> align
+  where
+  len = fromMaybe empty $ do
+    l <- mbLen
+    return (comma <+> ppTyped ppValue l)
+  align = fromMaybe empty $ do
+    a <- mbAlign
+    return (comma <+> text "align" <+> int a)
+
+ppCall :: Bool -> Type -> Value -> [Typed Value] -> Doc
+ppCall tc ty f args
+  | tc        = text "tail" <+> body
+  | otherwise = body
+  where
+  body = text "call" <+> ppCallSym ty f
+      <> parens (commas (map (ppTyped ppValue) args))
+
+ppCallSym :: Type -> Value -> Doc
+ppCallSym (PtrTo (FunTy res _ _)) (ValSymbol sym) = ppType res <+> ppSymbol sym
+ppCallSym ty              val                     = ppType ty  <+> ppValue val
+
+ppGEP :: LLVM => Bool -> Typed Value -> [Typed Value] -> Doc
+ppGEP ib ptr ixs = text "getelementptr" <+> inbounds
+               <+> (if isImplicit then empty else explicit)
+               <+> commas (map (ppTyped ppValue) (ptr:ixs))
+  where
+  isImplicit = checkConfig cfgGEPImplicitType
+
+  explicit =
+    case typedType ptr of
+      PtrTo ty -> ppType ty <> comma
+      ty       -> ppType ty <> comma
+
+  inbounds | ib        = text "inbounds"
+           | otherwise = empty
+
+ppInvoke :: Type -> Value -> [Typed Value] -> BlockLabel -> BlockLabel -> Doc
+ppInvoke ty f args to uw = body
+  where
+  body = text "invoke" <+> ppType ty <+> ppValue f
+      <> parens (commas (map (ppTyped ppValue) args))
+     <+> text "to" <+> ppType (PrimType Label) <+> ppLabel to
+     <+> text "unwind" <+> ppType (PrimType Label) <+> ppLabel uw
+
+ppPhiArg :: (Value,BlockLabel) -> Doc
+ppPhiArg (v,l) = char '[' <+> ppValue v <> comma <+> ppLabel l <+> char ']'
+
+ppICmpOp :: ICmpOp -> Doc
+ppICmpOp Ieq  = text "eq"
+ppICmpOp Ine  = text "ne"
+ppICmpOp Iugt = text "ugt"
+ppICmpOp Iuge = text "uge"
+ppICmpOp Iult = text "ult"
+ppICmpOp Iule = text "ule"
+ppICmpOp Isgt = text "sgt"
+ppICmpOp Isge = text "sge"
+ppICmpOp Islt = text "slt"
+ppICmpOp Isle = text "sle"
+
+ppFCmpOp :: FCmpOp -> Doc
+ppFCmpOp Ffalse = text "false"
+ppFCmpOp Foeq   = text "oeq"
+ppFCmpOp Fogt   = text "ogt"
+ppFCmpOp Foge   = text "oge"
+ppFCmpOp Folt   = text "olt"
+ppFCmpOp Fole   = text "ole"
+ppFCmpOp Fone   = text "one"
+ppFCmpOp Ford   = text "ord"
+ppFCmpOp Fueq   = text "ueq"
+ppFCmpOp Fugt   = text "ugt"
+ppFCmpOp Fuge   = text "uge"
+ppFCmpOp Fult   = text "ult"
+ppFCmpOp Fule   = text "ule"
+ppFCmpOp Fune   = text "une"
+ppFCmpOp Funo   = text "uno"
+ppFCmpOp Ftrue  = text "true"
+
+ppValue :: Value -> Doc
+ppValue val = case val of
+  ValInteger i       -> integer i
+  ValBool b          -> ppBool b
+  ValFloat i         -> float i
+  ValDouble i        -> double i
+  ValIdent i         -> ppIdent i
+  ValSymbol s        -> ppSymbol s
+  ValNull            -> text "null"
+  ValArray ty es     -> brackets
+                      $ commas (map (ppTyped ppValue . Typed ty) es)
+  ValVector ty es   -> angles $ commas
+                     $ map (ppTyped ppValue . Typed ty) es
+  ValStruct fs       -> structBraces (commas (map (ppTyped ppValue) fs))
+  ValPackedStruct fs -> angles
+                      $ structBraces (commas (map (ppTyped ppValue) fs))
+  ValString s        -> char 'c' <> ppStringLiteral s
+  ValConstExpr ce    -> ppConstExpr ce
+  ValUndef           -> text "undef"
+  ValLabel l         -> ppLabel l
+  ValZeroInit        -> text "zeroinitializer"
+  ValAsm s a i c     -> ppAsm s a i c
+  ValMd m            -> ppValMd m
+
+ppValMd :: ValMd -> Doc
+ppValMd m = case m of
+  ValMdString str -> ppMetadata (ppStringLiteral str)
+  ValMdValue tv   -> ppTyped ppValue tv
+  ValMdRef i      -> ppMetadata (int i)
+  ValMdNode vs    -> ppMetadataNode vs
+  ValMdLoc l      -> ppDebugLoc l
+
+ppDebugLoc :: DebugLoc -> Doc
+ppDebugLoc dl = text "!MDLocation"
+             <> parens (commas [ text "line:"    <+> int32 (dlLine dl)
+                               , text "column:"  <+> int32 (dlCol dl)
+                               , text "scope:"   <+> ppValMd (dlScope dl)
+                               ] <+> mbIA)
+
+  where
+  mbIA = case dlIA dl of
+           Just md -> comma <+> text "inlinedAt:" <+> ppValMd md
+           Nothing -> empty
+
+ppTypedValMd :: ValMd -> Doc
+ppTypedValMd  = ppTyped ppValMd . Typed (PrimType Metadata)
+
+ppMetadata :: Doc -> Doc
+ppMetadata body = char '!' <> body
+
+ppMetadataNode :: [Maybe ValMd] -> Doc
+ppMetadataNode vs = ppMetadata (braces (commas (map arg vs)))
+  where
+  arg = maybe (text "null") ppValMd
+
+ppBool :: Bool -> Doc
+ppBool b | b         = text "true"
+         | otherwise = text "false"
+
+ppStringLiteral :: String -> Doc
+ppStringLiteral  = doubleQuotes . text . concatMap escape
+  where
+  escape c | isAscii c && isPrint c = [c]
+           | otherwise              = '\\' : pad (ord c)
+
+  pad n | n < 0x10  = '0' : map toUpper (showHex n "")
+        | otherwise =       map toUpper (showHex n "")
+
+ppAsm :: Bool -> Bool -> String -> String -> Doc
+ppAsm s a i c =
+  text "asm" <+> sideeffect <+> alignstack
+             <+> ppStringLiteral i <> comma <+> ppStringLiteral c
+  where
+  sideeffect | s         = text "sideeffect"
+             | otherwise = empty
+
+  alignstack | a         = text "alignstack"
+             | otherwise = empty
+
+
+ppConstExpr :: ConstExpr -> Doc
+ppConstExpr (ConstGEP inb ixs)  = text "getelementptr"
+                              <+> opt inb (text "inbounds")
+                              <+> parens (commas (map (ppTyped ppValue) ixs))
+ppConstExpr (ConstConv op tv t) = ppConvOp op <+> parens
+                                 (ppTyped ppValue tv <+> text "to" <+> ppType t)
+ppConstExpr (ConstSelect c l r) = text "select" <+> parens
+                                 (commas [ ppTyped ppValue c, ppTyped ppValue l
+                                         , ppTyped ppValue r])
+ppConstExpr (ConstBlockAddr t l)= text "blockaddress" <+> parens
+                                 (ppSymbol t <> comma <+> ppLabel l)
+
+
+-- Utilities -------------------------------------------------------------------
+
+-- | Build a variable-argument argument list.
+ppArgList :: Bool -> [Doc] -> Doc
+ppArgList True  ds = parens (commas (ds ++ [text "..."]))
+ppArgList False ds = parens (commas ds)
+
+int32 :: Int32 -> Doc
+int32  = int . fromIntegral
+
+opt :: Bool -> Doc -> Doc
+opt True  = id
+opt False = const empty
+
+commas :: [Doc] -> Doc
+commas  = fsep . punctuate comma
+
+angles :: Doc -> Doc
+angles d = char '<' <> d <> char '>'
+
+structBraces :: Doc -> Doc
+structBraces body = char '{' <+> body <+> char '}'
+
+ppMaybe :: (a -> Doc) -> Maybe a -> Doc
+ppMaybe  = maybe empty
+
+colons :: [Doc] -> Doc
+colons  = fsep . punctuate (char ':')
diff --git a/src/Text/LLVM/Util.hs b/src/Text/LLVM/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Text/LLVM/Util.hs
@@ -0,0 +1,18 @@
+module Text.LLVM.Util where
+
+import Control.Monad (MonadPlus,mzero)
+import Data.List (unfoldr)
+
+
+breaks :: (a -> Bool) -> [a] -> [[a]]
+breaks p = unfoldr step
+  where
+  step [] = Nothing
+  step xs = case break p xs of
+    (as,_:bs) -> Just (as,bs)
+    (as,  []) -> Just (as,[])
+
+uncons :: MonadPlus m => [a] -> m (a,[a])
+uncons (a:as) = return (a,as)
+uncons _      = mzero
+