{- |
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.
-}