From 9c1f355e4dfc1ae745b4b22471a103a3754a6278 Mon Sep 17 00:00:00 2001 From: Henning Thielemann Date: Thu, 29 Mar 2018 21:37:22 +0200 Subject: base:Internal.Numeric.ComplexOf: turn from type function to type synonym Now it is obvious for GHC that (ComplexOf a) is always a Complex type. --- packages/base/src/Internal/Numeric.hs | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) (limited to 'packages') diff --git a/packages/base/src/Internal/Numeric.hs b/packages/base/src/Internal/Numeric.hs index c9ef0c5..d478984 100644 --- a/packages/base/src/Internal/Numeric.hs +++ b/packages/base/src/Internal/Numeric.hs @@ -788,13 +788,7 @@ type instance RealOf (Complex Float) = Float type instance RealOf I = I type instance RealOf Z = Z -type family ComplexOf x - -type instance ComplexOf Double = Complex Double -type instance ComplexOf (Complex Double) = Complex Double - -type instance ComplexOf Float = Complex Float -type instance ComplexOf (Complex Float) = Complex Float +type ComplexOf x = Complex (RealOf x) type family SingleOf x -- cgit v1.2.3 From 1a68793247b8845cefad4d157e4f4d25b1731b42 Mon Sep 17 00:00:00 2001 From: Dominic Steinitz Date: Fri, 30 Mar 2018 12:48:20 +0100 Subject: Implement CI --- .circleci/config.yml | 34 +++++++++ packages/base/src/Internal/Algorithms.hs | 2 + packages/base/src/Internal/CG.hs | 2 + packages/base/src/Internal/Chain.hs | 2 + packages/base/src/Internal/Devel.hs | 1 + packages/base/src/Internal/Element.hs | 23 +++++- packages/base/src/Internal/IO.hs | 16 +++- packages/base/src/Internal/LAPACK.hs | 2 + packages/base/src/Internal/Matrix.hs | 87 +++++++++++++++++++++- packages/base/src/Internal/Modular.hs | 3 + packages/base/src/Internal/Numeric.hs | 2 + packages/base/src/Internal/ST.hs | 12 ++- packages/base/src/Internal/Sparse.hs | 2 + packages/base/src/Internal/Static.hs | 2 + packages/base/src/Internal/Util.hs | 2 + packages/base/src/Internal/Vector.hs | 7 ++ packages/base/src/Internal/Vectorized.hs | 36 +++++++++ packages/base/src/Numeric/LinearAlgebra.hs | 2 + packages/base/src/Numeric/LinearAlgebra/HMatrix.hs | 2 + packages/base/src/Numeric/LinearAlgebra/Static.hs | 2 + packages/base/src/Numeric/Matrix.hs | 14 +++- packages/base/src/Numeric/Vector.hs | 14 +++- packages/gsl/src/Graphics/Plot.hs | 2 + packages/gsl/src/Numeric/GSL/Fitting.hs | 2 + packages/gsl/src/Numeric/GSL/Fourier.hs | 2 + packages/gsl/src/Numeric/GSL/Integration.hs | 2 + packages/gsl/src/Numeric/GSL/Internal.hs | 3 + packages/gsl/src/Numeric/GSL/Interpolation.hs | 2 + packages/gsl/src/Numeric/GSL/LinearAlgebra.hs | 3 + packages/gsl/src/Numeric/GSL/Minimization.hs | 2 + packages/gsl/src/Numeric/GSL/ODE.hs | 2 + packages/gsl/src/Numeric/GSL/Root.hs | 2 + packages/gsl/src/Numeric/GSL/Vector.hs | 3 + packages/special/lib/Numeric/GSL/Special/Bessel.hs | 3 + .../special/lib/Numeric/GSL/Special/Coulomb.hs | 3 + .../special/lib/Numeric/GSL/Special/Coupling.hs | 3 + packages/special/lib/Numeric/GSL/Special/Exp.hs | 3 + packages/special/lib/Numeric/GSL/Special/Gamma.hs | 3 + .../special/lib/Numeric/GSL/Special/Gegenbauer.hs | 3 + .../special/lib/Numeric/GSL/Special/Legendre.hs | 3 + packages/special/lib/Numeric/GSL/Special/Trig.hs | 4 + packages/tests/src/Numeric/GSL/Tests.hs | 2 +- packages/tests/src/Numeric/LinearAlgebra/Tests.hs | 8 +- .../src/Numeric/LinearAlgebra/Tests/Instances.hs | 8 +- .../src/Numeric/LinearAlgebra/Tests/Properties.hs | 5 +- packages/tests/src/TestBase.hs | 1 + packages/tests/src/TestGSL.hs | 1 + 47 files changed, 322 insertions(+), 22 deletions(-) create mode 100644 .circleci/config.yml (limited to 'packages') diff --git a/.circleci/config.yml b/.circleci/config.yml new file mode 100644 index 0000000..61d0c5a --- /dev/null +++ b/.circleci/config.yml @@ -0,0 +1,34 @@ +version: 2 +jobs: + build: + docker: + - image: fpco/stack-build + steps: + - checkout + - restore_cache: + key: stack-deps-{{ checksum "stack.yaml" }} + - run: + name: Setup build toolchain + command: stack setup + - run: + name: Building dependencies + command: stack test --only-snapshot --prefetch + - save_cache: + paths: + - "~/.stack" + key: stack-deps-{{ checksum "stack.yaml" }} + - run: + name: Set up apt + command: apt update + - run: + name: Installing C packages + command: apt -y install libglpk-dev + - run: + name: Building + command: stack build --pedantic + - run: + name: Building tests + command: stack test --pedantic --no-run-tests + - run: + name: Running tests + command: stack test diff --git a/packages/base/src/Internal/Algorithms.hs b/packages/base/src/Internal/Algorithms.hs index 99c9e34..cea06ce 100644 --- a/packages/base/src/Internal/Algorithms.hs +++ b/packages/base/src/Internal/Algorithms.hs @@ -4,6 +4,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- {- | Module : Internal.Algorithms diff --git a/packages/base/src/Internal/CG.hs b/packages/base/src/Internal/CG.hs index cc10ad8..29edd35 100644 --- a/packages/base/src/Internal/CG.hs +++ b/packages/base/src/Internal/CG.hs @@ -1,6 +1,8 @@ {-# LANGUAGE FlexibleContexts, FlexibleInstances #-} {-# LANGUAGE RecordWildCards #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + module Internal.CG( cgSolve, cgSolve', CGState(..), R, V diff --git a/packages/base/src/Internal/Chain.hs b/packages/base/src/Internal/Chain.hs index f87eb02..4000c2b 100644 --- a/packages/base/src/Internal/Chain.hs +++ b/packages/base/src/Internal/Chain.hs @@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- -- | -- Module : Internal.Chain diff --git a/packages/base/src/Internal/Devel.hs b/packages/base/src/Internal/Devel.hs index 3887663..f72d8aa 100644 --- a/packages/base/src/Internal/Devel.hs +++ b/packages/base/src/Internal/Devel.hs @@ -54,6 +54,7 @@ check msg f = do -- | postfix error code check infixl 0 #| +(#|) :: IO CInt -> String -> IO () (#|) = flip check -- | Error capture and conversion to Maybe diff --git a/packages/base/src/Internal/Element.hs b/packages/base/src/Internal/Element.hs index eb3a25b..2e330ee 100644 --- a/packages/base/src/Internal/Element.hs +++ b/packages/base/src/Internal/Element.hs @@ -4,6 +4,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Packed.Matrix @@ -31,6 +33,7 @@ import Data.List.Split(chunksOf) import Foreign.Storable(Storable) import System.IO.Unsafe(unsafePerformIO) import Control.Monad(liftM) +import Foreign.C.Types(CInt) ------------------------------------------------------------------- @@ -53,8 +56,10 @@ instance (Show a, Element a) => (Show (Matrix a)) where show m | rows m == 0 || cols m == 0 = sizes m ++" []" show m = (sizes m++) . dsp . map (map show) . toLists $ m +sizes :: Matrix t -> [Char] sizes m = "("++show (rows m)++"><"++show (cols m)++")\n" +dsp :: [[[Char]]] -> [Char] dsp as = (++" ]") . (" ["++) . init . drop 2 . unlines . map (" , "++) . map unwords' $ transpose mtp where mt = transpose as @@ -73,6 +78,7 @@ instance (Element a, Read a) => Read (Matrix a) where rs = read . snd . breakAt '(' .init . fst . breakAt '>' $ dims +breakAt :: Eq a => a -> [a] -> ([a], [a]) breakAt c l = (a++[c],tail b) where (a,b) = break (==c) l @@ -88,7 +94,8 @@ data Extractor | Drop Int | DropLast Int deriving Show - + +ppext :: Extractor -> [Char] ppext All = ":" ppext (Range a 1 c) = printf "%d:%d" a c ppext (Range a b c) = printf "%d:%d:%d" a b c @@ -128,10 +135,14 @@ ppext (DropLast n) = printf "DropLast %d" n infixl 9 ?? (??) :: Element t => Matrix t -> (Extractor,Extractor) -> Matrix t +minEl :: Vector CInt -> CInt minEl = toScalarI Min +maxEl :: Vector CInt -> CInt maxEl = toScalarI Max +cmodi :: Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt -> Vector Foreign.C.Types.CInt cmodi = vectorMapValI ModVS +extractError :: Matrix t1 -> (Extractor, Extractor) -> t extractError m (e1,e2)= error $ printf "can't extract (%s,%s) from matrix %dx%d" (ppext e1::String) (ppext e2::String) (rows m) (cols m) m ?? (Range a s b,e) | s /= 1 = m ?? (Pos (idxs [a,a+s .. b]), e) @@ -232,8 +243,10 @@ disp = putStr . dispf 2 fromBlocks :: Element t => [[Matrix t]] -> Matrix t fromBlocks = fromBlocksRaw . adaptBlocks +fromBlocksRaw :: Element t => [[Matrix t]] -> Matrix t fromBlocksRaw mms = joinVert . map joinHoriz $ mms +adaptBlocks :: Element t => [[Matrix t]] -> [[Matrix t]] adaptBlocks ms = ms' where bc = case common length ms of Just c -> c @@ -486,6 +499,9 @@ liftMatrix2Auto f m1 m2 m2' = conformMTo (r,c) m2 -- FIXME do not flatten if equal order +lM :: (Storable t, Element t1, Element t2) + => (Vector t1 -> Vector t2 -> Vector t) + -> Matrix t1 -> Matrix t2 -> Matrix t lM f m1 m2 = matrixFromVector RowMajor (max' (rows m1) (rows m2)) @@ -504,6 +520,7 @@ compat' m1 m2 = s1 == (1,1) || s2 == (1,1) || s1 == s2 ------------------------------------------------------------ +toBlockRows :: Element t => [Int] -> Matrix t -> [Matrix t] toBlockRows [r] m | r == rows m = [m] toBlockRows rs m @@ -513,6 +530,7 @@ toBlockRows rs m szs = map (* cols m) rs g k = (k><0)[] +toBlockCols :: Element t => [Int] -> Matrix t -> [Matrix t] toBlockCols [c] m | c == cols m = [m] toBlockCols cs m = map trans . toBlockRows cs . trans $ m @@ -576,7 +594,7 @@ Just (3><3) mapMatrixWithIndexM :: (Element a, Storable b, Monad m) => ((Int, Int) -> a -> m b) -> Matrix a -> m (Matrix b) -mapMatrixWithIndexM g m = liftM (reshape c) . mapVectorWithIndexM (mk c g) . flatten $ m +mapMatrixWithIndexM g m = liftM (reshape c) . mapVectorWithIndexM (mk c g) . flatten $ m where c = cols m @@ -598,4 +616,3 @@ mapMatrixWithIndex g m = reshape c . mapVectorWithIndex (mk c g) . flatten $ m mapMatrix :: (Element a, Element b) => (a -> b) -> Matrix a -> Matrix b mapMatrix f = liftMatrix (mapVector f) - diff --git a/packages/base/src/Internal/IO.hs b/packages/base/src/Internal/IO.hs index a899cfd..b0f5606 100644 --- a/packages/base/src/Internal/IO.hs +++ b/packages/base/src/Internal/IO.hs @@ -20,7 +20,7 @@ import Internal.Devel import Internal.Vector import Internal.Matrix import Internal.Vectorized -import Text.Printf(printf) +import Text.Printf(printf, PrintfArg, PrintfType) import Data.List(intersperse,transpose) import Data.Complex @@ -78,12 +78,18 @@ disps d x = sdims x ++ " " ++ formatScaled d x dispf :: Int -> Matrix Double -> String dispf d x = sdims x ++ "\n" ++ formatFixed (if isInt x then 0 else d) x +sdims :: Matrix t -> [Char] sdims x = show (rows x) ++ "x" ++ show (cols x) +formatFixed :: (Show a, Text.Printf.PrintfArg t, Element t) + => a -> Matrix t -> String formatFixed d x = format " " (printf ("%."++show d++"f")) $ x +isInt :: Matrix Double -> Bool isInt = all lookslikeInt . toList . flatten +formatScaled :: (Text.Printf.PrintfArg b, RealFrac b, Floating b, Num t, Element b, Show t) + => t -> Matrix b -> [Char] formatScaled dec t = "E"++show o++"\n" ++ ss where ss = format " " (printf fmt. g) t g x | o >= 0 = x/10^(o::Int) @@ -133,14 +139,18 @@ showComplex d (a:+b) s2 = if b<0 then "-" else "" s3 = if b<0 then "-" else "+" +shcr :: (Show a, Show t1, Text.Printf.PrintfType t, Text.Printf.PrintfArg t1, RealFrac t1) + => a -> t1 -> t shcr d a | lookslikeInt a = printf "%.0f" a | otherwise = printf ("%."++show d++"f") a - +lookslikeInt :: (Show a, RealFrac a) => a -> Bool lookslikeInt x = show (round x :: Int) ++".0" == shx || "-0.0" == shx where shx = show x +isZero :: Show a => a -> Bool isZero x = show x `elem` ["0.0","-0.0"] +isOne :: Show a => a -> Bool isOne x = show x `elem` ["1.0","-1.0"] -- | Pretty print a complex matrix with at most n decimal digits. @@ -168,6 +178,6 @@ loadMatrix f = do else return (reshape c v) - +loadMatrix' :: FilePath -> IO (Maybe (Matrix Double)) loadMatrix' name = mbCatch (loadMatrix name) diff --git a/packages/base/src/Internal/LAPACK.hs b/packages/base/src/Internal/LAPACK.hs index e306454..64cf2f5 100644 --- a/packages/base/src/Internal/LAPACK.hs +++ b/packages/base/src/Internal/LAPACK.hs @@ -1,6 +1,8 @@ {-# LANGUAGE TypeOperators #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- -- | -- Module : Numeric.LinearAlgebra.LAPACK diff --git a/packages/base/src/Internal/Matrix.hs b/packages/base/src/Internal/Matrix.hs index 4905f61..4bfa13d 100644 --- a/packages/base/src/Internal/Matrix.hs +++ b/packages/base/src/Internal/Matrix.hs @@ -57,19 +57,24 @@ cols :: Matrix t -> Int cols = icols {-# INLINE cols #-} +size :: Matrix t -> (Int, Int) size m = (irows m, icols m) {-# INLINE size #-} +rowOrder :: Matrix t -> Bool rowOrder m = xCol m == 1 || cols m == 1 {-# INLINE rowOrder #-} +colOrder :: Matrix t -> Bool colOrder m = xRow m == 1 || rows m == 1 {-# INLINE colOrder #-} +is1d :: Matrix t -> Bool is1d (size->(r,c)) = r==1 || c==1 {-# INLINE is1d #-} -- data is not contiguous +isSlice :: Storable t => Matrix t -> Bool isSlice m@(size->(r,c)) = r*c < dim (xdat m) {-# INLINE isSlice #-} @@ -136,16 +141,20 @@ instance Storable t => TransArray (Matrix t) {-# INLINE applyRaw #-} infixr 1 # +(#) :: TransArray c => c -> (b -> IO r) -> Trans c b -> IO r a # b = apply a b {-# INLINE (#) #-} +(#!) :: (TransArray c, TransArray c1) => c1 -> c -> Trans c1 (Trans c (IO r)) -> IO r a #! b = a # b # id {-# INLINE (#!) #-} -------------------------------------------------------------------------------- +copy :: Element t => MatrixOrder -> Matrix t -> IO (Matrix t) copy ord m = extractR ord m 0 (idxs[0,rows m-1]) 0 (idxs[0,cols m-1]) +extractAll :: Element t => MatrixOrder -> Matrix t -> Matrix t extractAll ord m = unsafePerformIO (copy ord m) {- | Creates a vector by concatenation of rows. If the matrix is ColumnMajor, this operation requires a transpose. @@ -223,11 +232,13 @@ m@Matrix {irows = r, icols = c} @@> (i,j) {-# INLINE (@@>) #-} -- Unsafe matrix access without range checking +atM' :: Storable t => Matrix t -> Int -> Int -> t atM' m i j = xdat m `at'` (i * (xRow m) + j * (xCol m)) {-# INLINE atM' #-} ------------------------------------------------------------------ +matrixFromVector :: Storable t => MatrixOrder -> Int -> Int -> Vector t -> Matrix t matrixFromVector _ 1 _ v@(dim->d) = Matrix { irows = 1, icols = d, xdat = v, xRow = d, xCol = 1 } matrixFromVector _ _ 1 v@(dim->d) = Matrix { irows = d, icols = 1, xdat = v, xRow = 1, xCol = d } matrixFromVector o r c v @@ -387,18 +398,21 @@ subMatrix (r0,c0) (rt,ct) m -------------------------------------------------------------------------- +maxZ :: (Num t1, Ord t1, Foldable t) => t t1 -> t1 maxZ xs = if minimum xs == 0 then 0 else maximum xs +conformMs :: Element t => [Matrix t] -> [Matrix t] conformMs ms = map (conformMTo (r,c)) ms where r = maxZ (map rows ms) c = maxZ (map cols ms) - +conformVs :: Element t => [Vector t] -> [Vector t] conformVs vs = map (conformVTo n) vs where n = maxZ (map dim vs) +conformMTo :: Element t => (Int, Int) -> Matrix t -> Matrix t conformMTo (r,c) m | size m == (r,c) = m | size m == (1,1) = matrixFromVector RowMajor r c (constantD (m@@>(0,0)) (r*c)) @@ -406,18 +420,24 @@ conformMTo (r,c) m | size m == (1,c) = repRows r m | otherwise = error $ "matrix " ++ shSize m ++ " cannot be expanded to " ++ shDim (r,c) +conformVTo :: Element t => Int -> Vector t -> Vector t conformVTo n v | dim v == n = v | dim v == 1 = constantD (v@>0) n | otherwise = error $ "vector of dim=" ++ show (dim v) ++ " cannot be expanded to dim=" ++ show n +repRows :: Element t => Int -> Matrix t -> Matrix t repRows n x = fromRows (replicate n (flatten x)) +repCols :: Element t => Int -> Matrix t -> Matrix t repCols n x = fromColumns (replicate n (flatten x)) +shSize :: Matrix t -> [Char] shSize = shDim . size +shDim :: (Show a, Show a1) => (a1, a) -> [Char] shDim (r,c) = "(" ++ show r ++"x"++ show c ++")" +emptyM :: Storable t => Int -> Int -> Matrix t emptyM r c = matrixFromVector RowMajor r c (fromList[]) ---------------------------------------------------------------------- @@ -432,6 +452,11 @@ instance (Storable t, NFData t) => NFData (Matrix t) --------------------------------------------------------------- +extractAux :: (Eq t3, Eq t2, TransArray c, Storable a, Storable t1, + Storable t, Num t3, Num t2, Integral t1, Integral t) + => (t3 -> t2 -> CInt -> Ptr t1 -> CInt -> Ptr t + -> Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt)) + -> MatrixOrder -> c -> t3 -> Vector t1 -> t2 -> Vector t -> IO (Matrix a) extractAux f ord m moder vr modec vc = do let nr = if moder == 0 then fromIntegral $ vr@>1 - vr@>0 + 1 else dim vr nc = if modec == 0 then fromIntegral $ vc@>1 - vc@>0 + 1 else dim vc @@ -451,6 +476,9 @@ foreign import ccall unsafe "extractL" c_extractL :: Extr Z --------------------------------------------------------------- +setRectAux :: (TransArray c1, TransArray c) + => (CInt -> CInt -> Trans c1 (Trans c (IO CInt))) + -> Int -> Int -> c1 -> c -> IO () setRectAux f i j m r = (m #! r) (f (fi i) (fi j)) #|"setRect" type SetRect x = I -> I -> x ::> x::> Ok @@ -464,19 +492,29 @@ foreign import ccall unsafe "setRectL" c_setRectL :: SetRect Z -------------------------------------------------------------------------------- +sortG :: (Storable t, Storable a) + => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a sortG f v = unsafePerformIO $ do r <- createVector (dim v) (v #! r) f #|"sortG" return r +sortIdxD :: Vector Double -> Vector CInt sortIdxD = sortG c_sort_indexD +sortIdxF :: Vector Float -> Vector CInt sortIdxF = sortG c_sort_indexF +sortIdxI :: Vector CInt -> Vector CInt sortIdxI = sortG c_sort_indexI +sortIdxL :: Vector Z -> Vector I sortIdxL = sortG c_sort_indexL +sortValD :: Vector Double -> Vector Double sortValD = sortG c_sort_valD +sortValF :: Vector Float -> Vector Float sortValF = sortG c_sort_valF +sortValI :: Vector CInt -> Vector CInt sortValI = sortG c_sort_valI +sortValL :: Vector Z -> Vector Z sortValL = sortG c_sort_valL foreign import ccall unsafe "sort_indexD" c_sort_indexD :: CV Double (CV CInt (IO CInt)) @@ -491,14 +529,21 @@ foreign import ccall unsafe "sort_valuesL" c_sort_valL :: Z :> Z :> Ok -------------------------------------------------------------------------------- +compareG :: (TransArray c, Storable t, Storable a) + => Trans c (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) + -> c -> Vector t -> Vector a compareG f u v = unsafePerformIO $ do r <- createVector (dim v) (u # v #! r) f #|"compareG" return r +compareD :: Vector Double -> Vector Double -> Vector CInt compareD = compareG c_compareD +compareF :: Vector Float -> Vector Float -> Vector CInt compareF = compareG c_compareF +compareI :: Vector CInt -> Vector CInt -> Vector CInt compareI = compareG c_compareI +compareL :: Vector Z -> Vector Z -> Vector CInt compareL = compareG c_compareL foreign import ccall unsafe "compareD" c_compareD :: CV Double (CV Double (CV CInt (IO CInt))) @@ -508,16 +553,33 @@ foreign import ccall unsafe "compareL" c_compareL :: Z :> Z :> I :> Ok -------------------------------------------------------------------------------- +selectG :: (TransArray c, TransArray c1, TransArray c2, Storable t, Storable a) + => Trans c2 (Trans c1 (CInt -> Ptr t -> Trans c (CInt -> Ptr a -> IO CInt))) + -> c2 -> c1 -> Vector t -> c -> Vector a selectG f c u v w = unsafePerformIO $ do r <- createVector (dim v) (c # u # v # w #! r) f #|"selectG" return r +selectD :: Vector CInt -> Vector Double -> Vector Double -> Vector Double -> Vector Double selectD = selectG c_selectD +selectF :: Vector CInt -> Vector Float -> Vector Float -> Vector Float -> Vector Float selectF = selectG c_selectF +selectI :: Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt -> Vector CInt selectI = selectG c_selectI +selectL :: Vector CInt -> Vector Z -> Vector Z -> Vector Z -> Vector Z selectL = selectG c_selectL +selectC :: Vector CInt + -> Vector (Complex Double) + -> Vector (Complex Double) + -> Vector (Complex Double) + -> Vector (Complex Double) selectC = selectG c_selectC +selectQ :: Vector CInt + -> Vector (Complex Float) + -> Vector (Complex Float) + -> Vector (Complex Float) + -> Vector (Complex Float) selectQ = selectG c_selectQ type Sel x = CV CInt (CV x (CV x (CV x (CV x (IO CInt))))) @@ -531,16 +593,29 @@ foreign import ccall unsafe "chooseL" c_selectL :: Sel Z --------------------------------------------------------------------------- +remapG :: (TransArray c, TransArray c1, Storable t, Storable a) + => (CInt -> CInt -> CInt -> CInt -> Ptr t + -> Trans c1 (Trans c (CInt -> CInt -> CInt -> CInt -> Ptr a -> IO CInt))) + -> Matrix t -> c1 -> c -> Matrix a remapG f i j m = unsafePerformIO $ do r <- createMatrix RowMajor (rows i) (cols i) (i # j # m #! r) f #|"remapG" return r +remapD :: Matrix CInt -> Matrix CInt -> Matrix Double -> Matrix Double remapD = remapG c_remapD +remapF :: Matrix CInt -> Matrix CInt -> Matrix Float -> Matrix Float remapF = remapG c_remapF +remapI :: Matrix CInt -> Matrix CInt -> Matrix CInt -> Matrix CInt remapI = remapG c_remapI +remapL :: Matrix CInt -> Matrix CInt -> Matrix Z -> Matrix Z remapL = remapG c_remapL +remapC :: Matrix CInt + -> Matrix CInt + -> Matrix (Complex Double) + -> Matrix (Complex Double) remapC = remapG c_remapC +remapQ :: Matrix CInt -> Matrix CInt -> Matrix (Complex Float) -> Matrix (Complex Float) remapQ = remapG c_remapQ type Rem x = OM CInt (OM CInt (OM x (OM x (IO CInt)))) @@ -554,6 +629,9 @@ foreign import ccall unsafe "remapL" c_remapL :: Rem Z -------------------------------------------------------------------------------- +rowOpAux :: (TransArray c, Storable a) => + (CInt -> Ptr a -> CInt -> CInt -> CInt -> CInt -> Trans c (IO CInt)) + -> Int -> a -> Int -> Int -> Int -> Int -> c -> IO () rowOpAux f c x i1 i2 j1 j2 m = do px <- newArray [x] (m # id) (f (fi c) px (fi i1) (fi i2) (fi j1) (fi j2)) #|"rowOp" @@ -572,6 +650,9 @@ foreign import ccall unsafe "rowop_mod_int64_t" c_rowOpML :: Z -> RowOp Z -------------------------------------------------------------------------------- +gemmg :: (TransArray c1, TransArray c, TransArray c2, TransArray c3) + => Trans c3 (Trans c2 (Trans c1 (Trans c (IO CInt)))) + -> c3 -> c2 -> c1 -> c -> IO () gemmg f v m1 m2 m3 = (v # m1 # m2 #! m3) f #|"gemmg" type Tgemm x = x :> x ::> x ::> x ::> Ok @@ -587,6 +668,10 @@ foreign import ccall unsafe "gemm_mod_int64_t" c_gemmML :: Z -> Tgemm Z -------------------------------------------------------------------------------- +reorderAux :: (TransArray c, Storable t, Storable a1, Storable t1, Storable a) => + (CInt -> Ptr a -> CInt -> Ptr t1 + -> Trans c (CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt)) + -> Vector t1 -> c -> Vector t -> Vector a1 reorderAux f s d v = unsafePerformIO $ do k <- createVector (dim s) r <- createVector (dim v) diff --git a/packages/base/src/Internal/Modular.hs b/packages/base/src/Internal/Modular.hs index 9d51444..eb0c5a8 100644 --- a/packages/base/src/Internal/Modular.hs +++ b/packages/base/src/Internal/Modular.hs @@ -13,6 +13,9 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + {- | Module : Internal.Modular Copyright : (c) Alberto Ruiz 2015 diff --git a/packages/base/src/Internal/Numeric.hs b/packages/base/src/Internal/Numeric.hs index c9ef0c5..216f142 100644 --- a/packages/base/src/Internal/Numeric.hs +++ b/packages/base/src/Internal/Numeric.hs @@ -5,6 +5,8 @@ {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE UndecidableInstances #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- -- | -- Module : Data.Packed.Internal.Numeric diff --git a/packages/base/src/Internal/ST.hs b/packages/base/src/Internal/ST.hs index 544c9e4..7d54e6d 100644 --- a/packages/base/src/Internal/ST.hs +++ b/packages/base/src/Internal/ST.hs @@ -81,6 +81,8 @@ unsafeFreezeVector :: (Storable t) => STVector s t -> ST s (Vector t) unsafeFreezeVector (STVector x) = unsafeIOToST . return $ x {-# INLINE safeIndexV #-} +safeIndexV :: Storable t2 + => (STVector s t2 -> Int -> t) -> STVector t1 t2 -> Int -> t safeIndexV f (STVector v) k | k < 0 || k>= dim v = error $ "out of range error in vector (dim=" ++show (dim v)++", pos="++show k++")" @@ -150,9 +152,12 @@ unsafeFreezeMatrix (STMatrix x) = unsafeIOToST . return $ x freezeMatrix :: (Element t) => STMatrix s t -> ST s (Matrix t) freezeMatrix m = liftSTMatrix id m +cloneMatrix :: Element t => Matrix t -> IO (Matrix t) cloneMatrix m = copy (orderOf m) m {-# INLINE safeIndexM #-} +safeIndexM :: (STMatrix s t2 -> Int -> Int -> t) + -> STMatrix t1 t2 -> Int -> Int -> t safeIndexM f (STMatrix m) r c | r<0 || r>=rows m || c<0 || c>=cols m = error $ "out of range error in matrix (size=" @@ -184,6 +189,7 @@ data ColRange = AllCols | Col Int | FromCol Int +getColRange :: Int -> ColRange -> (Int, Int) getColRange c AllCols = (0,c-1) getColRange c (ColRange a b) = (a `mod` c, b `mod` c) getColRange c (Col a) = (a `mod` c, a `mod` c) @@ -194,6 +200,7 @@ data RowRange = AllRows | Row Int | FromRow Int +getRowRange :: Int -> RowRange -> (Int, Int) getRowRange r AllRows = (0,r-1) getRowRange r (RowRange a b) = (a `mod` r, b `mod` r) getRowRange r (Row a) = (a `mod` r, a `mod` r) @@ -223,6 +230,7 @@ rowOper (SWAP i1 i2 r) (STMatrix m) = unsafeIOToST $ rowOp 2 0 i1' i2' j1 j2 m i2' = i2 `mod` (rows m) +extractMatrix :: Element a => STMatrix t a -> RowRange -> ColRange -> ST s (Matrix a) extractMatrix (STMatrix m) rr rc = unsafeIOToST (extractR (orderOf m) m 0 (idxs[i1,i2]) 0 (idxs[j1,j2])) where (i1,i2) = getRowRange (rows m) rr @@ -231,6 +239,7 @@ extractMatrix (STMatrix m) rr rc = unsafeIOToST (extractR (orderOf m) m 0 (idxs[ -- | r0 c0 height width data Slice s t = Slice (STMatrix s t) Int Int Int Int +slice :: Element a => Slice t a -> Matrix a slice (Slice (STMatrix m) r0 c0 nr nc) = subMatrix (r0,c0) (nr,nc) m gemmm :: Element t => t -> Slice s t -> t -> Slice s t -> Slice s t -> ST s () @@ -238,7 +247,7 @@ gemmm beta (slice->r) alpha (slice->a) (slice->b) = res where res = unsafeIOToST (gemm v a b r) v = fromList [alpha,beta] - + mutable :: Element t => (forall s . (Int, Int) -> STMatrix s t -> ST s u) -> Matrix t -> (Matrix t,u) mutable f a = runST $ do @@ -246,4 +255,3 @@ mutable f a = runST $ do info <- f (rows a, cols a) x r <- unsafeFreezeMatrix x return (r,info) - diff --git a/packages/base/src/Internal/Sparse.hs b/packages/base/src/Internal/Sparse.hs index 1ff3f57..6233b03 100644 --- a/packages/base/src/Internal/Sparse.hs +++ b/packages/base/src/Internal/Sparse.hs @@ -2,6 +2,8 @@ {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE FlexibleInstances #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + module Internal.Sparse( GMatrix(..), CSR(..), mkCSR, fromCSR, mkSparse, mkDiagR, mkDense, diff --git a/packages/base/src/Internal/Static.hs b/packages/base/src/Internal/Static.hs index f9dfff0..6ef1350 100644 --- a/packages/base/src/Internal/Static.hs +++ b/packages/base/src/Internal/Static.hs @@ -15,6 +15,8 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveGeneric #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {- | Module : Internal.Static Copyright : (c) Alberto Ruiz 2006-14 diff --git a/packages/base/src/Internal/Util.hs b/packages/base/src/Internal/Util.hs index 8c8a31e..def7cc3 100644 --- a/packages/base/src/Internal/Util.hs +++ b/packages/base/src/Internal/Util.hs @@ -6,6 +6,8 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ViewPatterns #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- {- | diff --git a/packages/base/src/Internal/Vector.hs b/packages/base/src/Internal/Vector.hs index 67d0416..dedb822 100644 --- a/packages/base/src/Internal/Vector.hs +++ b/packages/base/src/Internal/Vector.hs @@ -1,6 +1,7 @@ {-# LANGUAGE MagicHash, UnboxedTuples, BangPatterns, FlexibleContexts #-} {-# LANGUAGE TypeSynonymInstances #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} -- | -- Module : Internal.Vector @@ -40,6 +41,7 @@ import qualified Data.Vector.Storable as Vector import Data.Vector.Storable(Vector, fromList, unsafeToForeignPtr, unsafeFromForeignPtr, unsafeWith) import Data.Binary +import Data.Binary.Put import Control.Monad(replicateM) import qualified Data.ByteString.Internal as BS import Data.Vector.Storable.Internal(updPtr) @@ -92,6 +94,7 @@ createVector n = do -} +safeRead :: Storable a => Vector a -> (Ptr a -> IO c) -> c safeRead v = inlinePerformIO . unsafeWith v {-# INLINE safeRead #-} @@ -283,11 +286,13 @@ foldVectorWithIndex f x v = unsafePerformIO $ go (dim v -1) x {-# INLINE foldVectorWithIndex #-} +foldLoop :: (Int -> t -> t) -> t -> Int -> t foldLoop f s0 d = go (d - 1) s0 where go 0 s = f (0::Int) s go !j !s = go (j - 1) (f j s) +foldVectorG :: Storable t1 => (Int -> (Int -> t1) -> t -> t) -> t -> Vector t1 -> t foldVectorG f s0 v = foldLoop g s0 (dim v) where g !k !s = f k (safeRead v . flip peekElemOff) s {-# INLINE g #-} -- Thanks to Ryan Ingram (http://permalink.gmane.org/gmane.comp.lang.haskell.cafe/46479) @@ -390,8 +395,10 @@ chunks d = let c = d `div` chunk m = d `mod` chunk in if m /= 0 then reverse (m:(replicate c chunk)) else (replicate c chunk) +putVector :: (Storable t, Binary t) => Vector t -> Data.Binary.Put.PutM () putVector v = mapM_ put $! toList v +getVector :: (Storable a, Binary a) => Int -> Get (Vector a) getVector d = do xs <- replicateM d get return $! fromList xs diff --git a/packages/base/src/Internal/Vectorized.hs b/packages/base/src/Internal/Vectorized.hs index a410bb2..c00c324 100644 --- a/packages/base/src/Internal/Vectorized.hs +++ b/packages/base/src/Internal/Vectorized.hs @@ -28,12 +28,15 @@ import System.IO.Unsafe(unsafePerformIO) import Control.Monad(when) infixr 1 # +(#) :: TransArray c => c -> (b -> IO r) -> TransRaw c b -> IO r a # b = applyRaw a b {-# INLINE (#) #-} +(#!) :: (TransArray c, TransArray c1) => c1 -> c -> TransRaw c1 (TransRaw c (IO r)) -> IO r a #! b = a # b # id {-# INLINE (#!) #-} +fromei :: Enum a => a -> CInt fromei x = fromIntegral (fromEnum x) :: CInt data FunCodeV = Sin @@ -100,10 +103,20 @@ sumQ = sumg c_sumQ sumC :: Vector (Complex Double) -> Complex Double sumC = sumg c_sumC +sumI :: ( TransRaw c (CInt -> Ptr a -> IO CInt) ~ (CInt -> Ptr I -> I :> Ok) + , TransArray c + , Storable a + ) + => I -> c -> a sumI m = sumg (c_sumI m) +sumL :: ( TransRaw c (CInt -> Ptr a -> IO CInt) ~ (CInt -> Ptr Z -> Z :> Ok) + , TransArray c + , Storable a + ) => Z -> c -> a sumL m = sumg (c_sumL m) +sumg :: (TransArray c, Storable a) => TransRaw c (CInt -> Ptr a -> IO CInt) -> c -> a sumg f x = unsafePerformIO $ do r <- createVector 1 (x #! r) f #| "sum" @@ -140,6 +153,8 @@ prodI = prodg . c_prodI prodL :: Z-> Vector Z -> Z prodL = prodg . c_prodL +prodg :: (TransArray c, Storable a) + => TransRaw c (CInt -> Ptr a -> IO CInt) -> c -> a prodg f x = unsafePerformIO $ do r <- createVector 1 (x #! r) f #| "prod" @@ -155,16 +170,25 @@ foreign import ccall unsafe "prodL" c_prodL :: Z -> TVV Z ------------------------------------------------------------------ +toScalarAux :: (Enum a, TransArray c, Storable a1) + => (CInt -> TransRaw c (CInt -> Ptr a1 -> IO CInt)) -> a -> c -> a1 toScalarAux fun code v = unsafePerformIO $ do r <- createVector 1 (v #! r) (fun (fromei code)) #|"toScalarAux" return (r @> 0) + +vectorMapAux :: (Enum a, Storable t, Storable a1) + => (CInt -> CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt) + -> a -> Vector t -> Vector a1 vectorMapAux fun code v = unsafePerformIO $ do r <- createVector (dim v) (v #! r) (fun (fromei code)) #|"vectorMapAux" return r +vectorMapValAux :: (Enum a, Storable a2, Storable t, Storable a1) + => (CInt -> Ptr a2 -> CInt -> Ptr t -> CInt -> Ptr a1 -> IO CInt) + -> a -> a2 -> Vector t -> Vector a1 vectorMapValAux fun code val v = unsafePerformIO $ do r <- createVector (dim v) pval <- newArray [val] @@ -172,6 +196,9 @@ vectorMapValAux fun code val v = unsafePerformIO $ do free pval return r +vectorZipAux :: (Enum a, TransArray c, Storable t, Storable a1) + => (CInt -> CInt -> Ptr t -> TransRaw c (CInt -> Ptr a1 -> IO CInt)) + -> a -> Vector t -> c -> Vector a1 vectorZipAux fun code u v = unsafePerformIO $ do r <- createVector (dim u) (u # v #! r) (fun (fromei code)) #|"vectorZipAux" @@ -378,6 +405,7 @@ foreign import ccall unsafe "random_vector" c_random_vector :: CInt -> CInt -> D -------------------------------------------------------------------------------- +roundVector :: Vector Double -> Vector Double roundVector v = unsafePerformIO $ do r <- createVector (dim v) (v #! r) c_round_vector #|"roundVector" @@ -432,6 +460,8 @@ long2intV :: Vector Z -> Vector I long2intV = tog c_long2int +tog :: (Storable t, Storable a) + => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a tog f v = unsafePerformIO $ do r <- createVector (dim v) (v #! r) f #|"tog" @@ -451,6 +481,8 @@ foreign import ccall unsafe "long2int" c_long2int :: Z :> I :> Ok --------------------------------------------------------------- +stepg :: (Storable t, Storable a) + => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a stepg f v = unsafePerformIO $ do r <- createVector (dim v) (v #! r) f #|"step" @@ -476,6 +508,8 @@ foreign import ccall unsafe "stepL" c_stepL :: TVV Z -------------------------------------------------------------------------------- +conjugateAux :: (Storable t, Storable a) + => (CInt -> Ptr t -> CInt -> Ptr a -> IO CInt) -> Vector t -> Vector a conjugateAux fun x = unsafePerformIO $ do v <- createVector (dim x) (x #! v) fun #|"conjugateAux" @@ -501,6 +535,8 @@ cloneVector v = do -------------------------------------------------------------------------------- +constantAux :: (Storable a1, Storable a) + => (Ptr a1 -> CInt -> Ptr a -> IO CInt) -> a1 -> Int -> Vector a constantAux fun x n = unsafePerformIO $ do v <- createVector n px <- newArray [x] diff --git a/packages/base/src/Numeric/LinearAlgebra.hs b/packages/base/src/Numeric/LinearAlgebra.hs index 73d4a13..970c77e 100644 --- a/packages/base/src/Numeric/LinearAlgebra.hs +++ b/packages/base/src/Numeric/LinearAlgebra.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra diff --git a/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs b/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs index 3a84645..57e5cf1 100644 --- a/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs +++ b/packages/base/src/Numeric/LinearAlgebra/HMatrix.hs @@ -28,7 +28,9 @@ infixr 8 <·> (<·>) :: Numeric t => Vector t -> Vector t -> t (<·>) = dot +app :: Numeric t => Matrix t -> Vector t -> Vector t app m v = m #> v +mul :: Numeric t => Matrix t -> Matrix t -> Matrix t mul a b = a <> b diff --git a/packages/base/src/Numeric/LinearAlgebra/Static.hs b/packages/base/src/Numeric/LinearAlgebra/Static.hs index e328904..2e05c90 100644 --- a/packages/base/src/Numeric/LinearAlgebra/Static.hs +++ b/packages/base/src/Numeric/LinearAlgebra/Static.hs @@ -14,6 +14,8 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} {- | Module : Numeric.LinearAlgebra.Static diff --git a/packages/base/src/Numeric/Matrix.hs b/packages/base/src/Numeric/Matrix.hs index 06da150..6e3db61 100644 --- a/packages/base/src/Numeric/Matrix.hs +++ b/packages/base/src/Numeric/Matrix.hs @@ -4,6 +4,8 @@ {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} +{-# OPTIONS_GHC -fno-warn-orphans #-} + ----------------------------------------------------------------------------- -- | -- Module : Numeric.Matrix @@ -35,6 +37,7 @@ import Data.List(partition) import qualified Data.Foldable as F import qualified Data.Semigroup as S import Internal.Chain +import Foreign.Storable(Storable) ------------------------------------------------------------------- @@ -80,8 +83,16 @@ instance (Floating a, Container Vector a, Floating (Vector a), Fractional (Matri -------------------------------------------------------------------------------- +isScalar :: Matrix t -> Bool isScalar m = rows m == 1 && cols m == 1 +adaptScalarM :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2) + => (t1 -> Matrix t2 -> t) + -> (Matrix t1 -> Matrix t2 -> t) + -> (Matrix t1 -> t2 -> t) + -> Matrix t1 + -> Matrix t2 + -> t adaptScalarM f1 f2 f3 x y | isScalar x = f1 (x @@>(0,0) ) y | isScalar y = f3 x (y @@>(0,0) ) @@ -96,7 +107,7 @@ instance (Container Vector t, Eq t, Num (Vector t), Product t) => M.Monoid (Matr where mempty = 1 mappend = adaptScalarM scale mXm (flip scale) - + mconcat xs = work (partition isScalar xs) where work (ss,[]) = product ss @@ -106,4 +117,3 @@ instance (Container Vector t, Eq t, Num (Vector t), Product t) => M.Monoid (Matr | otherwise = scale x00 m where x00 = x @@> (0,0) - diff --git a/packages/base/src/Numeric/Vector.hs b/packages/base/src/Numeric/Vector.hs index 017196c..1e5877d 100644 --- a/packages/base/src/Numeric/Vector.hs +++ b/packages/base/src/Numeric/Vector.hs @@ -3,6 +3,9 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} + ----------------------------------------------------------------------------- -- | -- Module : Numeric.Vector @@ -14,7 +17,7 @@ -- -- Provides instances of standard classes 'Show', 'Read', 'Eq', -- 'Num', 'Fractional', and 'Floating' for 'Vector'. --- +-- ----------------------------------------------------------------------------- module Numeric.Vector () where @@ -23,9 +26,17 @@ import Internal.Vectorized import Internal.Vector import Internal.Numeric import Internal.Conversion +import Foreign.Storable(Storable) ------------------------------------------------------------------- +adaptScalar :: (Foreign.Storable.Storable t1, Foreign.Storable.Storable t2) + => (t1 -> Vector t2 -> t) + -> (Vector t1 -> Vector t2 -> t) + -> (Vector t1 -> t2 -> t) + -> Vector t1 + -> Vector t2 + -> t adaptScalar f1 f2 f3 x y | dim x == 1 = f1 (x@>0) y | dim y == 1 = f3 x (y@>0) @@ -172,4 +183,3 @@ instance Floating (Vector (Complex Float)) where sqrt = vectorMapQ Sqrt (**) = adaptScalar (vectorMapValQ PowSV) (vectorZipQ Pow) (flip (vectorMapValQ PowVS)) pi = fromList [pi] - diff --git a/packages/gsl/src/Graphics/Plot.hs b/packages/gsl/src/Graphics/Plot.hs index d2ea192..e422912 100644 --- a/packages/gsl/src/Graphics/Plot.hs +++ b/packages/gsl/src/Graphics/Plot.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- -- | -- Module : Graphics.Plot diff --git a/packages/gsl/src/Numeric/GSL/Fitting.hs b/packages/gsl/src/Numeric/GSL/Fitting.hs index 8f2eae3..a732c25 100644 --- a/packages/gsl/src/Numeric/GSL/Fitting.hs +++ b/packages/gsl/src/Numeric/GSL/Fitting.hs @@ -1,6 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {- | Module : Numeric.GSL.Fitting Copyright : (c) Alberto Ruiz 2010 diff --git a/packages/gsl/src/Numeric/GSL/Fourier.hs b/packages/gsl/src/Numeric/GSL/Fourier.hs index bffab87..ed7353a 100644 --- a/packages/gsl/src/Numeric/GSL/Fourier.hs +++ b/packages/gsl/src/Numeric/GSL/Fourier.hs @@ -1,5 +1,7 @@ {-# LANGUAGE TypeFamilies #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {- | Module : Numeric.GSL.Fourier Copyright : (c) Alberto Ruiz 2006 diff --git a/packages/gsl/src/Numeric/GSL/Integration.hs b/packages/gsl/src/Numeric/GSL/Integration.hs index 9c1d43a..0a1b4c6 100644 --- a/packages/gsl/src/Numeric/GSL/Integration.hs +++ b/packages/gsl/src/Numeric/GSL/Integration.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {- | Module : Numeric.GSL.Integration Copyright : (c) Alberto Ruiz 2006 diff --git a/packages/gsl/src/Numeric/GSL/Internal.hs b/packages/gsl/src/Numeric/GSL/Internal.hs index f70e167..1217162 100644 --- a/packages/gsl/src/Numeric/GSL/Internal.hs +++ b/packages/gsl/src/Numeric/GSL/Internal.hs @@ -1,5 +1,8 @@ {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + -- | -- Module : Numeric.GSL.Internal -- Copyright : (c) Alberto Ruiz 2009 diff --git a/packages/gsl/src/Numeric/GSL/Interpolation.hs b/packages/gsl/src/Numeric/GSL/Interpolation.hs index 6f02405..484d2a2 100644 --- a/packages/gsl/src/Numeric/GSL/Interpolation.hs +++ b/packages/gsl/src/Numeric/GSL/Interpolation.hs @@ -1,5 +1,7 @@ {-# LANGUAGE MagicHash, UnboxedTuples #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {- | Module : Numeric.GSL.Interpolation Copyright : (c) Matthew Peddie 2015 diff --git a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs index 1bf357b..aee64f7 100644 --- a/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs +++ b/packages/gsl/src/Numeric/GSL/LinearAlgebra.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ----------------------------------------------------------------------------- -- | -- Module : Numeric.GSL.LinearAlgebra diff --git a/packages/gsl/src/Numeric/GSL/Minimization.hs b/packages/gsl/src/Numeric/GSL/Minimization.hs index a0e5306..1fd951b 100644 --- a/packages/gsl/src/Numeric/GSL/Minimization.hs +++ b/packages/gsl/src/Numeric/GSL/Minimization.hs @@ -1,3 +1,5 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {-# LANGUAGE FlexibleContexts #-} diff --git a/packages/gsl/src/Numeric/GSL/ODE.hs b/packages/gsl/src/Numeric/GSL/ODE.hs index 987d47e..a1ccd38 100644 --- a/packages/gsl/src/Numeric/GSL/ODE.hs +++ b/packages/gsl/src/Numeric/GSL/ODE.hs @@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} {- | Module : Numeric.GSL.ODE diff --git a/packages/gsl/src/Numeric/GSL/Root.hs b/packages/gsl/src/Numeric/GSL/Root.hs index 724f32f..9cdb061 100644 --- a/packages/gsl/src/Numeric/GSL/Root.hs +++ b/packages/gsl/src/Numeric/GSL/Root.hs @@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + {- | Module : Numeric.GSL.Root Copyright : (c) Alberto Ruiz 2009 diff --git a/packages/gsl/src/Numeric/GSL/Vector.hs b/packages/gsl/src/Numeric/GSL/Vector.hs index b1c0106..2ca7cc0 100644 --- a/packages/gsl/src/Numeric/GSL/Vector.hs +++ b/packages/gsl/src/Numeric/GSL/Vector.hs @@ -1,3 +1,6 @@ +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ----------------------------------------------------------------------------- -- | -- Module : Numeric.GSL.Vector diff --git a/packages/special/lib/Numeric/GSL/Special/Bessel.hs b/packages/special/lib/Numeric/GSL/Special/Bessel.hs index 70066f8..84d4cf5 100644 --- a/packages/special/lib/Numeric/GSL/Special/Bessel.hs +++ b/packages/special/lib/Numeric/GSL/Special/Bessel.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Bessel diff --git a/packages/special/lib/Numeric/GSL/Special/Coulomb.hs b/packages/special/lib/Numeric/GSL/Special/Coulomb.hs index 6904739..3bd3ed6 100644 --- a/packages/special/lib/Numeric/GSL/Special/Coulomb.hs +++ b/packages/special/lib/Numeric/GSL/Special/Coulomb.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Coulomb diff --git a/packages/special/lib/Numeric/GSL/Special/Coupling.hs b/packages/special/lib/Numeric/GSL/Special/Coupling.hs index ad120cc..e8d9aef 100644 --- a/packages/special/lib/Numeric/GSL/Special/Coupling.hs +++ b/packages/special/lib/Numeric/GSL/Special/Coupling.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Coupling diff --git a/packages/special/lib/Numeric/GSL/Special/Exp.hs b/packages/special/lib/Numeric/GSL/Special/Exp.hs index b6dfeef..54033c5 100644 --- a/packages/special/lib/Numeric/GSL/Special/Exp.hs +++ b/packages/special/lib/Numeric/GSL/Special/Exp.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Exp diff --git a/packages/special/lib/Numeric/GSL/Special/Gamma.hs b/packages/special/lib/Numeric/GSL/Special/Gamma.hs index 41e24f0..55950cc 100644 --- a/packages/special/lib/Numeric/GSL/Special/Gamma.hs +++ b/packages/special/lib/Numeric/GSL/Special/Gamma.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Gamma diff --git a/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs b/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs index fb8bf3f..1dae1f1 100644 --- a/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs +++ b/packages/special/lib/Numeric/GSL/Special/Gegenbauer.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Gegenbauer diff --git a/packages/special/lib/Numeric/GSL/Special/Legendre.hs b/packages/special/lib/Numeric/GSL/Special/Legendre.hs index 927fa2c..5f7d2b0 100644 --- a/packages/special/lib/Numeric/GSL/Special/Legendre.hs +++ b/packages/special/lib/Numeric/GSL/Special/Legendre.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Legendre diff --git a/packages/special/lib/Numeric/GSL/Special/Trig.hs b/packages/special/lib/Numeric/GSL/Special/Trig.hs index f2c1519..754bed1 100644 --- a/packages/special/lib/Numeric/GSL/Special/Trig.hs +++ b/packages/special/lib/Numeric/GSL/Special/Trig.hs @@ -1,4 +1,8 @@ {-# LANGUAGE CPP #-} + +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} +{-# OPTIONS_GHC -fno-warn-unused-top-binds #-} + ------------------------------------------------------------ -- | -- Module : Numeric.GSL.Special.Trig diff --git a/packages/tests/src/Numeric/GSL/Tests.hs b/packages/tests/src/Numeric/GSL/Tests.hs index 025427b..ed15935 100644 --- a/packages/tests/src/Numeric/GSL/Tests.hs +++ b/packages/tests/src/Numeric/GSL/Tests.hs @@ -1,4 +1,4 @@ -{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns -fno-warn-missing-signatures #-} {- | Module : Numeric.GLS.Tests Copyright : (c) Alberto Ruiz 2014 diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs index 2aefc87..2c98c5a 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests.hs @@ -1,5 +1,5 @@ {-# LANGUAGE CPP #-} -{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns #-} +{-# OPTIONS_GHC -fno-warn-unused-imports -fno-warn-incomplete-patterns -fno-warn-missing-signatures #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} @@ -31,7 +31,7 @@ module Numeric.LinearAlgebra.Tests( --, runBigTests ) where -import Numeric.LinearAlgebra hiding (unitary) +import Numeric.LinearAlgebra import Numeric.LinearAlgebra.Devel import Numeric.LinearAlgebra.Static(L) import Numeric.LinearAlgebra.Tests.Instances @@ -514,7 +514,7 @@ indexProp g f x = a1 == g a2 && a2 == a3 && b1 == g b2 && b2 == b3 -------------------------------------------------------------------------------- -sliceTest = utest "slice test" $ and +_sliceTest = utest "slice test" $ and [ testSlice (chol . trustSym) (gen 5 :: Matrix R) , testSlice (chol . trustSym) (gen 5 :: Matrix C) , testSlice qr (rec :: Matrix R) @@ -841,7 +841,7 @@ runTests n = do , staticTest , intTest , modularTest - , sliceTest + -- , sliceTest ] when (errors c + failures c > 0) exitFailure return () diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs index f0bddd0..59230e0 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Instances.hs @@ -1,4 +1,8 @@ {-# LANGUAGE CPP, FlexibleContexts, UndecidableInstances, FlexibleInstances, ScopedTypeVariables #-} + +{-# OPTIONS_GHC -fno-warn-orphans #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.Tests.Instances @@ -62,7 +66,7 @@ instance KnownNat n => Arbitrary (Static.R n) where n :: Int n = fromIntegral (natVal (Proxy :: Proxy n)) - shrink v = [] + shrink _v = [] instance (Element a, Arbitrary a) => Arbitrary (Matrix a) where arbitrary = do @@ -89,7 +93,7 @@ instance (KnownNat n, KnownNat m) => Arbitrary (Static.L m n) where n :: Int n = fromIntegral (natVal (Proxy :: Proxy n)) - shrink mat = [] + shrink _mat = [] -- a square matrix newtype (Sq a) = Sq (Matrix a) deriving Show diff --git a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs index e3a6242..6cd3a9e 100644 --- a/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs +++ b/packages/tests/src/Numeric/LinearAlgebra/Tests/Properties.hs @@ -3,6 +3,8 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} +{-# OPTIONS_GHC -fno-warn-missing-signatures #-} + ----------------------------------------------------------------------------- {- | Module : Numeric.LinearAlgebra.Tests.Properties @@ -51,14 +53,13 @@ module Numeric.LinearAlgebra.Tests.Properties ( , staticVectorBinaryFailProp ) where -import Numeric.LinearAlgebra.HMatrix hiding (Testable,unitary) +import Numeric.LinearAlgebra.HMatrix hiding (Testable) import qualified Numeric.LinearAlgebra.Static as Static import Test.QuickCheck import Data.Binary import Data.Binary.Get (runGet) import Data.Either (isLeft) -import Debug.Trace (traceShowId) #if MIN_VERSION_base(4,11,0) import Prelude hiding ((<>)) #endif diff --git a/packages/tests/src/TestBase.hs b/packages/tests/src/TestBase.hs index 23fd675..51867b1 100644 --- a/packages/tests/src/TestBase.hs +++ b/packages/tests/src/TestBase.hs @@ -1,3 +1,4 @@ import Numeric.LinearAlgebra.Tests +main :: IO () main = runTests 20 diff --git a/packages/tests/src/TestGSL.hs b/packages/tests/src/TestGSL.hs index 112422d..cc6b1e7 100644 --- a/packages/tests/src/TestGSL.hs +++ b/packages/tests/src/TestGSL.hs @@ -1,3 +1,4 @@ import Numeric.GSL.Tests +main :: IO () main = runTests 20 -- cgit v1.2.3