module TextShow.Foreign.Ptr (
showbPtr
, showbFunPtr
, showbIntPtrPrec
, showbWordPtr
, showbForeignPtr
) where
import Data.Monoid.Compat ((<>))
import Data.Text.Lazy.Builder (Builder, singleton)
import Foreign.ForeignPtr (ForeignPtr)
import Foreign.Ptr (FunPtr, IntPtr, WordPtr, castFunPtrToPtr)
import GHC.ForeignPtr (unsafeForeignPtrToPtr)
import GHC.Num (wordToInteger)
import GHC.Ptr (Ptr(..))
import GHC.Prim (addr2Int#, int2Word#, unsafeCoerce#)
import TextShow.Classes (TextShow(showb, showbPrec), TextShow1(..))
import TextShow.Data.Integral (showbHex, showbIntPrec, showbWord)
import TextShow.Utils (lengthB, mtimesDefault)
#include "MachDeps.h"
#include "inline.h"
showbPtr :: Ptr a -> Builder
showbPtr = showb
showbFunPtr :: FunPtr a -> Builder
showbFunPtr = showb
showbIntPtrPrec :: Int -> IntPtr -> Builder
showbIntPtrPrec p ip = showbIntPrec p $ unsafeCoerce# ip
showbWordPtr :: WordPtr -> Builder
showbWordPtr wp = showbWord $ unsafeCoerce# wp
showbForeignPtr :: ForeignPtr a -> Builder
showbForeignPtr = showb
instance TextShow (Ptr a) where
showbPrec = showbPrecWith undefined
INLINE_INST_FUN(showbPrec)
instance TextShow1 Ptr where
showbPrecWith _ _ (Ptr a) = padOut . showbHex $ wordToInteger (int2Word# (addr2Int# a))
where
padOut :: Builder -> Builder
padOut ls =
singleton '0' <> singleton 'x'
<> mtimesDefault (max 0 $ 2*SIZEOF_HSPTR lengthB ls) (singleton '0')
<> ls
instance TextShow (FunPtr a) where
showbPrec = showbPrecWith undefined
INLINE_INST_FUN(showbPrec)
instance TextShow1 FunPtr where
showbPrecWith _ _ = showb . castFunPtrToPtr
INLINE_INST_FUN(showbPrecWith)
instance TextShow IntPtr where
showbPrec = showbIntPtrPrec
INLINE_INST_FUN(showbPrec)
instance TextShow WordPtr where
showb = showbWordPtr
INLINE_INST_FUN(showb)
instance TextShow (ForeignPtr a) where
showbPrec = showbPrecWith undefined
INLINE_INST_FUN(showbPrec)
instance TextShow1 ForeignPtr where
showbPrecWith _ _ = showb . unsafeForeignPtrToPtr
INLINE_INST_FUN(showbPrecWith)