55e6719 · grenade · git.iko.soy

git.iko.soy/grenade

Make it build with ghc 8.4

commit55e6719fcb486c955a51318b1811e4f49d1470ae authorErik de Castro Lopo <erikd@mega-nerd.com> dateSun 16 Sep 2018, 17:36 (8 years ago) parentefd11f7

7 files changed+63−26

compare with master

unifiedsplit

src/Grenade/Core/Shape.hs+5 src/Grenade/Layers/Convolution.hs+5 src/Grenade/Layers/Crop.hs+6 src/Grenade/Layers/Deconvolution.hs+5 src/Grenade/Layers/Pad.hs+6 src/Grenade/Layers/Pooling.hs+6 test/Test/Grenade/Network.hs+30−26

src/Grenade/Core/Shape.hs+5

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE GADTs #-}

34{-# LANGUAGE KindSignatures #-}

@@ -35,7 +36,11 @@ import Data.Singletons.TypeLits

3536import Data.Vector.Storable ( Vector )

3637import qualified Data.Vector.Storable as V

3738

39+#if MIN_VERSION_base(4,11,0)

40+import GHC.TypeLits hiding (natVal)

41+#else

3842import GHC.TypeLits

43+#endif

3944

4045import qualified Numeric.LinearAlgebra.Static as H

4146import Numeric.LinearAlgebra.Static

src/Grenade/Layers/Convolution.hs+5

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE ScopedTypeVariables #-}

34{-# LANGUAGE RecordWildCards #-}

@@ -29,7 +30,11 @@ import Data.Proxy

2930import Data.Serialize

3031import Data.Singletons.TypeLits

3132

33+#if MIN_VERSION_base(4,11,0)

34+import GHC.TypeLits hiding (natVal)

35+#else

3236import GHC.TypeLits

37+#endif

3338

3439import Numeric.LinearAlgebra hiding ( uniformSample, konst )

3540import qualified Numeric.LinearAlgebra as LA

src/Grenade/Layers/Crop.hs+6

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE ScopedTypeVariables #-}

34{-# LANGUAGE GADTs #-}

@@ -20,7 +21,12 @@ import Data.Maybe

2021import Data.Proxy

2122import Data.Serialize

2223import Data.Singletons.TypeLits

24+

25+#if MIN_VERSION_base(4,11,0)

26+import GHC.TypeLits hiding (natVal)

27+#else

2328import GHC.TypeLits

29+#endif

2430

2531import Grenade.Core

2632import Grenade.Layers.Internal.Pad

src/Grenade/Layers/Deconvolution.hs+5

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE ScopedTypeVariables #-}

34{-# LANGUAGE RecordWildCards #-}

@@ -33,7 +34,11 @@ import Data.Proxy

3334import Data.Serialize

3435import Data.Singletons.TypeLits

3536

37+#if MIN_VERSION_base(4,11,0)

38+import GHC.TypeLits hiding (natVal)

39+#else

3640import GHC.TypeLits

41+#endif

3742

3843import Numeric.LinearAlgebra hiding ( uniformSample, konst )

3944import qualified Numeric.LinearAlgebra as LA

src/Grenade/Layers/Pad.hs+6

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE ScopedTypeVariables #-}

34{-# LANGUAGE GADTs #-}

@@ -20,7 +21,12 @@ import Data.Maybe

2021import Data.Proxy

2122import Data.Serialize

2223import Data.Singletons.TypeLits

24+

25+#if MIN_VERSION_base(4,11,0)

26+import GHC.TypeLits hiding (natVal)

27+#else

2328import GHC.TypeLits

29+#endif

2430

2531import Grenade.Core

2632import Grenade.Layers.Internal.Pad

src/Grenade/Layers/Pooling.hs+6

@@ -1,3 +1,4 @@

1+{-# LANGUAGE CPP #-}

12{-# LANGUAGE DataKinds #-}

23{-# LANGUAGE ScopedTypeVariables #-}

34{-# LANGUAGE StandaloneDeriving #-}

@@ -21,7 +22,12 @@ import Data.Maybe

2122import Data.Proxy

2223import Data.Serialize

2324import Data.Singletons.TypeLits

25+

26+#if MIN_VERSION_base(4,11,0)

27+import GHC.TypeLits hiding (natVal)

28+#else

2429import GHC.TypeLits

30+#endif

2531

2632import Grenade.Core

2733import Grenade.Layers.Internal.Pooling

test/Test/Grenade/Network.hs+30−26

@@ -23,8 +23,6 @@ import Data.Singletons

2323import Data.Singletons.Prelude.List

2424import Data.Singletons.TypeLits

2525

26−-- import Data.Type.Equality

27−

2826import Hedgehog

2927import qualified Hedgehog.Gen as Gen

3028import Hedgehog.Internal.Source

@@ -32,7 +30,12 @@ import Hedgehog.Internal.Property ( failWith )

3230

3331import Grenade

3432

33+#if MIN_VERSION_base(4,11,0)

34+import GHC.TypeLits hiding (natVal)

35+#else

3536import GHC.TypeLits

37+#endif

38+

3639import GHC.TypeLits.Witnesses

3740import Test.Hedgehog.Compat

3841import Test.Hedgehog.TypeLits

@@ -74,8 +77,9 @@ genNetwork =

7477 , pure (SomeNetwork (Elu :~> rest :: Network ( Elu ': layers ) ( h ': h ': hs )))

7578 , pure (SomeNetwork (Softmax :~> rest :: Network ( Softmax ': layers ) ( h ': h ': hs )))

7679 , do -- Reshape to two dimensions

77− let divisors n = 1 : [x | x <- [2..(n-1)], n `rem` x == 0]

78− let len = natVal l

80+ let divisors :: Integer -> [Integer]

81+ divisors n = 1 : [x | x <- [2..(n-1)], n `rem` x == 0]

82+ let len = fromIntegral $ natVal l

7983 rs <- Gen.element $ divisors len

8084 let cs = len `quot` rs

8185 case ( someNatVal rs, someNatVal cs, someNatVal len ) of

@@ -96,8 +100,8 @@ genNetwork =

96100 , do -- Build a convolution layer with one filter output

97101 -- Figure out some kernel sizes which work for this layer

98102 -- There must be a better way than this...

99− let output_r = natVal r

100− let output_c = natVal c

103+ let output_r = fromIntegral $ natVal r

104+ let output_c = fromIntegral $ natVal c

101105

102106 let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]

103107

@@ -136,8 +140,8 @@ genNetwork =

136140 , do -- Build a convolution layer with one filter output

137141 -- Figure out some kernel sizes which work for this layer

138142 -- There must be a better way than this...

139− let output_r = natVal r

140− let output_c = natVal c

143+ let output_r = fromIntegral $ natVal r

144+ let output_c = fromIntegral $ natVal c

141145

142146 let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]

143147

@@ -178,8 +182,8 @@ genNetwork =

178182 pure (SomeNetwork (conv :~> rest :: Network ( Convolution channels 1 kernelRows kernelCols strideRows strideCols ': layers ) ( ('D3 inRows inCols channels) ': h ': hs )))

179183 _ -> Gen.discard -- Can't occur

180184 , do -- Build a Pooling layer

181− let output_r = natVal r

182− let output_c = natVal c

185+ let output_r = fromIntegral $ natVal r

186+ let output_c = fromIntegral $ natVal c

183187

184188 let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]

185189

@@ -215,8 +219,8 @@ genNetwork =

215219 pure (SomeNetwork (Pooling :~> rest :: Network ( Pooling kernelRows kernelCols strideRows strideCols ': layers ) ( ('D2 inRows inCols) ': h ': hs )))

216220 _ -> Gen.discard -- Can't occur

217221 , do -- Build a Pad layer

218− let output_r = natVal r

219− let output_c = natVal c

222+ let output_r = fromIntegral $ natVal r

223+ let output_c = fromIntegral $ natVal c

220224

221225 pad_left <- choose 0 (output_r - 1)

222226 pad_right <- choose 0 (output_r - 1 - pad_left)

@@ -242,8 +246,8 @@ genNetwork =

242246 pure (SomeNetwork (Pad :~> rest :: Network ( Pad padLeft padTop padRight padBottom ': layers ) ( ('D2 inputRows inputColumns) ': h ': hs )))

243247 _ -> Gen.discard -- Can't occur

244248 , do -- Build a Crop layer

245− let output_r = natVal r

246− let output_c = natVal c

249+ let output_r = fromIntegral $ natVal r

250+ let output_c = fromIntegral $ natVal c

247251

248252 crop_left <- choose 0 10

249253 crop_right <- choose 0 10

@@ -275,9 +279,9 @@ genNetwork =

275279 , do -- Build a convolution layer with one filter output

276280 -- Figure out some kernel sizes which work for this layer

277281 -- There must be a better way than this...

278− let output_r = natVal r

279− let output_c = natVal c

280− let output_f = natVal f

282+ let output_r = fromIntegral $ natVal r

283+ let output_c = fromIntegral $ natVal c

284+ let output_f = fromIntegral $ natVal f

281285

282286 let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]

283287

@@ -318,9 +322,9 @@ genNetwork =

318322 pure (SomeNetwork (conv :~> rest :: Network ( Convolution channels filters kernelRows kernelCols strideRows strideCols ': layers ) ( ('D3 inRows inCols channels) ': h ': hs )))

319323 _ -> Gen.discard -- Can't occur

320324 , do -- Build a Pooling layer

321− let output_r = natVal r

322− let output_c = natVal c

323− let output_f = natVal f

325+ let output_r = fromIntegral $ natVal r

326+ let output_c = fromIntegral $ natVal c

327+ let output_f = fromIntegral $ natVal f

324328

325329 let ok extent kernel = [stride | stride <- [ 1 .. extent ], (extent - kernel) `mod` stride == 0]

326330

@@ -359,9 +363,9 @@ genNetwork =

359363 pure (SomeNetwork (Pooling :~> rest :: Network ( Pooling kernelRows kernelCols strideRows strideCols ': layers ) ( ('D3 inRows inCols filters) ': h ': hs )))

360364 _ -> Gen.discard -- Can't occur

361365 , do -- Build a Pad layer

362− let output_r = natVal r

363− let output_c = natVal c

364− let output_f = natVal f

366+ let output_r = fromIntegral $ natVal r

367+ let output_c = fromIntegral $ natVal c

368+ let output_f = fromIntegral $ natVal f

365369

366370 pad_left <- choose 0 (output_r - 1)

367371 pad_right <- choose 0 (output_r - 1 - pad_left)

@@ -389,9 +393,9 @@ genNetwork =

389393 pure (SomeNetwork (Pad :~> rest :: Network ( Pad padLeft padTop padRight padBottom ': layers ) ( ('D3 inputRows inputColumns filters) ': h ': hs )))

390394 _ -> Gen.discard -- Can't occur

391395 , do -- Build a Crop layer

392− let output_r = natVal r

393− let output_c = natVal c

394− let output_f = natVal f

396+ let output_r = fromIntegral $ natVal r

397+ let output_c = fromIntegral $ natVal c

398+ let output_f = fromIntegral $ natVal f

395399

396400 crop_left <- choose 0 10

397401 crop_right <- choose 0 10