From 29c68e0ef93db0adea85877d89208a7c249e87e4 Mon Sep 17 00:00:00 2001 From: Ryan Scott Date: Sat, 22 Apr 2023 20:34:51 -0400 Subject: [PATCH] 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 | 57 ++++++++++++---------------- src/Data/LLVM/BitCode/IR/Function.hs | 20 ---------- 2 files changed, 25 insertions(+), 52 deletions(-) diff --git a/src/Data/LLVM/BitCode/Assert.hs b/src/Data/LLVM/BitCode/Assert.hs index c3dd3794..a10d80ac 100644 --- a/src/Data/LLVM/BitCode/Assert.hs +++ b/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,7 +79,11 @@ 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 @@ -88,35 +91,25 @@ elimPtrTo msg ptrTy = AST.elimPtrTo ptrTy `mplus` , 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 , and" - , "for the second value to be a value of type ." - ] - , "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. +-} diff --git a/src/Data/LLVM/BitCode/IR/Function.hs b/src/Data/LLVM/BitCode/IR/Function.hs index f59dcbcc..fd5fc3d1 100644 --- a/src/Data/LLVM/BitCode/IR/Function.hs +++ b/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 : , *" 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 : , * " 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 : , * " 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 : * , , " 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)