| Safe Haskell | None |
|---|---|
| Language | Haskell98 |
Data.Number.MPFR.Internal
- module Data.Number.MPFR.FFIhelper
- withMPFRsBA :: RoundMode -> Precision -> MPFR -> MPFR -> (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBAui :: RoundMode -> Precision -> MPFR -> CULong -> (Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBAiu :: RoundMode -> Precision -> CULong -> MPFR -> (Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBAd :: RoundMode -> Precision -> MPFR -> CDouble -> (Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBAsi :: RoundMode -> Precision -> MPFR -> CLong -> (Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBAis :: RoundMode -> Precision -> CLong -> MPFR -> (Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBAd' :: RoundMode -> Precision -> CDouble -> MPFR -> (Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRB :: MPFR -> (Ptr MPFR -> IO CInt) -> CInt
- withMPFRP :: MPFR -> (Ptr MPFR -> IO CPrecision) -> CPrecision
- withMPFR :: RoundMode -> Precision -> MPFR -> (Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRBB :: MPFR -> MPFR -> (Ptr MPFR -> Ptr MPFR -> IO CInt) -> CInt
- withMPFRC :: RoundMode -> Precision -> (Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRF :: MPFR -> RoundMode -> (Ptr MPFR -> CRoundMode -> IO CInt) -> Int
- withMPFRUI :: RoundMode -> Precision -> Word -> (Ptr MPFR -> CULong -> CRoundMode -> IO CInt) -> (MPFR, Int)
- withMPFRR :: Precision -> MPFR -> (Ptr MPFR -> Ptr MPFR -> IO CInt) -> (MPFR, Int)
- checkPrec :: Precision -> Precision
- getMantissa' :: MPFR -> [Limb]
- unsafePerformIO :: IO a -> a
- peek :: Storable a => Ptr a -> IO a
- data Ptr a :: * -> *
- nullPtr :: Ptr a
- mallocForeignPtrBytes :: Int -> IO (ForeignPtr a)
- with :: Storable a => a -> (Ptr a -> IO b) -> IO b
- withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b
- data CInt :: *
- data CLong :: *
- data CULong :: *
- withCString :: String -> (CString -> IO a) -> IO a
- peekCString :: CString -> IO String
- alloca :: Storable a => (Ptr a -> IO b) -> IO b
- peekArray :: Storable a => Int -> Ptr a -> IO [a]
- shiftL :: Bits a => a -> Int -> a
- data Word :: *
- minPrec :: Precision
Documentation
module Data.Number.MPFR.FFIhelper
withMPFRsBA :: RoundMode -> Precision -> MPFR -> MPFR -> (Ptr MPFR -> Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRBAui :: RoundMode -> Precision -> MPFR -> CULong -> (Ptr MPFR -> Ptr MPFR -> CULong -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRBAiu :: RoundMode -> Precision -> CULong -> MPFR -> (Ptr MPFR -> CULong -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRBAd :: RoundMode -> Precision -> MPFR -> CDouble -> (Ptr MPFR -> Ptr MPFR -> CDouble -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRBAsi :: RoundMode -> Precision -> MPFR -> CLong -> (Ptr MPFR -> Ptr MPFR -> CLong -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRBAis :: RoundMode -> Precision -> CLong -> MPFR -> (Ptr MPFR -> CLong -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRBAd' :: RoundMode -> Precision -> CDouble -> MPFR -> (Ptr MPFR -> CDouble -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRP :: MPFR -> (Ptr MPFR -> IO CPrecision) -> CPrecision Source #
withMPFR :: RoundMode -> Precision -> MPFR -> (Ptr MPFR -> Ptr MPFR -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
withMPFRUI :: RoundMode -> Precision -> Word -> (Ptr MPFR -> CULong -> CRoundMode -> IO CInt) -> (MPFR, Int) Source #
getMantissa' :: MPFR -> [Limb] Source #
unsafePerformIO :: IO a -> a #
This is the "back door" into the IO monad, allowing
IO computation to be performed at any time. For
this to be safe, the IO computation should be
free of side effects and independent of its environment.
If the I/O computation wrapped in unsafePerformIO performs side
effects, then the relative order in which those side effects take
place (relative to the main I/O trunk, or other calls to
unsafePerformIO) is indeterminate. Furthermore, when using
unsafePerformIO to cause side-effects, you should take the following
precautions to ensure the side effects are performed as many times as
you expect them to be. Note that these precautions are necessary for
GHC, but may not be sufficient, and other compilers may require
different precautions:
- Use
{-# NOINLINE foo #-}as a pragma on any functionfoothat callsunsafePerformIO. If the call is inlined, the I/O may be performed more than once. - Use the compiler flag
-fno-cseto prevent common sub-expression elimination being performed on the module, which might combine two side effects that were meant to be separate. A good example is using multiple global variables (liketestin the example below). - Make sure that the either you switch off let-floating (
-fno-full-laziness), or that the call tounsafePerformIOcannot float outside a lambda. For example, if you say:f x = unsafePerformIO (newIORef [])you may get only one reference cell shared between all calls tof. Better would bef x = unsafePerformIO (newIORef [x])because now it can't float outside the lambda.
It is less well known that
unsafePerformIO is not type safe. For example:
test :: IORef [a]
test = unsafePerformIO $ newIORef []
main = do
writeIORef test [42]
bang <- readIORef test
print (bang :: [Char])This program will core dump. This problem with polymorphic references
is well known in the ML community, and does not arise with normal
monadic use of references. There is no easy way to make it impossible
once you use unsafePerformIO. Indeed, it is
possible to write coerce :: a -> b with the
help of unsafePerformIO. So be careful!
peek :: Storable a => Ptr a -> IO a #
Read a value from the given memory location.
Note that the peek and poke functions might require properly
aligned addresses to function correctly. This is architecture
dependent; thus, portable code should ensure that when peeking or
poking values of some type a, the alignment
constraint for a, as given by the function
alignment is fulfilled.
A value of type represents a pointer to an object, or an
array of objects, which may be marshalled to or from Haskell values
of type Ptr aa.
The type a will often be an instance of class
Storable which provides the marshalling operations.
However this is not essential, and you can provide your own operations
to access the pointer. For example you might write small foreign
functions to get or set the fields of a C struct.
Instances
| Generic1 k (URec k (Ptr ())) | |
| Eq (Ptr a) | |
| Ord (Ptr a) | |
| Show (Ptr a) | Since: 2.1 |
| Storable (Ptr a) | Since: 2.1 |
| Functor (URec * (Ptr ())) | |
| Foldable (URec * (Ptr ())) | |
| Eq (URec k (Ptr ()) p) | |
| Ord (URec k (Ptr ()) p) | |
| Generic (URec k (Ptr ()) p) | |
| data URec k (Ptr ()) | Used for marking occurrences of Since: 4.9.0.0 |
| type Rep1 k (URec k (Ptr ())) | |
| type Rep (URec k (Ptr ()) p) | |
mallocForeignPtrBytes :: Int -> IO (ForeignPtr a) #
This function is similar to mallocForeignPtr, except that the
size of the memory required is given explicitly as a number of bytes.
with :: Storable a => a -> (Ptr a -> IO b) -> IO b #
executes the computation with val ff, passing as argument
a pointer to a temporarily allocated block of memory into which
val has been marshalled (the combination of alloca and poke).
The memory is freed when f terminates (either normally or via an
exception), so the pointer passed to f must not be used after this.
withForeignPtr :: ForeignPtr a -> (Ptr a -> IO b) -> IO b #
This is a way to look at the pointer living inside a
foreign object. This function takes a function which is
applied to that pointer. The resulting IO action is then
executed. The foreign object is kept alive at least during
the whole action, even if it is not used directly
inside. Note that it is not safe to return the pointer from
the action and use it after the action completes. All uses
of the pointer should be inside the
withForeignPtr bracket. The reason for
this unsafeness is the same as for
unsafeForeignPtrToPtr below: the finalizer
may run earlier than expected, because the compiler can only
track usage of the ForeignPtr object, not
a Ptr object made from it.
This function is normally used for marshalling data to
or from the object pointed to by the
ForeignPtr, using the operations from the
Storable class.
Haskell type representing the C int type.
Haskell type representing the C long type.
Haskell type representing the C unsigned long type.
withCString :: String -> (CString -> IO a) -> IO a #
Marshal a Haskell string into a NUL terminated C string using temporary storage.
- the Haskell string may not contain any NUL characters
- the memory is freed when the subcomputation terminates (either normally or via an exception), so the pointer to the temporary storage must not be used after this.
peekCString :: CString -> IO String #
Marshal a NUL terminated C string into a Haskell string.
alloca :: Storable a => (Ptr a -> IO b) -> IO b #
executes the computation alloca ff, passing as argument
a pointer to a temporarily allocated block of memory sufficient to
hold values of type a.
The memory is freed when f terminates (either normally or via an
exception), so the pointer passed to f must not be used after this.
peekArray :: Storable a => Int -> Ptr a -> IO [a] #
Convert an array of given length into a Haskell list. The implementation is tail-recursive and so uses constant stack space.
Instances
| Bounded Word | Since: 2.1 |
| Enum Word | Since: 2.1 |
| Eq Word | |
| Integral Word | Since: 2.1 |
| Num Word | Since: 2.1 |
| Ord Word | |
| Read Word | Since: 4.5.0.0 |
| Real Word | Since: 2.1 |
| Show Word | Since: 2.1 |
| Storable Word | Since: 2.1 |
| Bits Word | Since: 2.1 |
| FiniteBits Word | Since: 4.6.0.0 |
| Generic1 k (URec k Word) | |
| Functor (URec * Word) | |
| Foldable (URec * Word) | |
| Eq (URec k Word p) | |
| Ord (URec k Word p) | |
| Show (URec k Word p) | |
| Generic (URec k Word p) | |
| data URec k Word | Used for marking occurrences of Since: 4.9.0.0 |
| type Rep1 k (URec k Word) | |
| type Rep (URec k Word p) | |