diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,21 @@
+Copyright (c) 2014-2017 Stephen Diehl
+Copyright (c) 2015 Cedric Shock
+
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of this software and associated documentation files (the
+"Software"), to deal in the Software without restriction, including
+without limitation the rights to use, copy, modify, merge, publish,
+distribute, sublicense, and/or sell copies of the Software, and to
+permit persons to whom the Software is furnished to do so, subject to
+the following conditions:
+
+The above copyright notice and this permission notice shall be included
+in all copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY
+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,
+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,147 @@
+llvm-hs-pretty
+--------------
+
+[![Build Status](https://travis-ci.org/llvm-hs/llvm-hs-pretty.svg)](https://travis-ci.org/llvm-hs/llvm-hs-pretty)
+
+A pretty printer for ``llvm-hs-pure``. Goal is to be able to pretty print a
+sufficiently large subset of the LLVM AST from pure Haskell without having to go
+through the C++ API.
+
+Usage
+-----
+
+```bash
+sudo apt-get install llvm-dev-5.0
+```
+
+There is a single function ``ppllvm`` that maps a LLVM.AST.Module to a
+String.
+
+```haskell
+import LLVM.AST
+import LLVM.Pretty (ppllvm)
+
+ppllvm :: Module -> Text
+```
+
+Tests
+-----
+
+The test suite currently consists of round tripping a LLVM IR from correct IR
+outputted by the llc toolchain, parsing into llvm-general AST and then printing
+it back out and comparing it with the original textual form to see if the pretty
+printer faithfully preserves the structure. The sample modules are in
+``tests/``.
+
+Using stack:
+
+```bash
+$ stac build
+$ stack test
+```
+
+Using cabal:
+
+```bash
+$ cabal run
+$ cabal run -- tests/simple.ll
+```
+
+If you're using Nix then:
+
+```bash
+$ nix-shell
+$ cabal run
+```
+
+Example
+-------
+
+To try out the standalone example run:
+
+```bash
+$ stack repl
+$ :load Example.hs
+main
+```
+
+Consider the basic example LLVM module.
+
+```llvm
+; ModuleID = 'example-llvm-module'
+
+define i8 @f(i8 %x){
+entry:
+  ret i8 %x
+}
+```
+
+Using the LLVM.AST we construct the type and feed it to the pretty
+printer.
+
+```haskell
+module Standalone where
+
+-- Pretty Printer
+import LLVM.Pretty (ppllvm)
+
+-- AST
+import qualified LLVM.AST as AST
+import qualified LLVM.AST.Linkage as Linkage
+import qualified LLVM.AST.Visibility as Visibility
+import qualified LLVM.AST.CallingConvention as Convention
+
+import Data.Text.Lazy.IO as TIO
+
+astModule :: AST.Module
+astModule = AST.Module
+    { AST.moduleName         = "example-llvm-module"
+    , AST.moduleDataLayout   = Nothing
+    , AST.moduleTargetTriple = Nothing
+    , AST.moduleDefinitions  =
+        [ AST.GlobalDefinition
+            (AST.Function
+                Linkage.External
+                Visibility.Default
+                Nothing
+                Convention.C
+                []
+                (AST.IntegerType 8)
+                (AST.Name "f")
+                ([AST.Parameter (AST.IntegerType 8) (AST.Name "x") []], False)
+                []
+                Nothing
+                Nothing
+                0
+                Nothing
+                Nothing
+                [ AST.BasicBlock
+                    (AST.Name "entry")
+                    []
+                    (AST.Do
+                        (AST.Ret
+                            (Just
+                                (AST.LocalReference
+                                    (AST.IntegerType 8)
+                                    (AST.Name "x")
+                                )
+                            )
+                            []
+                        )
+                    )
+                ]
+            )
+        ]
+    }
+
+main :: IO ()
+main = TIO.putStrLn (ppllvm astModule)
+```
+
+License
+-------
+
+Released under the MIT License.
+
+Copyright (c) 2014-2017, Stephen Diehl
+Copyright (c) 2015 Cedric Shock
diff --git a/llvm-hs-pretty.cabal b/llvm-hs-pretty.cabal
new file mode 100644
--- /dev/null
+++ b/llvm-hs-pretty.cabal
@@ -0,0 +1,57 @@
+name:                llvm-hs-pretty
+version:             0.1.0.0
+license:             MIT
+license-file:        LICENSE
+author:              Stephen Diehl
+maintainer:          stephen.m.diehl@gmail.com
+build-type:          Simple
+category:            Compilers
+extra-source-files:  README.md
+cabal-version:       >=1.10
+homepage:            https://github.com/llvm-hs/llvm-hs-pretty
+
+Synopsis: Pretty printer for LLVM IR.
+Description:
+  Pretty printer for LLVM IR.
+
+Source-Repository head
+    Type: git
+    Location: git@github.com:llvm-hs/llvm-hs-pretty.git
+
+library
+  hs-source-dirs:      src
+  exposed-modules:     
+    LLVM.Pretty
+    LLVM.Typed
+    LLVM.Token
+  ghc-options:
+    -fwarn-incomplete-patterns
+  default-language:    Haskell2010
+  build-depends:
+    array                >= 0.5,
+    base                 >= 4.6   && < 5.0,
+    bytestring           >= 0.10,
+    llvm-hs-pure         >= 5.1,
+    text                 >= 0.1,
+    wl-pprint-text       >= 1.1
+
+Test-suite test
+  type:                exitcode-stdio-1.0
+  hs-source-dirs:      tests
+  main-is:             Main.hs
+  default-language:    Haskell2010
+  build-depends: 
+    base                 >= 4.6 && < 5.0,
+    text                 >= 0.1,
+    mtl                  >= 2.2,
+    transformers         >= 0.3 && < 0.6,
+    directory            >= 1.2,
+    filepath             >= 1.3,
+    pretty-show          >= 1.6 && < 1.7,
+    tasty                >= 0.11,
+    tasty-hspec          >= 1.1,
+    tasty-hunit          -any,
+    tasty-golden         >= 1.1,
+    llvm-hs-pretty       -any,
+    llvm-hs              >= 5.1,
+    llvm-hs-pure         >= 5.0
diff --git a/src/LLVM/Pretty.hs b/src/LLVM/Pretty.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Pretty.hs
@@ -0,0 +1,785 @@
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE TypeSynonymInstances #-}
+{-# OPTIONS_GHC -fwarn-incomplete-patterns #-}
+{-# OPTIONS_GHC -fwarn-incomplete-uni-patterns #-}
+
+module LLVM.Pretty (
+  ppllvm,
+  ppll,
+) where
+
+import Prelude hiding ((<$>))
+import GHC.Word
+
+import LLVM.Typed
+
+import LLVM.AST
+import LLVM.AST.Global
+import LLVM.AST.Type
+
+import LLVM.AST.Attribute
+import LLVM.AST.COMDAT
+import qualified LLVM.AST.Linkage as L
+import qualified LLVM.AST.Visibility as V
+import qualified LLVM.AST.CallingConvention as CC
+import qualified LLVM.AST.Constant as C
+import qualified LLVM.AST.FloatingPointPredicate as FP
+import qualified LLVM.AST.IntegerPredicate as IP
+import qualified LLVM.AST.AddrSpace as AS
+import qualified LLVM.AST.Float as F
+import qualified LLVM.AST.RMWOperation as RMW
+import LLVM.AST.ParameterAttribute as PA
+import LLVM.AST.FunctionAttribute as FA
+
+import Data.String
+
+import Text.Printf
+import Data.Text.Lazy.Encoding
+import Data.Text.Lazy (Text, pack, unpack)
+import qualified Data.ByteString.Short as SBF
+import qualified Data.ByteString.Lazy.Char8 as BF
+import Data.ByteString.Lazy (fromStrict)
+import Data.ByteString.Internal (w2c)
+import Text.PrettyPrint.Leijen.Text
+
+import qualified Data.ByteString.Char8 as BL
+import qualified Data.ByteString.Short as BS
+import Data.Char (chr, ord, isAscii, isControl, isLetter, isDigit)
+import Data.Foldable (toList)
+import Data.List (intersperse)
+import Data.Maybe (isJust)
+import Numeric (showHex)
+
+import Data.Array.Unsafe
+import Data.Array.MArray
+import Data.Array.ST
+import Control.Monad.ST
+
+-------------------------------------------------------------------------------
+-- Utils
+-------------------------------------------------------------------------------
+
+parensIf ::  Bool -> Doc -> Doc
+parensIf True = parens
+parensIf False = id
+
+commas :: [Doc] -> Doc
+commas  = hsep . punctuate (char ',')
+
+colons :: [Doc] -> Doc
+colons  = hcat . intersperse (char ':')
+
+hlinecat :: [Doc] -> Doc
+hlinecat = vcat . intersperse softbreak
+
+wrapbraces :: Doc -> Doc -> Doc
+wrapbraces leadIn x = (leadIn <> char '{') <$> x <$> char '}'
+
+angleBrackets :: Doc -> Doc
+angleBrackets x = char '<' <> x <> char '>'
+
+spacedbraces :: Doc -> Doc
+spacedbraces x = char '{' <+> x <+> char '}'
+
+local :: Doc -> Doc
+local a = "%" <> a
+
+global :: Doc -> Doc
+global a = "@" <> a
+
+label :: Doc -> Doc
+label a = "label" <+> "%" <> a
+
+cma :: Doc -> Doc -> Doc -- <,> does not work :(
+a `cma` b = a <> "," <+> b
+
+-------------------------------------------------------------------------------
+-- Classes
+-------------------------------------------------------------------------------
+
+class PP p where
+  pp :: p -> Doc
+
+ppMaybe :: PP a => Maybe a -> Doc
+ppMaybe (Just x) = pp x
+ppMaybe Nothing = empty
+
+ppBool :: Doc -> Bool -> Doc
+ppBool x True = x
+ppBool x False = empty
+
+-- XXX: horrible hack
+unShort :: BS.ShortByteString -> [Char]
+unShort xs = fmap (toEnum . fromIntegral) $ BS.unpack xs
+
+short :: BS.ShortByteString -> Doc
+short x = string (pack (unShort x))
+
+decodeShortUtf8 :: SBF.ShortByteString -> Text
+decodeShortUtf8 = decodeUtf8 . fromStrict . SBF.fromShort
+
+instance PP Word32 where
+  pp x = int (fromIntegral x)
+
+instance PP Word64 where
+  pp x = int (fromIntegral x)
+
+instance PP Integer where
+  pp = integer
+
+instance PP Name where
+  pp (Name nm)
+   | BS.null nm = dquotes empty
+    | isFirst first && all isRest name = text (pack name)
+    | otherwise = dquotes . hcat . map escape $ name
+    where
+        name = unShort nm
+        first = head name
+        isFirst c = isLetter c || c == '-' || c == '_' || c == '$' || c == '.'
+        isRest c = isDigit c || isFirst c
+  pp (UnName x) = int (fromIntegral x)
+
+instance PP Parameter where
+  pp (Parameter ty (UnName _) attrs) = pp ty <+> pp attrs
+  pp (Parameter ty name attrs) = pp ty <+> pp attrs <+> local (pp name)
+
+instance PP [ParameterAttribute] where
+  pp x = hsep $ fmap pp x
+
+instance PP ([Parameter], Bool) where
+  pp (params, False) = commas (fmap pp params)
+  pp (params, True) = "TODO" -- XXX: variadic case
+
+instance PP (Operand, [ParameterAttribute]) where
+  pp (op, attrs) = pp (typeOf op) <+> pp attrs <+> pp op
+
+instance PP UnnamedAddr where
+  pp LocalAddr = "local_unnamed_addr"
+  pp GlobalAddr = "unnamed_addr"
+
+instance PP Type where
+  pp (IntegerType width) = "i" <> pp width
+  pp (FloatingPointType HalfFP)      = "half"
+  pp (FloatingPointType FloatFP )    = "float"
+  pp (FloatingPointType DoubleFP)    = "double"
+  pp (FloatingPointType FP128FP)     = "fp128"
+  pp (FloatingPointType X86_FP80FP)  = "x86_fp80"
+  pp (FloatingPointType PPC_FP128FP) = "ppc_fp128"
+
+  pp VoidType = "void"
+  pp (PointerType ref (AS.AddrSpace addr))
+    | addr == 0 = pp ref <> "*"
+    | otherwise = pp ref <+> "addrspace" <> parens (pp addr) <> "*"
+  pp ft@(FunctionType {..}) = pp resultType <+> ppFunctionArgumentTypes ft
+  pp (VectorType {..}) = "<" <> pp nVectorElements <+> "x" <+> pp elementType <> ">"
+  pp (StructureType {..}) = if isPacked
+                               then "<{" <> (commas $ fmap pp elementTypes ) <> "}>"
+                               else  "{" <> (commas $ fmap pp elementTypes ) <> "}"
+  pp (ArrayType {..}) = brackets $ pp nArrayElements <+> "x" <+> pp elementType
+  pp (NamedTypeReference name) = "%" <> pp name
+  pp MetadataType = "metadata"
+  pp TokenType = "token"
+  pp LabelType = "label"
+
+instance PP Global where
+  pp Function {..} =
+      case basicBlocks of
+        [] ->
+          ("declare" <+> pp linkage <+> pp callingConvention
+            <+> pp returnAttributes <+> pp returnType <+> global (pp name)
+            <> ppParams (pp . typeOf) parameters <+> pp functionAttributes <+> align <+> gcName)
+
+        -- single unnamed block is special cased, and won't parse otherwise... yeah good times
+        [b@(BasicBlock (UnName _) _ _)] ->
+            ("define" <+> pp linkage <+> pp callingConvention
+              <+> pp returnAttributes <+> pp returnType <+> global (pp name)
+              <> ppParams pp parameters <+> pp functionAttributes <+> align <+> gcName)
+            `wrapbraces` (indent 2 $ ppSingleBlock b)
+
+        bs ->
+          ("define" <+> pp linkage <+> pp callingConvention
+            <+> pp returnAttributes <+> pp returnType <+> global (pp name)
+            <> ppParams pp parameters <+> pp functionAttributes <+> align <+> gcName)
+          `wrapbraces` (vcat $ fmap pp bs)
+    where
+      align | alignment == 0    = empty
+            | otherwise = "align" <+> pp alignment
+      gcName = maybe empty (\n -> "gc" <+> dquotes (text $ pack n)) (fmap unShort garbageCollectorName)
+
+  pp GlobalVariable {..} = global (pp name) <+> "=" <+> ppLinkage hasInitializer linkage <+> ppMaybe unnamedAddr
+                             <+> addrSpace' <+> kind <+> pp type' <+> ppMaybe initializer <> ppAlign alignment
+    where
+      hasInitializer = isJust initializer
+      addrSpace' =
+        case addrSpace of
+          AS.AddrSpace addr
+            | addr == 0 -> mempty
+            | otherwise -> "addrspace" <> parens (pp addr)
+      kind | isConstant = "constant"
+           | otherwise  = "global"
+
+  pp GlobalAlias {..} = global (pp name) <+> "=" <+> pp linkage <+> ppMaybe unnamedAddr <+> "alias" <+> pp typ `cma` ppTyped aliasee
+    where
+      typ = getElementType type'
+
+ppMetadata :: Maybe Metadata -> Doc
+ppMetadata Nothing = "null"
+ppMetadata (Just m) = pp m
+
+instance PP Definition where
+  pp (GlobalDefinition x) = pp x
+  pp (TypeDefinition nm ty) = local (pp nm) <+> "=" <+> "type" <+> maybe "opaque" pp ty
+  pp (FunctionAttributes gid attrs) = "attributes" <+> pp gid <+> "=" <+> braces (hsep (fmap ppAttrInGroup attrs))
+  pp (NamedMetadataDefinition nm meta) = "!" <> short nm <+> "=" <+> "!" <> braces (commas (fmap pp meta))
+  pp (MetadataNodeDefinition node meta) = pp node <+> "=" <+> "!" <> braces (commas (fmap ppMetadata meta))
+  pp (ModuleInlineAssembly asm) = "module asm" <+> dquotes (text (pack (BL.unpack asm)))
+  pp (COMDAT name selKind) = "$" <> short name <+> "=" <+> "comdat" <+> pp selKind
+
+instance PP SelectionKind where
+  pp Any = "any"
+  pp ExactMatch = "exactmatch"
+  pp Largest = "largest"
+  pp NoDuplicates = "noduplicates"
+  pp SameSize = "samesize"
+
+ppAttrInGroup :: FunctionAttribute -> Doc
+ppAttrInGroup = \case
+  StackAlignment n -> "alignstack=" <> pp n
+  attr -> pp attr
+
+instance PP FunctionAttribute where
+  pp = \case
+   NoReturn            -> "noreturn"
+   NoUnwind            -> "nounwind"
+   FA.ReadNone         -> "readnone"
+   FA.ReadOnly         -> "readonly"
+   FA.WriteOnly        -> "writeonly"
+   NoInline            -> "noinline"
+   AlwaysInline        -> "alwaysinline"
+   MinimizeSize        -> "minsize"
+   OptimizeForSize     -> "optsize"
+   OptimizeNone        -> "optnone"
+   SafeStack           -> "safestack"
+   StackProtect        -> "ssp"
+   StackProtectReq     -> "sspreq"
+   StackProtectStrong  -> "sspstrong"
+   NoRedZone           -> "noredzone"
+   NoImplicitFloat     -> "noimplicitfloat"
+   Naked               -> "naked"
+   InlineHint          -> "inlinehint"
+   StackAlignment n    -> "alignstack" <> parens (pp n)
+   ReturnsTwice        -> "returns_twice"
+   UWTable             -> "uwtable"
+   NonLazyBind         -> "nonlazybind"
+   Builtin             -> "builtin"
+   NoBuiltin           -> "nobuiltin"
+   Cold                -> "cold"
+   JumpTable           -> "jumptable"
+   NoDuplicate         -> "noduplicate"
+   SanitizeAddress     -> "sanitize_address"
+   SanitizeThread      -> "sanitize_thread"
+   SanitizeMemory      -> "sanitize_memory"
+   NoRecurse           -> "norecurse"
+   Convergent          -> "convergent"
+   ArgMemOnly          -> "argmemonly"
+   InaccessibleMemOnly -> "inaccessiblememonly"
+   AllocSize a Nothing -> "allocsize" <> parens (pp a)
+   AllocSize a (Just b) -> "allocsize" <> parens (commas [pp a, pp b])
+   InaccessibleMemOrArgMemOnly -> "inaccessiblemem_or_argmemonly"
+   FA.StringAttribute k v -> dquotes (short k) <> "=" <> dquotes (short v)
+   Speculatable        -> "speculatable"
+
+instance PP ParameterAttribute where
+  pp = \case
+    ZeroExt                    -> "zeroext"
+    SignExt                    -> "signext"
+    InReg                      -> "inreg"
+    SRet                       -> "sret"
+    Alignment word             -> "align" <+> pp word
+    NoAlias                    -> "noalias"
+    ByVal                      -> "byval"
+    NoCapture                  -> "nocapture"
+    Nest                       -> "nest"
+    PA.ReadNone                -> "readnone"
+    PA.ReadOnly                -> "readonly"
+    PA.WriteOnly               -> "writeonly"
+    InAlloca                   -> "inalloca"
+    NonNull                    -> "nonnull"
+    Dereferenceable word       -> "dereferenceable" <> parens (pp word)
+    DereferenceableOrNull word -> "dereferenceable_or_null" <> parens (pp word)
+    Returned                   -> "returned"
+    SwiftSelf                  -> "swiftself"
+    SwiftError                 -> "swifterror"
+    PA.StringAttribute k v -> dquotes (short k) <> "=" <> dquotes (short v)
+
+instance PP CC.CallingConvention where
+  pp = \case
+   CC.Numbered word -> "cc" <+> pp word
+   CC.C             -> "ccc"
+   CC.Fast          -> "fastcc"
+   CC.Cold          -> "coldcc"
+   CC.GHC           -> "cc 10"
+   CC.HiPE          -> "cc 11"
+   CC.WebKit_JS     -> "webkit_jscc"
+   CC.AnyReg        -> "anyregcc"
+   CC.PreserveMost  -> "preserve_mostcc"
+   CC.PreserveAll   -> "preserve_allcc"
+   CC.Swift         -> "swiftcc"
+   CC.CXX_FastTLS   -> "cxx_fast_tlscc"
+   CC.X86_StdCall   -> "cc 64"
+   CC.X86_FastCall  -> "cc 65"
+   CC.ARM_APCS      -> "cc 66"
+   CC.ARM_AAPCS     -> "cc 67"
+   CC.ARM_AAPCS_VFP -> "cc 68"
+   CC.MSP430_INTR   -> "cc 69"
+   CC.X86_ThisCall  -> "cc 70"
+   CC.PTX_Kernel    -> "cc 71"
+   CC.PTX_Device    -> "cc 72"
+   CC.SPIR_FUNC     -> "cc 75"
+   CC.SPIR_KERNEL   -> "cc 76"
+   CC.Intel_OCL_BI  -> "cc 77"
+   CC.X86_64_SysV   -> "cc 78"
+   CC.Win64         -> "cc 79"
+   CC.X86_Intr      -> "x86_intrcc"
+   CC.X86_RegCall   -> "x86_regcallcc"
+   CC.X86_VectorCall -> "x86_vectorcallcc"
+   CC.AVR_Intr      -> "avr_intrcc"
+   CC.AVR_Signal    -> "avr_signalcc"
+   CC.AVR_Builtin   -> "cc 86"
+   CC.HHVM          -> "hhvmcc"
+   CC.HHVM_C        -> "hhvm_ccc"
+   CC.AMDGPU_VS     -> "amdgpu_vs"
+   CC.AMDGPU_GS     -> "amdgpu_gs"
+   CC.AMDGPU_PS     -> "amdgpu_ps"
+   CC.AMDGPU_CS     -> "amdgpu_cs"
+   CC.AMDGPU_HS     -> "amdgpu_hs"
+   CC.AMDGPU_Kernel -> "amdgpu_kernel"
+   CC.MSP430_Builtin -> "msp430"
+
+instance PP L.Linkage where
+    pp = ppLinkage False
+
+ppLinkage :: Bool -> L.Linkage -> Doc
+ppLinkage omitExternal = \case
+   L.External | omitExternal -> empty
+              | otherwise    -> "external"
+   L.Private                 -> "private"
+   L.Internal                -> "internal"
+   L.ExternWeak              -> "extern_weak"
+   L.AvailableExternally     -> "available_externally"
+   L.LinkOnce                -> "linkonce"
+   L.Weak                    -> "weak"
+   L.Common                  -> "common"
+   L.Appending               -> "appending"
+   L.LinkOnceODR             -> "linkonce_odr"
+   L.WeakODR                 -> "weak_odr"
+
+instance PP MetadataNodeID where
+  pp (MetadataNodeID x) = "!" <> int (fromIntegral x)
+
+instance PP GroupID where
+  pp (GroupID x) = "#" <> int (fromIntegral x)
+
+instance PP BasicBlock where
+  pp (BasicBlock nm instrs term) =
+    label <$> indent 2 (vcat $ (fmap pp instrs) ++ [pp term])
+    where
+      label = case nm of
+        UnName _ -> "; <label>:" <> pp nm <> ":"
+        _ -> pp nm <> ":"
+
+instance PP Terminator where
+  pp = \case
+    Br dest meta -> "br" <+> label (pp dest)
+    Ret val meta -> "ret" <+> maybe "void" ppTyped val
+    CondBr cond tdest fdest meta ->
+     "br" <+> ppTyped cond
+     `cma` label (pp tdest)
+     `cma` label (pp fdest)
+    Switch {..} -> "switch" <+> ppTyped operand0'
+                 `cma` label (pp defaultDest)
+                 <+> brackets (hsep [ ppTyped v `cma` label (pp l) | (v,l) <- dests ])
+    Unreachable {..} -> "unreachable"
+    IndirectBr op dests meta -> "indirectbr" <+> ppTyped op `cma`
+     brackets (hsep [ label (pp l) | l <- dests ])
+
+    e @ Invoke {..} ->
+     ppInvoke e
+     <+> "to" <+> label (pp returnDest)
+     <+> "unwind" <+> label (pp exceptionDest)
+    Resume op meta -> "resume "<+> ppTyped op
+    CleanupRet pad dest meta ->
+     "cleanupret" <+> "from" <+> pp pad <+> "unwind" <+> maybe "to caller" (label . pp) dest
+    CatchRet catchPad succ meta ->
+      "catchret" <+> "from" <+> pp catchPad <+> "to" <+> label (pp succ)
+    CatchSwitch {..} ->
+      "catchswitch" <+> "within" <+> pp parentPad' <+>
+      brackets (commas (map (label . pp) (toList catchHandlers))) <+>
+      "unwind" <+> "to" <+> maybe "caller" pp defaultUnwindDest
+
+instance PP Instruction where
+  pp = \case
+    Add {..}    -> "add"  <+> ppTyped operand0 `cma` pp operand1
+    Sub {..}    -> "sub"  <+> ppTyped operand0 `cma` pp operand1
+    Mul {..}    -> "mul"  <+> ppTyped operand0 `cma` pp operand1
+    Shl {..}    -> "shl"  <+> ppTyped operand0 `cma` pp operand1
+    AShr {..}   -> "ashr" <+> ppTyped operand0 `cma` pp operand1
+    LShr {..}   -> "lshr" <+> ppTyped operand0 `cma` pp operand1
+    And {..}    -> "and"  <+> ppTyped operand0 `cma` pp operand1
+    Or {..}     -> "or"   <+> ppTyped operand0 `cma` pp operand1
+    Xor {..}    -> "xor"  <+> ppTyped operand0 `cma` pp operand1
+    SDiv {..}   -> "sdiv"  <+> ppTyped operand0 `cma` pp operand1
+    UDiv {..}   -> "udiv"  <+> ppTyped operand0 `cma` pp operand1
+    SRem {..}   -> "srem"  <+> ppTyped operand0 `cma` pp operand1
+    URem {..}   -> "urem"  <+> ppTyped operand0 `cma` pp operand1
+
+    FAdd {..}   -> "fadd" <+> ppTyped operand0 `cma` pp operand1
+    FSub {..}   -> "fsub" <+> ppTyped operand0 `cma` pp operand1
+    FMul {..}   -> "fmul" <+> ppTyped operand0 `cma` pp operand1
+    FDiv {..}   -> "fdiv" <+> ppTyped operand0 `cma` pp operand1
+    FRem {..}   -> "frem" <+> ppTyped operand0 `cma` pp operand1
+    FCmp {..}   -> "fcmp" <+> pp fpPredicate <+> ppTyped operand0 `cma` pp operand1
+
+    Alloca {..} -> "alloca" <+> pp allocatedType <> num <> ppAlign alignment
+      where num   = case numElements of Nothing -> empty
+                                        Just o -> "," <+> ppTyped o
+    Store {..}  -> "store" <+> ppTyped value `cma` ppTyped address <> ppAlign alignment
+    Load {..}   -> "load" <+> pp argTy `cma` ppTyped address <> ppAlign alignment
+      where PointerType argTy _ = typeOf address
+    Phi {..}    -> "phi" <+> pp type' <+> commas (fmap phiIncoming incomingValues)
+
+    ICmp {..}   -> "icmp" <+> pp iPredicate <+> ppTyped operand0 `cma` pp operand1
+
+    c@Call {..} -> ppCall c
+    Select {..} -> "select" <+> commas [ppTyped condition', ppTyped trueValue, ppTyped falseValue]
+    SExt {..}   -> "sext" <+> ppTyped operand0 <+> "to" <+> pp type'
+    ZExt {..}   -> "zext" <+> ppTyped operand0 <+> "to" <+> pp type'
+    FPExt {..}   -> "fpext" <+> ppTyped operand0 <+> "to" <+> pp type'
+    Trunc {..}  -> "trunc" <+> ppTyped operand0 <+> "to" <+> pp type'
+    FPTrunc {..}  -> "fptrunc" <+> ppTyped operand0 <+> "to" <+> pp type'
+
+    GetElementPtr {..} -> "getelementptr" <+> bounds inBounds <+> commas (pp argTy : fmap ppTyped (address:indices))
+      where argTy = getElementType $ typeOf address
+    ExtractValue {..} -> "extractvalue" <+> commas (ppTyped aggregate : fmap pp indices')
+
+    BitCast {..} -> "bitcast" <+> ppTyped operand0 <+> "to" <+> pp type'
+    FPToUI {..} -> "fptoui" <+> ppTyped operand0 <+> "to" <+> pp type'
+    FPToSI {..} -> "fptosi" <+> ppTyped operand0 <+> "to" <+> pp type'
+    UIToFP {..} -> "uitofp" <+> ppTyped operand0 <+> "to" <+> pp type'
+    SIToFP {..} -> "sitofp" <+> ppTyped operand0 <+> "to" <+> pp type'
+    PtrToInt {..} -> "ptrtoint" <+> ppTyped operand0 <+> "to" <+> pp type'
+    IntToPtr {..} -> "inttoptr" <+> ppTyped operand0 <+> "to" <+> pp type'
+
+    InsertElement {..} -> "insertelement" <+> commas [ppTyped vector, ppTyped element, ppTyped index]
+    ShuffleVector {..} -> "shufflevector" <+> commas [ppTyped operand0, ppTyped operand1, ppTyped mask]
+    ExtractElement {..} -> "extractelement" <+> commas [ppTyped vector, ppTyped index]
+    InsertValue {..} -> "insertvalue" <+> commas (ppTyped aggregate : ppTyped element : fmap pp indices')
+
+    Fence {..} -> "fence" <+> pp atomicity
+    AtomicRMW {..} -> "atomicrmw" <+> ppVolatile volatile <+> pp rmwOperation <+> ppTyped address `cma` ppTyped value <+> pp atomicity
+    CmpXchg {..} -> "cmpxchg" <+> ppVolatile volatile <+> ppTyped address `cma` ppTyped expected `cma` ppTyped replacement
+      <+> pp atomicity <+> pp failureMemoryOrdering
+
+    AddrSpaceCast {..} -> "addrspacecast" <+> ppTyped operand0 <+> "to" <+> pp type'
+    VAArg {..} -> "va_arg" <+> ppTyped argList `cma` pp type'
+
+    LandingPad {..} ->
+      "landingpad" <+> pp type' <+> ppBool "cleanup" cleanup
+      <+> commas (fmap pp clauses)
+    CatchPad {..} -> "catchpad" <+> "within" <+> pp catchSwitch <+> brackets (commas (map ppTyped args))
+    CleanupPad {..} -> "cleanuppad" <+> "within" <+> pp parentPad <+> brackets (commas (map ppTyped args))
+
+    where
+      bounds True = "inbounds"
+      bounds False = empty
+
+instance PP CallableOperand where
+  pp (Left asm) = error "CallableOperand"
+  pp (Right op) = pp op
+
+instance PP LandingPadClause where
+  pp = \case
+    Catch c  -> "catch" <+> ppTyped c
+    Filter c -> "filter" <+> ppTyped c
+
+instance PP [Either GroupID FunctionAttribute] where
+  pp x = hsep $ fmap pp x
+
+instance PP (Either GroupID FunctionAttribute) where
+  pp (Left gid) = pp gid
+  pp (Right fattr) = pp fattr
+
+instance PP Operand where
+  pp (LocalReference _ nm) = local (pp nm)
+  pp (ConstantOperand con) = pp con
+  pp (MetadataOperand mdata) = pp mdata
+
+instance PP Metadata where
+  pp (MDString str) = "!" <> dquotes (text (decodeShortUtf8 str))
+  pp (MDNode node) = pp node
+  pp (MDValue operand) = pp operand
+
+instance PP MetadataNode where
+  pp (MetadataNode xs) = "!" <> braces (commas (fmap ppMetadata xs))
+  pp (MetadataNodeReference ref) = pp ref
+
+instance PP C.Constant where
+  pp (C.Int width val) = pp val
+  pp (C.Float (F.Double val))      =
+    if specialFP val
+      then "0x" <> (text . pack) (showHex (doubleToWord val) "")
+      else text $ pack $ printf "%6.6e" val
+  pp (C.Float (F.Single val))      =
+    if specialFP val
+      then "0x" <> (text . pack) (showHex (floatToWord val) "")
+      else text $ pack $ printf "%6.6e" val
+  pp (C.Float (F.Half val))        = text $ pack $ printf "%6.6e" val
+  pp (C.Float (F.Quadruple val _)) = text $ pack $ printf "%6.6e" val
+  pp (C.Float (F.X86_FP80 val _))  = text $ pack $ printf "%6.6e" val
+  pp (C.Float (F.PPC_FP128 val _)) = text $ pack $ printf "%6.6e" val
+
+  pp (C.GlobalReference ty nm) = "@" <> pp nm
+  pp (C.Vector args) = "<" <+> commas (fmap ppTyped args) <+> ">"
+
+  pp (C.Add {..})    = "add"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.Sub {..})    = "sub"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.Mul {..})    = "mul"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.Shl {..})    = "shl"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.AShr {..})   = "ashr" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.LShr {..})   = "lshr" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.And {..})    = "and"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.Or {..})     = "or"   <+> ppTyped operand0 `cma` pp operand1
+  pp (C.Xor {..})    = "xor"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.SDiv {..})   = "sdiv"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.UDiv {..})   = "udiv"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.SRem {..})   = "srem"  <+> ppTyped operand0 `cma` pp operand1
+  pp (C.URem {..})   = "urem"  <+> ppTyped operand0 `cma` pp operand1
+
+  pp (C.FAdd {..})   = "fadd" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.FSub {..})   = "fsub" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.FMul {..})   = "fmul" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.FDiv {..})   = "fdiv" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.FRem {..})   = "frem" <+> ppTyped operand0 `cma` pp operand1
+  pp (C.FCmp {..})   = "fcmp" <+> pp fpPredicate <+> ppTyped operand0 `cma` pp operand1
+  pp C.ICmp {..}     = "icmp" <+> pp iPredicate <+> ppTyped operand0 `cma` pp operand1
+
+  pp (C.Select {..})  = "select" <+> commas [ppTyped condition', ppTyped trueValue, ppTyped falseValue]
+  pp (C.SExt {..})    = "sext" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp (C.ZExt {..})    = "zext" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp (C.FPExt {..})   = "fpext" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp (C.Trunc {..})   = "trunc" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp (C.FPTrunc {..}) = "fptrunc" <+> ppTyped operand0 <+> "to" <+> pp type'
+
+  pp C.FPToUI {..} = "fptoui" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp C.FPToSI {..} = "fptosi" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp C.UIToFP {..} = "uitofp" <+> ppTyped operand0 <+> "to" <+> pp type'
+  pp C.SIToFP {..} = "sitofp" <+> ppTyped operand0 <+> "to" <+> pp type'
+
+  pp (C.Struct _ packed elems) =
+    let struct = spacedbraces $ commas $ fmap ppTyped elems
+    in if packed
+         then angleBrackets struct
+         else struct
+  pp (C.Null {}) = "zeroinitializer"
+  pp (C.Undef {}) = "undef"
+  pp (C.TokenNone {}) = "none"
+  pp (C.BlockAddress fn blk) = "blockaddress" <> parens (commas (fmap pp [fn, blk]))
+
+  pp C.Array {..}
+    | memberType == (IntegerType 8) = "c" <> (dquotes $ hcat [ppIntAsChar val | C.Int _ val <- memberValues])
+    | otherwise = brackets $ commas $ fmap ppTyped memberValues
+
+  pp C.GetElementPtr {..} = "getelementptr" <+> bounds inBounds <+> parens (commas (pp argTy : fmap ppTyped (address:indices)))
+    where
+      PointerType argTy _ = typeOf address
+      bounds True = "inbounds"
+      bounds False = empty
+
+  pp C.BitCast {..} = "bitcast" <+> parens (ppTyped operand0 <+> "to" <+> pp type')
+  pp C.PtrToInt {..} = "ptrtoint" <+> parens (ppTyped operand0 <+> "to" <+> pp type')
+  pp C.IntToPtr {..} = "inttoptr" <+> parens (ppTyped operand0 <+> "to" <+> pp type')
+  pp C.AddrSpaceCast {..} = "addrspacecast" <+> parens (ppTyped operand0 <+> "to" <+> pp type')
+
+instance PP a => PP (Named a) where
+  pp (nm := a) = "%" <> pp nm <+> "=" <+> pp a
+  pp (Do a) = pp a
+
+instance PP Module where
+  pp Module {..} =
+    let header = printf "; ModuleID = '%s'" (unShort moduleName) in
+    hlinecat (fromString header : (fmap pp moduleDefinitions))
+
+instance PP FP.FloatingPointPredicate where
+  pp op = case op of
+   FP.False -> "false"
+   FP.OEQ   -> "oeq"
+   FP.OGT   -> "ogt"
+   FP.OGE   -> "oge"
+   FP.OLT   -> "olt"
+   FP.OLE   -> "ole"
+   FP.ONE   -> "one"
+   FP.ORD   -> "ord"
+   FP.UEQ   -> "ueq"
+   FP.UGT   -> "ugt"
+   FP.UGE   -> "uge"
+   FP.ULT   -> "ult"
+   FP.ULE   -> "ule"
+   FP.UNE   -> "une"
+   FP.UNO   -> "uno"
+   FP.True  -> "true"
+
+instance PP IP.IntegerPredicate where
+  pp op = case op of
+   IP.EQ  -> "eq"
+   IP.NE  -> "ne"
+   IP.UGT -> "ugt"
+   IP.UGE -> "uge"
+   IP.ULT -> "ult"
+   IP.ULE -> "ule"
+   IP.SGT -> "sgt"
+   IP.SGE -> "sge"
+   IP.SLT -> "slt"
+   IP.SLE -> "sle"
+
+instance PP Atomicity where
+  pp (scope, order) =
+    pp scope <+> pp order
+
+instance PP SynchronizationScope where
+  pp = \case
+    SingleThread -> "syncscope(\"singlethreaded\")"
+    System -> mempty
+
+instance PP MemoryOrdering where
+  pp = \case
+    Unordered              -> "unordered"
+    Monotonic              -> "monotonic"
+    Acquire                -> "acquire"
+    Release                -> "release"
+    AcquireRelease         -> "acq_rel"
+    SequentiallyConsistent -> "seq_cst"
+
+instance PP RMW.RMWOperation where
+  pp = \case
+    RMW.Xchg -> "xchg"
+    RMW.Add -> "add"
+    RMW.Sub -> "sub"
+    RMW.And -> "and"
+    RMW.Nand -> "nand"
+    RMW.Or -> "or"
+    RMW.Xor -> "xor"
+    RMW.Max -> "max"
+    RMW.Min -> "min"
+    RMW.UMax -> "umax"
+    RMW.UMin -> "umin"
+
+-------------------------------------------------------------------------------
+-- Special Case Hacks
+-------------------------------------------------------------------------------
+
+escape :: Char -> Doc
+escape '"'  = "\\22"
+escape '\\' = "\\\\"
+escape c    = if isAscii c && not (isControl c)
+              then char c
+              else "\\" <> hex c
+    where
+        hex :: Char -> Doc
+        hex = pad0 . ($ []) . showHex . ord
+        pad0 :: String -> Doc
+        pad0 [] = "00"
+        pad0 [x] = "0" <> char x
+        pad0 xs = text (pack xs)
+
+ppVolatile :: Bool -> Doc
+ppVolatile True = "volatile"
+ppVolatile False = mempty
+
+ppIntAsChar :: Integral a => a -> Doc
+ppIntAsChar = escape . chr . fromIntegral
+
+ppAlign :: Word32 -> Doc
+ppAlign x | x == 0    = empty
+          | otherwise = ", align" <+> pp x
+
+-- print an operand and its type
+ppTyped :: (PP a, Typed a) => a -> Doc
+ppTyped a = pp (typeOf a) <+> pp a
+
+ppCommaTyped :: (PP a, Typed a) => a -> Doc
+ppCommaTyped a = pp (typeOf a) `cma` pp a
+
+phiIncoming :: (Operand, Name) -> Doc
+phiIncoming (op, nm) = brackets (pp op `cma` (local (pp nm)))
+
+ppParams :: (a -> Doc) -> ([a], Bool) -> Doc
+ppParams ppParam (ps, varrg) = parens . commas $ fmap ppParam ps ++ vargs
+    where
+        vargs = if varrg then ["..."] else []
+
+ppFunctionArgumentTypes :: Type -> Doc
+ppFunctionArgumentTypes FunctionType {..} = ppParams pp (argumentTypes, isVarArg)
+ppFunctionArgumentTypes _ = error "Non-function argument. (Malformed AST)"
+
+ppCall :: Instruction -> Doc
+ppCall Call { function = Right f,..}
+  = tail <+> "call" <+> pp callingConvention <+> pp returnAttributes <+> pp resultType <+> ftype
+    <+> pp f <> parens (commas $ fmap pp arguments) <+> pp functionAttributes
+    where
+      (functionType@FunctionType {..}) = referencedType (typeOf f)
+      ftype = if isVarArg
+              then ppFunctionArgumentTypes functionType
+              else empty
+      referencedType (PointerType t _) = referencedType t
+      referencedType t                 = t
+
+      tail = case tailCallKind of
+        Just Tail -> "tail"
+        Just MustTail -> "musttail"
+        Just NoTail -> "notail"
+        Nothing -> empty
+ppCall x = error "Non-callable argument. (Malformed AST)"
+
+-- Differs from Call in record name conventions only so needs a seperate almost
+-- identical function. :(
+ppInvoke :: Terminator -> Doc
+ppInvoke Invoke { function' = Right f,..}
+  = "invoke" <+> pp callingConvention' <+> pp resultType <+> ftype
+    <+> pp f <> parens (commas $ fmap pp arguments') <+> pp functionAttributes'
+    where
+      (functionType@FunctionType {..}) = referencedType (typeOf f)
+      ftype = if isVarArg
+              then ppFunctionArgumentTypes functionType
+              else empty
+      referencedType (PointerType t _) = referencedType t
+      referencedType t                 = t
+ppInvoke x = error "Non-callable argument. (Malformed AST)"
+
+ppSingleBlock :: BasicBlock -> Doc
+ppSingleBlock (BasicBlock nm instrs term) = (vcat $ (fmap pp instrs) ++ [pp term])
+
+ppllvm :: Module -> Text
+ppllvm = displayT . renderPretty 0.4 100 . pp
+
+ppll :: PP a => a -> Text
+ppll = displayT . renderPretty 0.4 100 . pp
+
+-- According to <https://stackoverflow.com/a/7002812/3877993> this is
+-- the best way to cast floats to words.
+
+cast :: (MArray (STUArray s) a (ST s),
+         MArray (STUArray s) b (ST s)) => a -> ST s b
+cast x = newArray (0 :: Int, 0) x >>= castSTUArray >>= flip readArray 0
+
+doubleToWord :: Double -> Word64
+doubleToWord x = runST (cast x)
+
+floatToWord :: Float -> Word32
+floatToWord x = runST (cast x)
+
+specialFP :: RealFloat a => a -> Bool
+specialFP f = isNaN f || f == 1 / 0 || f == - 1 / 0
diff --git a/src/LLVM/Token.hs b/src/LLVM/Token.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Token.hs
@@ -0,0 +1,3 @@
+module LLVM.Token where
+
+import Data.Text
diff --git a/src/LLVM/Typed.hs b/src/LLVM/Typed.hs
new file mode 100644
--- /dev/null
+++ b/src/LLVM/Typed.hs
@@ -0,0 +1,123 @@
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE FlexibleInstances #-}
+
+module LLVM.Typed (
+  Typed(..),
+  getElementType,
+) where
+
+import LLVM.AST
+import LLVM.AST.Global
+import LLVM.AST.Type
+
+import qualified LLVM.AST.Constant as C
+import qualified LLVM.AST.Float as F
+
+-----
+-- Reasoning about types
+-----
+
+class Typed a where
+    typeOf :: a -> Type
+
+instance Typed Operand where
+    typeOf (LocalReference t _) = t
+    typeOf (ConstantOperand c)  = typeOf c
+    typeOf _                    = MetadataType
+
+instance Typed CallableOperand where
+  typeOf (Right op) = typeOf op
+  typeOf (Left asm) = error "typeOf inline assembler is not defined. (Malformed AST)"
+
+instance Typed C.Constant where
+    typeOf (C.Int bits _)  = IntegerType bits
+    typeOf (C.Float float) = typeOf float
+    typeOf (C.Null t)      = t
+    typeOf (C.Struct {..}) = StructureType isPacked (map typeOf memberValues)
+    typeOf (C.Array {..})  = ArrayType (fromIntegral $ length memberValues) memberType
+    typeOf (C.Vector {..}) = VectorType (fromIntegral $ length memberValues) $
+                                case memberValues of
+                                    []    -> VoidType {- error "Vectors of size zero are not allowed" -}
+                                    (x:_) -> typeOf x
+    typeOf (C.Undef t)     = t
+    typeOf (C.BlockAddress {..})   = ptr i8
+    typeOf (C.GlobalReference t _) = t
+    typeOf (C.Add {..})     = typeOf operand0
+    typeOf (C.FAdd {..})    = typeOf operand0
+    typeOf (C.FDiv {..})    = typeOf operand0
+    typeOf (C.FRem {..})    = typeOf operand0
+    typeOf (C.Sub {..})     = typeOf operand0
+    typeOf (C.FSub {..})    = typeOf operand0
+    typeOf (C.Mul {..})     = typeOf operand0
+    typeOf (C.FMul {..})    = typeOf operand0
+    typeOf (C.UDiv {..})    = typeOf operand0
+    typeOf (C.SDiv {..})    = typeOf operand0
+    typeOf (C.URem {..})    = typeOf operand0
+    typeOf (C.SRem {..})    = typeOf operand0
+    typeOf (C.Shl {..})     = typeOf operand0
+    typeOf (C.LShr {..})    = typeOf operand0
+    typeOf (C.AShr {..})    = typeOf operand0
+    typeOf (C.And {..})     = typeOf operand0
+    typeOf (C.Or  {..})     = typeOf operand0
+    typeOf (C.Xor {..})     = typeOf operand0
+    typeOf (C.GetElementPtr {..}) = getElementPtrType (typeOf address) indices
+    typeOf (C.Trunc {..})   = type'
+    typeOf (C.ZExt {..})    = type'
+    typeOf (C.SExt {..})    = type'
+    typeOf (C.FPToUI {..})  = type'
+    typeOf (C.FPToSI {..})  = type'
+    typeOf (C.UIToFP {..})  = type'
+    typeOf (C.SIToFP {..})  = type'
+    typeOf (C.FPTrunc {..}) = type'
+    typeOf (C.FPExt {..})   = type'
+    typeOf (C.PtrToInt {..}) = type'
+    typeOf (C.IntToPtr {..}) = type'
+    typeOf (C.BitCast {..})  = type'
+    typeOf (C.ICmp {..})    = case (typeOf operand0) of
+                                (VectorType n _) -> VectorType n i1
+                                _ -> i1
+    typeOf (C.FCmp {..})    = case (typeOf operand0) of
+                                (VectorType n _) -> VectorType n i1
+                                _ -> i1
+    typeOf (C.Select {..})  = typeOf trueValue
+    typeOf (C.ExtractElement {..})  = case typeOf vector of
+                                        (VectorType _ t) -> t
+                                        _ -> VoidType {- error "The first operand of an ‘extractelement‘ instruction is a value of vector type." -}
+    typeOf (C.InsertElement {..})   = typeOf vector
+    typeOf (C.ShuffleVector {..})   = case (typeOf operand0, typeOf mask) of
+                                        (VectorType _ t, VectorType m _) -> VectorType m t
+                                        _ -> VoidType {- error -}
+    typeOf (C.ExtractValue {..})    = extractValueType (typeOf aggregate) indices
+    typeOf (C.InsertValue {..})     = typeOf aggregate
+    typeOf (C.TokenNone)          = TokenType
+    typeOf (C.AddrSpaceCast {..}) = type'
+
+getElementPtrType :: Type -> [C.Constant] -> Type
+getElementPtrType ty [] = ptr ty
+getElementPtrType (PointerType ty _) (_:is) = getElementPtrType ty is
+getElementPtrType (StructureType _ elTys) (C.Int 32 val:is) =
+  getElementPtrType (elTys !! fromIntegral val) is
+getElementPtrType (VectorType _ elTy) (_:is) = getElementPtrType elTy is
+getElementPtrType (ArrayType _ elTy) (_:is) = getElementPtrType elTy is
+
+getElementType :: Type -> Type
+getElementType (PointerType t _) = t
+getElementType t = error $ "this should be a pointer type" ++ show t
+
+extractValueType = error "extract"
+
+instance Typed F.SomeFloat where
+    typeOf (F.Half _)          = FloatingPointType HalfFP
+    typeOf (F.Single _)        = FloatingPointType FloatFP
+    typeOf (F.Double _)        = FloatingPointType DoubleFP
+    typeOf (F.Quadruple _ _)   = FloatingPointType FP128FP
+    typeOf (F.X86_FP80 _ _)    = FloatingPointType X86_FP80FP
+    typeOf (F.PPC_FP128 _ _)   = FloatingPointType PPC_FP128FP
+
+instance Typed Global where
+    typeOf (GlobalVariable {..}) = type'
+    typeOf (GlobalAlias {..})    = type'
+    typeOf (Function {..})       = let (params, isVarArg) = parameters
+                                   in FunctionType returnType (map typeOf params) isVarArg
+instance Typed Parameter where
+    typeOf (Parameter t _ _) = t
diff --git a/tests/Main.hs b/tests/Main.hs
new file mode 100644
--- /dev/null
+++ b/tests/Main.hs
@@ -0,0 +1,56 @@
+module Main where
+
+import LLVM.Context
+import LLVM.Pretty (ppllvm)
+import qualified LLVM.Module as M
+
+import Control.Monad (filterM)
+import Control.Monad.Except
+
+import Data.Functor
+import qualified Data.Text.Lazy as T
+import qualified Data.Text.Lazy.IO as T
+import Text.Show.Pretty (ppShow)
+
+import System.IO
+import System.Exit
+import System.Directory
+import System.FilePath
+import System.Environment
+
+import Test.Tasty
+import Test.Tasty.HUnit
+
+-------------------------------------------------------------------------------
+-- Harness
+-------------------------------------------------------------------------------
+
+llvmFile :: FilePath -> IO Bool
+llvmFile fname = do
+  str <- readFile fname
+  withContext $ \ctx -> do
+    res <- M.withModuleFromLLVMAssembly ctx str $ \mod -> do
+      ast <- M.moduleAST mod
+      let str = ppllvm ast
+      T.writeFile ("tests/output" </> takeFileName fname) str
+      trip <- M.withModuleFromLLVMAssembly ctx (T.unpack str) (const $ return ())
+      {-T.putStrLn str-}
+      pure ()
+    return True
+
+makeTest :: FilePath -> TestTree
+makeTest fname = testCase fname $ assert  (llvmFile fname)
+
+testPath :: FilePath
+testPath = "tests/input/"
+
+suite :: IO TestTree
+suite = do
+  dirFiles <- listDirectory testPath
+  let testFiles = fmap (\x -> testPath </> x) dirFiles
+  pure $ testGroup "Test Suite" [
+    testGroup "Roundtrip Tests" $ fmap makeTest testFiles
+    ]
+
+main :: IO ()
+main = defaultMain =<< suite