------------------------------------------------------------------------
-- |
-- Module           : Lang.Crucible.LLVM.PrettyPrint
-- Description      : Printing utilties for LLVM
-- Copyright        : (c) Galois, Inc 2015-2016
-- License          : BSD3
-- Maintainer       : Rob Dockins <rdockins@galois.com>
-- Stability        : provisional
--
-- This module defines several functions whose names clash with functions
-- offered elsewhere in @llvm-pretty@ (e.g., "Text.LLVM.PP") and in
-- @crucible-llvm@ (e.g., "Lang.Crucible.LLVM.MemModel.MemLog"). For this
-- reason, it is recommended to import this module qualified.
------------------------------------------------------------------------

{-# LANGUAGE ImplicitParams #-}
{-# LANGUAGE RankNTypes #-}
module Lang.Crucible.LLVM.PrettyPrint
  ( commaSepList
  , ppIntType
  , ppPtrType
  , ppArrayType
  , ppVectorType
  , ppIntVector

    -- * @llvm-pretty@ printing with the latest LLVM version
  , ppLLVMLatest
  , ppDeclare
  , ppIdent
  , ppSymbol
  , ppType
  , ppValue
  ) where

import Numeric.Natural
import Prettyprinter
import qualified Text.PrettyPrint.HughesPJ as HPJ

import qualified Text.LLVM.AST as L
import qualified Text.LLVM.PP as L

-- | Print list of documents separated by commas and spaces.
commaSepList :: [Doc ann] -> Doc ann
commaSepList :: forall ann. [Doc ann] -> Doc ann
commaSepList [Doc ann]
l = [Doc ann] -> Doc ann
forall ann. [Doc ann] -> Doc ann
hcat (Doc ann -> [Doc ann] -> [Doc ann]
forall ann. Doc ann -> [Doc ann] -> [Doc ann]
punctuate (Doc ann
forall ann. Doc ann
comma Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
' ') [Doc ann]
l)

-- | Pretty print int type with width.
ppIntType :: Integral a => a -> Doc ann
ppIntType :: forall a ann. Integral a => a -> Doc ann
ppIntType a
i = Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'i' Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (a -> Integer
forall a. Integral a => a -> Integer
toInteger a
i)

-- | Pretty print pointer type.
ppPtrType :: Doc ann -> Doc ann
ppPtrType :: forall ann. Doc ann -> Doc ann
ppPtrType Doc ann
tp = Doc ann
tp Doc ann -> Doc ann -> Doc ann
forall a. Semigroup a => a -> a -> a
<> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'*'

ppArrayType :: Natural -> Doc ann -> Doc ann
ppArrayType :: forall ann. Natural -> Doc ann -> Doc ann
ppArrayType Natural
n Doc ann
e = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
brackets (Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'x' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
e)

ppVectorType :: Natural -> Doc ann -> Doc ann
ppVectorType :: forall ann. Natural -> Doc ann -> Doc ann
ppVectorType Natural
n Doc ann
e = Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann
angles (Integer -> Doc ann
forall ann. Integer -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty (Natural -> Integer
forall a. Integral a => a -> Integer
toInteger Natural
n) Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Char -> Doc ann
forall ann. Char -> Doc ann
forall a ann. Pretty a => a -> Doc ann
pretty Char
'x' Doc ann -> Doc ann -> Doc ann
forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc ann
e)

ppIntVector :: Integral a => Natural -> a -> Doc ann
ppIntVector :: forall a ann. Integral a => Natural -> a -> Doc ann
ppIntVector Natural
n a
w = Natural -> Doc ann -> Doc ann
forall ann. Natural -> Doc ann -> Doc ann
ppVectorType Natural
n (a -> Doc ann
forall a ann. Integral a => a -> Doc ann
ppIntType a
w)

-- | Pretty-print an LLVM-related AST in accordance with the latest LLVM version
-- that @llvm-pretty@ currently supports (i.e., the value of 'L.llvmVlatest'.)
--
-- Note that we are mainly using the @llvm-pretty@ printer in @crucible-llvm@
-- for the sake of defining 'Show' instances and creating error messages, not
-- for creating machine-readable LLVM code. As a result, it doesn't particularly
-- matter which LLVM version we use, as any version-specific differences in
-- pretty-printer output won't be that impactful.
ppLLVMLatest :: ((?config :: L.Config) => a) -> a
ppLLVMLatest :: forall a. ((?config::Config) => a) -> a
ppLLVMLatest = Config -> ((?config::Config) => a) -> a
forall a. Config -> ((?config::Config) => a) -> a
L.withConfig (L.Config { cfgVer :: LLVMVer
L.cfgVer = LLVMVer
L.llvmVlatest })

-- | Invoke 'L.ppDeclare' in accordance with the latest LLVM version that
-- @llvm-pretty@ supports.
ppDeclare :: L.Declare -> HPJ.Doc
ppDeclare :: Declare -> Doc
ppDeclare = ((?config::Config) => Declare -> Doc) -> Declare -> Doc
forall a. ((?config::Config) => a) -> a
ppLLVMLatest (?config::Config) => Declare -> Doc
Declare -> Doc
L.ppDeclare

-- | Invoke 'L.ppIdent' in accordance with the latest LLVM version that
-- @llvm-pretty@ supports.
ppIdent :: L.Ident -> HPJ.Doc
ppIdent :: Ident -> Doc
ppIdent = ((?config::Config) => Ident -> Doc) -> Ident -> Doc
forall a. ((?config::Config) => a) -> a
ppLLVMLatest (?config::Config) => Ident -> Doc
Ident -> Doc
L.ppIdent

-- | Invoke 'L.ppSymbol' in accordance with the latest LLVM version that
-- @llvm-pretty@ supports.
ppSymbol :: L.Symbol -> HPJ.Doc
ppSymbol :: Symbol -> Doc
ppSymbol = ((?config::Config) => Symbol -> Doc) -> Symbol -> Doc
forall a. ((?config::Config) => a) -> a
ppLLVMLatest (?config::Config) => Symbol -> Doc
Symbol -> Doc
L.ppSymbol

-- | Invoke 'L.ppType' in accordance with the latest LLVM version that
-- @llvm-pretty@ supports.
ppType :: L.Type -> HPJ.Doc
ppType :: Type -> Doc
ppType = ((?config::Config) => Type -> Doc) -> Type -> Doc
forall a. ((?config::Config) => a) -> a
ppLLVMLatest (?config::Config) => Type -> Doc
Type -> Doc
L.ppType

-- | Invoke 'L.ppValue' in accordance with the latest LLVM version that
-- @llvm-pretty@ supports.
ppValue :: L.Value -> HPJ.Doc
ppValue :: Value -> Doc
ppValue = ((?config::Config) => Value -> Doc) -> Value -> Doc
forall a. ((?config::Config) => a) -> a
ppLLVMLatest (?config::Config) => Value -> Doc
Value -> Doc
L.ppValue