diff options
Diffstat (limited to 'packages')
-rw-r--r-- | packages/special/lib/Numeric/GSL/Special/Dilog.hs | 15 | ||||
-rw-r--r-- | packages/special/lib/Numeric/GSL/Special/Internal.hsc | 15 | ||||
-rw-r--r-- | packages/special/lib/Numeric/GSL/Special/auto.hs | 16 |
3 files changed, 36 insertions, 10 deletions
diff --git a/packages/special/lib/Numeric/GSL/Special/Dilog.hs b/packages/special/lib/Numeric/GSL/Special/Dilog.hs index 48b548b..6aa58c4 100644 --- a/packages/special/lib/Numeric/GSL/Special/Dilog.hs +++ b/packages/special/lib/Numeric/GSL/Special/Dilog.hs | |||
@@ -15,6 +15,9 @@ | |||
15 | module Numeric.GSL.Special.Dilog( | 15 | module Numeric.GSL.Special.Dilog( |
16 | dilog_e | 16 | dilog_e |
17 | , dilog | 17 | , dilog |
18 | , complex_dilog_xy_e | ||
19 | , complex_dilog_e | ||
20 | , complex_spence_xy_e | ||
18 | ) where | 21 | ) where |
19 | 22 | ||
20 | import Foreign(Ptr) | 23 | import Foreign(Ptr) |
@@ -29,14 +32,14 @@ dilog :: Double -> Double | |||
29 | dilog = gsl_sf_dilog | 32 | dilog = gsl_sf_dilog |
30 | foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double | 33 | foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double |
31 | 34 | ||
32 | complex_dilog_xy_e :: Double -> Double -> Ptr () -> (Double,Double) | 35 | complex_dilog_xy_e :: Double -> Double -> ((Double,Double),(Double,Double)) |
33 | complex_dilog_xy_e x y result_re = createSFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y result_re | 36 | complex_dilog_xy_e x y = create2SFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y |
34 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt | 37 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt |
35 | 38 | ||
36 | complex_dilog_e :: Double -> Double -> Ptr () -> (Double,Double) | 39 | complex_dilog_e :: Double -> Double -> ((Double,Double),(Double,Double)) |
37 | complex_dilog_e r theta result_re = createSFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta result_re | 40 | complex_dilog_e r theta = create2SFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta |
38 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt | 41 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt |
39 | 42 | ||
40 | complex_spence_xy_e :: Double -> Double -> Ptr () -> (Double,Double) | 43 | complex_spence_xy_e :: Double -> Double -> ((Double,Double),(Double,Double)) |
41 | complex_spence_xy_e x y real_sp = createSFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y real_sp | 44 | complex_spence_xy_e x y = create2SFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y |
42 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_spence_xy_e" gsl_sf_complex_spence_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt | 45 | foreign import ccall SAFE_CHEAP "gsl_sf_complex_spence_xy_e" gsl_sf_complex_spence_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt |
diff --git a/packages/special/lib/Numeric/GSL/Special/Internal.hsc b/packages/special/lib/Numeric/GSL/Special/Internal.hsc index 68ec2f2..d1a9c57 100644 --- a/packages/special/lib/Numeric/GSL/Special/Internal.hsc +++ b/packages/special/lib/Numeric/GSL/Special/Internal.hsc | |||
@@ -20,6 +20,7 @@ Support for Special functions. | |||
20 | 20 | ||
21 | module Numeric.GSL.Special.Internal ( | 21 | module Numeric.GSL.Special.Internal ( |
22 | createSFR, | 22 | createSFR, |
23 | create2SFR, | ||
23 | createSFR_E10, | 24 | createSFR_E10, |
24 | Precision(..), | 25 | Precision(..), |
25 | Gsl_mode_t, | 26 | Gsl_mode_t, |
@@ -79,7 +80,7 @@ instance Storable Gsl_sf_result_e10 where | |||
79 | 80 | ||
80 | 81 | ||
81 | ---------------------------------------------------------------- | 82 | ---------------------------------------------------------------- |
82 | -- | access to a sf_result | 83 | -- | access to one sf_result |
83 | createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double) | 84 | createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double) |
84 | createSFR s f = unsafePerformIO $ do | 85 | createSFR s f = unsafePerformIO $ do |
85 | p <- malloc :: IO (Ptr Gsl_sf_result) | 86 | p <- malloc :: IO (Ptr Gsl_sf_result) |
@@ -88,6 +89,18 @@ createSFR s f = unsafePerformIO $ do | |||
88 | free p | 89 | free p |
89 | return (val,err) | 90 | return (val,err) |
90 | 91 | ||
92 | ---------------------------------------------------------------- | ||
93 | -- | access to two sf_result | ||
94 | create2SFR :: String -> (Ptr a -> Ptr a -> IO CInt) -> ((Double, Double),(Double, Double)) | ||
95 | create2SFR s f = unsafePerformIO $ do | ||
96 | p1 <- malloc :: IO (Ptr Gsl_sf_result) | ||
97 | p2 <- malloc :: IO (Ptr Gsl_sf_result) | ||
98 | f (castPtr p1) (castPtr p2) // check s | ||
99 | SF val1 err1 <- peek p1 | ||
100 | SF val2 err2 <- peek p2 | ||
101 | free p1 | ||
102 | free p2 | ||
103 | return ((val1,err1),(val2,err2)) | ||
91 | 104 | ||
92 | --------------------------------------------------------------------- | 105 | --------------------------------------------------------------------- |
93 | -- the sf_result_e10 contains two doubles and the exponent | 106 | -- the sf_result_e10 contains two doubles and the exponent |
diff --git a/packages/special/lib/Numeric/GSL/Special/auto.hs b/packages/special/lib/Numeric/GSL/Special/auto.hs index b46e6c6..b6276b2 100644 --- a/packages/special/lib/Numeric/GSL/Special/auto.hs +++ b/packages/special/lib/Numeric/GSL/Special/auto.hs | |||
@@ -31,7 +31,8 @@ fixlong (x:xs) = x : fixlong xs | |||
31 | 31 | ||
32 | 32 | ||
33 | safe (Header _ _ args) = all ok args | 33 | safe (Header _ _ args) = all ok args |
34 | || all ok (init args) && kn (last args) | 34 | || all ok (init args) && kn (last args) |
35 | || length args >= 2 && all ok (init (init args)) && kn (last args) && kn (last (init args)) | ||
35 | where ok ((Normal s),_) | s `elem` ["double","float","int","gsl_mode_t"] = True | 36 | where ok ((Normal s),_) | s `elem` ["double","float","int","gsl_mode_t"] = True |
36 | ok _ = False | 37 | ok _ = False |
37 | kn ((Pointer "gsl_sf_result"),_) = True | 38 | kn ((Pointer "gsl_sf_result"),_) = True |
@@ -206,7 +207,9 @@ showFull hc h@(Header t n args) = -- "\n-- | wrapper for "++showC h | |||
206 | fixmd1 = rep ("Gsl_mode_t","Precision") | 207 | fixmd1 = rep ("Gsl_mode_t","Precision") |
207 | fixmd2 = rep ("mode"," (precCode mode)") | 208 | fixmd2 = rep ("mode"," (precCode mode)") |
208 | 209 | ||
209 | boiler h@(Header t n args) | fst (last args) == Pointer "gsl_sf_result" = boilerResult h | 210 | boiler h@(Header t n args) | fst (last args) == Pointer "gsl_sf_result" |
211 | && fst (last (init args)) == Pointer "gsl_sf_result" = boiler2Results h | ||
212 | | fst (last args) == Pointer "gsl_sf_result" = boilerResult h | ||
210 | | fst (last args) == Pointer "gsl_sf_result_e10" = boilerResultE10 h | 213 | | fst (last args) == Pointer "gsl_sf_result_e10" = boilerResultE10 h |
211 | | any isMode args = boilerMode h | 214 | | any isMode args = boilerMode h |
212 | | otherwise = boilerBasic h | 215 | | otherwise = boilerBasic h |
@@ -223,6 +226,11 @@ boilerResult h@(Header t n args) = | |||
223 | hName n ++ " "++ initArgs args ++ | 226 | hName n ++ " "++ initArgs args ++ |
224 | " = createSFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ initArgs args) | 227 | " = createSFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ initArgs args) |
225 | 228 | ||
229 | boiler2Results h@(Header t n args) = | ||
230 | hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init (init args))) ++" -> " ++ "((Double,Double),(Double,Double))\n" ++ | ||
231 | hName n ++ " "++ init2Args args ++ | ||
232 | " = create2SFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ init2Args args) | ||
233 | |||
226 | boilerResultE10 h@(Header t n args) = | 234 | boilerResultE10 h@(Header t n args) = |
227 | hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init args)) ++" -> " ++ "(Double,Int,Double)\n" ++ | 235 | hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init args)) ++" -> " ++ "(Double,Int,Double)\n" ++ |
228 | hName n ++ " "++ initArgs args ++ | 236 | hName n ++ " "++ initArgs args ++ |
@@ -241,4 +249,6 @@ cVar (v:vs) | isUpper v = toLower v : v : vs | |||
241 | | otherwise = v:vs | 249 | | otherwise = v:vs |
242 | 250 | ||
243 | allArgs args = unwords (map (cVar.snd) args) | 251 | allArgs args = unwords (map (cVar.snd) args) |
244 | initArgs args = unwords (map (cVar.snd) (init args)) \ No newline at end of file | 252 | initArgs args = unwords (map (cVar.snd) (init args)) |
253 | init2Args args = unwords (map (cVar.snd) (init $ init args)) | ||
254 | |||