summaryrefslogtreecommitdiff
path: root/packages/special
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2010-10-19 18:03:46 +0000
committerAlberto Ruiz <aruiz@um.es>2010-10-19 18:03:46 +0000
commitceb049de0898a2cc58fac8191a049e65bad7a2f6 (patch)
treede0444d67ed3ee0d2c6d825beaf7336f151111b1 /packages/special
parentbedc8781b1d4e1d684d2c259f3accf66e8c9c9cc (diff)
complex dilogarithm
Diffstat (limited to 'packages/special')
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Dilog.hs15
-rw-r--r--packages/special/lib/Numeric/GSL/Special/Internal.hsc15
-rw-r--r--packages/special/lib/Numeric/GSL/Special/auto.hs16
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 @@
15module Numeric.GSL.Special.Dilog( 15module 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
20import Foreign(Ptr) 23import Foreign(Ptr)
@@ -29,14 +32,14 @@ dilog :: Double -> Double
29dilog = gsl_sf_dilog 32dilog = gsl_sf_dilog
30foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double 33foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double
31 34
32complex_dilog_xy_e :: Double -> Double -> Ptr () -> (Double,Double) 35complex_dilog_xy_e :: Double -> Double -> ((Double,Double),(Double,Double))
33complex_dilog_xy_e x y result_re = createSFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y result_re 36complex_dilog_xy_e x y = create2SFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y
34foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 37foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt
35 38
36complex_dilog_e :: Double -> Double -> Ptr () -> (Double,Double) 39complex_dilog_e :: Double -> Double -> ((Double,Double),(Double,Double))
37complex_dilog_e r theta result_re = createSFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta result_re 40complex_dilog_e r theta = create2SFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta
38foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 41foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt
39 42
40complex_spence_xy_e :: Double -> Double -> Ptr () -> (Double,Double) 43complex_spence_xy_e :: Double -> Double -> ((Double,Double),(Double,Double))
41complex_spence_xy_e x y real_sp = createSFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y real_sp 44complex_spence_xy_e x y = create2SFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y
42foreign import ccall SAFE_CHEAP "gsl_sf_complex_spence_xy_e" gsl_sf_complex_spence_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt 45foreign 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
21module Numeric.GSL.Special.Internal ( 21module 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
83createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double) 84createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double)
84createSFR s f = unsafePerformIO $ do 85createSFR 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
94create2SFR :: String -> (Ptr a -> Ptr a -> IO CInt) -> ((Double, Double),(Double, Double))
95create2SFR 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
33safe (Header _ _ args) = all ok args 33safe (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
206fixmd1 = rep ("Gsl_mode_t","Precision") 207fixmd1 = rep ("Gsl_mode_t","Precision")
207fixmd2 = rep ("mode"," (precCode mode)") 208fixmd2 = rep ("mode"," (precCode mode)")
208 209
209boiler h@(Header t n args) | fst (last args) == Pointer "gsl_sf_result" = boilerResult h 210boiler 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
229boiler2Results 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
226boilerResultE10 h@(Header t n args) = 234boilerResultE10 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
243allArgs args = unwords (map (cVar.snd) args) 251allArgs args = unwords (map (cVar.snd) args)
244initArgs args = unwords (map (cVar.snd) (init args)) \ No newline at end of file 252initArgs args = unwords (map (cVar.snd) (init args))
253init2Args args = unwords (map (cVar.snd) (init $ init args))
254