X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=GHC%2FPtr.lhs;h=bf78f713bd04105f6264e53ce6b73af745431fc9;hb=792a8b86185d4cc74bb3d0d31b481ff0de4cf0d6;hp=31daa5f105e7b3cd3180a30ef8ce12f5fe742aef;hpb=aaf764b3ad8b1816d68b5f27299eac125f08e1a5;p=ghc-base.git diff --git a/GHC/Ptr.lhs b/GHC/Ptr.lhs index 31daa5f..bf78f71 100644 --- a/GHC/Ptr.lhs +++ b/GHC/Ptr.lhs @@ -1,5 +1,7 @@ \begin{code} -{-# OPTIONS_GHC -fno-implicit-prelude #-} +{-# LANGUAGE CPP, NoImplicitPrelude, MagicHash #-} +{-# OPTIONS_HADDOCK hide #-} + ----------------------------------------------------------------------------- -- | -- Module : GHC.Ptr @@ -14,9 +16,16 @@ -- ----------------------------------------------------------------------------- +-- #hide module GHC.Ptr where import GHC.Base +import GHC.Show +import GHC.Num +import GHC.List ( length, replicate ) +import Numeric ( showHex ) + +#include "MachDeps.h" ------------------------------------------------------------------------ -- Data pointers. @@ -55,7 +64,7 @@ alignPtr addr@(Ptr a) (I# i) 0# -> addr; n -> Ptr (plusAddr# a (i -# n)) } --- |Computes the offset required to get from the first to the second +-- |Computes the offset required to get from the second to the first -- argument. We have -- -- > p2 == p1 `plusPtr` (p2 `minusPtr` p1) @@ -71,7 +80,7 @@ data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- a function type with zero or more arguments where -- -- * the argument types are /marshallable foreign types/, --- i.e. 'Char', 'Int', 'Prelude.Double', 'Prelude.Float', +-- i.e. 'Char', 'Int', 'Double', 'Float', -- 'Bool', 'Data.Int.Int8', 'Data.Int.Int16', 'Data.Int.Int32', -- 'Data.Int.Int64', 'Data.Word.Word8', 'Data.Word.Word16', -- 'Data.Word.Word32', 'Data.Word.Word64', @'Ptr' a@, @'FunPtr' a@, @@ -79,7 +88,7 @@ data FunPtr a = FunPtr Addr# deriving (Eq, Ord) -- using @newtype@. -- -- * the return type is either a marshallable foreign type or has the form --- @'Prelude.IO' t@ where @t@ is a marshallable foreign type or @()@. +-- @'IO' t@ where @t@ is a marshallable foreign type or @()@. -- -- A value of type @'FunPtr' a@ may be a pointer to a foreign function, -- either returned by another foreign function or imported with a @@ -133,5 +142,19 @@ castFunPtrToPtr (FunPtr addr) = Ptr addr -- this assumption. castPtrToFunPtr :: Ptr a -> FunPtr b castPtrToFunPtr (Ptr addr) = FunPtr addr + + +------------------------------------------------------------------------ +-- Show instances for Ptr and FunPtr + +instance Show (Ptr a) where + showsPrec _ (Ptr a) rs = pad_out (showHex (wordToInteger(int2Word#(addr2Int# a))) "") + where + -- want 0s prefixed to pad it out to a fixed length. + pad_out ls = + '0':'x':(replicate (2*SIZEOF_HSPTR - length ls) '0') ++ ls ++ rs + +instance Show (FunPtr a) where + showsPrec p = showsPrec p . castFunPtrToPtr \end{code}