Remove ptrTo and baseType

As explained in the new `Note [Pointers and pointee types]`, we cannot inspect
`PtrTo` pointee types if we simultaneously support opaque pointers. The `ptrTo`
and `baseType` functions fundamentally rely on this, and as such, they have
been removed. They are ultimately used in service of implementing assertions,
so removing them is fairly straightforward. See #177.

The `elimPtrTo` and `elimPtrTo_` functions also inspect pointee types, but they
are required to support old versions of LLVM that do not store the necessary
type information in the instructions that need them. In subsequent commits, I
will ensure that all uses of `elimPtrTo`/`elimPtrTo_` are appropriately guarded
such that they will not be used on modern versions of LLVM bitcode.

src/Data/LLVM/BitCode/Assert.hs

@@ -22,7 +22,6 @@ module Data.LLVM.BitCode.Assert
   -- ** Types
   , elimPtrTo
   , elimPtrTo_
-  , ptrTo
   ) where
 
 import           Control.Monad (MonadPlus, mplus)
@@ -32,7 +31,7 @@ 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', Typed, Ident)
+import           Text.LLVM.AST (Type', Ident)
 import qualified Text.LLVM.AST as AST
 
 supportedCompilerMessage :: [String]
@@ -80,43 +79,37 @@ recordSizeIn record ns =
 ----------------------------------------------------------------
 -- ** Types
 
--- | Assert that this thing is a pointer, get the underlying type
+-- | 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 pointer
+-- | 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 ()
 
--- | Assert that the first thing is a pointer to something of the type of the
--- second thing, e.g. in a load/store instruction.
---
--- See: https://github.com/llvm-mirror/llvm/blob/release_60/lib/Bitcode/Reader/BitcodeReader.cpp#L3328
-ptrTo :: (MonadFail m, Show a, Show b)
-      => String
-      -> Typed a -- ^ The pointer
-      -> Typed b -- ^ The value
-      -> m ()
-ptrTo sig ptr val = do
-  case AST.typedType ptr of
-    AST.PtrTo ptrTo_ ->
-      when (AST.typedType val /= ptrTo_) $ fail $ unlines
-        [ unwords [ "Expected first value to be a pointer to some type <ty>, and"
-                  , "for the second value to be a value of type <ty>."
-                  ]
-        , "Instruction signature: " ++ sig
-        , "Pointer type:  " ++ show (AST.typedType ptr)
-        , "Value type:    " ++ show (AST.typedType val)
-        , "Pointer value: " ++ show (AST.typedValue ptr)
-        , "Value value:   " ++ show (AST.typedValue val)
-        ]
-    ty ->
-      fail $ unlines $
-        [ "Instruction expected a pointer argument."
-        , "Instruction signature: " ++ sig
-        , "Argument type: " ++ show ty
-        ]
+{-
+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.
+-}

src/Data/LLVM/BitCode/IR/Function.hs

@@ -812,8 +812,6 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
          else do ty <- Assert.elimPtrTo "" (typedType tv)
                  return (ty, ix)
 
-    Assert.ptrTo "load atomic : <ty>, <ty>*" tv (Typed ret ())
-
     ordval <- getDecodedOrdering =<< parseField r (ix' + 2) unsigned
     when (ordval `elem` Nothing:map Just [Release, AcqRel]) $
       fail $ "Invalid atomic ordering: " ++ show ordval
@@ -840,7 +838,6 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     (val,ix') <- getValueTypePair t r ix
 
     Assert.recordSizeIn r [ix' + 2]
-    Assert.ptrTo "store : <ty> <value>, <ty>* <pointer>" ptr val
 
     aval      <- field ix' numeric
     let align | aval > 0  = Just (bit aval `shiftR` 1)
@@ -853,7 +850,6 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     (val, ix') <- getValueTypePair t r ix
 
     Assert.recordSizeIn r [ix' + 4]
-    Assert.ptrTo "store atomic : <ty> <value>, <ty>* <pointer>" ptr val
 
     -- TODO: There's no spot in the AST for this ordering. Should there be?
     ordering <- getDecodedOrdering =<< parseField r (ix' + 2) unsigned
@@ -880,7 +876,6 @@ parseFunctionBlockEntry _ t d (fromEntry -> Just r) = case recordCode r of
     -- TODO: record size assertion
     -- Assert.recordSizeGreater r (ix'' + 5)
 
-    Assert.ptrTo "cmpxchg : <ty>* <pointer>, <ty> <cmp>, <ty> <new> " ptr val
     when (typedType val /= typedType new) $ fail $ unlines $
       [ "Mismatched value types:"
       , "cmp value: " ++ show (typedValue val)
@@ -1108,12 +1103,6 @@ addInstrAttachments atts blocks = go 0 (Map.toList atts) (Seq.viewl blocks)
 
   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
@@ -1134,15 +1123,6 @@ parseGEP t mbInBound r d = do
           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, ty, tv, r', ix')
 
   args    <- label "parseGepArgs" (parseGepArgs t r' ix)