HuwCampbell/grenade
1
1
Fork 0
mirror of https://github.com/HuwCampbell/grenade.git synced 2024-09-11 09:45:55 +03:00
Code Issues Projects Releases Wiki Activity

Merge pull request #75 from erikd/master

Browse Source 
Make it build with ghc 8.4
This commit is contained in:
Huw Campbell 2018-09-19 09:46:37 +10:00 committed by GitHub
commit 950be38afe
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
10 changed files with 77 additions and 37 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.travis.yml
View File

@ -4,7 +4,8 @@
env:
- CABALVER=1.22 GHCVER=7.10.3
- CABALVER=1.24 GHCVER=8.0.2
- CABALVER=2.0 GHCVER=8.2.1
- CABALVER=2.0 GHCVER=8.2.2
- CABALVER=2.0 GHCVER=8.4.3
# Note: the distinction between `before_install` and `install` is not important.
before_install:

2
README.md
View File

@ -159,7 +159,7 @@ and the tests run using:
./mafia test
```
Grenade builds with ghc 7.10 and 8.0.
Grenade builds with ghc 7.10, 8.0, 8.2 and 8.4.
Thanks
------

20
grenade.cabal
View File

@ -45,7 +45,9 @@ library
, hmatrix == 0.18.*
, MonadRandom >= 0.4 && < 0.6
, primitive >= 0.6 && < 0.7
, singletons >= 2.1 && < 2.4
-- Versions of singletons are *tightly* coupled with the
-- GHC version so its fine to drop version bounds.
, singletons
, vector >= 0.11 && < 0.13
ghc-options:
@ -146,9 +148,9 @@ test-suite test
ghc-options: -fno-warn-incomplete-patterns
build-depends:
base >= 4.8 && < 5
base
, grenade
, hedgehog >= 0.5 && < 0.6
, hedgehog >= 0.5 && < 0.7
, hmatrix
, mtl
, singletons
@ -174,9 +176,9 @@ benchmark bench
bench
build-depends:
base >= 3 && < 5
, bytestring == 0.10.*
, criterion >= 1.1 && < 1.3
base
, bytestring
, criterion >= 1.1 && < 1.5
, grenade
, hmatrix
@ -191,8 +193,8 @@ benchmark bench-lstm
bench
build-depends:
base >= 3 && < 5
, bytestring == 0.10.*
, criterion == 1.1.*
base
, bytestring
, criterion
, grenade
, hmatrix

5
src/Grenade/Core/Shape.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
@ -35,7 +36,11 @@ import Data.Singletons.TypeLits
import Data.Vector.Storable ( Vector )
import qualified Data.Vector.Storable as V
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import qualified Numeric.LinearAlgebra.Static as H
import Numeric.LinearAlgebra.Static

5
src/Grenade/Layers/Convolution.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
@ -29,7 +30,11 @@ import Data.Proxy
import Data.Serialize
import Data.Singletons.TypeLits
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import Numeric.LinearAlgebra hiding ( uniformSample, konst )
import qualified Numeric.LinearAlgebra as LA

6
src/Grenade/Layers/Crop.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
@ -20,7 +21,12 @@ import Data.Maybe
import Data.Proxy
import Data.Serialize
import Data.Singletons.TypeLits
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import Grenade.Core
import Grenade.Layers.Internal.Pad

5
src/Grenade/Layers/Deconvolution.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE RecordWildCards #-}
@ -33,7 +34,11 @@ import Data.Proxy
import Data.Serialize
import Data.Singletons.TypeLits
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import Numeric.LinearAlgebra hiding ( uniformSample, konst )
import qualified Numeric.LinearAlgebra as LA

6
src/Grenade/Layers/Pad.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE GADTs #-}
@ -20,7 +21,12 @@ import Data.Maybe
import Data.Proxy
import Data.Serialize
import Data.Singletons.TypeLits
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import Grenade.Core
import Grenade.Layers.Internal.Pad

6
src/Grenade/Layers/Pooling.hs
View File

@ -1,3 +1,4 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
@ -21,7 +22,12 @@ import Data.Maybe
import Data.Proxy
import Data.Serialize
import Data.Singletons.TypeLits
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import Grenade.Core
import Grenade.Layers.Internal.Pooling

56
test/Test/Grenade/Network.hs
View File

@ -23,8 +23,6 @@ import Data.Singletons
import Data.Singletons.Prelude.List
import Data.Singletons.TypeLits
-- import Data.Type.Equality
import Hedgehog
import qualified Hedgehog.Gen as Gen
import Hedgehog.Internal.Source
@ -32,7 +30,12 @@ import Hedgehog.Internal.Property ( failWith )
import Grenade
#if MIN_VERSION_base(4,11,0)
import GHC.TypeLits hiding (natVal)
#else
import GHC.TypeLits
#endif
import GHC.TypeLits.Witnesses
import Test.Hedgehog.Compat
import Test.Hedgehog.TypeLits
@ -74,8 +77,9 @@ genNetwork =
, pure (SomeNetwork (Elu :~> rest :: Network ( Elu ': layers ) ( h ': h ': hs )))
, pure (SomeNetwork (Softmax :~> rest :: Network ( Softmax ': layers ) ( h ': h ': hs )))
, do -- Reshape to two dimensions
let divisors n = 1 : [x | x <- [2..(n-1)], n `rem` x == 0]
let len = natVal l
let divisors :: Integer -> [Integer]
divisors n = 1 : [x | x <- [2..(n-1)], n `rem` x == 0]
let len = fromIntegral $ natVal l
rs <- Gen.element $ divisors len
let cs = len `quot` rs
case ( someNatVal rs, someNatVal cs, someNatVal len ) of
@ -96,8 +100,8 @@ genNetwork =
, do -- Build a convolution layer with one filter output
-- Figure out some kernel sizes which work for this layer
-- There must be a better way than this...
let output_r = natVal r
let output_c = natVal c
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]
@ -136,8 +140,8 @@ genNetwork =
, do -- Build a convolution layer with one filter output
-- Figure out some kernel sizes which work for this layer
-- There must be a better way than this...
let output_r = natVal r
let output_c = natVal c
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]
@ -178,8 +182,8 @@ genNetwork =
pure (SomeNetwork (conv :~> rest :: Network ( Convolution channels 1 kernelRows kernelCols strideRows strideCols ': layers ) ( ('D3 inRows inCols channels) ': h ': hs )))
_ -> Gen.discard -- Can't occur
, do -- Build a Pooling layer
let output_r = natVal r
let output_c = natVal c
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]
@ -215,8 +219,8 @@ genNetwork =
pure (SomeNetwork (Pooling :~> rest :: Network ( Pooling kernelRows kernelCols strideRows strideCols ': layers ) ( ('D2 inRows inCols) ': h ': hs )))
_ -> Gen.discard -- Can't occur
, do -- Build a Pad layer
let output_r = natVal r
let output_c = natVal c
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
pad_left <- choose 0 (output_r - 1)
pad_right <- choose 0 (output_r - 1 - pad_left)
@ -242,8 +246,8 @@ genNetwork =
pure (SomeNetwork (Pad :~> rest :: Network ( Pad padLeft padTop padRight padBottom ': layers ) ( ('D2 inputRows inputColumns) ': h ': hs )))
_ -> Gen.discard -- Can't occur
, do -- Build a Crop layer
let output_r = natVal r
let output_c = natVal c
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
crop_left <- choose 0 10
crop_right <- choose 0 10
@ -275,9 +279,9 @@ genNetwork =
, do -- Build a convolution layer with one filter output
-- Figure out some kernel sizes which work for this layer
-- There must be a better way than this...
let output_r = natVal r
let output_c = natVal c
let output_f = natVal f
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let output_f = fromIntegral $ natVal f
let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]
@ -318,9 +322,9 @@ genNetwork =
pure (SomeNetwork (conv :~> rest :: Network ( Convolution channels filters kernelRows kernelCols strideRows strideCols ': layers ) ( ('D3 inRows inCols channels) ': h ': hs )))
_ -> Gen.discard -- Can't occur
, do -- Build a Pooling layer
let output_r = natVal r
let output_c = natVal c
let output_f = natVal f
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let output_f = fromIntegral $ natVal f
let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]
@ -359,9 +363,9 @@ genNetwork =
pure (SomeNetwork (Pooling :~> rest :: Network ( Pooling kernelRows kernelCols strideRows strideCols ': layers ) ( ('D3 inRows inCols filters) ': h ': hs )))
_ -> Gen.discard -- Can't occur
, do -- Build a Pad layer
let output_r = natVal r
let output_c = natVal c
let output_f = natVal f
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let output_f = fromIntegral $ natVal f
pad_left <- choose 0 (output_r - 1)
pad_right <- choose 0 (output_r - 1 - pad_left)
@ -389,9 +393,9 @@ genNetwork =
pure (SomeNetwork (Pad :~> rest :: Network ( Pad padLeft padTop padRight padBottom ': layers ) ( ('D3 inputRows inputColumns filters) ': h ': hs )))
_ -> Gen.discard -- Can't occur
, do -- Build a Crop layer
let output_r = natVal r
let output_c = natVal c
let output_f = natVal f
let output_r = fromIntegral $ natVal r
let output_c = fromIntegral $ natVal c
let output_f = fromIntegral $ natVal f
crop_left <- choose 0 10
crop_right <- choose 0 10