summaryrefslogtreecommitdiff
path: root/packages/gsl/src
diff options
context:
space:
mode:
authorAlberto Ruiz <aruiz@um.es>2015-06-19 13:55:39 +0200
committerAlberto Ruiz <aruiz@um.es>2015-06-19 13:55:39 +0200
commitdb50bc11dafa6834a4367427156306674063ed6b (patch)
tree721e9d0235168be1d0ebb2bd1dd254a66251f274 /packages/gsl/src
parent7f9c7b5adf8f05653d15f19358f41c1916e8db70 (diff)
removed the annoying appN adapter for the foreign functions.
replaced by several overloaded app variants in the style of the module Internal.Foreign contributed by Mike Ledger.
Diffstat (limited to 'packages/gsl/src')
-rw-r--r--packages/gsl/src/Numeric/GSL/Fitting.hs2
-rw-r--r--packages/gsl/src/Numeric/GSL/Fourier.hs5
-rw-r--r--packages/gsl/src/Numeric/GSL/Internal.hs20
-rw-r--r--packages/gsl/src/Numeric/GSL/LinearAlgebra.hs12
-rw-r--r--packages/gsl/src/Numeric/GSL/Minimization.hs2
-rw-r--r--packages/gsl/src/Numeric/GSL/Polynomials.hs2
-rw-r--r--packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs1
-rw-r--r--packages/gsl/src/Numeric/GSL/Vector.hs12
8 files changed, 35 insertions, 21 deletions
diff --git a/packages/gsl/src/Numeric/GSL/Fitting.hs b/packages/gsl/src/Numeric/GSL/Fitting.hs
index db9d82f..8eb93a7 100644
--- a/packages/gsl/src/Numeric/GSL/Fitting.hs
+++ b/packages/gsl/src/Numeric/GSL/Fitting.hs
@@ -87,7 +87,7 @@ nlFitGen m f jac xiv epsabs epsrel maxit = unsafePerformIO $ do
87 fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) 87 fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f))
88 jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) 88 jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac))
89 rawpath <- createMatrix RowMajor maxit (2+p) 89 rawpath <- createMatrix RowMajor maxit (2+p)
90 app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" 90 c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n) # xiv # rawpath #|"c_nlfit"
91 let it = round (rawpath `atIndex` (maxit-1,0)) 91 let it = round (rawpath `atIndex` (maxit-1,0))
92 path = takeRows it rawpath 92 path = takeRows it rawpath
93 [sol] = toRows $ dropRows (it-1) path 93 [sol] = toRows $ dropRows (it-1) path
diff --git a/packages/gsl/src/Numeric/GSL/Fourier.hs b/packages/gsl/src/Numeric/GSL/Fourier.hs
index d824b4f..1c2c053 100644
--- a/packages/gsl/src/Numeric/GSL/Fourier.hs
+++ b/packages/gsl/src/Numeric/GSL/Fourier.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE TypeFamilies #-}
2
1{- | 3{- |
2Module : Numeric.GSL.Fourier 4Module : Numeric.GSL.Fourier
3Copyright : (c) Alberto Ruiz 2006 5Copyright : (c) Alberto Ruiz 2006
@@ -23,7 +25,7 @@ import System.IO.Unsafe (unsafePerformIO)
23 25
24genfft code v = unsafePerformIO $ do 26genfft code v = unsafePerformIO $ do
25 r <- createVector (size v) 27 r <- createVector (size v)
26 app2 (c_fft code) vec v vec r "fft" 28 c_fft code # v # r #|"fft"
27 return r 29 return r
28 30
29foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) 31foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res)
@@ -41,3 +43,4 @@ fft = genfft 0
41-- | The inverse of 'fft', using /gsl_fft_complex_inverse/. 43-- | The inverse of 'fft', using /gsl_fft_complex_inverse/.
42ifft :: Vector (Complex Double) -> Vector (Complex Double) 44ifft :: Vector (Complex Double) -> Vector (Complex Double)
43ifft = genfft 1 45ifft = genfft 1
46
diff --git a/packages/gsl/src/Numeric/GSL/Internal.hs b/packages/gsl/src/Numeric/GSL/Internal.hs
index a269224..dcd3bc4 100644
--- a/packages/gsl/src/Numeric/GSL/Internal.hs
+++ b/packages/gsl/src/Numeric/GSL/Internal.hs
@@ -23,7 +23,7 @@ module Numeric.GSL.Internal(
23 createV, 23 createV,
24 createMIO, 24 createMIO,
25 module Numeric.LinearAlgebra.Devel, 25 module Numeric.LinearAlgebra.Devel,
26 check, 26 check,(#),vec, ww2,
27 Res,TV,TM,TCV,TCM 27 Res,TV,TM,TCV,TCM
28) where 28) where
29 29
@@ -35,7 +35,7 @@ import Foreign.Ptr(Ptr, FunPtr)
35import Foreign.C.Types 35import Foreign.C.Types
36import Foreign.C.String(peekCString) 36import Foreign.C.String(peekCString)
37import System.IO.Unsafe(unsafePerformIO) 37import System.IO.Unsafe(unsafePerformIO)
38import Data.Vector.Storable(unsafeWith) 38import Data.Vector.Storable as V (unsafeWith,length)
39import Control.Monad(when) 39import Control.Monad(when)
40 40
41iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) 41iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double)
@@ -86,12 +86,12 @@ aux_vTom f n p rr cr r = g where
86 86
87createV n fun msg = unsafePerformIO $ do 87createV n fun msg = unsafePerformIO $ do
88 r <- createVector n 88 r <- createVector n
89 app1 fun vec r msg 89 fun # r #| msg
90 return r 90 return r
91 91
92createMIO r c fun msg = do 92createMIO r c fun msg = do
93 res <- createMatrix RowMajor r c 93 res <- createMatrix RowMajor r c
94 app1 fun mat res msg 94 fun # res #| msg
95 return res 95 return res
96 96
97-------------------------------------------------------------------------------- 97--------------------------------------------------------------------------------
@@ -123,3 +123,15 @@ type TCM x = CInt -> CInt -> PC -> x
123type TVV = TV (TV Res) 123type TVV = TV (TV Res)
124type TVM = TV (TM Res) 124type TVM = TV (TM Res)
125 125
126ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2
127
128vec x f = unsafeWith x $ \p -> do
129 let v g = do
130 g (fi $ V.length x) p
131 f v
132{-# INLINE vec #-}
133
134infixl 1 #
135a # b = applyRaw a b
136{-# INLINE (#) #-}
137
diff --git a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs
index cb78bf4..6ffe306 100644
--- a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs
+++ b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs
@@ -40,7 +40,7 @@ randomVector :: Int -- ^ seed
40 -> Vector Double 40 -> Vector Double
41randomVector seed dist n = unsafePerformIO $ do 41randomVector seed dist n = unsafePerformIO $ do
42 r <- createVector n 42 r <- createVector n
43 app1 (c_random_vector (fi seed) ((fi.fromEnum) dist)) vec r "randomVector" 43 c_random_vector (fi seed) ((fi.fromEnum) dist) # r #|"randomVector"
44 return r 44 return r
45 45
46foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV 46foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV
@@ -56,7 +56,7 @@ saveMatrix filename fmt m = do
56 charname <- newCString filename 56 charname <- newCString filename
57 charfmt <- newCString fmt 57 charfmt <- newCString fmt
58 let o = if orderOf m == RowMajor then 1 else 0 58 let o = if orderOf m == RowMajor then 1 else 0
59 app1 (matrix_fprintf charname charfmt o) mat m "matrix_fprintf" 59 matrix_fprintf charname charfmt o # m #|"matrix_fprintf"
60 free charname 60 free charname
61 free charfmt 61 free charfmt
62 62
@@ -69,7 +69,7 @@ fscanfVector :: FilePath -> Int -> IO (Vector Double)
69fscanfVector filename n = do 69fscanfVector filename n = do
70 charname <- newCString filename 70 charname <- newCString filename
71 res <- createVector n 71 res <- createVector n
72 app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" 72 gsl_vector_fscanf charname # res #|"gsl_vector_fscanf"
73 free charname 73 free charname
74 return res 74 return res
75 75
@@ -80,7 +80,7 @@ fprintfVector :: FilePath -> String -> Vector Double -> IO ()
80fprintfVector filename fmt v = do 80fprintfVector filename fmt v = do
81 charname <- newCString filename 81 charname <- newCString filename
82 charfmt <- newCString fmt 82 charfmt <- newCString fmt
83 app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" 83 gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf"
84 free charname 84 free charname
85 free charfmt 85 free charfmt
86 86
@@ -91,7 +91,7 @@ freadVector :: FilePath -> Int -> IO (Vector Double)
91freadVector filename n = do 91freadVector filename n = do
92 charname <- newCString filename 92 charname <- newCString filename
93 res <- createVector n 93 res <- createVector n
94 app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" 94 gsl_vector_fread charname # res #| "gsl_vector_fread"
95 free charname 95 free charname
96 return res 96 return res
97 97
@@ -101,7 +101,7 @@ foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV
101fwriteVector :: FilePath -> Vector Double -> IO () 101fwriteVector :: FilePath -> Vector Double -> IO ()
102fwriteVector filename v = do 102fwriteVector filename v = do
103 charname <- newCString filename 103 charname <- newCString filename
104 app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" 104 gsl_vector_fwrite charname # v #|"gsl_vector_fwrite"
105 free charname 105 free charname
106 106
107foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV 107foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV
diff --git a/packages/gsl/src/Numeric/GSL/Minimization.hs b/packages/gsl/src/Numeric/GSL/Minimization.hs
index 00e0619..a0e5306 100644
--- a/packages/gsl/src/Numeric/GSL/Minimization.hs
+++ b/packages/gsl/src/Numeric/GSL/Minimization.hs
@@ -137,7 +137,7 @@ minimizeV :: MinimizeMethod
137minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList sz) (f.toList) (fromList xi) 137minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList sz) (f.toList) (fromList xi)
138 where v2l (v,m) = (toList v, m) 138 where v2l (v,m) = (toList v, m)
139 139
140ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 140
141 141
142minimizeV method eps maxit szv f xiv = unsafePerformIO $ do 142minimizeV method eps maxit szv f xiv = unsafePerformIO $ do
143 let n = size xiv 143 let n = size xiv
diff --git a/packages/gsl/src/Numeric/GSL/Polynomials.hs b/packages/gsl/src/Numeric/GSL/Polynomials.hs
index 246e301..8890f8f 100644
--- a/packages/gsl/src/Numeric/GSL/Polynomials.hs
+++ b/packages/gsl/src/Numeric/GSL/Polynomials.hs
@@ -48,7 +48,7 @@ polySolve = toList . polySolve' . fromList
48polySolve' :: Vector Double -> Vector (Complex Double) 48polySolve' :: Vector Double -> Vector (Complex Double)
49polySolve' v | size v > 1 = unsafePerformIO $ do 49polySolve' v | size v > 1 = unsafePerformIO $ do
50 r <- createVector (size v-1) 50 r <- createVector (size v-1)
51 app2 c_polySolve vec v vec r "polySolve" 51 c_polySolve # v # r #| "polySolve"
52 return r 52 return r
53 | otherwise = error "polySolve on a polynomial of degree zero" 53 | otherwise = error "polySolve on a polynomial of degree zero"
54 54
diff --git a/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs b/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs
index 9f9ed97..11b22d3 100644
--- a/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs
+++ b/packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs
@@ -55,7 +55,6 @@ import Foreign.Ptr(Ptr, FunPtr, nullFunPtr)
55import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr) 55import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr)
56import Foreign.C.Types 56import Foreign.C.Types
57import System.IO.Unsafe(unsafePerformIO) 57import System.IO.Unsafe(unsafePerformIO)
58import Control.Applicative ((<*>), (<$>))
59 58
60import System.IO (hFlush, stdout) 59import System.IO (hFlush, stdout)
61 60
diff --git a/packages/gsl/src/Numeric/GSL/Vector.hs b/packages/gsl/src/Numeric/GSL/Vector.hs
index 0cd99eb..fb982c5 100644
--- a/packages/gsl/src/Numeric/GSL/Vector.hs
+++ b/packages/gsl/src/Numeric/GSL/Vector.hs
@@ -34,7 +34,7 @@ randomVector :: Int -- ^ seed
34 -> Vector Double 34 -> Vector Double
35randomVector seed dist n = unsafePerformIO $ do 35randomVector seed dist n = unsafePerformIO $ do
36 r <- createVector n 36 r <- createVector n
37 app1 (c_random_vector_GSL (fi seed) ((fi.fromEnum) dist)) vec r "randomVectorGSL" 37 c_random_vector_GSL (fi seed) ((fi.fromEnum) dist) # r #|"randomVectorGSL"
38 return r 38 return r
39 39
40foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV 40foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV
@@ -50,7 +50,7 @@ saveMatrix filename fmt m = do
50 charname <- newCString filename 50 charname <- newCString filename
51 charfmt <- newCString fmt 51 charfmt <- newCString fmt
52 let o = if orderOf m == RowMajor then 1 else 0 52 let o = if orderOf m == RowMajor then 1 else 0
53 app1 (matrix_fprintf charname charfmt o) mat m "matrix_fprintf" 53 matrix_fprintf charname charfmt o # m #|"matrix_fprintf"
54 free charname 54 free charname
55 free charfmt 55 free charfmt
56 56
@@ -63,7 +63,7 @@ fscanfVector :: FilePath -> Int -> IO (Vector Double)
63fscanfVector filename n = do 63fscanfVector filename n = do
64 charname <- newCString filename 64 charname <- newCString filename
65 res <- createVector n 65 res <- createVector n
66 app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" 66 gsl_vector_fscanf charname # res #|"gsl_vector_fscanf"
67 free charname 67 free charname
68 return res 68 return res
69 69
@@ -74,7 +74,7 @@ fprintfVector :: FilePath -> String -> Vector Double -> IO ()
74fprintfVector filename fmt v = do 74fprintfVector filename fmt v = do
75 charname <- newCString filename 75 charname <- newCString filename
76 charfmt <- newCString fmt 76 charfmt <- newCString fmt
77 app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" 77 gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf"
78 free charname 78 free charname
79 free charfmt 79 free charfmt
80 80
@@ -85,7 +85,7 @@ freadVector :: FilePath -> Int -> IO (Vector Double)
85freadVector filename n = do 85freadVector filename n = do
86 charname <- newCString filename 86 charname <- newCString filename
87 res <- createVector n 87 res <- createVector n
88 app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" 88 gsl_vector_fread charname # res #|"gsl_vector_fread"
89 free charname 89 free charname
90 return res 90 return res
91 91
@@ -95,7 +95,7 @@ foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV
95fwriteVector :: FilePath -> Vector Double -> IO () 95fwriteVector :: FilePath -> Vector Double -> IO ()
96fwriteVector filename v = do 96fwriteVector filename v = do
97 charname <- newCString filename 97 charname <- newCString filename
98 app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" 98 gsl_vector_fwrite charname # v #|"gsl_vector_fwrite"
99 free charname 99 free charname
100 100
101foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV 101foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV