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