diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,20 @@
+# Revision history for llvm-pretty-bc-parser
+
+## 0.4.1.0 (January 2024)
+
+* Add preliminary support for LLVM versions up through 16.
+* Require building with `llvm-pretty-0.12.*`.
+* Add preliminary support for parsing opaque pointers. For now,
+  `llvm-pretty-bc-parser` will still fill in the types of certain instructions
+  with non-opaque pointer types (e.g., the type of memory to store in a `store`
+  instruction), so be wary of this if you are parsing a bitcode file that
+  contains opaque pointers. See also the discussion in
+  https://github.com/GaloisInc/llvm-pretty-bc-parser/issues/262.
+* Improve the runtime performance of the parser.
+* A variety of bugfixes. Some notable fixes include:
+  * Fix a bug in which the parser would fail to parse `DIDerivedType` nodes
+    produced by Apple Clang on macOS.
+  * Fix a bug in which the DWARF address space field of a `DIDerivedType` node
+    was parsed incorrectly.
+  * Fix a bug in which constant `fcmp`/`icmp` expressions would parse their
+    operands incorrectly.
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,70 @@
+# llvm-pretty-bc-parser
+
+A parser for the LLVM bitcode file format, yielding a `Module` from
+[the llvm-pretty package](http://hackage.haskell.org/package/llvm-pretty).
+
+## Compatibility
+
+The following table shows what kinds of tests have been/are being run with which
+compilers.
+
+ - A check in the the randomized tests column indicates that such tests are
+   regularly run [in Github Actions][fuzz-workflow].
+ - A check in the manual tests column indicates that the parser seems to work on
+   some code that was generated by this compiler.
+
+| Compiler  | Version | [Randomized tests](./fuzzing) | Manual tests | Notes                |
+|-----------|---------|-------------------------------|--------------|----------------------|
+| `clang`   | v3.4    | ✓                             |              |                      |
+|           | v3.5    | ✓                             |              |                      |
+|           | v3.6    | ✓                             |              |                      |
+|           | v3.7    | ✓                             |              |                      |
+|           | v3.8    | ✓                             | ✓            |                      |
+|           | v3.9    | ✓                             |              |                      |
+|           | v4.0    | ✓                             |              |                      |
+|           | v5.0    | ✓                             |              |                      |
+|           | v6.0    | ✓                             | ✓            |                      |
+|           | v7.0    | ✓                             |              |                      |
+|           | v8.0    | ✓                             |              |                      |
+|           | v9.0    | ✓                             |              |                      |
+|           | v10.0   | ✓                             |              |                      |
+|           | v11.0   | ✓                             |              |                      |
+|           | v12.0   | ✓                             |              |                      |
+|           | v13.0   | ✓                             |              | See [issues][llvm13] |
+|           | v14.0   | ✓                             |              | See [issues][llvm14] |
+|           | v15.0   | ✓                             |              | See [issues][llvm15] |
+|           | v16.0   | ✓                             |              | See [issues][llvm16] |
+| `clang++` | v3.4    |                               |              |                      |
+|           | v3.5    |                               |              |                      |
+|           | v3.6    |                               |              |                      |
+|           | v3.7    |                               |              |                      |
+|           | v3.8    |                               |              |                      |
+|           | v3.9    |                               |              |                      |
+|           | v4.0    |                               |              |                      |
+|           | v5.0    |                               |              |                      |
+|           | v6.0    |                               |              |                      |
+|           | v7.0    |                               | ✓            |                      |
+|           | v8.0    |                               |              |                      |
+
+If you encounter problems with the output of *any* compiler, please file [an
+issue](https://github.com/GaloisInc/llvm-pretty-bc-parser/issues).
+
+## Documentation
+
+Developers' documentation: [doc/developing.md](./doc/developing.md)
+
+## GHC Support
+
+llvm-pretty-bc-parser endeavors to support three versions of GHC at a time. See
+the developers' documentation for more details and a rationale:
+[doc/developing.md](./doc/developing.md). Currently supported:
+
+- GHC 9.2.8
+- GHC 9.4.5
+- GHC 9.6.2
+
+[fuzz-workflow]: https://github.com/GaloisInc/llvm-pretty-bc-parser/blob/master/.github/workflows/llvm-quick-fuzz.yml
+[llvm13]: https://github.com/GaloisInc/llvm-pretty-bc-parser/issues?q=is%3Aopen+is%3Aissue+label%3Allvm%2F13.0
+[llvm14]: https://github.com/GaloisInc/llvm-pretty-bc-parser/issues?q=is%3Aopen+is%3Aissue+label%3Allvm%2F14.0
+[llvm15]: https://github.com/GaloisInc/llvm-pretty-bc-parser/issues?q=is%3Aopen+is%3Aissue+label%3Allvm%2F15.0
+[llvm16]: https://github.com/GaloisInc/llvm-pretty-bc-parser/issues?q=is%3Aopen+is%3Aissue+label%3Allvm%2F16.0
diff --git a/disasm-test/Main.hs b/disasm-test/Main.hs
--- a/disasm-test/Main.hs
+++ b/disasm-test/Main.hs
@@ -1,173 +1,805 @@
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
 
 module Main where
 
-import Data.LLVM.BitCode (parseBitCodeLazyFromFile,Error(..),formatError)
-import Text.LLVM.AST (Module)
-import Text.LLVM.PP (ppLLVM,ppModule)
+import           Data.LLVM.BitCode (parseBitCodeLazyFromFile,Error(..),formatError)
+import qualified Text.LLVM.AST as AST
+import           Text.LLVM.PP ( ppLLVM, ppLLVM35, ppLLVM36, ppLLVM37, ppLLVM38, llvmPP )
 
-import Control.Monad (when)
-import Data.Char (ord,isSpace,chr)
-import Data.Monoid ( mconcat, Endo(..) )
-import Data.Typeable (Typeable)
-import System.Console.GetOpt
-           ( ArgOrder(..), ArgDescr(..), OptDescr(..), getOpt, usageInfo )
-import System.Directory (getTemporaryDirectory,removeFile)
-import System.Environment (getArgs,getProgName)
-import System.Exit (exitFailure,exitSuccess,ExitCode(..))
-import System.FilePath ((<.>),dropExtension,takeFileName)
-import System.IO
-    (openBinaryTempFile,hClose,openTempFile,hPrint)
-import System.Process
-    (proc,createProcess,waitForProcess,cmdspec,CmdSpec(..),CreateProcess())
-import qualified Control.Exception as X
+import qualified Control.Exception as EX
+import           Control.Lens ( (^?), _Right )
+import           Control.Monad ( foldM, unless, when )
+import qualified Control.Monad.Catch as X
+import           Control.Monad.IO.Class ( MonadIO, liftIO )
+import           Control.Monad.Trans.State
+import           Data.Bifunctor (first)
 import qualified Data.ByteString.Lazy as L
+import           Data.Char (ord,isLetter,isSpace,chr)
+import           Data.Generics (everywhere, mkT) -- SYB
+import           Data.List ( find, isInfixOf, isPrefixOf, isSuffixOf, nub, sort )
+import           Data.Map ( (!), (!?) )
+import qualified Data.Map as Map
+import           Data.Maybe ( fromMaybe )
+import           Data.Proxy ( Proxy(..) )
+import           Data.String.Interpolate
+import qualified Data.Text as T
+import           Data.Typeable (Typeable)
+import           Data.Versions (Versioning, versioning, prettyV, major, minor)
+import qualified GHC.IO.Exception as GE
+import qualified Options.Applicative as OA
+import qualified Prettyprinter as PP
+import qualified Prettyprinter.Util as PPU
+import qualified System.Console.Terminal.Size as Term
+import           System.Directory ( doesFileExist, getTemporaryDirectory
+                                  , listDirectory
+                                  , removeFile )
+import           System.Exit (ExitCode(..), exitFailure, exitSuccess)
+import           System.FilePath ( (</>), (<.>) )
+import           System.IO (openBinaryTempFile,hClose,openTempFile,hPutStrLn)
+import qualified System.IO as IO (stderr)
+import qualified System.Process as Proc
+import           Test.Tasty
+import           Test.Tasty.ExpectedFailure ( ignoreTestBecause
+                                            , expectFailBecause )
+import           Test.Tasty.HUnit ( assertFailure, testCase )
+import qualified Test.Tasty.Options as TO
+import qualified Test.Tasty.Runners as TR
+import qualified Test.Tasty.Sugar as TS
+import           Text.Read (readMaybe)
+import           Text.Show.Pretty (ppShow)
 
 
+descr :: PP.Doc ann
+descr = PP.vcat $
+  let block = PPU.reflow in
+  [ block [iii|
+ This test verifies that the llvm-pretty-bc-parser is capable of
+ parsing bitcode properly.  This is done by two sets of operations:
+ one which uses the llvm-as assembler to generate bitcode from .ll files
+ (text assembly in LLVM format), and one which uses the clang compiler to
+ generate bitcode from C files; this library should be able to parse both
+ types of generated bitcode files.
+      |]
+  , ""
+  , block [iii|
+ The assembler test method starts with a known .ll file (LLVM text assembly
+ format) and assembles it to LLVM bitcode (via llvm-as from the LLVM tool
+ suite). Then the test will use both llvm-dis (from the LLVM tool suite)
+ and llvm-disasm (from this package, via direct library calls) to convert
+ that bitcode back into the .ll text format, and also (for the latter) into
+ an AST representation.  [NOTE: C sources should be kept minimal to be focused
+ in particular; if too large there are too many opportunities for unrelated
+ issues to interfere in successful evaluation.]
+       |]
+  , ""
+  , block [iii|
+ The compiler test method starts with a known .c or .cpp file and uses clang to directly
+ generate a bitcode file.  The test then proceeds just as with the assembler
+ test.  The only difference therefore is the starting file and first command
+ used on that file, but the compiler method will usually generate more variance
+ in the bitcode files as the compiler version changes.
+       |]
+  , ""
+  , "          +-------------[2nd cycle]------------+"
+  , "          |                                    |"
+  , "          v                                    |"
+  , " .ll --[llvm-as]--> .bc ---[llvm-dis]--> .ll   |"
+  , "                     ^   `-[llvm-disasm]---> .ll"
+  , "                     |                   `-> .AST"
+  , " .c/.cpp --[clang]---+                         |"
+  , "                     |                        [show]"
+  , " .bc -[pre-existing]-+                         |"
+  , "                                               v"
+  , "      [compare first and second of these:]   .txt"
+  , ""
+  , block [iii|
+ The differences between the two .ll text formats
+ are displayed for user information, but differences do not constitute a
+ test failure.  The .ll text file obtained from llvm-disasm is then
+ *re-assembled* into another bitcode file, which is again converted back to
+ both .ll and AST formats (repeating the above actions, thus any
+ differences in the .ll files may be displayed twice.  Finally, the two
+ AST's are serialized to text and the resulting text is compared for
+ differences.  The tests will fail if any of the conversion steps fail, or
+ if there are differences between the first round-trip .ll file and the
+ second round-trip .ll file produced by llvm-pretty-bc-parser.
+       |]
+  , ""
+  , PP.indent 2 $ PP.hang 2 $ block
+    [iii|* If opaque pointers are present, *all* pointers are
+           converted to opaque pointers.  This is because the LLVM
+           tools are stricter about opaque pointers, whereas this
+           package is more permissive. Opaque pointers are
+           the standard in LLVM 15.
+      |]
+  , ""
+  , PP.indent 2 $ PP.hang 2 $ block
+    [iii|* Metadata information between the two AST text formats is *not*
+           compared (and is actually discarded before serialization, resetting
+           all indices to zero).  This is because metadata indexes are
+           dynamically generated and therefore unstable.
+        |]
+  , ""
+  , PP.indent 2 $ PP.hang 2 $ block
+    [iii|* If the --roundtrip-disabled option is specified on the command line,
+           then only one assembly-disassembly will be performed and
+           the results will not be compared to anything (although any
+           llvm-dis/llvm-disasm differences will still be shown).
+           This mode ensures that the llvm-disasm will not fail, but
+           it does not validate the results.
+        |]
+  ]
+
 -- Option Parsing --------------------------------------------------------------
 
-data Options = Options { optTests   :: [FilePath] -- ^ Tests
-                       , optLlvmAs  :: String     -- ^ llvm-as  name
-                       , optLlvmDis :: String     -- ^ llvm-dis name
-                       , optHelp    :: Bool
-                       } deriving (Show)
+newtype LLVMAs = LLVMAs FilePath
 
-defaultOptions :: Options
-defaultOptions  = Options { optTests   = []
-                          , optLlvmAs  = "llvm-as"
-                          , optLlvmDis = "llvm-dis"
-                          , optHelp    = False
-                          }
+defaultLLVMAs :: LLVMAs
+defaultLLVMAs = LLVMAs "llvm-as"
 
-options :: [OptDescr (Endo Options)]
-options  =
-  [ Option "" ["with-llvm-as"] (ReqArg setLlvmAs "FILEPATH")
-    "path to llvm-as"
-  , Option "" ["with-llvm-dis"] (ReqArg setLlvmDis "FILEPATH")
-    "path to llvm-dis"
-  , Option "h" ["help"] (NoArg setHelp)
-    "display this message"
-  ]
+instance TO.IsOption LLVMAs where
+  defaultValue = defaultLLVMAs
+  parseValue = Just . LLVMAs
+  optionName = pure "with-llvm-as"
+  optionHelp = pure "path to llvm-as"
+  showDefaultValue (LLVMAs as) = Just as
+  optionCLParser = TO.mkOptionCLParser $
+    OA.metavar "FILEPATH"
 
-setLlvmAs :: String -> Endo Options
-setLlvmAs str = Endo (\opt -> opt { optLlvmAs = str })
+newtype LLVMDis = LLVMDis FilePath
 
-setLlvmDis :: String -> Endo Options
-setLlvmDis str = Endo (\opt -> opt { optLlvmDis = str })
+instance TO.IsOption LLVMDis where
+  defaultValue = LLVMDis "llvm-dis"
+  parseValue = Just . LLVMDis
+  optionName = pure "with-llvm-dis"
+  optionHelp = pure "path to llvm-dis"
+  showDefaultValue (LLVMDis dis) = Just dis
+  optionCLParser = TO.mkOptionCLParser $
+    OA.metavar "FILEPATH"
 
-setHelp :: Endo Options
-setHelp  = Endo (\opt -> opt { optHelp = True })
+newtype Clang = Clang FilePath
 
-addTest :: String -> Endo Options
-addTest test = Endo (\opt -> opt { optTests = test : optTests opt })
+instance TO.IsOption Clang where
+  defaultValue = Clang "clang"
+  parseValue = Just . Clang
+  optionName = pure "with-clang"
+  optionHelp = pure "path to clang"
+  showDefaultValue (Clang dis) = Just dis
+  optionCLParser = TO.mkOptionCLParser $
+    OA.metavar "FILEPATH"
 
-getOptions :: IO Options
-getOptions  =
-  do args <- getArgs
-     case getOpt (ReturnInOrder addTest) options args of
+newtype Roundtrip = Roundtrip Bool
 
-       (fs,[],[]) -> do let opts = appEndo (mconcat fs) defaultOptions
+instance TO.IsOption Roundtrip where
+  defaultValue = Roundtrip True
+  parseValue = fmap Roundtrip . TO.safeReadBool
+  optionName = pure "roundtrip-disabled"
+  optionHelp = pure "disable roundtrip tests (AST/AST diff)"
+  showDefaultValue (Roundtrip r) = Just $ show r
+  optionCLParser = TO.mkOptionCLParser $
+    OA.short 'r'
 
-                        when (optHelp opts) $ do printUsage []
-                                                 exitSuccess
+newtype Keep = Keep Bool
 
-                        return opts
+instance TO.IsOption Keep where
+  defaultValue = Keep False
+  parseValue = fmap Keep . TO.safeReadBool
+  optionName = pure "keep"
+  optionHelp = pure "keep all generated files for manual inspection"
+  showDefaultValue (Keep k) = Just $ show k
+  optionCLParser = TO.mkOptionCLParser $
+    OA.short 'k'
 
-       (_,_,errs) -> do printUsage errs
-                        exitFailure
+newtype Details = Details Bool
 
-printUsage :: [String] -> IO ()
-printUsage errs =
-  do prog <- getProgName
-     let banner = "Usage: " ++ prog ++ " [OPTIONS] test1.ll .. testn.ll"
-     putStrLn (usageInfo (unlines (errs ++ [banner])) options)
+instance TO.IsOption Details where
+  defaultValue = Details False
+  parseValue = fmap Details . TO.safeReadBool
+  optionName = pure "details"
+  optionHelp = pure "show details of each individual test execution (for debug)"
+  showDefaultValue (Details d) = Just $ show d
+  optionCLParser = TO.mkOptionCLParser $
+    OA.short 'd'
 
+disasmTestIngredients :: VersionCheck -> [TR.Ingredient]
+disasmTestIngredients llvmver =
+  includingOptions [ TO.Option (Proxy @LLVMAs)
+                   , TO.Option (Proxy @LLVMDis)
+                   , TO.Option (Proxy @Clang)
+                   , TO.Option (Proxy @Roundtrip)
+                   , TO.Option (Proxy @Keep)
+                   , TO.Option (Proxy @Details)
+                   ] :
+  TS.sugarIngredients [ assemblyCube llvmver
+                      , cCompilerCube llvmver
+                      , ccCompilerCube llvmver ]
+  <> defaultIngredients
 
+parseCmdLine :: IO TO.OptionSet
+parseCmdLine = do
+  TR.installSignalHandlers
+  llvmver <- getLLVMAsVersion defaultLLVMAs
+  let disasmOptDescrs = TO.uniqueOptionDescriptions $
+        TR.coreOptions ++
+        TS.sugarOptions ++
+        TR.ingredientsOptions (disasmTestIngredients llvmver)
+      (disasmOptWarns, disasmOptParser) = TR.optionParser disasmOptDescrs
+  mapM_ (hPutStrLn IO.stderr) disasmOptWarns
+  ts <- maybe 80 Term.width <$> Term.size
+  let pr = OA.prefs $ OA.columns ts
+  OA.customExecParser pr $
+    OA.info (OA.helper <*> disasmOptParser)
+    ( OA.fullDesc
+      <> OA.header "llvm-pretty-bc-parser disassembly test suite"
+      <> OA.footerDoc (Just $ PP.align descr)
+    )
+
+
+-- Querying Tool Versions ------------------------------------------------------
+
+-- | Captures the name of the tool and either the error when attempting to get
+-- the tool version or the actual parsed version self-reported by the tool.  Lack
+-- of a decipherable version is not fatal to running the tests.
+data VersionCheck = VC String (Either T.Text Versioning)
+
+showVC :: VersionCheck -> String
+showVC (VC nm v) = nm <> " " <> (T.unpack $ either id prettyV v)
+
+vcVersioning :: VersionCheck -> Either T.Text Versioning
+vcVersioning (VC _ v) = v
+
+mkVC :: String -> String -> VersionCheck
+mkVC nm raw = let r = T.pack raw in VC nm $ first (const r) $ versioning r
+
+getLLVMAsVersion :: LLVMAs -> IO VersionCheck
+getLLVMAsVersion (LLVMAs llvmAsPath) = getLLVMToolVersion "llvm-as" llvmAsPath
+
+getLLVMDisVersion :: LLVMDis -> IO VersionCheck
+getLLVMDisVersion (LLVMDis llvmDisPath) = getLLVMToolVersion "llvm-dis" llvmDisPath
+
+getClangVersion :: Clang -> IO VersionCheck
+getClangVersion (Clang clangPath) = getLLVMToolVersion "clang" clangPath
+
+-- Determine which version of an LLVM tool will be used for these tests (if
+-- possible).  Uses partial 'head' but this is just tests, and failure is
+-- captured.
+getLLVMToolVersion :: String -> FilePath -> IO VersionCheck
+getLLVMToolVersion toolName toolPath = do
+  let isVerLine l = isInfixOf "LLVM version" l || isInfixOf "clang version" l
+      dropLetter = dropWhile (all isLetter)
+      getVer (Right inp) =
+        -- example inp: "LLVM version 10.0.1" or "clang version 11.1.0"
+        case filter isVerLine $ lines inp of
+          [] -> "NO VERSION IDENTIFIED FOR " <> toolName
+          (l:_) -> case dropLetter $ words l of
+            [] -> toolName <> " VERSION NOT PARSED: " <> l
+            (v:_) -> fst $ break (== '-') v -- remove vendor suffix (e.g. 12.0.1-19ubuntu3)
+      getVer (Left full) = full
+  mkVC toolName . getVer <$> readProcessVersion toolPath
+
+-- Runs the tool with a --version argument to have it self-report its version.
+-- The tool may not even be installed.  Returns either an error string or the
+-- output string from the tool.
+readProcessVersion :: String -> IO (Either String String)
+readProcessVersion forTool =
+  X.catches (Right <$> Proc.readProcess forTool [ "--version" ] "")
+  [ X.Handler $ \(e :: EX.IOException) ->
+      if GE.ioe_type e == GE.NoSuchThing
+      then return $ Left "[missing]" -- tool executable not found
+      else do putStrLn $ "Warning: IO error attempting to determine " <> forTool <> " version:"
+              putStrLn $ show e
+              return $ Left "unknown"
+  , X.Handler $ \(e :: X.SomeException) -> do
+      putStrLn $ "Warning: error attempting to determine " <> forTool <> " version:"
+      putStrLn $ show e
+      return $ Left "??"
+  ]
+
 -- Test Running ----------------------------------------------------------------
 
 -- | Run all provided tests.
 main :: IO ()
-main  = do
-  opts <- getOptions
-  mapM_ (runTest opts) (optTests opts)
+main =  do
+  -- This is a bit more involved than a typical tasty `main` function. The
+  -- problem is that the number of tests that we generate (via
+  -- `withSugarGroups`) depends on the version of the --llvm-as argument,
+  -- which must be checked in IO. Unfortunately, a typical
+  -- `defaultMainWithIngredients` invocation doesn't allow you to
+  -- generate a dynamic number of tests in IO based on argument values. As a
+  -- result, we have to resort to using more of tasty's internals here.
+  disasmOpts <- parseCmdLine
 
+  let llvmAs'  = TO.lookupOption disasmOpts
+      llvmDis' = TO.lookupOption disasmOpts
+      clang'   = TO.lookupOption disasmOpts
+
+  llvmAsVC <- getLLVMAsVersion llvmAs'
+  llvmDisVC <- getLLVMDisVersion llvmDis'
+  clangVC <- getClangVersion clang'
+  unless (and [ vcVersioning llvmAsVC == vcVersioning llvmDisVC
+              , vcVersioning llvmAsVC == vcVersioning clangVC
+              ]) $
+    error $ unlines
+      [ "Unexpected version mismatch between clang, llvm-as and llvm-dis"
+      , "* llvm-as  version: " ++ showVC llvmAsVC
+      , "* llvm-dis version: " ++ showVC llvmDisVC
+      , "* clang    version: " ++ showVC clangVC
+      ]
+
+  knownBugs <- getKnownBugs
+  sweets1 <- TS.findSugar $ assemblyCube llvmAsVC
+  sweets2 <- TS.findSugar $ cCompilerCube llvmAsVC
+  sweets3 <- TS.findSugar $ ccCompilerCube llvmAsVC
+  sweets4 <- TS.findSugar $ bitcodeCube llvmAsVC
+  atests <- TS.withSugarGroups sweets1 testGroup
+            $ \s _ e -> runAssemblyTest llvmAsVC knownBugs s e
+  ctests <- TS.withSugarGroups sweets2 testGroup
+            $ \s _ e -> runCompileTest llvmAsVC knownBugs s e
+  cctests <- TS.withSugarGroups sweets3 testGroup
+             $ \s _ e -> runCompileTest llvmAsVC knownBugs s e
+  bctests <- TS.withSugarGroups sweets4 testGroup
+             $ \s _ e -> runRawBCTest llvmAsVC knownBugs s e
+  let tests = atests <> ctests
+  case TR.tryIngredients
+         (disasmTestIngredients llvmAsVC)
+         disasmOpts
+         (testGroup "Disassembly tests"
+          [ testGroup ("llvm-as " <> showVC llvmAsVC) atests
+          , testGroup ("C " <> showVC clangVC) ctests
+          , testGroup ("C++ " <> showVC clangVC) cctests
+          , testGroup ("rawBC " <> showVC llvmAsVC) bctests
+          ]) of
+    Nothing ->
+      hPutStrLn IO.stderr
+        "No ingredients agreed to run. Something is wrong either with your ingredient set or the options."
+    Just act -> do
+      ok <- act
+      if ok then exitSuccess else exitFailure
+
+  defaultMainWithIngredients (disasmTestIngredients llvmAsVC) $
+    testGroup "Disassembly tests" tests
+
+----------------------------------------------------------------------
+-- Assembly/disassembly tests
+
+assemblyCube :: VersionCheck -> TS.CUBE
+assemblyCube llvmver = TS.mkCUBE
+  { TS.inputDirs = ["disasm-test/tests"]
+  , TS.rootName = "*.ll"
+  , TS.separators = "."
+  , TS.validParams = [ ("llvm-range", Just [ "recent-llvm"
+                                           , "pre-llvm12"
+                                           , "pre-llvm13"
+                                           , "pre-llvm14"
+                                           , "pre-llvm15"
+                                           ])
+                     ]
+    -- Somewhat unusually for tasty-sugar, we make the expectedSuffix the same
+    -- as the rootName suffix. This is because we are comparing the contents of
+    -- each .ll file against *itself* after parsing it with
+    -- llvm-pretty-bc-parser, pretty-printing it with llvm-pretty, and
+    -- then normalizing it. As such, each .ll file acts as its own golden file.
+  , TS.expectedSuffix = "ll"
+  , TS.sweetAdjuster = \cb ->
+      -- In addition to range matching, this is a round-trip test (assemble +
+      -- disassemble) where the rootname is the same as the expected name.
+      -- Filter out any expectations that don't match the root name.
+      -- (e.g. remove: root=poison.ll with exp=poison.pre-llvm12.ll).
+      let rootExpSame s e = TS.rootFile s == TS.expectedFile e
+          addExpFilter s = s { TS.expected = filter (rootExpSame s) $ TS.expected s }
+      in fmap (fmap addExpFilter) . rangeMatch llvmver cb
+  }
+
+
+rangeMatch :: MonadIO m => VersionCheck -> TS.CUBE -> [TS.Sweets] -> m [TS.Sweets]
+rangeMatch llvmver cb swts = do
+  -- Perform ranged-matching of the llvm-range parameter against the version of
+  -- llvm (reported by llvm-as) to filter the tasty-sugar expectations.  Note
+  -- that there is a built-in expectation here that there is only one llvm
+  -- version available to the test.
+  TS.rangedParamAdjuster "llvm-range"
+    (readMaybe . drop (length ("pre-llvm" :: String)))
+    (<)
+    (vcVersioning llvmver ^? (_Right . major))
+    cb swts
+
+
+-- | Returns true if this particular test should be skipped, which is signalled
+-- by the expected file contents starting with "SKIP_TEST".  For test cases that
+-- require a minimum LLVM version, this technique is used to prevent running the
+-- test on older LLVM versions.
+skipTest :: TS.Expectation -> IO Bool
+skipTest expct =
+  ("SKIP_TEST" `L.isPrefixOf`) <$> L.readFile (TS.expectedFile expct)
+
+
+-- | Attempt to compare the assembly generated by llvm-pretty and llvm-dis.
+runAssemblyTest :: VersionCheck -> KnownBugs -> TS.Sweets -> TS.Expectation
+                -> IO [TestTree]
+runAssemblyTest llvmVersion knownBugs sweet expct
+  = do shouldSkip <- skipTest expct
+       let tmod = if shouldSkip
+                  then ignoreTestBecause "not valid for this LLVM version"
+                  else case isKnownBug knownBugs sweet expct llvmVersion of
+                         Just (from, why) ->
+                           expectFailBecause $ why <> " [see " <> from <> "]"
+                         Nothing -> id
+       let pfx = TS.rootBaseName sweet
+       return $ (:[]) $ tmod
+         $ testCaseM llvmVersion pfx
+         $ with2Files (processLL pfx $ TS.rootFile sweet)
+         $ \(parsed1, ast) ->
+             case ast of
+               Nothing   -> return ()
+               Just ast1 ->
+                 -- Re-assemble and re-disassemble
+                 with2Files (processLL pfx parsed1)
+                 $ \(_, mb'ast2) ->
+                     case mb'ast2 of
+                       Just ast2 -> diffCmp ast1 ast2 -- Ensure that the ASTs match
+
+                                    -- Ensure that the disassembled files match.
+                                    -- This is usually too strict (and doesn't
+                                    -- really provide more info).  We normalize
+                                    -- the AST (see below) to ensure that the
+                                    -- ASTs match modulo metadata numbering, but
+                                    -- the equivalent isn't possible for the
+                                    -- assembly: we need llvm-as to be able to
+                                    -- re-assemble it.
+                                    --
+                                    -- diffCmp parsed1 parsed2
+                       Nothing -> error "Failed processLL"
+
+
+diffCmp :: FilePath -> FilePath -> TestM ()
+diffCmp file1 file2 = do
+  let assertF = liftIO . assertFailure . unlines
+  (code, stdout, stderr) <- liftIO $
+    Proc.readCreateProcessWithExitCode (Proc.proc "diff" ["-u", file1, file2]) ""
+  case code of
+    ExitFailure _ -> assertF ["diff failed", stdout, stderr]
+    ExitSuccess   ->
+      if stdout /= "" || stderr /= ""
+      then assertF ["non-empty diff", stdout, stderr]
+      else do Details det <- gets showDetails
+              when det $ liftIO
+                $ mapM_ putStrLn ["success: empty diff: ", file1, file2]
+
+
+-- Assembles the specified .ll file to bitcode, then disassembles it with
+-- llvm-dis.  Also parses the bitcode with this library (effectively llvm-disasm)
+-- and prints the difference between the parsed version and the .ll file.
+-- Returns the library parsed version and the serialized AST from the library.
+
+processLL :: FilePath -> FilePath -> TestM (FilePath, Maybe FilePath)
+processLL pfx f = do
+  Details det <- gets showDetails
+  when det $ liftIO $ putStrLn (showString f ": ")
+  X.handle logError
+    $ withFile (assembleToBitCode pfx f)
+    $ parseBC pfx
+  where
+    logError (ParseError msg) =
+      liftIO $ assertFailure $ unlines
+      $ "failure" : map ("; " ++) (lines (formatError msg))
+
+parseBC :: FilePath -> FilePath -> TestM (FilePath, Maybe FilePath)
+parseBC pfx bc = do
+  withFile (X.handle
+            (\(_ :: GE.IOException) -> return "LLVM llvm-dis failed to parse this file")
+            (disasmBitCode pfx bc))
+    $ \ norm -> do
+    (parsed, ast) <- processBitCode pfx bc
+    Details dets <- gets showDetails
+    when dets $ liftIO $ do
+      -- Informationally display if there are differences between the llvm-dis
+      -- and llvm-disasm outputs, but no error if they differ.  Note that the
+      -- arguments to this diff are not the same as those supplied to the diffCmp
+      -- function. The diff here is intended to supply additional information to
+      -- the user for diagnostics, and whitespace changes are likely unimportant
+      -- in that context; this diff does not determine the pass/fail status of
+      -- the testing.  On the other hand, the diffCmp *does* determine if the
+      -- tests pass or fail, so ignoring whitespace in that determination would
+      -- potentially weaken the testing to an unsatisfactory degree and would
+      -- need more careful evaluation.
+      putStrLn "## Output differences: LLVM's llvm-dis <--> this llvm-disasm"
+      ignore (Proc.callProcess "diff" ["-u", "-b", "-B", "-w", norm, parsed])
+      putStrLn ("successfully parsed " ++ show pfx ++ " bitcode")
+    return (parsed, ast)
+
+----------------------------------------------------------------------
+-- Compiler->Assembly->Disassembly tests
+
+-- The compilation tests ensure that the clang version-specific generated .bc
+-- file can be reasonably parsed by this library.  This is a parallel to the
+-- assemblyCube-driven tests, but starts with a C source file.  One distinction
+-- is that the .ll used for the assemblyCube is typically representative of a
+-- specific LLVM version, and while it is assembled and disassembled by newer
+-- versions of LLVM tools, it will never introduce any newer element, whereas the
+-- clang-generated bitcode will contain version-current output which might have
+-- newer elements and ordering.
+--
+-- The cCompilerCube uses .c (C source) files as the input and .ll files for the
+-- expected output.  The ccCompilerCube uses .cc (C++ source) files as the input
+-- and .ll files for the expected output.  The assemblyCube uses the .ll file as
+-- both input and output.  The actual testing done is very similar, and the
+-- assemblyCube always generates a superset of the compilerCube tests (i.e. when
+-- no .c or .cc file is present).
+
+cCompilerCube :: VersionCheck -> TS.CUBE
+cCompilerCube llvmver = (assemblyCube llvmver)
+                        { TS.rootName = "*.(c|cc|cpp)"
+                        , TS.sweetAdjuster = rangeMatch llvmver
+                        }
+
+ccCompilerCube :: VersionCheck -> TS.CUBE
+ccCompilerCube llvmver = (cCompilerCube llvmver) { TS.rootName = "*.cc"}
+
+
+runCompileTest :: VersionCheck -> KnownBugs -> TS.Sweets -> TS.Expectation
+               -> IO [TestTree]
+runCompileTest llvmVersion knownBugs sweet expct = do
+  shouldSkip <- skipTest expct
+  let tmod = if shouldSkip
+             then ignoreTestBecause "not valid for this LLVM version"
+             else case isKnownBug knownBugs sweet expct llvmVersion of
+                    Just (from, why) ->
+                      expectFailBecause $ why <> " [see " <> from <> "]"
+                    Nothing -> id
+  let pfx = TS.rootBaseName sweet
+  return $ (:[]) $ tmod
+    $ testCaseM llvmVersion pfx
+    $ withFile (compileToBitCode pfx $ TS.rootFile sweet)
+    $ \bc ->
+        with2Files (parseBC pfx bc)
+        $ \(parsed1, ast) ->
+            case ast of
+              Nothing ->
+                -- No round trip, so this just verifies that the bitcode could be
+                -- parsed without generating an error.
+                return ()
+              Just ast1 ->
+                -- Assemble and re-parse the bitcode to make sure it can be
+                -- round-tripped successfully.
+                with2Files (processLL pfx parsed1)
+                $ \(_, mb'ast2) -> case mb'ast2 of
+                                     Just ast2 -> diffCmp ast1 ast2
+                                     Nothing -> error "failed processLL"
+                  -- fst is ignored because .ll files are not compared; see
+                  -- runAssemblyTest for details.
+
+
+----------------------------------------------------------------------
+-- Pre-existing bitcode tests tests
+
+bitcodeCube :: VersionCheck -> TS.CUBE
+bitcodeCube llvmver = (assemblyCube llvmver)
+                        { TS.rootName = "*.bc"
+                        , TS.inputDirs = ["disasm-test/bc_src_tests"]
+                        , TS.sweetAdjuster = rangeMatch llvmver
+                        }
+
+runRawBCTest :: VersionCheck -> KnownBugs -> TS.Sweets -> TS.Expectation
+               -> IO [TestTree]
+runRawBCTest llvmVersion knownBugs sweet expct = do
+  shouldSkip <- skipTest expct
+  let tmod = if shouldSkip
+             then ignoreTestBecause "not valid for this LLVM version"
+             else case isKnownBug knownBugs sweet expct llvmVersion of
+                    Just (from, why) ->
+                      expectFailBecause $ why <> " [see " <> from <> "]"
+                    Nothing -> id
+  let pfx = TS.rootBaseName sweet
+  let bc = TS.rootFile sweet
+  return $ (:[]) $ tmod
+    $ testCaseM llvmVersion pfx
+    $ with2Files (parseBC pfx bc)
+        $ \(parsed1, ast) ->
+            case ast of
+              Nothing ->
+                -- No round trip, so this just verifies that the bitcode could be
+                -- parsed without generating an error.
+                return ()
+              Just ast1 ->
+                -- Assemble and re-parse the bitcode to make sure it can be
+                -- round-tripped successfully.
+                with2Files (processLL pfx parsed1)
+                $ \(_, mb'ast2) -> case mb'ast2 of
+                                     Just ast2 -> diffCmp ast1 ast2
+                                     Nothing -> error "Failed processLL"
+                  -- fst is ignored because .ll files are not compared; see
+                  -- runAssemblyTest for details.
+
+
+----------------------------------------------------------------------
+-- Helpers
+
 -- | A test failure.
 data TestFailure
-  = ParseError Error -- ^ A parser failure.
+  = ParseError Error -- ^ A parser failure
     deriving (Typeable,Show)
 
 instance X.Exception TestFailure
 
--- | Attempt to compare the assembly generated by llvm-pretty and llvm-dis.
-runTest :: Options -> FilePath -> IO ()
-runTest opts file = do
-  putStr (showString file ":")
-  X.handle logError                                  $
-    X.handle logCommandError                         $
-    X.bracket (generateBitCode  opts pfx file) removeFile $ \ bc     ->
-    X.bracket (normalizeBitCode opts pfx bc)   removeFile $ \ norm   ->
-    X.bracket (processBitCode        pfx bc)   removeFile $ \ parsed -> do
-      ignore (wait (proc "diff" ["-u",norm,parsed]))
-      putStrLn "success"
-  where
-  pfx = dropExtension (takeFileName file)
 
-  logError (ParseError msg) = do
-    putStrLn "failure"
-    putStrLn (unlines (map ("; " ++) (lines (formatError msg))))
+-- This structure essentially recapitulates the TestOptions, but in a way that
+-- they will be accessible in a TestTree (via: StateT TestState IO a).
+data TestState = TestState { keepTemp :: Keep
+                           , rndTrip :: Roundtrip
+                           , showDetails :: Details
+                           , llvmAs :: LLVMAs
+                           , llvmDis :: LLVMDis
+                           , clang :: Clang
+                           , llvmVer :: VersionCheck
+                           }
 
-  logCommandError (CommandFailed cmd) = do
-    putStrLn "failure"
-    putStrLn ("Command ``" ++ cmd ++ "'' failed\n\n")
+type TestM a = StateT TestState IO a
 
+testCaseM :: VersionCheck -> FilePath -> TestM () -> TestTree
+testCaseM llvmVersion pfx ops =
+  askOption $ \llvmAs' ->
+  askOption $ \llvmDis' ->
+  askOption $ \roundtrip ->
+  askOption $ \keep ->
+  askOption $ \details ->
+  askOption $ \clang' ->
+  testCase pfx $ evalStateT ops (TestState { keepTemp = keep
+                                           , rndTrip = roundtrip
+                                           , showDetails = details
+                                           , llvmAs = llvmAs'
+                                           , llvmDis = llvmDis'
+                                           , clang = clang'
+                                           , llvmVer = llvmVersion
+                                           })
+
+
 -- | Assemble some llvm assembly, producing a bitcode file in /tmp.
-generateBitCode :: Options -> FilePath -> FilePath -> IO FilePath
-generateBitCode Options { .. } pfx file = do
-  tmp    <- getTemporaryDirectory
-  (bc,h) <- openBinaryTempFile tmp (pfx <.> "bc")
-  hClose h
-  wait (proc optLlvmAs ["-o", bc, file])
-  return bc
+assembleToBitCode :: FilePath -> FilePath -> TestM FilePath
+assembleToBitCode pfx file = do
+  tmp <- liftIO getTemporaryDirectory
+  LLVMAs asm <- gets llvmAs
+  X.bracketOnError
+    (liftIO $ openBinaryTempFile tmp (pfx <.> "bc"))
+    (rmFile . fst)
+    $ \(bc,h) ->
+        do liftIO $ hClose h
+           callProc asm ["-o", bc, file]
+           return bc
 
+-- | Compile a C or C++ source, producing a bitcode file in /tmp.
+compileToBitCode :: FilePath -> FilePath -> TestM FilePath
+compileToBitCode pfx file = do
+  tmp <- liftIO getTemporaryDirectory
+  Clang comp' <- gets clang
+  let comp = if ".cc" `isSuffixOf` file then comp' <> "++" else comp'
+  X.bracketOnError
+    (liftIO $ openBinaryTempFile tmp (pfx <.> "bc"))
+    (rmFile . fst)
+    $ \(bc,h) ->
+        do liftIO $ hClose h
+           callProc comp ["-c", "-emit-llvm", "-O0", "-U_FORTIFY_SOURCE", "-g", "-o", bc, file]
+           return bc
+
 -- | Use llvm-dis to parse a bitcode file, to obtain a normalized version of the
 -- llvm assembly.
-normalizeBitCode :: Options -> FilePath -> FilePath -> IO FilePath
-normalizeBitCode Options { .. } pfx file = do
-  tmp      <- getTemporaryDirectory
-  (norm,h) <- openTempFile tmp (pfx <.> "ll")
-  hClose h
-  wait (proc optLlvmDis ["-o", norm, file])
-  stripComments norm
-  return norm
+disasmBitCode :: FilePath -> FilePath -> TestM FilePath
+disasmBitCode pfx file = do
+  tmp <- liftIO $ getTemporaryDirectory
+  LLVMDis dis <- gets llvmDis
+  X.bracketOnError
+    (liftIO $ openTempFile tmp (pfx ++ "llvm-dis" <.> "ll"))
+    (rmFile . fst)
+    $ \(norm,h) ->
+        do liftIO $ hClose h
+           callProc dis ["-o", norm, file]
+           -- stripComments norm
+           return norm
 
+-- | Usually, the ASTs aren't "on the nose" identical.
+-- The big thing is that the metadata numbering differs, so we zero out all
+-- metadata indices and sort the unnamed metadata list.
+-- Done with SYB (Scrap Your Boilerplate).
+normalizeModule :: AST.Module -> AST.Module
+normalizeModule = sorted . everywhere (mkT zeroValMdRef)
+                         . everywhere (mkT zeroNamedMd)
+  where sorted m = m { AST.modUnnamedMd =
+                         sort (map (\um -> um { AST.umIndex = 0 })
+                                   (AST.modUnnamedMd m)) }
+        -- Zero out all ValMdRefs
+        zeroValMdRef (AST.ValMdRef _) = AST.ValMdRef 0
+        zeroValMdRef a                = (a :: AST.ValMd) -- avoid ambiguous type
+
+        -- Reduce all named metadata
+        zeroNamedMd (AST.NamedMd x _) = AST.NamedMd x []
+
+
 -- | Parse a bitcode file using llvm-pretty, failing the test if the parser
 -- fails.
-processBitCode :: FilePath -> FilePath -> IO FilePath
+processBitCode :: FilePath -> FilePath -> TestM (FilePath, Maybe FilePath)
 processBitCode pfx file = do
-  let handler :: X.SomeException -> IO (Either Error Module)
+  let handler :: X.SomeException -> IO (Either Error AST.Module)
       handler se = return (Left (Error [] (show se)))
-  e <- parseBitCodeLazyFromFile file `X.catch` handler
+      printToTempFile sufx stuff = do
+        tmp        <- getTemporaryDirectory
+        (parsed,h) <- openTempFile tmp (pfx ++ "llvm-disasm" <.> sufx)
+        hPutStrLn h stuff
+        hClose h
+        return parsed
+  e <- liftIO $ parseBitCodeLazyFromFile file `X.catch` handler
   case e of
-    Left err -> X.throwIO (ParseError err)
+    Left err -> X.throwM (ParseError err)
     Right m  -> do
-      tmp        <- getTemporaryDirectory
-      (parsed,h) <- openTempFile tmp (pfx <.> "ll")
-      hPrint h (ppLLVM (ppModule m))
-      hClose h
-      stripComments parsed
-      return parsed
+      let m' = AST.fixupOpaquePtrs m
+      postParseTests m'
+      llvmVersion <- gets llvmVer
+      llvmAssembly <-
+        case vcVersioning llvmVersion ^? (_Right . major) of
+          Nothing -> do liftIO $ hPutStrLn IO.stderr
+                          ( "warning: unknown LLVM version ("
+                            <> showVC llvmVersion <> "), assuming 3.5")
+                        return $ ppLLVM35 $ llvmPP m'
+          Just v ->
+            case v of
+              3 -> case vcVersioning llvmVersion ^? (_Right . minor) of
+                     Just 5 -> return $ ppLLVM35 $ llvmPP m'
+                     Just 6 -> return $ ppLLVM36 $ llvmPP m'
+                     Just 7 -> return $ ppLLVM37 $ llvmPP m'
+                     Just 8 -> return $ ppLLVM38 $ llvmPP m'
+                     o -> if maybe True (< 5) o
+                          then return $ ppLLVM35 $ llvmPP m'
+                          else return $ ppLLVM38 $ llvmPP m'
+              _ -> return $ ppLLVM (fromEnum v) $ llvmPP m'
+      parsed <- liftIO $ printToTempFile "ll" $ show llvmAssembly
+      Roundtrip roundtrip <- gets rndTrip
+      -- stripComments parsed
+      Details det <- gets showDetails
+      if roundtrip
+      then do
+        tmp2 <- liftIO $ printToTempFile "ast" (ppShow (normalizeModule m'))
+        when det $ liftIO $ putStrLn $ "## parsed Bitcode to " <> parsed <> " and " <> tmp2
+        return (parsed, Just tmp2)
+      else do
+        when det $ liftIO $ putStrLn $ "## parsed Bitcode to " <> parsed
+        return (parsed, Nothing)
 
+
+-- | These are common tests that should be run on the AST that is parsed from the
+-- bitcode file.  This tests invariants that are not accessible or testable from
+-- the serialized formats.
+postParseTests :: AST.Module -> TestM ()
+postParseTests m = ensureValidMetadataIndices m
+  where
+    -- This test is to ensure that all unnamed metadata instances have a unique
+    -- index value.
+    ensureValidMetadataIndices md = do
+      let idxs = AST.umIndex <$> AST.modUnnamedMd md
+      let uniqIdxs = nub idxs
+      let numDups = length idxs - length uniqIdxs
+      unless (numDups == 0)
+        $ do Details det <- gets showDetails
+             when det $ liftIO $ putStrLn
+               $ "Unnamed metadata (modUnnamedMd) indices: " <> show idxs
+             liftIO $ assertFailure
+               $ show numDups
+               <> " duplicated Unnamed metadata (modUnnamedMd) indices"
+
+
+
 -- | Remove comments from a .ll file, stripping everything including the
 -- semi-colon.
-stripComments :: FilePath -> IO ()
+stripComments :: FilePath -> TestM ()
 stripComments path = do
-  bytes <- L.readFile path
-  removeFile path
+  Keep keep <- gets keepTemp
+  bytes <- liftIO $ L.readFile path
+  when (not keep) $ rmFile path
   mapM_ (writeLine . dropComments) (bsLines bytes)
   where
   writeLine bs | L.null bs = return ()
-               | otherwise = do
+               | otherwise = liftIO $ do
                  L.appendFile path bs
                  L.appendFile path (L.singleton 0x0a)
 
@@ -193,30 +825,94 @@
   loop n | isSpace (chr (fromIntegral (L.index bs n))) = loop (n-1)
          | otherwise                                   = n
 
--- | A shell-command failure.
-data CommandError
-  = CommandFailed String -- ^ The command failed when running.
-    deriving (Typeable,Show)
+-- | Ignore a command that fails.
+ignore :: IO () -> IO ()
+ignore  = X.handle f
+  where f   :: EX.IOException -> IO ()
+        f _ = return ()
 
-instance X.Exception CommandError
+callProc :: String -> [String] -> TestM ()
+callProc p args = do
+  Details dets <- gets showDetails
+  when dets $ liftIO $ putStrLn ("## Running: " ++ p ++ " " ++ unwords args)
+  liftIO $ Proc.callProcess p args
 
--- | Construct a command error, given a description of the command that was run.
-commandError :: CmdSpec -> CommandError
-commandError (ShellCommand str)  = CommandFailed str
-commandError (RawCommand p args) = CommandFailed (unwords (takeFileName p:args))
+withFile :: TestM FilePath -> (FilePath -> TestM r) -> TestM r
+withFile iofile f = X.bracket iofile rmFile f
 
--- | Run a command, waiting for it to return.
-wait :: CreateProcess -> IO ()
-wait cmd = do
-  (_,_,_,ph) <- createProcess cmd
-  status     <- waitForProcess ph
-  case status of
-    ExitFailure{} -> X.throwIO (commandError (cmdspec cmd))
-    _             -> return ()
+with2Files :: TestM (FilePath, Maybe FilePath)
+           -> ((FilePath, Maybe FilePath) -> TestM r)
+           -> TestM r
+with2Files iofiles f =
+  let cleanup (tmp1, mbTmp2) = do
+        rmFile tmp1
+        traverse rmFile mbTmp2
+  in X.bracket iofiles cleanup f
 
--- | Ignore a command that fails.
-ignore :: IO () -> IO ()
-ignore  = X.handle f
-  where
-  f :: CommandError -> IO ()
-  f _ = return ()
+rmFile :: FilePath -> TestM ()
+rmFile tmp = do Keep keep <- gets keepTemp
+                unless keep
+                  $ do do exists <- liftIO $ doesFileExist tmp
+                          when exists $ do
+                            Details dets <- gets showDetails
+                            when dets $ liftIO $ putStrLn $ "## Removing " <> tmp
+                            liftIO $ removeFile tmp
+
+----------------------------------------------------------------------
+
+-- Handling Known Bugs
+
+-- | A map from a known bug file to the identifiers and identifier values in that
+-- known bug file.
+type KnownBugs = Map.Map FilePath (Map.Map String [String])
+
+-- | There is a directory containing files which describe known bugs (one per
+-- file).  Those files contain marker lines (prefixed with "##> ") which specify
+-- the elements and values that should match a test for this test to be a known
+-- bug.  This function reads in that file and creates a map from file to a map of
+-- markers and values in that file.  This returned value should be passed to the
+-- isKnownBug function, along with the test information to determine if the test
+-- is associated with a known bug.
+getKnownBugs :: IO KnownBugs
+getKnownBugs = do
+  let kbdir = "disasm-test/known_bugs"
+  known <- listDirectory kbdir
+  let interestingLine = ("##> " `isPrefixOf`)
+  let addInterestingLine l = case words l of
+                               (_ : t : ws) -> Map.insertWith (<>) t ws
+                               _ -> id
+  let interestingLineMap ls = foldr addInterestingLine mempty
+                              $ filter interestingLine ls
+  let addKnownBugInfo mp f = do
+        let fpath = kbdir </> f
+        X.try (lines <$> readFile fpath) >>= \case
+          Left (_e :: IOError) ->
+            -- Error reading the known bug file: ignore it
+            return mp
+          Right ls ->
+            let buginfo = interestingLineMap ls
+            in return $ if Map.null buginfo
+                        then mp
+                        else Map.insert fpath buginfo mp
+  foldM addKnownBugInfo mempty known
+
+
+-- | This function checks to see if the current test being defined corresponds to
+-- one of those known bugs, and if so, returns the name of the known bugs file
+-- and the summary string from that file.
+isKnownBug :: KnownBugs -> TS.Sweets -> TS.Expectation -> VersionCheck
+           -> Maybe (FilePath, String)
+isKnownBug knownBugs sweet _expct llvmver =
+  let matchOf (_,km) = and (uncurry isMatch <$> Map.assocs km)
+      isMatch = \case
+        "rootMatchName:" -> (TS.rootMatchName sweet `elem`)
+        "llvmver:" -> case vcVersioning llvmver ^? (_Right . major) of
+                        Just v -> (show v `elem`)
+                        Nothing -> const False
+        _ -> const True
+      found = find matchOf $ Map.assocs knownBugs
+      getSummary (f,_) = (f
+                         , head (fromMaybe [] (knownBugs ! f !? "summary:")
+                                 <> ["this is a known bug"])
+                         )
+  in getSummary <$> found
diff --git a/disasm-test/tests/T189.ll b/disasm-test/tests/T189.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/T189.ll
@@ -0,0 +1,29 @@
+; ModuleID = 'T189.c'
+source_filename = "T189.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-pc-linux-gnu"
+
+@.str = private unnamed_addr constant [4 x i8] c"%d\0A\00", align 1
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local void @f() #0 {
+entry:
+  %p = alloca i32 (i8*, ...)*, align 8
+  store i32 (i8*, ...)* @printf, i32 (i8*, ...)** %p, align 8
+  %0 = load i32 (i8*, ...)*, i32 (i8*, ...)** %p, align 8
+  %call = call i32 (i8*, ...) %0(i8* getelementptr inbounds ([4 x i8], [4 x i8]* @.str, i64 0, i64 0), i32 0)
+  ret void
+}
+
+declare dso_local i32 @printf(i8*, ...) #1
+
+attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
+attributes #1 = { "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "no-infs-fp-math"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
+
+!llvm.module.flags = !{!0}
+!llvm.ident = !{!1}
+!llvm.commandline = !{!2}
+
+!0 = !{i32 1, !"wchar_size", i32 4}
+!1 = !{!"clang version 10.0.0-4ubuntu1 "}
+!2 = !{!"/usr/lib/llvm-10/bin/clang -S -emit-llvm -frecord-command-line -fno-discard-value-names T189.c -o T189.ll"}
diff --git a/disasm-test/tests/T266-constant-icmp.ll b/disasm-test/tests/T266-constant-icmp.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/T266-constant-icmp.ll
@@ -0,0 +1,7 @@
+@global_var = external constant [1 x i8]
+
+define i64 @h() {
+  br i1 icmp ne (i32 ptrtoint (ptr @global_var to i32), i32 1), label %pc_1, label %pc_1
+pc_1:
+  ret i64 0
+}
diff --git a/disasm-test/tests/T266-constant-icmp.pre-llvm15.ll b/disasm-test/tests/T266-constant-icmp.pre-llvm15.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/T266-constant-icmp.pre-llvm15.ll
@@ -0,0 +1,7 @@
+@global_var = external constant [1 x i8]
+
+define i64 @h() {
+  br i1 icmp ne (i32 ptrtoint ([1 x i8]* @global_var to i32), i32 1), label %pc_1, label %pc_1
+pc_1:
+  ret i64 0
+}
diff --git a/disasm-test/tests/alloca.ll b/disasm-test/tests/alloca.ll
deleted file mode 100644
--- a/disasm-test/tests/alloca.ll
+++ /dev/null
@@ -1,10 +0,0 @@
-; ModuleID = 'alloca.bc'
-
-%aaaa = type [1 x i32]
-
-define i32 @f() {
-  %arr = alloca %aaaa, align 4
-  %ptr = getelementptr %aaaa* %arr, i32 0, i32 0
-  store i32 0, i32* %ptr
-  ret i32 0
-}
diff --git a/disasm-test/tests/atomicrmw.ll b/disasm-test/tests/atomicrmw.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/atomicrmw.ll
@@ -0,0 +1,4 @@
+define void @atomicrmw(i32* %a, i32 %i) {
+    %b = atomicrmw add i32* %a, i32 %i acquire
+    ret void
+}
diff --git a/disasm-test/tests/btf-tag-dicompositetype.ll b/disasm-test/tests/btf-tag-dicompositetype.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-dicompositetype.ll
@@ -0,0 +1,10 @@
+;; https://github.com/llvm/llvm-project/blob/0b32dca12ef4d82af71f86a70c49806e5b81ead2/llvm/test/Bitcode/attr-btf_tag-dicomposite.ll
+
+!3 = !DIFile(filename: "struct.c", directory: "/home/yhs/work/tests/llvm/btf_tag")
+!6 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "t", file: !3, line: 1, size: 32, elements: !7, annotations: !10)
+!7 = !{!8}
+!8 = !DIDerivedType(tag: DW_TAG_member, name: "a", scope: !6, file: !3, line: 1, baseType: !9, size: 32)
+!9 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!10 = !{!11, !12}
+!11 = !{!"btf_tag", !"a"}
+!12 = !{!"btf_tag", !"b"}
diff --git a/disasm-test/tests/btf-tag-dicompositetype.pre-llvm14.ll b/disasm-test/tests/btf-tag-dicompositetype.pre-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-dicompositetype.pre-llvm14.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/btf-tag-diderivedtype.ll b/disasm-test/tests/btf-tag-diderivedtype.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-diderivedtype.ll
@@ -0,0 +1,10 @@
+;; Adapted from https://github.com/llvm/llvm-project/blob/430e22388173c96da6777fccb9735a6e8ee3ea1c/llvm/test/Bitcode/attr-btf_tag-field.ll
+
+!1 = !DIFile(filename: "attr-btf_tag-field.c", directory: "/home/yhs/work/tests/llvm/btf_tag")
+!12 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!14 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "t1", file: !1, line: 7, size: 32, elements: !15)
+!15 = !{!16}
+!16 = !DIDerivedType(tag: DW_TAG_member, name: "a", scope: !14, file: !1, line: 8, baseType: !12, size: 32, annotations: !17)
+!17 = !{!18, !19}
+!18 = !{!"btf_tag", !"tag1"}
+!19 = !{!"btf_tag", !"tag2"}
diff --git a/disasm-test/tests/btf-tag-diderivedtype.pre-llvm14.ll b/disasm-test/tests/btf-tag-diderivedtype.pre-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-diderivedtype.pre-llvm14.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/btf-tag-diglobalvariable.ll b/disasm-test/tests/btf-tag-diglobalvariable.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-diglobalvariable.ll
@@ -0,0 +1,15 @@
+;; Adapted from https://github.com/llvm/llvm-project/blob/30c288489ae51a3e0819241f367eeae6df2b09e7/llvm/test/Bitcode/attr-btf_tag-diglobalvariable.ll
+
+!0 = !DIGlobalVariableExpression(var: !1, expr: !DIExpression())
+!1 = distinct !DIGlobalVariable(name: "g1", scope: !2, file: !3, line: 7, type: !6, isLocal: false, isDefinition: true, annotations: !10)
+!2 = distinct !DICompileUnit(language: DW_LANG_C99, file: !3, producer: "clang version 13.0.0 (https://github.com/llvm/llvm-project.git 47af5574a87dc298b5c6c36ff6a969c8c77c8499)", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !4, globals: !5, splitDebugInlining: false, nameTableKind: None)
+!3 = !DIFile(filename: "t.c", directory: "/home/yhs/work/tests/llvm/btf_tag")
+!4 = !{}
+!5 = !{!0}
+!6 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "t1", file: !3, line: 4, size: 32, elements: !7)
+!7 = !{!8}
+!8 = !DIDerivedType(tag: DW_TAG_member, name: "a", scope: !6, file: !3, line: 5, baseType: !9, size: 32)
+!9 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!10 = !{!11, !12}
+!11 = !{!"btf_tag", !"tag1"}
+!12 = !{!"btf_tag", !"tag2"}
diff --git a/disasm-test/tests/btf-tag-diglobalvariable.pre-llvm14.ll b/disasm-test/tests/btf-tag-diglobalvariable.pre-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-diglobalvariable.pre-llvm14.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/btf-tag-dilocalvariable.ll b/disasm-test/tests/btf-tag-dilocalvariable.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-dilocalvariable.ll
@@ -0,0 +1,14 @@
+;; Adapted from https://github.com/llvm/llvm-project/blob/1bebc31c617d1a0773f1d561f02dd17c5e83b23b/llvm/test/Bitcode/attr-btf_tag-parameter.ll
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 13.0.0 (https://github.com/llvm/llvm-project.git c9e3139e00bcef23b236a02890b909a130d1b3d9)", isOptimized: true, runtimeVersion: 0, emissionKind: FullDebug, enums: !2, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "func.c", directory: "/home/yhs/work/tests/llvm/btf_tag")
+!2 = !{}
+!8 = distinct !DISubprogram(name: "f", scope: !1, file: !1, line: 1, type: !9, scopeLine: 1, flags: DIFlagPrototyped | DIFlagAllCallsDescribed, spFlags: DISPFlagDefinition | DISPFlagOptimized, unit: !0, retainedNodes: !12)
+!9 = !DISubroutineType(types: !10)
+!10 = !{!11, !11}
+!11 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!12 = !{!13}
+!13 = !DILocalVariable(name: "a", arg: 1, scope: !8, file: !1, line: 1, type: !11, annotations: !14)
+!14 = !{!15, !16}
+!15 = !{!"btf_tag", !"a"}
+!16 = !{!"btf_tag", !"b"}
diff --git a/disasm-test/tests/btf-tag-dilocalvariable.pre-llvm14.ll b/disasm-test/tests/btf-tag-dilocalvariable.pre-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-dilocalvariable.pre-llvm14.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/btf-tag-disubprogram.ll b/disasm-test/tests/btf-tag-disubprogram.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-disubprogram.ll
@@ -0,0 +1,15 @@
+;; Adapted from https://github.com/llvm/llvm-project/blob/d383df32c0d5bcdc8c160ecdd7174399aa3c5395/llvm/test/Bitcode/attr-btf_tag-disubprogram.ll
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 13.0.0 (https://github.com/llvm/llvm-project.git a6dd9d402a04d53403664bbb47771f2573c7ade0)", isOptimized: true, runtimeVersion: 0, emissionKind: FullDebug, enums: !2, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "func.c", directory: "/home/yhs/work/tests/llvm/btf_tag")
+!2 = !{}
+!7 = !{!"clang version 13.0.0 (https://github.com/llvm/llvm-project.git a6dd9d402a04d53403664bbb47771f2573c7ade0)"}
+!8 = distinct !DISubprogram(name: "f", scope: !1, file: !1, line: 1, type: !9, scopeLine: 1, flags: DIFlagPrototyped | DIFlagAllCallsDescribed, spFlags: DISPFlagDefinition | DISPFlagOptimized, unit: !0, retainedNodes: !12, annotations: !14)
+!9 = !DISubroutineType(types: !10)
+!10 = !{!11, !11}
+!11 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!12 = !{!13}
+!13 = !DILocalVariable(name: "a", arg: 1, scope: !8, file: !1, line: 1, type: !11)
+!14 = !{!15, !16}
+!15 = !{!"btf_tag", !"a"}
+!16 = !{!"btf_tag", !"b"}
diff --git a/disasm-test/tests/btf-tag-disubprogram.pre-llvm14.ll b/disasm-test/tests/btf-tag-disubprogram.pre-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/btf-tag-disubprogram.pre-llvm14.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/callbr.ll b/disasm-test/tests/callbr.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/callbr.ll
@@ -0,0 +1,47 @@
+; ModuleID = 'callbr.c'
+source_filename = "callbr.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local i32 @main() #0 {
+  %1 = alloca i32, align 4
+  %2 = alloca i32, align 4
+  store i32 0, ptr %1, align 4
+  store i32 0, ptr %2, align 4
+  %3 = load i32, ptr %2, align 4
+  callbr void asm sideeffect "testl $0, $0; jne ${1:l};", "r,!i,!i,~{dirflag},~{fpsr},~{flags}"(i32 %3) #1
+          to label %4 [label %6, label %5], !srcloc !7
+
+4:                                                ; preds = %0
+  store i32 0, ptr %1, align 4
+  br label %7
+
+5:                                                ; preds = %0
+  store i32 0, ptr %1, align 4
+  br label %7
+
+6:                                                ; preds = %0
+  store i32 1, ptr %1, align 4
+  br label %7
+
+7:                                                ; preds = %6, %5, %4
+  %8 = load i32, ptr %1, align 4
+  ret i32 %8
+}
+
+attributes #0 = { noinline nounwind optnone uwtable "frame-pointer"="all" "min-legal-vector-width"="0" "no-trapping-math"="true" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "tune-cpu"="generic" }
+attributes #1 = { nounwind }
+
+!llvm.module.flags = !{!0, !1, !2, !3, !4}
+!llvm.ident = !{!5}
+!llvm.commandline = !{!6}
+
+!0 = !{i32 1, !"wchar_size", i32 4}
+!1 = !{i32 7, !"PIC Level", i32 2}
+!2 = !{i32 7, !"PIE Level", i32 2}
+!3 = !{i32 7, !"uwtable", i32 2}
+!4 = !{i32 7, !"frame-pointer", i32 2}
+!5 = !{!"clang version 15.0.6"}
+!6 = !{!"/home/ryanglscott/Software/clang+llvm-15.0.6/bin/clang-15 -S -emit-llvm -frecord-command-line callbr.c -o callbr.ll"}
+!7 = !{i64 272}
diff --git a/disasm-test/tests/callbr.pre-llvm15.ll b/disasm-test/tests/callbr.pre-llvm15.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/callbr.pre-llvm15.ll
@@ -0,0 +1,40 @@
+; ModuleID = 'test.c'
+source_filename = "test.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-pc-linux-gnu"
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local i32 @test1(i32 %0) #0 {
+  %2 = alloca i32, align 4
+  %3 = alloca i32, align 4
+  store i32 %0, i32* %3, align 4
+  %4 = load i32, i32* %3, align 4
+  callbr void asm sideeffect "testl $0, $0; jne ${1:l};", "r,X,X,~{dirflag},~{fpsr},~{flags}"(i32 %4, i8* blockaddress(@test1, %7), i8* blockaddress(@test1, %6)) #1
+          to label %5 [label %7, label %6], !srcloc !2
+
+5:                                                ; preds = %1
+  store i32 0, i32* %2, align 4
+  br label %8
+
+6:                                                ; preds = %1
+  store i32 0, i32* %2, align 4
+  br label %8
+
+7:                                                ; preds = %1
+  store i32 1, i32* %2, align 4
+  br label %8
+
+8:                                                ; preds = %7, %6, %5
+  %9 = load i32, i32* %2, align 4
+  ret i32 %9
+}
+
+attributes #0 = { noinline nounwind optnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
+attributes #1 = { nounwind }
+
+!llvm.module.flags = !{!0}
+!llvm.ident = !{!1}
+
+!0 = !{i32 1, !"wchar_size", i32 4}
+!1 = !{!"clang version 10.0.0-4ubuntu1 "}
+!2 = !{i32 265}
diff --git a/disasm-test/tests/cmpxchg.ll b/disasm-test/tests/cmpxchg.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/cmpxchg.ll
@@ -0,0 +1,73 @@
+; ModuleID = '/tmp/nix-shell.mXmHgC/cmpxchg1066927-8.bc'
+source_filename = "disasm-test/tests/cmpxchg.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+@val = global i32 2344, align 4, !dbg !0
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define i32 @do_atomic_update(i32 %0) #0 !dbg !15 {
+  %2 = alloca i32, align 4
+  %3 = alloca i32, align 4
+  %4 = alloca i32, align 4
+  %5 = alloca i8, align 1
+  store i32 %0, i32* %2, align 4
+  call void @llvm.dbg.declare(metadata i32* %2, metadata !18, metadata !DIExpression()), !dbg !19
+  call void @llvm.dbg.declare(metadata i32* %3, metadata !20, metadata !DIExpression()), !dbg !21
+  store i32 2344, i32* %3, align 4, !dbg !21
+  %6 = load atomic i32, i32* %2 seq_cst, align 4, !dbg !22
+  store i32 %6, i32* %4, align 4, !dbg !22
+  %7 = load i32, i32* %3, align 4, !dbg !22
+  %8 = load i32, i32* %4, align 4, !dbg !22
+  %9 = cmpxchg weak i32* @val, i32 %7, i32 %8 seq_cst seq_cst, !dbg !22
+  %10 = extractvalue { i32, i1 } %9, 0, !dbg !22
+  %11 = extractvalue { i32, i1 } %9, 1, !dbg !22
+  br i1 %11, label %13, label %12, !dbg !22
+
+12:                                               ; preds = %1
+  store i32 %10, i32* %3, align 4, !dbg !22
+  br label %13, !dbg !22
+
+13:                                               ; preds = %12, %1
+  %14 = zext i1 %11 to i8, !dbg !22
+  store i8 %14, i8* %5, align 1, !dbg !22
+  %15 = load i8, i8* %5, align 1, !dbg !22
+  %16 = trunc i8 %15 to i1, !dbg !22
+  %17 = zext i1 %16 to i32, !dbg !22
+  ret i32 %17, !dbg !23
+}
+
+; Function Attrs: nounwind readnone speculatable willreturn
+declare void @llvm.dbg.declare(metadata, metadata, metadata) #1
+
+attributes #0 = { noinline nounwind optnone sspstrong uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="true" "stack-protector-buffer-size"="4" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
+attributes #1 = { nounwind readnone speculatable willreturn }
+
+!llvm.dbg.cu = !{!2}
+!llvm.module.flags = !{!10, !11, !12, !13}
+!llvm.ident = !{!14}
+
+!0 = !DIGlobalVariableExpression(var: !1, expr: !DIExpression())
+!1 = distinct !DIGlobalVariable(name: "val", scope: !2, file: !3, line: 4, type: !6, isLocal: false, isDefinition: true)
+!2 = distinct !DICompileUnit(language: DW_LANG_C99, file: !3, producer: "clang version 11.1.0", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !4, globals: !5, splitDebugInlining: false, nameTableKind: None)
+!3 = !DIFile(filename: "disasm-test/tests/cmpxchg.c", directory: "/home/kquick/work/DFAMS/llvm-pretty-bc-parser")
+!4 = !{}
+!5 = !{!0}
+!6 = !DIDerivedType(tag: DW_TAG_typedef, name: "atomic_int", file: !7, line: 83, baseType: !8)
+!7 = !DIFile(filename: "/nix/store/4pk431ywfvw0k926blzwncnp699z3vh5-clang-wrapper-11.1.0/resource-root/include/stdatomic.h", directory: "")
+!8 = !DIDerivedType(tag: DW_TAG_atomic_type, baseType: !9)
+!9 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!10 = !{i32 7, !"Dwarf Version", i32 4}
+!11 = !{i32 2, !"Debug Info Version", i32 3}
+!12 = !{i32 1, !"wchar_size", i32 4}
+!13 = !{i32 7, !"PIC Level", i32 2}
+!14 = !{!"clang version 11.1.0"}
+!15 = distinct !DISubprogram(name: "do_atomic_update", scope: !3, file: !3, line: 6, type: !16, scopeLine: 6, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !2, retainedNodes: !4)
+!16 = !DISubroutineType(types: !17)
+!17 = !{!9, !6}
+!18 = !DILocalVariable(name: "newval", arg: 1, scope: !15, file: !3, line: 6, type: !6)
+!19 = !DILocation(line: 6, column: 33, scope: !15)
+!20 = !DILocalVariable(name: "old_val", scope: !15, file: !3, line: 7, type: !9)
+!21 = !DILocation(line: 7, column: 9, scope: !15)
+!22 = !DILocation(line: 8, column: 12, scope: !15)
+!23 = !DILocation(line: 8, column: 5, scope: !15)
diff --git a/disasm-test/tests/debug-loc.ll b/disasm-test/tests/debug-loc.ll
deleted file mode 100644
--- a/disasm-test/tests/debug-loc.ll
+++ /dev/null
@@ -1,43 +0,0 @@
-; ModuleID = 'test.c'
-target datalayout = "e-m:o-i64:64-f80:128-n8:16:32:64-S128"
-target triple = "x86_64-apple-macosx10.10.0"
-
-; Function Attrs: nounwind ssp uwtable
-define i32 @f(i32 %c) #0 {
-entry:
-  %c.addr = alloca i32, align 4
-  store i32 %c, i32* %c.addr, align 4
-  call void @llvm.dbg.declare(metadata i32* %c.addr, metadata !13, metadata !14), !dbg !15
-  %0 = load i32* %c.addr, align 4, !dbg !16
-  %add = add nsw i32 %0, 1, !dbg !16
-  ret i32 %add, !dbg !16
-}
-
-; Function Attrs: nounwind readnone
-declare void @llvm.dbg.declare(metadata, metadata, metadata) #1
-
-attributes #0 = { nounwind ssp uwtable "less-precise-fpmad"="false" "no-frame-pointer-elim"="true" "no-frame-pointer-elim-non-leaf" "no-infs-fp-math"="false" "no-nans-fp-math"="false" "stack-protector-buffer-size"="8" "unsafe-fp-math"="false" "use-soft-float"="false" }
-attributes #1 = { nounwind readnone }
-
-!llvm.dbg.cu = !{!0}
-!llvm.module.flags = !{!9, !10, !11}
-!llvm.ident = !{!12}
-
-!0 = !{!"0x11\0012\00clang version 3.6.1 (tags/RELEASE_361/final)\000\00\000\00\001", !1, !2, !2, !3, !2, !2} ; [ DW_TAG_compile_unit ] [/Users/trevor/Work/verifier/llvm-pretty-bc-parser/test.c] [DW_LANG_C99]
-!1 = !{!"test.c", !"/Users/trevor/Work/verifier/llvm-pretty-bc-parser"}
-!2 = !{}
-!3 = !{!4}
-!4 = !{!"0x2e\00f\00f\00\002\000\001\000\000\00256\000\002", !1, !5, !6, null, i32 (i32)* @f, null, null, !2} ; [ DW_TAG_subprogram ] [line 2] [def] [f]
-!5 = !{!"0x29", !1}                               ; [ DW_TAG_file_type ] [/Users/trevor/Work/verifier/llvm-pretty-bc-parser/test.c]
-!6 = !{!"0x15\00\000\000\000\000\000\000", null, null, null, !7, null, null, null} ; [ DW_TAG_subroutine_type ] [line 0, size 0, align 0, offset 0] [from ]
-!7 = !{!8, !8}
-!8 = !{!"0x24\00int\000\0032\0032\000\000\005", null, null} ; [ DW_TAG_base_type ] [int] [line 0, size 32, align 32, offset 0, enc DW_ATE_signed]
-!9 = !{i32 2, !"Dwarf Version", i32 2}
-!10 = !{i32 2, !"Debug Info Version", i32 2}
-!11 = !{i32 1, !"PIC Level", i32 2}
-!12 = !{!"clang version 3.6.1 (tags/RELEASE_361/final)"}
-!13 = !{!"0x101\00c\0016777218\000", !4, !5, !8}  ; [ DW_TAG_arg_variable ] [c] [line 2]
-!14 = !{!"0x102"}                                 ; [ DW_TAG_expression ]
-!15 = !MDLocation(line: 2, column: 11, scope: !4)
-!16 = !MDLocation(line: 3, column: 12, scope: !4)
-!17 = !MDLocation(line: 3, column: 5, scope: !4)
diff --git a/disasm-test/tests/derivedtype.ll b/disasm-test/tests/derivedtype.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/derivedtype.ll
@@ -0,0 +1,52 @@
+; ModuleID = 'derivedtype.bc'
+source_filename = "derivedtype.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+%struct.message = type { i32, i8* }
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define i32 @foo(%struct.message* %0) #0 !dbg !8 {
+  %2 = alloca %struct.message*, align 8
+  store %struct.message* %0, %struct.message** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.message** %2, metadata !19, metadata !DIExpression()), !dbg !20
+  %3 = load %struct.message*, %struct.message** %2, align 8, !dbg !21
+  %4 = getelementptr inbounds %struct.message, %struct.message* %3, i32 0, i32 0, !dbg !22
+  %5 = load i32, i32* %4, align 8, !dbg !22
+  ret i32 %5, !dbg !23
+}
+
+; Function Attrs: nounwind readnone speculatable willreturn
+declare void @llvm.dbg.declare(metadata, metadata, metadata) #1
+
+attributes #0 = { noinline nounwind optnone sspstrong uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="false" "stack-protector-buffer-size"="4" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
+attributes #1 = { nounwind readnone speculatable willreturn }
+
+!llvm.dbg.cu = !{!0}
+!llvm.module.flags = !{!3, !4, !5, !6}
+!llvm.ident = !{!7}
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 10.0.1 ", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !2, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "derivedtype.c", directory: "/home/kquick/work/RISE/llvm-regr5/disasm-test/tests")
+!2 = !{}
+!3 = !{i32 7, !"Dwarf Version", i32 4}
+!4 = !{i32 2, !"Debug Info Version", i32 3}
+!5 = !{i32 1, !"wchar_size", i32 4}
+!6 = !{i32 7, !"PIC Level", i32 2}
+!7 = !{!"clang version 10.0.1 "}
+!8 = distinct !DISubprogram(name: "foo", scope: !1, file: !1, line: 3, type: !9, scopeLine: 3, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!9 = !DISubroutineType(types: !10)
+!10 = !{!11, !12}
+!11 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!12 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !13, size: 64)
+!13 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "message", file: !1, line: 1, size: 128, elements: !14)
+!14 = !{!15, !16}
+!15 = !DIDerivedType(tag: DW_TAG_member, name: "msglen", scope: !13, file: !1, line: 1, baseType: !11, size: 32)
+!16 = !DIDerivedType(tag: DW_TAG_member, name: "msgptr", scope: !13, file: !1, line: 1, baseType: !17, size: 64, offset: 64)
+!17 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !18, size: 64)
+!18 = !DIBasicType(name: "char", size: 8, encoding: DW_ATE_signed_char)
+!19 = !DILocalVariable(name: "mptr", arg: 1, scope: !8, file: !1, line: 3, type: !12)
+!20 = !DILocation(line: 3, column: 25, scope: !8)
+!21 = !DILocation(line: 4, column: 12, scope: !8)
+!22 = !DILocation(line: 4, column: 18, scope: !8)
+!23 = !DILocation(line: 4, column: 5, scope: !8)
diff --git a/disasm-test/tests/di-arg-list.ll b/disasm-test/tests/di-arg-list.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/di-arg-list.ll
@@ -0,0 +1,43 @@
+; ModuleID = 'di-arg-list.c'
+source_filename = "di-arg-list.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+; Function Attrs: mustprogress nofree norecurse nosync nounwind readnone uwtable willreturn
+define dso_local i32 @f(i32 %0, i32 %1) local_unnamed_addr #0 !dbg !9 {
+  call void @llvm.dbg.value(metadata i32 %0, metadata !14, metadata !DIExpression()), !dbg !17
+  call void @llvm.dbg.value(metadata i32 %1, metadata !15, metadata !DIExpression()), !dbg !17
+  call void @llvm.dbg.value(metadata !DIArgList(i32 %0, i32 %1), metadata !16, metadata !DIExpression(DW_OP_LLVM_arg, 0, DW_OP_LLVM_arg, 1, DW_OP_plus, DW_OP_stack_value)), !dbg !17
+  ret i32 0, !dbg !18
+}
+
+; Function Attrs: nofree nosync nounwind readnone speculatable willreturn
+declare void @llvm.dbg.value(metadata, metadata, metadata) #1
+
+attributes #0 = { mustprogress nofree norecurse nosync nounwind readnone uwtable willreturn "frame-pointer"="none" "min-legal-vector-width"="0" "no-trapping-math"="true" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "tune-cpu"="generic" }
+attributes #1 = { nofree nosync nounwind readnone speculatable willreturn }
+
+!llvm.dbg.cu = !{!0}
+!llvm.module.flags = !{!3, !4, !5, !6}
+!llvm.ident = !{!7}
+!llvm.commandline = !{!8}
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 13.0.1", isOptimized: true, runtimeVersion: 0, emissionKind: FullDebug, enums: !2, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "di-arg-list.c", directory: "/home/rscott/Documents/Hacking/Haskell/llvm-pretty-bc-parser/disasm-test/tests")
+!2 = !{}
+!3 = !{i32 7, !"Dwarf Version", i32 4}
+!4 = !{i32 2, !"Debug Info Version", i32 3}
+!5 = !{i32 1, !"wchar_size", i32 4}
+!6 = !{i32 7, !"uwtable", i32 1}
+!7 = !{!"clang version 13.0.1"}
+!8 = !{!"/home/rscott/Software/clang+llvm-13.0.1/bin/clang-13 -S -emit-llvm -g -O1 -frecord-command-line di-arg-list.c -o di-arg-list.at-least-llvm13.ll"}
+!9 = distinct !DISubprogram(name: "f", scope: !1, file: !1, line: 1, type: !10, scopeLine: 1, flags: DIFlagPrototyped | DIFlagAllCallsDescribed, spFlags: DISPFlagDefinition | DISPFlagOptimized, unit: !0, retainedNodes: !13)
+!10 = !DISubroutineType(types: !11)
+!11 = !{!12, !12, !12}
+!12 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!13 = !{!14, !15, !16}
+!14 = !DILocalVariable(name: "x", arg: 1, scope: !9, file: !1, line: 1, type: !12)
+!15 = !DILocalVariable(name: "y", arg: 2, scope: !9, file: !1, line: 1, type: !12)
+!16 = !DILocalVariable(name: "z", scope: !9, file: !1, line: 2, type: !12)
+!17 = !DILocation(line: 0, scope: !9)
+!18 = !DILocation(line: 3, column: 3, scope: !9)
diff --git a/disasm-test/tests/di-arg-list.pre-llvm13.ll b/disasm-test/tests/di-arg-list.pre-llvm13.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/di-arg-list.pre-llvm13.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/diderivedtype-address-space.at-least-llvm14.ll b/disasm-test/tests/diderivedtype-address-space.at-least-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/diderivedtype-address-space.at-least-llvm14.ll
@@ -0,0 +1,4 @@
+;; Adapted from https://github.com/llvm/llvm-project/blob/d5561e0a0bbd484da17d3b68ae5fedc0a057246b/llvm/test/Assembler/debug-info.ll
+
+!7 = !DIBasicType(tag: DW_TAG_base_type, name: "name", size: 1, align: 2, encoding: DW_ATE_unsigned_char)
+!15 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !7, size: 32, align: 32, dwarfAddressSpace: 1)
diff --git a/disasm-test/tests/dilocalvariable.ll b/disasm-test/tests/dilocalvariable.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/dilocalvariable.ll
@@ -0,0 +1,32 @@
+;; Adapted from https://github.com/llvm/llvm-project/blob/2ede126b1b3fae52cddece5cf1f75b474a9c7932/llvm/test/Assembler/dilocalvariable.ll
+
+; CHECK: !named = !{!0, !1, !2, !3, !4, !5, !6, !7, !8, !9}
+!named = !{!0, !1, !2, !3, !4, !5, !6, !7, !8, !9}
+
+!llvm.module.flags = !{!10}
+!llvm.dbg.cu = !{!1}
+
+!0 = distinct !DISubprogram(unit: !1)
+!1 = distinct !DICompileUnit(language: DW_LANG_C99, producer: "clang",
+                             file: !2,
+                             isOptimized: true, flags: "-O2",
+                             splitDebugFilename: "abc.debug", emissionKind: 2)
+!2 = !DIFile(filename: "path/to/file", directory: "/path/to/dir")
+!3 = !DIBasicType(name: "int", size: 32, align: 32, encoding: DW_ATE_signed)
+!4 = !DILocation(scope: !0)
+
+; CHECK: !5 = !DILocalVariable(name: "foo", arg: 3, scope: !0, file: !2, line: 7, type: !3, flags: DIFlagArtificial, align: 32)
+; CHECK: !6 = !DILocalVariable(name: "foo", scope: !0, file: !2, line: 7, type: !3, flags: DIFlagArtificial)
+!5 = !DILocalVariable(name: "foo", arg: 3,
+                      scope: !0, file: !2, line: 7, type: !3,
+                      flags: DIFlagArtificial, align: 32)
+!6 = !DILocalVariable(name: "foo", scope: !0,
+                      file: !2, line: 7, type: !3, flags: DIFlagArtificial)
+
+; CHECK: !7 = !DILocalVariable(arg: 1, scope: !0)
+; CHECK: !8 = !DILocalVariable(scope: !0)
+!7 = !DILocalVariable(scope: !0, arg: 1)
+!8 = !DILocalVariable(scope: !0)
+!9 = distinct !{}
+
+!10 = !{i32 2, !"Debug Info Version", i32 3}
diff --git a/disasm-test/tests/dilocalvariable.pre-llvm14.ll b/disasm-test/tests/dilocalvariable.pre-llvm14.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/dilocalvariable.pre-llvm14.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/fcmp-fast-math.ll b/disasm-test/tests/fcmp-fast-math.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/fcmp-fast-math.ll
@@ -0,0 +1,23 @@
+; ModuleID = 'test.c'
+source_filename = "test.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-pc-linux-gnu"
+
+; Function Attrs: norecurse nounwind readnone uwtable
+define dso_local double @f(double %a) local_unnamed_addr #0 {
+entry:
+  %tobool = fcmp fast une double %a, 0.000000e+00
+  %inc = fadd fast double %a, 1.000000e+00
+  %a.addr.0 = select i1 %tobool, double %inc, double %a
+  ret double %a.addr.0
+}
+
+attributes #0 = { norecurse nounwind readnone uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="none" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="true" "no-jump-tables"="false" "no-nans-fp-math"="true" "no-signed-zeros-fp-math"="true" "no-trapping-math"="false" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="true" "use-soft-float"="false" }
+
+!llvm.module.flags = !{!0}
+!llvm.ident = !{!1}
+!llvm.commandline = !{!2}
+
+!0 = !{i32 1, !"wchar_size", i32 4}
+!1 = !{!"clang version 10.0.0-4ubuntu1 "}
+!2 = !{!"/usr/lib/llvm-10/bin/clang -O3 test.c -emit-llvm -S -fno-discard-value-names -frecord-command-line -ffast-math"}
diff --git a/disasm-test/tests/fneg.ll b/disasm-test/tests/fneg.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/fneg.ll
@@ -0,0 +1,14 @@
+define double @real_fneg(double %X) {
+        %Y = fneg double %X               ; <double> [#uses=1]
+        ret double %Y
+}
+
+define double @real_fneg_constant() {
+        %Y = fneg double -2.0             ; <double> [#uses=1]
+        ret double %Y
+}
+
+define float @real_fnegf(float %X) {
+        %Y = fneg float %X                ; <float> [#uses=1]
+        ret float %Y
+}
diff --git a/disasm-test/tests/global-alias.ll b/disasm-test/tests/global-alias.ll
deleted file mode 100644
--- a/disasm-test/tests/global-alias.ll
+++ /dev/null
@@ -1,10 +0,0 @@
-
-%azaz = type { i32, i8 }
-
-define i32 @f() {
-	%a = alloca %azaz, align 4
-	%ptr = getelementptr %azaz* %a, i32 0, i32 0
-	store i32 42, i32* %ptr
-	%x = load i32* %ptr
-	ret i32 %x
-}
diff --git a/disasm-test/tests/global-var-extern.ll b/disasm-test/tests/global-var-extern.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/global-var-extern.ll
@@ -0,0 +1,32 @@
+; ModuleID = '/tmp/nix-shell.AkHqe1/global-var-extern207140-4.bc'
+source_filename = "disasm-test/tests/global-var-extern.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu-"
+
+@global_var = external global i32, align 4
+
+define i32 @foo() !dbg !9 {
+  %1 = load i32, i32* @global_var, align 4, !dbg !14
+  ret i32 %1, !dbg !15
+}
+
+!llvm.dbg.cu = !{!0}
+!llvm.ident = !{!2}
+!llvm.module.flags = !{!3, !4, !5, !6, !7, !8}
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 15.0.7", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "disasm-test/tests/global-var-extern.c", directory: "/home/kquick/work/RISE/llvm-regr5")
+!2 = !{!"clang version 15.0.7"}
+!3 = !{i32 7, !"Dwarf Version", i32 5}
+!4 = !{i32 2, !"Debug Info Version", i32 3}
+!5 = !{i32 1, !"wchar_size", i32 4}
+!6 = !{i32 7, !"PIC Level", i32 2}
+!7 = !{i32 7, !"uwtable", i32 2}
+!8 = !{i32 7, !"frame-pointer", i32 2}
+!9 = distinct !DISubprogram(name: "foo", scope: !1, file: !1, line: 3, type: !10, scopeLine: 3, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !13)
+!10 = distinct !DISubroutineType(types: !11)
+!11 = !{!12}
+!12 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!13 = !{}
+!14 = !DILocation(line: 3, column: 24, scope: !9)
+!15 = !DILocation(line: 3, column: 17, scope: !9)
diff --git a/disasm-test/tests/global-var.ll b/disasm-test/tests/global-var.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/global-var.ll
@@ -0,0 +1,13 @@
+; ModuleID = 'global-var.bc'
+source_filename = "disasm-test/tests/global-var.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+@global_var = global i32 0, align 4
+
+!llvm.module.flags = !{!0, !1}
+!llvm.ident = !{!2}
+
+!0 = !{i32 1, !"wchar_size", i32 4}
+!1 = !{i32 7, !"PIC Level", i32 2}
+!2 = !{!"clang version 11.1.0"}
diff --git a/disasm-test/tests/global.ll b/disasm-test/tests/global.ll
deleted file mode 100644
--- a/disasm-test/tests/global.ll
+++ /dev/null
@@ -1,1 +0,0 @@
-@value = global i32 10
diff --git a/disasm-test/tests/instrmd.ll b/disasm-test/tests/instrmd.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/instrmd.ll
@@ -0,0 +1,33 @@
+define i32 @f(i32 %a0) {
+   %1 = mul i32 %a0, 2
+   %2 = mul i32 %1, 2
+   %3 = mul i32 %2, 2
+   br label %test
+test:
+   %4 = mul i32 %a0, 2, !llvm.loop !3
+   br label %5, !dbg !1
+; <label>:5
+   %6 = mul i32 %4, 2
+   %7 = mul i32 %6, 2
+   %8 = mul i32 %7, 2
+   %9 = mul i32 %8, 2
+   %10 = mul i32 %9, 2
+   %11 = mul i32 %10, 2
+   %12 = mul i32 %11, 2
+   br label %test, !dbg !2, !llvm.loop !3
+}
+
+!llvm.dbg.cu = !{!0}
+!llvm.module.flags = !{!11}
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !7, producer: "hand-made version 1.0", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !10, splitDebugInlining: false, nameTableKind: None)
+!1 = !DILocation(line: 1, column: 1, scope: !5)
+!2 = !DILocation(line: 91, column: 81, scope: !5)
+!3 = distinct !{!3, !1, !4}
+!4 = !DILocation(line: 9, column: 8, scope: !5)
+!5 = distinct !DILexicalBlock(scope: !6, file: !1, line: 32, column: 5)
+!6 = distinct !DISubprogram(name: "test", scope: !7, file: !7, line: 31, type: !9, scopeLine: 31, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !10)
+!7 = !DIFile(filename: "disasm-test/tests/instrmd.ll", directory: "/where/these/tests/are")
+!9 = !DISubroutineType(types: !10)
+!10 = !{}
+!11 = !{i32 2, !"Debug Info Version", i32 3}
diff --git a/disasm-test/tests/metadata.ll b/disasm-test/tests/metadata.ll
deleted file mode 100644
--- a/disasm-test/tests/metadata.ll
+++ /dev/null
@@ -1,10 +0,0 @@
-
-; Some unnamed metadata nodes, which are referenced by the named metadata.
-!0 = !{ !"zero" }
-!1 = !{ !{ !"three" }, !2 }
-!2 = !{ !"one"  }
-
-; A named metadata.
-!thinger = !{ !0, !1, !2 }
-
-@val = global i32 10
diff --git a/disasm-test/tests/opaque-atomicrmw.ll b/disasm-test/tests/opaque-atomicrmw.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-atomicrmw.ll
@@ -0,0 +1,4 @@
+define void @atomicrmw(ptr %a, i32 %i) {
+    %b = atomicrmw add ptr %a, i32 %i acquire
+    ret void
+}
diff --git a/disasm-test/tests/opaque-atomicrmw.pre-llvm15.ll b/disasm-test/tests/opaque-atomicrmw.pre-llvm15.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-atomicrmw.pre-llvm15.ll
@@ -0,0 +1,4 @@
+SKIP_TEST
+
+This test case requires the use of opaque pointers, which are most easily
+usable with LLVM 15 or later.
diff --git a/disasm-test/tests/opaque-call.ll b/disasm-test/tests/opaque-call.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-call.ll
@@ -0,0 +1,11 @@
+define void @f(i32 %x) {
+    ret void
+}
+
+define void @g() {
+    %p = alloca ptr
+    store ptr @f, ptr %p
+    %f = load ptr, ptr %p
+    call void (i32) %f(i32 42)
+    ret void
+}
diff --git a/disasm-test/tests/opaque-call.pre-llvm15.ll b/disasm-test/tests/opaque-call.pre-llvm15.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-call.pre-llvm15.ll
@@ -0,0 +1,4 @@
+SKIP_TEST
+
+This test case requires the use of opaque pointers, which are most easily
+usable with LLVM 15 or later.
diff --git a/disasm-test/tests/opaque-constant-getelementptr.ll b/disasm-test/tests/opaque-constant-getelementptr.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-constant-getelementptr.ll
@@ -0,0 +1,9 @@
+%struct.RT = type { i8, [10 x [20 x i32]], i8 }
+%struct.ST = type { i32, double, %struct.RT }
+
+@.s = private constant %struct.ST zeroinitializer
+
+define ptr @foo() {
+entry:
+  ret ptr getelementptr inbounds (%struct.ST, ptr @.s, i64 1, i32 2, i32 1, i64 5, i64 13)
+}
diff --git a/disasm-test/tests/opaque-constant-getelementptr.pre-llvm15.ll b/disasm-test/tests/opaque-constant-getelementptr.pre-llvm15.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-constant-getelementptr.pre-llvm15.ll
@@ -0,0 +1,4 @@
+SKIP_TEST
+
+This test case requires the use of opaque pointers, which are most easily
+usable with LLVM 15 or later.
diff --git a/disasm-test/tests/opaque-getelementptr.ll b/disasm-test/tests/opaque-getelementptr.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-getelementptr.ll
@@ -0,0 +1,8 @@
+%struct.RT = type { i8, [10 x [20 x i32]], i8 }
+%struct.ST = type { i32, double, %struct.RT }
+
+define ptr @foo(ptr %s) {
+entry:
+  %arrayidx = getelementptr inbounds %struct.ST, ptr %s, i64 1, i32 2, i32 1, i64 5, i64 13
+  ret ptr %arrayidx
+}
diff --git a/disasm-test/tests/opaque-getelementptr.pre-llvm15.ll b/disasm-test/tests/opaque-getelementptr.pre-llvm15.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/opaque-getelementptr.pre-llvm15.ll
@@ -0,0 +1,4 @@
+SKIP_TEST
+
+This test case requires the use of opaque pointers, which are most easily
+usable with LLVM 15 or later.
diff --git a/disasm-test/tests/p0.ll b/disasm-test/tests/p0.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/p0.ll
@@ -0,0 +1,533 @@
+; ModuleID = 'p0.bc'
+source_filename = "disasm-test/tests/p0.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+%struct.broker = type { [10 x %struct.message], i8, i8 }
+%struct.message = type { i16, i8*, i8 }
+
+@broker = external global %struct.broker, align 8
+@signal = external global [200 x i8], align 16
+@__const.main.msg = private unnamed_addr constant %struct.message { i16 0, i8* getelementptr inbounds ([200 x i8], [200 x i8]* @signal, i32 0, i32 0), i8 -56 }, align 8
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @broker_init(%struct.broker* %0) #0 !dbg !21 {
+  %2 = alloca %struct.broker*, align 8
+  store %struct.broker* %0, %struct.broker** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.broker** %2, metadata !44, metadata !DIExpression()), !dbg !45
+  %3 = load %struct.broker*, %struct.broker** %2, align 8, !dbg !46
+  %4 = getelementptr inbounds %struct.broker, %struct.broker* %3, i32 0, i32 2, !dbg !47
+  store i8 0, i8* %4, align 1, !dbg !48
+  ret void, !dbg !49
+}
+
+; Function Attrs: nounwind readnone speculatable willreturn
+declare void @llvm.dbg.declare(metadata, metadata, metadata) #1
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @broker_run(%struct.broker* %0) #0 !dbg !50 {
+  %2 = alloca %struct.broker*, align 8
+  %3 = alloca i8, align 1
+  store %struct.broker* %0, %struct.broker** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.broker** %2, metadata !51, metadata !DIExpression()), !dbg !52
+  call void @llvm.dbg.declare(metadata i8* %3, metadata !53, metadata !DIExpression()), !dbg !55
+  store i8 0, i8* %3, align 1, !dbg !55
+  br label %4, !dbg !56
+
+4:                                                ; preds = %18, %1
+  %5 = load i8, i8* %3, align 1, !dbg !57
+  %6 = zext i8 %5 to i32, !dbg !57
+  %7 = load %struct.broker*, %struct.broker** %2, align 8, !dbg !59
+  %8 = getelementptr inbounds %struct.broker, %struct.broker* %7, i32 0, i32 2, !dbg !60
+  %9 = load i8, i8* %8, align 1, !dbg !60
+  %10 = zext i8 %9 to i32, !dbg !59
+  %11 = icmp slt i32 %6, %10, !dbg !61
+  br i1 %11, label %12, label %21, !dbg !62
+
+12:                                               ; preds = %4
+  %13 = load %struct.broker*, %struct.broker** %2, align 8, !dbg !63
+  %14 = getelementptr inbounds %struct.broker, %struct.broker* %13, i32 0, i32 0, !dbg !65
+  %15 = load i8, i8* %3, align 1, !dbg !66
+  %16 = zext i8 %15 to i64, !dbg !63
+  %17 = getelementptr [10 x %struct.message], [10 x %struct.message]* %14, i64 0, i64 %16, !dbg !63
+  call void @sp_receive(%struct.message* %17), !dbg !67
+  br label %18, !dbg !68
+
+18:                                               ; preds = %12
+  %19 = load i8, i8* %3, align 1, !dbg !69
+  %20 = add i8 %19, 1, !dbg !69
+  store i8 %20, i8* %3, align 1, !dbg !69
+  br label %4, !dbg !70, !llvm.loop !71
+
+21:                                               ; preds = %4
+  ret void, !dbg !73
+}
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @sp_receive(%struct.message* %0) #0 !dbg !74 {
+  %2 = alloca %struct.message*, align 8
+  store %struct.message* %0, %struct.message** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.message** %2, metadata !78, metadata !DIExpression()), !dbg !79
+  %3 = load %struct.message*, %struct.message** %2, align 8, !dbg !80
+  %4 = getelementptr inbounds %struct.message, %struct.message* %3, i32 0, i32 0, !dbg !81
+  %5 = load i16, i16* %4, align 8, !dbg !81
+  %6 = zext i16 %5 to i32, !dbg !80
+  switch i32 %6, label %28 [
+    i32 0, label %7
+    i32 1, label %14
+    i32 2, label %21
+  ], !dbg !82
+
+7:                                                ; preds = %1
+  %8 = load %struct.message*, %struct.message** %2, align 8, !dbg !83
+  %9 = getelementptr inbounds %struct.message, %struct.message* %8, i32 0, i32 1, !dbg !85
+  %10 = load i8*, i8** %9, align 8, !dbg !85
+  %11 = load %struct.message*, %struct.message** %2, align 8, !dbg !86
+  %12 = getelementptr inbounds %struct.message, %struct.message* %11, i32 0, i32 2, !dbg !87
+  %13 = load i8, i8* %12, align 8, !dbg !87
+  call void @sp_clear(i8* %10, i8 zeroext %13), !dbg !88
+  br label %29, !dbg !89
+
+14:                                               ; preds = %1
+  %15 = load %struct.message*, %struct.message** %2, align 8, !dbg !90
+  %16 = getelementptr inbounds %struct.message, %struct.message* %15, i32 0, i32 1, !dbg !91
+  %17 = load i8*, i8** %16, align 8, !dbg !91
+  %18 = load %struct.message*, %struct.message** %2, align 8, !dbg !92
+  %19 = getelementptr inbounds %struct.message, %struct.message* %18, i32 0, i32 2, !dbg !93
+  %20 = load i8, i8* %19, align 8, !dbg !93
+  call void @sp_add_five(i8* %17, i8 zeroext %20), !dbg !94
+  br label %29, !dbg !95
+
+21:                                               ; preds = %1
+  %22 = load %struct.message*, %struct.message** %2, align 8, !dbg !96
+  %23 = getelementptr inbounds %struct.message, %struct.message* %22, i32 0, i32 1, !dbg !97
+  %24 = load i8*, i8** %23, align 8, !dbg !97
+  %25 = load %struct.message*, %struct.message** %2, align 8, !dbg !98
+  %26 = getelementptr inbounds %struct.message, %struct.message* %25, i32 0, i32 2, !dbg !99
+  %27 = load i8, i8* %26, align 8, !dbg !99
+  call void @sp_double(i8* %24, i8 zeroext %27), !dbg !100
+  br label %29, !dbg !101
+
+28:                                               ; preds = %1
+  br label %29, !dbg !102
+
+29:                                               ; preds = %28, %21, %14, %7
+  ret void, !dbg !103
+}
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @broker_publish(%struct.broker* %0, %struct.message* %1) #0 !dbg !104 {
+  %3 = alloca %struct.broker*, align 8
+  %4 = alloca %struct.message*, align 8
+  store %struct.broker* %0, %struct.broker** %3, align 8
+  call void @llvm.dbg.declare(metadata %struct.broker** %3, metadata !107, metadata !DIExpression()), !dbg !108
+  store %struct.message* %1, %struct.message** %4, align 8
+  call void @llvm.dbg.declare(metadata %struct.message** %4, metadata !109, metadata !DIExpression()), !dbg !110
+  %5 = load %struct.broker*, %struct.broker** %3, align 8, !dbg !111
+  %6 = getelementptr inbounds %struct.broker, %struct.broker* %5, i32 0, i32 0, !dbg !112
+  %7 = load %struct.broker*, %struct.broker** %3, align 8, !dbg !113
+  %8 = getelementptr inbounds %struct.broker, %struct.broker* %7, i32 0, i32 2, !dbg !114
+  %9 = load i8, i8* %8, align 1, !dbg !115
+  %10 = add i8 %9, 1, !dbg !115
+  store i8 %10, i8* %8, align 1, !dbg !115
+  %11 = zext i8 %9 to i64, !dbg !111
+  %12 = getelementptr [10 x %struct.message], [10 x %struct.message]* %6, i64 0, i64 %11, !dbg !111
+  %13 = load %struct.message*, %struct.message** %4, align 8, !dbg !116
+  %14 = bitcast %struct.message* %12 to i8*, !dbg !117
+  %15 = bitcast %struct.message* %13 to i8*, !dbg !117
+  call void @llvm.memcpy.p0i8.p0i8.i64(i8* align 8 %14, i8* align 8 %15, i64 24, i1 false), !dbg !117
+  ret void, !dbg !118
+}
+
+; Function Attrs: argmemonly nounwind willreturn
+declare void @llvm.memcpy.p0i8.p0i8.i64(i8* noalias nocapture writeonly, i8* noalias nocapture readonly, i64, i1 immarg) #2
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @sp_clear(i8* %0, i8 zeroext %1) #0 !dbg !119 {
+  %3 = alloca i8*, align 8
+  %4 = alloca i8, align 1
+  %5 = alloca i8, align 1
+  store i8* %0, i8** %3, align 8
+  call void @llvm.dbg.declare(metadata i8** %3, metadata !122, metadata !DIExpression()), !dbg !123
+  store i8 %1, i8* %4, align 1
+  call void @llvm.dbg.declare(metadata i8* %4, metadata !124, metadata !DIExpression()), !dbg !125
+  call void @llvm.dbg.declare(metadata i8* %5, metadata !126, metadata !DIExpression()), !dbg !128
+  store i8 0, i8* %5, align 1, !dbg !128
+  br label %6, !dbg !129
+
+6:                                                ; preds = %17, %2
+  %7 = load i8, i8* %5, align 1, !dbg !130
+  %8 = zext i8 %7 to i32, !dbg !130
+  %9 = load i8, i8* %4, align 1, !dbg !132
+  %10 = zext i8 %9 to i32, !dbg !132
+  %11 = icmp slt i32 %8, %10, !dbg !133
+  br i1 %11, label %12, label %20, !dbg !134
+
+12:                                               ; preds = %6
+  %13 = load i8*, i8** %3, align 8, !dbg !135
+  %14 = load i8, i8* %5, align 1, !dbg !137
+  %15 = zext i8 %14 to i64, !dbg !135
+  %16 = getelementptr i8, i8* %13, i64 %15, !dbg !135
+  store i8 0, i8* %16, align 1, !dbg !138
+  br label %17, !dbg !139
+
+17:                                               ; preds = %12
+  %18 = load i8, i8* %5, align 1, !dbg !140
+  %19 = add i8 %18, 1, !dbg !140
+  store i8 %19, i8* %5, align 1, !dbg !140
+  br label %6, !dbg !141, !llvm.loop !142
+
+20:                                               ; preds = %6
+  ret void, !dbg !144
+}
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @sp_double(i8* %0, i8 zeroext %1) #0 !dbg !145 {
+  %3 = alloca i8*, align 8
+  %4 = alloca i8, align 1
+  %5 = alloca i8, align 1
+  store i8* %0, i8** %3, align 8
+  call void @llvm.dbg.declare(metadata i8** %3, metadata !146, metadata !DIExpression()), !dbg !147
+  store i8 %1, i8* %4, align 1
+  call void @llvm.dbg.declare(metadata i8* %4, metadata !148, metadata !DIExpression()), !dbg !149
+  call void @llvm.dbg.declare(metadata i8* %5, metadata !150, metadata !DIExpression()), !dbg !152
+  store i8 0, i8* %5, align 1, !dbg !152
+  br label %6, !dbg !153
+
+6:                                                ; preds = %21, %2
+  %7 = load i8, i8* %5, align 1, !dbg !154
+  %8 = zext i8 %7 to i32, !dbg !154
+  %9 = load i8, i8* %4, align 1, !dbg !156
+  %10 = zext i8 %9 to i32, !dbg !156
+  %11 = icmp slt i32 %8, %10, !dbg !157
+  br i1 %11, label %12, label %24, !dbg !158
+
+12:                                               ; preds = %6
+  %13 = load i8*, i8** %3, align 8, !dbg !159
+  %14 = load i8, i8* %5, align 1, !dbg !161
+  %15 = zext i8 %14 to i64, !dbg !159
+  %16 = getelementptr i8, i8* %13, i64 %15, !dbg !159
+  %17 = load i8, i8* %16, align 1, !dbg !162
+  %18 = zext i8 %17 to i32, !dbg !162
+  %19 = mul i32 %18, 2, !dbg !162
+  %20 = trunc i32 %19 to i8, !dbg !162
+  store i8 %20, i8* %16, align 1, !dbg !162
+  br label %21, !dbg !163
+
+21:                                               ; preds = %12
+  %22 = load i8, i8* %5, align 1, !dbg !164
+  %23 = add i8 %22, 1, !dbg !164
+  store i8 %23, i8* %5, align 1, !dbg !164
+  br label %6, !dbg !165, !llvm.loop !166
+
+24:                                               ; preds = %6
+  ret void, !dbg !168
+}
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @sp_add_five(i8* %0, i8 zeroext %1) #0 !dbg !169 {
+  %3 = alloca i8*, align 8
+  %4 = alloca i8, align 1
+  %5 = alloca i8, align 1
+  store i8* %0, i8** %3, align 8
+  call void @llvm.dbg.declare(metadata i8** %3, metadata !170, metadata !DIExpression()), !dbg !171
+  store i8 %1, i8* %4, align 1
+  call void @llvm.dbg.declare(metadata i8* %4, metadata !172, metadata !DIExpression()), !dbg !173
+  call void @llvm.dbg.declare(metadata i8* %5, metadata !174, metadata !DIExpression()), !dbg !176
+  store i8 0, i8* %5, align 1, !dbg !176
+  br label %6, !dbg !177
+
+6:                                                ; preds = %21, %2
+  %7 = load i8, i8* %5, align 1, !dbg !178
+  %8 = zext i8 %7 to i32, !dbg !178
+  %9 = load i8, i8* %4, align 1, !dbg !180
+  %10 = zext i8 %9 to i32, !dbg !180
+  %11 = icmp slt i32 %8, %10, !dbg !181
+  br i1 %11, label %12, label %24, !dbg !182
+
+12:                                               ; preds = %6
+  %13 = load i8*, i8** %3, align 8, !dbg !183
+  %14 = load i8, i8* %5, align 1, !dbg !185
+  %15 = zext i8 %14 to i64, !dbg !183
+  %16 = getelementptr i8, i8* %13, i64 %15, !dbg !183
+  %17 = load i8, i8* %16, align 1, !dbg !186
+  %18 = zext i8 %17 to i32, !dbg !186
+  %19 = add i32 %18, 5, !dbg !186
+  %20 = trunc i32 %19 to i8, !dbg !186
+  store i8 %20, i8* %16, align 1, !dbg !186
+  br label %21, !dbg !187
+
+21:                                               ; preds = %12
+  %22 = load i8, i8* %5, align 1, !dbg !188
+  %23 = add i8 %22, 1, !dbg !188
+  store i8 %23, i8* %5, align 1, !dbg !188
+  br label %6, !dbg !189, !llvm.loop !190
+
+24:                                               ; preds = %6
+  ret void, !dbg !192
+}
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define void @sp_send(i8* %0) #0 !dbg !193 {
+  %2 = alloca i8*, align 8
+  %3 = alloca %struct.message, align 8
+  store i8* %0, i8** %2, align 8
+  call void @llvm.dbg.declare(metadata i8** %2, metadata !196, metadata !DIExpression()), !dbg !197
+  call void @llvm.dbg.declare(metadata %struct.message* %3, metadata !198, metadata !DIExpression()), !dbg !199
+  %4 = getelementptr inbounds %struct.message, %struct.message* %3, i32 0, i32 0, !dbg !200
+  store i16 0, i16* %4, align 8, !dbg !200
+  %5 = getelementptr inbounds %struct.message, %struct.message* %3, i32 0, i32 1, !dbg !200
+  %6 = load i8*, i8** %2, align 8, !dbg !201
+  store i8* %6, i8** %5, align 8, !dbg !200
+  %7 = getelementptr inbounds %struct.message, %struct.message* %3, i32 0, i32 2, !dbg !200
+  store i8 -56, i8* %7, align 8, !dbg !200
+  call void @broker_publish(%struct.broker* @broker, %struct.message* %3), !dbg !202
+  ret void, !dbg !203
+}
+
+; Function Attrs: noinline nounwind optnone sspstrong uwtable
+define i32 @main() #0 !dbg !204 {
+  %1 = alloca %struct.message, align 8
+  call void @broker_init(%struct.broker* @broker), !dbg !208
+  call void @llvm.dbg.declare(metadata %struct.message* %1, metadata !209, metadata !DIExpression()), !dbg !210
+  %2 = bitcast %struct.message* %1 to i8*, !dbg !210
+  call void @llvm.memcpy.p0i8.p0i8.i64(i8* align 8 %2, i8* align 8 bitcast (%struct.message* @__const.main.msg to i8*), i64 24, i1 false), !dbg !210
+  call void @broker_publish(%struct.broker* @broker, %struct.message* %1), !dbg !211
+  %3 = getelementptr inbounds %struct.message, %struct.message* %1, i32 0, i32 0, !dbg !212
+  store i16 1, i16* %3, align 8, !dbg !213
+  call void @broker_publish(%struct.broker* @broker, %struct.message* %1), !dbg !214
+  %4 = getelementptr inbounds %struct.message, %struct.message* %1, i32 0, i32 0, !dbg !215
+  store i16 2, i16* %4, align 8, !dbg !216
+  call void @broker_publish(%struct.broker* @broker, %struct.message* %1), !dbg !217
+  call void @broker_run(%struct.broker* @broker), !dbg !218
+  ret i32 0, !dbg !219
+}
+
+attributes #0 = { noinline nounwind optnone sspstrong uwtable "correctly-rounded-divide-sqrt-fp-math"="false" "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="true" "stack-protector-buffer-size"="4" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "unsafe-fp-math"="false" "use-soft-float"="false" }
+attributes #1 = { nounwind readnone speculatable willreturn }
+attributes #2 = { argmemonly nounwind willreturn }
+
+!llvm.dbg.cu = !{!0}
+!llvm.module.flags = !{!16, !17, !18, !19}
+!llvm.ident = !{!20}
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 11.1.0", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !2, globals: !3, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "disasm-test/tests/p0.c", directory: "/home/kquick/work/RISE/llvm-regr2")
+!2 = !{}
+!3 = !{!4, !12, !14}
+!4 = !DIGlobalVariableExpression(var: !5, expr: !DIExpression(DW_OP_constu, 0, DW_OP_stack_value))
+!5 = distinct !DIGlobalVariable(name: "MSG_TYPE_CLEAR", scope: !0, file: !1, line: 7, type: !6, isLocal: true, isDefinition: true)
+!6 = !DIDerivedType(tag: DW_TAG_const_type, baseType: !7)
+!7 = !DIDerivedType(tag: DW_TAG_typedef, name: "uint16_t", file: !8, line: 25, baseType: !9)
+!8 = !DIFile(filename: "/nix/store/rfw51dqr3qn7b6fjy8hmx6f0x3hfwbx6-glibc-2.37-8-dev/include/bits/stdint-uintn.h", directory: "")
+!9 = !DIDerivedType(tag: DW_TAG_typedef, name: "__uint16_t", file: !10, line: 40, baseType: !11)
+!10 = !DIFile(filename: "/nix/store/rfw51dqr3qn7b6fjy8hmx6f0x3hfwbx6-glibc-2.37-8-dev/include/bits/types.h", directory: "")
+!11 = !DIBasicType(name: "unsigned short", size: 16, encoding: DW_ATE_unsigned)
+!12 = !DIGlobalVariableExpression(var: !13, expr: !DIExpression(DW_OP_constu, 1, DW_OP_stack_value))
+!13 = distinct !DIGlobalVariable(name: "MSG_TYPE_ADD_FIVE", scope: !0, file: !1, line: 8, type: !6, isLocal: true, isDefinition: true)
+!14 = !DIGlobalVariableExpression(var: !15, expr: !DIExpression(DW_OP_constu, 2, DW_OP_stack_value))
+!15 = distinct !DIGlobalVariable(name: "MSG_TYPE_DOUBLE", scope: !0, file: !1, line: 9, type: !6, isLocal: true, isDefinition: true)
+!16 = !{i32 7, !"Dwarf Version", i32 4}
+!17 = !{i32 2, !"Debug Info Version", i32 3}
+!18 = !{i32 1, !"wchar_size", i32 4}
+!19 = !{i32 7, !"PIC Level", i32 2}
+!20 = !{!"clang version 11.1.0"}
+!21 = distinct !DISubprogram(name: "broker_init", scope: !1, file: !1, line: 29, type: !22, scopeLine: 29, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!22 = !DISubroutineType(types: !23)
+!23 = !{null, !24}
+!24 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !25, size: 64)
+!25 = !DIDerivedType(tag: DW_TAG_typedef, name: "broker_t", file: !1, line: 23, baseType: !26)
+!26 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "broker", file: !1, line: 19, size: 1984, elements: !27)
+!27 = !{!28, !42, !43}
+!28 = !DIDerivedType(tag: DW_TAG_member, name: "msgs", scope: !26, file: !1, line: 20, baseType: !29, size: 1920)
+!29 = !DICompositeType(tag: DW_TAG_array_type, baseType: !30, size: 1920, elements: !40)
+!30 = !DIDerivedType(tag: DW_TAG_typedef, name: "message_t", file: !1, line: 17, baseType: !31)
+!31 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "message", file: !1, line: 13, size: 192, elements: !32)
+!32 = !{!33, !34, !39}
+!33 = !DIDerivedType(tag: DW_TAG_member, name: "type", scope: !31, file: !1, line: 14, baseType: !7, size: 16)
+!34 = !DIDerivedType(tag: DW_TAG_member, name: "payload", scope: !31, file: !1, line: 15, baseType: !35, size: 64, offset: 64)
+!35 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !36, size: 64)
+!36 = !DIDerivedType(tag: DW_TAG_typedef, name: "uint8_t", file: !8, line: 24, baseType: !37)
+!37 = !DIDerivedType(tag: DW_TAG_typedef, name: "__uint8_t", file: !10, line: 38, baseType: !38)
+!38 = !DIBasicType(name: "unsigned char", size: 8, encoding: DW_ATE_unsigned_char)
+!39 = !DIDerivedType(tag: DW_TAG_member, name: "payload_len", scope: !31, file: !1, line: 16, baseType: !36, size: 8, offset: 128)
+!40 = !{!41}
+!41 = !DISubrange(count: 10)
+!42 = !DIDerivedType(tag: DW_TAG_member, name: "msg_idx", scope: !26, file: !1, line: 21, baseType: !36, size: 8, offset: 1920)
+!43 = !DIDerivedType(tag: DW_TAG_member, name: "num_messages", scope: !26, file: !1, line: 22, baseType: !36, size: 8, offset: 1928)
+!44 = !DILocalVariable(name: "broker", arg: 1, scope: !21, file: !1, line: 29, type: !24)
+!45 = !DILocation(line: 29, column: 29, scope: !21)
+!46 = !DILocation(line: 30, column: 5, scope: !21)
+!47 = !DILocation(line: 30, column: 13, scope: !21)
+!48 = !DILocation(line: 30, column: 26, scope: !21)
+!49 = !DILocation(line: 31, column: 1, scope: !21)
+!50 = distinct !DISubprogram(name: "broker_run", scope: !1, file: !1, line: 33, type: !22, scopeLine: 33, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!51 = !DILocalVariable(name: "broker", arg: 1, scope: !50, file: !1, line: 33, type: !24)
+!52 = !DILocation(line: 33, column: 28, scope: !50)
+!53 = !DILocalVariable(name: "i", scope: !54, file: !1, line: 34, type: !36)
+!54 = distinct !DILexicalBlock(scope: !50, file: !1, line: 34, column: 5)
+!55 = !DILocation(line: 34, column: 18, scope: !54)
+!56 = !DILocation(line: 34, column: 10, scope: !54)
+!57 = !DILocation(line: 34, column: 25, scope: !58)
+!58 = distinct !DILexicalBlock(scope: !54, file: !1, line: 34, column: 5)
+!59 = !DILocation(line: 34, column: 29, scope: !58)
+!60 = !DILocation(line: 34, column: 37, scope: !58)
+!61 = !DILocation(line: 34, column: 27, scope: !58)
+!62 = !DILocation(line: 34, column: 5, scope: !54)
+!63 = !DILocation(line: 36, column: 22, scope: !64)
+!64 = distinct !DILexicalBlock(scope: !58, file: !1, line: 34, column: 56)
+!65 = !DILocation(line: 36, column: 30, scope: !64)
+!66 = !DILocation(line: 36, column: 35, scope: !64)
+!67 = !DILocation(line: 36, column: 9, scope: !64)
+!68 = !DILocation(line: 37, column: 5, scope: !64)
+!69 = !DILocation(line: 34, column: 52, scope: !58)
+!70 = !DILocation(line: 34, column: 5, scope: !58)
+!71 = distinct !{!71, !62, !72}
+!72 = !DILocation(line: 37, column: 5, scope: !54)
+!73 = !DILocation(line: 38, column: 1, scope: !50)
+!74 = distinct !DISubprogram(name: "sp_receive", scope: !1, file: !1, line: 67, type: !75, scopeLine: 67, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!75 = !DISubroutineType(types: !76)
+!76 = !{null, !77}
+!77 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !30, size: 64)
+!78 = !DILocalVariable(name: "msg", arg: 1, scope: !74, file: !1, line: 67, type: !77)
+!79 = !DILocation(line: 67, column: 29, scope: !74)
+!80 = !DILocation(line: 68, column: 13, scope: !74)
+!81 = !DILocation(line: 68, column: 18, scope: !74)
+!82 = !DILocation(line: 68, column: 5, scope: !74)
+!83 = !DILocation(line: 70, column: 22, scope: !84)
+!84 = distinct !DILexicalBlock(scope: !74, file: !1, line: 68, column: 24)
+!85 = !DILocation(line: 70, column: 27, scope: !84)
+!86 = !DILocation(line: 70, column: 36, scope: !84)
+!87 = !DILocation(line: 70, column: 41, scope: !84)
+!88 = !DILocation(line: 70, column: 13, scope: !84)
+!89 = !DILocation(line: 71, column: 13, scope: !84)
+!90 = !DILocation(line: 73, column: 25, scope: !84)
+!91 = !DILocation(line: 73, column: 30, scope: !84)
+!92 = !DILocation(line: 73, column: 39, scope: !84)
+!93 = !DILocation(line: 73, column: 44, scope: !84)
+!94 = !DILocation(line: 73, column: 13, scope: !84)
+!95 = !DILocation(line: 74, column: 13, scope: !84)
+!96 = !DILocation(line: 76, column: 23, scope: !84)
+!97 = !DILocation(line: 76, column: 28, scope: !84)
+!98 = !DILocation(line: 76, column: 37, scope: !84)
+!99 = !DILocation(line: 76, column: 42, scope: !84)
+!100 = !DILocation(line: 76, column: 13, scope: !84)
+!101 = !DILocation(line: 77, column: 13, scope: !84)
+!102 = !DILocation(line: 79, column: 13, scope: !84)
+!103 = !DILocation(line: 81, column: 1, scope: !74)
+!104 = distinct !DISubprogram(name: "broker_publish", scope: !1, file: !1, line: 40, type: !105, scopeLine: 40, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!105 = !DISubroutineType(types: !106)
+!106 = !{null, !24, !77}
+!107 = !DILocalVariable(name: "broker", arg: 1, scope: !104, file: !1, line: 40, type: !24)
+!108 = !DILocation(line: 40, column: 32, scope: !104)
+!109 = !DILocalVariable(name: "msg", arg: 2, scope: !104, file: !1, line: 40, type: !77)
+!110 = !DILocation(line: 40, column: 52, scope: !104)
+!111 = !DILocation(line: 41, column: 5, scope: !104)
+!112 = !DILocation(line: 41, column: 13, scope: !104)
+!113 = !DILocation(line: 41, column: 18, scope: !104)
+!114 = !DILocation(line: 41, column: 26, scope: !104)
+!115 = !DILocation(line: 41, column: 38, scope: !104)
+!116 = !DILocation(line: 41, column: 45, scope: !104)
+!117 = !DILocation(line: 41, column: 44, scope: !104)
+!118 = !DILocation(line: 42, column: 1, scope: !104)
+!119 = distinct !DISubprogram(name: "sp_clear", scope: !1, file: !1, line: 44, type: !120, scopeLine: 44, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!120 = !DISubroutineType(types: !121)
+!121 = !{null, !35, !36}
+!122 = !DILocalVariable(name: "signal", arg: 1, scope: !119, file: !1, line: 44, type: !35)
+!123 = !DILocation(line: 44, column: 25, scope: !119)
+!124 = !DILocalVariable(name: "signal_len", arg: 2, scope: !119, file: !1, line: 44, type: !36)
+!125 = !DILocation(line: 44, column: 41, scope: !119)
+!126 = !DILocalVariable(name: "i", scope: !127, file: !1, line: 45, type: !36)
+!127 = distinct !DILexicalBlock(scope: !119, file: !1, line: 45, column: 5)
+!128 = !DILocation(line: 45, column: 18, scope: !127)
+!129 = !DILocation(line: 45, column: 10, scope: !127)
+!130 = !DILocation(line: 45, column: 25, scope: !131)
+!131 = distinct !DILexicalBlock(scope: !127, file: !1, line: 45, column: 5)
+!132 = !DILocation(line: 45, column: 29, scope: !131)
+!133 = !DILocation(line: 45, column: 27, scope: !131)
+!134 = !DILocation(line: 45, column: 5, scope: !127)
+!135 = !DILocation(line: 46, column: 9, scope: !136)
+!136 = distinct !DILexicalBlock(scope: !131, file: !1, line: 45, column: 46)
+!137 = !DILocation(line: 46, column: 16, scope: !136)
+!138 = !DILocation(line: 46, column: 19, scope: !136)
+!139 = !DILocation(line: 47, column: 5, scope: !136)
+!140 = !DILocation(line: 45, column: 42, scope: !131)
+!141 = !DILocation(line: 45, column: 5, scope: !131)
+!142 = distinct !{!142, !134, !143}
+!143 = !DILocation(line: 47, column: 5, scope: !127)
+!144 = !DILocation(line: 48, column: 1, scope: !119)
+!145 = distinct !DISubprogram(name: "sp_double", scope: !1, file: !1, line: 50, type: !120, scopeLine: 50, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!146 = !DILocalVariable(name: "signal", arg: 1, scope: !145, file: !1, line: 50, type: !35)
+!147 = !DILocation(line: 50, column: 26, scope: !145)
+!148 = !DILocalVariable(name: "signal_len", arg: 2, scope: !145, file: !1, line: 50, type: !36)
+!149 = !DILocation(line: 50, column: 42, scope: !145)
+!150 = !DILocalVariable(name: "i", scope: !151, file: !1, line: 51, type: !36)
+!151 = distinct !DILexicalBlock(scope: !145, file: !1, line: 51, column: 5)
+!152 = !DILocation(line: 51, column: 18, scope: !151)
+!153 = !DILocation(line: 51, column: 10, scope: !151)
+!154 = !DILocation(line: 51, column: 25, scope: !155)
+!155 = distinct !DILexicalBlock(scope: !151, file: !1, line: 51, column: 5)
+!156 = !DILocation(line: 51, column: 29, scope: !155)
+!157 = !DILocation(line: 51, column: 27, scope: !155)
+!158 = !DILocation(line: 51, column: 5, scope: !151)
+!159 = !DILocation(line: 52, column: 9, scope: !160)
+!160 = distinct !DILexicalBlock(scope: !155, file: !1, line: 51, column: 46)
+!161 = !DILocation(line: 52, column: 16, scope: !160)
+!162 = !DILocation(line: 52, column: 19, scope: !160)
+!163 = !DILocation(line: 53, column: 5, scope: !160)
+!164 = !DILocation(line: 51, column: 42, scope: !155)
+!165 = !DILocation(line: 51, column: 5, scope: !155)
+!166 = distinct !{!166, !158, !167}
+!167 = !DILocation(line: 53, column: 5, scope: !151)
+!168 = !DILocation(line: 54, column: 1, scope: !145)
+!169 = distinct !DISubprogram(name: "sp_add_five", scope: !1, file: !1, line: 56, type: !120, scopeLine: 56, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!170 = !DILocalVariable(name: "signal", arg: 1, scope: !169, file: !1, line: 56, type: !35)
+!171 = !DILocation(line: 56, column: 28, scope: !169)
+!172 = !DILocalVariable(name: "signal_len", arg: 2, scope: !169, file: !1, line: 56, type: !36)
+!173 = !DILocation(line: 56, column: 44, scope: !169)
+!174 = !DILocalVariable(name: "i", scope: !175, file: !1, line: 57, type: !36)
+!175 = distinct !DILexicalBlock(scope: !169, file: !1, line: 57, column: 5)
+!176 = !DILocation(line: 57, column: 18, scope: !175)
+!177 = !DILocation(line: 57, column: 10, scope: !175)
+!178 = !DILocation(line: 57, column: 25, scope: !179)
+!179 = distinct !DILexicalBlock(scope: !175, file: !1, line: 57, column: 5)
+!180 = !DILocation(line: 57, column: 29, scope: !179)
+!181 = !DILocation(line: 57, column: 27, scope: !179)
+!182 = !DILocation(line: 57, column: 5, scope: !175)
+!183 = !DILocation(line: 58, column: 9, scope: !184)
+!184 = distinct !DILexicalBlock(scope: !179, file: !1, line: 57, column: 46)
+!185 = !DILocation(line: 58, column: 16, scope: !184)
+!186 = !DILocation(line: 58, column: 19, scope: !184)
+!187 = !DILocation(line: 59, column: 5, scope: !184)
+!188 = !DILocation(line: 57, column: 42, scope: !179)
+!189 = !DILocation(line: 57, column: 5, scope: !179)
+!190 = distinct !{!190, !182, !191}
+!191 = !DILocation(line: 59, column: 5, scope: !175)
+!192 = !DILocation(line: 60, column: 1, scope: !169)
+!193 = distinct !DISubprogram(name: "sp_send", scope: !1, file: !1, line: 62, type: !194, scopeLine: 62, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!194 = !DISubroutineType(types: !195)
+!195 = !{null, !35}
+!196 = !DILocalVariable(name: "signal", arg: 1, scope: !193, file: !1, line: 62, type: !35)
+!197 = !DILocation(line: 62, column: 24, scope: !193)
+!198 = !DILocalVariable(name: "msg", scope: !193, file: !1, line: 63, type: !30)
+!199 = !DILocation(line: 63, column: 15, scope: !193)
+!200 = !DILocation(line: 63, column: 21, scope: !193)
+!201 = !DILocation(line: 63, column: 38, scope: !193)
+!202 = !DILocation(line: 64, column: 5, scope: !193)
+!203 = !DILocation(line: 65, column: 1, scope: !193)
+!204 = distinct !DISubprogram(name: "main", scope: !1, file: !1, line: 83, type: !205, scopeLine: 83, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!205 = !DISubroutineType(types: !206)
+!206 = !{!207}
+!207 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!208 = !DILocation(line: 84, column: 5, scope: !204)
+!209 = !DILocalVariable(name: "msg", scope: !204, file: !1, line: 86, type: !30)
+!210 = !DILocation(line: 86, column: 15, scope: !204)
+!211 = !DILocation(line: 87, column: 5, scope: !204)
+!212 = !DILocation(line: 88, column: 9, scope: !204)
+!213 = !DILocation(line: 88, column: 14, scope: !204)
+!214 = !DILocation(line: 89, column: 5, scope: !204)
+!215 = !DILocation(line: 90, column: 9, scope: !204)
+!216 = !DILocation(line: 90, column: 14, scope: !204)
+!217 = !DILocation(line: 91, column: 5, scope: !204)
+!218 = !DILocation(line: 93, column: 5, scope: !204)
+!219 = !DILocation(line: 94, column: 1, scope: !204)
diff --git a/disasm-test/tests/poison.ll b/disasm-test/tests/poison.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/poison.ll
@@ -0,0 +1,3 @@
+define double @f(i32 %x) {
+  ret double poison
+}
diff --git a/disasm-test/tests/poison.pre-llvm12.ll b/disasm-test/tests/poison.pre-llvm12.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/poison.pre-llvm12.ll
@@ -0,0 +1,1 @@
+SKIP_TEST
diff --git a/disasm-test/tests/printf_frexpl.ll b/disasm-test/tests/printf_frexpl.ll
deleted file mode 100644
--- a/disasm-test/tests/printf_frexpl.ll
+++ /dev/null
@@ -1,60 +0,0 @@
-; ModuleID = 'lib/printf-frexpl.c'
-target datalayout = "e-m:e-i64:64-f80:128-n8:16:32:64-S128"
-target triple = "x86_64-unknown-linux-gnu"
-
-; Function Attrs: nounwind uwtable
-define x86_fp80 @printf_frexpl(x86_fp80 %x, i32* nocapture %expptr) #0 {
-  %exponent = alloca i32, align 4
-  %_cw = alloca i16, align 2
-  %_ncw = alloca i16, align 2
-  %_ncw1 = alloca i16, align 2
-  call void asm sideeffect "fnstcw $0", "=*m,~{dirflag},~{fpsr},~{flags}"(i16* %_cw) #2, !srcloc !1
-  %1 = load i16* %_cw, align 2, !tbaa !2
-  %2 = or i16 %1, 768
-  store i16 %2, i16* %_ncw, align 2, !tbaa !2
-  call void asm sideeffect "fldcw $0", "*m,~{dirflag},~{fpsr},~{flags}"(i16* %_ncw) #2, !srcloc !6
-  %3 = call x86_fp80 @frexpl(x86_fp80 %x, i32* %exponent) #2
-  %4 = fadd x86_fp80 %3, %3
-  %5 = load i32* %exponent, align 4, !tbaa !7
-  %6 = add nsw i32 %5, -1
-  store i32 %6, i32* %exponent, align 4, !tbaa !7
-  %7 = icmp slt i32 %5, -16381
-  br i1 %7, label %8, label %11
-
-; <label>:8                                       ; preds = %0
-  %9 = add nsw i32 %5, 16381
-  %10 = call x86_fp80 @ldexpl(x86_fp80 %4, i32 %9) #2
-  store i32 -16382, i32* %exponent, align 4, !tbaa !7
-  br label %11
-
-; <label>:11                                      ; preds = %8, %0
-  %12 = phi i32 [ -16382, %8 ], [ %6, %0 ]
-  %.0 = phi x86_fp80 [ %10, %8 ], [ %4, %0 ]
-  store i16 %1, i16* %_ncw1, align 2, !tbaa !2
-  call void asm sideeffect "fldcw $0", "*m,~{dirflag},~{fpsr},~{flags}"(i16* %_ncw1) #2, !srcloc !9
-  store i32 %12, i32* %expptr, align 4, !tbaa !7
-  ret x86_fp80 %.0
-}
-
-; Function Attrs: nounwind
-declare x86_fp80 @frexpl(x86_fp80, i32* nocapture) #1
-
-; Function Attrs: nounwind
-declare x86_fp80 @ldexpl(x86_fp80, i32) #1
-
-attributes #0 = { nounwind uwtable "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-nans-fp-math"="false" "stack-protector-buffer-size"="8" "unsafe-fp-math"="false" "use-soft-float"="false" }
-attributes #1 = { nounwind "less-precise-fpmad"="false" "no-frame-pointer-elim"="false" "no-infs-fp-math"="false" "no-nans-fp-math"="false" "stack-protector-buffer-size"="8" "unsafe-fp-math"="false" "use-soft-float"="false" }
-attributes #2 = { nounwind }
-
-!llvm.ident = !{!0}
-
-!0 = !{!"clang version 3.6.2 (tags/RELEASE_362/final)"}
-!1 = !{i32 -2146987380}
-!2 = !{!3, !3, i64 0}
-!3 = !{!"short", !4, i64 0}
-!4 = !{!"omnipotent char", !5, i64 0}
-!5 = !{!"Simple C/C++ TBAA"}
-!6 = !{i32 -2146987172}
-!7 = !{!8, !8, i64 0}
-!8 = !{!"int", !4, i64 0}
-!9 = !{i32 -2146986812}
diff --git a/disasm-test/tests/smallprog.ll b/disasm-test/tests/smallprog.ll
new file mode 100644
--- /dev/null
+++ b/disasm-test/tests/smallprog.ll
@@ -0,0 +1,226 @@
+; ModuleID = 'smallprog.c'
+source_filename = "smallprog.c"
+target datalayout = "e-m:e-p270:32:32-p271:32:32-p272:64:64-i64:64-f80:128-n8:16:32:64-S128"
+target triple = "x86_64-unknown-linux-gnu"
+
+%struct.message = type { i32, i32*, i32 }
+%struct.broker = type { [5 x %struct.message], i32, i32 }
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local void @sp_receive(%struct.message* %0) #0 !dbg !8 {
+  %2 = alloca %struct.message*, align 8
+  %3 = alloca i32, align 4
+  store %struct.message* %0, %struct.message** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.message** %2, metadata !20, metadata !DIExpression()), !dbg !21
+  %4 = load %struct.message*, %struct.message** %2, align 8, !dbg !22
+  %5 = getelementptr inbounds %struct.message, %struct.message* %4, i32 0, i32 0, !dbg !23
+  %6 = load i32, i32* %5, align 8, !dbg !23
+  switch i32 %6, label %26 [
+    i32 0, label %7
+  ], !dbg !24
+
+7:                                                ; preds = %1
+  call void @llvm.dbg.declare(metadata i32* %3, metadata !25, metadata !DIExpression()), !dbg !28
+  store i32 0, i32* %3, align 4, !dbg !28
+  br label %8, !dbg !29
+
+8:                                                ; preds = %22, %7
+  %9 = load i32, i32* %3, align 4, !dbg !30
+  %10 = load %struct.message*, %struct.message** %2, align 8, !dbg !32
+  %11 = getelementptr inbounds %struct.message, %struct.message* %10, i32 0, i32 2, !dbg !33
+  %12 = load i32, i32* %11, align 8, !dbg !33
+  %13 = shl i32 %9, %12, !dbg !34
+  %14 = icmp ne i32 %13, 0, !dbg !35
+  br i1 %14, label %15, label %25, !dbg !35
+
+15:                                               ; preds = %8
+  %16 = load %struct.message*, %struct.message** %2, align 8, !dbg !36
+  %17 = getelementptr inbounds %struct.message, %struct.message* %16, i32 0, i32 1, !dbg !38
+  %18 = load i32*, i32** %17, align 8, !dbg !38
+  %19 = load i32, i32* %3, align 4, !dbg !39
+  %20 = sext i32 %19 to i64, !dbg !36
+  %21 = getelementptr inbounds i32, i32* %18, i64 %20, !dbg !36
+  store i32 0, i32* %21, align 4, !dbg !40
+  br label %22, !dbg !41
+
+22:                                               ; preds = %15
+  %23 = load i32, i32* %3, align 4, !dbg !42
+  %24 = add nsw i32 %23, 1, !dbg !42
+  store i32 %24, i32* %3, align 4, !dbg !42
+  br label %8, !dbg !43, !llvm.loop !44
+
+25:                                               ; preds = %8
+  br label %26, !dbg !47
+
+26:                                               ; preds = %1, %25
+  ret void, !dbg !48
+}
+
+; Function Attrs: nofree nosync nounwind readnone speculatable willreturn
+declare void @llvm.dbg.declare(metadata, metadata, metadata) #1
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local void @broker_init(%struct.broker* %0) #0 !dbg !49 {
+  %2 = alloca %struct.broker*, align 8
+  store %struct.broker* %0, %struct.broker** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.broker** %2, metadata !62, metadata !DIExpression()), !dbg !63
+  %3 = load %struct.broker*, %struct.broker** %2, align 8, !dbg !64
+  %4 = getelementptr inbounds %struct.broker, %struct.broker* %3, i32 0, i32 2, !dbg !65
+  store i32 0, i32* %4, align 4, !dbg !66
+  ret void, !dbg !67
+}
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local void @broker_run(%struct.broker* %0) #0 !dbg !68 {
+  %2 = alloca %struct.broker*, align 8
+  %3 = alloca i32, align 4
+  store %struct.broker* %0, %struct.broker** %2, align 8
+  call void @llvm.dbg.declare(metadata %struct.broker** %2, metadata !69, metadata !DIExpression()), !dbg !70
+  call void @llvm.dbg.declare(metadata i32* %3, metadata !71, metadata !DIExpression()), !dbg !73
+  store i32 0, i32* %3, align 4, !dbg !73
+  br label %4, !dbg !74
+
+4:                                                ; preds = %16, %1
+  %5 = load i32, i32* %3, align 4, !dbg !75
+  %6 = load %struct.broker*, %struct.broker** %2, align 8, !dbg !77
+  %7 = getelementptr inbounds %struct.broker, %struct.broker* %6, i32 0, i32 2, !dbg !78
+  %8 = load i32, i32* %7, align 4, !dbg !78
+  %9 = icmp slt i32 %5, %8, !dbg !79
+  br i1 %9, label %10, label %19, !dbg !80
+
+10:                                               ; preds = %4
+  %11 = load %struct.broker*, %struct.broker** %2, align 8, !dbg !81
+  %12 = getelementptr inbounds %struct.broker, %struct.broker* %11, i32 0, i32 0, !dbg !83
+  %13 = load i32, i32* %3, align 4, !dbg !84
+  %14 = sext i32 %13 to i64, !dbg !81
+  %15 = getelementptr inbounds [5 x %struct.message], [5 x %struct.message]* %12, i64 0, i64 %14, !dbg !81
+  call void @sp_receive(%struct.message* %15), !dbg !85
+  br label %16, !dbg !86
+
+16:                                               ; preds = %10
+  %17 = load i32, i32* %3, align 4, !dbg !87
+  %18 = add nsw i32 %17, 1, !dbg !87
+  store i32 %18, i32* %3, align 4, !dbg !87
+  br label %4, !dbg !88, !llvm.loop !89
+
+19:                                               ; preds = %4
+  ret void, !dbg !91
+}
+
+; Function Attrs: noinline nounwind optnone uwtable
+define dso_local i32 @main() #0 !dbg !92 {
+  %1 = alloca %struct.broker, align 8
+  call void @llvm.dbg.declare(metadata %struct.broker* %1, metadata !95, metadata !DIExpression()), !dbg !96
+  call void @broker_init(%struct.broker* %1), !dbg !97
+  call void @broker_run(%struct.broker* %1), !dbg !98
+  ret i32 0, !dbg !99
+}
+
+attributes #0 = { noinline nounwind optnone uwtable "disable-tail-calls"="false" "frame-pointer"="all" "less-precise-fpmad"="false" "min-legal-vector-width"="0" "no-infs-fp-math"="false" "no-jump-tables"="false" "no-nans-fp-math"="false" "no-signed-zeros-fp-math"="false" "no-trapping-math"="true" "stack-protector-buffer-size"="8" "target-cpu"="x86-64" "target-features"="+cx8,+fxsr,+mmx,+sse,+sse2,+x87" "tune-cpu"="generic" "unsafe-fp-math"="false" "use-soft-float"="false" }
+attributes #1 = { nofree nosync nounwind readnone speculatable willreturn }
+
+!llvm.dbg.cu = !{!0}
+!llvm.module.flags = !{!3, !4, !5}
+!llvm.ident = !{!6}
+!llvm.commandline = !{!7}
+
+!0 = distinct !DICompileUnit(language: DW_LANG_C99, file: !1, producer: "clang version 12.0.1", isOptimized: false, runtimeVersion: 0, emissionKind: FullDebug, enums: !2, splitDebugInlining: false, nameTableKind: None)
+!1 = !DIFile(filename: "smallprog.c", directory: "/home/rscott/Documents/Hacking/Haskell/llvm-pretty-bc-parser/disasm-test/tests")
+!2 = !{}
+!3 = !{i32 7, !"Dwarf Version", i32 4}
+!4 = !{i32 2, !"Debug Info Version", i32 3}
+!5 = !{i32 1, !"wchar_size", i32 4}
+!6 = !{!"clang version 12.0.1"}
+!7 = !{!"/home/rscott/Software/clang+llvm-12.0.1/bin/clang-12 -emit-llvm -g -S -frecord-command-line smallprog.c -o smallprog.ll"}
+!8 = distinct !DISubprogram(name: "sp_receive", scope: !1, file: !1, line: 17, type: !9, scopeLine: 17, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!9 = !DISubroutineType(types: !10)
+!10 = !{null, !11}
+!11 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !12, size: 64)
+!12 = !DIDerivedType(tag: DW_TAG_typedef, name: "message_t", file: !1, line: 9, baseType: !13)
+!13 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "message", file: !1, line: 5, size: 192, elements: !14)
+!14 = !{!15, !17, !19}
+!15 = !DIDerivedType(tag: DW_TAG_member, name: "type", scope: !13, file: !1, line: 6, baseType: !16, size: 32)
+!16 = !DIBasicType(name: "int", size: 32, encoding: DW_ATE_signed)
+!17 = !DIDerivedType(tag: DW_TAG_member, name: "payload", scope: !13, file: !1, line: 7, baseType: !18, size: 64, offset: 64)
+!18 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !16, size: 64)
+!19 = !DIDerivedType(tag: DW_TAG_member, name: "payload_len", scope: !13, file: !1, line: 8, baseType: !16, size: 32, offset: 128)
+!20 = !DILocalVariable(name: "msg", arg: 1, scope: !8, file: !1, line: 17, type: !11)
+!21 = !DILocation(line: 17, column: 28, scope: !8)
+!22 = !DILocation(line: 18, column: 13, scope: !8)
+!23 = !DILocation(line: 18, column: 18, scope: !8)
+!24 = !DILocation(line: 18, column: 5, scope: !8)
+!25 = !DILocalVariable(name: "i", scope: !26, file: !1, line: 20, type: !16)
+!26 = distinct !DILexicalBlock(scope: !27, file: !1, line: 20, column: 9)
+!27 = distinct !DILexicalBlock(scope: !8, file: !1, line: 18, column: 24)
+!28 = !DILocation(line: 20, column: 18, scope: !26)
+!29 = !DILocation(line: 20, column: 14, scope: !26)
+!30 = !DILocation(line: 20, column: 25, scope: !31)
+!31 = distinct !DILexicalBlock(scope: !26, file: !1, line: 20, column: 9)
+!32 = !DILocation(line: 20, column: 30, scope: !31)
+!33 = !DILocation(line: 20, column: 35, scope: !31)
+!34 = !DILocation(line: 20, column: 27, scope: !31)
+!35 = !DILocation(line: 20, column: 9, scope: !26)
+!36 = !DILocation(line: 21, column: 13, scope: !37)
+!37 = distinct !DILexicalBlock(scope: !31, file: !1, line: 20, column: 53)
+!38 = !DILocation(line: 21, column: 18, scope: !37)
+!39 = !DILocation(line: 21, column: 26, scope: !37)
+!40 = !DILocation(line: 21, column: 29, scope: !37)
+!41 = !DILocation(line: 22, column: 9, scope: !37)
+!42 = !DILocation(line: 20, column: 48, scope: !31)
+!43 = !DILocation(line: 20, column: 9, scope: !31)
+!44 = distinct !{!44, !35, !45, !46}
+!45 = !DILocation(line: 22, column: 9, scope: !26)
+!46 = !{!"llvm.loop.mustprogress"}
+!47 = !DILocation(line: 23, column: 9, scope: !27)
+!48 = !DILocation(line: 25, column: 1, scope: !8)
+!49 = distinct !DISubprogram(name: "broker_init", scope: !1, file: !1, line: 27, type: !50, scopeLine: 27, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!50 = !DISubroutineType(types: !51)
+!51 = !{null, !52}
+!52 = !DIDerivedType(tag: DW_TAG_pointer_type, baseType: !53, size: 64)
+!53 = !DIDerivedType(tag: DW_TAG_typedef, name: "broker_t", file: !1, line: 15, baseType: !54)
+!54 = distinct !DICompositeType(tag: DW_TAG_structure_type, name: "broker", file: !1, line: 11, size: 1024, elements: !55)
+!55 = !{!56, !60, !61}
+!56 = !DIDerivedType(tag: DW_TAG_member, name: "msgs", scope: !54, file: !1, line: 12, baseType: !57, size: 960)
+!57 = !DICompositeType(tag: DW_TAG_array_type, baseType: !12, size: 960, elements: !58)
+!58 = !{!59}
+!59 = !DISubrange(count: 5)
+!60 = !DIDerivedType(tag: DW_TAG_member, name: "msg_idx", scope: !54, file: !1, line: 13, baseType: !16, size: 32, offset: 960)
+!61 = !DIDerivedType(tag: DW_TAG_member, name: "num_msgs", scope: !54, file: !1, line: 14, baseType: !16, size: 32, offset: 992)
+!62 = !DILocalVariable(name: "broker", arg: 1, scope: !49, file: !1, line: 27, type: !52)
+!63 = !DILocation(line: 27, column: 28, scope: !49)
+!64 = !DILocation(line: 28, column: 5, scope: !49)
+!65 = !DILocation(line: 28, column: 13, scope: !49)
+!66 = !DILocation(line: 28, column: 22, scope: !49)
+!67 = !DILocation(line: 29, column: 1, scope: !49)
+!68 = distinct !DISubprogram(name: "broker_run", scope: !1, file: !1, line: 31, type: !50, scopeLine: 31, flags: DIFlagPrototyped, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!69 = !DILocalVariable(name: "broker", arg: 1, scope: !68, file: !1, line: 31, type: !52)
+!70 = !DILocation(line: 31, column: 27, scope: !68)
+!71 = !DILocalVariable(name: "i", scope: !72, file: !1, line: 32, type: !16)
+!72 = distinct !DILexicalBlock(scope: !68, file: !1, line: 32, column: 5)
+!73 = !DILocation(line: 32, column: 14, scope: !72)
+!74 = !DILocation(line: 32, column: 10, scope: !72)
+!75 = !DILocation(line: 32, column: 21, scope: !76)
+!76 = distinct !DILexicalBlock(scope: !72, file: !1, line: 32, column: 5)
+!77 = !DILocation(line: 32, column: 25, scope: !76)
+!78 = !DILocation(line: 32, column: 33, scope: !76)
+!79 = !DILocation(line: 32, column: 23, scope: !76)
+!80 = !DILocation(line: 32, column: 5, scope: !72)
+!81 = !DILocation(line: 33, column: 22, scope: !82)
+!82 = distinct !DILexicalBlock(scope: !76, file: !1, line: 32, column: 48)
+!83 = !DILocation(line: 33, column: 30, scope: !82)
+!84 = !DILocation(line: 33, column: 35, scope: !82)
+!85 = !DILocation(line: 33, column: 9, scope: !82)
+!86 = !DILocation(line: 34, column: 5, scope: !82)
+!87 = !DILocation(line: 32, column: 43, scope: !76)
+!88 = !DILocation(line: 32, column: 5, scope: !76)
+!89 = distinct !{!89, !80, !90, !46}
+!90 = !DILocation(line: 34, column: 5, scope: !72)
+!91 = !DILocation(line: 35, column: 1, scope: !68)
+!92 = distinct !DISubprogram(name: "main", scope: !1, file: !1, line: 37, type: !93, scopeLine: 37, spFlags: DISPFlagDefinition, unit: !0, retainedNodes: !2)
+!93 = !DISubroutineType(types: !94)
+!94 = !{!16}
+!95 = !DILocalVariable(name: "broker", scope: !92, file: !1, line: 38, type: !53)
+!96 = !DILocation(line: 38, column: 14, scope: !92)
+!97 = !DILocation(line: 39, column: 5, scope: !92)
+!98 = !DILocation(line: 40, column: 5, scope: !92)
+!99 = !DILocation(line: 41, column: 1, scope: !92)
diff --git a/fuzzing/Main.hs b/fuzzing/Main.hs
--- a/fuzzing/Main.hs
+++ b/fuzzing/Main.hs
@@ -9,8 +9,6 @@
 import qualified Control.Exception as X
 import Control.Monad (forM, forM_, unless, void, when)
 import Control.Monad.IO.Class (liftIO)
-import Control.Monad.Par.Class (get, spawn)
-import Control.Monad.Par.IO (runParIO)
 import Data.List (isPrefixOf, partition, stripPrefix)
 import Data.Map.Strict (Map)
 import qualified Data.Map.Strict as Map
@@ -40,8 +38,9 @@
 -- Option Parsing --------------------------------------------------------------
 
 -- | The @clang@ executable and flags for a particular test
--- configuration, e.g., @("clang-3.8", "-O -w -g")@
-type Clang = (FilePath, String)
+-- configuration, e.g., @("clang-3.8", ["/usr/local/include"],
+-- "-O -w -g")@
+type Clang = (FilePath, [String], String)
 
 data Options = Options {
     optNumTests :: Integer
@@ -54,6 +53,9 @@
     -- ^ Clangs to use with the fuzzer
   , optClangFlags :: [String]
     -- ^ Sets of argument flags to use with each clang configuration
+  , optIncludeDirs :: [String]
+    -- ^ List of include directories to pass to clang, since those
+    -- interact badly with intermediate file names
   , optJUnitXml :: Maybe FilePath
     -- ^ Write JUnit test report
   , optCsmithPath :: Maybe FilePath
@@ -80,6 +82,7 @@
   , optSaveTests    = Nothing
   , optClangs       = ["clang"]
   , optClangFlags   = ["-O -g -w"]
+  , optIncludeDirs  = []
   , optJUnitXml     = Nothing
   , optCsmithPath   = Nothing
   , optCollapse     = False
@@ -104,6 +107,8 @@
   , Option ""  ["clang-flags"] (ReqArg addClangFlags "ARGS") $
     "specify a set of flags to use with each clang " ++
     "e.g., `--clang-flags \"-O\" --clang-flags \"-O -g\"'"
+  , Option "I" ["include-dir"] (ReqArg addIncludeDir "DIRECTORY")
+    "add a directory to the include search path for clang"
   , Option ""  ["junit-xml"] (ReqArg setJUnitXml "FILEPATH")
     "output JUnit-style XML test report"
   , Option ""  ["csmith-path"] (ReqArg setCsmithPath "DIRECTORY")
@@ -157,6 +162,10 @@
   then opt { optClangFlags = [str] }
   else opt { optClangFlags = str : optClangFlags opt }
 
+addIncludeDir :: String -> Endo Options
+addIncludeDir str = Endo $ \opt ->
+  opt { optIncludeDirs = str : optIncludeDirs opt }
+
 setJUnitXml :: String -> Endo Options
 setJUnitXml str = Endo (\opt -> opt { optJUnitXml = Just str })
 
@@ -208,34 +217,32 @@
 main :: IO ()
 main = withTempDirectory "." ".fuzz." $ \tmpDir -> do
   opts <- getOptions
+  let includeDirs = optIncludeDirs opts
   when (optSaveTests opts == Nothing &&
         or [optReduceDisasm opts, optReduceAs opts, optReduceExec opts]) $
     printUsage [ "--reduce options require --output to be set" ]
-  -- run the tests within each clang version in parallel. We could
-  -- parallelize the runs across clang versions as well, but it's
-  -- probably not worth the complexity at that level of granularity
+  liftIO $ putStrLn $ "Temp directory: " ++ tmpDir
   resultMaps <-
     forM (optClangs opts) $ \clangExe ->
-    forM (optClangFlags opts) $ \flags -> runParIO $ do
-      let clang = (clangExe, flags)
+    forM (optClangFlags opts) $ \flags -> do
+      let clang = (clangExe, includeDirs, flags)
       liftIO $ putStrLn $ "[" ++ clangExe ++ " " ++ flags ++ "]"
-      results' <-
+      forM_ includeDirs $ \dir ->
+        liftIO $ putStrLn $ "Include directory: " ++ dir
+      results <-
         case optSeeds opts of
           Nothing ->
-            forM [1..optNumTests opts] $ \_ ->
-              spawn $ liftIO $ do
+            forM [1..optNumTests opts] $ \_ -> do
               seed <- randomIO
               runTest tmpDir clang seed opts
           Just seeds ->
             forM seeds $ \seed ->
-              spawn $ liftIO $ do
               runTest tmpDir clang seed opts
-      results <- mapM get results'
       return (Map.singleton clang results)
   let allResults' = Map.unions (concat resultMaps)
       allResults | optCollapse opts = collapseResults allResults'
                  | otherwise        = allResults'
-  forM_ (Map.toList allResults) $ \((clangExe, flags), results) -> do
+  forM_ (Map.toList allResults) $ \((clangExe, _, flags), results) -> do
     let (_passes, fails) = partition isPass results
     when (not (null fails)) $ do
       putStrLn $ "[" ++ clangExe ++ " " ++ flags ++ "] " ++
@@ -247,7 +254,7 @@
     Nothing -> return ()
     Just root -> do
       createDirectoryIfMissing False root
-      forM_ (Map.toList allResults) $ \((clangExe, flags), results) ->
+      forM_ (Map.toList allResults) $ \((clangExe, _, flags), results) ->
         when (not (null (filter isFail results))) $ do
           let clangRoot = root </> (clangExe ++ "_" ++ toUnders " " flags)
           createDirectoryIfMissing False clangRoot
@@ -266,7 +273,7 @@
                 when (or [ st == DisasmStage && optReduceDisasm opts
                          , st == AsStage     && optReduceAs opts
                          , st == ExecStage   && optReduceExec opts ]) $
-                  reduce result (clangExe, flags) opts clangRoot
+                  reduce result (clangExe, includeDirs, flags) opts clangRoot
   case optJUnitXml opts of
     Nothing -> return ()
     Just f -> do
@@ -274,16 +281,17 @@
       writeFile f (ppTopElement xml)
 
 reduce :: TestResult -> Clang -> Options -> FilePath -> IO ()
-reduce (TestFail st _ TestSrc{..} err) (clangExe, flags) opts clangRoot = do
+reduce (TestFail st _ TestSrc{..} err) (clangExe, includeDirs, flags) opts clangRoot = do
   csmithPath <- getCsmithPath opts
   -- copy a file for the reduction in place
   let baseName   = dropExtension srcFile
       srcReduced = clangRoot </> baseName ++ "-reduced.c"
       scriptFile = clangRoot </> baseName ++ "-reduce.sh"
-      llvmVersion =
+      llvmVersionFlags =
         case stripPrefix "clang-" clangExe of
-          Nothing -> ""
-          Just ver -> "--llvm-version=" ++ ver
+          Nothing -> []
+          Just ver -> [ "--llvm-version=" ++ ver ]
+      includeOpts = concatMap (\dir -> ["-I", dir]) includeDirs
   copyFile (clangRoot </> srcFile) srcReduced
   absClangRoot <- makeAbsolute clangRoot
   let grepPat DisasmStage =
@@ -317,22 +325,24 @@
         , "set -e"
         , ""
         ]
-      buildBc = unwords [
+      buildBc = unwords $ [
           clangExe, "-I", csmithPath, flags, "-c"
         , "-emit-llvm", baseName ++ "-reduced.c", "-o", bcFile
-        ]
-      buildLl = unwords [
-          "llvm-disasm", llvmVersion, bcFile, ">", llFile
-        ]
+        ] ++ includeOpts
+      buildLl = unwords $
+          [ "llvm-disasm" ] ++
+          llvmVersionFlags ++
+          [ bcFile, ">", llFile ]
       copyBc = unwords [
           "cp", bcFile, absClangRoot </> bcFile
         ]
       script DisasmStage = unlines $ scriptHeader ++ [
           buildBc
         , copyBc
-        , unwords [ "llvm-disasm", llvmVersion, bcFile, "2>&1 |"
-                  , "grep", show (fromMaybe "" (grepPat st))
-                  ]
+        , unwords $
+            [ "llvm-disasm" ] ++
+            llvmVersionFlags ++
+            [ bcFile, "2>&1 |" , "grep", show (fromMaybe "" (grepPat st)) ]
         ]
       script AsStage = unlines $ scriptHeader ++ [
           buildBc
@@ -417,15 +427,17 @@
 isFail = not . isPass
 
 runTest :: FilePath -> Clang -> Seed -> Options -> IO TestResult
-runTest tmpDir (clangExe, flags) seed opts = X.handle return $ do
+runTest tmpDir (clangExe, includeDirs, flags) seed opts = X.handle return $ do
   let baseFile = show seed
       srcFile  = baseFile <.> "c"
       bcFile   = baseFile <.> "bc"
       llFile   = baseFile <.> "ll"
-      llvmVersion =
+      llvmVersionFlags =
         case stripPrefix "clang-" clangExe of
-          Nothing -> ""
-          Just ver -> "--llvm-version=" ++ ver
+          Nothing -> []
+          Just ver -> [ "--llvm-version=" ++ ver ]
+      includeOpts = concatMap (\dir -> ["-I", dir]) includeDirs
+  putStrLn $ "Testing bitcode file " ++ bcFile
   ---- Run csmith ----
   csmithPath <- getCsmithPath opts
   callProcess "csmith" [
@@ -440,13 +452,14 @@
     , "-c", "-emit-llvm"
     , tmpDir </> srcFile
     , "-o", tmpDir </> bcFile
-    ])
+    ] ++ includeOpts)
   clangErr <- waitForProcess h
   unless (clangErr == ExitSuccess) $ X.throw $!! TestClangError seed
 
   ---- Disassemble ----
+  let disasmArgs = llvmVersionFlags ++ [ tmpDir </> bcFile ]
   (ec, out, err) <-
-    readProcessWithExitCode "llvm-disasm" [ llvmVersion, tmpDir </> bcFile ] ""
+    readProcessWithExitCode "llvm-disasm" disasmArgs ""
   case ec of
     ExitFailure c -> do
       putStrLn "[DISASM ERROR]"
@@ -465,7 +478,7 @@
         "-I" ++ csmithPath
       , tmpDir </> llFile
       , "-o", tmpDir </> "ours"
-      ]) ""
+      ] ++ includeOpts) ""
     case ec of
       ExitFailure c -> do
         putStrLn "[AS ERROR]"
@@ -483,7 +496,7 @@
         "-I" ++ csmithPath
       , tmpDir </> bcFile
       , "-o", tmpDir </> "golden"
-      ])
+      ] ++ includeOpts)
     clangErr <- waitForProcess h
     unless (clangErr == ExitSuccess) $ X.throw $!! TestClangError seed
     timeout <- getTimeoutCmd
@@ -531,7 +544,7 @@
       testsuites = map (testsuite hostname nowFmt) (Map.toList allResults)
   return $ unode "testsuites" testsuites
   where
-    fmtClang (clangExe, flags) = toUnders ". " (clangExe ++ "_" ++ flags)
+    fmtClang (clangExe, _, flags) = toUnders ". " (clangExe ++ "_" ++ flags)
     testsuite hostname nowFmt (clang, results) =
       unode "testsuite" ([
           uattr "name"      "llvm-disasm fuzzer"
diff --git a/llvm-disasm/LLVMDis.hs b/llvm-disasm/LLVMDis.hs
--- a/llvm-disasm/LLVMDis.hs
+++ b/llvm-disasm/LLVMDis.hs
@@ -1,14 +1,15 @@
-{-# LANGUAGE ImplicitParams #-}
 import Data.LLVM.BitCode (parseBitCode, formatError)
 import Data.LLVM.CFG (buildCFG, CFG(..), blockId)
-import Text.LLVM.AST (defBody, modDefines)
-import Text.LLVM.PP (ppLLVM35, ppLLVM36, ppLLVM37, ppLLVM38, ppModule)
-import Text.PrettyPrint (Style(..), renderStyle, style)
+import Text.LLVM.AST (defBody, modDefines,Module)
+import Text.LLVM.PP (ppLLVM, ppLLVM35, ppLLVM36, ppLLVM37, ppLLVM38, llvmPP, llvmVlatest)
 
 import Control.Monad (when)
 import Data.Graph.Inductive.Graph (nmap, emap)
 import Data.Graph.Inductive.Dot (fglToDotString, showDot)
-import Data.Monoid (mconcat, Endo(..))
+import Data.Monoid (Endo(..))
+import Text.PrettyPrint (Style(..), renderStyle, style)
+import Text.Read (readMaybe)
+import Text.Show.Pretty (pPrint)
 import System.Console.GetOpt
   (ArgOrder(..), ArgDescr(..), OptDescr(..), getOpt, usageInfo)
 import System.Environment (getArgs,getProgName)
@@ -19,22 +20,26 @@
 data Options = Options {
     optLLVMVersion :: String
   , optDoCFG       :: Bool
+  , optAST         :: Bool
   , optHelp        :: Bool
   } deriving (Show)
 
 defaultOptions :: Options
 defaultOptions  = Options {
-    optLLVMVersion = "3.8"
+    optLLVMVersion = show llvmVlatest
   , optDoCFG       = False
+  , optAST         = False
   , optHelp        = False
   }
 
 options :: [OptDescr (Endo Options)]
 options  =
   [ Option "" ["llvm-version"] (ReqArg setLLVMVersion "VERSION")
-    "print assembly compatible with this LLVM version (e.g., 3.8)"
+    "output for LLVM version (e.g., 3.5, 3.6. 3.7, 3.8, 4, 5, 6, ...)."
   , Option "" ["cfg"] (NoArg setDoCFG)
     "output CFG in graphviz format"
+  , Option "" ["ast"] (NoArg setAST)
+    "output the Haskell AST instead"
   , Option "h" ["help"] (NoArg setHelp)
     "display this message"
   ]
@@ -54,15 +59,26 @@
 printUsage :: [String] -> IO ()
 printUsage errs =
   do prog <- getProgName
-     let banner = "Usage: " ++ prog ++ " [OPTIONS]"
-     putStrLn (usageInfo (unlines (errs ++ [banner])) options)
+     let banner = [ "Usage: " ++ prog ++ " [OPTIONS]"
+                  , ""
+                  , "  Converts LLVM bitcode format (.bc) to LLVM text form (.ll) on stdout."
+                  , "  Supports LLVM versions 3.4 through " <> show llvmVlatest <> "."
+                  , ""
+                  , "  Comparable to the llvm-dis tool from LLVM (which only supports"
+                  , "  the *current* version) but writes to stdout instead of a file."
+                  ]
 
+     putStrLn (usageInfo (unlines (errs ++ banner)) options)
+
 setLLVMVersion :: String -> Endo Options
 setLLVMVersion str = Endo (\opt -> opt { optLLVMVersion = str })
 
 setDoCFG :: Endo Options
 setDoCFG = Endo (\opt -> opt { optDoCFG = True })
 
+setAST :: Endo Options
+setAST = Endo (\opt -> opt { optAST = True })
+
 setHelp :: Endo Options
 setHelp = Endo (\opt -> opt { optHelp = True })
 
@@ -83,20 +99,25 @@
       exitFailure
 
     Right m  -> do
-      let s = style { lineLength = maxBound, ribbonsPerLine = 1.0 }
-      case optLLVMVersion opts of
-        -- try the 3.5 style for 3.4
-        "3.4" -> putStrLn (renderStyle s (ppLLVM35 (ppModule m)))
-        "3.5" -> putStrLn (renderStyle s (ppLLVM35 (ppModule m)))
-        "3.6" -> putStrLn (renderStyle s (ppLLVM36 (ppModule m)))
-        "3.7" -> putStrLn (renderStyle s (ppLLVM37 (ppModule m)))
-        "3.8" -> putStrLn (renderStyle s (ppLLVM38 (ppModule m)))
-        -- try the 3.8 style for 3.9
-        "3.9" -> putStrLn (renderStyle s (ppLLVM38 (ppModule m)))
-        -- try the 3.8 style for 4.0
-        "4.0" -> putStrLn (renderStyle s (ppLLVM38 (ppModule m)))
-        v -> printUsage ["unsupported LLVM version: " ++ v] >> exitFailure
-      when (optDoCFG opts) $ do
-        let cfgs  = map (buildCFG . defBody) $ modDefines m
-            fixup = nmap (show . blockId) . emap (const "")
-        mapM_ (putStrLn . showDot . fglToDotString . fixup . cfgGraph) cfgs
+        if optAST opts
+          then pPrint m
+          else renderLLVM opts m
+
+renderLLVM :: Options -> Module -> IO ()
+renderLLVM opts m = do
+  let s         = style { lineLength = maxBound, ribbonsPerLine = 1.0 }
+  let v         = optLLVMVersion opts
+  let putRender = putStrLn . renderStyle s
+  case readMaybe v :: Maybe Int of
+    Just n -> putRender (ppLLVM n (llvmPP m))
+    Nothing -> case readMaybe v :: Maybe Float of
+                 Just 3.4 -> putRender (ppLLVM35 (llvmPP m))
+                 Just 3.5 -> putRender (ppLLVM35 (llvmPP m))
+                 Just 3.6 -> putRender (ppLLVM36 (llvmPP m))
+                 Just 3.7 -> putRender (ppLLVM37 (llvmPP m))
+                 Just 3.8 -> putRender (ppLLVM38 (llvmPP m))
+                 _ -> printUsage ["unsupported LLVM version: " ++ v] >> exitFailure
+  when (optDoCFG opts) $ do
+    let cfgs  = map (buildCFG . defBody) $ modDefines m
+        fixup = nmap (show . blockId) . emap (const "")
+    mapM_ (putStrLn . showDot . fglToDotString . fixup . cfgGraph) cfgs
diff --git a/llvm-pretty-bc-parser.cabal b/llvm-pretty-bc-parser.cabal
--- a/llvm-pretty-bc-parser.cabal
+++ b/llvm-pretty-bc-parser.cabal
@@ -1,13 +1,16 @@
+cabal-version:       2.4
 Name:                llvm-pretty-bc-parser
-Version:             0.4.0.0
-License:             BSD3
+Version:             0.4.1.0
+License:             BSD-3-Clause
 License-file:        LICENSE
 Author:              Trevor Elliott <trevor@galois.com>
-Maintainer:          Trevor Elliott
+Maintainer:          Ryan Scott <rscott@galois.com>
+                   , Kevin Quick <kquick@galois.com>
+                   , Langston Barrett <langston@galois.com>
 Category:            Text
 Build-type:          Simple
-Cabal-version:       >=1.10
 Synopsis:            LLVM bitcode parsing library
+Tested-with:         GHC==8.8, GHC==8.10, GHC==9.2, GHC==9.4, GHC==9.6
 
 Description:
   A parser for the LLVM bitcode file format, yielding a Module from the
@@ -15,22 +18,31 @@
 
 Extra-source-files:  disasm-test/tests/*.ll
 
+extra-doc-files: CHANGELOG.md, README.md
+
 Flag fuzz
   Description:         Enable fuzzing harness
   Default:             False
 
+Flag regressions
+  Description:         Enable regression testing build
+  Default:             False
+
 Source-repository head
   type:                git
-  location:            http://github.com/galoisinc/llvm-pretty-bc-parser
+  location:            https://github.com/galoisinc/llvm-pretty-bc-parser
 
 Library
   Hs-source-dirs:      src
   Exposed-modules:     Data.LLVM.CFG,
-                       Data.LLVM.BitCode
+                       Data.LLVM.BitCode,
+                       -- for testing:
+                       Data.LLVM.Internal
 
   Default-language:    Haskell2010
 
-  Other-modules:       Data.LLVM.BitCode.BitString,
+  Other-modules:       Data.LLVM.BitCode.Assert,
+                       Data.LLVM.BitCode.BitString,
                        Data.LLVM.BitCode.Bitstream,
                        Data.LLVM.BitCode.GetBits,
                        Data.LLVM.BitCode.IR,
@@ -48,54 +60,129 @@
                        Data.LLVM.BitCode.Record
 
   Ghc-options:         -Wall
+                       -Wunbanged-strict-patterns
+                       -Wcompat
+                       -Wincomplete-uni-patterns
+                       -Wsimplifiable-class-constraints
+                       -Wpartial-fields
+                       -O2
+                       -funbox-strict-fields
+                       -fhide-source-paths
 
-  Build-depends:       base       >= 4 && < 5,
-                       containers >= 0.4,
-                       array      >= 0.3,
-                       pretty     >= 1.0.1,
-                       monadLib   >= 3.7.2,
-                       fgl        >= 5.5,
-                       cereal     >= 0.3.5.2,
-                       bytestring >= 0.9.1,
-                       llvm-pretty>= 0.7.1.1
+  Build-depends:       array       >= 0.3,
+                       base        >= 4.8 && < 5,
+                       binary      >= 0.8,
+                       bytestring  >= 0.10,
+                       containers  >= 0.4,
+                       fgl         >= 5.5,
+                       llvm-pretty >= 0.12 && < 0.13,
+                       mtl         >= 2.2.2,
+                       pretty      >= 1.0.1,
+                       uniplate    >= 1.6,
+                       utf8-string >= 1.0
 
 Executable llvm-disasm
   Main-is:             LLVMDis.hs
   Default-language:    Haskell2010
   Ghc-options:         -Wall
+                       -Wunbanged-strict-patterns
+                       -O2
+                       -funbox-strict-fields
   Hs-source-dirs:      llvm-disasm
-  Build-depends:       bytestring >= 0.9.1,
-                       base       >= 4 && < 5,
-                       pretty     >= 1.0.1,
-                       containers >= 0.4,
-                       array      >= 0.3,
-                       monadLib   >= 3.7.2,
-                       fgl        >= 5.5,
-                       fgl-visualize >= 0.1,
-                       cereal     >= 0.3.5.2,
-                       llvm-pretty>= 0.7.1.0,
-                       llvm-pretty-bc-parser
+  Build-depends:       array                 >= 0.3,
+                       base,
+                       binary                >= 0.8,
+                       bytestring,
+                       containers            >= 0.4,
+                       fgl                   >= 5.5,
+                       fgl-visualize         >= 0.1,
+                       llvm-pretty-bc-parser,
+                       llvm-pretty,
+                       monadLib              >= 3.7.2,
+                       pretty                >= 1.0.1,
+                       pretty-show           >= 1.6
 
+test-suite unit-test
+    type:                exitcode-stdio-1.0
+    main-is:             Main.hs
+    other-modules:       Tests.Instances,
+                         Tests.ExpressionInstances,
+                         Tests.FuncDataInstances,
+                         Tests.PrimInstances,
+                         Tests.StmtInstances,
+                         Tests.TripleInstances,
+                         Tests.Metadata
+    hs-source-dirs:      unit-test
+    default-language:    Haskell2010
+    ghc-options:         -W -Wcompat
+                         -Wunrecognised-warning-flags
+                         -threaded
+    -- other-extensions:    OverloadedStrings, ...
+    build-depends: base -any,
+                   containers >= 0.4,
+                   HUnit -any,
+                   QuickCheck -any,
+                   generic-random -any,
+                   tasty -any,
+                   tasty-hunit -any,
+                   tasty-quickcheck -any,
+                   llvm-pretty -any,
+                   llvm-pretty-bc-parser
+
 Test-suite disasm-test
   type:                exitcode-stdio-1.0
   Main-is:             Main.hs
   Default-language:    Haskell2010
   hs-source-dirs:      disasm-test
   Ghc-options:         -Wall
-  build-depends:       base >= 4 && < 5,
+  build-depends:       base,
+                       containers,
                        process,
                        directory,
                        bytestring,
+                       exceptions >= 0.10 && < 0.11,
                        filepath,
-                       llvm-pretty>= 0.7.1.0,
+                       lens,
+                       optparse-applicative >= 0.18.1.0,
+                       pretty-show>= 1.6,
+                       prettyprinter >= 1.7 && < 1.8,
+                       string-interpolate >= 0.3 && < 0.4,
+                       syb >= 0.7,
+                       tasty >= 1.3,
+                       tasty-expected-failure >= 0.12 && < 0.13,
+                       tasty-hunit,
+                       tasty-sugar >= 2.2 && < 2.3,
+                       transformers >= 0.5 && < 0.7,
+                       terminal-size >= 0.3 && < 0.4,
+                       text,
+                       versions < 7,
+                       llvm-pretty,
                        llvm-pretty-bc-parser
 
+Executable regression-test
+  Main-is:             Main.hs
+  Default-language:    Haskell2010
+  hs-source-dirs:      regression-test
+  Ghc-options:         -Wall
+  build-depends:       base,
+                       directory,
+                       filepath,
+                       foldl,
+                       text,
+                       turtle >= 1.6,
+                       llvm-pretty,
+                       llvm-pretty-bc-parser
+  if flag(regressions)
+      Buildable:       True
+  else
+      Buildable:       False
+
 Executable fuzz-llvm-disasm
   Main-is:             Main.hs
   Default-language:    Haskell2010
   hs-source-dirs:      fuzzing
   Ghc-options:         -Wall -threaded -O2
-  build-depends:       base >= 4 && < 5,
+  build-depends:       base,
                        process,
                        directory,
                        bytestring,
@@ -106,10 +193,8 @@
                        xml,
                        time,
                        deepseq,
-                       abstract-par,
-                       monad-par,
                        transformers,
-                       llvm-pretty>= 0.7.1.0,
+                       llvm-pretty,
                        llvm-pretty-bc-parser
   if flag(fuzz)
       Buildable:       True
diff --git a/regression-test/Main.hs b/regression-test/Main.hs
new file mode 100644
--- /dev/null
+++ b/regression-test/Main.hs
@@ -0,0 +1,242 @@
+-- * Regression tests
+
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE GADTSyntax #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}
+
+module Main where
+
+import           Data.LLVM.BitCode (Error(..))
+
+import           Control.Monad (when, forM, forM_, filterM)
+import           Control.Monad.IO.Class (liftIO)
+import qualified Control.Foldl as Foldl
+import           Data.List (nub)
+import           Data.Maybe (fromMaybe, listToMaybe)
+import           Data.Semigroup hiding ( Option )
+import           Data.Text (Text)
+import qualified Data.Text as Text
+import qualified Data.Text.IO as TextIO
+import           Data.Typeable (Typeable)
+import           System.Console.GetOpt (ArgOrder(..), ArgDescr(..), OptDescr(..), getOpt, usageInfo)
+import qualified System.Directory as Dir
+import           System.Environment (getArgs, getProgName, getExecutablePath)
+import           System.Exit (exitFailure, exitSuccess)
+import           System.FilePath (takeDirectory)
+import           Data.List (maximumBy)
+import           Data.Ord (comparing)
+import qualified Turtle as T
+
+import           Prelude
+
+
+----------------------------------------------------------------
+-- ** Option parsing
+
+data Options = Options { optTests   :: [FilePath] -- ^ Tests
+                       , optLlvmAs  :: Text       -- ^ llvm-as name
+                       , optRev1    :: Text       -- ^ Git revision 1
+                       , optRev2    :: Text       -- ^ Git revision 2
+                       , optAST     :: Bool       -- ^ Compare generated ASTs?
+                       , optNew     :: Bool       -- ^ Use cabal new-build?
+                       , optHelp    :: Bool
+                       } deriving (Eq, Ord, Show)
+
+defaultOptions :: Options
+defaultOptions  = Options { optTests   = ["disasm-test/tests/factorial2.ll"]
+                          , optLlvmAs  = "llvm-as"
+                          , optRev1    = "HEAD"
+                          , optRev2    = "HEAD~1"
+                          , optAST     = False
+                          , optNew     = False
+                          , optHelp    = False
+                          }
+
+options :: [OptDescr (Endo Options)]
+options  =
+  [ Option ""  ["llvm-as"] (ReqArg setLlvmAs "PATH") "path to/name of llvm-as"
+  , Option ""  ["rev1"]    (ReqArg setRev1 "REV")    "first git revision to compare"
+  , Option ""  ["rev2"]    (ReqArg setRev2 "REV")    "second git revision to compare"
+  , Option ""  ["ast"]     (NoArg setAST)            "compare generated ASTs, rather than disassembled bitcode"
+  , Option ""  ["new"]     (NoArg setNew)            "use cabal new-build"
+  , Option "h" ["help"]    (NoArg setHelp)           "display this message"
+  ]
+  where setLlvmAs str = Endo $ \opt -> opt { optLlvmAs = Text.pack str }
+        setRev1   str = Endo $ \opt -> opt { optRev1   = Text.pack str }
+        setRev2   str = Endo $ \opt -> opt { optRev2   = Text.pack str }
+        setAST        = Endo $ \opt -> opt { optAST    = True          }
+        setNew        = Endo $ \opt -> opt { optNew    = True          }
+        setHelp       = Endo $ \opt -> opt { optHelp   = True          }
+
+addTest :: String -> Endo Options
+addTest test = Endo $ \opt -> opt { optTests = test : optTests opt }
+
+getOptions :: IO Options
+getOptions  =
+  do args <- getArgs
+     case getOpt (ReturnInOrder addTest) options args of
+
+       (fs, [], []) -> let opts = appEndo (mconcat fs) defaultOptions
+                       in if optHelp opts
+                          then printUsage [] >> exitSuccess
+                          else pure opts
+
+       (_, _, errs) -> printUsage errs >> exitFailure
+
+printUsage :: [String] -> IO ()
+printUsage errs = do
+  prog <- getProgName
+  let banner = "Usage: " ++ prog ++ " [OPTIONS] test1.ll .. testn.ll"
+  putStrLn (usageInfo (unlines (errs ++ [banner])) options)
+
+  ----------------------------------------------------------------
+-- ** Test running
+
+------------------------------------------------------
+-- *** Exceptions
+
+-- | A test failure.
+data TestFailure where
+  -- | A parser failure. Occurs when the parser from one of the git revisions
+  -- couldn't even parse the assembly.
+  ParseError :: String -- ^ Which git revision?
+             -> Error  -- ^ The parse error
+             -> TestFailure
+    deriving (Typeable, Eq, Ord, Show)
+
+------------------------------------------------------
+-- *** Outline
+
+-- **** Preparing
+
+--  1. Copy the entire source directory (located via the
+--     `llvm-pretty-bc-parser.cabal` file) to a temporary "build" directory
+--  2. Create a second temporary "output" directory
+--  3. Copy all test `.ll` files to the "output" directory
+--  4. Assemble the `.ll` files into `.bc` files with `llvm-as`
+--  5. For each of the two specified git revisions,
+--     i.   Check out that revision
+--     ii.  Build llvm-disasm
+--     iii. Copy the binary to llvm-disasm-<rev> in the output directory
+
+-- **** Testing
+
+--  6. Run llvm-disasm-<rev> on each `.bc` file, save the output as a file
+--  7. Compare the two outputs, warn the user and print a diff if they aren't the
+--     same
+
+------------------------------------------------------
+-- *** Running
+
+-- | Beginning in the directory of the current executable, move upwards
+-- and try to find `llvm-pretty-bc-parser.cabal`.
+findSrc :: IO FilePath
+findSrc = do
+  parents       <- allParents . takeDirectory <$> getExecutablePath
+  haveCabalFile <- flip filterM parents $
+    fmap ("llvm-pretty-bc-parser.cabal" `elem` ) . Dir.listDirectory
+  pure $ flip fromMaybe (listToMaybe haveCabalFile) $
+    error $ unlines [ "Couldn't find cabal file in directories:"
+                    , show parents
+                    ]
+  where -- This is quick-n-dirty: We assume the path has <200 components
+        allParents = nub . take 200 . iterate takeDirectory
+
+-- | Run all provided tests.
+main :: IO ()
+main = T.runManaged $ do
+  opts      <- liftIO getOptions
+
+  -- (1)
+  src       <- liftIO findSrc
+  buildDir  <- T.mktempdir "/tmp" "regression-build"
+  T.cptree src buildDir
+
+  -- (2)
+  outputDir <- T.mktempdir "/tmp" "regression-out"
+  bcfiles   <- liftIO $ forM (optTests opts) $ \testFile -> do
+    let llName = buildDir  T.</> testFile
+    let bcName = llName    T.<.> "bc"
+
+    -- (3)
+    echoText $ "Assembling: " <> Text.pack llName
+    T.cp testFile llName
+
+    -- (4)
+    (code, stdout, stderr) <-
+      T.procStrictWithErr (optLlvmAs opts)
+        [ "-o"
+        , Text.pack bcName
+        , Text.pack llName
+        ]
+        (pure "")
+    exitWithMsg ("Couldn't assemble " <> Text.pack testFile) code stdout stderr
+    pure bcName
+
+  let revs = [optRev1 opts, optRev2 opts]
+
+  -- (5)
+  T.cd buildDir
+  liftIO $ forM_ revs $ \rev -> do
+    echoText $ "Compiling: " <> rev
+
+    -- (i)
+    (code, stdout, stderr) <- T.procStrictWithErr "git" ["checkout", rev] (pure "")
+    exitWithMsg ("Couldn't checkout rev " <> rev) code stdout stderr
+
+    -- (ii)
+    let build = (if optNew opts then "new-" else "") <> "build"
+    (code, stdout, stderr) <- T.procStrictWithErr "cabal" [build, "llvm-disasm"] (pure "")
+    exitWithMsg ("Couldn't `cabal " <> build <> "` revision " <> rev)
+                code stdout stderr
+
+    -- (iii)
+    -- A bit hacky: some directories contain this text, assume the longest
+    -- filepath is the binary
+    let dist = "dist" <> if optNew opts then "-newstyle" else ""
+    paths <- T.fold (T.find (T.has "llvm-disasm") (Text.unpack dist)) Foldl.list
+    T.cp (maximumBy (comparing length) paths)
+         (outputDir T.</> Text.unpack ("llvm-disasm-" <> rev))
+
+  -- (6)
+  T.cd outputDir
+  -- [a, b] <- liftIO $ forM revs $ \rev ->
+  resAandB <- liftIO $ forM revs $ \rev ->
+    forM bcfiles $ \bcfile -> do
+      let exe = Text.pack outputDir <> "/" <> "llvm-disasm-" <> rev
+      let ast = ["--ast" | optAST opts]
+      let pat = Text.pack bcfile
+      (code, stdout, stderr) <-
+        T.procStrictWithErr exe (ast ++ [pat]) (pure "")
+
+      exitWithMsg ("Failed when disassembling " <> pat <> " with " <> exe)
+        code stdout stderr
+
+      let newPath = bcfile T.<.> Text.unpack rev T.<.> "ll"
+      TextIO.writeFile newPath stdout
+      pure newPath
+
+  -- (7)
+  case resAandB of
+   (a:b:[]) ->
+    liftIO $ forM_ (zip a b) $ \(ll1, ll2) -> do
+    let ll1t = Text.pack ll1
+        ll2t = Text.pack ll2
+
+    echoText $ "Diffing: " <> ll1t <> " " <> ll2t
+    (code, stdout, stderr) <-
+      T.procStrictWithErr "diff" [ll1t, ll2t] (pure "")
+    exitWithMsg ("Failed when diffing " <> ll1t <> " with " <> ll2t)
+      code stdout stderr
+
+    mapM_ T.echo $ T.textToLines stdout
+   _ -> error "Failed to generate old and new disassemblies for comparison"
+        -- should never happen, but this avoids requiring MonadFail on matching
+        -- [a, b] <- {...step 6...}
+
+  where echoText = liftIO . T.echo . T.unsafeTextToLine
+        exitWithMsg msg code stdout stderr =
+          when (code /= T.ExitSuccess) $
+            mapM_ (mapM_ T.echo . T.textToLines) [msg, stdout, stderr] >>
+            exitFailure
diff --git a/src/Data/LLVM/BitCode/Assert.hs b/src/Data/LLVM/BitCode/Assert.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LLVM/BitCode/Assert.hs
@@ -0,0 +1,115 @@
+{- |
+Module      : Data.LLVM.BitCode.Assert
+Description : This module implements exceptions and warnings about bitcode.
+License     : BSD3
+Maintainer  : lbarrett
+Stability   : experimental
+
+This module is meant to be imported qualified as @Assert@
+
+-}
+
+{-# LANGUAGE CPP #-}
+module Data.LLVM.BitCode.Assert
+  ( failWithMsg
+  , unknownEntity
+  -- ** Record size
+  , recordSizeLess
+  , recordSizeGreater
+  , recordSizeBetween
+  , recordSizeIn
+
+  -- ** Types
+  , elimPtrTo
+  , elimPtrTo_
+  ) where
+
+import           Control.Monad (MonadPlus, mplus)
+import           Control.Monad (when)
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail (MonadFail)
+#endif
+import           Data.LLVM.BitCode.Record (Record)
+import qualified Data.LLVM.BitCode.Record as Record
+import           Text.LLVM.AST (Type', Ident)
+import qualified Text.LLVM.AST as AST
+
+supportedCompilerMessage :: [String]
+supportedCompilerMessage =
+  [ "Are you sure you're using a supported compiler?"
+  , "Check here: https://github.com/GaloisInc/llvm-pretty-bc-parser"
+  ]
+
+-- | Call 'fail' with a helpful hint to the user
+failWithMsg :: MonadFail m => String -> m a
+failWithMsg s = fail $ unlines (s:supportedCompilerMessage)
+
+-- | For when an unknown value of an enumeration is encountered
+unknownEntity :: (MonadFail m, Show a) => String -> a -> m b
+unknownEntity sort val = failWithMsg ("Unknown " ++ sort ++ " " ++ show val)
+
+----------------------------------------------------------------
+-- ** Record sizes
+
+recordSizeCmp :: MonadFail m => String -> (Int -> Bool) -> Record -> m ()
+recordSizeCmp msg compare_ record =
+  let len = length (Record.recordFields record)
+  in when (compare_ len) $ failWithMsg $ unlines $
+       [ "Invalid record size: " ++ show len, msg ]
+
+recordSizeLess :: MonadFail m => Record -> Int -> m ()
+recordSizeLess r i = recordSizeCmp "Expected size less than" (i <=) r
+
+recordSizeGreater :: MonadFail m => Record -> Int -> m ()
+recordSizeGreater r i = recordSizeCmp "Expected size greater than" (<= i) r
+
+recordSizeBetween :: MonadFail m => Record -> Int -> Int -> m ()
+recordSizeBetween record lb ub =
+  recordSizeGreater record lb >> recordSizeLess record ub
+
+recordSizeIn :: MonadFail m => Record -> [Int] -> m ()
+recordSizeIn record ns =
+  let len = length (Record.recordFields record)
+  in when (not (len `elem` ns)) $ failWithMsg $ unlines $
+       [ "Invalid record size: " ++ show len
+       , "Expected one of: " ++ show ns
+       ]
+
+
+----------------------------------------------------------------
+-- ** Types
+
+-- | Assert that this thing is a @'PtrTo' ty@ and return the underlying @ty@.
+--
+-- Think carefully before using this function, as it will not work as you would
+-- expect when the type is an opaque pointer.
+-- See @Note [Pointers and pointee types]@.
+elimPtrTo :: (MonadFail m, MonadPlus m) => String -> Type' Ident -> m (Type' Ident)
+elimPtrTo msg ptrTy = AST.elimPtrTo ptrTy `mplus`
+                        (fail $ unlines [ msg
+                                        , "Expected pointer type, found:"
+                                        , show ptrTy
+                                        ])
+
+-- | Assert that this thing is a 'PtrTo' type.
+--
+-- Think carefully before using this function, as it will not work as you would
+-- expect when the type is an opaque pointer.
+-- See @Note [Pointers and pointee types]@.
+elimPtrTo_ :: (MonadFail m, MonadPlus m) => String -> Type' Ident -> m ()
+elimPtrTo_ msg ptrTy = elimPtrTo msg ptrTy >> pure ()
+
+{-
+Note [Pointers and pointee types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Unlike LLVM itself, llvm-pretty and llvm-pretty-bc-parser allow mixing opaque
+and non-opaque pointers. A consequence of this is that we generally avoid
+pattern matching on PtrTo (non-opaque pointer) types and inspecting the
+underlying pointee types. This sort of code simply won't work for PtrOpaque
+types, which lack pointee types.
+
+The elimPtrTo and elimPtrTo_ functions go against this rule, as they retrieve
+the pointee type in a PtrTo. These functions are primarily used for supporting
+old versions of LLVM which do not store the necessary type information in the
+instruction itself.
+-}
diff --git a/src/Data/LLVM/BitCode/BitString.hs b/src/Data/LLVM/BitCode/BitString.hs
--- a/src/Data/LLVM/BitCode/BitString.hs
+++ b/src/Data/LLVM/BitCode/BitString.hs
@@ -1,67 +1,173 @@
-module Data.LLVM.BitCode.BitString (
-    BitString(..)
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE PatternSynonyms #-}
+
+module Data.LLVM.BitCode.BitString
+  (
+    BitString
+  , emptyBitString
   , toBitString
   , showBitString
   , fromBitString
-  , maskBits
-  , take, drop, splitAt
-  ) where
+  , bitStringValue
+  , take, drop
+  , joinBitString
+  , NumBits, NumBytes, pattern Bits', pattern Bytes'
+  , bitCount, bitCount#
+  , bitsToBytes, bytesToBits
+  , addBitCounts
+  , subtractBitCounts
+  )
+where
 
+import Data.Bits ( bit, bitSizeMaybe, Bits )
+import GHC.Exts
+import Numeric ( showIntAtBase, showHex )
+
 import Prelude hiding (take,drop,splitAt)
 
-import Data.Bits ((.&.),(.|.),shiftL,shiftR,bit)
-import Data.Monoid (Monoid(..))
-import Numeric (showIntAtBase)
+----------------------------------------------------------------------
+-- Define some convenience newtypes to clarify whether the count of bits or count
+-- of bytes is being referenced, and to convert between the two.
 
+newtype NumBits = NumBits Int deriving (Show, Eq, Ord)
+newtype NumBytes = NumBytes Int deriving (Show, Eq, Ord)
 
+pattern Bits' :: Int -> NumBits
+pattern Bits' n = NumBits n
+{-# COMPLETE Bits' #-}
+
+pattern Bytes' :: Int -> NumBytes
+pattern Bytes' n = NumBytes n
+{-# COMPLETE Bytes' #-}
+
+bitCount :: NumBits -> Int
+bitCount (NumBits n) = n
+
+bitCount# :: NumBits -> Int#
+bitCount# (NumBits (I# n#)) = n#
+
+{-# INLINE addBitCounts #-}
+addBitCounts :: NumBits -> NumBits -> NumBits
+addBitCounts (NumBits (I# a#)) (NumBits (I# b#)) = NumBits (I# (a# +# b#))
+
+{-# INLINE subtractBitCounts #-}
+subtractBitCounts :: NumBits -> NumBits -> NumBits
+subtractBitCounts (NumBits (I# a#)) (NumBits (I# b#)) = NumBits (I# (a# -# b#))
+
+{-# INLINE bytesToBits #-}
+bitsToBytes :: NumBits -> (NumBytes, NumBits)
+bitsToBytes (NumBits (I# n#)) = ( NumBytes (I# (n# `uncheckedIShiftRL#` 3#))
+                                , NumBits (I# (n# `andI#` 7#))
+                                )
+
+{-# INLINE bitsToBytes #-}
+bytesToBits :: NumBytes -> NumBits
+bytesToBits (NumBytes (I# n#)) = NumBits (I# (n# `uncheckedIShiftL#` 3#))
+
+----------------------------------------------------------------------
+
 data BitString = BitString
-  { bsLength :: !Int
-  , bsData   :: !Integer
-  } deriving Show
+  { bsLength :: !NumBits
+  , bsData   :: !Int
+    -- Note: the bsData was originally an Integer, which allows an essentially
+    -- unlimited size value.  However, this adds some overhead to various
+    -- computations, and since LLVM Bitcode is unlikely to ever represent values
+    -- greater than the native size (64 bits) as discrete values.  By changing
+    -- this to @Int@, the use of unboxed calculations is enabled for better
+    -- performance.
+    --
+    -- The use of Int is potentially unsound because GHC only guarantees it's a
+    -- signed integer of at least 32-bits.  However current implementations in
+    -- all environments where it's reasonable to use this parser have a 64-bit
+    -- Int implementation.  This can be verified via:
+    --
+    --  > import Data.Bits
+    --  > bitSizeMaybe (maxBound :: Int) >= Just 64
+    --
+    -- There's no good location here to automate this check (perhaps
+    -- GetBits.hs:runGetBits?), which is why it isn't verified at runtime.
+  } deriving (Show, Eq)
 
-instance Eq BitString where
-  BitString n i == BitString m j = n == m && i == j
+-- | Create an empty BitString
 
-instance Monoid BitString where
-  mempty = BitString 0 0
-  mappend (BitString n i) (BitString m j) =
-    BitString (n+m) (i .|. (j `shiftL` n))
+emptyBitString :: BitString
+emptyBitString = BitString (NumBits 0) 0
 
+
+-- | Join two BitString representations together to form a single larger
+-- BitString.  The first BitString is the \"lower\" value portion of the resulting
+-- BitString.
+
+joinBitString :: BitString -> BitString -> BitString
+joinBitString (BitString (Bits' (I# szA#)) (I# a#))
+              (BitString (Bits' (I# szB#)) (I# b#)) =
+  BitString { bsLength = NumBits (I# (szA# +# szB#))
+            , bsData = I# (a# `orI#` (b# `uncheckedIShiftL#` szA#))
+            }
+
+
 -- | Given a number of bits to take, and an @Integer@, create a @BitString@.
-toBitString :: Int -> Integer -> BitString
-toBitString len val = BitString len (val .&. maskBits len)
 
-fromBitString :: Num a => BitString -> a
-fromBitString (BitString l i) = fromIntegral (i .&. maskBits l)
+toBitString :: NumBits -> Int -> BitString
+toBitString len@(Bits' (I# len#)) (I# val#) =
+  let !mask# = (1# `uncheckedIShiftL#` len#) -# 1#
+  in BitString len (I# (val# `andI#` mask#))
 
+
+-- | Extract the referenced Integer value from a BitString
+
+bitStringValue :: BitString -> Int
+bitStringValue = bsData
+
+
+-- | Extract a target (Num) value of the desired type from a BitString (using
+-- fromInteger to perform the target type conversion).
+
+fromBitString :: (Num a, Bits a) => BitString -> a
+fromBitString (BitString l i) =
+  case bitSizeMaybe x of
+    Nothing -> x
+    Just n
+      -- Verify that the bitstring size is less than the target size, or if it is
+      -- greater, that the extra upper bits are all zero.
+      | n >= bitCount l || (ival < bit n) -> x
+      | otherwise -> error (unwords
+           [ "Data.LLVM.BitCode.BitString.fromBitString: bitstring value of length", show l
+           , "(mask=0x" <> showHex i ")"
+           , "could not be parsed into type with only", show n, "bits"
+           ])
+ where
+ x    = fromInteger ival  -- use Num to convert the Integer to the target type
+ ival = toInteger i  -- convert input to an Integer for ^^
+
+
 showBitString :: BitString -> ShowS
 showBitString bs = showString padding . showString bin
   where
   bin     = showIntAtBase 2 fmt (bsData bs) ""
-  padding = replicate (bsLength bs - length bin) '0'
+  padding = replicate (bitCount (bsLength bs) - length bin) '0'
   fmt 0   = '0'
   fmt 1   = '1'
   fmt _   = error "invalid binary digit value"
 
 
--- | Generate a mask from a number of bits desired.
-maskBits :: Int -> Integer
-maskBits len
-  | len <= 0  = 0
-  | otherwise = pred (bit len)
-
-take :: Int -> BitString -> BitString
+-- | Extract a smaller BitString with the specified number of bits from the
+-- \"start\" of a larger BitString.
+take :: NumBits -> BitString -> BitString
 take n bs@(BitString l i)
   | n >= l    = bs
   | otherwise = toBitString n i
 
-drop :: Int -> BitString -> BitString
-drop n (BitString l i)
-  | n >= l    = mempty
-  | otherwise = BitString (l - n) (i `shiftR` n)
 
-splitAt :: Int -> BitString -> (BitString,BitString)
-splitAt n bs@(BitString l i)
-  | n <= 0    = (mempty, bs)
-  | n >= l    = (bs, mempty)
-  | otherwise = (toBitString n i, toBitString (l - n) (i `shiftR` n))
+-- | Remove the specified number of bits from the beginning of a BitString and
+-- return the remaining as a smaller BitString.
+
+drop :: NumBits -> BitString -> BitString
+drop !n !(BitString l i)
+  | n >= l    = emptyBitString
+  | otherwise =
+      let !(I# n#) = bitCount n
+          !(I# l#) = bitCount l
+          !(I# i#) = i
+      in BitString (NumBits (I# (l# -# n#))) (I# (i# `uncheckedIShiftRL#` n#))
diff --git a/src/Data/LLVM/BitCode/Bitstream.hs b/src/Data/LLVM/BitCode/Bitstream.hs
--- a/src/Data/LLVM/BitCode/Bitstream.hs
+++ b/src/Data/LLVM/BitCode/Bitstream.hs
@@ -16,60 +16,56 @@
   , parseMetadataStringLengths
   ) where
 
-import Data.LLVM.BitCode.BitString as BS
-import Data.LLVM.BitCode.GetBits
+import           Data.LLVM.BitCode.BitString as BS
+import           Data.LLVM.BitCode.GetBits
 
-import Control.Applicative ((<$>))
-import Control.Monad (unless,replicateM,guard)
-import Data.Monoid (Monoid(..))
-import Data.Word (Word8,Word16,Word32)
+import           Control.Monad ( unless, replicateM, guard )
+import           Data.Bits ( Bits )
 import qualified Data.ByteString as S
 import qualified Data.ByteString.Lazy as L
 import qualified Data.Map as Map
-import qualified Data.Serialize as C
+import           Data.Word ( Word8, Word16, Word32 )
 
 
 -- Primitive Reads -------------------------------------------------------------
 
 -- | Parse a @Bool@ out of a single bit.
 boolean :: GetBits Bool
-boolean  = do
-  bs <- fixed 1
-  return (bsData bs == 1)
+boolean  = ((1 :: Word8) ==) . fromBitString <$> fixed (Bits' 1)
 
+
 -- | Parse a Num type out of n-bits.
-numeric :: Num a => Int -> GetBits a
-numeric n = do
-  bs <- fixed n
-  return (fromIntegral (bsData bs))
+numeric :: (Num a, Bits a) => NumBits -> GetBits a
+numeric n = fromBitString <$> fixed n
 
+
 -- | Get a @BitString@ formatted as vbr.
-vbr :: Int -> GetBits BitString
-vbr n = loop mempty
+vbr :: NumBits -> GetBits BitString
+vbr n = loop emptyBitString
   where
-  len      = n - 1
+  len      = subtractBitCounts n (Bits' 1)
   loop acc = acc `seq` do
     chunk <- fixed len
     cont  <- boolean
-    let acc' = acc `mappend` chunk
+    let acc' = acc `joinBitString` chunk
     if cont
        then loop acc'
        else return acc'
 
 -- | Process a variable-bit encoded integer.
-vbrNum :: Num a => Int -> GetBits a
+vbrNum :: (Num a, Bits a) => NumBits -> GetBits a
 vbrNum n = fromBitString <$> vbr n
 
 -- | Decode a 6-bit encoded character.
-char6 :: GetBits Char
+char6 :: GetBits Word8
 char6  = do
-  word <- numeric 6
+  word <- numeric $ Bits' 6
   case word of
-    n | 0  <= n && n <= 25 -> return (toEnum (n + 97))
-      | 26 <= n && n <= 51 -> return (toEnum (n + 39))
-      | 52 <= n && n <= 61 -> return (toEnum (n - 4))
-    62                     -> return '.'
-    63                     -> return '_'
+    n | 0  <= n && n <= 25 -> return (n + 97)
+      | 26 <= n && n <= 51 -> return (n + 39)
+      | 52 <= n && n <= 61 -> return (n - 4)
+    62                     -> return (fromIntegral (fromEnum '.'))
+    63                     -> return (fromIntegral (fromEnum '_'))
     _                      -> fail "invalid char6"
 
 
@@ -81,17 +77,19 @@
   } deriving (Show)
 
 parseBitstream :: S.ByteString -> Either String Bitstream
-parseBitstream  = C.runGet (runGetBits getBitstream)
+parseBitstream = runGetBits getBitstream
 
 parseBitCodeBitstream :: S.ByteString -> Either String Bitstream
-parseBitCodeBitstream  = C.runGet (runGetBits getBitCodeBitstream)
+parseBitCodeBitstream = parseBitCodeBitstreamLazy . L.fromStrict
 
 parseBitCodeBitstreamLazy :: L.ByteString -> Either String Bitstream
-parseBitCodeBitstreamLazy  = C.runGetLazy (runGetBits getBitCodeBitstream)
+parseBitCodeBitstreamLazy = runGetBits getBitCodeBitstream . L.toStrict
 
 -- | The magic constant at the beginning of all llvm-bitcode files.
 bcMagicConst :: BitString
-bcMagicConst  = BitString 8 0x42 `mappend` BitString 8 0x43
+bcMagicConst  = toBitString (Bits' 8) 0x42
+                `joinBitString`
+                toBitString (Bits' 8) 0x43
 
 -- | Parse a @Bitstream@ from either a normal bitcode file, or a wrapped
 -- bitcode.
@@ -101,31 +99,32 @@
   case mb of
     Nothing -> getBitstream
     Just () -> do
-      skip 32 -- Version
-      off <- fixed 32
+      skip $ Bits' 32 -- Version
+      off <- fixed $ Bits' 32
       -- the offset should always be 20 (5 word32 values)
       unless (fromBitString off == (20 :: Int))
           (fail ("invalid offset value: " ++ show off))
-      size <- fixed 32
-      skip 32 -- CPUType
-      isolate (fromBitString size `div` 4) getBitstream
+      size <- Bytes' . fromBitString <$> (fixed $ Bits' 32)
+      skip $ Bits' 32 -- CPUType
+      isolate size getBitstream
 
 bcWrapperMagicConst :: BitString
-bcWrapperMagicConst  = mconcat [byte 0xDE, byte 0xC0, byte 0x17, byte 0x0B]
+bcWrapperMagicConst  =
+  foldr1 joinBitString [ byte 0xDE, byte 0xC0, byte 0x17, byte 0x0B]
   where
-  byte = BitString 8
+  byte = toBitString (Bits' 8)
 
 guardWrapperMagic :: GetBits ()
 guardWrapperMagic  = do
-  magic <- fixed 32
+  magic <- fixed (Bits' 32)
   guard (magic == bcWrapperMagicConst)
 
 -- | Parse a @Bitstream@.
 getBitstream :: GetBits Bitstream
 getBitstream  = label "bitstream" $ do
-  bc       <- fixed 16
+  bc       <- fixed $ Bits' 16
   unless (bc == bcMagicConst) (fail "Invalid magic number")
-  appMagic <- numeric 16
+  appMagic <- numeric $ Bits' 16
   entries  <- getTopLevelEntries
   return Bitstream
     { bsAppMagic = appMagic
@@ -141,7 +140,7 @@
 
 -- | Parse top-level entries.
 getTopLevelEntries :: GetBits [Entry]
-getTopLevelEntries  = fst <$> getEntries 2 Map.empty emptyAbbrevMap True
+getTopLevelEntries  = fst <$> getEntries (Bits' 2) Map.empty emptyAbbrevMap True
 
 -- | Get as many entries as we can parse.
 getEntries :: AbbrevIdWidth -> BlockInfoMap -> AbbrevMap -> Bool
@@ -183,7 +182,7 @@
 
 -- Abbreviation IDs ------------------------------------------------------------
 
-type AbbrevIdWidth = Int
+type AbbrevIdWidth = NumBits
 
 data AbbrevId
   = END_BLOCK
@@ -214,12 +213,12 @@
 -- | Parse an abbreviation definition.
 getDefineAbbrev :: GetBits DefineAbbrev
 getDefineAbbrev  =
-  label "define abbrev" (DefineAbbrev `fmap` (getAbbrevOps =<< vbrNum 5))
+  label "define abbrev" (DefineAbbrev `fmap` (getAbbrevOps =<< vbrNum (Bits' 5)))
 
 data AbbrevOp
   = OpLiteral !BitString
-  | OpFixed   !Int
-  | OpVBR     !Int
+  | OpFixed   !NumBits
+  | OpVBR     !NumBits
   | OpArray    AbbrevOp
   | OpChar6
   | OpBlob
@@ -239,12 +238,12 @@
   let one = fmap (\x -> (x,1))
   isLiteral <- boolean
   if isLiteral
-     then one (OpLiteral <$> vbr 8)
+     then one (OpLiteral <$> (vbr $ Bits' 8))
      else do
-       enc <- numeric 3
+       enc <- numeric $ Bits' 3
        case enc :: Word8 of
-         1 -> one (OpFixed <$> vbrNum 5)
-         2 -> one (OpVBR   <$> vbrNum 5)
+         1 -> one (OpFixed . Bits' <$> vbrNum (Bits' 5))
+         2 -> one (OpVBR   . Bits' <$> vbrNum (Bits' 5))
          3 -> do
            (op,n) <- getAbbrevOp
            return (OpArray op, n+1)
@@ -285,7 +284,7 @@
 data Block = Block
   { blockId           :: !BlockId
   , blockNewAbbrevLen :: !AbbrevIdWidth
-  , blockLength       :: !Int
+  , blockLength       :: !NumBytes
   , blockEntries      :: [Entry]
   } deriving (Show)
 
@@ -304,10 +303,12 @@
 -- | A generic block.
 getGenericBlock :: BlockInfoMap -> GetBits (Block,BlockInfoMap)
 getGenericBlock bim = label "block " $ do
-  blockid      <- vbrNum 8
-  newabbrevlen <- vbrNum 4
+  blockid      <- vbrNum $ Bits' 8
+  newabbrevlen <- Bits' <$> (vbrNum $ Bits' 4)
   align32bits
-  blocklen     <- numeric 32
+  -- Block length in the bitcode is the number of 32-bit longwords; internally it
+  -- is stored as the number of bytes.
+  blocklen     <- Bytes' . (*4) <$> (numeric $ Bits' 32)
   let am = lookupAbbrevMap blockid bim
   (entries,bim') <- isolate blocklen (getEntries newabbrevlen bim am False)
   let block = Block
@@ -374,9 +375,9 @@
 -- | Parse an unabbreviated record.
 getUnabbrevRecord :: GetBits UnabbrevRecord
 getUnabbrevRecord  = label "unabbreviated record" $ do
-  code   <- vbrNum 6
-  numops <- vbrNum 6
-  ops    <- replicateM numops (vbr 6)
+  code   <- vbrNum $ Bits' 6
+  numops <- vbrNum $ Bits' 6
+  ops    <- replicateM numops (vbr $ Bits' 6)
   return UnabbrevRecord
     { unabbrevCode = code
     , unabbrevOps  = ops
@@ -412,7 +413,7 @@
   | FieldFixed   !BitString
   | FieldVBR     !BitString
   | FieldArray    [Field]
-  | FieldChar6   !Char
+  | FieldChar6   !Word8
   | FieldBlob    !S.ByteString
     deriving Show
 
@@ -430,13 +431,13 @@
   OpVBR width -> FieldVBR <$> vbr width
 
   OpArray ty -> do
-    len <- vbrNum 6
+    len <- vbrNum $ Bits' 6
     FieldArray <$> replicateM len (interpAbbrevOp ty)
 
   OpChar6 -> FieldChar6 <$> char6
 
   OpBlob -> do
-    len   <- vbrNum 6
+    len   <- Bytes' <$> (vbrNum $ Bits' 6)
     bytes <- bytestring len
     return (FieldBlob bytes)
 
@@ -444,4 +445,4 @@
 -- Metadata String Lengths -----------------------------------------------------
 
 parseMetadataStringLengths :: Int -> S.ByteString -> Either String [Int]
-parseMetadataStringLengths n = C.runGet (runGetBits (replicateM n (vbrNum 6)))
+parseMetadataStringLengths n = runGetBits (replicateM n (vbrNum $ Bits' 6))
diff --git a/src/Data/LLVM/BitCode/GetBits.hs b/src/Data/LLVM/BitCode/GetBits.hs
--- a/src/Data/LLVM/BitCode/GetBits.hs
+++ b/src/Data/LLVM/BitCode/GetBits.hs
@@ -1,3 +1,8 @@
+{-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE UnboxedTuples #-}
+
 module Data.LLVM.BitCode.GetBits (
     GetBits
   , runGetBits
@@ -9,59 +14,96 @@
   , skip
   ) where
 
-import Data.LLVM.BitCode.BitString
+import           Data.LLVM.BitCode.BitString
 
-import Control.Applicative (Applicative(..),Alternative(..),(<$>))
-import Control.Arrow (first)
-import Control.Monad (MonadPlus(..),when,replicateM_)
-import Data.Bits (shiftR)
-import Data.ByteString (ByteString)
-import Data.Monoid (mempty,mappend)
-import Data.Word (Word32)
-import qualified Data.Serialize as C
+import           Control.Applicative ( Alternative(..) )
+import           Control.Monad ( MonadPlus(..) )
+import           Data.Bits ( shiftR, shiftL, (.&.), (.|.) )
+import           Data.ByteString ( ByteString )
+import qualified Data.ByteString as BS
+import           GHC.Exts
+import           GHC.Word
 
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail ( MonadFail )
+import qualified Control.Monad.Fail
+#endif
 
 -- Bit-level Parsing -----------------------------------------------------------
 
-newtype GetBits a = GetBits { unGetBits :: SubWord -> C.Get (a,SubWord) }
+newtype GetBits a =
+  GetBits { unGetBits :: BitPosition -> BS.ByteString
+                      -> (# BitsGetter a, BitPosition #)
+          }
 
+type BitPosition = (# Int#, Int# #)  -- (# current bit pos, maximum bit pos #)
+
+type BitsGetter a = Either String a -- Left is fail
+
+
 -- | Run a @GetBits@ action, returning its value, and the number of bits offset
 -- into the next byte of the stream.
-runGetBits :: GetBits a -> C.Get a
-runGetBits m = fst `fmap` unGetBits m Aligned
+runGetBits :: GetBits a -> ByteString -> Either String a
+runGetBits m bs =
+  let !startPos# = (# 0#, bitCount# $ bytesToBits $ Bytes' $ BS.length bs #)
+      !(# g, _ #) = unGetBits m startPos# bs
+  in g
 
+
 instance Functor GetBits where
   {-# INLINE fmap #-}
-  fmap f m = GetBits (\ off -> first f <$> unGetBits m off)
+  fmap f m = GetBits $
+    \ !pos# inp -> let !(# b, n# #) = unGetBits m pos# inp
+                   in (# f <$> b, n# #)
 
 instance Applicative GetBits where
   {-# INLINE pure #-}
-  pure x = GetBits (\ off -> return (x,off))
+  pure x = GetBits $ \ !pos# _ -> (# pure x, pos# #)
 
   {-# INLINE (<*>) #-}
-  f <*> x = GetBits $ \ off0 -> do
-    (g,off1) <- unGetBits f off0
-    (y,off2) <- unGetBits x off1
-    return (g y,off2)
+  f <*> x =
+    GetBits $ \ !pos# inp ->
+                let !(# g, n# #) = unGetBits f pos# inp
+                in case g of
+                     Right g' ->
+                       let !(# y, m# #) = unGetBits x n# inp
+                       in case y of
+                            Right y' -> (# Right $ g' y', m# #)
+                            Left e -> (# Left e, m# #)
+                     Left e -> (# Left e, n# #)
 
 instance Monad GetBits where
   {-# INLINE return #-}
   return = pure
 
   {-# INLINE (>>=) #-}
-  m >>= f = GetBits $ \ off0 -> do
-    (x,off1) <- unGetBits m off0
-    unGetBits (f x) off1
+  m >>= f = GetBits $ \ !pos# inp ->
+                        let !(# g, n# #) = unGetBits m pos# inp
+                            !(# gr, nr# #) = case g of
+                                               Left e -> (# Left e, n# #)
+                                               Right a -> unGetBits (f a) n# inp
+                        in (# gr, nr# #)
 
+#if !MIN_VERSION_base(4,13,0)
   {-# INLINE fail #-}
-  fail str = GetBits (\ _ -> fail str)
+  fail e = GetBits $ \ p _ -> (# Left e, p #)
+#endif
 
+instance MonadFail GetBits where
+  {-# INLINE fail #-}
+  fail e = GetBits $ \ p _ -> (# Left e, p #)
+
 instance Alternative GetBits where
   {-# INLINE empty #-}
-  empty   = GetBits (\_ -> mzero)
+  empty = GetBits $ \ p _ -> (# Left "GetBits is empty!", p #)
 
   {-# INLINE (<|>) #-}
-  a <|> b = GetBits (\ off -> unGetBits a off <|> unGetBits b off)
+  a <|> b = GetBits
+            $ \ !pos# inp ->
+                let !r@(# g, _ #) = unGetBits a pos# inp
+                in case g of
+                     Right _ -> r
+                     Left _ -> unGetBits b pos# inp
 
 instance MonadPlus GetBits where
   {-# INLINE mzero #-}
@@ -71,88 +113,274 @@
   mplus = (<|>)
 
 
--- Sub-word Bit Parsing State --------------------------------------------------
+-- | Extracts an Integer value of the specified number of bits from a ByteString,
+-- starting at the indicated bit position (fails with Left if the range to
+-- extract is not valid... i.e. > bitLimit).  Returns the Integer value along
+-- with the bit position following the extraction.
 
--- This assumes that we'll pad any incoming bitcode to a 32-bit boundary, but
--- given the use of 32-bit padding already, it seems likely that all bitcode
--- files get padded to a 32-bit boundary.
-data SubWord
-  = SubWord !Int !Word32
-  | Aligned
-    deriving (Show)
+-- There are two implementations: one builds an integer value by shifting bits,
+-- then shifts and masks the result to get the final value.  The other uses
+-- unlifted values and avoids the final shift by being smarter about individual
+-- compositions.  Their functionality should be identical, but it may be easier
+-- to debug the first.
 
-splitWord :: Int -> Int -> Word32 -> (BitString,Either Int SubWord)
-splitWord n l w = case compare n l of
-  LT -> (toBitString n (fromIntegral w), Right (SubWord (l - n) (w `shiftR` n)))
-  EQ -> (toBitString n (fromIntegral w), Right Aligned)
-  GT -> (toBitString l (fromIntegral w), Left (n - l))
+_extractFromByteString' :: NumBits {-^ the last bit accessible in the ByteString -}
+                        -> NumBits {-^ the bit to start extraction at -}
+                        -> NumBits {-^ the number of bits to extract -}
+                        -> ByteString {-^ the ByteString to extract from -}
+                        -> Either String (Int, NumBits)
+_extractFromByteString' bitLimit startBit numBits bs =
+  let Bytes' s8 = fst (bitsToBytes startBit)
+      Bytes' r8 = fst (bitsToBytes numBits)
+      rcnt = r8 + 2 -- 2 == pre-shift overflow byte on either side
 
--- | Get a @BitString@, yielding a new partial word.
-getBitString :: Int -> C.Get (BitString,SubWord)
-getBitString 0 = return (mempty,Aligned)
-getBitString n = getBitStringPartial n 32 =<< C.getWord32le
+      -- Extract the relevant bits from the ByteCode, with padding to byte
+      -- boundaries into ws.
+      ws = BS.take rcnt $ BS.drop s8 bs
 
--- | A combination of @splitWord@ and @getBitString@ that takes an initial
--- partial word as input.
-getBitStringPartial :: Int -> Int -> Word32 -> C.Get (BitString,SubWord)
-getBitStringPartial n l w = case splitWord n l w of
-  (bs,Right off) -> return (bs, off)
-  (bs,Left n')   -> do
-    (rest,off) <- getBitString n'
-    return (bs `mappend` rest, off)
+      -- Combine the extracted bytes into an Integer value in wi.
+      wi = BS.foldr (\w a -> a `shiftL` 8 .|. fromIntegral w) (0::Int) ws
 
--- | Skip a byte of input, which must be zero.
-skipZeroByte :: C.Get ()
-skipZeroByte = do
-  x <- C.getWord8
-  when (x /= 0) $ fail "alignment padding was not zeros"
+      -- Mask is 0-bit based set of bits wanted in the result
+      mask = ((1::Int) `shiftL` bitCount numBits) - 1
 
--- | Get a @ByteString@ of @n@ bytes, and then align to 32 bits.
-getByteString :: Int -> C.Get (ByteString,SubWord)
-getByteString n = do
-  bs <- C.getByteString n
-  replicateM_ ((- n) `mod` 4) skipZeroByte
-  return (bs, Aligned)
+      -- Shift the desired value down to byte alignment and then discard any
+      -- excess high bits.
+      vi = wi `shiftR` (bitCount startBit .&. 7) .&. mask
 
+      updPos = addBitCounts startBit numBits
+  in if updPos > bitLimit
+     then Left ("Attempt to read bits past limit (newPos="
+                <> show updPos <> ", limit=" <> show bitLimit <> ")"
+               )
+     else Right (vi, updPos)
 
+extractFromByteString :: Int# {-^ the last bit accessible in the ByteString -}
+                      -> Int# {-^ the bit to start extraction at -}
+                      -> Int# {-^ the number of bits to extract -}
+                      -> ByteString {-^ the ByteString to extract from -}
+                      -> Either String (() -> (# Int#, Int# #))
+extractFromByteString !bitLim# !sBit# !nbits# bs =
+     if isTrue# ((1# `uncheckedIShiftL#` (nbits#)) /=# 0#)
+        -- (nbits# -# 1#) above would allow 64-bit value extraction, but this
+        -- function cannot actually support a size of 64, because Int# is signed,
+        -- so it doesn't properly use the high bit in numeric operations.  This
+        -- seems to be OK at this point because LLVM bitcode does not attempt to
+        -- encode actual 64-bit values.
+     then
+       let !updPos# = sBit# +# nbits#
+       in if isTrue# (updPos# <=# bitLim#)
+          then
+            let !s8# = sBit# `uncheckedIShiftRL#` 3#
+                !hop# = sBit# `andI#` 7#
+                !r8# = ((hop# +# nbits# +# 7#) `uncheckedIShiftRL#` 3#)
+                !mask# = (1# `uncheckedIShiftL#` nbits#) -# 1#
+                -- Here, s8# is the size in 8-bit bytes, hop# is the number of
+                -- bits shifted from the byte boundary, r8# is the rounded number
+                -- of bytes actually needed to retrieve to get the value to
+                -- account for shifting, and mask# is the mask for the final
+                -- target set of bits after shifting.
+#if MIN_VERSION_base(4,16,0)
+                word8ToInt !w8# = word2Int# (word8ToWord# w8#)
+#else
+                -- technically #if !MIN_VERSION_ghc_prim(0,8,0), for GHC 9.2, but
+                -- since ghc_prim isn't a direct dependency and is re-exported
+                -- from base, this define needs to reference the base version.
+                word8ToInt = word2Int#
+#endif
+                -- getB# gets a value from a byte starting at bit0 of the byte
+                getB# :: Int# -> Int#
+                getB# !i# =
+                  case i# of
+                    0# -> let !(W8# w#) = bs `BS.index` (I# s8#)
+                          in word8ToInt w#
+                    _ -> let !(W8# w#) = (bs `BS.index` (I# (s8# +# i#)))
+                         in (word8ToInt w#) `uncheckedIShiftL#` (8# *# i#)
+                -- getSB# gets a value from a byte shifting from a non-zero start
+                -- bit within the byte.
+                getSB# :: Int# -> Int#
+                getSB# !i# =
+                  case i# of
+                    0# -> let !(W8# w#) = bs `BS.index` (I# s8#)
+                          in (word8ToInt w#) `uncheckedIShiftRL#` hop#
+                    _  -> let !(W8# w#) = bs `BS.index` (I# (s8# +# i#))
+                              !shft# = (8# *# i#) -# hop#
+                          in (word8ToInt w#) `uncheckedIShiftL#` shft#
+                !vi# = mask# `andI#`
+                       (case hop# of
+                          0# -> case r8# of
+                                  1# -> getB# 0#
+                                  2# -> getB# 0# `orI#` getB# 1#
+                                  3# -> getB# 0# `orI#` getB# 1# `orI#`
+                                        getB# 2#
+                                  4# -> getB# 0# `orI#` getB# 1# `orI#`
+                                        getB# 2# `orI#` getB# 3#
+                                  5# -> getB# 0# `orI#` getB# 1# `orI#`
+                                        getB# 2# `orI#` getB# 3# `orI#`
+                                        getB# 4#
+                                  6# -> getB# 0# `orI#` getB# 1# `orI#`
+                                        getB# 2# `orI#` getB# 3# `orI#`
+                                        getB# 4# `orI#` getB# 5#
+                                  7# -> getB# 0# `orI#` getB# 1# `orI#`
+                                        getB# 2# `orI#` getB# 3# `orI#`
+                                        getB# 4# `orI#` getB# 5# `orI#`
+                                        getB# 6#
+                                  8# -> getB# 0# `orI#` getB# 1# `orI#`
+                                        getB# 2# `orI#` getB# 3# `orI#`
+                                        getB# 4# `orI#` getB# 5# `orI#`
+                                        getB# 6# `orI#` getB# 7#
+                                  -- This is the catch-all loop for other sizes
+                                  -- not addressed above.
+                                  _ -> let join !(W8# w#) !(I# a#) =
+                                             I# ((a# `uncheckedIShiftL#` 8#)
+                                                 `orI#` (word8ToInt w#))
+                                           bs' = BS.take (I# (r8# +# 2#))
+                                                 $ BS.drop (I# s8#) bs
+                                           !(I# v#) = BS.foldr join (0::Int) bs'
+                                       in mask# `andI#` (v# `uncheckedIShiftRL#` hop#)
+                          _ -> case r8# of
+                                 1# -> getSB# 0#
+                                 2# -> getSB# 0# `orI#` getSB# 1#
+                                 3# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2#
+                                 4# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2# `orI#` getSB# 3#
+                                 5# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2# `orI#` getSB# 3# `orI#`
+                                       getSB# 4#
+                                 6# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2# `orI#` getSB# 3# `orI#`
+                                       getSB# 4# `orI#` getSB# 5#
+                                 7# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2# `orI#` getSB# 3# `orI#`
+                                       getSB# 4# `orI#` getSB# 5# `orI#`
+                                       getSB# 6#
+                                 8# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2# `orI#` getSB# 3# `orI#`
+                                       getSB# 4# `orI#` getSB# 5# `orI#`
+                                       getSB# 6# `orI#` getSB# 7#
+                                 -- n.b. these are hand-unrolled cases for common
+                                 -- sizes this is called for.
+                                 9# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                       getSB# 2# `orI#` getSB# 3# `orI#`
+                                       getSB# 4# `orI#` getSB# 5# `orI#`
+                                       getSB# 6# `orI#` getSB# 7# `orI#`
+                                       getSB# 8#
+                                 18# -> getSB# 0# `orI#` getSB# 1# `orI#`
+                                        getSB# 2# `orI#` getSB# 3# `orI#`
+                                        getSB# 4# `orI#` getSB# 5# `orI#`
+                                        getSB# 6# `orI#` getSB# 7# `orI#`
+                                        getSB# 8# `orI#` getSB# 9# `orI#`
+                                        getSB# 10# `orI#` getSB# 11# `orI#`
+                                        getSB# 12# `orI#` getSB# 13# `orI#`
+                                        getSB# 14# `orI#` getSB# 15# `orI#`
+                                        getSB# 16# `orI#` getSB# 17#
+                                 -- This is the catch-all loop for other sizes
+                                 -- not addressed above.
+                                 _ -> let join !(W8# w#) !(I# a#) =
+                                            I# ((a# `uncheckedIShiftL#` 8#)
+                                                `orI#` (word8ToInt w#))
+                                          bs' = BS.take (I# (r8# +# 2#))
+                                                $ BS.drop (I# s8#) bs
+                                          !(I# v#) = BS.foldr join (0::Int) bs'
+                                      in mask# `andI#` (v# `uncheckedIShiftRL#` hop#)
+                       )
+            in Right $ \_ -> (# vi#, updPos# #)
+          else Left "Attempt to read bits past limit"
+     else
+       -- BitString stores an Int, but number of extracted bits is larger than
+       -- an Int can represent.
+       Left "Attempt to extracted large value"
+
+
 -- Basic Interface -------------------------------------------------------------
 
 -- | Read zeros up to an alignment of 32-bits.
 align32bits :: GetBits ()
-align32bits  = GetBits $ \ off -> case off of
-  Aligned     -> return ((),Aligned)
-  SubWord _ 0 -> return ((),Aligned)
-  SubWord _ _ -> fail "alignment padding was not zeros"
+align32bits  = GetBits $ \ !pos# inp ->
+  let !(# curBit#, ttlBits# #) = pos#
+      !s32# = curBit# `andI#` 31#
+      !r32# = 32# -# s32#  -- num bits to reach next 32-bit boundary
+      nonZero = "alignments @" <> show (I# curBit#)
+                <> " not zeroes up to 32-bit boundary"
+  in if isTrue# (s32# ==# 0#)
+     then (# Right (), pos# #)
+     else case extractFromByteString ttlBits# curBit# r32# inp of
+            Right getRes ->
+              let !(# vi#, newPos# #) = getRes ()
+              in if isTrue# (vi# ==# 0#)
+                 then (# Right (), (# newPos#, ttlBits# #) #)
+                 else (# Left nonZero, pos# #)
+            Left e -> (# Left e, pos# #)
 
+
 -- | Read out n bits as a @BitString@.
-fixed :: Int -> GetBits BitString
-fixed n = GetBits $ \ off -> case off of
-  Aligned     -> getBitString n
-  SubWord l w -> getBitStringPartial n l w
+fixed :: NumBits -> GetBits BitString
+fixed !(Bits' (I# n#)) = GetBits
+  $ \ !s@(# cur#, lim# #) ->
+      \inp ->
+        case extractFromByteString lim# cur# n# inp of
+          Right getRes ->
+            let !(# v#, p# #) = getRes ()
+            in (# pure $ toBitString (Bits' (I# n#)) (I# v#)
+               , (# p#, lim# #)
+               #)
+          Left e -> (# Left e, s #)
 
--- | Read out n bytes as a @ByteString@, aligning to a 32-bit boundary before and after.
-bytestring :: Int -> GetBits ByteString
-bytestring n = GetBits $ \ off -> case off of
-  Aligned     -> getByteString n
-  SubWord _ 0 -> getByteString n
-  SubWord _ _ -> fail "alignment padding was not zeros"
 
+-- | Read out n bytes as a @ByteString@, aligning to a 32-bit boundary before and
+-- after.
+bytestring :: NumBytes -> GetBits ByteString
+bytestring n@(Bytes' nbytes) = do
+  align32bits
+  r <- GetBits
+       $ \ !(# pos#, lim# #) ->
+           \inp ->
+             let !sbyte# = pos# `uncheckedIShiftRL#` 3# -- known to be aligned
+                 !endAt# = pos# +# bitCount# (bytesToBits n)
+                 !end# = (# endAt#, lim# #)
+                 err = "Sub-bytestring attempted beyond end of input bytestring"
+             in if isTrue# (endAt# <=# lim#)
+                then (# pure $ BS.take nbytes $ BS.drop (I# sbyte#) inp, end# #)
+                else (# Left err, end# #)
+  align32bits
+  return r
+
+
 -- | Add a label to the error tag stack.
 label :: String -> GetBits a -> GetBits a
-label l m = GetBits (\ off -> C.label l (unGetBits m off))
+label l m = GetBits $ \ !pos# inp ->
+                        let !(# j, n# #) = unGetBits m pos# inp
+                        in case j of
+                             Left e -> (# Left $ e <> "\n  " <> l, n# #)
+                             Right r -> (# Right r, n# #)
 
--- | Isolate input length, in 32-bit words.
-isolate :: Int -> GetBits a -> GetBits a
-isolate ws m = GetBits (\ off -> C.isolate (ws * 4) (unGetBits m off))
 
+-- | Isolate input to a sub-span of the specified byte length.
+isolate :: NumBytes -> GetBits a -> GetBits a
+isolate ws m =
+  GetBits $ \ !(# pos#, lim# #) ->
+              \inp ->
+                let !l# = pos# +# bitCount# (bytesToBits ws)
+                    !(# r, (# x#, _ #) #) = unGetBits m (# pos#, l# #) inp
+                in (# r, (# x#, lim# #) #)
+
+
 -- | Try to parse something, returning Nothing when it fails.
---
--- XXX this will hang on to the parsing state at the Get and GetBits levels, so
--- a long-running computation will keep the current state until it finishes.
+
 try :: GetBits a -> GetBits (Maybe a)
 try m = (Just <$> m) `mplus` return Nothing
 
-skip :: Int -> GetBits ()
-skip n = do
-  _ <- fixed n
-  return ()
+
+-- | Skips the specified number of bits
+
+skip :: NumBits -> GetBits ()
+skip !(Bits' (I# n#)) =
+  GetBits $ \ !(# cur#, lim# #) ->
+              let !newLoc# = cur# +# n#
+                  !newPos# = (# newLoc#, lim# #)
+              in if isTrue# (newLoc# ># lim#)
+                 then \_ -> (# Left "skipped past end of bytestring"
+                            , newPos#
+                              #)
+                 else \_ -> (# Right (), newPos# #)
diff --git a/src/Data/LLVM/BitCode/IR.hs b/src/Data/LLVM/BitCode/IR.hs
--- a/src/Data/LLVM/BitCode/IR.hs
+++ b/src/Data/LLVM/BitCode/IR.hs
@@ -6,13 +6,14 @@
 
 import Data.LLVM.BitCode.Bitstream
 import Data.LLVM.BitCode.BitString
+import Data.LLVM.BitCode.IR.Blocks
 import Data.LLVM.BitCode.IR.Module (parseModuleBlock)
 import Data.LLVM.BitCode.Match
 import Data.LLVM.BitCode.Parse
+import Data.LLVM.BitCode.Record
 import Text.LLVM.AST
 
-import Control.Monad ((<=<),unless)
-import Data.Monoid (mappend)
+import Control.Monad (unless,forM_)
 import Data.Word (Word16)
 
 
@@ -20,11 +21,9 @@
 
 -- | The magic number that identifies a @Bitstream@ structure as LLVM IR.
 llvmIrMagic :: Word16
-llvmIrMagic  = fromBitString (toBitString 8 0xc0 `mappend` toBitString 8 0xde)
-
--- | Block selector for the top-level module block.
-moduleBlock :: Match Entry [Entry]
-moduleBlock  = fmap blockEntries . hasBlockId 8 <=< block
+llvmIrMagic  = fromBitString (toBitString (Bits' 8) 0xc0
+                              `joinBitString`
+                              toBitString (Bits' 8) 0xde)
 
 -- | Parse an LLVM Module out of a Bitstream object.
 parseModule :: Bitstream -> Parse Module
@@ -32,6 +31,16 @@
   unless (bsAppMagic == llvmIrMagic) (fail "Bitstream is not an llvm-ir")
   parseTopLevel bsEntries
 
+findTables :: [Entry] -> Parse ()
+findTables es = forM_ es $ \e ->
+  case e of
+    (strtabBlockId -> Just [ abbrevDef -> Just _
+                           , abbrev -> Just (fromAbbrev -> Just r)
+                           ]) -> do
+      st <- mkStrtab <$> parseField r 0 fieldBlob
+      setStringTable st
+    --(symtabBlockId -> Just _) -> fail "Found symbol table."
+    _ -> return ()
 
 -- | The only top-level block that we parse currently is the module block. The
 -- Identification block that's introduced in 3.8 is ignored. In the future, it
@@ -39,7 +48,8 @@
 -- aid error reporting.
 parseTopLevel :: [Entry] -> Parse Module
 
-parseTopLevel (EntryBlock Block { blockId = 8, blockEntries } : _) =
+parseTopLevel ((moduleBlockId -> Just blockEntries) : rest) = do
+  findTables rest
   parseModuleBlock blockEntries
 
 parseTopLevel (_ : rest) =
diff --git a/src/Data/LLVM/BitCode/IR/Attrs.hs b/src/Data/LLVM/BitCode/IR/Attrs.hs
--- a/src/Data/LLVM/BitCode/IR/Attrs.hs
+++ b/src/Data/LLVM/BitCode/IR/Attrs.hs
@@ -35,3 +35,13 @@
     18 -> return Linkonce
     19 -> return LinkonceODR
     _  -> mzero
+
+visibility :: Match Field Visibility
+visibility = choose <=< numeric
+  where
+  choose :: Match Int Visibility
+  choose n = case n of
+    0 -> return DefaultVisibility
+    1 -> return HiddenVisibility
+    2 -> return ProtectedVisibility
+    _ -> mzero
diff --git a/src/Data/LLVM/BitCode/IR/Blocks.hs b/src/Data/LLVM/BitCode/IR/Blocks.hs
--- a/src/Data/LLVM/BitCode/IR/Blocks.hs
+++ b/src/Data/LLVM/BitCode/IR/Blocks.hs
@@ -16,6 +16,7 @@
 
 -- Module Block Ids ------------------------------------------------------------
 
+-- | Block selector for the top-level module block.
 moduleBlockId :: Match Entry [Entry]
 moduleBlockId  = fmap blockEntries . hasBlockId 8 <=< block
 
@@ -66,6 +67,18 @@
 metadataKindBlockId :: Match Entry [Entry]
 metadataKindBlockId  = fmap blockEntries . hasBlockId 22 <=< block
 
+strtabBlockId :: Match Entry [Entry]
+strtabBlockId  = fmap blockEntries . hasBlockId 23 <=< block
+
+ltoSummaryBlockId :: Match Entry [Entry]
+ltoSummaryBlockId  = fmap blockEntries . hasBlockId 24 <=< block
+
+symtabBlockId :: Match Entry [Entry]
+symtabBlockId  = fmap blockEntries . hasBlockId 25 <=< block
+
+syncScopeNamesBlockId :: Match Entry [Entry]
+syncScopeNamesBlockId  = fmap blockEntries . hasBlockId 26 <=< block
+
 -- Module Codes ----------------------------------------------------------------
 
 -- | MODULE_CODE_VERSION
@@ -127,3 +140,9 @@
 
 moduleCodeIFunc :: Match Entry Record
 moduleCodeIFunc = hasRecordCode 18 <=< fromEntry
+
+strtabBlobId :: Match Entry Record
+strtabBlobId = hasRecordCode 1 <=< fromEntry
+
+symtabBlobId :: Match Entry Record
+symtabBlobId = hasRecordCode 1 <=< fromEntry
diff --git a/src/Data/LLVM/BitCode/IR/Constants.hs b/src/Data/LLVM/BitCode/IR/Constants.hs
--- a/src/Data/LLVM/BitCode/IR/Constants.hs
+++ b/src/Data/LLVM/BitCode/IR/Constants.hs
@@ -1,33 +1,38 @@
-{-# LANGUAGE ViewPatterns #-}
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE PatternSynonyms #-}
 {-# LANGUAGE ScopedTypeVariables #-}
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE ViewPatterns #-}
 
 module Data.LLVM.BitCode.IR.Constants where
 
-import Data.LLVM.BitCode.Bitstream
-import Data.LLVM.BitCode.IR.Values
-import Data.LLVM.BitCode.Match
-import Data.LLVM.BitCode.Parse
-import Data.LLVM.BitCode.Record
-import Text.LLVM.AST
+import qualified Data.LLVM.BitCode.Assert as Assert
+import           Data.LLVM.BitCode.Bitstream
+import           Data.LLVM.BitCode.Match
+import           Data.LLVM.BitCode.Parse
+import           Data.LLVM.BitCode.Record
+import           Text.LLVM.AST
 
-import Control.Monad (mplus,mzero,foldM,(<=<),when)
-import Control.Monad.ST (runST,ST)
-import Data.Array.ST (newArray,readArray,MArray,STUArray)
-import Data.Bits (shiftL,shiftR,testBit)
-import Data.Char (chr)
-import Data.Maybe (fromMaybe)
-import Data.Word (Word32,Word64)
+import qualified Codec.Binary.UTF8.String as UTF8 (decode)
+import           Control.Monad (mplus,mzero,foldM,(<=<), when)
+import           Control.Monad.ST (runST,ST)
+import           Data.Array.ST (newArray,readArray,MArray,STUArray)
+import           Data.Bits (shiftL,shiftR,testBit, Bits)
+import           Data.LLVM.BitCode.BitString ( pattern Bits' )
+import qualified Data.LLVM.BitCode.BitString as BitS
 import qualified Data.Map as Map
+import           Data.Maybe (fromMaybe)
+import           Data.Word (Word16, Word32,Word64)
 
 #if __GLASGOW_HASKELL__ >= 704
-import Data.Array.Unsafe (castSTUArray)
+import           Data.Array.Unsafe (castSTUArray)
 #else
-import Data.Array.ST (castSTUArray)
+import           Data.Array.ST (castSTUArray)
 #endif
 
+import           Prelude
 
+
 -- Instruction Field Parsing ---------------------------------------------------
 
 -- | Parse a binop from a field, returning its constructor in the AST.
@@ -129,6 +134,23 @@
   choose 41 = return Isle
   choose _  = mzero
 
+unopGeneric :: forall a.
+               (UnaryArithOp -> Typed PValue -> a)
+            -> Match Field (Typed PValue -> a)
+unopGeneric uaop = choose <=< numeric
+  where
+  choose :: Match Int (Typed PValue -> a)
+  choose 0 = return (uaop FNeg)
+  choose _ = mzero
+
+unop :: Match Field (Typed PValue -> PInstr)
+unop = unopGeneric UnaryArith
+
+unopCE :: Match Field (Typed PValue -> PValue)
+unopCE = unopGeneric uaop
+  where
+  uaop op tv = ValConstExpr (ConstUnaryArith op tv)
+
 castOpGeneric :: forall c. (ConvOp -> Maybe c) -> Match Field c
 castOpGeneric op = choose <=< numeric
   where
@@ -212,21 +234,23 @@
   -- [n x value]
   5 -> label "CST_CODE_WIDE_INTEGER" $ do
     ty <- getTy
-    n  <- parseWideInteger r
+    n  <- parseWideInteger r 0
     return (getTy, Typed ty (ValInteger n):cs)
 
   -- [fpval]
   6 -> label "CST_CODE_FLOAT" $ do
-    let field = parseField r
     ty <- getTy
     ft <- (elimFloatType =<< elimPrimType ty)
         `mplus` fail "expecting a float type"
-    let build k = do
-          w <- field 0 numeric
-          return (getTy, (Typed ty $! k w):cs)
+    let build :: (Num a, Bits a) => (a -> PValue) -> Parse (Parse Type, [Typed PValue])
+        build k = do
+          a <-  parseField r 0 (fmap k . numeric)
+          return (getTy, (Typed ty $! a):cs)
     case ft of
       Float -> build (ValFloat  . castFloat)
-      _     -> build (ValDouble . castDouble)
+      Double -> build (ValDouble . castDouble)
+      X86_fp80 -> fp80build ty r cs getTy
+      _ -> error $ "parseConstantEntry: Unsupported type " ++ show ft
 
   -- [n x value number]
   7 -> label "CST_CODE_AGGREGATE" $ do
@@ -255,15 +279,15 @@
   8 -> label "CST_CODE_STRING" $ do
     let field = parseField r
     ty     <- getTy
-    values <- field 0 string
+    values <- field 0 (fieldArray char)
     return (getTy, Typed ty (ValString values):cs)
 
   -- [values]
   9 -> label "CST_CODE_CSTRING" $ do
     ty     <- getTy
-    values <- parseField r 0 cstring
+    values <- parseField r 0 (fieldArray (fieldChar6 ||| char))
         `mplus` parseFields r 0 (fieldChar6 ||| char)
-    return (getTy, Typed ty (ValString (values ++ [chr 0])):cs)
+    return (getTy, Typed ty (ValString (values ++ [0])):cs)
 
   -- [opcode,opval,opval]
   10 -> label "CST_CODE_CE_BINOP" $ do
@@ -292,7 +316,7 @@
   -- [n x operands]
   12 -> label "CST_CODE_CE_GEP" $ do
     ty <- getTy
-    v <- parseCeGep False t r
+    v <- parseCeGep CeGepCode12 t r
     return (getTy,Typed ty v:cs)
 
   -- [opval,opval,opval]
@@ -320,9 +344,12 @@
   -- [opty, opval, opval, pred]
   17 -> label "CST_CODE_CE_CMP" $ do
     let field = parseField r
-    opty <- getType                  =<< field 0 numeric
-    op0  <- getConstantFwdRef t opty =<< field 1 numeric
-    op1  <- getConstantFwdRef t opty =<< field 2 numeric
+    opty <- getType =<< field 0 numeric
+    ix0  <- field 1 numeric
+    ix1  <- field 2 numeric
+    cxt  <- getContext
+    let op0 = forwardRef cxt ix0 t
+    let op1 = forwardRef cxt ix1 t
 
     let isFloat = isPrimTypeOf isFloatingPoint
     cst <- if isFloat opty || isVectorOf isFloat opty
@@ -335,19 +362,8 @@
     return (getTy, Typed (PrimType (Integer 1)) (ValConstExpr cst):cs)
 
   18 -> label "CST_CODE_INLINEASM_OLD" $ do
-    let field = parseField r
-    ty    <- getTy
-    flags <- field 0 numeric
-    let sideEffect = testBit (flags :: Int) 0
-        alignStack = (flags `shiftR` 1) == 1
-
-    alen <- field 1 numeric
-    asm  <- parseSlice r 2 alen char
-
-    clen <- field (2+alen) numeric
-    cst  <- parseSlice r (3+alen) clen char
-
-    return (getTy, Typed ty (ValAsm sideEffect alignStack asm cst):cs)
+    tv <- parseInlineAsm InlineAsmCode18 getTy r
+    return (getTy, tv:cs)
 
   19 -> label "CST_CODE_CE_SHUFFLEVEC_EX" $ do
     notImplemented
@@ -355,19 +371,20 @@
   -- [n x operands]
   20 -> label "CST_CODE_CE_INBOUNDS_GEP" $ do
     ty <- getTy
-    v <- parseCeGep True t r
+    v <- parseCeGep CeGepCode20 t r
     return (getTy,Typed ty v:cs)
 
   -- [funty,fnval,bb#]
   21 -> label "CST_CODE_BLOCKADDRESS" $ do
+    when (length (recordFields r) < 3) $
+      fail "Invalid BLOCKADDRESS record (length < 3)"
     let field = parseField r
     ty  <- getTy
-    val <- getValue ty =<< field 1 numeric
-    bid <-                 field 2 numeric
-    sym <- elimValSymbol (typedValue val)
-        `mplus` fail "invalid function symbol in BLOCKADDRESS record"
-    let ce = ConstBlockAddr sym bid
-    return (getTy, Typed ty (ValConstExpr ce):cs)
+    ctx <- getContext
+    valref <- field 1 numeric
+    bid <- field 2 numeric
+    let ce = ConstBlockAddr (forwardRef ctx valref t) bid
+    return (getTy, Typed ty (ValConstExpr ce) : cs)
 
   -- [n x elements]
   22 -> label "CST_CODE_DATA" $ do
@@ -381,44 +398,53 @@
                   | otherwise  = ValVector (PrimType elemTy) elems
           return (getTy, Typed ty val : cs)
     case elemTy of
-      Integer 8        -> build ValInteger
-      Integer 16       -> build ValInteger
-      Integer 32       -> build ValInteger
-      Integer 64       -> build ValInteger
-      FloatType Float  -> build ValFloat
-      FloatType Double -> build ValDouble
-      _                -> fail "unknown element type in CE_DATA"
-
-  23 -> label "CST_CODE_INLINEASM" $ do
-    let field = parseField r
-    mask <- field 0 numeric
-
-    let test = testBit (mask :: Word32)
-        hasSideEffects = test 0
-        isAlignStack   = test 1
-        _asmDialect    = mask `shiftR` 2
+      Integer 8          -> build ValInteger
+      Integer 16         -> build ValInteger
+      Integer 32         -> build ValInteger
+      Integer 64         -> build ValInteger
+      FloatType Float    -> build (ValFloat . castFloat)
+      FloatType Double   -> build (ValDouble . castDouble)
+      x                  -> Assert.unknownEntity "element type" x
 
-    let len = length (recordFields r)
-    asmStrSize <- field 1 numeric
-    when (2 + asmStrSize >= len)
-         (fail "Invalid record")
+  23 -> label "CST_CODE_INLINEASM_OLD2" $ do
+    tv <- parseInlineAsm InlineAsmCode23 getTy r
+    return (getTy, tv:cs)
 
-    constStrSize <- field (2 + asmStrSize) numeric
-    when (3 + asmStrSize + constStrSize > len)
-         (fail "Invalid record")
+  -- [opty, flags, n x operands]
+  24 -> label "CST_CODE_CE_GEP_WITH_INRANGE_INDEX" $ do
+    ty <- getTy
+    v <- parseCeGep CeGepCode24 t r
+    return (getTy,Typed ty v:cs)
 
-    asmStr   <- parseSlice r  2               asmStrSize   char
-    constStr <- parseSlice r (3 + asmStrSize) constStrSize char
+  -- [opcode, opval]
+  25 -> label "CST_CODE_CE_UNOP" $ do
+    let field = parseField r
+    ty      <- getTy
+    mkInstr <- field 0 unopCE
+    opval   <- field 1 numeric
+    cxt     <- getContext
+    let v = forwardRef cxt opval t
+    return (getTy, Typed ty (mkInstr v) : cs)
 
+  26 -> label "CST_CODE_POISON" $ do
     ty <- getTy
-    let val = ValAsm hasSideEffects isAlignStack asmStr constStr
+    return (getTy, Typed ty ValPoison : cs)
 
-    return (getTy, Typed ty val : cs)
+  27 -> label "CST_CODE_DSO_LOCAL_EQUIVALENT" $ do
+    notImplemented
 
+  28 -> label "CST_CODE_INLINEASM_OLD3" $ do
+    tv <- parseInlineAsm InlineAsmCode28 getTy r
+    return (getTy, tv:cs)
 
+  29 -> label "CST_CODE_NO_CFI_VALUE" $ do
+    notImplemented
 
+  30 -> label "CST_CODE_INLINEASM" $ do
+    tv <- parseInlineAsm InlineAsmCode30 getTy r
+    return (getTy, tv:cs)
 
-  code -> fail ("unknown constant record code: " ++ show code)
+  code -> Assert.unknownEntity "constant record code" code
 
 parseConstantEntry _ st (abbrevDef -> Just _) =
   -- ignore abbreviation definitions
@@ -427,27 +453,66 @@
 parseConstantEntry _ _ e =
   fail ("constant block: unexpected: " ++ show e)
 
-parseCeGep :: Bool -> ValueTable -> Record -> Parse PValue
-parseCeGep isInbounds t r = do
-  let isExplicit = odd (length (recordFields r))
-      firstIdx = if isExplicit then 1 else 0
-      field = parseField r
-      loop n = do
+-- | The different codes for constant @getelementptr@ expressions. Each one has
+-- minor differences in how they are parsed.
+data CeGepCode
+  = CeGepCode12
+  -- ^ @CST_CODE_CE_GEP = 12@. The original.
+  | CeGepCode20
+  -- ^ @CST_CODE_CE_INBOUNDS_GEP = 20@. This adds an @inbounds@ field that
+  -- indicates that the result value should be poison if it performs an
+  -- out-of-bounds index.
+  | CeGepCode24
+  -- ^ @CST_CODE_CE_GEP_WITH_INRANGE_INDEX = 24@. This adds an @inrange@ field
+  -- that indicates that loading or storing to the result pointer will have
+  -- undefined behavior if the load or store would access memory outside of the
+  -- bounds of the indices marked as @inrange@.
+  deriving Eq
+
+-- | Parse a 'ConstGEP' value. There are several variations on this theme that
+-- are captured in the 'CeGepCode' argument.
+parseCeGep :: CeGepCode -> ValueTable -> Record -> Parse PValue
+parseCeGep code t r = do
+  let field = parseField r
+
+  (mbBaseTy, ix0) <-
+    if code == CeGepCode24 || odd (length (recordFields r))
+    then do baseTy <- getType =<< field 0 numeric
+            pure (Just baseTy, 1)
+    else pure (Nothing, 0)
+
+  (isInbounds, mInrangeIdx, ix1) <-
+    case code of
+      CeGepCode12 -> pure (False, Nothing, ix0)
+      CeGepCode20 -> pure (True, Nothing, ix0)
+      CeGepCode24 -> do
+        (flags :: Word64) <- parseField r ix0 numeric
+        let inbounds = testBit flags 0
+            inrangeIdx = flags `shiftR` 1
+        pure (inbounds, Just inrangeIdx, ix0 + 1)
+
+  let loop n = do
         ty   <- getType =<< field  n    numeric
         elt  <-             field (n+1) numeric
         rest <- loop (n+2) `mplus` return []
         cxt  <- getContext
         return (Typed ty (typedValue (forwardRef cxt elt t)) : rest)
-  mPointeeType <-
-    if isExplicit
-    then Just <$> (getType =<< field 0 numeric)
-    else pure Nothing
-  args <- loop firstIdx
-  return $! ValConstExpr (ConstGEP isInbounds mPointeeType args)
+  args <- loop ix1
+  (ptr, args') <-
+    case args of
+      [] -> fail "Invalid constant GEP with no operands"
+      (base:args') -> pure (base, args')
 
-parseWideInteger :: Record -> Parse Integer
-parseWideInteger r = do
-  limbs <- parseFields r 0 signedWord64
+  baseTy <-
+    case mbBaseTy of
+      Just baseTy -> pure baseTy
+      Nothing -> Assert.elimPtrTo "constant GEP not headed by pointer" (typedType ptr)
+
+  return $! ValConstExpr (ConstGEP isInbounds mInrangeIdx baseTy ptr args')
+
+parseWideInteger :: Record -> Int -> Parse Integer
+parseWideInteger r idx = do
+  limbs <- parseSlice r idx (length (recordFields r) - idx) signedWord64
   return (foldr (\l acc -> acc `shiftL` 64 + (toInteger l)) 0 limbs)
 
 resolveNull :: Type -> Parse PValue
@@ -455,7 +520,62 @@
   HasNull nv    -> return nv
   ResolveNull i -> resolveNull =<< getType' =<< getTypeId i
 
+-- | The different codes for inline @asm@ constants. Each one has minor
+-- differences in how they are parsed.
+data InlineAsmCode
+  = InlineAsmCode18
+    -- ^ @CST_CODE_INLINEASM_OLD = 18@. The original.
+  | InlineAsmCode23
+    -- ^ @CST_CODE_INLINEASM_OLD2 = 23@. This adds an @asmdialect@ field.
+  | InlineAsmCode28
+    -- ^ @CST_CODE_INLINEASM_OLD3 = 28@. This adds an @unwind@ field (which is
+    -- referred to as @canThrow@ in the LLVM source code).
+  | InlineAsmCode30
+    -- ^ @CST_CODE_INLINEASM = 30@. This adds an explicit function type field.
 
+-- | Parse a 'ValAsm' value. There are several variations on this theme that are
+-- captured in the 'InlineAsmCode' argument.
+parseInlineAsm :: InlineAsmCode -> Parse Type -> Record -> Parse (Typed PValue)
+parseInlineAsm code getTy r = do
+  let field = parseField r
+
+  -- If using InlineAsmCode30 or later, we parse the type as an explicit
+  -- field.
+  let parseTy  = do ty <- getType =<< field 0 numeric
+                    return (PtrTo ty, 1)
+  -- If using an older InlineAsmCode, then we retrieve the type from the
+  -- current context.
+  let useCurTy = do ty <- getTy
+                    return (ty, 0)
+  (ty, ix) <- case code of
+                InlineAsmCode18 -> useCurTy
+                InlineAsmCode23 -> useCurTy
+                InlineAsmCode28 -> useCurTy
+                InlineAsmCode30 -> parseTy
+
+  mask <- field ix numeric
+
+  let test = testBit (mask :: Word32)
+      hasSideEffects = test 0
+      isAlignStack   = test 1
+      -- We don't store these in the llvm-pretty AST at the moment:
+      _asmDialect    = test 2 -- Only with InlineAsmCode23 or later
+      _canThrow      = test 3 -- Only with InlineAsmCode28 or later
+
+  asmStrSize <- field (ix + 1) numeric
+  Assert.recordSizeGreater r (ix + 1 + asmStrSize)
+
+  constStrSize <- field (ix + 2 + asmStrSize) numeric
+  Assert.recordSizeGreater r (ix + 2 + asmStrSize + constStrSize)
+
+  asmStr   <- fmap UTF8.decode $ parseSlice r (ix + 2)              asmStrSize   char
+  constStr <- fmap UTF8.decode $ parseSlice r (ix + 3 + asmStrSize) constStrSize char
+
+  let val = ValAsm hasSideEffects isAlignStack asmStr constStr
+
+  return (Typed ty val)
+
+
 -- Float/Double Casting --------------------------------------------------------
 
 castFloat :: Word32 -> Float
@@ -470,3 +590,41 @@
   arr <- newArray (0 :: Int, 0) x
   res <- castSTUArray arr
   readArray res 0
+
+-- fp80 is double extended format.  This conforms to IEEE 754, but is
+-- store as two values: the significand and the exponent.  Discussion
+-- here is relative to information from the LLVM source based at
+-- https://github.com/llvm-mirror/llvm/blob/release_60 (hereafter
+-- identified as LGH).
+--
+-- The exponent range is 16383..-16384 (14 bits), and the precision
+-- (significand bits) is 64, including the integer bit (see
+-- LGH/lib/Support/APFloat.cpp:75).
+--
+-- When reading the Record here, there are two fields, one of 65 bits
+-- and the other of up to 20 bits (which clearly adds to more than
+-- 80... extras are ignored).  Bits are not stored in the expected way
+-- and "compensation" is needed. First the two record fields are
+-- combined into an 80-bit integer (see
+-- LGH/lib/Bitcode/Reader/BitcodeReader.cpp:2196-2202), using only 64
+-- bits of the first field and 16 bits of the second field, discarding
+-- the extra bits.  This is the result of this build operation; if
+-- this result is used semantically, it should be analyzed as per
+-- LGH/lib/Support/APFloat.cpp:3076-3108.
+
+fp80build :: Type -> Record -> [Typed PValue] -> Parse Type
+          -> Parse (Parse Type, [Typed PValue])
+fp80build ty r cs getTy =
+  do v1 <- parseField r 0 fieldLiteral
+     v2 <- parseField r 1 fieldLiteral
+     let -- Note bs1 <> bs2 results in bs2|bs1 layout, shifting bs2 to higher bits
+         v64_0 = BitS.take (Bits' 64)
+                 $ BitS.take (Bits' 16) v2 `BitS.joinBitString` v1
+         v64_1 = BitS.drop (Bits' 48) v2
+         -- result is v64_1|v64_0 being v0|v1
+         fullexp :: Word16
+         fullexp = BitS.fromBitString $ BitS.take (Bits' 16) v64_1 -- includes sign bit
+         significnd :: Word64
+         significnd = BitS.fromBitString $ v64_0
+         fp80Val = FP80_LongDouble fullexp significnd
+     return (getTy, Typed ty (ValFP80 fp80Val):cs)
diff --git a/src/Data/LLVM/BitCode/IR/Function.hs b/src/Data/LLVM/BitCode/IR/Function.hs
--- a/src/Data/LLVM/BitCode/IR/Function.hs
+++ b/src/Data/LLVM/BitCode/IR/Function.hs
@@ -1,64 +1,117 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE TupleSections #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Data.LLVM.BitCode.IR.Function where
 
-import Data.LLVM.BitCode.Bitstream
-import Data.LLVM.BitCode.IR.Blocks
-import Data.LLVM.BitCode.IR.Constants
-import Data.LLVM.BitCode.IR.Metadata
-import Data.LLVM.BitCode.IR.Values
-import Data.LLVM.BitCode.Match
-import Data.LLVM.BitCode.Parse
-import Data.LLVM.BitCode.Record
-import Text.LLVM.AST
-import Text.LLVM.Labels
-import Text.LLVM.PP
+import qualified Data.LLVM.BitCode.Assert as Assert
+import           Data.LLVM.BitCode.Bitstream
+import           Data.LLVM.BitCode.IR.Blocks
+import           Data.LLVM.BitCode.IR.Constants
+import           Data.LLVM.BitCode.IR.Metadata
+import           Data.LLVM.BitCode.IR.Values
+import           Data.LLVM.BitCode.IR.Attrs
+import           Data.LLVM.BitCode.Match
+import           Data.LLVM.BitCode.Parse
+import           Data.LLVM.BitCode.Record
 
-import Control.Applicative ((<$>),(<*>))
-import Control.Monad (unless,mplus,mzero,foldM,(<=<))
-import Data.Bits (shiftR,bit,shiftL,testBit,(.&.),(.|.),complement)
-import Data.Int (Int32)
-import Data.Word (Word32)
+import           Text.LLVM.AST
+import           Text.LLVM.Labels
+import           Text.LLVM.PP
+
+import           Control.Monad (when,unless,mplus,mzero,foldM,(<=<))
+import           Data.Bits (shiftR,bit,shiftL,testBit,(.&.),(.|.),complement,Bits)
+import           Data.Int (Int32)
+import           Data.Word (Word32)
 import qualified Data.Foldable as F
+import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
 import qualified Data.Traversable as T
 
 
+-- | When showing a Symbol to the user, show it in the manner that it would appear
+-- in LLVM text format.  This displays the Symbol in the format associated with
+-- the latest version of LLVM supported by llvm-pretty and this library; the
+-- Symbol syntax has not changed from LLVM 3.5 through LLVM 16, and this library
+-- is intended to be able to import *any* version of LLVM, so this is not a
+-- significant issue that would drive the code changes necessary to make an
+-- actual LLVM version available here.
+
+-- NOTE: this cannot be eta-reduced to point-free format because simplified
+-- subsumption rules (introduced in GHC 9) requires eta-expansion of some higher
+-- order functions in order to maintain soundness and typecheck.
+prettySym :: Symbol -> String
+prettySym s = show $ ppLLVM llvmVlatest $ llvmPP s
+
+
 -- Function Aliases ------------------------------------------------------------
 
 type AliasList = Seq.Seq PartialAlias
 
 data PartialAlias = PartialAlias
-  { paName   :: Symbol
-  , paType   :: Type
-  , paTarget :: !Int
+  { paLinkage    :: Maybe Linkage
+  , paVisibility :: Maybe Visibility
+  , paName       :: Symbol
+  , paType       :: Type
+  , paTarget     :: !Word32
   } deriving Show
 
-parseAlias :: Int -> Record -> Parse PartialAlias
-parseAlias n r = do
+parseAliasOld :: Int -> Record -> Parse PartialAlias
+parseAliasOld n r = do
+  sym <- entryName n
   let field = parseField r
+      name = Symbol sym
   ty  <- getType   =<< field 0 numeric
   tgt <-               field 1 numeric
-  sym <- entryName n
-  let name = Symbol sym
+  lnk <-               field 2 linkage
+  vis <-               field 3 visibility
   _   <- pushValue (Typed ty (ValSymbol name))
   return PartialAlias
-    { paName   = name
-    , paType   = ty
-    , paTarget = tgt
+    { paLinkage    = Just lnk
+    , paVisibility = Just vis
+    , paName       = name
+    , paType       = ty
+    , paTarget     = tgt
     }
 
+parseAlias :: Record -> Parse PartialAlias
+parseAlias r = do
+  n <- nextValueId
+  (name, offset) <- oldOrStrtabName n r
+  let field i = parseField r (i + offset)
+  ty       <- getType =<< field 0 numeric
+  _addrSp  <-             field 1 unsigned
+  tgt      <-             field 2 numeric
+  lnk      <-             field 3 linkage
+  vis      <-             field 4 visibility
+
+
+  -- XXX: is it the case that the alias type will always be a pointer to the
+  -- aliasee?
+  _   <- pushValue (Typed (PtrTo ty) (ValSymbol name))
+
+  return PartialAlias
+    { paLinkage    = Just lnk
+    , paVisibility = Just vis
+    , paName       = name
+    , paType       = ty
+    , paTarget     = tgt
+    }
+
 finalizePartialAlias :: PartialAlias -> Parse GlobalAlias
-finalizePartialAlias pa = do
-  tv  <- getValue (paType pa) (paTarget pa)
-  tgt <- relabel (const requireBbEntryName) (typedValue tv)
+finalizePartialAlias pa = label "finalizePartialAlias" $ do
+  -- aliases refer to absolute offsets
+  tv  <- getFnValueById (paType pa) (fromIntegral (paTarget pa))
+  tgt <- liftFinalize $ relabel (const requireBbEntryName) (typedValue tv)
   return GlobalAlias
-    { aliasName   = paName pa
-    , aliasType   = paType pa
-    , aliasTarget = tgt
+    { aliasLinkage    = paLinkage pa
+    , aliasVisibility = paVisibility pa
+    , aliasName       = paName pa
+    , aliasType       = paType pa
+    , aliasTarget     = tgt
     }
 
 
@@ -70,11 +123,14 @@
 finalizeDeclare :: FunProto -> Parse Declare
 finalizeDeclare fp = case protoType fp of
   PtrTo (FunTy ret args va) -> return Declare
-    { decRetType = ret
-    , decName    = Symbol (protoName fp)
-    , decArgs    = args
-    , decVarArgs = va
-    , decAttrs   = []
+    { decLinkage    = protoLinkage fp
+    , decVisibility = protoVisibility fp
+    , decRetType    = ret
+    , decName       = protoSym fp
+    , decArgs       = args
+    , decVarArgs    = va
+    , decAttrs      = []
+    , decComdat     = protoComdat fp
     }
   _ -> fail "invalid type on function prototype"
 
@@ -86,20 +142,22 @@
 -- | A define with a list of statements for a body, instead of a list of basic
 -- bocks.
 data PartialDefine = PartialDefine
-  { partialLinkage  :: Maybe Linkage
-  , partialGC       :: Maybe GC
-  , partialSection  :: Maybe String
-  , partialRetType  :: Type
-  , partialName     :: Symbol
-  , partialArgs     :: [Typed Ident]
-  , partialVarArgs  :: Bool
-  , partialBody     :: BlockList
-  , partialBlock    :: StmtList
-  , partialBlockId  :: !Int
-  , partialSymtab   :: ValueSymtab
-  , partialMetadata :: Map.Map PKindMd PValMd
-  , partialGlobalMd :: [PartialUnnamedMd]
-  } deriving (Show)
+  { partialLinkage    :: Maybe Linkage
+  , partialVisibility :: Maybe Visibility
+  , partialGC         :: Maybe GC
+  , partialSection    :: Maybe String
+  , partialRetType    :: Type
+  , partialName       :: Symbol
+  , partialArgs       :: [Typed Ident]
+  , partialVarArgs    :: Bool
+  , partialBody       :: BlockList
+  , partialBlock      :: StmtList
+  , partialBlockId    :: !Int
+  , partialSymtab     :: ValueSymtab
+  , partialMetadata   :: Map.Map PKindMd PValMd
+  , partialGlobalMd   :: !(Seq.Seq PartialUnnamedMd)
+  , partialComdatName :: Maybe String
+  } deriving Show
 
 -- | Generate a partial function definition from a function prototype.
 emptyPartialDefine :: FunProto -> Parse PartialDefine
@@ -111,19 +169,21 @@
   symtab <- initialPartialSymtab
 
   return PartialDefine
-    { partialLinkage  = protoLinkage proto
-    , partialGC       = protoGC proto
-    , partialSection  = protoSect proto
-    , partialRetType  = rty
-    , partialName     = Symbol (protoName proto)
-    , partialArgs     = zipWith Typed tys names
-    , partialVarArgs  = va
-    , partialBody     = Seq.empty
-    , partialBlock    = Seq.empty
-    , partialBlockId  = 0
-    , partialSymtab   = symtab
-    , partialMetadata = Map.empty
-    , partialGlobalMd = []
+    { partialLinkage    = protoLinkage proto
+    , partialVisibility = protoVisibility proto
+    , partialGC         = protoGC proto
+    , partialSection    = protoSect proto
+    , partialRetType    = rty
+    , partialName       = protoSym proto
+    , partialArgs       = zipWith Typed tys names
+    , partialVarArgs    = va
+    , partialBody       = mempty
+    , partialBlock      = mempty
+    , partialBlockId    = 0
+    , partialSymtab     = symtab
+    , partialMetadata   = mempty
+    , partialGlobalMd   = mempty
+    , partialComdatName = protoComdat proto
     }
 
 -- | Set the statement list in a partial define.
@@ -136,7 +196,7 @@
 
 initialPartialSymtab :: Parse ValueSymtab
 initialPartialSymtab  = do
-  mb     <- bbEntryName 0
+  mb <- liftFinalize $ bbEntryName 0
   case mb of
     Just{}  -> return emptyValueSymtab
     Nothing -> do
@@ -162,45 +222,48 @@
 
 
 
-type BlockLookup = Symbol -> Int -> Parse BlockLabel
+type BlockLookup = Symbol -> Int -> Finalize BlockLabel
 
 lookupBlockName :: DefineList -> BlockLookup
 lookupBlockName dl = lkp
   where
   syms = Map.fromList [ (partialName d, partialSymtab d) | d <- F.toList dl ]
   lkp fn bid = case Map.lookup fn syms of
-    Nothing -> fail ("symbol " ++ show (ppLLVM (ppSymbol fn)) ++ " is not defined")
-    Just st -> case Map.lookup (SymTabBBEntry bid) st of
+    Nothing -> fail ("symbol " ++ prettySym fn ++ " is not defined")
+    Just st -> case IntMap.lookup bid (bbSymtab st) of
       Nothing -> fail ("block id " ++ show bid ++ " does not exist")
       Just sn -> return (mkBlockLabel sn)
 
 -- | Finalize a partial definition.
 finalizePartialDefine :: BlockLookup -> PartialDefine -> Parse Define
 finalizePartialDefine lkp pd =
+  label "finalizePartialDefine" $
   -- augment the symbol table with implicitly named anonymous blocks, and
   -- generate basic blocks.
   withValueSymtab (partialSymtab pd) $ do
-    body <- finalizeBody lkp (partialBody pd)
+    body <- liftFinalize $ finalizeBody lkp (partialBody pd)
     md <- finalizeMetadata (partialMetadata pd)
     return Define
-      { defLinkage  = partialLinkage pd
-      , defGC       = partialGC pd
-      , defAttrs    = []
-      , defRetType  = partialRetType pd
-      , defName     = partialName pd
-      , defArgs     = partialArgs pd
-      , defVarArgs  = partialVarArgs pd
-      , defBody     = body
-      , defSection  = partialSection pd
-      , defMetadata = md
+      { defLinkage    = partialLinkage pd
+      , defVisibility = partialVisibility pd
+      , defGC         = partialGC pd
+      , defAttrs      = []
+      , defRetType    = partialRetType pd
+      , defName       = partialName pd
+      , defArgs       = partialArgs pd
+      , defVarArgs    = partialVarArgs pd
+      , defBody       = body
+      , defSection    = partialSection pd
+      , defMetadata   = md
+      , defComdat     = partialComdatName pd
       }
 
 finalizeMetadata :: PFnMdAttachments -> Parse FnMdAttachments
 finalizeMetadata patt = Map.fromList <$> mapM f (Map.toList patt)
-  where f (k,md) = (,) <$> getKind k <*> finalizePValMd md
+  where f (k,md) = (,) <$> getKind k <*> liftFinalize (finalizePValMd md)
 
 -- | Individual label resolution step.
-resolveBlockLabel :: BlockLookup -> Maybe Symbol -> Int -> Parse BlockLabel
+resolveBlockLabel :: BlockLookup -> Maybe Symbol -> Int -> Finalize BlockLabel
 resolveBlockLabel lkp mbSym = case mbSym of
   Nothing  -> requireBbEntryName
   Just sym -> lkp sym
@@ -235,7 +298,7 @@
 terminateBlock :: PartialDefine -> Parse PartialDefine
 terminateBlock d = do
   let next = partialBlockId d + 1
-  mb <- bbEntryName next
+  mb <- liftFinalize $ bbEntryName next
   d' <- case mb of
     Just _  -> return d
     Nothing -> do
@@ -255,7 +318,7 @@
 type BlockList = Seq.Seq PartialBlock
 
 -- | Process a @BlockList@, turning it into a list of basic blocks.
-finalizeBody :: BlockLookup -> BlockList -> Parse [BasicBlock]
+finalizeBody :: BlockLookup -> BlockList -> Finalize [BasicBlock]
 finalizeBody lkp = fmap F.toList . T.mapM (finalizePartialBlock lkp)
 
 data PartialBlock = PartialBlock
@@ -267,7 +330,7 @@
 setPartialStmts stmts pb = pb { partialStmts = stmts }
 
 -- | Process a partial basic block into a full basic block.
-finalizePartialBlock :: BlockLookup -> PartialBlock -> Parse BasicBlock
+finalizePartialBlock :: BlockLookup -> PartialBlock -> Finalize BasicBlock
 finalizePartialBlock lkp pb = BasicBlock
                           <$> bbEntryName (partialLabel pb)
                           <*> finalizeStmts lkp (partialStmts pb)
@@ -278,15 +341,21 @@
 
 -- | Process a list of statements with explicit block id labels into one with
 -- textual labels.
-finalizeStmts :: BlockLookup -> StmtList -> Parse [Stmt]
+finalizeStmts :: BlockLookup -> StmtList -> Finalize [Stmt]
 finalizeStmts lkp = mapM (finalizeStmt lkp) . F.toList
 
-finalizeStmt :: BlockLookup -> Stmt' Int -> Parse Stmt
+finalizeStmt :: BlockLookup -> Stmt' Int -> Finalize Stmt
 finalizeStmt lkp = relabel (resolveBlockLabel lkp)
 
 
 -- Function Block Parsing ------------------------------------------------------
 
+-- | A bit saying whether a call or callbr instruction has an explicit type, see
+-- LLVM's CallMarkersFlags:
+-- https://github.com/llvm/llvm-project/blob/c8ed784ee69a7dbdf4b33e85229457ffad309cf2/llvm/include/llvm/Bitcode/LLVMBitCodes.h#L505
+callExplicitTypeBit :: Int
+callExplicitTypeBit = 15
+
 -- | Parse the function block.
 parseFunctionBlock ::
   Int {- ^ unnamed globals so far -} ->
@@ -300,12 +369,12 @@
     mb <- match (findMatch valueSymtabBlockId) ents
     case mb of
       Just es -> parseValueSymbolTableBlock es
-      Nothing -> return Map.empty
+      Nothing -> return mempty
 
   -- pop the function prototype off of the internal stack
   proto <- popFunProto
 
-  label (protoName proto) $ withValueSymtab symtab $ do
+  label (prettySym (protoSym proto)) $ withValueSymtab symtab $ do
 
     -- generate the initial partial definition
     pd  <- emptyPartialDefine proto
@@ -313,7 +382,7 @@
         vt  <- getValueTable
 
     -- merge the symbol table with the anonymous symbol table
-    return pd' { partialSymtab = partialSymtab pd' `Map.union` symtab }
+    return pd' { partialSymtab = partialSymtab pd' `mappend` symtab }
 
 -- | Parse the members of the function block
 parseFunctionBlockEntry ::
@@ -329,17 +398,29 @@
 parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
 
   -- [n]
-  1 -> label "FUNC_CODE_DECLARE_BLOCKS" (return d)
+  1 -> label "FUNC_CODE_DECLARE_BLOCKS"
+             (Assert.recordSizeGreater r 0 >> return d)
 
   -- [opval,ty,opval,opcode]
   2 -> label "FUNC_CODE_INST_BINOP" $ do
     let field = parseField r
     (lhs,ix) <- getValueTypePair t r 0
-    rhs      <- getValue (typedType lhs) =<< field ix numeric
+    rhs      <- getValue t (typedType lhs) =<< field ix numeric
     mkInstr  <- field (ix + 1) binop
-    -- if there's an extra field on the end of the record, it's for designating
-    -- the value of the nuw and nsw flags.  the constructor returned from binop
-    -- will use that value when constructing the binop.
+    -- If there's an extra field on the end of the record, it's for one of the
+    -- following:
+    --
+    -- - If the instruction is add, sub, mul, or shl, the extra field
+    --   designates the value of the nuw and nsw flags.
+    --
+    -- - If the instruction is sdiv, udiv, lshr, or ashr, the extra field
+    --   designates the value of the exact flag.
+    --
+    -- - If the instruction is floating-point, the extra field designates the
+    --   value of the fast-math flags. We currently ignore these.
+    --
+    -- The constructor returned from binop will use that value when
+    -- constructing the binop.
     let mbWord = numeric =<< fieldAt (ix + 2) r
     result (typedType lhs) (mkInstr mbWord lhs (typedValue rhs)) d
 
@@ -347,6 +428,7 @@
   3 -> label "FUNC_CODE_INST_CAST" $ do
     let field = parseField r
     (tv,ix) <- getValueTypePair t r 0
+    Assert.recordSizeIn r [ix + 2]
     resty   <- getType =<< field ix numeric
     cast'   <-             field (ix+1) castOp
     result resty (cast' tv resty) d
@@ -357,14 +439,14 @@
   5 -> label "FUNC_CODE_INST_SELECT" $ do
     let field = parseField r
     (tval,ix) <- getValueTypePair t r 0
-    fval      <- getValue (typedType tval)       =<< field  ix    numeric
-    cond      <- getValue (PrimType (Integer 1)) =<< field (ix+1) numeric
+    fval      <- getValue t (typedType tval)       =<< field  ix    numeric
+    cond      <- getValue t (PrimType (Integer 1)) =<< field (ix+1) numeric
     result (typedType tval) (Select cond tval (typedValue fval)) d
 
   -- [ty,opval,opval]
   6 -> label "FUNC_CODE_INST_EXTRACTELT" $ do
     (tv,ix) <- getValueTypePair t r 0
-    idx     <- getValue (PrimType (Integer 32)) =<< parseField r ix numeric
+    idx     <- getValue t (PrimType (Integer 32)) =<< parseField r ix numeric
     (_, ty) <- elimVector (typedType tv)
         `mplus` fail "invalid EXTRACTELT record"
     result ty (ExtractElt tv (typedValue idx)) d
@@ -375,17 +457,21 @@
     (tv,ix) <- getValueTypePair t r 0
     (_,pty) <- elimVector (typedType tv)
                  `mplus` fail "invalid INSERTELT record (not a vector)"
-    elt     <- getValue pty                     =<< field  ix    numeric
-    idx     <- getValue (PrimType (Integer 32)) =<< field (ix+1) numeric
+    elt     <- getValue t pty                     =<< field  ix    numeric
+    idx     <- getValue t (PrimType (Integer 32)) =<< field (ix+1) numeric
     result (typedType tv) (InsertElt tv elt (typedValue idx)) d
 
   -- [opval,ty,opval,opval]
   8 -> label "FUNC_CODE_INST_SHUFFLEVEC" $ do
     let field = parseField r
     (vec1,ix) <- getValueTypePair t r 0
-    vec2      <- getValue (typedType vec1) =<< field  ix    numeric
+    vec2      <- getValue t (typedType vec1) =<< field  ix    numeric
     (mask,_)  <- getValueTypePair t r (ix+1)
-    result (typedType vec1) (ShuffleVector vec1 (typedValue vec2) mask) d
+    resTy <- case (typedType vec1,typedType mask) of
+                (Vector _ elemTy, Vector shuffleLen _) ->
+                        return (Vector shuffleLen elemTy)
+                _ -> fail "Invalid arguments to shuffle vector (not vectors)"
+    result resTy (ShuffleVector vec1 (typedValue vec2) mask) d
 
   -- 9 is handled lower down, as it's processed the same way as 28
 
@@ -393,18 +479,20 @@
   10 -> label "FUNC_CODE_INST_RET" $ case length (recordFields r) of
     0 -> effect RetVoid d
     _ -> do
-      (tv,_) <- getValueTypePair t r 0
+      (tv, ix) <- getValueTypePair t r 0
+      Assert.recordSizeIn r [ix]
       effect (Ret tv) d
 
   -- [bb#,bb#,cond] or [bb#]
   11 -> label "FUNC_CODE_INST_BR" $ do
+    Assert.recordSizeIn r [1, 3]
     let field = parseField r
     bb1 <- field 0 numeric
     let jump   = effect (Jump bb1) d
         branch = do
           bb2  <- field 1 numeric
           n    <- field 2 numeric
-          cond <- getValue (PrimType (Integer 1)) n
+          cond <- getValue t (PrimType (Integer 1)) n
           effect (Br cond bb1 bb2) d
     branch `mplus` jump
 
@@ -425,9 +513,9 @@
             PrimType (Integer w) -> return w
             _                    -> fail "invalid switch discriminate"
 
-          cond     <- getValue opty =<< field 2 numeric
-          def      <-                   field 3 numeric -- Int id of a label
-          numCases <-                   field 4 numeric
+          cond     <- getValue t opty =<< field 2 numeric
+          def      <-                      field 3 numeric -- Int id of a label
+          numCases <-                      field 4 numeric
           ls       <- parseNewSwitchLabels width r numCases 5
           effect (Switch cond def ls) d
 
@@ -437,8 +525,8 @@
     -- [opty, op0, op1, ...]
     let oldSwitch = do
           opty <- getType n
-          cond <- getValue opty =<< field 1 numeric
-          def  <-                   field 2 numeric
+          cond <- getValue t opty =<< field 1 numeric
+          def  <-                      field 2 numeric
           ls   <- parseSwitchLabels opty r 3
           effect (Switch cond def ls) d
 
@@ -452,15 +540,33 @@
 
   -- [attrs,cc,normBB,unwindBB,fnty,op0,op1..]
   13 -> label "FUNC_CODE_INST_INVOKE" $ do
+    Assert.recordSizeGreater r 3
     let field = parseField r
+    ccinfo      <- field 1 unsigned
     normal      <- field 2 numeric
     unwind      <- field 3 numeric
-    (f,ix)      <- getValueTypePair t r 4
-    (ret,as,va) <- elimFunPtr (typedType f)
+
+    -- explicit function type?
+    (mbFTy,ix)    <-
+      if testBit ccinfo 13
+         then do ty <- getType =<< field 4 numeric
+                 return (Just ty, 5)
+         else return (Nothing, 4)
+
+    (f,ix')      <- getValueTypePair t r ix
+
+    fty <- case mbFTy of
+             Just ty -> return ty
+             Nothing -> Assert.elimPtrTo "Callee is not a pointer" (typedType f)
+
+    (ret,as,va) <- elimFunTy fty
         `mplus` fail "invalid INVOKE record"
-    args        <- parseInvokeArgs t va r ix as
-    result ret (Invoke (typedType f) (typedValue f) args normal unwind) d
 
+    args        <- parseInvokeArgs t va r ix' as
+    -- Use `fty` instead of `typedType f` as the function type, as `typedType f`
+    -- will be a pointer type. See Note [Typing function applications].
+    result ret (Invoke fty (typedValue f) args normal unwind) d
+
   14 -> label "FUNC_CODE_INST_UNWIND" (effect Unwind d)
 
   15 -> label "FUNC_CODE_INST_UNREACHABLE" (effect Unreachable d)
@@ -474,6 +580,10 @@
     -- cause a loop.
     useRelIds <- getRelIds
     args      <- parsePhiArgs useRelIds t r
+
+    when (even (length (recordFields r))) $ do
+      pure () -- TODO: fast math flags
+
     result ty (Phi ty args) d
 
   -- 17 is unused
@@ -481,8 +591,8 @@
 
   -- [instty,opty,op,align]
   19 -> label "FUNC_CODE_INST_ALLOCA" $ do
-    unless (length (recordFields r) == 4)
-        (fail "Invalid ALLOCA record")
+    Assert.recordSizeIn r [4]
+
     let field = parseField r
 
     instty <- getType           =<< field 0 numeric -- pointer type
@@ -502,37 +612,37 @@
         ity = if explicitType then PtrTo instty else instty
 
     ret <- if explicitType
-              then return instty
-              else elimPtrTo instty
-                      `mplus` fail "invalid return type in INST_ALLOCA"
+           then return instty
+           else Assert.elimPtrTo "In return type:" instty
 
     result ity (Alloca ret sval (Just aval)) d
 
   -- [opty,op,align,vol]
   20 -> label "FUNC_CODE_INST_LOAD" $ do
     (tv,ix) <- getValueTypePair t r 0
+    Assert.recordSizeIn r [ix + 2, ix + 3]
 
     (ret,ix') <-
       if length (recordFields r) == ix + 3
          then do ty <- getType =<< parseField r ix numeric
                  return (ty,ix+1)
 
-         else do ty <- elimPtrTo (typedType tv)
-                           `mplus` fail "invalid type to INST_LOAD"
+         else do ty <- Assert.elimPtrTo "" (typedType tv)
                  return (ty,ix)
 
     aval    <- parseField r ix' numeric
     let align | aval > 0  = Just (bit aval `shiftR` 1)
               | otherwise = Nothing
-    result ret (Load (tv { typedType = PtrTo ret }) align) d
+    result ret (Load ret tv Nothing align) d
 
   -- 21 is unused
   -- 22 is unused
 
   23 -> label "FUNC_CODE_INST_VAARG" $ do
+    Assert.recordSizeGreater r 2
     let field = parseField r
     ty    <- getType     =<< field 0 numeric
-    op    <- getValue ty =<< field 1 numeric
+    op    <- getValue t ty =<< field 1 numeric
     resTy <- getType     =<< field 2 numeric
     result resTy (VaArg op resTy) d
 
@@ -540,25 +650,37 @@
   24 -> label "FUNC_CODE_INST_STORE_OLD" $ do
     let field = parseField r
     (ptr,ix) <- getValueTypePair t r 0
-    ty       <- elimPtrTo (typedType ptr)
-                  `mplus` fail "invalid type to INST_STORE"
-    val      <- getValue ty =<< field ix numeric
+    ty       <- Assert.elimPtrTo "" (typedType ptr)
+    val      <- getValue t ty =<< field ix numeric
     aval     <- field (ix+1) numeric
     let align | aval > 0  = Just (bit aval `shiftR` 1)
               | otherwise = Nothing
-    effect (Store val ptr align) d
+    effect (Store val ptr Nothing align) d
 
   -- 25 is unused
 
-  -- [opty, opval, n x indices]
+  -- LLVM 6: [opty, opval, n x indices]
   26 -> label "FUNC_CODE_INST_EXTRACTVAL" $ do
-    (tv,ix) <- getValueTypePair t r 0
-    ixs     <- parseIndexes r ix
-    ret     <- interpValueIndex (typedType tv) ixs
-    result ret (ExtractValue tv ixs) d
+    (tv, ix) <- getValueTypePair t r 0
 
+    when (length (recordFields r) == ix) $
+      fail "`extractval` instruction had zero indices"
+
+    ixs <- parseIndexes r ix
+    let instr = ExtractValue tv ixs
+
+    -- The return type of this instruction depends on the given indices into the
+    -- type.
+    ret      <- interpValueIndex (typedType tv) ixs
+    result ret instr d
+
   27 -> label "FUNC_CODE_INST_INSERTVAL" $ do
     (tv,ix)   <- getValueTypePair t r 0
+
+    -- See comment in FUNC_CODE_INST_EXTRACTVAL
+    when (length (recordFields r) == ix) $
+      fail "Invalid instruction with zero indices"
+
     (elt,ix') <- getValueTypePair t r ix
     ixs       <- parseIndexes r ix'
     result (typedType tv) (InsertValue tv elt ixs) d
@@ -568,8 +690,9 @@
   29 -> label "FUNC_CODE_INST_VSELECT" $ do
     let field = parseField r
     (tv,ix) <- getValueTypePair t r 0
-    fv      <- getValue (typedType tv) =<< field ix numeric
+    fv      <- getValue t (typedType tv) =<< field ix numeric
     (c,_)   <- getValueTypePair t r (ix+1)
+    -- XXX: we're ignoring the fast-math flags
     result (typedType tv) (Select c tv (typedValue fv)) d
 
   30 -> label "FUNC_CODE_INST_INBOUNDS_GEP_OLD" (parseGEP t (Just True) r d)
@@ -577,7 +700,7 @@
   31 -> label "FUNC_CODE_INST_INDIRECTBR" $ do
     let field = parseField r
     ty   <- getType     =<< field 0 numeric
-    addr <- getValue ty =<< field 1 numeric
+    addr <- getValue t ty =<< field 1 numeric
     ls   <- parseIndexes r 2
     effect (IndirectBr addr ls) d
 
@@ -587,29 +710,26 @@
     loc <- getLastLoc
     updateLastStmt (extendMetadata ("dbg", ValMdLoc loc)) d
 
-  -- [paramattrs, cc, fnty, fnid, arg0 .. arg n]
+  -- [paramattrs, cc, mb fmf, mb fnty, fnid, arg0 .. arg n, varargs]
   34 -> label "FUNC_CODE_INST_CALL" $ do
+    Assert.recordSizeGreater r 2
     let field = parseField r
 
-    -- pal <- field 0 numeric
+    -- pal <- field 0 numeric -- N.B. skipping param attributes
     ccinfo <- field 1 numeric
-
-    (mbFnTy, ix) <- if testBit (ccinfo :: Word32) 15
-                       then do fnTy <- getType =<< field 2 numeric
-                               return (Just fnTy, 3)
-                       else    return (Nothing,   2)
+    let ix0 = if testBit ccinfo 17 then 3 else 2 -- N.B. skipping fast-math flags
+    (mbFnTy, ix1) <- if testBit (ccinfo :: Word32) callExplicitTypeBit
+                       then do fnTy <- getType =<< field ix0 numeric
+                               return (Just fnTy, ix0+1)
+                       else    return (Nothing,   ix0)
 
-    (Typed opTy fn, ix') <- getValueTypePair t r ix
+    (Typed opTy fn, ix2) <- getValueTypePair t r ix1
                                 `mplus` fail "Invalid record"
 
-    op <- elimPtrTo opTy `mplus` fail "Callee is not a pointer type"
-
     fnty <- case mbFnTy of
-             Just ty | ty == op  -> return op
-                     | otherwise -> fail "Explicit call type does not match \
-                                         \pointee type of callee operand"
-
-             Nothing ->
+             Just ty -> return ty
+             Nothing -> do
+               op <- Assert.elimPtrTo "Callee is not a pointer type" opTy
                case op of
                  FunTy{} -> return op
                  _       -> fail "Callee is not of pointer to function type"
@@ -617,11 +737,15 @@
 
     label (show fn) $ do
       (ret,as,va) <- elimFunTy fnty `mplus` fail "invalid CALL record"
-      args <- parseCallArgs t va r ix' as
-      result ret (Call False opTy fn args) d
+      args <- parseCallArgs t va r ix2 as
+      -- Use `fnty` instead of `opTy` as the function type, as `opTy` will be
+      -- a pointer type. See Note [Typing function applications].
+      result ret (Call False fnty fn args) d
 
   -- [Line,Col,ScopeVal, IAVal]
   35 -> label "FUNC_CODE_DEBUG_LOC" $ do
+    Assert.recordSizeGreater r 3
+
     let field = parseField r
     line    <- field 0 numeric
     col     <- field 1 numeric
@@ -641,25 +765,30 @@
           , dlCol   = col
           , dlScope = typedValue scope
           , dlIA    = typedValue `fmap` ia
+          , dlImplicit = False
           }
     setLastLoc loc
     updateLastStmt (extendMetadata ("dbg", ValMdLoc loc)) d
 
   -- [ordering, synchscope]
   36 -> label "FUNC_CODE_INST_FENCE" $ do
-    notImplemented
+    Assert.recordSizeIn r [2]
+    mordval <- getDecodedOrdering =<< parseField r 0 unsigned
+    -- TODO: parse scope
+    case mordval of
+      Just ordval -> effect (Fence Nothing ordval) d
+      Nothing -> fail "`fence` instruction requires ordering"
 
   -- [ptrty,ptr,cmp,new, align, vol,
   --  ordering, synchscope]
-  37 -> label "FUNC_CODE_INST_CMPXCHG" $ do
+  37 -> label "FUNC_CODE_INST_CMPXCHG_OLD" $ do
     notImplemented
 
-  -- [ptrty,ptr,val, operation,
-  --  align, vol,
-  --  ordering,synchscope]
-  38 -> label "FUNC_CODE_INST_ATOMICRMW" $ do
-    notImplemented
+  -- LLVM 6.0: [ptrty, ptr, val, operation, vol, ordering, ssid]
+  38 -> label "FUNC_CODE_INST_ATOMICRMW_OLD" $
+    parseAtomicRMW True t r d
 
+
   -- [opval]
   39 -> label "FUNC_CODE_RESUME" $ do
     (tv,_) <- getValueTypePair t r 0
@@ -667,6 +796,7 @@
 
   -- [ty,val,val,num,id0,val0...]
   40 -> label "FUNC_CODE_LANDINGPAD_OLD" $ do
+    Assert.recordSizeGreater r 3
     let field = parseField r
     ty          <- getType =<< field 0 numeric
     (persFn,ix) <- getValueTypePair t r 1
@@ -674,13 +804,36 @@
     let isCleanup = val /= (0 :: Int)
     len         <- field (ix + 1) numeric
     clauses     <- parseClauses t r len (ix + 2)
-    result ty (LandingPad ty persFn isCleanup clauses) d
+    result ty (LandingPad ty (Just persFn) isCleanup clauses) d
 
-  -- [opty, op, align, vol,
-  --  ordering, synchscope]
+  -- [opty, op, align, vol, ordering, synchscope]
   41 -> label "FUNC_CODE_LOADATOMIC" $ do
-    notImplemented
+    (tv,ix) <- getValueTypePair t r 0
 
+    Assert.recordSizeIn r [ix + 4, ix+ 5]
+
+    (ret,ix') <-
+      if length (recordFields r) == ix + 5
+         then do ty <- getType =<< parseField r ix numeric
+                 return (ty, ix + 1)
+
+         else do ty <- Assert.elimPtrTo "" (typedType tv)
+                 return (ty, ix)
+
+    ordval <- getDecodedOrdering =<< parseField r (ix' + 2) unsigned
+    when (ordval `elem` Nothing:map Just [Release, AcqRel]) $
+      fail $ "Invalid atomic ordering: " ++ show ordval
+
+    aval    <- parseField r ix' numeric
+    let align | aval > 0  = Just (bit aval `shiftR` 1)
+              | otherwise = Nothing
+
+    when (ordval /= Nothing && align == Nothing)
+         (fail "Invalid record")
+
+    result ret (Load ret tv ordval align) d
+
+
   -- [ptrty, ptr, val, align, vol, ordering, synchscope]
   42 -> label "FUNC_CODE_INST_STOREATOMIC_OLD" $ do
     notImplemented
@@ -691,33 +844,122 @@
     let field = parseField r
     (ptr,ix)  <- getValueTypePair t r 0
     (val,ix') <- getValueTypePair t r ix
+
+    Assert.recordSizeIn r [ix' + 2]
+
     aval      <- field ix' numeric
     let align | aval > 0  = Just (bit aval `shiftR` 1)
               | otherwise = Nothing
-    effect (Store val ptr align) d
+    effect (Store val ptr Nothing align) d
 
+  -- LLVM 6: [ptrty, ptr, val, align, vol, ordering, ssid]
   45 -> label "FUNC_CODE_INST_STOREATOMIC" $ do
-    notImplemented
+    (ptr, ix)  <- getValueTypePair t r 0
+    (val, ix') <- getValueTypePair t r ix
 
-  46 -> label "FUNC_CODE_CMPXCHG" $ do
-    notImplemented
+    Assert.recordSizeIn r [ix' + 4]
 
+    -- TODO: There's no spot in the AST for this ordering. Should there be?
+    ordering <- getDecodedOrdering =<< parseField r (ix' + 2) unsigned
+    when (ordering `elem` Nothing:map Just [Acquire, AcqRel]) $
+      fail $ "Invalid atomic ordering: " ++ show ordering
+
+    -- TODO: parse sync scope (ssid)
+
+    -- copy-pasted from LOADATOMIC
+    aval    <- parseField r ix' numeric
+    let align | aval > 0  = Just (bit aval `shiftR` 1)
+              | otherwise = Nothing
+
+    effect (Store val ptr ordering align) d
+
+  -- LLVM 6: [ptrty, ptr, cmp, new, vol, successordering, ssid,
+  --          failureordering?, isweak?]
+  46 -> label "FUNC_CODE_INST_CMPXCHG" $ do
+    (ptr, ix)  <- getValueTypePair t r 0
+    (val, ix') <- getValueTypePair t r ix
+    new        <- getValue t (typedType val) =<< parseField r ix' numeric
+    let ix''   = ix' + 1 -- TODO: is this right?
+
+    -- TODO: record size assertion
+    -- Assert.recordSizeGreater r (ix'' + 5)
+
+    unless (typedType val `eqTypeModuloOpaquePtrs` typedType new)
+      -- This test is generally validating the behavior of this library: the LLVM
+      -- bitcode was likely generated by LLVM and is therefore "correct".
+      $ fail $ unlines $
+      [ "Mismatched value types:"
+      , "cmp value: " ++ show (typedValue val)
+      , "new value: " ++ show (typedValue new)
+      , "cmp type:  " ++ show (typedType val)
+      , "new type:  " ++ show (typedType new)
+      ]
+
+    volatile <- parseField r ix'' boolean
+
+    successOrdering_ <- getDecodedOrdering =<< parseField r (ix'' + 1) unsigned
+    let successOrderMsg ord = "Invalid success ordering: " ++ show ord
+    successOrdering  <-
+      case successOrdering_ of
+        Nothing        -> fail (successOrderMsg successOrdering_)
+        Just Unordered -> fail (successOrderMsg successOrdering_)
+        Just ordering  -> pure ordering
+
+    -- TODO: parse sync scope (ssid)
+    -- ssid <- parseField r (ix'' + 2) ssid
+
+    let len = length (recordFields r)
+    failureOrdering_ <-
+      if len < 7
+      -- Implementation of getStrongestFailureOrdering in llvm/IR/Instructions.h:
+      then case successOrdering of
+             Release   -> pure (Just Monotonic)
+             Monotonic -> pure (Just Monotonic)
+             Acquire   -> pure (Just Acquire)   -- TODO: AcquireRelease?
+             SeqCst    -> pure (Just SeqCst)
+             _         -> fail (successOrderMsg successOrdering)
+      else getDecodedOrdering =<< parseField r (ix'' + 3) unsigned
+    failureOrdering  <-
+      case failureOrdering_ of
+        Nothing  -> fail "Invalid failure ordering (Nothing)"
+        Just ord -> pure ord
+
+    weak <-
+      if len < 8
+      then fail "Not yet implemented: old-style cmpxchg instruction (weak)"
+      else parseField r (ix'' + 4) boolean
+
+    -- The return type of cmpxchg is: the value that was present in the memory
+    -- location and a boolean indicating whether it was overwritten.
+    let ty = Struct [typedType val, PrimType (Integer 1)]
+    result ty (CmpXchg weak volatile ptr val new Nothing successOrdering failureOrdering) d
+
   47 -> label "FUNC_CODE_LANDINGPAD" $ do
-    notImplemented
+    Assert.recordSizeGreater r 2
+    let field = parseField r
+    ty         <- getType =<< field 0 numeric
+    isCleanup  <- (/=(0::Int)) <$> field 1 numeric
+    len        <- field 2 numeric
+    clauses    <- parseClauses t r len 3
+    result ty (LandingPad ty Nothing isCleanup clauses) d
 
   48 -> label "FUNC_CODE_CLEANUPRET" $ do
+    -- Assert.recordSizeIn r [1, 2]
     notImplemented
 
   49 -> label "FUNC_CODE_CATCHRET" $ do
+    -- Assert.recordSizeIn r [2]
     notImplemented
 
   50 -> label "FUNC_CODE_CATCHPAD" $ do
     notImplemented
 
   51 -> label "FUNC_CODE_CLEANUPPAD" $ do
+    -- Assert.recordSizeGreater r [1]
     notImplemented
 
   52 -> label "FUNC_CODE_CATCHSWITCH" $ do
+    -- Assert.recordSizeGreater r [1]
     notImplemented
 
   -- 53 is unused
@@ -726,13 +968,71 @@
   55 -> label "FUNC_CODE_OPERAND_BUNDLE" $ do
     notImplemented
 
+  -- [opval,ty,opcode]
+  56 -> label "FUNC_CODE_INST_UNOP" $ do
+    let field = parseField r
+    (v,ix)  <- getValueTypePair t r 0
+    mkInstr <- field ix unop
+    -- XXX: we're ignoring the fast-math flags
+    result (typedType v) (mkInstr v) d
+
+  -- LLVM 9: [attr, cc, norm, transfs, fnty, fnid, args...]
+  57 -> label "FUNC_CODE_INST_CALLBR" $ do
+    -- This implementation shares a lot with the parser for `call`, but they
+    -- have different fields and so different handling of indices. In
+    -- particular, the handling of basic block destinations is unique to
+    -- `callbr`, and `callbr` doesn't support fast math flags.
+
+    let field = parseField r
+    -- pal <- field 0 numeric -- N.B. skipping param attributes
+    ccinfo <- field 1 unsigned
+    normal <- field 2 numeric
+    numIndirect <- field 3 numeric
+    indirectDests <- mapM (\idx -> field (4 + idx) numeric) [0..numIndirect - 1]
+    let ix0 = 4 + numIndirect
+    (mbFnTy, ix1) <- if testBit (ccinfo :: Word32) callExplicitTypeBit
+                       then do fnTy <- getType =<< field ix0 numeric
+                               return (Just fnTy, ix0+1)
+                       else    return (Nothing,   ix0)
+
+    (Typed opTy fn, ix2) <- getValueTypePair t r ix1
+                                `mplus` fail "Invalid callbr record"
+
+    fnty <- case mbFnTy of
+             Just ty -> return ty
+             Nothing -> do
+               op <- Assert.elimPtrTo "callbr callee is not a pointer type" opTy
+               case op of
+                 FunTy{} -> return op
+                 _       -> fail "Callee is not of pointer to function type"
+
+    label (show fn) $ do
+      (ret,as,va) <- elimFunTy fnty `mplus` fail "invalid CALLBR record"
+      args <- parseCallArgs t va r ix2 as
+      -- Use `fnty` instead of `opTy` as the function type, as `opTy` will be
+      -- a pointer type. See Note [Typing function applications].
+      result ret (CallBr fnty fn args normal indirectDests) d
+
+  -- [opty, opval]
+  58 -> label "FUNC_CODE_INST_FREEZE" $ do
+    (v,_) <- getValueTypePair t r 0
+    result (typedType v) (Freeze v) d
+
+  -- LLVM 13: [ptrty, ptr, valty, val, operation, vol, ordering, ssid]
+  59 -> label "FUNC_CODE_INST_ATOMICRMW" $
+    parseAtomicRMW False t r d
+
+
   -- [opty,opval,opval,pred]
   code
    |  code == 9
    || code == 28 -> label "FUNC_CODE_INST_CMP2" $ do
     let field = parseField r
     (lhs,ix) <- getValueTypePair t r 0
-    rhs      <- getValue (typedType lhs) =<< field ix numeric
+               `mplus` (do i   <- adjustId =<< field 0 numeric
+                           cxt <- getContext
+                           return (forwardRef cxt i t, 1))
+    rhs <- getValue t (typedType lhs) =<< field ix numeric
 
     let ty = typedType lhs
         parseOp | isPrimTypeOf isFloatingPoint ty ||
@@ -742,7 +1042,8 @@
                 | otherwise =
                   return . ICmp <=< icmpOp
 
-    op <- field (ix+1) parseOp
+    op <- field (ix + 1) parseOp
+    -- XXX: we're ignoring the fast-math flags
 
     let boolTy = Integer 1
     let rty = case ty of
@@ -759,9 +1060,9 @@
 
 parseFunctionBlockEntry globals t d (metadataBlockId -> Just es) = do
   (_, (globalUnnamedMds, localUnnamedMds), _, _, _) <- parseMetadataBlock globals t es
-  unless (null localUnnamedMds)
-     (fail "parseFunctionBlockEntry PANIC: unexpected local unnamed metadata")
-  return d { partialGlobalMd = globalUnnamedMds ++ partialGlobalMd d }
+  if (null localUnnamedMds)
+    then return d { partialGlobalMd = globalUnnamedMds <> partialGlobalMd d }
+    else return d -- silently drop unexpected local unnamed metadata
 
 parseFunctionBlockEntry globals t d (metadataAttachmentBlockId -> Just es) = do
   (_,(globalUnnamedMds, localUnnamedMds),instrAtt,fnAtt,_)
@@ -802,30 +1103,25 @@
     b' | null use  = b
        | otherwise = b { partialStmts = foldl addMd (partialStmts b) use }
 
-    addMd stmts (i,md') = Seq.adjust update i stmts
+    addMd stmts (i,md') = Seq.adjust update (i-off) stmts
       where
       update (Result n s md) = Result n s (md ++ md')
       update (Effect   s md) = Effect   s (md ++ md')
 
   go _ _ Seq.EmptyL = Seq.empty
 
-baseType :: Type -> Type
-baseType (PtrTo ty) = ty
-baseType (Array _ ty) = ty
-baseType (Vector _ ty) = ty
-baseType ty = ty
-
 -- [n x operands]
 parseGEP :: ValueTable -> Maybe Bool -> Record -> PartialDefine -> Parse PartialDefine
 parseGEP t mbInBound r d = do
-  (ib, tv, r', ix) <-
+  (ib, ty, tv, r', ix) <-
       case mbInBound of
 
         -- FUNC_CODE_INST_GEP_OLD
         -- FUNC_CODE_INST_INBOUNDS_GEP_OLD
         Just ib -> do
           (tv,ix') <- getValueTypePair t r 0
-          return (ib, tv, r, ix')
+          ty <- Assert.elimPtrTo "GEP not headed by pointer" (typedType tv)
+          return (ib, ty, tv, r, ix')
 
         -- FUNC_CODE_INST_GEP
         Nothing -> do
@@ -834,21 +1130,67 @@
           ib <- field 0 boolean
           ty <- getType =<< field 1 numeric
           (tv,ix') <- getValueTypePair t r' 2
-          -- TODO: the following sometimes fails, but it doesn't seem to matter.
-          {-
-          unless (baseType (typedType tv) == ty)
-              (fail $ unlines [ "Explicit gep type does not match base type of pointer operand"
-                              , "Declared type: " ++ show (ppType ty)
-                              , "Operand type: " ++ show (ppType (typedType tv))
-                              , "Base type of operand: " ++ show (ppType (baseType (typedType tv)))
-                              ])
-           -}
-          return (ib, tv { typedType = PtrTo ty }, r', ix')
+          return (ib, ty, tv, r', ix')
 
   args    <- label "parseGepArgs" (parseGepArgs t r' ix)
-  rty     <- label "interpGep"    (interpGep (typedType tv) args)
-  result rty (GEP ib tv args) d
+  rty     <- label "interpGep"    (interpGep ty tv args)
+  result rty (GEP ib ty tv args) d
 
+-- Parse an @atomicrmw@ instruction, which can be represented by one of the
+-- following function codes:
+--
+-- * FUNC_CODE_INST_ATOMICRMW_OLD, which was introduced in LLVM 6.0.
+--   [ptrty, ptr,        val, operation, vol, ordering, ssid]
+--
+-- * FUNC_CODE_INST_ATOMICRMW, which was introduced in LLVM 13.
+--   [ptrty, ptr, valty, val, operation, vol, ordering, ssid]
+--
+-- The only difference between the two is that FUNC_CODE_INST_ATOMICRMW has a
+-- @valty@ field, whereas FUNC_CODE_INST_ATOMICRMW_OLD does not (it reuses the
+-- type that @ptrty@ points to as the @valty@).
+--
+-- The parsing code was inspired by the upstream code at
+-- https://github.com/llvm/llvm-project/blob/2362c4ecdc88123e5d54c7ebe30889fbfa760a88/llvm/lib/Bitcode/Reader/BitcodeReader.cpp#L5658-L5720.
+parseAtomicRMW :: Bool -> ValueTable -> Record -> PartialDefine -> Parse PartialDefine
+parseAtomicRMW old t r d = do
+  -- TODO: parse sync scope (ssid)
+  (ptr, ix0) <- getValueTypePair t r 0
+
+  (val, ix1) <-
+    if old
+      then -- FUNC_CODE_INST_ATOMICRMW_OLD
+           do ty <- Assert.elimPtrTo "atomicrmw instruction not headed by pointer" (typedType ptr)
+              typed <- getValue t ty =<< parseField r ix0 numeric
+              if ty /= (typedType typed)
+              then fail $ unlines $ [ "Wrong type of value retrieved from value table"
+                                    , "Expected: " ++ show (ty)
+                                    , "Got: " ++ show (typedType typed)
+                                    ]
+              else pure (typed, ix0 + 1)
+      else -- FUNC_CODE_INST_ATOMICRMW
+           getValueTypePair t r ix0
+
+  -- Catch incorrect operand types
+  let valTy = typedType val
+  unless (case valTy of
+            PrimType (Integer   _) -> True
+            PrimType (FloatType _) -> True
+            _                      -> False) $
+    fail $ "Expected integer or float operand, found " ++ show valTy
+
+  -- TODO: enable this assertion. Is getTypeValuePair returning the wrong value?
+  -- when (length (recordFields r) /= ix1 + 4) $ do
+  --   fail $ "Invalid record size: " ++ show (length (recordFields r))
+
+  operation <- getDecodedAtomicRWOp =<< parseField r ix1 numeric
+  volatile  <- parseField r (ix1 + 1) nonzero
+  ordering  <- parseField r (ix1 + 2) unsigned >>= getDecodedOrdering >>=
+    \case
+      Just ordering -> pure ordering
+      Nothing       -> fail $ "`atomicrmw` requires ordering: ix == " ++ show ix1
+
+  result (typedType val) (AtomicRW volatile operation ptr val Nothing ordering) d
+
 -- | Generate a statement that doesn't produce a result.
 effect :: Instr' Int -> PartialDefine -> Parse PartialDefine
 effect i d = addStmt (Effect i []) d
@@ -884,22 +1226,23 @@
     return (typedValue val,bid)
 
   loop n
-    | n >= len  = return []
-    | otherwise = do
-      entry <- parse n
-      rest  <- loop (n+2)
-      return (entry:rest)
+    -- We must stop when @n@ is either equal to @len@, or to @len - 1@ in the
+    -- presence of fast math flags.
+    | len - n < 2 = return []
+    | otherwise   = (:) <$> parse n <*> loop (n + 2)
 
 -- | Parse the arguments for a call record.
 parseCallArgs :: ValueTable -> Bool -> Record -> Int -> [Type] -> Parse [Typed PValue]
-parseCallArgs t = parseArgs t $ \ ty i ->
+parseCallArgs t b r = parseArgs t op b r
+ where
+ op ty i =
   case ty of
     PrimType Label -> return (Typed ty (ValLabel i))
-    _              -> getValue ty i
+    _              -> getValue t ty i
 
 -- | Parse the arguments for an invoke record.
 parseInvokeArgs :: ValueTable -> Bool -> Record -> Int -> [Type] -> Parse [Typed PValue]
-parseInvokeArgs t = parseArgs t getValue
+parseInvokeArgs t = parseArgs t (getValue t)
 
 -- | Parse arguments for the invoke and call instructions.
 parseArgs :: ValueTable -> (Type -> Int -> Parse (Typed PValue))
@@ -936,19 +1279,22 @@
       rest     <- loop ix'
       return (tv:rest)
 
--- | Interpret the getelementptr arguments, to determine the final type of the
--- instruction.
-interpGep :: Type -> [Typed PValue] -> Parse Type
-interpGep ty vs = check (resolveGep ty vs)
+-- | Interpret a getelementptr instruction to determine its result type.
+interpGep :: Type -> Typed PValue -> [Typed PValue] -> Parse Type
+interpGep baseTy ptr vs = check (resolveGep baseTy ptr vs)
   where
   check res = case res of
     HasType rty -> return (PtrTo rty)
-    Invalid     -> fail "unable to determine the type of getelementptr"
+    Invalid -> fail $ unlines $
+      [ "Unable to determine the type of getelementptr"
+      , "Base type: " ++ show baseTy
+      , "Pointer value: " ++ show ptr
+      ]
     Resolve i k -> do
       ty' <- getType' =<< getTypeId i
       check (k ty')
 
-parseIndexes :: Num a => Record -> Int -> Parse [a]
+parseIndexes :: (Num a, Bits a) => Record -> Int -> Parse [a]
 parseIndexes r = loop
   where
   field  = parseField r
@@ -957,11 +1303,19 @@
     rest <- loop (n+1) `mplus` return []
     return (ix:rest)
 
-interpValueIndex :: Type -> [Int32] -> Parse Type
+interpValueIndex :: Type    -- ^ Aggregate (struct/array) type to index into
+                 -> [Int32] -- ^ Indices
+                 -> Parse Type
 interpValueIndex ty is = check (resolveValueIndex ty is)
   where
   check res = case res of
-    Invalid     -> fail "unable to determine the type of (extract/insert)value"
+    Invalid ->
+      fail $ unlines $
+        [ "Unable to determine the return type of `extractvalue`"
+        , "Hint: The input type should be an aggregate type (struct or array)"
+        , "Input type: " ++ show ty
+        , "Indices: " ++ show is
+        ]
     HasType rty -> return rty
     Resolve i k -> do
       ty' <- getType' =<< getTypeId i
@@ -997,7 +1351,7 @@
 
 -- | See the comment for 'parseSwitchLabels' for information about what this
 -- does.
-parseNewSwitchLabels :: Int32 -> Record -> Int -> Int -> Parse [(Integer,Int)]
+parseNewSwitchLabels :: Word32 -> Record -> Int -> Int -> Parse [(Integer,Int)]
 parseNewSwitchLabels width r = loop
   where
   field = parseField r
@@ -1063,3 +1417,63 @@
         0 -> return (Catch  val : cs)
         1 -> return (Filter val : cs)
         _ -> fail ("Invalid clause type: " ++ show cty)
+
+
+-- | 'Nothing' corresponds to @NotAtomic@ in the LLVM source
+getDecodedOrdering :: Word32 -> Parse (Maybe AtomicOrdering)
+getDecodedOrdering 0 = return Nothing
+getDecodedOrdering 1 = return (Just Unordered)
+getDecodedOrdering 2 = return (Just Monotonic)
+getDecodedOrdering 3 = return (Just Acquire)
+getDecodedOrdering 4 = return (Just Release)
+getDecodedOrdering 5 = return (Just AcqRel)
+getDecodedOrdering 6 = return (Just SeqCst)
+getDecodedOrdering i = Assert.unknownEntity "atomic ordering" i
+
+
+-- https://github.com/llvm-mirror/llvm/blob/release_60/include/llvm/Bitcode/LLVMBitCodes.h#L377
+getDecodedAtomicRWOp :: Integer -> Parse AtomicRWOp
+getDecodedAtomicRWOp 0  = pure AtomicXchg
+getDecodedAtomicRWOp 1  = pure AtomicAdd
+getDecodedAtomicRWOp 2  = pure AtomicSub
+getDecodedAtomicRWOp 3  = pure AtomicAnd
+getDecodedAtomicRWOp 4  = pure AtomicNand
+getDecodedAtomicRWOp 5  = pure AtomicOr
+getDecodedAtomicRWOp 6  = pure AtomicXor
+getDecodedAtomicRWOp 7  = pure AtomicMax
+getDecodedAtomicRWOp 8  = pure AtomicMin
+getDecodedAtomicRWOp 9  = pure AtomicUMax
+getDecodedAtomicRWOp 10 = pure AtomicUMin
+getDecodedAtomicRWOp v  = Assert.unknownEntity "atomic RWOp" v
+
+{-
+Note [Typing function applications]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+The LLVM Language Reference Manual says the following about the `call`
+instruction:
+
+    <result> = [tail | musttail | notail ] call [fast-math flags] [cconv] [ret attrs] [addrspace(<num>)]
+               <ty>|<fnty> <fnptrval>(<function args>) [fn attrs] [ operand bundles ]
+
+    ...
+
+    * ‘fnty’: shall be the signature of the function being called. [...]
+    * ‘fnptrval’: An LLVM value containing a pointer to a function to be called. [...]
+
+One slightly surprising aspect of this instruction (at least, this was not
+obvious to me when I first read it) is that `fnptrval` does _not_ have the type
+`fnty`. Rather, `fnptrval` has a pointer type, and the underlying memory being
+pointed to is treated as having type `fnty`.
+
+A consequence of this property is that `fnty` is /never/ a pointer type. It is
+easy to accidentally give the `fnty` of a `call` instruction a pointer type if
+you simply compute the type of `fnptrval`, but this is incorrect. This is
+especially incorrect in a world where pointers are opaque (see
+https://llvm.org/docs/OpaquePointers.html), as you cannot know know what a
+pointer's pointee type is by looking at the type alone. Instead, you must look
+at the surrounding instruction to know what the pointee type is. In the case of
+the `call` instruction, the pointee type for `fnptrval` is precisely `fnty`.
+
+Similar reasoning applies to the `callbr` and `invoke` instructions, which also
+invoke a pointer whose underlying memory has a function type.
+-}
diff --git a/src/Data/LLVM/BitCode/IR/Globals.hs b/src/Data/LLVM/BitCode/IR/Globals.hs
--- a/src/Data/LLVM/BitCode/IR/Globals.hs
+++ b/src/Data/LLVM/BitCode/IR/Globals.hs
@@ -35,7 +35,8 @@
 -- ]
 parseGlobalVar :: Int -> Record -> Parse PartialGlobal
 parseGlobalVar n r = label "GLOBALVAR" $ do
-  let field = parseField r
+  (name, offset) <- oldOrStrtabName n r
+  let field i = parseField r (i + offset)
   ptrty   <- getType =<< field 0 numeric
   mask    <-             field 1 numeric
   let isconst    = testBit (mask :: Word32) 0
@@ -43,27 +44,28 @@
   initid  <-             field 2 numeric
   link    <-             field 3 linkage
 
-  mbAlign <- if length (recordFields r) > 4
+  mbAlign <- if length (recordFields r) > (4 + offset)
                 then Just `fmap` field 4 numeric
                 else return Nothing
+  vis <- if length (recordFields r) > (6 + offset) && not (link `elem` [Internal, Private])
+                then field 6 visibility
+                else pure DefaultVisibility
 
   ty <- if explicitTy
            then return ptrty
-           else elimPtrTo ptrty `mplus` fail "Invalid type for value"
+           else elimPtrTo ptrty `mplus` (fail $ "Invalid type for value: " ++ show ptrty)
 
-  name    <- entryName n
-  _       <- pushValue (Typed (PtrTo ty) (ValSymbol (Symbol name)))
+  _       <- pushValue (Typed (PtrTo ty) (ValSymbol name))
   let valid | initid == 0 = Nothing
             | otherwise   = Just (initid - 1)
       attrs = GlobalAttrs
-        { gaLinkage    = do
-          guard (link /= External)
-          return link
+        { gaLinkage    = Just link
+        , gaVisibility = Just vis
         , gaConstant   = isconst
         }
 
   return PartialGlobal
-    { pgSym     = Symbol name
+    { pgSym     = name
     , pgAttrs   = attrs
     , pgType    = ty
     , pgValueIx = valid
@@ -77,11 +79,11 @@
 
 finalizeGlobal :: PartialGlobal -> Parse Global
 finalizeGlobal pg = case pgValueIx pg of
-  Nothing -> mkGlobal Nothing
+  Nothing -> liftFinalize $ mkGlobal Nothing
   Just ix -> do
     tv <- getFnValueById (pgType pg) (fromIntegral ix)
-    val <- relabel (const requireBbEntryName) (typedValue tv)
-    mkGlobal (Just val)
+    val <- liftFinalize $ relabel (const requireBbEntryName) (typedValue tv)
+    liftFinalize $ mkGlobal (Just val)
   where
   mkGlobal mval =
     do md <- mapM (relabel (const requireBbEntryName)) (pgMd pg)
diff --git a/src/Data/LLVM/BitCode/IR/Metadata.hs b/src/Data/LLVM/BitCode/IR/Metadata.hs
--- a/src/Data/LLVM/BitCode/IR/Metadata.hs
+++ b/src/Data/LLVM/BitCode/IR/Metadata.hs
@@ -1,859 +1,1294 @@
-{-# LANGUAGE TupleSections #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE ViewPatterns #-}
-{-# LANGUAGE RecursiveDo #-}
-
-module Data.LLVM.BitCode.IR.Metadata (
-    parseMetadataBlock
-  , parseMetadataKindEntry
-  , PartialUnnamedMd(..)
-  , finalizePartialUnnamedMd
-  , finalizePValMd
-  , InstrMdAttachments
-  , PFnMdAttachments
-  , PKindMd
-  , PGlobalAttachments
-  ) where
-
-import Data.LLVM.BitCode.Bitstream
-import Data.LLVM.BitCode.Match
-import Data.LLVM.BitCode.Parse
-import Data.LLVM.BitCode.Record
-import Text.LLVM.AST
-import Text.LLVM.Labels
-
-import Control.Exception (throw)
-import Control.Monad (foldM,guard,mplus,unless,when)
-import Data.List (mapAccumL)
-import Data.Maybe (fromMaybe)
-import Data.Bits (shiftR, testBit, shiftL)
-import Data.Word (Word32,Word64)
-import qualified Data.ByteString as S
-import qualified Data.ByteString.Char8 as Char8 (unpack)
-import qualified Data.Map as Map
-
-
--- Parsing State ---------------------------------------------------------------
-
-data MetadataTable = MetadataTable
-  { mtEntries   :: MdTable
-  , mtNextNode  :: !Int
-  , mtNodes     :: Map.Map Int (Bool,Bool,Int)
-                   -- ^ The entries in the map are: is the entry function local,
-                   -- is the entry distinct, and the implicit id for the node.
-  } deriving (Show)
-
-emptyMetadataTable ::
-  Int {- ^ globals seen so far -} ->
-  MdTable -> MetadataTable
-emptyMetadataTable globals es = MetadataTable
-  { mtEntries   = es
-  , mtNextNode  = globals
-  , mtNodes     = Map.empty
-  }
-
-metadata :: PValMd -> Typed PValue
-metadata  = Typed (PrimType Metadata) . ValMd
-
-addMetadata :: PValMd  -> MetadataTable -> (Int,MetadataTable)
-addMetadata val mt = (ix, mt { mtEntries = es' })
-  where
-  (ix,es') = addValue' (metadata val) (mtEntries mt)
-
-addMdValue :: Typed PValue -> MetadataTable -> MetadataTable
-addMdValue tv mt = mt { mtEntries = addValue tv' (mtEntries mt) }
-  where
-  -- explicitly make a metadata value out of a normal value
-  tv' = Typed { typedType  = PrimType Metadata
-              , typedValue = ValMd (ValMdValue tv)
-              }
-
-nameNode :: Bool -> Bool -> Int -> MetadataTable -> MetadataTable
-nameNode fnLocal isDistinct ix mt = mt
-  { mtNodes    = Map.insert ix (fnLocal,isDistinct,mtNextNode mt) (mtNodes mt)
-  , mtNextNode = mtNextNode mt + 1
-  }
-
-addString :: String -> MetadataTable -> MetadataTable
-addString str = snd . addMetadata (ValMdString str)
-
-addStrings :: [String] -> MetadataTable -> MetadataTable
-addStrings strs mt = foldl (flip addString) mt strs
-
-addLoc :: Bool -> PDebugLoc -> MetadataTable -> MetadataTable
-addLoc isDistinct loc mt = nameNode False isDistinct ix mt'
-  where
-  (ix,mt') = addMetadata (ValMdLoc loc) mt
-
-addDebugInfo
-  :: Bool
-  -> DebugInfo' Int
-  -> MetadataTable
-  -> MetadataTable
-addDebugInfo isDistinct di mt = nameNode False isDistinct ix mt'
-  where
-  (ix,mt') = addMetadata (ValMdDebugInfo di) mt
-
--- | Add a new node, that might be distinct.
-addNode :: Bool -> [Maybe PValMd] -> MetadataTable -> MetadataTable
-addNode isDistinct vals mt = nameNode False isDistinct ix mt'
-  where
-  (ix,mt') = addMetadata (ValMdNode vals) mt
-
-addOldNode :: Bool -> [Typed PValue] -> MetadataTable -> MetadataTable
-addOldNode fnLocal vals mt = nameNode fnLocal False ix mt'
-  where
-  (ix,mt') = addMetadata (ValMdNode [ Just (ValMdValue tv) | tv <- vals ]) mt
-
-mdForwardRef :: [String] -> MetadataTable -> Int -> PValMd
-mdForwardRef cxt mt ix = fromMaybe fallback nodeRef
-  where
-  fallback          = case forwardRef cxt ix (mtEntries mt) of
-                        Typed { typedValue = ValMd md } -> md
-                        tv                              -> ValMdValue tv
-  reference (_,_,r) = ValMdRef r
-  nodeRef           = reference `fmap` Map.lookup ix (mtNodes mt)
-
-mdForwardRefOrNull :: [String] -> MetadataTable -> Int -> Maybe PValMd
-mdForwardRefOrNull cxt mt ix | ix > 0 = Just (mdForwardRef cxt mt (ix - 1))
-                             | otherwise = Nothing
-
-mdNodeRef :: [String] -> MetadataTable -> Int -> Int
-mdNodeRef cxt mt ix =
-  maybe (throw (BadValueRef cxt ix)) prj (Map.lookup ix (mtNodes mt))
-  where
-  prj (_,_,x) = x
-
-mdString :: [String] -> MetadataTable -> Int -> String
-mdString cxt mt ix =
-  fromMaybe (throw (BadValueRef cxt ix)) (mdStringOrNull cxt mt ix)
-
-mdStringOrNull :: [String] -> MetadataTable -> Int -> Maybe String
-mdStringOrNull cxt mt ix =
-  case mdForwardRefOrNull cxt mt ix of
-    Nothing -> Nothing
-    Just (ValMdString str) -> Just str
-    Just _ -> throw (BadTypeRef cxt ix)
-
-mkMdRefTable :: MetadataTable -> MdRefTable
-mkMdRefTable mt = Map.mapMaybe step (mtNodes mt)
-  where
-  step (fnLocal,_,ix) = do
-    guard (not fnLocal)
-    return ix
-
-data PartialMetadata = PartialMetadata
-  { pmEntries          :: MetadataTable
-  , pmNamedEntries     :: Map.Map String [Int]
-  , pmNextName         :: Maybe String
-  , pmInstrAttachments :: InstrMdAttachments
-  , pmFnAttachments    :: PFnMdAttachments
-  , pmGlobalAttachments:: PGlobalAttachments
-  } deriving (Show)
-
-emptyPartialMetadata ::
-  Int {- ^ globals seen so far -} ->
-  MdTable -> PartialMetadata
-emptyPartialMetadata globals es = PartialMetadata
-  { pmEntries          = emptyMetadataTable globals es
-  , pmNamedEntries     = Map.empty
-  , pmNextName         = Nothing
-  , pmInstrAttachments = Map.empty
-  , pmFnAttachments    = Map.empty
-  , pmGlobalAttachments= Map.empty
-  }
-
-updateMetadataTable :: (MetadataTable -> MetadataTable)
-                    -> (PartialMetadata -> PartialMetadata)
-updateMetadataTable f pm = pm { pmEntries = f (pmEntries pm) }
-
-addGlobalAttachments ::
-  Symbol {- ^ name of the global to attach to ^ -} ->
-  (Map.Map KindMd PValMd) {- ^ metadata references to attach ^ -} ->
-  (PartialMetadata -> PartialMetadata)
-addGlobalAttachments sym mds pm =
-  pm { pmGlobalAttachments = Map.insert sym mds (pmGlobalAttachments pm)
-     }
-
-setNextName :: String -> PartialMetadata -> PartialMetadata
-setNextName name pm = pm { pmNextName = Just name }
-
-addFnAttachment :: PFnMdAttachments -> PartialMetadata -> PartialMetadata
-addFnAttachment att pm =
-  -- left-biased union, since the parser overwrites metadata as it encounters it
-  pm { pmFnAttachments = Map.union att (pmFnAttachments pm) }
-
-addInstrAttachment :: Int -> [(KindMd,PValMd)]
-                   -> PartialMetadata -> PartialMetadata
-addInstrAttachment instr md pm =
-  pm { pmInstrAttachments = Map.insert instr md (pmInstrAttachments pm) }
-
-nameMetadata :: [Int] -> PartialMetadata -> Parse PartialMetadata
-nameMetadata val pm = case pmNextName pm of
-  Just name -> return $! pm
-    { pmNextName     = Nothing
-    , pmNamedEntries = Map.insert name val (pmNamedEntries pm)
-    }
-  Nothing -> fail "Expected a metadata name"
-
-namedEntries :: PartialMetadata -> [NamedMd]
-namedEntries  = map (uncurry NamedMd)
-              . Map.toList
-              . pmNamedEntries
-
-data PartialUnnamedMd = PartialUnnamedMd
-  { pumIndex    :: Int
-  , pumValues   :: PValMd
-  , pumDistinct :: Bool
-  } deriving (Show)
-
-finalizePartialUnnamedMd :: PartialUnnamedMd -> Parse UnnamedMd
-finalizePartialUnnamedMd pum = mkUnnamedMd `fmap` finalizePValMd (pumValues pum)
-  where
-  mkUnnamedMd v = UnnamedMd
-    { umIndex  = pumIndex pum
-    , umValues = v
-    , umDistinct = pumDistinct pum
-    }
-
-finalizePValMd :: PValMd -> Parse ValMd
-finalizePValMd = relabel (const requireBbEntryName)
-
--- | Partition unnamed entries into global and function local unnamed entries.
-unnamedEntries :: PartialMetadata -> ([PartialUnnamedMd],[PartialUnnamedMd])
-unnamedEntries pm = foldl resolveNode ([],[]) (Map.toList (mtNodes mt))
-  where
-  mt = pmEntries pm
-  es = valueEntries (mtEntries mt)
-
-  resolveNode (gs,fs) (ref,(fnLocal,d,ix)) = case lookupNode ref d ix of
-    Just pum | fnLocal   -> (gs,pum:fs)
-             | otherwise -> (pum:gs,fs)
-
-    -- TODO: is this silently eating errors with metadata that's not in the
-    -- value table?
-    Nothing              -> (gs,fs)
-
-  lookupNode ref d ix = do
-    Typed { typedValue = ValMd v } <- Map.lookup ref es
-    return PartialUnnamedMd
-      { pumIndex  = ix
-      , pumValues = v
-      , pumDistinct = d
-      }
-
-type InstrMdAttachments = Map.Map Int [(KindMd,PValMd)]
-
-type PKindMd = Int
-type PFnMdAttachments = Map.Map PKindMd PValMd
-type PGlobalAttachments = Map.Map Symbol (Map.Map KindMd PValMd)
-
-type ParsedMetadata =
-  ( [NamedMd]
-  , ([PartialUnnamedMd],[PartialUnnamedMd])
-  , InstrMdAttachments
-  , PFnMdAttachments
-  , PGlobalAttachments
-  )
-
-parsedMetadata :: PartialMetadata -> ParsedMetadata
-parsedMetadata pm =
-  ( namedEntries pm
-  , unnamedEntries pm
-  , pmInstrAttachments pm
-  , pmFnAttachments pm
-  , pmGlobalAttachments pm
-  )
-
--- Metadata Parsing ------------------------------------------------------------
-
-parseMetadataBlock ::
-  Int {- ^ globals seen so far -} ->
-  ValueTable -> [Entry] -> Parse ParsedMetadata
-parseMetadataBlock globals vt es = label "METADATA_BLOCK" $ do
-  ms <- getMdTable
-  let pm0 = emptyPartialMetadata globals ms
-  rec pm <- foldM (parseMetadataEntry vt (pmEntries pm)) pm0 es
-  let entries = pmEntries pm
-  setMdTable (mtEntries entries)
-  setMdRefs  (mkMdRefTable entries)
-  return (parsedMetadata pm)
-
--- | Parse an entry in the metadata block.
---
--- XXX this currently relies on the constant block having been parsed already.
--- Though most bitcode examples I've seen are ordered this way, it would be nice
--- to not have to rely on it.
-parseMetadataEntry :: ValueTable -> MetadataTable -> PartialMetadata -> Entry
-                   -> Parse PartialMetadata
-parseMetadataEntry vt mt pm (fromEntry -> Just r) =
- case recordCode r of
-  -- [values]
-  1 -> label "METADATA_STRING" $ do
-    str <- parseFields r 0 char `mplus` parseField r 0 string
-    return $! updateMetadataTable (addString str) pm
-
-  -- [type num, value num]
-  2 -> label "METADATA_VALUE" $ do
-    unless (length (recordFields r) == 2)
-           (fail "Invalid record")
-
-    let field = parseField r
-    ty  <- getType =<< field 0 numeric
-    when (ty == PrimType Metadata || ty == PrimType Void)
-         (fail "invalid record")
-
-    cxt <- getContext
-    ix  <- field 1 numeric
-    let tv = forwardRef cxt ix vt
-
-    return $! updateMetadataTable (addMdValue tv) pm
-
-
-  -- [n x md num]
-  3 -> label "METADATA_NODE" (parseMetadataNode False mt r pm)
-
-  -- [values]
-  4 -> label "METADATA_NAME" $ do
-    name <- parseFields r 0 char `mplus` parseField r 0 cstring
-    return $! setNextName name pm
-
-  -- [n x md num]
-  5 -> label "METADATA_DISTINCT_NODE" (parseMetadataNode True mt r pm)
-
-  -- [n x [id, name]]
-  6 -> label "METADATA_KIND" $ do
-    kind <- parseField  r 0 numeric
-    name <- parseFields r 1 char
-    addKind kind name
-    return pm
-
-  -- [distinct, line, col, scope, inlined-at?]
-  7 -> label "METADATA_LOCATION" $ do
-    -- TODO: broken in 3.7+; needs to be a DILocation rather than an
-    -- MDLocation, but there appears to be no difference in the
-    -- bitcode. /sigh/
-    cxt       <- getContext
-    let field = parseField r
-    isDistinct <- field 0 nonzero
-    dlLine     <- field 1 numeric
-    dlCol      <- field 2 numeric
-    dlScope    <- mdForwardRef cxt mt <$> field 3 numeric
-    dlIA       <- mdForwardRefOrNull cxt mt <$> field 4 numeric
-    let loc = DebugLoc { .. }
-    return $! updateMetadataTable (addLoc isDistinct loc) pm
-
-
-  -- [n x (type num, value num)]
-  8 -> label "METADATA_OLD_NODE" (parseMetadataOldNode False vt mt r pm)
-
-  -- [n x (type num, value num)]
-  9 -> label "METADATA_OLD_FN_NODE" (parseMetadataOldNode True vt mt r pm)
-
-  -- [n x mdnodes]
-  10 -> label "METADATA_NAMED_NODE" $ do
-    mdIds <- parseFields r 0 numeric
-    cxt   <- getContext
-    let ids = map (mdNodeRef cxt mt) mdIds
-    nameMetadata ids pm
-
-  -- [m x [value, [n x [id, mdnode]]]
-  11 -> label "METADATA_ATTACHMENT" $ do
-    let recordSize = length (recordFields r)
-    when (recordSize == 0)
-      (fail "Invalid record")
-    if (recordSize `mod` 2 == 0)
-      then label "function attachment" $ do
-        att <- Map.fromList <$> parseAttachment r 0
-        return $! addFnAttachment att pm
-      else label "instruction attachment" $ do
-        inst <- parseField r 0 numeric
-        patt <- parseAttachment r 1
-        att <- mapM (\(k,md) -> (,md) <$> getKind k) patt
-        return $! addInstrAttachment inst att pm
-
-  12 -> label "METADATA_GENERIC_DEBUG" $ do
-    --isDistinct <- parseField r 0 numeric
-    --tag <- parseField r 1 numeric
-    --version <- parseField r 2 numeric
-    --header <- parseField r 3 string
-    -- TODO: parse all remaining fields
-    fail "not yet implemented"
-
-  13 -> label "METADATA_SUBRANGE" $ do
-    isDistinct <- parseField r 0 nonzero
-    disrCount <- parseField r 1 numeric
-    disrLowerBound <- parseField r 2 signedInt64
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoSubrange DISubrange{..})) pm
-
-  -- [distinct, value, name]
-  14 -> label "METADATA_ENUMERATOR" $ do
-    ctx        <- getContext
-    isDistinct <- parseField r 0 nonzero
-    value      <- parseField r 1 signedInt64
-    name       <- mdString ctx mt <$> parseField r 2 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoEnumerator name value)) pm
-
-  15 -> label "METADATA_BASIC_TYPE" $ do
-    ctx <- getContext
-    isDistinct <- parseField r 0 nonzero
-    dibtTag <- parseField r 1 numeric
-    dibtName <- mdString ctx mt <$> parseField r 2 numeric
-    dibtSize <- parseField r 3 numeric
-    dibtAlign <- parseField r 4 numeric
-    dibtEncoding <- parseField r 5 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoBasicType DIBasicType{..})) pm
-
-  -- [distinct, filename, directory]
-  16 -> label "METADATA_FILE" $ do
-    ctx <- getContext
-    isDistinct <- parseField r 0 nonzero
-    difFilename <- mdString ctx mt <$> parseField r 1 numeric
-    difDirectory <- mdString ctx mt <$> parseField r 2 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoFile DIFile{..})) pm
-
-  17 -> label "METADATA_DERIVED_TYPE" $ do
-    ctx <- getContext
-    isDistinct    <- parseField r 0 nonzero
-    didtTag       <- parseField r 1 numeric
-    didtName      <- mdStringOrNull     ctx mt <$> parseField r 2 numeric
-    didtFile      <- mdForwardRefOrNull ctx mt <$> parseField r 3 numeric
-    didtLine      <- parseField r 4 numeric
-    didtScope     <- mdForwardRefOrNull ctx mt <$> parseField r 5 numeric
-    didtBaseType  <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
-    didtSize      <- parseField r 7 numeric
-    didtAlign     <- parseField r 8 numeric
-    didtOffset    <- parseField r 9 numeric
-    didtFlags     <- parseField r 10 numeric
-    didtExtraData <- mdForwardRefOrNull ctx mt <$> parseField r 11 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoDerivedType DIDerivedType{..})) pm
-
-  18 -> label "METADATA_COMPOSITE_TYPE" $ do
-    ctx <- getContext
-    isDistinct         <- parseField r 0 nonzero
-    dictTag            <- parseField r 1 numeric
-    dictName           <- mdStringOrNull     ctx mt <$> parseField r 2 numeric
-    dictFile           <- mdForwardRefOrNull ctx mt <$> parseField r 3 numeric
-    dictLine           <- parseField r 4 numeric
-    dictScope          <- mdForwardRefOrNull ctx mt <$> parseField r 5 numeric
-    dictBaseType       <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
-    dictSize           <- parseField r 7 numeric
-    dictAlign          <- parseField r 8 numeric
-    dictOffset         <- parseField r 9 numeric
-    dictFlags          <- parseField r 10 numeric
-    dictElements       <- mdForwardRefOrNull ctx mt <$> parseField r 11 numeric
-    dictRuntimeLang    <- parseField r 12 numeric
-    dictVTableHolder   <- mdForwardRefOrNull ctx mt <$> parseField r 13 numeric
-    dictTemplateParams <- mdForwardRefOrNull ctx mt <$> parseField r 14 numeric
-    dictIdentifier     <- mdStringOrNull     ctx mt <$> parseField r 15 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoCompositeType DICompositeType{..})) pm
-
-  19 -> label "METADATA_SUBROUTINE_TYPE" $ do
-    ctx <- getContext
-    isDistinct    <- parseField r 0 nonzero
-    distFlags     <- parseField r 1 numeric
-    distTypeArray <- mdForwardRefOrNull ctx mt <$> parseField r 2 numeric
-    return $! updateMetadataTable
-      (addDebugInfo
-         isDistinct
-         (DebugInfoSubroutineType DISubroutineType{..}))
-      pm
-
-  20 -> label "METADATA_COMPILE_UNIT" $ do
-    let recordSize = length (recordFields r)
-
-    -- TODO: update this for llvm-4.0, which bumped the upper bound to 18
-    when (recordSize < 14 || recordSize > 18)
-      (fail "Invalid record")
-
-    ctx <- getContext
-    isDistinct             <- parseField r 0 nonzero
-    dicuLanguage           <- parseField r 1 numeric
-    dicuFile               <-
-      mdForwardRefOrNull ctx mt <$> parseField r 2 numeric
-    dicuProducer           <- mdStringOrNull ctx mt <$> parseField r 3 numeric
-    dicuIsOptimized        <- parseField r 4 nonzero
-    dicuFlags              <- mdStringOrNull ctx mt <$> parseField r 5 numeric
-    dicuRuntimeVersion     <- parseField r 6 numeric
-    dicuSplitDebugFilename <- mdStringOrNull ctx mt <$> parseField r 7 numeric
-    dicuEmissionKind       <- parseField r 8 numeric
-    dicuEnums              <-
-      mdForwardRefOrNull ctx mt <$> parseField r 9 numeric
-    dicuRetainedTypes      <-
-      mdForwardRefOrNull ctx mt <$> parseField r 10 numeric
-    dicuSubprograms        <-
-      mdForwardRefOrNull ctx mt <$> parseField r 11 numeric
-    dicuGlobals            <-
-      mdForwardRefOrNull ctx mt <$> parseField r 12 numeric
-    dicuImports            <-
-      mdForwardRefOrNull ctx mt <$> parseField r 13 numeric
-    dicuMacros <-
-      if recordSize <= 15
-      then pure Nothing
-      else mdForwardRefOrNull ctx mt <$> parseField r 15 numeric
-    dicuDWOId <-
-      if recordSize <= 14
-      then pure 0
-      else parseField r 14 numeric
-    dicuSplitDebugInlining <-
-      if recordSize <= 16
-      then pure True
-      else parseField r 16 nonzero
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoCompileUnit DICompileUnit {..})) pm
-
-
-  21 -> label "METADATA_SUBPROGRAM" $ do
-    -- this one is a bit funky:
-    -- https://github.com/llvm-mirror/llvm/blob/release_38/lib/Bitcode/Reader/BitcodeReader.cpp#L2186
-    let recordSize = length (recordFields r)
-        adj i | recordSize == 19 = i + 1
-              | otherwise        = i
-        hasThisAdjustment = recordSize >= 20
-    unless (18 <= recordSize && recordSize <= 20)
-      (fail "Invalid record")
-
-    ctx <- getContext
-    isDistinct         <- parseField r 0 nonzero
-    dispScope          <- mdForwardRefOrNull ctx mt <$> parseField r 1 numeric
-    dispName           <- mdStringOrNull ctx mt <$> parseField r 2 numeric
-    dispLinkageName    <- mdStringOrNull ctx mt <$> parseField r 3 numeric
-    dispFile           <- mdForwardRefOrNull ctx mt <$> parseField r 4 numeric
-    dispLine           <- parseField r 5 numeric
-    dispType           <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
-    dispIsLocal        <- parseField r 7 nonzero
-    dispIsDefinition   <- parseField r 8 nonzero
-    dispScopeLine      <- parseField r 9 numeric
-    dispContainingType <- mdForwardRefOrNull ctx mt <$> parseField r 10 numeric
-    dispVirtuality     <- parseField r 11 numeric
-    dispVirtualIndex   <- parseField r 12 numeric
-    dispThisAdjustment <- if hasThisAdjustment
-                            then parseField r 19 numeric
-                            else return 0
-    dispFlags          <- parseField r 13 numeric
-    dispIsOptimized    <- parseField r 14 nonzero
-    dispTemplateParams <-
-      mdForwardRefOrNull ctx mt <$> parseField r (adj 15) numeric
-    dispDeclaration <-
-      mdForwardRefOrNull ctx mt <$> parseField r (adj 16) numeric
-    dispVariables <-
-      mdForwardRefOrNull ctx mt <$> parseField r (adj 17) numeric
-    -- TODO: in the LLVM parser, it then goes into the metadata table
-    -- and updates function entries to point to subprograms. Is that
-    -- neccessary for us?
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoSubprogram DISubprogram{..})) pm
-
-  22 -> label "METADATA_LEXICAL_BLOCK" $ do
-    when (length (recordFields r) /= 5)
-      (fail "Invalid record")
-    cxt <- getContext
-    isDistinct <- parseField r 0 nonzero
-    dilbScope  <- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-    dilbFile   <- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    dilbLine   <- parseField r 3 numeric
-    dilbColumn <- parseField r 4 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoLexicalBlock DILexicalBlock{..})) pm
-
-  23 -> label "METADATA_LEXICAL_BLOCK_FILE" $ do
-    when (length (recordFields r) /= 4)
-      (fail "Invalid record")
-    cxt <- getContext
-    isDistinct <- parseField r 0 nonzero
-    dilbfScope <- do
-      mScope <- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-      maybe (fail "Invalid record: scope field not present") return mScope
-    dilbfFile <- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    dilbfDiscriminator <- parseField r 3 numeric
-    return $! updateMetadataTable
-      (addDebugInfo
-         isDistinct
-         (DebugInfoLexicalBlockFile DILexicalBlockFile{..}))
-      pm
-
-  24 -> label "METADATA_NAMESPACE" $ do
-    -- cxt <- getContext
-    -- isDistinct <- parseField r 0 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    -- parseField r 3 string
-    -- parseField r 4 numeric
-    -- TODO
-    fail "not yet implemented"
-  25 -> label "METADATA_TEMPLATE_TYPE" $ do
-    -- isDistinct <- parseField r 0 numeric
-    -- parseField r 1 string
-    -- getDITypeRefOrNull <$> parseField r 2 numeric
-    -- TODO
-    fail "not yet implemented"
-  26 -> label "METADATA_TEMPLATE_VALUE" $ do
-    -- cxt <- getContext
-    -- isDistinct <- parseField r 0 numeric
-    -- parseField r 1 numeric
-    -- parseField r 2 string
-    -- getDITypeRefOrNull cxt mt <$> parseField r 3 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 4 numeric
-    -- TODO
-    fail "not yet implemented"
-
-  27 -> label "METADATA_GLOBAL_VAR" $ do
-    let len = length (recordFields r)
-    unless (11 <= len && len <= 12)
-      (fail "Unexpected number of record fields")
-
-    ctx        <- getContext
-    field0     <- parseField r 0 numeric
-    let isDistinct = testBit field0 0
-        _version   = shiftR  field0 1 :: Int
-
-    digvScope  <- mdForwardRefOrNull ctx mt <$> parseField r 1 numeric
-    digvName   <- mdStringOrNull ctx mt <$> parseField r 2 numeric
-    digvLinkageName <- mdStringOrNull ctx mt <$> parseField r 3 numeric
-    digvFile   <- mdForwardRefOrNull ctx mt <$> parseField r 4 numeric
-    digvLine   <- parseField r 5 numeric
-    digvType   <- mdForwardRefOrNull ctx mt <$> parseField r 6 numeric
-    digvIsLocal <- parseField r 7 nonzero
-    digvIsDefinition <- parseField r 8 nonzero
-    digvVariable <- mdForwardRefOrNull ctx mt <$> parseField r 9 numeric
-    digvDeclaration <- mdForwardRefOrNull ctx mt <$> parseField r 10 numeric
-    digvAlignment   <- if len > 11 then Just <$> parseField r 11 numeric
-                                   else return Nothing
-    return $! updateMetadataTable
-      (addDebugInfo
-         isDistinct
-         (DebugInfoGlobalVariable DIGlobalVariable{..})) pm
-
-  28 -> label "METADATA_LOCAL_VAR" $ do
-    -- this one is a bit funky:
-    -- https://github.com/llvm-mirror/llvm/blob/release_38/lib/Bitcode/Reader/BitcodeReader.cpp#L2308
-    let recordSize = length (recordFields r)
-    when (recordSize < 8 || recordSize > 10)
-      (fail "Invalid record")
-
-    ctx <- getContext
-
-    field0 <- parseField r 0 numeric
-    let isDistinct   = testBit (field0 :: Word32) 0
-        hasAlignment = testBit (field0 :: Word32) 1
-
-        hasTag | not hasAlignment && recordSize > 8 = 1
-               | otherwise                          = 0
-
-        adj i = i + hasTag
-
-    _alignInBits <-
-      if hasAlignment
-         then do n <- parseField r (adj 8) numeric
-                 when ((n :: Word64) > fromIntegral (maxBound :: Word32))
-                      (fail "Alignment value is too large")
-                 return (fromIntegral n :: Word32)
-
-         else return 0
-
-    dilvScope  <- mdForwardRefOrNull ("dilvScope":ctx) mt <$> parseField r (adj 1) numeric
-    dilvName   <- mdStringOrNull     ("dilvName" :ctx) mt <$> parseField r (adj 2) numeric
-    dilvFile   <- mdForwardRefOrNull ("dilvFile" :ctx) mt <$> parseField r (adj 3) numeric
-    dilvLine   <- parseField r (adj 4) numeric
-    dilvType   <- mdForwardRefOrNull ("dilvType" :ctx) mt <$> parseField r (adj 5) numeric
-    dilvArg    <- parseField r (adj 6) numeric
-    dilvFlags  <- parseField r (adj 7) numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoLocalVariable DILocalVariable{..})) pm
-
-  29 -> label "METADATA_EXPRESSION" $ do
-    let recordSize = length (recordFields r)
-    when (recordSize < 1)
-      (fail "Invalid record")
-    isDistinct <- parseField r 0 nonzero
-    dieElements <- parseFields r 1 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoExpression DIExpression{..})) pm
-
-  30 -> label "METADATA_OBJC_PROPERTY" $ do
-    -- TODO
-    fail "not yet implemented"
-  31 -> label "METADATA_IMPORTED_ENTITY" $ do
-    -- cxt <- getContext
-    -- isDistinct <- parseField r 0 numeric
-    -- parseField r 1 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    -- getDITypeRefOrNull cxt mt <$> parseField r 3 numeric
-    -- parseField r 4 numeric
-    -- parseField r 5 string
-    -- TODO
-    fail "not yet implemented"
-  32 -> label "METADATA_MODULE" $ do
-    -- cxt <- getContext
-    -- isDistinct <- parseField r 0 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-    -- parseField r 2 string
-    -- parseField r 3 string
-    -- parseField r 4 string
-    -- parseField r 5 string
-    -- TODO
-    fail "not yet implemented"
-  33 -> label "METADATA_MACRO" $ do
-    -- isDistinct <- parseField r 0 numeric
-    -- parseField r 1 numeric
-    -- parseField r 2 numeric
-    -- parseField r 3 string
-    -- parseField r 4 string
-    -- TODO
-    fail "not yet implemented"
-  34 -> label "METADATA_MACRO_FILE" $ do
-    -- cxt <- getContext
-    -- isDistinct <- parseField r 0 numeric
-    -- parseField r 1 numeric
-    -- parseField r 2 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 3 numeric
-    -- mdForwardRefOrNull cxt mt <$> parseField r 4 numeric
-    -- TODO
-    fail "not yet implemented"
-
-  35 -> label "METADATA_STRINGS" $ do
-    when (length (recordFields r) /= 3)
-      (fail "Invalid record: metadata strings layout")
-    count  <- parseField r 0 numeric
-    offset <- parseField r 1 numeric
-    bs     <- parseField r 2 fieldBlob
-    when (count == 0)
-      (fail "Invalid record: metadata strings with no strings")
-    when (offset >= S.length bs)
-      (fail "Invalid record: metadata strings corrupt offset")
-    let (bsLengths, bsStrings) = S.splitAt offset bs
-    lengths <- either fail return $ parseMetadataStringLengths count bsLengths
-    when (sum lengths > S.length bsStrings)
-      (fail "Invalid record: metadata strings truncated")
-    let strings = snd (mapAccumL f bsStrings lengths)
-          where f s i = case S.splitAt i s of
-                          (str,rest) -> (rest, Char8.unpack str)
-    return $! updateMetadataTable (addStrings strings) pm
-
-  -- [ valueid, n x [id, mdnode] ]
-  36 -> label "METADATA_GLOBAL_DECL_ATTACHMENT" $ do
-
-    -- the record will always be of odd length
-    when (mod (length (recordFields r)) 2 == 0)
-         (fail "Invalid record")
-
-    valueId <- parseField r 0 numeric
-    sym     <- case lookupValueTableAbs valueId vt of
-                 Just (Typed { typedValue = ValSymbol sym }) -> return sym
-                 _ -> fail "Non-global referenced"
-
-    refs <- parseGlobalObjectAttachment mt r
-
-    return $! addGlobalAttachments sym refs pm
-
-  37 -> label "METADATA_GLOBAL_VAR_EXPR" $ do
-    when (length (recordFields r) /= 3)
-      (fail "Invalid record: unsupported layout")
-    cxt <- getContext
-    isDistinct      <- parseField r 0 nonzero
-    digveVariable   <- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
-    digveExpression <- mdForwardRefOrNull cxt mt <$> parseField r 2 numeric
-    return $! updateMetadataTable
-      (addDebugInfo isDistinct (DebugInfoGlobalVariableExpression DIGlobalVariableExpression{..})) pm
-
-  38 -> label "METADATA_INDEX_OFFSET" $ do
-
-    when (length (recordFields r) /= 2)
-         (fail "Invalid record")
-
-    a <- parseField r 0 numeric
-    b <- parseField r 1 numeric
-    let _offset = a + (b `shiftL` 32) :: Word64
-
-    -- TODO: is it OK to skip this if we always parse everything?
-    return pm
-
-
-  -- In the llvm source, this node is processed when the INDEX_OFFSET record is
-  -- found.
-  39 -> label "METADATA_INDEX" $ do
-    -- TODO: is it OK to skip this if we always parse everything?
-    return pm
-
-  code -> fail ("unknown record code: " ++ show code)
-
-parseMetadataEntry _ _ pm (abbrevDef -> Just _) =
-  return pm
-
-parseMetadataEntry _ _ _ r =
-  fail ("unexpected: " ++ show r)
-
-parseAttachment :: Record -> Int -> Parse [(PKindMd,PValMd)]
-parseAttachment r l = loop (length (recordFields r) - 1) []
-  where
-  loop n acc | n < l = return acc
-             | otherwise = do
-    kind <- parseField r (n - 1) numeric
-    md   <- getMetadata =<< parseField r n numeric
-    loop (n - 2) ((kind,typedValue md) : acc)
-
-
--- | This is a named version of the metadata list that can show up at the end of
--- a global declaration. It will be of the form @!dbg !2 [!dbg !n, ...]@.
-parseGlobalObjectAttachment :: MetadataTable -> Record -> Parse (Map.Map KindMd PValMd)
-parseGlobalObjectAttachment mt r = label "parseGlobalObjectAttachment" $
-  do cxt <- getContext
-     go cxt Map.empty 1
-  where
-  len = length (recordFields r)
-
-  go cxt acc n | n < len =
-    do kind <- getKind =<< parseField r n numeric
-       i    <- parseField r (n + 1) numeric
-       go cxt (Map.insert kind (mdForwardRef cxt mt i) acc) (n + 2)
-
-  go _ acc _ =
-       return acc
-
-
--- | Parse a metadata node.
-parseMetadataNode :: Bool -> MetadataTable -> Record -> PartialMetadata
-                  -> Parse PartialMetadata
-parseMetadataNode isDistinct mt r pm = do
-  ixs <- parseFields r 0 numeric
-  cxt <- getContext
-  let lkp = mdForwardRefOrNull cxt mt
-  return $! updateMetadataTable (addNode isDistinct (map lkp ixs)) pm
-
-
--- | Parse out a metadata node in the old format.
-parseMetadataOldNode :: Bool -> ValueTable -> MetadataTable -> Record
-                     -> PartialMetadata -> Parse PartialMetadata
-parseMetadataOldNode fnLocal vt mt r pm = do
-  values <- loop =<< parseFields r 0 numeric
-  return $! updateMetadataTable (addOldNode fnLocal values) pm
-  where
-  loop fs = case fs of
-
-    tyId:valId:rest -> do
-      cxt <- getContext
-      ty  <- getType' tyId
-      val <- case ty of
-        PrimType Metadata -> return $ Typed (PrimType Metadata)
-                                            (ValMd (mdForwardRef cxt mt valId))
-        -- XXX need to check for a void type here
-        _                 -> return (forwardRef cxt valId vt)
-
-      vals <- loop rest
-      return (val:vals)
-
-    [] -> return []
-
-    _ -> fail "Malformed metadata node"
-
-parseMetadataKindEntry :: Record -> Parse ()
-parseMetadataKindEntry r = do
-  kind <- parseField  r 0 numeric
-  name <- parseFields r 1 char
-  addKind kind name
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ExplicitForAll #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE RecursiveDo #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Data.LLVM.BitCode.IR.Metadata (
+    parseMetadataBlock
+  , parseMetadataKindEntry
+  , PartialUnnamedMd(..)
+  , finalizePartialUnnamedMd
+  , finalizePValMd
+  , dedupMetadata
+  , InstrMdAttachments
+  , PFnMdAttachments
+  , PKindMd
+  , PGlobalAttachments
+  ) where
+
+import           Data.LLVM.BitCode.Bitstream
+import           Data.LLVM.BitCode.IR.Constants
+import           Data.LLVM.BitCode.Match
+import           Data.LLVM.BitCode.Parse
+import           Data.LLVM.BitCode.Record
+import           Text.LLVM.AST
+import           Text.LLVM.Labels
+
+import qualified Codec.Binary.UTF8.String as UTF8 (decode)
+import           Control.Applicative ((<|>))
+import           Control.Exception (throw)
+import           Control.Monad (foldM, guard, mplus, when)
+import           Data.Bits (shiftR, testBit, shiftL, (.&.), (.|.), bit, complement)
+import           Data.Data (Data)
+import           Data.Typeable (Typeable)
+import qualified Data.ByteString as S
+import qualified Data.ByteString.Char8 as Char8 (unpack)
+import           Data.Either (partitionEithers)
+import           Data.Generics.Uniplate.Data
+import qualified Data.IntMap as IntMap
+import           Data.List (mapAccumL, foldl')
+import           Data.Map (Map)
+import qualified Data.Map as Map
+import           Data.Maybe (fromMaybe, mapMaybe)
+import qualified Data.Sequence as Seq
+import           Data.Sequence (Seq)
+import           Data.Word (Word8,Word32,Word64)
+
+import           GHC.Generics (Generic)
+import           GHC.Stack (HasCallStack, callStack)
+import Data.Bifunctor (bimap)
+
+
+
+-- Parsing State ---------------------------------------------------------------
+
+data MetadataTable = MetadataTable
+  { mtEntries   :: MdTable
+  , mtNextNode  :: !Int
+  , mtNodes     :: IntMap.IntMap (Bool, Bool, Int)
+                   -- ^ The entries in the map are: is the entry function local,
+                   -- is the entry distinct, and the implicit id for the node.
+  } deriving (Show)
+
+emptyMetadataTable ::
+  Int {- ^ globals seen so far -} ->
+  MdTable -> MetadataTable
+emptyMetadataTable globals es = MetadataTable
+  { mtEntries   = es
+  , mtNextNode  = globals
+  , mtNodes     = IntMap.empty
+  }
+
+metadata :: PValMd -> Typed PValue
+metadata  = Typed (PrimType Metadata) . ValMd
+
+addMetadata :: PValMd  -> MetadataTable -> (Int,MetadataTable)
+addMetadata val mt = (ix, mt { mtEntries = es' })
+  where
+  (ix,es') = addValue' (metadata val) (mtEntries mt)
+
+addMdValue :: Typed PValue -> MetadataTable -> MetadataTable
+addMdValue tv mt = mt { mtEntries = addValue tv' (mtEntries mt) }
+  where
+  -- explicitly make a metadata value out of a normal value
+  tv' = Typed { typedType  = PrimType Metadata
+              , typedValue = ValMd (ValMdValue tv)
+              }
+
+nameNode :: Bool -> Bool -> Int -> MetadataTable -> MetadataTable
+nameNode fnLocal isDistinct ix mt = mt
+  { mtNodes    = IntMap.insert ix (fnLocal,isDistinct,mtNextNode mt) (mtNodes mt)
+  , mtNextNode = mtNextNode mt + 1
+  }
+
+addString :: String -> PartialMetadata -> PartialMetadata
+addString str pm =
+  let (ix, mt) = addMetadata (ValMdString str) (pmEntries pm)
+  in pm { pmEntries = mt
+        , pmStrings = Map.insert ix str (pmStrings pm)
+        }
+
+addStrings :: [String] -> PartialMetadata -> PartialMetadata
+addStrings strs pm = foldl' (flip addString) pm strs
+
+addLoc :: Bool -> PDebugLoc -> MetadataTable -> MetadataTable
+addLoc isDistinct loc mt = nameNode False isDistinct ix mt'
+  where
+  (ix,mt') = addMetadata (ValMdLoc loc) mt
+
+addDebugInfo
+  :: Bool
+  -> DebugInfo' Int
+  -> MetadataTable
+  -> MetadataTable
+addDebugInfo isDistinct di mt = nameNode False isDistinct ix mt'
+  where
+  (ix,mt') = addMetadata (ValMdDebugInfo di) mt
+
+-- | A variant of 'addDebugInfo' that only inserts the 'DebugInfo' into the
+-- 'mtEntries', not the 'mtNodes'. This has the effect of causing the
+-- 'DebugInfo' /not/ to be added to any top-level metadata lists and instead
+-- causing it to be printed inline wherever it occurs.
+-- See @Note [Printing metadata inline]@.
+addInlineDebugInfo :: DebugInfo' Int -> MetadataTable -> MetadataTable
+addInlineDebugInfo di mt = mt { mtEntries = addValue tv (mtEntries mt) }
+  where
+  tv = Typed { typedType  = PrimType Metadata
+             , typedValue = ValMd (ValMdDebugInfo di)
+             }
+
+-- | Add a new node, that might be distinct.
+addNode :: Bool -> [Maybe PValMd] -> MetadataTable -> MetadataTable
+addNode isDistinct vals mt = nameNode False isDistinct ix mt'
+  where
+  (ix,mt') = addMetadata (ValMdNode vals) mt
+
+addOldNode :: Bool -> [Typed PValue] -> MetadataTable -> MetadataTable
+addOldNode fnLocal vals mt = nameNode fnLocal False ix mt'
+  where
+  (ix,mt') = addMetadata (ValMdNode [ Just (ValMdValue tv) | tv <- vals ]) mt
+
+mdForwardRef :: [String] -> MetadataTable -> Int -> PValMd
+mdForwardRef cxt mt ix = fromMaybe fallback nodeRef
+  where
+  nodeRef           = reference `fmap` IntMap.lookup ix (mtNodes mt)
+  fallback          = case forwardRef cxt ix (mtEntries mt) of
+                        Typed { typedValue = ValMd md } -> md
+                        tv                              -> ValMdValue tv
+  reference (False, _, r) = ValMdRef r
+  reference (_    , _, r) =
+    let explanation = "Illegal forward reference into function-local metadata."
+    in throw (BadValueRef callStack cxt explanation r)
+
+mdForwardRefOrNull :: [String] -> MetadataTable -> Int -> Maybe PValMd
+mdForwardRefOrNull cxt mt ix | ix > 0 = Just (mdForwardRef cxt mt (ix - 1))
+                             | otherwise = Nothing
+
+mdNodeRef :: HasCallStack
+          => [String] -> MetadataTable -> Int -> Int
+mdNodeRef cxt mt ix = maybe except prj (IntMap.lookup ix (mtNodes mt))
+  where explanation   = "Bad forward reference into mtNodes"
+        except        = throw (BadValueRef callStack cxt explanation ix)
+        prj (_, _, x) = x
+
+mdString :: HasCallStack
+         => [String] -> PartialMetadata -> Int -> String
+mdString cxt partialMeta ix =
+  let explanation = "Null value when metadata string was expected"
+  in fromMaybe (throw (BadValueRef callStack cxt explanation ix))
+               (mdStringOrNull cxt partialMeta ix)
+
+-- | This preferentially fetches the string from the strict string table
+-- (@pmStrings@), but will return a forward reference when it can't find it there.
+mdStringOrNull :: HasCallStack
+               => [String]
+               -> PartialMetadata
+               -> Int
+               -> Maybe String
+mdStringOrNull cxt partialMeta ix =
+  Map.lookup (ix - 1) (pmStrings partialMeta) <|>
+    case mdForwardRefOrNull cxt (pmEntries partialMeta) ix of
+      Nothing                -> Nothing
+      Just (ValMdString str) -> Just str
+      Just _                 ->
+        let explanation = "Non-string metadata when string was expected"
+        in throw (BadTypeRef callStack cxt explanation ix)
+
+mdStringOrEmpty :: HasCallStack
+                => [String]
+                -> PartialMetadata
+                -> Int
+                -> String
+mdStringOrEmpty cxt partialMeta = fromMaybe "" . mdStringOrNull cxt partialMeta
+
+mkMdRefTable :: MetadataTable -> MdRefTable
+mkMdRefTable mt = IntMap.mapMaybe step (mtNodes mt)
+  where
+  step (fnLocal,_,ix) = do
+    guard (not fnLocal)
+    return ix
+
+data PartialMetadata = PartialMetadata
+  { pmEntries          :: MetadataTable
+  , pmNamedEntries     :: Map.Map String [Int]
+  , pmNextName         :: Maybe String
+  , pmInstrAttachments :: InstrMdAttachments
+  , pmFnAttachments    :: PFnMdAttachments
+  , pmGlobalAttachments:: PGlobalAttachments
+  , pmStrings          :: Map Int String
+  -- ^ Forward references to metadata strings are never actually
+  -- forward references, string blocks (@METADATA_STRINGS@) always come first.
+  -- So references to them don't need to be inside the @MonadFix@ like
+  -- references into other 'pmEntries', allowing them to be strict.
+  --
+  -- See this comment:
+  -- - https://github.com/llvm-mirror/llvm/blob/release_40/lib/Bitcode/Reader/MetadataLoader.cpp#L913
+  -- - https://github.com/llvm-mirror/llvm/blob/release_60/lib/Bitcode/Reader/MetadataLoader.cpp#L1017
+  } deriving (Show)
+
+emptyPartialMetadata ::
+  Int {- ^ globals seen so far -} ->
+  MdTable -> PartialMetadata
+emptyPartialMetadata globals es = PartialMetadata
+  { pmEntries           = emptyMetadataTable globals es
+  , pmNamedEntries      = Map.empty
+  , pmNextName          = Nothing
+  , pmInstrAttachments  = Map.empty
+  , pmFnAttachments     = Map.empty
+  , pmGlobalAttachments = Map.empty
+  , pmStrings           = Map.empty
+  }
+
+updateMetadataTable :: (MetadataTable -> MetadataTable)
+                    -> (PartialMetadata -> PartialMetadata)
+updateMetadataTable f pm = pm { pmEntries = f (pmEntries pm) }
+
+addGlobalAttachments ::
+  Symbol {- ^ name of the global to attach to ^ -} ->
+  (Map.Map KindMd PValMd) {- ^ metadata references to attach ^ -} ->
+  (PartialMetadata -> PartialMetadata)
+addGlobalAttachments sym mds pm =
+  pm { pmGlobalAttachments = Map.insert sym mds (pmGlobalAttachments pm)
+     }
+
+setNextName :: String -> PartialMetadata -> PartialMetadata
+setNextName name pm = pm { pmNextName = Just name }
+
+addFnAttachment :: PFnMdAttachments -> PartialMetadata -> PartialMetadata
+addFnAttachment att pm =
+  -- left-biased union, since the parser overwrites metadata as it encounters it
+  pm { pmFnAttachments = Map.union att (pmFnAttachments pm) }
+
+addInstrAttachment :: Int -> [(KindMd,PValMd)]
+                   -> PartialMetadata -> PartialMetadata
+addInstrAttachment instr md pm =
+  pm { pmInstrAttachments = Map.insert instr md (pmInstrAttachments pm) }
+
+nameMetadata :: [Int] -> PartialMetadata -> Parse PartialMetadata
+nameMetadata val pm = case pmNextName pm of
+  Just name -> return $! pm
+    { pmNextName     = Nothing
+    , pmNamedEntries = Map.insert name val (pmNamedEntries pm)
+    }
+  Nothing -> fail "Expected a metadata name"
+
+-- De-duplicating ---------------------------------------------------------------
+
+-- | This function generically traverses the given unnamed metadata values.
+-- When it encounters one with a 'PValMd' inside of it, it looks up that
+-- value in the list. If found, it replaces the value with a reference to it.
+--
+-- Such de-duplication is necessary because the @fallback@ of
+-- 'mdForwardRefOrNull' is often called when it is in fact unnecessary, just
+-- because the appropriate references aren't available yet.
+--
+-- This function is concise at the cost of efficiency: In the worst case, every
+-- metadata node contains a reference to every other metadata node, and the
+-- cost is O(n^2*log(n)) where
+-- * n^2 comes from looking at every 'PValMd' inside every 'PartialUnnamedMd'
+-- * log(n) is the cost of looking them up in a 'Map'.
+dedupMetadata :: Seq PartialUnnamedMd -> Seq PartialUnnamedMd
+dedupMetadata pumd = helper (mkPartialUnnamedMdMap pumd) <$> pumd
+  where helper pumdMap pum =
+          let pumdMap' = Map.delete (pumValues pum) pumdMap -- don't self-reference
+          in pum { pumValues = maybeTransform pumdMap' (pumValues pum) }
+
+        -- | We avoid erroneously recursing into ValMdValues and exit early on
+        -- a few other constructors de-duplication wouldn't affect.
+        maybeTransform :: Map PValMd Int -> PValMd -> PValMd
+        maybeTransform pumdMap v@(ValMdNode _)      = transform (trans pumdMap) v
+        maybeTransform pumdMap v@(ValMdLoc _)       = transform (trans pumdMap) v
+        maybeTransform pumdMap v@(ValMdDebugInfo _) = transform (trans  pumdMap) v
+        maybeTransform _       v                    = v
+
+        trans :: Map PValMd Int -> PValMd -> PValMd
+        trans pumdMap v = case Map.lookup v pumdMap of
+                            Just idex -> ValMdRef idex
+                            Nothing   -> v
+
+        mkPartialUnnamedMdMap :: Seq PartialUnnamedMd -> Map PValMd Int
+        mkPartialUnnamedMdMap =
+          foldl' (\mp part -> Map.insert (pumValues part) (pumIndex part) mp) Map.empty
+
+-- Finalizing ---------------------------------------------------------------
+
+namedEntries :: PartialMetadata -> Seq NamedMd
+namedEntries  = Seq.fromList
+              . map (uncurry NamedMd)
+              . Map.toList
+              . pmNamedEntries
+
+data PartialUnnamedMd = PartialUnnamedMd
+  { pumIndex    :: Int
+  , pumValues   :: PValMd
+  , pumDistinct :: Bool
+  } deriving (Data, Eq, Ord, Generic, Show, Typeable)
+
+finalizePartialUnnamedMd :: PartialUnnamedMd -> Finalize UnnamedMd
+finalizePartialUnnamedMd pum = mkUnnamedMd `fmap` finalizePValMd (pumValues pum)
+  where
+  mkUnnamedMd v = UnnamedMd
+    { umIndex  = pumIndex pum
+    , umValues = v
+    , umDistinct = pumDistinct pum
+    }
+
+finalizePValMd :: PValMd -> Finalize ValMd
+finalizePValMd = relabel (const requireBbEntryName)
+
+-- | Partition unnamed entries into global and function local unnamed entries.
+unnamedEntries :: PartialMetadata -> (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
+unnamedEntries pm = bimap Seq.fromList Seq.fromList (partitionEithers (mapMaybe resolveNode (IntMap.toList (mtNodes mt))))
+  where
+  mt = pmEntries pm
+
+  -- TODO: is this silently eating errors with metadata that's not in the
+  -- value table (when the lookupValueTableAbs fails)?
+  resolveNode :: (Int, (Bool, Bool, Int))
+              -> Maybe (Either PartialUnnamedMd PartialUnnamedMd)
+  resolveNode (ref,(fnLocal,d,ix)) =
+    ((if fnLocal then Right else Left) <$> lookupNode ref d ix)
+
+  lookupNode :: Int -> Bool -> Int -> Maybe PartialUnnamedMd
+  lookupNode ref d ix = do
+    tv <- lookupValueTableAbs ref (mtEntries mt)
+    case tv of
+      Typed { typedValue = ValMd v } ->
+        pure $! PartialUnnamedMd
+          { pumIndex    = ix
+          , pumValues   = v
+          , pumDistinct = d
+          }
+      _ -> error "Impossible: Only ValMds are stored in mtEntries"
+
+type InstrMdAttachments = Map.Map Int [(KindMd,PValMd)]
+
+type PKindMd = Int
+type PFnMdAttachments = Map.Map PKindMd PValMd
+type PGlobalAttachments = Map.Map Symbol (Map.Map KindMd PValMd)
+
+type ParsedMetadata =
+  ( Seq NamedMd
+  , (Seq PartialUnnamedMd, Seq PartialUnnamedMd)
+  , InstrMdAttachments
+  , PFnMdAttachments
+  , PGlobalAttachments
+  )
+
+parsedMetadata :: PartialMetadata -> ParsedMetadata
+parsedMetadata pm =
+  ( namedEntries pm
+  , unnamedEntries pm
+  , pmInstrAttachments pm
+  , pmFnAttachments pm
+  , pmGlobalAttachments pm
+  )
+
+-- Metadata Parsing ------------------------------------------------------------
+
+parseMetadataBlock ::
+  Int {- ^ globals seen so far -} ->
+  ValueTable -> [Entry] -> Parse ParsedMetadata
+parseMetadataBlock globals vt es = label "METADATA_BLOCK" $ do
+  ms <- getMdTable
+  let pm0 = emptyPartialMetadata globals ms
+  rec pm <- foldM (parseMetadataEntry vt (pmEntries pm)) pm0 es
+  let entries = pmEntries pm
+  setMdTable (mtEntries entries)
+  setMdRefs  (mkMdRefTable entries)
+  return (parsedMetadata pm)
+
+-- | Parse an entry in the metadata block.
+--
+-- XXX this currently relies on the constant block having been parsed already.
+-- Though most bitcode examples I've seen are ordered this way, it would be nice
+-- to not have to rely on it.
+--
+-- Based on the function 'parseOneMetadata' in the LLVM source.
+parseMetadataEntry :: ValueTable -> MetadataTable -> PartialMetadata -> Entry
+                   -> Parse PartialMetadata
+parseMetadataEntry vt mt pm (fromEntry -> Just r) =
+  let msg = [ "Are you sure you're using a supported version of LLVM/Clang?"
+            , "Check here: https://github.com/GaloisInc/llvm-pretty-bc-parser"
+            ]
+      assertRecordSizeBetween lb ub =
+        let len = length (recordFields r)
+        in when (len < lb || ub < len) $
+             fail $ unlines $ [ "Invalid record size: " ++ show len
+                              , "Expected size between " ++ show lb ++ " and " ++ show ub
+                              ] ++ msg
+      assertRecordSizeIn ns =
+        let len = length (recordFields r)
+        in when (not (len `elem` ns)) $
+             fail $ unlines $ [ "Invalid record size: " ++ show len
+                              , "Expected one of: " ++ show ns
+                              ] ++ msg
+
+      assertRecordSizeAtLeast lb =
+        let len = length (recordFields r)
+        in when (len < lb) $
+             fail $ unlines $ [ "Invalid record size: " ++ show len
+                              , "Expected size of " ++ show lb ++ " or greater"
+                              ] ++ msg
+
+      -- Helper for a common pattern which appears below in the parsing
+      ron n = do ctx <- getContext
+                 mdForwardRefOrNull ctx mt <$> parseField r n numeric
+
+  -- Note: the parsing cases below use a Monadic coding style, as opposed to an
+  -- Applicative style (as was originally used) for performance reasons:
+  -- Applicative record construction has quadratic size and corresponding
+  -- performance impacts (the initial conversion from Applicative to Monadic
+  -- saved 11s when parsing a 22MB bitcode file).
+  --
+  -- Additionally, this module uses RecordWildcards... a pragma that is not
+  -- normally advisable but which does work to good effect in this situation to
+  -- simplify the following and remove boilerplate intermediary assignments.
+
+  in case recordCode r of
+    -- [values]
+    1 -> label "METADATA_STRING" $ do
+      str <- fmap UTF8.decode (parseFields r 0 char) `mplus` parseField r 0 string
+      return $! addString str pm
+
+    -- [type num, value num]
+    2 -> label "METADATA_VALUE" $ do
+      assertRecordSizeIn [2]
+      let field = parseField r
+      ty  <- getType =<< field 0 numeric
+      when (ty == PrimType Metadata || ty == PrimType Void)
+          (fail "invalid record")
+
+      cxt <- getContext
+      ix  <- field 1 numeric
+      let tv = forwardRef cxt ix vt
+
+      return $! updateMetadataTable (addMdValue tv) pm
+
+
+    -- [n x md num]
+    3 -> label "METADATA_NODE" (parseMetadataNode False mt r pm)
+
+    -- [values]
+    4 -> label "METADATA_NAME" $ do
+      name <- fmap UTF8.decode (parseFields r 0 char) `mplus` parseField r 0 cstring
+      return $! setNextName name pm
+
+    -- [n x md num]
+    5 -> label "METADATA_DISTINCT_NODE" (parseMetadataNode True mt r pm)
+
+    -- [n x [id, name]]
+    6 -> label "METADATA_KIND" $ do
+      kind <- parseField r 0 numeric
+      name <- UTF8.decode <$> parseFields r 1 char
+      addKind kind name
+      return pm
+
+    -- [distinct, line, col, scope, inlined-at?]
+    7 -> label "METADATA_LOCATION" $ do
+      -- TODO: broken in 3.7+; needs to be a DILocation rather than an
+      -- MDLocation, but there appears to be no difference in the
+      -- bitcode. /sigh/
+      assertRecordSizeIn [5, 6]
+      let field = parseField r
+      cxt        <- getContext
+      isDistinct <- field 0 nonzero
+      dlLine <- field 1 numeric
+      dlCol <- field 2 numeric
+      dlScope <- mdForwardRef cxt mt <$> field 3 numeric
+      dlIA <- mdForwardRefOrNull cxt mt <$> field 4 numeric
+      dlImplicit <- if length (recordFields r) <= 5
+                    then pure False
+                    else parseField r 5 nonzero
+      let loc = DebugLoc {..}
+      return $! updateMetadataTable (addLoc isDistinct loc) pm
+
+
+    -- [n x (type num, value num)]
+    8 -> label "METADATA_OLD_NODE" (parseMetadataOldNode False vt mt r pm)
+
+    -- [n x (type num, value num)]
+    9 -> label "METADATA_OLD_FN_NODE" (parseMetadataOldNode True vt mt r pm)
+
+    -- [n x mdnodes]
+    10 -> label "METADATA_NAMED_NODE" $ do
+      mdIds <- parseFields r 0 numeric
+      cxt   <- getContext
+      let ids = map (mdNodeRef cxt mt) mdIds
+      nameMetadata ids pm
+
+    -- [m x [value, [n x [id, mdnode]]]
+    11 -> label "METADATA_ATTACHMENT" $ do
+      let recordSize = length (recordFields r)
+      when (recordSize == 0)
+        (fail "Invalid record")
+      if recordSize `mod` 2 == 0
+        then label "function attachment" $ do
+        att <- Map.fromList <$> parseAttachment r 0
+        return $! addFnAttachment att pm
+        else label "instruction attachment" $ do
+        inst <- parseField r 0 numeric
+        patt <- parseAttachment r 1
+        att <- mapM (\(k,md) -> (,md) <$> getKind k) patt
+        return $! addInstrAttachment inst att pm
+
+    12 -> label "METADATA_GENERIC_DEBUG" $ do
+      --isDistinct <- parseField r 0 numeric
+      --tag <- parseField r 1 numeric
+      --version <- parseField r 2 numeric
+      --header <- parseField r 3 string
+      -- TODO: parse all remaining fields
+      fail "not yet implemented"
+
+    13 -> label "METADATA_SUBRANGE" $ do
+      assertRecordSizeIn [3, 5]
+      field0 <- parseField r 0 unsigned
+      let isDistinct = field0 .&. 0 == 1
+      -- The format field determines what set of fields are contained in this
+      -- record and what their types are (see
+      -- https://github.com/llvm/llvm-project/blob/bbe8cd13/llvm/lib/Bitcode/Reader/MetadataLoader.cpp#L1437-L1444).
+      let format = field0 `shiftR` 1
+      let asValMdInt64 x = Just $ ValMdValue
+                           $ Typed { typedType = PrimType $ Integer 64
+                                   , typedValue = ValInteger x
+                                   }
+      diNode <- case format of
+        2 -> do disrCount <- ron 1
+                disrLowerBound <- ron 2
+                disrUpperBound <- ron 3
+                disrStride <- ron 4
+                return $ DISubrange {..}
+        1 -> do disrCount <- ron 1
+                disrLowerBound <- ron 2
+                let disrUpperBound = Nothing
+                let disrStride = Nothing
+                return $ DISubrange {..}
+        0 -> do disrCount <- asValMdInt64 <$> parseField r 1 numeric
+                disrLowerBound <- asValMdInt64 . fromIntegral <$> parseField r 2 signedInt64
+                let disrUpperBound = Nothing
+                let disrStride = Nothing
+                return $ DISubrange {..}
+        _ -> fail $ "Unknown format: " <> show format
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoSubrange diNode)) pm
+
+    -- [isBigInt|isUnsigned|distinct, value, name]
+    14 -> label "METADATA_ENUMERATOR" $ do
+      assertRecordSizeAtLeast 3
+      ctx   <- getContext
+      flags <- parseField r 0 numeric
+      let isDistinct = testBit (flags :: Int) 0
+          isUnsigned = testBit (flags :: Int) 1
+          isBigInt   = testBit (flags :: Int) 2
+      name  <- mdString ctx pm <$> parseField r 2 numeric
+      value <-
+        if isBigInt
+          -- LLVM 12 or later
+          then parseWideInteger r 3
+          -- Pre-LLVM 12
+          else toInteger <$> parseField r 1 signedInt64
+      let diEnum = DebugInfoEnumerator name value isUnsigned
+      return $! updateMetadataTable (addDebugInfo isDistinct diEnum) pm
+
+    15 -> label "METADATA_BASIC_TYPE" $ do
+      assertRecordSizeIn [6, 7]
+      ctx        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dibtTag <- parseField r 1 numeric
+      dibtName <- mdString ctx pm <$> parseField r 2 numeric
+      dibtSize <- parseField r 3 numeric
+      dibtAlign <- parseField r 4 numeric
+      dibtEncoding <- parseField r 5 numeric
+      dibtFlags <- if length (recordFields r) <= 6
+                   then pure Nothing
+                   else Just <$> parseField r 6 numeric
+      let dibt = DIBasicType {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoBasicType dibt)) pm
+
+    -- [distinct, filename, directory]
+    16 -> label "METADATA_FILE" $ do
+      assertRecordSizeIn [3, 5]
+      ctx        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      difFilename <- mdStringOrEmpty ctx pm <$> parseField r 1 numeric
+      difDirectory <- mdStringOrEmpty ctx pm <$> parseField r 2 numeric
+      let diFile = DIFile {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoFile diFile)) pm
+
+    17 -> label "METADATA_DERIVED_TYPE" $ do
+      -- While upstream LLVM currently imposes a maximum of 14 records per
+      -- entry, we raise this to 15 for the sake of parsing Apple LLVM.
+      -- See Note [Apple LLVM].
+      assertRecordSizeBetween 12 15
+      ctx        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      didtTag <- parseField r 1 numeric
+      didtName <- mdStringOrNull ctx pm <$> parseField r 2 numeric
+      didtFile <- ron 3
+      didtLine <- parseField r 4 numeric
+      didtScope <- ron 5
+      didtBaseType <- ron 6
+      didtSize <- parseField r 7 numeric
+      didtAlign <- parseField r 8 numeric
+      didtOffset <- parseField r 9 numeric
+      didtFlags <- parseField r 10 numeric
+      didtExtraData <- ron 11
+      didtDwarfAddressSpace <-
+        if length (recordFields r) <= 12
+        then pure Nothing  -- field not present
+        else do v <- parseField r 12 numeric
+                -- dwarf address space is encoded in bitcode as +1; a value of
+                -- zero means there is no dwarf address space present:
+                -- https://github.com/llvm/llvm-project/blob/bbe8cd1/llvm/lib/Bitcode/Reader/MetadataLoader.cpp#L1544-L1548
+                -- The AST representation is the actual address space, or Nothing
+                -- if there is no address space (indistinguishable from "field
+                -- not present" for LLVM 4 and earlier).
+                if v == 0
+                  then return Nothing
+                  else return $ Just $ v - 1
+      didtAnnotations <- if length (recordFields r) <= 13
+                         then pure Nothing
+                         else ron 13
+      let didt = DIDerivedType {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoDerivedType didt)) pm
+
+    18 -> label "METADATA_COMPOSITE_TYPE" $ do
+      assertRecordSizeBetween 16 22
+      ctx        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dictTag <- parseField r 1 numeric
+      dictName <- mdStringOrNull ctx pm <$> parseField r 2 numeric
+      dictFile <- ron 3
+      dictLine <- parseField r 4 numeric
+      dictScope <- ron 5
+      dictBaseType <- ron 6
+      dictSize <- parseField r 7 numeric
+      dictAlign <- parseField r 8 numeric
+      dictOffset <- parseField r 9 numeric
+      dictFlags <- parseField r 10 numeric
+      dictElements <- ron 11
+      dictRuntimeLang <- parseField r 12 numeric
+      dictVTableHolder <- ron 13
+      dictTemplateParams <- ron 14
+      dictIdentifier <- mdStringOrNull ctx pm <$> parseField r 15 numeric
+      dictDiscriminator <- if length (recordFields r) <= 16
+                           then pure Nothing
+                           else ron 16
+      dictDataLocation <- if length (recordFields r) <= 17
+                          then pure Nothing
+                          else ron 17
+      dictAssociated <- if length (recordFields r) <= 18
+                        then pure Nothing
+                        else ron 18
+      dictAllocated <- if length (recordFields r) <= 19
+                       then pure Nothing
+                       else ron 19
+      dictRank <- if length (recordFields r) <= 20
+                  then pure Nothing
+                  else ron 20
+      dictAnnotations <- if length (recordFields r) <= 21
+                         then pure Nothing
+                         else ron 21
+      let dict = DICompositeType {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoCompositeType dict)) pm
+
+    19 -> label "METADATA_SUBROUTINE_TYPE" $ do
+      assertRecordSizeBetween 3 4
+      isDistinct <- parseField r 0 nonzero
+      distFlags <- parseField r 1 numeric
+      distTypeArray <- ron 2
+      let dist = DISubroutineType {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoSubroutineType dist)) pm
+
+    20 -> label "METADATA_COMPILE_UNIT" $ do
+      assertRecordSizeBetween 14 22
+      let recordSize = length (recordFields r)
+      ctx        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dicuLanguage <- parseField r 1 numeric
+      dicuFile <- ron 2
+      dicuProducer <- mdStringOrNull ctx pm <$> parseField r 3 numeric
+      dicuIsOptimized <- parseField r 4 nonzero
+      dicuFlags <- mdStringOrNull ctx pm <$> parseField r 5 numeric
+      dicuRuntimeVersion <- parseField r 6 numeric
+      dicuSplitDebugFilename <- mdStringOrNull ctx pm <$> parseField r 7 numeric
+      dicuEmissionKind <- parseField r 8 numeric
+      dicuEnums <- ron 9
+      dicuRetainedTypes <- ron 10
+      dicuSubprograms <- ron 11
+      dicuGlobals <- ron 12
+      dicuImports <- ron 13
+      dicuMacros <- if recordSize <= 15
+                    then pure Nothing
+                    else ron 15
+      dicuDWOId <- if recordSize <= 14
+                   then pure 0
+                   else parseField r 14 numeric
+      dicuSplitDebugInlining <- if recordSize <= 16
+                                then pure True
+                                else parseField r 16 nonzero
+      dicuDebugInfoForProf <- if recordSize <= 17
+                              then pure False
+                              else parseField r 17 nonzero
+      dicuNameTableKind <- if recordSize <= 18
+                           then pure 0
+                           else parseField r 18 numeric
+      dicuRangesBaseAddress <- if recordSize <= 19
+                               then pure False
+                               else parseField r 19 nonzero
+      dicuSysRoot <- if recordSize <= 20
+                     then pure Nothing
+                     else mdStringOrNull ctx pm <$> parseField r 20 numeric
+      dicuSDK <- if recordSize <= 21
+                 then pure Nothing
+                 else mdStringOrNull ctx pm <$> parseField r 21 numeric
+      let dicu = DICompileUnit {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoCompileUnit dicu)) pm
+
+
+    21 -> label "METADATA_SUBPROGRAM" $ do
+      -- this one is a bit funky:
+      -- https://github.com/llvm/llvm-project/blob/release/10.x/llvm/lib/Bitcode/Reader/MetadataLoader.cpp#L1486
+
+      assertRecordSizeBetween 18 21
+
+      -- A "version" is encoded in the high-order bits of the isDistinct field.
+      version <- parseField r 0 numeric
+
+      let hasSPFlags = (version .&. (0x4 :: Word64)) /= 0;
+
+      (diFlags0, spFlags0) <-
+        if hasSPFlags then
+          (,) <$> parseField r 11 numeric <*> parseField r 9 numeric
+        else
+          (,) <$> parseField r (11 + 2) numeric <*> pure 0
+
+      let diFlagMainSubprogram = bit 21 :: Word32
+          hasOldMainSubprogramFlag = (diFlags0 .&. diFlagMainSubprogram) /= 0
+
+          -- CF https://github.com/llvm/llvm-project/blob/release/10.x/llvm/include/llvm/IR/DebugInfoFlags.def
+          spFlagIsLocal      = bit 2
+          spFlagIsDefinition = bit 3
+          spFlagIsOptimized  = bit 4
+          spFlagIsMain       = bit 8
+
+          dispFlags :: Word32
+          dispFlags
+            | hasOldMainSubprogramFlag = diFlags0 .&. complement diFlagMainSubprogram
+            | otherwise                = diFlags0
+
+          spFlags :: Word32
+          spFlags
+            | hasOldMainSubprogramFlag = spFlags0 .|. spFlagIsMain
+            | otherwise                = spFlags0
+
+      -- TODO, isMain isn't exposed via DISubprogram
+      (dispIsLocal, dispIsDefinition, dispIsOptimized, dispVirtuality, _isMain) <-
+        if hasSPFlags then
+          let spIsLocal       = spFlags .&. spFlagIsLocal /= 0
+              spIsDefinition  = spFlags .&. spFlagIsDefinition /= 0
+              spIsOptimized   = spFlags .&. spFlagIsOptimized /= 0
+              spIsMain        = spFlags .&. spFlagIsMain /= 0
+              spVirtuality :: Word8
+              spVirtuality    = fromIntegral (spFlags .&. 0x3)
+           in return (spIsLocal, spIsDefinition, spIsOptimized, spVirtuality, spIsMain)
+        else
+          do spIsLocal <- parseField r 7 nonzero
+             spIsDefinition <- parseField r 8 nonzero
+             spIsOptimized <- parseField r 14 nonzero
+             spVirtuality <- parseField r 11 numeric
+             return (spIsLocal, spIsDefinition, spIsOptimized, spVirtuality, hasOldMainSubprogramFlag)
+
+      let recordSize = length (recordFields r)
+
+          isDistinct = (version .&. 0x1 /= 0) || (spFlags .&. spFlagIsDefinition /= 0)
+
+          hasUnit = version .&. 0x2 /= 0
+
+          offsetA
+            | not hasSPFlags = 2
+            | otherwise      = 0
+
+          offsetB
+            | not hasSPFlags && recordSize >= 19 = 3
+            | not hasSPFlags                     = 2
+            | otherwise                          = 0
+
+          -- this doesn't seem to be used in our parser...
+          --hasFn
+          --  | not hasSPFlags && recordSize >= 19 = not hasUnit
+          --  | otherwise = False
+
+          hasThisAdjustment
+            | not hasSPFlags = recordSize >= 20
+            | otherwise      = True
+
+          hasThrownTypes
+            | not hasSPFlags = recordSize >= 21
+            | otherwise      = True
+
+          hasAnnotations
+            | not hasSPFlags = False
+            | otherwise      = recordSize >= 19
+
+      -- Some additional sanity checking
+      when (not hasSPFlags && hasUnit)
+           (assertRecordSizeBetween 19 21)
+
+      when (hasSPFlags && not hasUnit)
+           (fail "DISubprogram record has subprogram flags, but does not have unit.  Invalid record.")
+
+      ctx <- getContext
+
+      -- Forward references that depend on the 'version'
+      let optFwdRef b n =
+            if b
+            then mdForwardRefOrNull ctx mt <$> parseField r n numeric
+            else pure Nothing
+
+      dispScope <- ron 1
+      dispName <- mdStringOrNull ctx pm <$> parseField r 2 numeric
+      dispLinkageName <- mdStringOrNull ctx pm <$> parseField r 3 numeric
+      dispFile <- ron 4
+      dispLine <- parseField r 5 numeric
+      dispType <- ron 6
+      dispScopeLine <- parseField r (7 + offsetA) numeric
+      dispContainingType <- ron (8 + offsetA)
+      dispVirtualIndex <- parseField r (10 + offsetA) numeric
+      dispThisAdjustment <- if hasThisAdjustment
+                            then parseField r (16 + offsetB) numeric
+                            else return 0
+      dispUnit <- optFwdRef hasUnit (12 + offsetB)
+      dispTemplateParams <- ron (13 + offsetB)
+      dispDeclaration <- ron (14 + offsetB)
+      dispRetainedNodes <- ron (15 + offsetB)
+      dispThrownTypes <- optFwdRef hasThrownTypes (17 + offsetB)
+      dispAnnotations <- optFwdRef hasAnnotations (18 + offsetB)
+
+      let disp = DISubprogram {..}
+
+      -- TODO: in the LLVM parser, it then goes into the metadata table
+      -- and updates function entries to point to subprograms. Is that
+      -- neccessary for us?
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoSubprogram disp)) pm
+
+    22 -> label "METADATA_LEXICAL_BLOCK" $ do
+      assertRecordSizeIn [5]
+      isDistinct <- parseField r 0 nonzero
+      dilbScope <- ron 1
+      dilbFile <- ron 2
+      dilbLine <- parseField r 3 numeric
+      dilbColumn <- parseField r 4 numeric
+      let dilb = DILexicalBlock {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoLexicalBlock dilb)) pm
+
+    23 -> label "METADATA_LEXICAL_BLOCK_FILE" $ do
+      assertRecordSizeIn [4]
+      cxt        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dilbfScope <- mdForwardRef cxt mt <$> parseField r 1 numeric
+      dilbfFile <- ron 2
+      dilbfDiscriminator <- parseField r 3 numeric
+      let dilbf = DILexicalBlockFile {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoLexicalBlockFile dilbf)) pm
+
+    24 -> label "METADATA_NAMESPACE" $ do
+      assertRecordSizeIn [3, 5]
+      let isNew =
+            case length (recordFields r) of
+              3 -> True
+              5 -> False
+              _ -> error "Impossible (METADATA_NAMESPACE)" -- see assertion
+      let nameIdx = if isNew then 2 else 3
+
+      cxt        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dinsName <- mdStringOrNull cxt pm <$> parseField r nameIdx numeric
+      dinsScope <- mdForwardRef cxt mt <$> parseField r 1 numeric
+      dinsFile <- if isNew
+                  then return (ValMdString "")
+                  else mdForwardRef cxt mt <$> parseField r 2 numeric
+      dinsLine <- if isNew then return 0 else parseField r 4 numeric
+      let dins = DINameSpace {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoNameSpace dins)) pm
+
+    25 -> label "METADATA_TEMPLATE_TYPE" $ do
+      assertRecordSizeIn [3, 4]
+      let recordLength = length (recordFields r)
+      let hasIsDefault | recordLength == 3 = False
+                       | recordLength == 4 = True
+                       | otherwise = error "Impossible (METADATA_TEMPLATE_TYPE)" -- see assertion
+      cxt <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dittpName <- mdStringOrNull cxt pm <$> parseField r 1 numeric
+      dittpType <- ron 2
+      dittpIsDefault <- if hasIsDefault
+                        then Just <$> parseField r 3 boolean
+                        else pure Nothing
+      let dittp = DITemplateTypeParameter {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoTemplateTypeParameter dittp)) pm
+
+    26 -> label "METADATA_TEMPLATE_VALUE" $ do
+      assertRecordSizeIn [5, 6]
+      let recordLength = length (recordFields r)
+      let hasIsDefault | recordLength == 5 = False
+                       | recordLength == 6 = True
+                       | otherwise = error "Impossible (METADATA_TEMPLATE_TYPE)" -- see assertion
+      cxt        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      ditvpTag <- parseField r 1 numeric
+      ditvpName <- mdStringOrNull cxt pm <$> parseField r 2 numeric
+      ditvpType <- ron 3
+      ditvpIsDefault <- if hasIsDefault
+                        then Just <$> parseField r 4 boolean
+                        else pure Nothing
+      ditvpValue <- mdForwardRef cxt mt <$> parseField r (if hasIsDefault then 5 else 4) numeric
+      let ditvp = DITemplateValueParameter {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoTemplateValueParameter ditvp)) pm
+
+    27 -> label "METADATA_GLOBAL_VAR" $ do
+      assertRecordSizeBetween 11 13
+      ctx        <- getContext
+      field0     <- parseField r 0 numeric
+      let isDistinct = testBit field0 0
+          _version   = shiftR  field0 1 :: Int
+
+      digvScope <- ron 1
+      digvName <- mdStringOrNull ctx pm <$> parseField r 2 numeric
+      digvLinkageName <- mdStringOrNull ctx pm <$> parseField r 3 numeric
+      digvFile <- ron 4
+      digvLine <- parseField r 5 numeric
+      digvType <- ron 6
+      digvIsLocal <- parseField r 7 nonzero
+      digvIsDefinition <- parseField r 8 nonzero
+      digvVariable <- ron 9
+      digvDeclaration <- ron 10
+      digvAlignment <- if length (recordFields r) > 11
+                       then Just <$> parseField r 11 numeric
+                       else pure Nothing
+      digvAnnotations <- if length (recordFields r) > 12
+                         then ron 12
+                         else pure Nothing
+      let digv = DIGlobalVariable {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoGlobalVariable digv)) pm
+
+    28 -> label "METADATA_LOCAL_VAR" $ do
+      -- this one is a bit funky:
+      -- https://github.com/llvm-mirror/llvm/blob/release_38/lib/Bitcode/Reader/BitcodeReader.cpp#L2308
+      assertRecordSizeBetween 8 10
+      ctx    <- getContext
+      field0 <- parseField r 0 numeric
+      let isDistinct   = testBit (field0 :: Word32) 0
+          hasAlignment = testBit (field0 :: Word32) 1
+
+          hasTag | not hasAlignment && length (recordFields r) > 8 = 1
+                 | otherwise                                       = 0
+
+          adj i = i + hasTag
+
+
+      dilvScope <- mdForwardRefOrNull ("dilvScope":ctx) mt
+                   <$> parseField r (adj 1) numeric
+      dilvName <- mdStringOrNull     ("dilvName" :ctx) pm
+                  <$> parseField r (adj 2) numeric
+      dilvFile <- mdForwardRefOrNull ("dilvFile" :ctx) mt
+                  <$> parseField r (adj 3) numeric
+      dilvLine <- parseField r (adj 4) numeric
+      dilvType <- mdForwardRefOrNull ("dilvType" :ctx) mt
+                  <$> parseField r (adj 5) numeric
+      dilvArg <- parseField r (adj 6) numeric
+      dilvFlags <- parseField r (adj 7) numeric
+      dilvAlignment <-
+        if hasAlignment
+          then do n <- parseField r 8 numeric
+                  when ((n :: Word64) > fromIntegral (maxBound :: Word32))
+                        (fail "Alignment value is too large")
+                  return $ Just (fromIntegral n :: Word32)
+          else return Nothing
+      dilvAnnotations <- if hasAlignment && length (recordFields r) > 9
+                          then ron 9
+                          else pure Nothing
+      let dilv = DILocalVariable {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoLocalVariable dilv)) pm
+
+    29 -> label "METADATA_EXPRESSION" $ do
+      {-
+      Although DIExpressions store an `isDistinct` field in LLVM bitcode, it is
+      never used in practice. This is because DIExpressions are always printed
+      inline in definitions, and since the `distinct` keyword is only printed in
+      top-level metadata lists, there is no way for `distinct` to be printed
+      before a DIExpression. See also Note [Printing metadata inline].
+      -}
+      -- isDistinct <- parseField r 0 nonzero
+      diExpr     <- DebugInfoExpression . DIExpression <$> parseFields r 1 numeric
+      return $! updateMetadataTable (addInlineDebugInfo diExpr) pm
+
+    30 -> label "METADATA_OBJC_PROPERTY" $ do
+      -- TODO
+      fail "not yet implemented"
+
+    31 -> label "METADATA_IMPORTED_ENTITY" $ do
+      assertRecordSizeIn [6, 7]
+      cxt        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      diieTag <- parseField r 1 numeric
+      diieScope <- ron 2
+      diieEntity <- ron 3
+      diieFile <- if length (recordFields r) >= 7
+                  then ron 6
+                  else pure Nothing
+      diieLine <- parseField r 4 numeric
+      diieName <- mdStringOrNull cxt pm <$> parseField r 5 numeric
+      let diie = DIImportedEntity {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoImportedEntity diie)) pm
+
+    32 -> label "METADATA_MODULE" $ do
+      -- cxt <- getContext
+      -- isDistinct <- parseField r 0 numeric
+      -- mdForwardRefOrNull cxt mt <$> parseField r 1 numeric
+      -- parseField r 2 string
+      -- parseField r 3 string
+      -- parseField r 4 string
+      -- parseField r 5 string
+      -- TODO
+      fail "not yet implemented"
+    33 -> label "METADATA_MACRO" $ do
+      -- isDistinct <- parseField r 0 numeric
+      -- parseField r 1 numeric
+      -- parseField r 2 numeric
+      -- parseField r 3 string
+      -- parseField r 4 string
+      -- TODO
+      fail "not yet implemented"
+    34 -> label "METADATA_MACRO_FILE" $ do
+      -- cxt <- getContext
+      -- isDistinct <- parseField r 0 numeric
+      -- parseField r 1 numeric
+      -- parseField r 2 numeric
+      -- mdForwardRefOrNull cxt mt <$> parseField r 3 numeric
+      -- mdForwardRefOrNull cxt mt <$> parseField r 4 numeric
+      -- TODO
+      fail "not yet implemented"
+
+    35 -> label "METADATA_STRINGS" $ do
+      assertRecordSizeIn [3]
+      count  <- parseField r 0 numeric
+      offset <- parseField r 1 numeric
+      bs     <- parseField r 2 fieldBlob
+      when (count == 0)
+        (fail "Invalid record: metadata strings with no strings")
+      when (offset > S.length bs)
+        (fail "Invalid record: metadata strings corrupt offset")
+      let (bsLengths, bsStrings) = S.splitAt offset bs
+      lengths <- either fail return $ parseMetadataStringLengths count bsLengths
+      when (sum lengths > S.length bsStrings)
+        (fail "Invalid record: metadata strings truncated")
+      let strings = snd (mapAccumL f bsStrings lengths)
+            where f s i = case S.splitAt i s of
+                            (str, rest) -> (rest, Char8.unpack str)
+      return $! addStrings strings pm
+
+    -- [ valueid, n x [id, mdnode] ]
+    36 -> label "METADATA_GLOBAL_DECL_ATTACHMENT" $ do
+
+      -- the record will always be of odd length
+      when (mod (length (recordFields r)) 2 == 0)
+          (fail "Invalid record")
+
+      valueId <- parseField r 0 numeric
+      sym     <- case lookupValueTableAbs valueId vt of
+                  Just (Typed { typedValue = ValSymbol sym }) -> return sym
+                  _ -> fail "Non-global referenced"
+
+      refs <- parseGlobalObjectAttachment mt r
+
+      return $! addGlobalAttachments sym refs pm
+
+    37 -> label "METADATA_GLOBAL_VAR_EXPR" $ do
+      assertRecordSizeIn [3]
+      isDistinct <- parseField r 0 nonzero
+      digveVariable <- ron 1
+      digveExpression <- ron 2
+      let digve = DIGlobalVariableExpression {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoGlobalVariableExpression digve)) pm
+
+    38 -> label "METADATA_INDEX_OFFSET" $ do
+      assertRecordSizeIn [2]
+      a <- parseField r 0 numeric
+      b <- parseField r 1 numeric
+      let _offset = a + (b `shiftL` 32) :: Word64
+
+      -- TODO: is it OK to skip this if we always parse everything?
+      return pm
+
+
+    -- In the llvm source, this node is processed when the INDEX_OFFSET record is
+    -- found.
+    39 -> label "METADATA_INDEX" $ do
+      -- TODO: is it OK to skip this if we always parse everything?
+      return pm
+
+    40 -> label "METADATA_LABEL" $ do
+      assertRecordSizeIn [5]
+      cxt        <- getContext
+      isDistinct <- parseField r 0 nonzero
+      dilScope <- ron 1
+      dilName <- mdString cxt pm <$> parseField r 2 numeric
+      dilFile <- ron 3
+      dilLine <- parseField r 4 numeric
+      let dil = DILabel {..}
+      return $! updateMetadataTable
+        (addDebugInfo isDistinct (DebugInfoLabel dil)) pm
+
+    41 -> label "METADATA_STRING_TYPE" $ do
+      notImplemented
+
+    -- Codes 42 and 43 are reserved for Fortran array–specific debug info, see
+    -- https://github.com/llvm/llvm-project/blob/4681f6111e655057f5015564a9bf3705f87495bf/llvm/include/llvm/Bitcode/LLVMBitCodes.h#L348-L349
+
+    44 -> label "METADATA_COMMON_BLOCK" $ do
+      notImplemented
+
+    45 -> label "METADATA_GENERIC_SUBRANGE" $ do
+      notImplemented
+
+    46 -> label "METADATA_ARG_LIST" $ do
+      cxt <- getContext
+      dial <- DIArgList
+        <$> (map (mdForwardRef cxt mt) <$> parseFields r 0 numeric)
+      return $! updateMetadataTable
+        (addInlineDebugInfo (DebugInfoArgList dial)) pm
+
+
+    code -> fail ("unknown record code: " ++ show code)
+
+parseMetadataEntry _ _ pm (abbrevDef -> Just _) =
+  return pm
+
+parseMetadataEntry _ _ _ r =
+  fail ("unexpected metadata entry: " ++ show r)
+
+parseAttachment :: Record -> Int -> Parse [(PKindMd,PValMd)]
+parseAttachment r l = loop (length (recordFields r) - 1) []
+  where
+  loop n acc | n < l = return acc
+             | otherwise = do
+    kind <- parseField r (n - 1) numeric
+    md   <- getMetadata =<< parseField r n numeric
+    loop (n - 2) ((kind,typedValue md) : acc)
+
+
+-- | This is a named version of the metadata list that can show up at the end of
+-- a global declaration. It will be of the form @!dbg !2 [!dbg !n, ...]@.
+parseGlobalObjectAttachment :: MetadataTable -> Record -> Parse (Map.Map KindMd PValMd)
+parseGlobalObjectAttachment mt r = label "parseGlobalObjectAttachment" $
+  do cxt <- getContext
+     go cxt Map.empty 1
+  where
+  len = length (recordFields r)
+
+  go cxt acc n | n < len =
+    do kind <- getKind =<< parseField r n numeric
+       i    <- parseField r (n + 1) numeric
+       go cxt (Map.insert kind (mdForwardRef cxt mt i) acc) (n + 2)
+
+  go _ acc _ =
+       return acc
+
+
+-- | Parse a metadata node.
+parseMetadataNode :: Bool -> MetadataTable -> Record -> PartialMetadata
+                  -> Parse PartialMetadata
+parseMetadataNode isDistinct mt r pm = do
+  ixs <- parseFields r 0 numeric
+  cxt <- getContext
+  let lkp = mdForwardRefOrNull cxt mt
+  return $! updateMetadataTable (addNode isDistinct (map lkp ixs)) pm
+
+
+-- | Parse out a metadata node in the old format.
+parseMetadataOldNode :: Bool -> ValueTable -> MetadataTable -> Record
+                     -> PartialMetadata -> Parse PartialMetadata
+parseMetadataOldNode fnLocal vt mt r pm = do
+  values <- loop =<< parseFields r 0 numeric
+  return $! updateMetadataTable (addOldNode fnLocal values) pm
+  where
+  loop fs = case fs of
+
+    tyId:valId:rest -> do
+      cxt <- getContext
+      ty  <- getType' tyId
+      val <- case ty of
+        PrimType Metadata -> return $ Typed (PrimType Metadata)
+                                            (ValMd (mdForwardRef cxt mt valId))
+        -- XXX need to check for a void type here
+        _                 -> return (forwardRef cxt valId vt)
+
+      vals <- loop rest
+      return (val:vals)
+
+    [] -> return []
+
+    _ -> fail "Malformed metadata node"
+
+parseMetadataKindEntry :: Record -> Parse ()
+parseMetadataKindEntry r = do
+  kind <- parseField  r 0 numeric
+  name <- parseFields r 1 char
+  addKind kind (UTF8.decode name)
+
+{-
+Note [Apple LLVM]
+~~~~~~~~~~~~~~~~~
+Apple maintains a fork of LLVM, whose source code can be found at
+https://github.com/apple/llvm-project. The version of Clang that is shipped
+with Xcode, and thereby the de facto default Clang version on macOS, is based
+on this LLVM fork. To distinguish between the two LLVM codebases, we will refer
+to "upstream LLVM" and "Apple LLVM" throughout this Note.
+
+One of the more noticeable differences between upstream and Apple LLVM is that
+Apple LLVM uses a slightly different bitcode format. In particular, Apple LLVM
+has support for pointer authentication
+(https://lists.llvm.org/pipermail/llvm-dev/2019-October/136091.html), which
+requires adding an extra record to the METADATA_DERIVED_TYPE entry that is not
+present in upstream LLVM. This impacts llvm-pretty-bc-parser, as we currently
+check that the number of records does not exceed a certain maximum, but this
+maximum is different depending on whether we parse upstream or Apple LLVM
+bitcode.
+
+For now, we work around this issue by raising the maximum number of
+METADATA_DERIVED_TYPE records by one to accommodate Apple LLVM, but we do not
+actually parse any information related to pointer authentication. This should
+work provided that Apple LLVM continues to encode pointer authentication–related
+metadata in the same part of METADATA_DERIVED_TYPE in future releases. If this
+assumption does not hold true in the future, we will likely need a more
+sophisticated solution that involves parsing the bitcode differently depending
+on what Apple LLVM version was used to produce a bitcode file.
+
+Note [Printing metadata inline]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+There are some forms of metadata that we should always print inline and never
+create entries for in top-level metadata lists (named or otherwise). Currently,
+these forms of metadata are:
+
+* DIExpression
+* DIArgList
+
+This list is taken from the LLVM source code here:
+https://github.com/llvm/llvm-project/blob/65600cb2a7e940babf6c493503b9d3fd19f8cb06/llvm/lib/IR/AsmWriter.cpp#L1242-L1245
+
+Implementation-wise, this is accomplished by using `addInlineDebugInfo`. Unlike
+`addDebugInfo`, this inserts the metadata field into a separate `mtEntries` map
+that is not used to populate top-level metadata lists when pretty-printing an
+LLVM module.
+-}
diff --git a/src/Data/LLVM/BitCode/IR/Module.hs b/src/Data/LLVM/BitCode/IR/Module.hs
--- a/src/Data/LLVM/BitCode/IR/Module.hs
+++ b/src/Data/LLVM/BitCode/IR/Module.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE ViewPatterns #-}
 
 module Data.LLVM.BitCode.IR.Module where
@@ -15,14 +16,16 @@
 import Data.LLVM.BitCode.Parse
 import Data.LLVM.BitCode.Record
 import Text.LLVM.AST
+import Text.LLVM.Triple.AST (TargetTriple)
+import Text.LLVM.Triple.Parse (parseTriple)
 
+import qualified Codec.Binary.UTF8.String as UTF8 (decode)
 import Control.Monad (foldM,guard,when,forM_)
-import Data.List (sortBy)
-import Data.Monoid (mempty)
-import Data.Ord (comparing)
+import Data.List (sortOn)
 import qualified Data.Foldable as F
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
+import Data.Sequence (Seq)
 import qualified Data.Traversable as T
 
 
@@ -33,13 +36,15 @@
   , partialGlobals    :: GlobalList
   , partialDefines    :: DefineList
   , partialDeclares   :: DeclareList
+  , partialTriple     :: TargetTriple
   , partialDataLayout :: DataLayout
   , partialInlineAsm  :: InlineAsm
+  , partialComdat     :: !(Seq (String,SelectionKind))
   , partialAliasIx    :: !Int
   , partialAliases    :: AliasList
-  , partialNamedMd    :: [NamedMd]
-  , partialUnnamedMd  :: [PartialUnnamedMd]
-  , partialSections   :: Seq.Seq String
+  , partialNamedMd    :: !(Seq NamedMd)
+  , partialUnnamedMd  :: !(Seq PartialUnnamedMd)
+  , partialSections   :: !(Seq String)
   , partialSourceName :: !(Maybe String)
   }
 
@@ -49,6 +54,7 @@
   , partialGlobals    = mempty
   , partialDefines    = mempty
   , partialDeclares   = mempty
+  , partialTriple     = mempty
   , partialDataLayout = mempty
   , partialInlineAsm  = mempty
   , partialAliasIx    = 0
@@ -57,29 +63,33 @@
   , partialUnnamedMd  = mempty
   , partialSections   = mempty
   , partialSourceName = mempty
+  , partialComdat     = mempty
   }
 
 -- | Fixup the global variables and declarations, and return the completed
 -- module.
 finalizeModule :: PartialModule -> Parse Module
-finalizeModule pm = do
+finalizeModule pm = label "finalizeModule" $ do
   globals  <- T.mapM finalizeGlobal       (partialGlobals pm)
   declares <- T.mapM finalizeDeclare      (partialDeclares pm)
   aliases  <- T.mapM finalizePartialAlias (partialAliases pm)
-  unnamed  <- T.mapM finalizePartialUnnamedMd (partialUnnamedMd pm)
+  unnamed  <- liftFinalize $ T.mapM finalizePartialUnnamedMd (dedupMetadata (partialUnnamedMd pm))
   types    <- resolveTypeDecls
   let lkp = lookupBlockName (partialDefines pm)
   defines <- T.mapM (finalizePartialDefine lkp) (partialDefines pm)
   return emptyModule
-    { modDataLayout = partialDataLayout pm
-    , modNamedMd    = partialNamedMd pm
-    , modUnnamedMd  = sortBy (comparing umIndex) unnamed
+    { modSourceName = partialSourceName pm
+    , modTriple     = partialTriple pm
+    , modDataLayout = partialDataLayout pm
+    , modNamedMd    = F.toList (partialNamedMd pm)
+    , modUnnamedMd  = sortOn umIndex (F.toList unnamed)
     , modGlobals    = F.toList globals
     , modDefines    = F.toList defines
     , modTypes      = types
     , modDeclares   = F.toList declares
     , modInlineAsm  = partialInlineAsm pm
     , modAliases    = F.toList aliases
+    , modComdat     = Map.fromList (F.toList (partialComdat pm))
     }
 
 -- | Parse an LLVM Module out of the top-level block in a Bitstream.
@@ -94,7 +104,7 @@
       Just es -> parseTypeBlock es
       Nothing -> return mempty
 
-  withTypeSymtab tsymtab $ do
+  withTypeSymtab tsymtab $ label "value symbol table" $ do
     -- parse the value symbol table out first, if there is one
     symtab <- do
       mb <- match (findMatch valueSymtabBlockId) ents
@@ -129,13 +139,12 @@
   -- MODULE_CODE_FUNCTION
   parseFunProto r pm
 
-parseModuleBlockEntry pm (functionBlockId -> Just es) = do
-  -- FUNCTION_BLOCK_ID
+parseModuleBlockEntry pm (functionBlockId -> Just es) = label "FUNCTION_BLOCK_ID" $ do
   let unnamedGlobalsCount = length (partialUnnamedMd pm)
   def <- parseFunctionBlock unnamedGlobalsCount es
-  let def' = def { partialGlobalMd = [] }
+  let def' = def { partialGlobalMd = mempty }
   return pm { partialDefines = partialDefines pm Seq.|> def'
-            , partialUnnamedMd = partialGlobalMd def ++ partialUnnamedMd pm
+            , partialUnnamedMd = partialGlobalMd def <> partialUnnamedMd pm
             }
 
 parseModuleBlockEntry pm (paramattrBlockId -> Just _) = do
@@ -148,34 +157,36 @@
   -- TODO: skip for now
   return pm
 
-parseModuleBlockEntry pm (metadataBlockId -> Just es) = do
-  -- METADATA_BLOCK_ID
+parseModuleBlockEntry pm (metadataBlockId -> Just es) = label "METADATA_BLOCK_ID" $ do
   vt <- getValueTable
   let globalsSoFar = length (partialUnnamedMd pm)
   (ns,(gs,_),_,_,atts) <- parseMetadataBlock globalsSoFar vt es
   return $ addGlobalAttachments atts pm
-    { partialNamedMd   = partialNamedMd   pm ++ ns
-    , partialUnnamedMd = partialUnnamedMd pm ++ gs
+    { partialNamedMd   = partialNamedMd   pm <> ns
+    , partialUnnamedMd = partialUnnamedMd pm <> gs
     }
 
-parseModuleBlockEntry pm (valueSymtabBlockId -> Just _) = do
+parseModuleBlockEntry pm (valueSymtabBlockId -> Just _es) = do
   -- VALUE_SYMTAB_BLOCK_ID
+  -- NOTE: we parse the value symbol table eagerly at the beginning of the
+  -- MODULE_BLOCK
   return pm
 
-parseModuleBlockEntry pm (moduleCodeTriple -> Just _) = do
+parseModuleBlockEntry pm (moduleCodeTriple -> Just r) = do
   -- MODULE_CODE_TRIPLE
-  return pm
+  triple <- UTF8.decode <$> parseFields r 0 char
+  return (pm { partialTriple = parseTriple triple })
 
 parseModuleBlockEntry pm (moduleCodeDatalayout -> Just r) = do
   -- MODULE_CODE_DATALAYOUT
-  layout <- parseFields r 0 char
+  layout <- UTF8.decode <$> parseFields r 0 char
   case parseDataLayout layout of
     Nothing -> fail ("unable to parse data layout: ``" ++ layout ++ "''")
     Just dl -> return (pm { partialDataLayout = dl })
 
 parseModuleBlockEntry pm (moduleCodeAsm -> Just r) = do
   -- MODULE_CODE_ASM
-  asm <- parseFields r 0 char
+  asm <- UTF8.decode <$> parseFields r 0 char
   return pm { partialInlineAsm = lines asm }
 
 parseModuleBlockEntry pm (abbrevDef -> Just _) = do
@@ -190,9 +201,8 @@
     , partialGlobals  = partialGlobals pm Seq.|> pg
     }
 
-parseModuleBlockEntry pm (moduleCodeAlias -> Just r) = do
-  -- MODULE_CODE_ALIAS_OLD
-  pa <- parseAlias (partialAliasIx pm) r
+parseModuleBlockEntry pm (moduleCodeAlias -> Just r) = label "MODULE_CODE_ALIAS_OLD" $ do
+  pa <- parseAliasOld (partialAliasIx pm) r
   return pm
     { partialAliasIx = succ (partialAliasIx pm)
     , partialAliases = partialAliases pm Seq.|> pa
@@ -204,29 +214,38 @@
   -- please see:
   -- http://llvm.org/docs/BitCodeFormat.html#module-code-version-record
   version <- parseField r 0 numeric
+  setModVersion version
   case version :: Int of
     0 -> setRelIds False  -- Absolute value ids in LLVM <= 3.2
     1 -> setRelIds True   -- Relative value ids in LLVM >= 3.3
+    2 -> setRelIds True   -- Relative value ids in LLVM >= 5.0
     _ -> fail ("unsupported version id: " ++ show version)
 
   return pm
 
 parseModuleBlockEntry pm (moduleCodeSectionname -> Just r) = do
-  name <- parseFields r 0 char
+  name <- UTF8.decode <$> parseFields r 0 char
   return pm { partialSections = partialSections pm Seq.|> name }
 
-parseModuleBlockEntry _ (moduleCodeComdat -> Just _) = do
+parseModuleBlockEntry pm (moduleCodeComdat -> Just r) = do
   -- MODULE_CODE_COMDAT
-  fail "MODULE_CODE_COMDAT"
+  when (length (recordFields r) < 2) (fail "Invalid record (MODULE_CODE_COMDAT)")
+  -- This was last updated in 0fc96d5, but the implementation appeared a bit
+  -- buggy for clang++ 3.8. Since no known downstream consumer uses it, it was
+  -- removed.
+  return pm
 
 parseModuleBlockEntry pm (moduleCodeVSTOffset -> Just _) = do
   -- MODULE_CODE_VSTOFFSET
   -- TODO: should we handle this?
   return pm
 
-parseModuleBlockEntry _ (moduleCodeAliasNew -> Just _) = do
-  -- MODULE_CODE_ALIAS
-  fail "MODULE_CODE_ALIAS"
+parseModuleBlockEntry pm (moduleCodeAliasNew -> Just r) = label "MODULE_CODE_ALIAS" $ do
+  pa <- parseAlias r
+  return pm
+    { partialAliasIx = succ (partialAliasIx pm)
+    , partialAliases = partialAliases pm Seq.|> pa
+    }
 
 parseModuleBlockEntry pm (moduleCodeMDValsUnused -> Just _) = do
   -- MODULE_CODE_METADATA_VALUES_UNUSED
@@ -237,46 +256,69 @@
   do str <- parseField r 0 cstring
      return pm { partialSourceName = Just str }
 
-parseModuleBlockEntry _ (moduleCodeHash -> Just _) = do
+parseModuleBlockEntry pm (moduleCodeHash -> Just _) = do
   -- MODULE_CODE_HASH
-  fail "MODULE_CODE_HASH"
+  -- It should be safe to ignore this for now.
+  --fail "MODULE_CODE_HASH"
+  return pm
 
 parseModuleBlockEntry _ (moduleCodeIFunc -> Just _) = do
   -- MODULE_CODE_IFUNC
   fail "MODULE_CODE_IFUNC"
 
-parseModuleBlockEntry _ (uselistBlockId -> Just _) = do
+parseModuleBlockEntry pm (uselistBlockId -> Just _) = do
   -- USELIST_BLOCK_ID
-  fail "USELIST_BLOCK_ID"
+  -- XXX ?? fail "USELIST_BLOCK_ID"
+  return pm
 
 parseModuleBlockEntry _ (moduleStrtabBlockId -> Just _) = do
   -- MODULE_STRTAB_BLOCK_ID
   fail "MODULE_STRTAB_BLOCK_ID"
 
-parseModuleBlockEntry _ (globalvalSummaryBlockId -> Just _) = do
+parseModuleBlockEntry pm (globalvalSummaryBlockId -> Just _) = do
   -- GLOBALVAL_SUMMARY_BLOCK_ID
-  fail "GLOBALVAL_SUMMARY_BLOCK_ID"
+  -- It should be safe to ignore this for now.
+  return pm
 
 parseModuleBlockEntry pm (operandBundleTagsBlockId -> Just _) = do
   -- OPERAND_BUNDLE_TAGS_BLOCK_ID
   -- fail "OPERAND_BUNDLE_TAGS_BLOCK_ID"
   return pm
 
-parseModuleBlockEntry pm (metadataKindBlockId -> Just es) = do
-  -- METADATA_KIND_BLOCK_ID
+parseModuleBlockEntry pm (metadataKindBlockId -> Just es) = label "METADATA_KIND_BLOCK_ID" $ do
   forM_ es $ \e ->
     case fromEntry e of
       Just r -> parseMetadataKindEntry r
       Nothing -> fail "Can't parse metadata kind block entry."
   return pm
 
-parseModuleBlockEntry _ e =
-  fail ("unexpected: " ++ show e)
+parseModuleBlockEntry pm (strtabBlockId -> Just _) =
+  -- Handled already.
+  return pm
 
+parseModuleBlockEntry pm (ltoSummaryBlockId -> Just _) =
+  -- It should be safe to ignore this for now.
+  --label "FULL_LTO_GLOBALVAL_SUMMARY_BLOCK_ID" $ do
+  --  fail "FULL_LTO_GLOBALVAL_SUMMARY_BLOCK_ID unsupported"
+  return pm
 
+parseModuleBlockEntry pm (symtabBlockId -> Just [symtabBlobId -> Just _]) =
+  -- Handled already
+  return pm
+
+parseModuleBlockEntry pm (syncScopeNamesBlockId -> Just _) =
+  label "SYNC_SCOPE_NAMES_BLOCK_ID" $ do
+    -- TODO: record this information somewhere
+    return pm
+
+parseModuleBlockEntry _ e =
+  fail ("unexpected module block entry: " ++ show e)
+
 parseFunProto :: Record -> PartialModule -> Parse PartialModule
 parseFunProto r pm = label "FUNCTION" $ do
-  let field = parseField r
+  ix   <- nextValueId
+  (name, offset) <- oldOrStrtabName ix r
+  let field i = parseField r (i + offset)
   funTy   <- getType =<< field 0 numeric
   let ty = case funTy of
              PtrTo _  -> funTy
@@ -286,23 +328,29 @@
 
   link    <-             field 3 linkage
 
+  vis     <-             field 7 visibility
+
   section <-
     if length (recordFields r) >= 6
-       then do ix <- field 6 numeric
-               if ix == 0
+       then do sid <- field 6 numeric
+               if sid == 0
                   then return Nothing
-                  else do let ix' = ix - 1
-                          when (ix' >= Seq.length (partialSections pm))
+                  else do let sid' = sid - 1
+                          when (sid' >= length (partialSections pm))
                               (fail "invalid section name index")
-                          return (Just (Seq.index (partialSections pm) (ix - 1)))
+                          return (Just (Seq.index (partialSections pm) sid'))
 
        else return Nothing
 
   -- push the function type
-  ix   <- nextValueId
-  name <- entryName ix
-  _    <- pushValue (Typed ty (ValSymbol (Symbol name)))
-
+  _    <- pushValue (Typed ty (ValSymbol name))
+  let lkMb t x
+       | length t > x = Just (Seq.index t x)
+       | otherwise        = Nothing
+  comdat <- if length (recordFields r) >= 12
+               then do comdatID <- field 12 numeric
+                       pure (fst <$> partialComdat pm `lkMb` comdatID)
+               else pure Nothing
   let proto = FunProto
         { protoType  = ty
         , protoLinkage =
@@ -310,10 +358,12 @@
              -- llvm-dis when linkage is External
              guard (link /= External)
              return link
+        , protoVisibility = Just vis
         , protoGC    = Nothing
-        , protoName  = name
+        , protoSym   = name
         , protoIndex = ix
         , protoSect  = section
+        , protoComdat = comdat
         }
 
   if isProto == (0 :: Int)
diff --git a/src/Data/LLVM/BitCode/IR/Types.hs b/src/Data/LLVM/BitCode/IR/Types.hs
--- a/src/Data/LLVM/BitCode/IR/Types.hs
+++ b/src/Data/LLVM/BitCode/IR/Types.hs
@@ -5,18 +5,19 @@
   , parseTypeBlock
   ) where
 
-import Data.LLVM.BitCode.Bitstream
-import Data.LLVM.BitCode.Match
-import Data.LLVM.BitCode.Parse
-import Data.LLVM.BitCode.Record
-import Text.LLVM.AST
+import qualified Data.LLVM.BitCode.Assert as Assert
+import           Data.LLVM.BitCode.Bitstream
+import           Data.LLVM.BitCode.Match
+import           Data.LLVM.BitCode.Parse
+import           Data.LLVM.BitCode.Record
+import           Text.LLVM.AST
 
-import Control.Monad (when,unless,mplus,(<=<))
-import Data.List (sortBy)
-import Data.Maybe (catMaybes)
-import Data.Monoid (mempty)
-import Data.Ord (comparing)
-import qualified Data.Map as Map
+import qualified Codec.Binary.UTF8.String as UTF8 (decode)
+import           Control.Monad (when,unless,mplus,(<=<))
+import qualified Data.IntMap as IntMap
+import           Data.List (sortBy)
+import           Data.Maybe (catMaybes)
+import           Data.Ord (comparing)
 
 
 -- Type Block ------------------------------------------------------------------
@@ -28,7 +29,7 @@
 resolveTypeDecls :: Parse [TypeDecl]
 resolveTypeDecls  = do
   symtab <- getTypeSymtab
-  decls  <- mapM mkTypeDecl (Map.toList (tsById symtab))
+  decls  <- mapM mkTypeDecl (IntMap.toList (tsById symtab))
   return (sortBy (comparing typeName) decls)
   where
   mkTypeDecl (ix,alias) = do
@@ -75,8 +76,8 @@
   -- recursively resolve the type table, if they don't already exist in the
   -- symbol table.  if the index entry doesn't exist, throw an error, as that
   -- should be impossible.
-  tt = Map.fromList [ (ix,updateAliases resolve ty) | (ix,(ty,_)) <- ixs ]
-  resolve ix = case Map.lookup ix (tsById sym) of
+  tt = IntMap.fromList [ (ix, updateAliases resolve ty) | (ix, (ty, _)) <- ixs ]
+  resolve ix = case IntMap.lookup ix (tsById sym) of
     Nothing    -> lookupTypeRef cxt ix tt
     Just ident -> Alias ident
 
@@ -116,6 +117,7 @@
     let field = parseField r
     ty <- field 0 typeRef
     when (length (recordFields r) == 2) $ do
+      -- We do not currently store address spaces in the @llvm-pretty@ AST.
       _space <- field 1 keep
       return ()
     addType (PtrTo ty)
@@ -129,7 +131,7 @@
       rty:ptys -> addType (FunTy rty ptys va)
       _        -> fail "function expects a return type"
 
-  10 -> label "TYPE_CODE_X86_FP80" (addType (PrimType (FloatType Half)))
+  10 -> label "TYPE_CODE_FP_HALF" (addType (PrimType (FloatType Half)))
 
   11 -> label "TYPE_CODE_ARRAY" $ do
     let field = parseField r
@@ -164,7 +166,7 @@
 
   19 -> label "TYPE_CODE_STRUCT_NAME" $ do
     name <- label "struct name" $ parseField r 0 cstring
-        `mplus` parseFields r 0 char
+        `mplus` fmap UTF8.decode (parseFields r 0 char)
     setTypeName name
     noType
 
@@ -188,7 +190,27 @@
       rty:ptys -> addType (FunTy rty ptys vararg)
       []       -> fail "function expects a return type"
 
-  code -> fail ("unknown type code " ++ show code)
+  22 -> label "TYPE_CODE_TOKEN" $ do
+    notImplemented
+
+  23 -> label "TYPE_CODE_BFLOAT" $ do
+    notImplemented
+
+  24 -> label "TYPE_CODE_X86_AMX" $ do
+    notImplemented
+
+  25 -> label "TYPE_CODE_OPAQUE_POINTER" $ do
+    let field = parseField r
+    when (length (recordFields r) /= 1) $
+      fail "Invalid opaque pointer record"
+    -- We do not currently store address spaces in the @llvm-pretty@ AST.
+    _space <- field 0 keep
+    addType PtrOpaque
+
+  26 -> label "TYPE_CODE_TARGET_TYPE" $ do
+    notImplemented
+
+  code -> Assert.unknownEntity "type code " code
 
 -- skip blocks
 parseTypeBlockEntry (block -> Just _) =
diff --git a/src/Data/LLVM/BitCode/IR/Values.hs b/src/Data/LLVM/BitCode/IR/Values.hs
--- a/src/Data/LLVM/BitCode/IR/Values.hs
+++ b/src/Data/LLVM/BitCode/IR/Values.hs
@@ -2,14 +2,11 @@
 
 module Data.LLVM.BitCode.IR.Values (
     getValueTypePair
-  , getConstantFwdRef
   , getValue
-  , getFnValueById
+  , getFnValueById, getFnValueById'
   , parseValueSymbolTableBlock
   ) where
 
-import Data.Word
-
 import Data.LLVM.BitCode.Bitstream
 import Data.LLVM.BitCode.Match
 import Data.LLVM.BitCode.Parse
@@ -17,79 +14,70 @@
 import Text.LLVM.AST
 
 import Control.Monad ((<=<),foldM)
-import qualified Data.Map as Map
 
 
 -- Value Table -----------------------------------------------------------------
 
-getConstantFwdRef :: ValueTable -> Type -> Int -> Parse (Typed PValue)
-getConstantFwdRef t ty n = label "getConstantFwdRef" $ do
-  mb <- lookupValue n
-  case mb of
-    Just tv -> return tv
-
-    -- forward reference
-    Nothing -> do
-      cxt <- getContext
-      let ref = forwardRef cxt n t
-      return (Typed ty (typedValue ref))
-
 -- | Get either a value from the value table, with its value, or parse a value
 -- and a type.
 getValueTypePair :: ValueTable -> Record -> Int -> Parse (Typed PValue, Int)
 getValueTypePair t r ix = do
   let field = parseField r
-  n  <- field ix numeric
-  mb <- lookupValue n
+  n  <- adjustId =<< field ix numeric
+  mb <- lookupValueAbs n
   case mb of
-    -- value
+
+    -- value is already present in the incremental table
     Just tv -> return (tv, ix+1)
 
-    -- forward reference
+    -- forward reference to the entry in the final table
     Nothing -> do
       ty  <- getType =<< field (ix+1) numeric
-      n'  <- adjustId n
       cxt <- getContext
-      let ref = forwardRef cxt n' t
+      let ref = forwardRef cxt n t
 
       -- generate the forward reference to the value only, as we already know
       -- what the type should be.
       return (Typed ty (typedValue ref), ix+2)
 
 -- | Get a single value from the value table.
-getValue :: Type -> Int -> Parse (Typed PValue)
-getValue ty n = label "getValue" $ do
+--getValueNoFwdRef :: Type -> Int -> Parse (Typed PValue)
+--getValueNoFwdRef ty n = label "getValueNoFwdRef" (getFnValueById ty =<< adjustId n)
 
-  useRelIds <- getRelIds
-  cur       <- getNextId
-  -- The relative conversion has to be done on a Word32 to handle overflow
-  -- when n is large the same way BitcodeReaderMDValueList::getValue does.
-  let i :: Word32
-      i | useRelIds = fromIntegral cur - fromIntegral n
-        | otherwise = fromIntegral n
-  getFnValueById ty i
+getFnValueById :: Type -> Int -> Parse (Typed PValue)
+getFnValueById  = getFnValueById' Nothing
 
+getValue :: ValueTable -> Type -> Int -> Parse (Typed PValue)
+getValue vt ty n = label "getValue" (getFnValueById' (Just vt) ty =<< adjustId n)
+
 -- | Lookup a value by its absolute id, or perhaps some metadata.
-getFnValueById :: Type -> Word32 -> Parse (Typed PValue)
-getFnValueById ty n = label "getFnValueById" $ case ty of
+getFnValueById' :: Maybe ValueTable -> Type -> Int -> Parse (Typed PValue)
+getFnValueById' mbVt ty n = label "getFnValueById'" $ case ty of
 
   PrimType Metadata -> do
     cxt <- getContext
     md  <- getMdTable
-    return (forwardRef cxt (fromIntegral n) md)
+    return (forwardRef cxt n md)
 
   _ -> do
-    mb <- lookupValueAbs (fromIntegral n)
+    mb <- lookupValueAbs n
     case mb of
 
       Just tv -> return tv
 
       -- forward reference
       Nothing -> do
-        name <- entryName (fromIntegral n)
-        return (Typed ty (ValIdent (Ident name)))
+        mbName <- entryNameMb n
+        case mbName of
+          Just name -> return (Typed ty (ValIdent (Ident name)))
 
+          Nothing
+            | Just vt <- mbVt ->
+              do cxt <- getContext
+                 return (forwardRef cxt n vt)
 
+            | otherwise ->
+              fail "Unable to create forward reference"
 
 -- Value Symbol Table Entries --------------------------------------------------
 
@@ -105,22 +93,24 @@
 -- Value Symbol Table Parsing --------------------------------------------------
 
 parseValueSymbolTableBlock :: [Entry] -> Parse ValueSymtab
-parseValueSymbolTableBlock  = foldM parseValueSymbolTableBlockEntry Map.empty
+parseValueSymbolTableBlock  = foldM parseValueSymbolTableBlockEntry mempty
 
 parseValueSymbolTableBlockEntry :: ValueSymtab -> Entry -> Parse ValueSymtab
 
 parseValueSymbolTableBlockEntry vs (vstCodeEntry -> Just r) = do
   -- VST_ENTRY: [valid, namechar x N]
+  -- TODO: fail if version >= 2? These aren't supposed to be around anymore.
   let field = parseField r
   valid <- field 0 numeric
-  name  <- field 1 (fieldArray (fieldChar6 ||| char))
+  name  <- field 1 cstring
   return (addEntry valid name vs)
 
 parseValueSymbolTableBlockEntry vs (vstCodeBBEntry -> Just r) = do
   -- VST_BBENTRY: [bbid, namechar x N]
+  -- TODO: fail if version >= 2? These aren't supposed to be around anymore.
   let field = parseField r
   bbid <- field 0 numeric
-  name <- field 1 (fieldArray (fieldChar6 ||| char))
+  name <- field 1 cstring
   return (addBBEntry bbid name vs)
 
 parseValueSymbolTableBlockEntry vs (vstCodeFNEntry -> Just r) = do
@@ -128,8 +118,12 @@
   let field = parseField r
   valid  <- field 0 numeric
   offset <- field 1 numeric
-  name   <- field 2 (fieldArray (fieldChar6 ||| char))
-  return (addFNEntry valid offset name vs)
+  case length (recordFields r) of
+    2 -> return (addFwdFNEntry valid offset vs)
+    3 -> do
+      name <- field 2 cstring
+      return (addFNEntry valid offset name vs)
+    _ -> fail "unexpected number of parameters to FNENTRY"
 
 parseValueSymbolTableBlockEntry vs (abbrevDef -> Just _) =
   -- skip abbreviation definitions, they're already resolved
diff --git a/src/Data/LLVM/BitCode/Parse.hs b/src/Data/LLVM/BitCode/Parse.hs
--- a/src/Data/LLVM/BitCode/Parse.hs
+++ b/src/Data/LLVM/BitCode/Parse.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE CPP #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
@@ -8,27 +9,41 @@
 
 module Data.LLVM.BitCode.Parse where
 
-import Text.LLVM.AST
-import Text.LLVM.PP
+import           Text.LLVM.AST
+import           Text.LLVM.PP
 
-import Control.Applicative (Applicative(..),Alternative(..),(<$>))
-import Control.Monad.Fix (MonadFix)
-import Data.Maybe (fromMaybe)
-import Data.Monoid (Monoid(..))
-import Data.Typeable (Typeable)
-import Data.Word ( Word32 )
-import MonadLib
+import           Control.Applicative (Alternative(..))
+import           Control.Monad (MonadPlus(..), unless)
+#if !MIN_VERSION_base(4,13,0)
+import           Control.Monad.Fail (MonadFail)
+import qualified Control.Monad.Fail -- makes fail visible for instance
+#endif
+import           Control.Monad.Fix (MonadFix)
+import           Control.Monad.Except (MonadError(..), Except, runExcept)
+import           Control.Monad.Reader (MonadReader(..), ReaderT(..))
+import           Control.Monad.State.Strict (MonadState(..), StateT(..))
+import           Data.Maybe (fromMaybe)
+import           Data.Semigroup
+import           Data.Typeable (Typeable)
+import           Data.Word ( Word32 )
+
+import qualified Codec.Binary.UTF8.String as UTF8 (decode)
 import qualified Control.Exception as X
+import qualified Data.ByteString as BS
+import qualified Data.IntMap as IntMap
 import qualified Data.Map as Map
 import qualified Data.Sequence as Seq
+import           GHC.Stack (HasCallStack, CallStack, callStack, prettyCallStack)
 
+import           Prelude
 
+
 -- Error Collection Parser -----------------------------------------------------
 
 data Error = Error
   { errContext :: [String]
   , errMessage :: String
-  } deriving (Show)
+  } deriving (Show, Eq, Ord)
 
 formatError :: Error -> String
 formatError err
@@ -39,25 +54,33 @@
                           : map ('\t' :) (errContext err)
 
 newtype Parse a = Parse
-  { unParse :: ReaderT Env (StateT ParseState (ExceptionT Error Lift)) a
-  } deriving (Functor,Applicative,MonadFix)
+  { unParse :: ReaderT Env (StateT ParseState (Except Error)) a
+  } deriving (Functor, Applicative, MonadFix)
 
 instance Monad Parse where
+#if !MIN_VERSION_base(4,11,0)
   {-# INLINE return #-}
-  return  = Parse . return
+  return = pure
+#endif
 
   {-# INLINE (>>=) #-}
   Parse m >>= f = Parse (m >>= unParse . f)
 
+#if !MIN_VERSION_base(4,13,0)
   {-# INLINE fail #-}
   fail = failWithContext
+#endif
 
+instance MonadFail Parse where
+  {-# INLINE fail #-}
+  fail = failWithContext
+
 instance Alternative Parse where
   {-# INLINE empty #-}
   empty = failWithContext "empty"
 
   {-# INLINE (<|>) #-}
-  a <|> b = Parse (either (const (unParse b)) return =<< try (unParse a))
+  a <|> b = Parse $ catchError (unParse a) (const (unParse b))
 
 instance MonadPlus Parse where
   {-# INLINE mzero #-}
@@ -67,9 +90,10 @@
   mplus = (<|>)
 
 runParse :: Parse a -> Either Error a
-runParse (Parse m) = case runM m emptyEnv emptyParseState of
-  Left err    -> Left err
-  Right (a,_) -> Right a
+runParse (Parse m) =
+  case runExcept (runStateT (runReaderT m emptyEnv) emptyParseState) of
+    Left err     -> Left err
+    Right (a, _) -> Right a
 
 notImplemented :: Parse a
 notImplemented  = fail "not implemented"
@@ -80,6 +104,7 @@
   { psTypeTable     :: TypeTable
   , psTypeTableSize :: !Int
   , psValueTable    :: ValueTable
+  , psStringTable   :: Maybe StringTable
   , psMdTable       :: ValueTable
   , psMdRefs        :: MdRefTable
   , psFunProtos     :: Seq.Seq FunProto
@@ -88,29 +113,32 @@
   , psNextTypeId    :: !Int
   , psLastLoc       :: Maybe PDebugLoc
   , psKinds         :: !KindTable
+  , psModVersion    :: !Int
   } deriving (Show)
 
 -- | The initial parsing state.
 emptyParseState :: ParseState
 emptyParseState  = ParseState
-  { psTypeTable     = Map.empty
+  { psTypeTable     = IntMap.empty
   , psTypeTableSize = 0
   , psValueTable    = emptyValueTable False
+  , psStringTable   = Nothing
   , psMdTable       = emptyValueTable False
-  , psMdRefs        = Map.empty
+  , psMdRefs        = IntMap.empty
   , psFunProtos     = Seq.empty
   , psNextResultId  = 0
   , psTypeName      = Nothing
   , psNextTypeId    = 0
   , psLastLoc       = Nothing
   , psKinds         = emptyKindTable
+  , psModVersion    = 0
   }
 
 -- | The next implicit result id.
 nextResultId :: Parse Int
 nextResultId  = Parse $ do
   ps <- get
-  set ps { psNextResultId = psNextResultId ps + 1 }
+  put ps { psNextResultId = psNextResultId ps + 1 }
   return (psNextResultId ps)
 
 type PDebugLoc = DebugLoc' Int
@@ -118,37 +146,45 @@
 setLastLoc :: PDebugLoc -> Parse ()
 setLastLoc loc = Parse $ do
   ps <- get
-  set $! ps { psLastLoc = Just loc }
+  put $! ps { psLastLoc = Just loc }
 
 setRelIds :: Bool -> Parse ()
 setRelIds b = Parse $ do
   ps <- get
-  set $! ps { psValueTable = (psValueTable ps) { valueRelIds = b }}
+  put $! ps { psValueTable = (psValueTable ps) { valueRelIds = b }}
 
 getRelIds :: Parse Bool
-getRelIds  = Parse $ do
-  ps <- get
+getRelIds  = do
+  ps <- Parse get
   return (valueRelIds (psValueTable ps))
 
 getLastLoc :: Parse PDebugLoc
-getLastLoc  = Parse $ do
-  ps <- get
+getLastLoc  = do
+  ps <- Parse get
   case psLastLoc ps of
     Just loc -> return loc
     Nothing  -> fail "No last location available"
 
+setModVersion :: Int -> Parse ()
+setModVersion v = Parse $ do
+  ps <- get
+  put $! ps { psModVersion = v }
+
+getModVersion :: Parse Int
+getModVersion = Parse (psModVersion <$> get)
+
 -- | Sort of a hack to preserve state between function body parses.  It would
 -- really be nice to separate this into a different monad, that could just run
 -- under the Parse monad, but sort of unnecessary in the long run.
 enterFunctionDef :: Parse a -> Parse a
 enterFunctionDef m = Parse $ do
   ps  <- get
-  set ps
+  put ps
     { psNextResultId = 0
     }
   res <- unParse m
   ps' <- get
-  set ps'
+  put ps'
     { psValueTable = psValueTable ps
     , psMdTable    = psMdTable ps
     , psMdRefs     = psMdRefs ps
@@ -159,35 +195,47 @@
 
 -- Type Table ------------------------------------------------------------------
 
-type TypeTable = Map.Map Int Type
+type TypeTable = IntMap.IntMap Type
 
 -- | Generate a type table, and a type symbol table.
 mkTypeTable :: [Type] -> TypeTable
-mkTypeTable  = Map.fromList . zip [0 ..]
+mkTypeTable  = IntMap.fromList . zip [0 ..]
 
+-- | Exceptions contain a callstack, parsing context, explanation, and index
 data BadForwardRef
-  = BadTypeRef [String] Int
-  | BadValueRef [String] Int
+  = BadTypeRef  CallStack [String] String Int
+  | BadValueRef CallStack [String] String Int
     deriving (Show,Typeable)
 
 instance X.Exception BadForwardRef
 
 badRefError :: BadForwardRef -> Error
-badRefError ref = case ref of
-  BadTypeRef  c i -> Error c ("bad forward reference to type: " ++ show i)
-  BadValueRef c i -> Error c ("bad forward reference to value: " ++ show i)
+badRefError ref =
+  let (stk, cxt, explanation, i, thing) =
+        case ref of
+          BadTypeRef  stk' cxt' explanation' i' -> (stk', cxt', explanation', i', "type")
+          BadValueRef stk' cxt' explanation' i' -> (stk', cxt', explanation', i', "value")
+  in Error cxt $ unlines ["bad forward reference to " ++ thing ++ ": " ++ show i
+                         , "additional details: "
+                         , explanation
+                         , "with call stack: "
+                         , prettyCallStack stk
+                         ]
 
 -- | As type tables are always pre-allocated, looking things up should never
 -- fail.  As a result, the worst thing that could happen is that the type entry
 -- causes a runtime error.  This is pretty bad, but it's an acceptable trade-off
 -- for the complexity of the forward references in the type table.
-lookupTypeRef :: [String] -> Int -> TypeTable -> Type
-lookupTypeRef cxt n = fromMaybe (X.throw (BadTypeRef cxt n)) . Map.lookup n
+lookupTypeRef :: HasCallStack
+              => [String] -> Int -> TypeTable -> Type
+lookupTypeRef cxt n =
+  let explanation = "Bad reference into type table"
+  in fromMaybe (X.throw (BadTypeRef callStack cxt explanation n)) . IntMap.lookup n
 
 setTypeTable :: TypeTable -> Parse ()
 setTypeTable table = Parse $ do
   ps <- get
-  set ps { psTypeTable = table }
+  put ps { psTypeTable = table }
 
 getTypeTable :: Parse TypeTable
 getTypeTable  = Parse (psTypeTable <$> get)
@@ -195,7 +243,7 @@
 setTypeTableSize :: Int -> Parse ()
 setTypeTableSize n = Parse $ do
   ps <- get
-  set ps { psTypeTableSize = n }
+  put ps { psTypeTableSize = n }
 
 -- | Retrieve the current type name, failing if it hasn't been set.
 getTypeName :: Parse Ident
@@ -203,17 +251,17 @@
   ps  <- get
   str <- case psTypeName ps of
     Just tn -> do
-      set ps { psTypeName = Nothing }
+      put ps { psTypeName = Nothing }
       return tn
     Nothing -> do
-      set ps { psNextTypeId = psNextTypeId ps + 1 }
+      put ps { psNextTypeId = psNextTypeId ps + 1 }
       return (show (psNextTypeId ps))
   return (Ident str)
 
 setTypeName :: String -> Parse ()
 setTypeName name = Parse $ do
   ps <- get
-  set ps { psTypeName = Just name }
+  put ps { psTypeName = Just name }
 
 -- | Lookup the value of a type; don't attempt to resolve to an alias.
 getType' :: Int -> Parse Type
@@ -226,9 +274,16 @@
 
 -- | Test to see if the type table has been added to already.
 isTypeTableEmpty :: Parse Bool
-isTypeTableEmpty  = Parse (Map.null . psTypeTable <$> get)
+isTypeTableEmpty  = Parse (IntMap.null . psTypeTable <$> get)
 
+setStringTable :: StringTable -> Parse ()
+setStringTable st = Parse $ do
+  ps <- get
+  put ps { psStringTable = Just st }
 
+getStringTable :: Parse (Maybe StringTable)
+getStringTable = Parse (psStringTable <$> get)
+
 -- Value Tables ----------------------------------------------------------------
 
 -- | Values that have an identifier instead of a string label
@@ -238,14 +293,16 @@
 
 data ValueTable = ValueTable
   { valueNextId  :: !Int
-  , valueEntries :: Map.Map Int (Typed PValue)
+  , valueEntries :: IntMap.IntMap (Typed PValue)
+  , strtabEntries :: IntMap.IntMap (Int, Int)
   , valueRelIds  :: Bool
   } deriving (Show)
 
 emptyValueTable :: Bool -> ValueTable
 emptyValueTable rel = ValueTable
   { valueNextId  = 0
-  , valueEntries = Map.empty
+  , valueEntries = IntMap.empty
+  , strtabEntries = IntMap.empty
   , valueRelIds  = rel
   }
 
@@ -257,7 +314,7 @@
   where
   vs' = vs
     { valueNextId  = valueNextId vs + 1
-    , valueEntries = Map.insert (valueNextId vs) tv (valueEntries vs)
+    , valueEntries = IntMap.insert (valueNextId vs) tv (valueEntries vs)
     }
 
 -- | Push a value into the value table, and return its index.
@@ -265,7 +322,7 @@
 pushValue tv = Parse $ do
   ps <- get
   let vt = psValueTable ps
-  set ps { psValueTable = addValue tv vt }
+  put ps { psValueTable = addValue tv vt }
   return (valueNextId vt)
 
 -- | Get the index for the next value.
@@ -279,6 +336,8 @@
   return (translateValueId vt n)
 
 -- | Translate an id, relative to the value table it references.
+-- NOTE: The relative conversion has to be done on a Word32 to handle overflow
+-- when n is large the same way BitcodeReaderMDValueList::getValue does.
 translateValueId :: ValueTable -> Int -> Int
 translateValueId vt n | valueRelIds vt = fromIntegral adjusted
                       | otherwise      = n
@@ -288,7 +347,7 @@
 
 -- | Lookup an absolute address in the value table.
 lookupValueTableAbs :: Int -> ValueTable -> Maybe (Typed PValue)
-lookupValueTableAbs n values = Map.lookup n (valueEntries values)
+lookupValueTableAbs n values = IntMap.lookup n (valueEntries values)
 
 -- | When you know you have an absolute index.
 lookupValueAbs :: Int -> Parse (Maybe (Typed PValue))
@@ -306,9 +365,11 @@
 -- | Lookup lazily, hiding an error in the result if the entry doesn't exist by
 -- the time it's needed.  NOTE: This always looks up an absolute index, never a
 -- relative one.
-forwardRef :: [String] -> Int -> ValueTable -> Typed PValue
+forwardRef :: HasCallStack
+           => [String] -> Int -> ValueTable -> Typed PValue
 forwardRef cxt n vt =
-  fromMaybe (X.throw (BadValueRef cxt n)) (lookupValueTableAbs n vt)
+  let explanation = "Bad reference into a value table"
+  in fromMaybe (X.throw (BadValueRef callStack cxt explanation n)) (lookupValueTableAbs n vt)
 
 -- | Require that a value be present.
 requireValue :: Int -> Parse (Typed PValue)
@@ -331,7 +392,7 @@
 setValueTable :: ValueTable -> Parse ()
 setValueTable vt = Parse $ do
   ps <- get
-  set ps { psValueTable = vt }
+  put ps { psValueTable = vt }
 
 -- | Update the value table, giving a lazy reference to the final table.
 fixValueTable :: (ValueTable -> Parse (a,[Typed PValue])) -> Parse a
@@ -358,7 +419,7 @@
 setMdTable :: MdTable -> Parse ()
 setMdTable md = Parse $ do
   ps <- get
-  set $! ps { psMdTable = md }
+  put $! ps { psMdTable = md }
 
 getMetadata :: Int -> Parse (Typed PValMd)
 getMetadata ix = do
@@ -373,34 +434,36 @@
 resolveMd ix ps = nodeRef `mplus` mdValue
   where
   reference = Typed (PrimType Metadata) . ValMd . ValMdRef
-  nodeRef   = reference `fmap` Map.lookup ix (psMdRefs ps)
-  mdValue   = Map.lookup ix (valueEntries (psMdTable ps))
+  nodeRef   = reference `fmap` IntMap.lookup ix (psMdRefs ps)
+  mdValue   = lookupValueTableAbs ix (psMdTable ps)
 
 
-type MdRefTable = Map.Map Int Int
+type MdRefTable = IntMap.IntMap Int
 
 setMdRefs :: MdRefTable -> Parse ()
 setMdRefs refs = Parse $ do
   ps <- get
-  set $! ps { psMdRefs = refs `Map.union` psMdRefs ps }
+  put $! ps { psMdRefs = refs `IntMap.union` psMdRefs ps }
 
 
 -- Function Prototypes ---------------------------------------------------------
 
 data FunProto = FunProto
-  { protoType  :: Type
-  , protoLinkage :: Maybe Linkage
-  , protoGC    :: Maybe GC
-  , protoName  :: String
-  , protoIndex :: Int
-  , protoSect  :: Maybe String
-  } deriving (Show)
+  { protoType       :: Type
+  , protoLinkage    :: Maybe Linkage
+  , protoVisibility :: Maybe Visibility
+  , protoGC         :: Maybe GC
+  , protoSym        :: Symbol
+  , protoIndex      :: Int
+  , protoSect       :: Maybe String
+  , protoComdat     :: Maybe String
+  } deriving Show
 
 -- | Push a function prototype on to the prototype stack.
 pushFunProto :: FunProto -> Parse ()
 pushFunProto p = Parse $ do
   ps <- get
-  set ps { psFunProtos = psFunProtos ps Seq.|> p }
+  put ps { psFunProtos = psFunProtos ps Seq.|> p }
 
 -- | Take a single function prototype off of the prototype stack.
 popFunProto :: Parse FunProto
@@ -409,7 +472,7 @@
   case Seq.viewl (psFunProtos ps) of
     Seq.EmptyL   -> fail "empty function prototype stack"
     p Seq.:< ps' -> do
-      Parse (set ps { psFunProtos = ps' })
+      Parse (put ps { psFunProtos = ps' })
       return p
 
 
@@ -443,29 +506,31 @@
   , symTypeSymtab  :: TypeSymtab
   } deriving (Show)
 
+instance Semigroup Symtab where
+  l <> r = Symtab
+    { symValueSymtab = symValueSymtab l <> symValueSymtab r
+    , symTypeSymtab  = symTypeSymtab  l <> symTypeSymtab  r
+    }
+
 instance Monoid Symtab where
   mempty = Symtab
     { symValueSymtab = emptyValueSymtab
     , symTypeSymtab  = mempty
     }
 
-  mappend l r = Symtab
-    { symValueSymtab = symValueSymtab l `Map.union` symValueSymtab r
-    , symTypeSymtab  = symTypeSymtab  l `mappend`   symTypeSymtab  r
-    }
+  mappend = (<>)
 
 withSymtab :: Symtab -> Parse a -> Parse a
 withSymtab symtab body = Parse $ do
-  env <- ask
-  local (extendSymtab symtab env) (unParse body)
+  local (extendSymtab symtab) (unParse body)
 
 -- | Run a computation with an extended value symbol table.
 withValueSymtab :: ValueSymtab -> Parse a -> Parse a
 withValueSymtab symtab = withSymtab (mempty { symValueSymtab = symtab })
 
 -- | Retrieve the value symbol table.
-getValueSymtab :: Parse ValueSymtab
-getValueSymtab  = Parse (symValueSymtab . envSymtab <$> ask)
+getValueSymtab :: Finalize ValueSymtab
+getValueSymtab = Finalize (symValueSymtab . envSymtab <$> ask)
 
 -- | Run a computation with an extended type symbol table.
 withTypeSymtab :: TypeSymtab -> Parse a -> Parse a
@@ -478,14 +543,13 @@
 -- | Label a sub-computation with its context.
 label :: String -> Parse a -> Parse a
 label l m = Parse $ do
-  env <- ask
-  local (addLabel l env) (unParse m)
+  local (addLabel l) (unParse m)
 
 -- | Fail, taking into account the current context.
 failWithContext :: String -> Parse a
 failWithContext msg = Parse $ do
   env <- ask
-  raise Error
+  throwError Error
     { errMessage = msg
     , errContext = envContext env
     }
@@ -495,7 +559,7 @@
 getType :: Int -> Parse Type
 getType ref = do
   symtab <- getTypeSymtab
-  case Map.lookup ref (tsById symtab) of
+  case IntMap.lookup ref (tsById symtab) of
     Just i  -> return (Alias i)
     Nothing -> getType' ref
 
@@ -505,21 +569,35 @@
   symtab <- getTypeSymtab
   case Map.lookup n (tsByName symtab) of
     Just ix -> return ix
-    Nothing -> fail ("unknown type alias " ++ show (ppLLVM (ppIdent n)))
+    Nothing -> fail ("unknown type alias " ++ show (ppLLVM llvmVlatest (llvmPP n)))
 
 
 -- Value Symbol Table ----------------------------------------------------------
 
 type SymName = Either String Int
 
-type ValueSymtab = Map.Map SymTabEntry SymName
+data ValueSymtab =
+  ValueSymtab
+  { valSymtab :: IntMap.IntMap SymName
+  , bbSymtab  :: IntMap.IntMap SymName
+  , fnSymtab  :: IntMap.IntMap SymName
+  } deriving (Show)
 
-data SymTabEntry
-  = SymTabEntry !Int
-  | SymTabBBEntry !Int
-  | SymTabFNEntry !Int
-    deriving (Eq,Ord,Show)
+instance Semigroup ValueSymtab where
+  l <> r = ValueSymtab
+    { valSymtab = valSymtab l `IntMap.union` valSymtab r
+    , bbSymtab  = bbSymtab l  `IntMap.union` bbSymtab r
+    , fnSymtab  = fnSymtab l  `IntMap.union` fnSymtab r
+    }
 
+instance Monoid ValueSymtab where
+  mappend = (<>)
+  mempty = ValueSymtab
+    { valSymtab = IntMap.empty
+    , bbSymtab  = IntMap.empty
+    , fnSymtab  = IntMap.empty
+    }
+
 renderName :: SymName -> String
 renderName  = either id show
 
@@ -527,72 +605,84 @@
 mkBlockLabel  = either (Named . Ident) Anon
 
 emptyValueSymtab :: ValueSymtab
-emptyValueSymtab  = Map.empty
+emptyValueSymtab  = mempty
 
 addEntry :: Int -> String -> ValueSymtab -> ValueSymtab
-addEntry i n = Map.insert (SymTabEntry i) (Left n)
+addEntry i n t = t { valSymtab = IntMap.insert i (Left n) (valSymtab t) }
 
 addBBEntry :: Int -> String -> ValueSymtab -> ValueSymtab
-addBBEntry i n = Map.insert (SymTabBBEntry i) (Left n)
+addBBEntry i n t = t { bbSymtab = IntMap.insert i (Left n) (bbSymtab t) }
 
 addBBAnon :: Int -> Int -> ValueSymtab -> ValueSymtab
-addBBAnon i n = Map.insert (SymTabBBEntry i) (Right n)
+addBBAnon i n t = t { bbSymtab = IntMap.insert i (Right n) (bbSymtab t) }
 
 addFNEntry :: Int -> Int -> String -> ValueSymtab -> ValueSymtab
 -- TODO: do we ever need to be able to look up the offset?
-addFNEntry i _o n = Map.insert (SymTabFNEntry i) (Left n)
+addFNEntry i _o n t = t { fnSymtab = IntMap.insert i (Left n) (fnSymtab t) }
 
+addFwdFNEntry :: Int -> Int -> ValueSymtab -> ValueSymtab
+addFwdFNEntry i o t = t { fnSymtab = IntMap.insert i (Right o) (fnSymtab t) }
+
+-- | Lookup the name of an entry. Returns @Nothing@ when it's not present.
+entryNameMb :: Int -> Parse (Maybe String)
+entryNameMb n = do
+  symtab <- liftFinalize getValueSymtab
+  return $! fmap renderName
+         $  IntMap.lookup n (valSymtab symtab) `mplus`
+            IntMap.lookup n (fnSymtab symtab)
+
 -- | Lookup the name of an entry.
 entryName :: Int -> Parse String
 entryName n = do
-  symtab <- getValueSymtab
-  let mentry = Map.lookup (SymTabEntry n) symtab `mplus`
-               Map.lookup (SymTabFNEntry n) symtab
+  mentry <- entryNameMb n
   case mentry of
-    Just i  -> return (renderName i)
-    Nothing ->
-      do isRel <- getRelIds
+    Just name -> return name
+    Nothing   ->
+      do isRel  <- getRelIds
+         symtab <- liftFinalize getValueSymtab
          fail $ unlines
            [ "entry " ++ show n ++ (if isRel then " (relative)" else "")
               ++ " is missing from the symbol table"
            , show symtab ]
 
 -- | Lookup the name of a basic block.
-bbEntryName :: Int -> Parse (Maybe BlockLabel)
+bbEntryName :: Int -> Finalize (Maybe BlockLabel)
 bbEntryName n = do
   symtab <- getValueSymtab
-  return (mkBlockLabel <$> Map.lookup (SymTabBBEntry n) symtab)
+  return (mkBlockLabel <$> IntMap.lookup n (bbSymtab symtab))
 
 -- | Lookup the name of a basic block.
-requireBbEntryName :: Int -> Parse BlockLabel
+requireBbEntryName :: Int -> Finalize BlockLabel
 requireBbEntryName n = do
   mb <- bbEntryName n
   case mb of
     Just l  -> return l
     Nothing -> fail ("basic block " ++ show n ++ " has no id")
 
-
 -- Type Symbol Tables ----------------------------------------------------------
 
 data TypeSymtab = TypeSymtab
-  { tsById   :: Map.Map Int Ident
+  { tsById   :: IntMap.IntMap Ident
   , tsByName :: Map.Map Ident Int
   } deriving Show
 
+instance Semigroup TypeSymtab where
+  l <> r = TypeSymtab
+    { tsById   = tsById   l `IntMap.union` tsById r
+    , tsByName = tsByName l `Map.union` tsByName r
+    }
+
 instance Monoid TypeSymtab where
   mempty = TypeSymtab
-    { tsById   = Map.empty
+    { tsById   = IntMap.empty
     , tsByName = Map.empty
     }
 
-  mappend l r = TypeSymtab
-    { tsById   = tsById   l `Map.union` tsById r
-    , tsByName = tsByName l `Map.union` tsByName r
-    }
+  mappend = (<>)
 
 addTypeSymbol :: Int -> Ident -> TypeSymtab -> TypeSymtab
 addTypeSymbol ix n ts = ts
-  { tsById   = Map.insert ix n (tsById ts)
+  { tsById   = IntMap.insert ix n (tsById ts)
   , tsByName = Map.insert n ix (tsByName ts)
   }
 
@@ -600,12 +690,12 @@
 -- Metadata Kind Table ---------------------------------------------------------
 
 data KindTable = KindTable
-  { ktNames :: Map.Map Int String
+  { ktNames :: IntMap.IntMap String
   } deriving (Show)
 
 emptyKindTable :: KindTable
 emptyKindTable  = KindTable
-  { ktNames = Map.fromList
+  { ktNames = IntMap.fromList
     [ (0, "dbg"   )
     , (1, "tbaa"  )
     , (2, "prof"  )
@@ -618,12 +708,83 @@
 addKind kind name = Parse $ do
   ps <- get
   let KindTable { .. } = psKinds ps
-  set $! ps { psKinds = KindTable { ktNames = Map.insert kind name ktNames } }
+  put $! ps { psKinds = KindTable { ktNames = IntMap.insert kind name ktNames } }
 
 getKind :: Int -> Parse String
-getKind kind = Parse $ do
-  ps <- get
+getKind kind = do
+  ps <- Parse get
   let KindTable { .. } = psKinds ps
-  case Map.lookup kind ktNames of
+  case IntMap.lookup kind ktNames of
     Just name -> return name
     Nothing   -> fail ("Unknown kind id: " ++ show kind ++ "\nKind table: " ++ show (psKinds ps))
+
+-- Partial Symbols -------------------------------------------------------------
+
+newtype StringTable = Strtab BS.ByteString
+  deriving (Show)
+--newtype SymbolTable = Symtab BS.ByteString
+
+mkStrtab :: BS.ByteString -> StringTable
+mkStrtab = Strtab
+
+--mkSymtab :: BS.ByteString -> SymbolTable
+--mkSymtab = Symtab
+
+resolveStrtabSymbol :: StringTable -> Int -> Int -> Symbol
+resolveStrtabSymbol (Strtab bs) start len =
+  Symbol $ UTF8.decode $ BS.unpack $ BS.take len $ BS.drop start bs
+
+-- Finalize Monad --------------------------------------------------------------
+
+newtype Finalize a = Finalize
+  { unFinalize :: ReaderT Env (Except Error) a
+  } deriving (Functor, Applicative)
+
+instance Monad Finalize where
+#if !MIN_VERSION_base(4,11,0)
+  {-# INLINE return #-}
+  return = pure
+#endif
+
+  {-# INLINE (>>=) #-}
+  Finalize m >>= f = Finalize (m >>= unFinalize . f)
+
+#if !MIN_VERSION_base(4,13,0)
+  {-# INLINE fail #-}
+  fail = failWithContext'
+#endif
+
+instance MonadFail Finalize where
+  {-# INLINE fail #-}
+  fail = failWithContext'
+
+instance Alternative Finalize where
+  {-# INLINE empty #-}
+  empty = failWithContext' "empty"
+
+  {-# INLINE (<|>) #-}
+  a <|> b = Finalize $ catchError (unFinalize a) (const (unFinalize b))
+
+instance MonadPlus Finalize where
+  {-# INLINE mzero #-}
+  mzero = failWithContext' "mzero"
+
+  {-# INLINE mplus #-}
+  mplus = (<|>)
+
+-- | Fail, taking into account the current context.
+failWithContext' :: String -> Finalize a
+failWithContext' msg =
+  Finalize $
+  do env <- ask
+     throwError Error
+       { errMessage = msg
+       , errContext = envContext env
+       }
+
+liftFinalize :: Finalize a -> Parse a
+liftFinalize (Finalize m) =
+  do env <- Parse ask
+     case runExcept (runReaderT m env) of
+       Left err -> Parse (throwError err)
+       Right a -> return a
diff --git a/src/Data/LLVM/BitCode/Record.hs b/src/Data/LLVM/BitCode/Record.hs
--- a/src/Data/LLVM/BitCode/Record.hs
+++ b/src/Data/LLVM/BitCode/Record.hs
@@ -1,17 +1,19 @@
+{-# LANGUAGE MultiWayIf #-}
 module Data.LLVM.BitCode.Record where
 
 import Data.LLVM.BitCode.Bitstream
 import Data.LLVM.BitCode.BitString hiding (drop,take)
 import Data.LLVM.BitCode.Match
 import Data.LLVM.BitCode.Parse
+import Text.LLVM.AST
 
 import Data.Bits (Bits,testBit,shiftR,bit)
-import Data.Char (chr)
 import Data.Int  (Int64)
-import Data.Word (Word64)
+import Data.Word (Word8,Word32,Word64)
 import Data.ByteString (ByteString)
 
-import Control.Monad ((<=<),MonadPlus(..),guard)
+import qualified Codec.Binary.UTF8.String as UTF8 (decode)
+import Control.Monad ((<=<),MonadPlus(..))
 
 
 -- Generic Records -------------------------------------------------------------
@@ -34,8 +36,9 @@
 -- | Record construction from an abbreviated field.
 fromAbbrev :: Match AbbrevRecord Record
 fromAbbrev a = do
-  guard (not (null (abbrevFields a)))
-  let (f:fs) = abbrevFields a
+  -- If abbrevFields is empty here, it will cause the Match to fail with
+  -- Nothing, at which point alternatives may then be tried.
+  (f:fs) <- return $ abbrevFields a
   code <- numeric f
   return Record
     { recordCode   = code
@@ -67,7 +70,7 @@
 fieldVbr _             = mzero
 
 -- | Match a character field.
-fieldChar6 :: Match Field Char
+fieldChar6 :: Match Field Word8
 fieldChar6 (FieldChar6 c) = return c
 fieldChar6 _              = mzero
 
@@ -114,7 +117,7 @@
   loop []     = return []
 
 -- | Parse a @Field@ as a numeric value.
-numeric :: Num a => Match Field a
+numeric :: (Num a, Bits a) => Match Field a
 numeric  = fmap fromBitString . (fieldLiteral ||| fieldFixed ||| fieldVbr)
 
 signedImpl :: (Bits a, Num a) => Match Field a
@@ -135,26 +138,49 @@
 signedInt64 :: Match Field Int64
 signedInt64 = signedImpl
 
+-- | Parse a @Field@ as a Word32.
+unsigned :: Match Field Word32
+unsigned  = numeric
+
 boolean :: Match Field Bool
 boolean  = decode <=< (fieldFixed ||| fieldLiteral ||| fieldVbr)
   where
-  decode bs
-    | bsData bs == 1 = return True
-    | bsData bs == 0 = return False
-    | otherwise      = mzero
+  decode bs = case bitStringValue bs of
+                0 -> return False
+                1 -> return True
+                _ -> mzero
 
 nonzero :: Match Field Bool
 nonzero  = decode <=< (fieldFixed ||| fieldLiteral ||| fieldVbr)
   where
-  decode bs
-    | bsData bs == 0 = return False
-    | otherwise      = return True
+  decode bs = return $ case bitStringValue bs of
+                         0 -> False
+                         _ -> True
 
-char :: Match Field Char
-char  = fmap chr . numeric
+char :: Match Field Word8
+char = numeric
 
 string :: Match Field String
-string  = fieldArray char
+string  = fmap UTF8.decode . fieldArray char
 
 cstring :: Match Field String
-cstring  = fieldArray (fieldChar6 ||| char)
+cstring  = fmap UTF8.decode . fieldArray (fieldChar6 ||| char)
+
+-- | Lookup the name at the given field index if using an old bitcode
+-- version, or in the string table if using a new bitcode version.
+-- Returns the name and the offset into the record to use for further
+-- queries.
+oldOrStrtabName :: Int -> Record -> Parse (Symbol, Int)
+oldOrStrtabName n r = do
+  v <- getModVersion
+  if | v < 2 -> do
+        name <- entryName n
+        return (Symbol name, 0)
+     | otherwise -> do
+        mst <- getStringTable
+        case mst of
+          Just st -> do
+            offset <- parseField r 0 numeric
+            len <- parseField r 1 numeric
+            return (resolveStrtabSymbol st offset len, 2)
+          Nothing -> fail "New-style name encountered with no string table."
diff --git a/src/Data/LLVM/CFG.hs b/src/Data/LLVM/CFG.hs
--- a/src/Data/LLVM/CFG.hs
+++ b/src/Data/LLVM/CFG.hs
@@ -29,10 +29,10 @@
 
 import           Control.Arrow
 
+import           Data.Functor.Identity (runIdentity)
 import qualified Data.Graph.Inductive.Query.Dominators as Dom
 import qualified Data.Graph.Inductive                  as G
 import qualified Data.Map                              as M
-import           MonadLib (runId)
 
 import           Text.LLVM                             hiding (BB)
 import qualified Text.LLVM.Labels                      as L
@@ -171,7 +171,7 @@
 
     nodeByName = fmap (\(BBId n, _) -> n) bbIds
 
-    fixLabels stmts = runId (mapM (L.relabel f) stmts)
+    fixLabels stmts = runIdentity (mapM (L.relabel f) stmts)
       where
       -- This should be fine, as there shouldn't be references to labels that
       -- aren't defined.
diff --git a/src/Data/LLVM/Internal.hs b/src/Data/LLVM/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Data/LLVM/Internal.hs
@@ -0,0 +1,6 @@
+-- | This module exports some internal modules *for use in testing only*.
+module Data.LLVM.Internal
+  ( module Data.LLVM.BitCode.IR.Metadata
+  ) where
+
+import Data.LLVM.BitCode.IR.Metadata
diff --git a/unit-test/Main.hs b/unit-test/Main.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Main.hs
@@ -0,0 +1,8 @@
+module Main (main) where
+
+import qualified Test.Tasty as T
+import qualified Tests.Metadata
+
+main :: IO ()
+main = T.defaultMain $ T.testGroup "Tests" [ Tests.Metadata.tests
+                                           ]
diff --git a/unit-test/Tests/ExpressionInstances.hs b/unit-test/Tests/ExpressionInstances.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/ExpressionInstances.hs
@@ -0,0 +1,43 @@
+module Tests.ExpressionInstances where
+
+import Generic.Random hiding ((%))
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+
+import Text.LLVM.AST
+
+import Tests.PrimInstances ()
+
+
+instance Arbitrary lab => Arbitrary (Type' lab)                       where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (Typed lab)                       where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (ValMd' lab)                      where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (Value' lab)                      where arbitrary = genericArbitrary uniform
+instance Arbitrary ArithOp                                            where arbitrary = genericArbitrary uniform
+instance Arbitrary UnaryArithOp                                       where arbitrary = genericArbitrary uniform
+instance Arbitrary BitOp                                              where arbitrary = genericArbitrary uniform
+instance Arbitrary ConvOp                                             where arbitrary = genericArbitrary uniform
+instance Arbitrary ICmpOp                                             where arbitrary = genericArbitrary uniform
+instance Arbitrary FCmpOp                                             where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DebugLoc' lab)                   where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (ConstExpr' lab)                  where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DebugInfo' lab)                  where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DIImportedEntity' lab)           where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DITemplateTypeParameter' lab)    where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DITemplateValueParameter' lab)   where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DINameSpace' lab)                where arbitrary = genericArbitrary uniform
+instance Arbitrary DIBasicType                                        where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DICompileUnit' lab)              where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DICompositeType' lab)            where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DIDerivedType' lab)              where arbitrary = genericArbitrary uniform
+instance Arbitrary DIExpression                                       where arbitrary = genericArbitrary uniform
+instance Arbitrary DIFile                                             where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DIGlobalVariable' lab)           where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DIGlobalVariableExpression' lab) where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DILexicalBlock' lab)             where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DILexicalBlockFile' lab)         where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DILocalVariable' lab)            where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DISubprogram' lab)               where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DISubrange' lab)                 where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DISubroutineType' lab)           where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DILabel' lab)                    where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (DIArgList' lab)                  where arbitrary = genericArbitrary uniform
diff --git a/unit-test/Tests/FuncDataInstances.hs b/unit-test/Tests/FuncDataInstances.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/FuncDataInstances.hs
@@ -0,0 +1,24 @@
+module Tests.FuncDataInstances where
+
+import Generic.Random hiding ((%))
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+
+import Text.LLVM.AST
+
+import Tests.StmtInstances ()
+
+
+instance Arbitrary BlockLabel where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (BasicBlock' lab) where
+  arbitrary = genericArbitrary uniform
+
+instance Arbitrary TypeDecl where arbitrary = genericArbitrary uniform
+instance Arbitrary Global where arbitrary = genericArbitrary uniform
+instance Arbitrary GlobalAttrs where arbitrary = genericArbitrary uniform
+instance Arbitrary Linkage where arbitrary = genericArbitrary uniform
+instance Arbitrary Visibility where arbitrary = genericArbitrary uniform
+
+instance Arbitrary FunAttr where arbitrary = genericArbitrary uniform
+instance Arbitrary Define where arbitrary = genericArbitrary uniform
+instance Arbitrary Declare where arbitrary = genericArbitrary uniform
+instance Arbitrary GC     where arbitrary = genericArbitrary uniform
diff --git a/unit-test/Tests/Instances.hs b/unit-test/Tests/Instances.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/Instances.hs
@@ -0,0 +1,39 @@
+-- | Arbitrary instances for LLVM AST nodes, for QuickCheck.
+--
+-- These declarations are actually spread across a number of files.  This spread
+-- must allow for dependencies between instances, which would not be as much of
+-- an issue if they were all collected in a single file, but the single file
+-- takes much more time and memory to compile.
+--
+-- In one file:                                  2m13s compilation, ~10GB RAM
+-- top + triple + prim + expr + stmt + funcdata:   32s compilation, ~ 1GB RAM
+
+module Tests.Instances where
+
+import Generic.Random hiding ((%))
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+
+import Data.LLVM.Internal
+import Text.LLVM.AST
+
+import Tests.TripleInstances ()
+import Tests.FuncDataInstances ()
+import Tests.ExpressionInstances ()
+import Tests.StmtInstances ()
+
+-------------------------------------------------------------------------
+-- ** llvm-pretty
+
+instance Arbitrary Module where arbitrary = genericArbitrary uniform
+instance Arbitrary NamedMd where arbitrary = genericArbitrary uniform
+instance Arbitrary UnnamedMd where arbitrary = genericArbitrary uniform
+instance Arbitrary GlobalAlias where arbitrary = genericArbitrary uniform
+instance Arbitrary LayoutSpec where arbitrary = genericArbitrary uniform
+instance Arbitrary Mangling where arbitrary = genericArbitrary uniform
+instance Arbitrary SelectionKind where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (NullResult lab) where arbitrary = genericArbitrary uniform
+
+-------------------------------------------------------------------------
+-- ** llvm-pretty-bc-parser
+
+instance Arbitrary PartialUnnamedMd where arbitrary = genericArbitrary uniform
diff --git a/unit-test/Tests/Metadata.hs b/unit-test/Tests/Metadata.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/Metadata.hs
@@ -0,0 +1,46 @@
+module Tests.Metadata (tests) where
+
+import qualified Data.Sequence as Seq
+import Test.Tasty (TestTree, testGroup)
+import Test.Tasty.HUnit (testCase, (@?=))
+
+import Data.LLVM.Internal
+import Text.LLVM.AST
+
+import Tests.Instances ()
+
+
+tests :: TestTree
+tests = testGroup "Metadata"
+    [ testCase "test dedup metadata" $
+        mempty @?= dedupMetadata mempty
+
+    -- The first two should remain unchanged, but the third duplicates information in
+    -- the second, so should be updated to hold a reference to it.
+    , testGroup "test dedup metadata" $
+        let mkPum i v = PartialUnnamedMd i v True
+            val1 = mkPum 1 (ValMdString "str")
+            val2 = mkPum 2 (ValMdDebugInfo (DebugInfoExpression (DIExpression [])))
+            val3 = mkPum 3 (ValMdNode [Just (pumValues val2)])
+            deduped = dedupMetadata (Seq.fromList [val1, val2, val3])
+        in [ testCase "1" $
+               Just val1 @?= deduped Seq.!? 0
+           , testCase "2" $
+               Just val2 @?= deduped Seq.!? 1
+           , testCase "3" $
+               Just (mkPum 3 (ValMdNode [Just (ValMdRef 2)])) @?=
+                  deduped Seq.!? 2
+           ]
+
+    -- Deduplication should not changes: references or strings
+    -- This test takes too long.
+    -- , testProperty "dedup metadata" $
+    --     \lst i -> i >= 0 && length lst > i ==>
+    --       let result = dedupMetadata lst
+    --       in if lst !! i /= result !! i
+    --          then case pumValues (result !! i) of
+    --                 ValMdRef _    -> False
+    --                 ValMdString _ -> False
+    --                 _             -> True
+    --          else True
+    ]
diff --git a/unit-test/Tests/PrimInstances.hs b/unit-test/Tests/PrimInstances.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/PrimInstances.hs
@@ -0,0 +1,13 @@
+module Tests.PrimInstances where
+
+import Generic.Random hiding ((%))
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+
+import Text.LLVM.AST
+
+
+instance Arbitrary PrimType where arbitrary = genericArbitrary uniform
+instance Arbitrary FloatType where arbitrary = genericArbitrary uniform
+instance Arbitrary FP80Value where arbitrary = genericArbitrary uniform
+instance Arbitrary Ident  where arbitrary = genericArbitrary uniform
+instance Arbitrary Symbol where arbitrary = genericArbitrary uniform
diff --git a/unit-test/Tests/StmtInstances.hs b/unit-test/Tests/StmtInstances.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/StmtInstances.hs
@@ -0,0 +1,15 @@
+module Tests.StmtInstances where
+
+import Generic.Random hiding ((%))
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+
+import Text.LLVM.AST
+
+import Tests.ExpressionInstances ()
+
+
+instance Arbitrary AtomicRWOp where arbitrary = genericArbitrary uniform
+instance Arbitrary AtomicOrdering where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (Instr' lab) where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (Clause' lab) where arbitrary = genericArbitrary uniform
+instance Arbitrary lab => Arbitrary (Stmt' lab) where arbitrary = genericArbitrary uniform
diff --git a/unit-test/Tests/TripleInstances.hs b/unit-test/Tests/TripleInstances.hs
new file mode 100644
--- /dev/null
+++ b/unit-test/Tests/TripleInstances.hs
@@ -0,0 +1,15 @@
+module Tests.TripleInstances where
+
+import Generic.Random hiding ((%))
+import Test.QuickCheck.Arbitrary (Arbitrary(..))
+
+import qualified Text.LLVM.Triple.AST as Triple
+
+
+instance Arbitrary Triple.Arch where arbitrary = genericArbitrary uniform
+instance Arbitrary Triple.Environment where arbitrary = genericArbitrary uniform
+instance Arbitrary Triple.OS where arbitrary = genericArbitrary uniform
+instance Arbitrary Triple.ObjectFormat where arbitrary = genericArbitrary uniform
+instance Arbitrary Triple.SubArch where arbitrary = genericArbitrary uniform
+instance Arbitrary Triple.TargetTriple where arbitrary = genericArbitrary uniform
+instance Arbitrary Triple.Vendor where arbitrary = genericArbitrary uniform