complex dilogarithm

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 @@
 module Numeric.GSL.Special.Dilog(
   dilog_e
 , dilog
+, complex_dilog_xy_e
+, complex_dilog_e
+, complex_spence_xy_e
 ) where
 
 import Foreign(Ptr)
@@ -29,14 +32,14 @@ dilog :: Double -> Double
 dilog = gsl_sf_dilog
 foreign import ccall SAFE_CHEAP "gsl_sf_dilog" gsl_sf_dilog :: Double -> Double
 
-complex_dilog_xy_e :: Double -> Double -> Ptr () -> (Double,Double)
-complex_dilog_xy_e x y result_re = createSFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y result_re
+complex_dilog_xy_e :: Double -> Double -> ((Double,Double),(Double,Double))
+complex_dilog_xy_e x y = create2SFR "complex_dilog_xy_e" $ gsl_sf_complex_dilog_xy_e x y
 foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_xy_e" gsl_sf_complex_dilog_xy_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt
 
-complex_dilog_e :: Double -> Double -> Ptr () -> (Double,Double)
-complex_dilog_e r theta result_re = createSFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta result_re
+complex_dilog_e :: Double -> Double -> ((Double,Double),(Double,Double))
+complex_dilog_e r theta = create2SFR "complex_dilog_e" $ gsl_sf_complex_dilog_e r theta
 foreign import ccall SAFE_CHEAP "gsl_sf_complex_dilog_e" gsl_sf_complex_dilog_e :: Double -> Double -> Ptr () -> Ptr () -> IO CInt
 
-complex_spence_xy_e :: Double -> Double -> Ptr () -> (Double,Double)
-complex_spence_xy_e x y real_sp = createSFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y real_sp
+complex_spence_xy_e :: Double -> Double -> ((Double,Double),(Double,Double))
+complex_spence_xy_e x y = create2SFR "complex_spence_xy_e" $ gsl_sf_complex_spence_xy_e x y
 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.
 
 module Numeric.GSL.Special.Internal (
     createSFR,
+    create2SFR,
     createSFR_E10,
     Precision(..),
     Gsl_mode_t,
@@ -79,7 +80,7 @@ instance Storable Gsl_sf_result_e10 where
 
 
 ----------------------------------------------------------------
--- | access to a sf_result
+-- | access to one sf_result
 createSFR :: String -> (Ptr a -> IO CInt) -> (Double, Double)
 createSFR s f = unsafePerformIO $ do
     p <- malloc :: IO (Ptr Gsl_sf_result)
@@ -88,6 +89,18 @@ createSFR s f = unsafePerformIO $ do
     free p
     return (val,err)
 
+----------------------------------------------------------------
+-- | access to two sf_result 
+create2SFR :: String -> (Ptr a -> Ptr a -> IO CInt) -> ((Double, Double),(Double, Double))
+create2SFR s f = unsafePerformIO $ do
+    p1 <- malloc :: IO (Ptr Gsl_sf_result)
+    p2 <- malloc :: IO (Ptr Gsl_sf_result)
+    f (castPtr p1) (castPtr p2) // check s
+    SF val1 err1 <- peek p1
+    SF val2 err2 <- peek p2
+    free p1
+    free p2
+    return ((val1,err1),(val2,err2))
 
 ---------------------------------------------------------------------
 -- 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
 
 
 safe (Header _ _ args) =  all ok args 
-                         || all ok (init args) && kn (last args)
+                       || all ok (init args) && kn (last args)
+                       || length args >= 2 && all ok (init (init args)) && kn (last args) && kn (last (init args))
     where ok ((Normal s),_) | s `elem` ["double","float","int","gsl_mode_t"] = True
           ok _ = False
           kn ((Pointer "gsl_sf_result"),_) = True
@@ -206,7 +207,9 @@ showFull hc h@(Header t n args) = -- "\n-- | wrapper for "++showC h
 fixmd1 = rep ("Gsl_mode_t","Precision")
 fixmd2 = rep ("mode"," (precCode mode)")
 
-boiler h@(Header t n args) | fst (last args) == Pointer "gsl_sf_result" = boilerResult h
+boiler h@(Header t n args) |    fst (last args)        == Pointer "gsl_sf_result" 
+                             && fst (last (init args)) == Pointer "gsl_sf_result" = boiler2Results h
+                           | fst (last args) == Pointer "gsl_sf_result" = boilerResult h
                            | fst (last args) == Pointer "gsl_sf_result_e10" = boilerResultE10 h
                            | any isMode args = boilerMode h
                            | otherwise = boilerBasic h
@@ -223,6 +226,11 @@ boilerResult h@(Header t n args) =
      hName n ++ " "++ initArgs args ++
        " = createSFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ initArgs args)
 
+boiler2Results h@(Header t n args) =
+    hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init (init args))) ++" -> " ++ "((Double,Double),(Double,Double))\n" ++
+     hName n ++ " "++ init2Args args ++
+       " = create2SFR \""++ hName n ++"\" $ " ++ n ++ " "++ (fixmd2 $ init2Args args)
+
 boilerResultE10 h@(Header t n args) =
     hName n++" :: "++ (fixmd1 $ concat $ intersperse" -> "$ map showHa (init args)) ++" -> " ++ "(Double,Int,Double)\n" ++
      hName n ++ " "++ initArgs args ++
@@ -241,4 +249,6 @@ cVar (v:vs) | isUpper v = toLower v : v : vs
             | otherwise = v:vs
 
 allArgs args =  unwords (map (cVar.snd) args)
-initArgs args = unwords (map (cVar.snd) (init args))
\ No newline at end of file
+initArgs args = unwords (map (cVar.snd) (init args))
+init2Args args = unwords (map (cVar.snd) (init $ init args))
+