diff options
-rw-r--r-- | lib/Numeric/GSL/Special/Internal.hs | 68 | ||||
-rw-r--r-- | lib/Numeric/GSL/Special/Internal.hsc | 102 |
2 files changed, 102 insertions, 68 deletions
diff --git a/lib/Numeric/GSL/Special/Internal.hs b/lib/Numeric/GSL/Special/Internal.hs deleted file mode 100644 index ca36009..0000000 --- a/lib/Numeric/GSL/Special/Internal.hs +++ /dev/null | |||
@@ -1,68 +0,0 @@ | |||
1 | {-# OPTIONS #-} | ||
2 | ----------------------------------------------------------------------------- | ||
3 | {- | | ||
4 | Module : Numeric.GSL.Special.Internal | ||
5 | Copyright : (c) Alberto Ruiz 2007 | ||
6 | License : GPL-style | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | Portability : uses ffi | ||
11 | |||
12 | Support for Special functions. | ||
13 | |||
14 | <http://www.gnu.org/software/gsl/manual/html_node/Special-Functions.html#Special-Functions> | ||
15 | -} | ||
16 | ----------------------------------------------------------------------------- | ||
17 | |||
18 | module Numeric.GSL.Special.Internal ( | ||
19 | createSFR, | ||
20 | createSFR_E10, | ||
21 | Precision(..), | ||
22 | Gsl_mode_t, | ||
23 | Size_t, | ||
24 | precCode | ||
25 | ) | ||
26 | where | ||
27 | |||
28 | import Foreign | ||
29 | import Data.Packed.Internal(check,(//)) | ||
30 | |||
31 | |||
32 | data Precision = PrecDouble | PrecSingle | PrecApprox | ||
33 | |||
34 | precCode :: Precision -> Int | ||
35 | precCode PrecDouble = 0 | ||
36 | precCode PrecSingle = 1 | ||
37 | precCode PrecApprox = 2 | ||
38 | |||
39 | type Gsl_mode_t = Int | ||
40 | |||
41 | type Size_t = Int | ||
42 | |||
43 | ---------------------------------------------------------------- | ||
44 | -- | access to a sf_result | ||
45 | createSFR :: Storable a => String -> (Ptr a -> IO Int) -> (a, a) | ||
46 | createSFR s f = unsafePerformIO $ do | ||
47 | p <- mallocArray 2 | ||
48 | f p // check s | ||
49 | [val,err] <- peekArray 2 p | ||
50 | free p | ||
51 | return (val,err) | ||
52 | |||
53 | |||
54 | --------------------------------------------------------------------- | ||
55 | -- the sf_result_e10 contains two doubles and the exponent | ||
56 | |||
57 | -- | acces to sf_result_e10 | ||
58 | createSFR_E10 :: (Storable t2, Storable t3, Storable t1) => String -> (Ptr a -> IO Int) -> (t1, t2, t3) | ||
59 | createSFR_E10 s f = unsafePerformIO $ do | ||
60 | let sd = sizeOf (0::Double) | ||
61 | let si = sizeOf (0::Int) | ||
62 | p <- mallocBytes (2*sd + si) | ||
63 | f p // check s | ||
64 | val <- peekByteOff p 0 | ||
65 | err <- peekByteOff p sd | ||
66 | expo <- peekByteOff p (2*sd) | ||
67 | free p | ||
68 | return (val,expo,err) | ||
diff --git a/lib/Numeric/GSL/Special/Internal.hsc b/lib/Numeric/GSL/Special/Internal.hsc new file mode 100644 index 0000000..03a431c --- /dev/null +++ b/lib/Numeric/GSL/Special/Internal.hsc | |||
@@ -0,0 +1,102 @@ | |||
1 | {-# OPTIONS -ffi #-} | ||
2 | ----------------------------------------------------------------------------- | ||
3 | {- | | ||
4 | Module : Numeric.GSL.Special.Internal | ||
5 | Copyright : (c) Alberto Ruiz 2007 | ||
6 | License : GPL-style | ||
7 | |||
8 | Maintainer : Alberto Ruiz (aruiz at um dot es) | ||
9 | Stability : provisional | ||
10 | Portability : uses ffi | ||
11 | |||
12 | Support for Special functions. | ||
13 | |||
14 | <http://www.gnu.org/software/gsl/manual/html_node/Special-Functions.html#Special-Functions> | ||
15 | -} | ||
16 | ----------------------------------------------------------------------------- | ||
17 | |||
18 | #include <gsl/gsl_sf_result.h> | ||
19 | #let alignment t = "%lu", (unsigned long)offsetof(struct {char x__; t (y__); }, y__) | ||
20 | |||
21 | module Numeric.GSL.Special.Internal ( | ||
22 | createSFR, | ||
23 | createSFR_E10, | ||
24 | Precision(..), | ||
25 | Gsl_mode_t, | ||
26 | Size_t, | ||
27 | precCode | ||
28 | ) | ||
29 | where | ||
30 | |||
31 | import Foreign | ||
32 | import Data.Packed.Internal(check,(//)) | ||
33 | import Foreign.C.Types(CSize) | ||
34 | |||
35 | |||
36 | data Precision = PrecDouble | PrecSingle | PrecApprox | ||
37 | |||
38 | precCode :: Precision -> Int | ||
39 | precCode PrecDouble = 0 | ||
40 | precCode PrecSingle = 1 | ||
41 | precCode PrecApprox = 2 | ||
42 | |||
43 | type Gsl_mode_t = Int | ||
44 | |||
45 | type Size_t = CSize | ||
46 | |||
47 | --------------------------------------------------- | ||
48 | |||
49 | data Gsl_sf_result = SF Double Double | ||
50 | deriving (Show) | ||
51 | |||
52 | instance Storable Gsl_sf_result where | ||
53 | sizeOf _ = #size gsl_sf_result | ||
54 | alignment _ = #alignment gsl_sf_result | ||
55 | peek ptr = do | ||
56 | val <- (#peek gsl_sf_result, val) ptr | ||
57 | err <- (#peek gsl_sf_result, err) ptr | ||
58 | return (SF val err) | ||
59 | poke ptr (SF val err) = do | ||
60 | (#poke gsl_sf_result, val) ptr val | ||
61 | (#poke gsl_sf_result, err) ptr err | ||
62 | |||
63 | |||
64 | data Gsl_sf_result_e10 = SFE Double Double Int | ||
65 | deriving (Show) | ||
66 | |||
67 | instance Storable Gsl_sf_result_e10 where | ||
68 | sizeOf _ = #size gsl_sf_result_e10 | ||
69 | alignment _ = #alignment gsl_sf_result_e10 | ||
70 | peek ptr = do | ||
71 | val <- (#peek gsl_sf_result_e10, val) ptr | ||
72 | err <- (#peek gsl_sf_result_e10, err) ptr | ||
73 | e10 <- (#peek gsl_sf_result_e10, e10) ptr | ||
74 | return (SFE val err e10) | ||
75 | poke ptr (SFE val err e10) = do | ||
76 | (#poke gsl_sf_result_e10, val) ptr val | ||
77 | (#poke gsl_sf_result_e10, err) ptr err | ||
78 | (#poke gsl_sf_result_e10, e10) ptr e10 | ||
79 | |||
80 | |||
81 | ---------------------------------------------------------------- | ||
82 | -- | access to a sf_result | ||
83 | createSFR :: String -> (Ptr a -> IO Int) -> (Double, Double) | ||
84 | createSFR s f = unsafePerformIO $ do | ||
85 | p <- malloc :: IO (Ptr Gsl_sf_result) | ||
86 | f (castPtr p) // check s | ||
87 | SF val err <- peek p | ||
88 | free p | ||
89 | return (val,err) | ||
90 | |||
91 | |||
92 | --------------------------------------------------------------------- | ||
93 | -- the sf_result_e10 contains two doubles and the exponent | ||
94 | |||
95 | -- | access to sf_result_e10 | ||
96 | createSFR_E10 :: String -> (Ptr a -> IO Int) -> (Double, Int, Double) | ||
97 | createSFR_E10 s f = unsafePerformIO $ do | ||
98 | p <- malloc :: IO (Ptr Gsl_sf_result_e10) | ||
99 | f (castPtr p) // check s | ||
100 | SFE val err expo <- peek p | ||
101 | free p | ||
102 | return (val,expo,err) | ||