From db50bc11dafa6834a4367427156306674063ed6b Mon Sep 17 00:00:00 2001 From: Alberto Ruiz Date: Fri, 19 Jun 2015 13:55:39 +0200 Subject: 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. --- packages/gsl/src/Numeric/GSL/Fitting.hs | 2 +- packages/gsl/src/Numeric/GSL/Fourier.hs | 5 ++++- packages/gsl/src/Numeric/GSL/Internal.hs | 20 ++++++++++++++++---- packages/gsl/src/Numeric/GSL/LinearAlgebra.hs | 12 ++++++------ packages/gsl/src/Numeric/GSL/Minimization.hs | 2 +- packages/gsl/src/Numeric/GSL/Polynomials.hs | 2 +- packages/gsl/src/Numeric/GSL/SimulatedAnnealing.hs | 1 - packages/gsl/src/Numeric/GSL/Vector.hs | 12 ++++++------ 8 files changed, 35 insertions(+), 21 deletions(-) (limited to 'packages/gsl/src/Numeric') 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 fp <- mkVecVecfun (aux_vTov (checkdim1 n p . f)) jp <- mkVecMatfun (aux_vTom (checkdim2 n p . jac)) rawpath <- createMatrix RowMajor maxit (2+p) - app2 (c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n)) vec xiv mat rawpath "c_nlfit" + c_nlfit m fp jp epsabs epsrel (fi maxit) (fi n) # xiv # rawpath #|"c_nlfit" let it = round (rawpath `atIndex` (maxit-1,0)) path = takeRows it rawpath [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 @@ +{-# LANGUAGE TypeFamilies #-} + {- | Module : Numeric.GSL.Fourier Copyright : (c) Alberto Ruiz 2006 @@ -23,7 +25,7 @@ import System.IO.Unsafe (unsafePerformIO) genfft code v = unsafePerformIO $ do r <- createVector (size v) - app2 (c_fft code) vec v vec r "fft" + c_fft code # v # r #|"fft" return r foreign import ccall unsafe "gsl-aux.h fft" c_fft :: CInt -> TCV (TCV Res) @@ -41,3 +43,4 @@ fft = genfft 0 -- | The inverse of 'fft', using /gsl_fft_complex_inverse/. ifft :: Vector (Complex Double) -> Vector (Complex Double) ifft = genfft 1 + 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( createV, createMIO, module Numeric.LinearAlgebra.Devel, - check, + check,(#),vec, ww2, Res,TV,TM,TCV,TCM ) where @@ -35,7 +35,7 @@ import Foreign.Ptr(Ptr, FunPtr) import Foreign.C.Types import Foreign.C.String(peekCString) import System.IO.Unsafe(unsafePerformIO) -import Data.Vector.Storable(unsafeWith) +import Data.Vector.Storable as V (unsafeWith,length) import Control.Monad(when) iv :: (Vector Double -> Double) -> (CInt -> Ptr Double -> Double) @@ -86,12 +86,12 @@ aux_vTom f n p rr cr r = g where createV n fun msg = unsafePerformIO $ do r <- createVector n - app1 fun vec r msg + fun # r #| msg return r createMIO r c fun msg = do res <- createMatrix RowMajor r c - app1 fun mat res msg + fun # res #| msg return res -------------------------------------------------------------------------------- @@ -123,3 +123,15 @@ type TCM x = CInt -> CInt -> PC -> x type TVV = TV (TV Res) type TVM = TV (TM Res) +ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 + +vec x f = unsafeWith x $ \p -> do + let v g = do + g (fi $ V.length x) p + f v +{-# INLINE vec #-} + +infixl 1 # +a # b = applyRaw a b +{-# INLINE (#) #-} + 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 -> Vector Double randomVector seed dist n = unsafePerformIO $ do r <- createVector n - app1 (c_random_vector (fi seed) ((fi.fromEnum) dist)) vec r "randomVector" + c_random_vector (fi seed) ((fi.fromEnum) dist) # r #|"randomVector" return r foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> TV @@ -56,7 +56,7 @@ saveMatrix filename fmt m = do charname <- newCString filename charfmt <- newCString fmt let o = if orderOf m == RowMajor then 1 else 0 - app1 (matrix_fprintf charname charfmt o) mat m "matrix_fprintf" + matrix_fprintf charname charfmt o # m #|"matrix_fprintf" free charname free charfmt @@ -69,7 +69,7 @@ fscanfVector :: FilePath -> Int -> IO (Vector Double) fscanfVector filename n = do charname <- newCString filename res <- createVector n - app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" + gsl_vector_fscanf charname # res #|"gsl_vector_fscanf" free charname return res @@ -80,7 +80,7 @@ fprintfVector :: FilePath -> String -> Vector Double -> IO () fprintfVector filename fmt v = do charname <- newCString filename charfmt <- newCString fmt - app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" + gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf" free charname free charfmt @@ -91,7 +91,7 @@ freadVector :: FilePath -> Int -> IO (Vector Double) freadVector filename n = do charname <- newCString filename res <- createVector n - app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" + gsl_vector_fread charname # res #| "gsl_vector_fread" free charname return res @@ -101,7 +101,7 @@ foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV fwriteVector :: FilePath -> Vector Double -> IO () fwriteVector filename v = do charname <- newCString filename - app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" + gsl_vector_fwrite charname # v #|"gsl_vector_fwrite" free charname foreign 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 minimize method eps maxit sz f xi = v2l $ minimizeV method eps maxit (fromList sz) (f.toList) (fromList xi) where v2l (v,m) = (toList v, m) -ww2 w1 o1 w2 o2 f = w1 o1 $ \a1 -> w2 o2 $ \a2 -> f a1 a2 + minimizeV method eps maxit szv f xiv = unsafePerformIO $ do 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 polySolve' :: Vector Double -> Vector (Complex Double) polySolve' v | size v > 1 = unsafePerformIO $ do r <- createVector (size v-1) - app2 c_polySolve vec v vec r "polySolve" + c_polySolve # v # r #| "polySolve" return r | otherwise = error "polySolve on a polynomial of degree zero" 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) import Foreign.StablePtr(StablePtr, newStablePtr, deRefStablePtr, freeStablePtr) import Foreign.C.Types import System.IO.Unsafe(unsafePerformIO) -import Control.Applicative ((<*>), (<$>)) import System.IO (hFlush, stdout) 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 -> Vector Double randomVector seed dist n = unsafePerformIO $ do r <- createVector n - app1 (c_random_vector_GSL (fi seed) ((fi.fromEnum) dist)) vec r "randomVectorGSL" + c_random_vector_GSL (fi seed) ((fi.fromEnum) dist) # r #|"randomVectorGSL" return r foreign import ccall unsafe "random_vector_GSL" c_random_vector_GSL :: CInt -> CInt -> TV @@ -50,7 +50,7 @@ saveMatrix filename fmt m = do charname <- newCString filename charfmt <- newCString fmt let o = if orderOf m == RowMajor then 1 else 0 - app1 (matrix_fprintf charname charfmt o) mat m "matrix_fprintf" + matrix_fprintf charname charfmt o # m #|"matrix_fprintf" free charname free charfmt @@ -63,7 +63,7 @@ fscanfVector :: FilePath -> Int -> IO (Vector Double) fscanfVector filename n = do charname <- newCString filename res <- createVector n - app1 (gsl_vector_fscanf charname) vec res "gsl_vector_fscanf" + gsl_vector_fscanf charname # res #|"gsl_vector_fscanf" free charname return res @@ -74,7 +74,7 @@ fprintfVector :: FilePath -> String -> Vector Double -> IO () fprintfVector filename fmt v = do charname <- newCString filename charfmt <- newCString fmt - app1 (gsl_vector_fprintf charname charfmt) vec v "gsl_vector_fprintf" + gsl_vector_fprintf charname charfmt # v #|"gsl_vector_fprintf" free charname free charfmt @@ -85,7 +85,7 @@ freadVector :: FilePath -> Int -> IO (Vector Double) freadVector filename n = do charname <- newCString filename res <- createVector n - app1 (gsl_vector_fread charname) vec res "gsl_vector_fread" + gsl_vector_fread charname # res #|"gsl_vector_fread" free charname return res @@ -95,7 +95,7 @@ foreign import ccall unsafe "vector_fread" gsl_vector_fread:: Ptr CChar -> TV fwriteVector :: FilePath -> Vector Double -> IO () fwriteVector filename v = do charname <- newCString filename - app1 (gsl_vector_fwrite charname) vec v "gsl_vector_fwrite" + gsl_vector_fwrite charname # v #|"gsl_vector_fwrite" free charname foreign import ccall unsafe "vector_fwrite" gsl_vector_fwrite :: Ptr CChar -> TV -- cgit v1.2.3