Merge pull request #691 from hasktorch/feature/ghc963

Bump ghc to 9.6
hasktorch · Apr 22, 2024 · 09e504d · 09e504d
2 parents 816334c 224a34e
commit 09e504d
Show file tree

Hide file tree

Showing 54 changed files with 556 additions and 488 deletions.
diff --git a/.github/workflows/cabal-linux.yml b/.github/workflows/cabal-linux.yml
@@ -7,7 7,7 @@ jobs:
 
  runs-on: ubuntu-latest
  env:
- GHC: '9.2.8'
  GHC: '9.6.4'
  steps:
 
  - uses: actions/checkout@v4

diff --git a/.github/workflows/cabal-macos.yaml b/.github/workflows/cabal-macos.yaml
@@ -6,7 6,7 @@ jobs:
  build:
  runs-on: macOS-latest
  env:
- GHC: '9.2.8'
  GHC: '9.6.4'
  steps:
 
  - uses: actions/checkout@v4

diff --git a/.github/workflows/stack-linux.yml b/.github/workflows/stack-linux.yml
@@ -62,19 62,19 @@ jobs:
  stack test hasktorch
  stack exec codegen-exe
  stack exec xor-mlp
- - name: Build tutorial
- run: |
- stack build tintin
- pushd hasktorch
- stack exec tintin -- run
- popd
- mkdir -p public/tutorial
- cp -r hasktorch/.stack-work/tintin/rendered/* public/tutorial
- - name: Deploy tutorial
- if: github.event_name == 'push' && github.ref == 'refs/heads/master'
- uses: peaceiris/actions-gh-pages@v3
- with:
- deploy_key: ${{ secrets.ACTIONS_DEPLOY_KEY }}
- external_repository: hasktorch/hasktorch.github.io
- publish_branch: tutorial
- publish_dir: ./public
  # - name: Build tutorial
  #  run: |
  #  stack build tintin
  #  pushd hasktorch
  #  stack exec tintin -- run
  #  popd
  #  mkdir -p public/tutorial
  #  cp -r hasktorch/.stack-work/tintin/rendered/* public/tutorial
  # - name: Deploy tutorial
  #  if: github.event_name == 'push' && github.ref == 'refs/heads/master'
  #  uses: peaceiris/actions-gh-pages@v3
  #  with:
  #  deploy_key: ${{ secrets.ACTIONS_DEPLOY_KEY }}
  #  external_repository: hasktorch/hasktorch.github.io
  #  publish_branch: tutorial
  #  publish_dir: ./public
diff --git a/cabal.project b/cabal.project
@@ -4,27 4,47 @@ packages:
  libtorch-ffi-helper/*.cabal
  hasktorch/*.cabal
  examples/*.cabal
 -- experimental/bounding-box/*.cabal
 -- experimental/dataloader-cifar10/*.cabal
 -- experimental/untyped-nlp/*.cabal
  experimental/*/*.cabal
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/tokenizers
- tag: 9d25f0ba303193e97f8b22b9c93cbc84725886c3
- --sha256: 03nm9kd1j6v5ygxiyc86gbr4sjzj4l9xibmpccyws49vwzf02p2k
  tag: addbd197fa71eb0bf875424d015ad9d732f42eed
  subdir: bindings/haskell/tokenizers-haskell
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/typelevel-rewrite-rules
- --sha256: 0nfs6qyrhc2hxskdnlhsr6rrqdqa1kw5a18d2fiybiygxy75z140
- tag: 4176e10d4de2d1310506c0fcf6a74956d81d59b6
  tag: 1f181c3073df201cec45e121f07610b0bfbb6ecd
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/type-errors-pretty
- --sha256: 0sdw3ga7gbffyywpyx7xn8ghdw9gzsy4l68cas41hwfbkrwxwdg6
  tag: 32d7abec6a21c42a5f960d7f4133d604e8be79ec
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/streaming-cassava
  tag: 1ecc4742beae22a2fe32e445a54d1990b6200249
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/indexed-extras
  tag: 7a0c4e918578e7620a46d4f0546fbdaec933ede0
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/term-rewriting
  tag: 54221f58b28c9f36db9bac437231e6142c8cca3a
 
 source-repository-package
  type: git
  location: https://github.com/hasktorch/union-find-array
  tag: 2e94a0e7bdd15d5a7425aca05d64cca8816f2a23
 
 write-ghc-environment-files: always
 tests: true
 documentation: false
diff --git a/codegen/codegen.cabal b/codegen/codegen.cabal
@@ -53,7 53,7 @@ executable codegen-exe
 
 test-suite doctests
  -- ToDo: Fix doctests
- build: disabled
  Buildable: False
  default-language: Haskell2010
  type: exitcode-stdio-1.0
  hs-source-dirs: test

diff --git a/deps/get-wheel.sh b/deps/get-wheel.sh
@@ -2,7 2,7 @@
 
 set -eu
 
-VERSION=1.11.0
 VERSION=2.0.0
 
 case "$(uname)-$(uname -p)" in
  "Darwin-arm")

diff --git a/examples/examples.cabal b/examples/examples.cabal
@@ -23,6 23,8 @@ common config
  , ghc-typelits-knownnat
  , ghc-typelits-natnormalise
  , mtl
  default-extensions: Strict
  , StrictData
 
 executable xor-mlp
  import: config

diff --git a/examples/minimal-text-example/Hello.hs b/examples/minimal-text-example/Hello.hs
@@ -5,7 5,7 @@
 
 module Main where
 
-import Control.Monad (when)
 import Control.Monad (when, foldM)
 import Control.Monad.State.Strict
 import Data.List
 import Elman

diff --git a/examples/mnist-mlp/datasets b/examples/mnist-mlp/datasets
diff --git a/examples/rnn/Main.hs b/examples/rnn/Main.hs
@@ -6,6 6,7 @@
 module Main where
 
 import Control.Monad.State.Strict
 import Control.Monad
 import Data.List (foldl', intersperse, scanl')
 import Elman
 import GHC.Generics

diff --git a/examples/typed-transformer/Main.hs b/examples/typed-transformer/Main.hs
@@ -291,7 291,16 @@ evaluation ::
  outputs
  target
  m.
- ( HasScatter workerDevices dataDevice input inputs,
  ( 1 <= seqLen,
  1 <= numEmbeds,
  workerDevices ~ WorkerDevices,
  modelDevice ~ ModelDevice,
  dtype ~ 'Float,
  inputs ~ '[Tensor '( 'CPU, 0) 'Int64 '[batchSize, seqLen]],
  outputs ~ '[Tensor '( 'CPU, 0) dtype '[batchSize, seqLen, numEmbeds]],
  models ~ '[Model numEmbeds modelDevice],
  model ~ Model numEmbeds modelDevice,
  HasScatter workerDevices dataDevice input inputs,
  HasReplicate workerDevices modelDevice model models,
  HZipWithM Concurrently ForwardConcurrentlyF models inputs outputs,
  HasGather dataDevice workerDevices outputs output,
@@ -345,7 354,17 @@ learning ::
  gradients
  tensors
  m.
- ( HasScatter workerDevices dataDevice input inputs,
  ( 1 <= numEmbeds,
  1 <= seqLen,
  dtype ~ 'Float,
  workerDevices ~ WorkerDevices,
  modelDevice ~ ModelDevice,
  dataDevice ~ DataDevice,
  inputs ~ '[Tensor '( 'CPU, 0) 'Int64 '[batchSize, seqLen]],
  outputs ~ '[Tensor '( 'CPU, 0) dtype '[batchSize, seqLen, numEmbeds]],
  models ~ '[Model numEmbeds modelDevice],
  model ~ Model numEmbeds modelDevice,
  HasScatter workerDevices dataDevice input inputs,
  HasScatter workerDevices dataDevice target targets,
  HasReplicate workerDevices modelDevice model models,
  HZip inputs targets inputTargets,

diff --git a/experimental/gradually-typed/examples/neural-interpreter/STLC.hs b/experimental/gradually-typed/examples/neural-interpreter/STLC.hs
@@ -11,6 11,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE GADTs #-}
 
 
 module STLC where
 
@@ -21,7 23,7 @@ import Control.Monad.State (MonadState, modify)
 import Control.Monad.Trans.Maybe (MaybeT (..))
 import Data.Aeson (FromJSON, ToJSON)
 import Data.Deriving (deriveEq1, deriveOrd1, deriveShow1)
-import Data.Functor.Classes (compare1, eq1, showsPrec1)
 import Data.Functor.Classes (compare1, eq1, showsPrec1, Eq1)
 import Data.Hashable (Hashable)
 import Data.Hashable.Lifted (Hashable1)
 import Data.Map (Map)
@@ -93,15 95,15 @@ instance ToJSON a => ToJSON (Scope () Exp a)
 
 instance ToJSON a => ToJSON (Exp a)
 
-deriveEq1 ''Exp
-deriveShow1 ''Exp
-deriveOrd1 ''Exp
-
-instance Eq a => Eq (Exp a) where (==) = eq1
-
-instance Ord a => Ord (Exp a) where compare = compare1
-
-instance Show a => Show (Exp a) where showsPrec = showsPrec1
 fmap concat $ sequence
  [ deriveEq1  ''Exp
  , deriveOrd1  ''Exp
  , deriveShow1 ''Exp
  , [d| instance Eq a => Eq (Exp a) where (==) = eq1
  instance Ord a => Ord (Exp a) where compare = compare1
  instance Show a => Show (Exp a) where showsPrec = showsPrec1
  |]
  ]
 
 instance (Eq a, Hashable a) => Hashable (Exp a)
 

diff --git a/experimental/gradually-typed/hasktorch-gradually-typed.cabal b/experimental/gradually-typed/hasktorch-gradually-typed.cabal
@@ -292,7 292,7 @@ test-suite doctests
  ghc-options: -Wall -threaded -fplugin GHC.TypeLits.Normalise -fplugin GHC.TypeLits.KnownNat.Solver -fplugin GHC.TypeLits.Extra.Solver -fconstraint-solver-iterations=0
  default-language: Haskell2010
  build-depends: base >= 4.7 && < 5
- , doctest >=0.16.0.1 && <0.21
  , doctest >=0.16.0.1 && <0.23
  , hasktorch
  , libtorch-ffi == 2.0.*
  , ghc-typelits-extra

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Class.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Class.hs
@@ -40,17 40,20 @@ import qualified Data.Vector.Generic.Sized.Internal as VGS
 import qualified Data.Vector.Sized as VS
 import Foreign.ForeignPtr (ForeignPtr)
 import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), (:*:) (..))
-import GHC.TypeLits (Nat, natVal, type ( ))
 import GHC.TypeLits -- (Nat, natVal, type ( ), SNat(..), SNat)
 import Torch.GraduallyTyped.Device (Device, DeviceType)
 import qualified Torch.GraduallyTyped.Internal.Vector as V
-import Torch.GraduallyTyped.Prelude.TypeLits (SNat (..))
 -- import Torch.GraduallyTyped.Prelude.TypeLits (SNat (..))
 import Torch.GraduallyTyped.Random (Generator)
 import Torch.GraduallyTyped.Shape.Type (SDim)
 import Torch.GraduallyTyped.Tensor.Type (Tensor (..), TensorSpec (..), UncheckedTensor, sCheckedDataType, sCheckedLayout, sCheckedShape, sSetDevice, sSetGradient)
 import qualified Torch.Internal.Type as ATen (Tensor)
 import qualified Torch.Script (IValue (..))
 import qualified Torch.Serialize (pickleLoad, pickleSave)
 import qualified Torch.Tensor (Tensor (Unsafe))
 -- import GHC.TypeNats
 --import GHC.TypeLits
 
 
 type NamedModel :: Type -> Type
 data NamedModel model = NamedModel Text model

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Functional/Activation.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Functional/Activation.hs
@@ -59,7 59,7 @@ gelu = unsafePerformIO . cast1 ATen.gelu_t
 -- Google's BERT repo (and coincidentally also from OpenAI's GPT).
 -- See also https://arxiv.org/abs/1606.08415.
 --
--- >>> t <- sFull (TensorSpec (SGradient SWithGradient) (SLayout SDense) (SDevice SCPU) (SDataType SFloat) (SShape $ SNil)) 0.5
 -- >>> t <- sFull (TensorSpec (SGradient SWithGradient) (SLayout SDense) (SDevice SCPU) (SDataType SFloat) (SShape $ SNil)) (0.5 :: Prelude.Float)
 -- >>> t' <- geluNew t
 -- >>> fromTensor @Float t'
 -- 0.345714

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Functional/Linear.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Functional/Linear.hs
@@ -36,8 36,7 @@ import Type.Errors.Pretty (type (%), type (<>))
 -- LinearWithBiasF WeightShape BiasShape InputShape :: Shape
 -- [Dim (Name Symbol) (Size Natural)]
 -- = 'Shape
--- '[ 'Dim ('Name "batch") ('Size 20),
--- 'Dim ('Name "output") ('Size 10)]
 -- ['Dim ('Name "batch") ('Size 20), 'Dim ('Name "output") ('Size 10)]
 type family LinearWithBiasF (weightShape :: Shape [Dim (Name Symbol) (Size Nat)]) (biasShape :: Shape [Dim (Name Symbol) (Size Nat)]) (inputShape :: Shape [Dim (Name Symbol) (Size Nat)]) :: Shape [Dim (Name Symbol) (Size Nat)] where
  LinearWithBiasF ('Shape '[]) _ _ = TypeError (LinearWeightDimsErrorMessage '[])
  LinearWithBiasF ('Shape '[weightDim]) _ _ = TypeError (LinearWeightDimsErrorMessage '[weightDim])
@@ -109,13 108,13 @@ type LinearWeightDimsErrorMessage (weightDims :: [Dim (Name Symbol) (Size Nat)])
 -- >>> :type result
 -- result
 -- :: Tensor
--- ('Gradient 'WithoutGradient)
--- ('Layout 'Dense)
--- ('Device 'CPU)
 -- ('Gradient WithoutGradient)
 -- ('Layout Dense)
 -- ('Device CPU)
 -- ('DataType 'Float)
 -- ('Shape
--- '[ 'Dim ('Name "batch") ('Size 20),
---  'Dim ('Name "output") ('Size 10)])
 -- ['Dim ('Name "batch") ('Size 20),
 -- 'Dim ('Name "output") ('Size 10)])
 linearWithBias ::
  forall gradient layout device dataType shape gradient' layout' device' dataType' shape' gradient'' layout'' device'' dataType'' shape''.
  -- | weight

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Functional/NonLinearActivation.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Functional/NonLinearActivation.hs
@@ -55,13 55,13 @@ type family SoftmaxF (selectDim :: SelectDim (By Symbol Nat)) (shape :: Shape [D
 -- >>> :type result
 -- result
 -- :: Tensor
--- ('Gradient 'WithGradient)
--- ('Layout 'Dense)
--- ('Device 'CPU)
 -- ('Gradient WithGradient)
 -- ('Layout Dense)
 -- ('Device CPU)
 -- ('DataType 'Float)
 -- ('Shape
--- '[ 'Dim ('Name "batch") ('Size 32),
---  'Dim ('Name "feature") ('Size 8)])
 -- ['Dim ('Name "batch") ('Size 32),
 -- 'Dim ('Name "feature") ('Size 8)])
 softmax,
  logSoftmax ::
  forall selectDim gradient layout device dataType shape shape' m.

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Transformer/GStack.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/NN/Transformer/GStack.hs
@@ -28,7 28,7 @@ import Torch.GraduallyTyped.NN.Class (HasForward (..), HasInitialize (..), HasSt
 import Torch.GraduallyTyped.NN.Transformer.GBlock (DecoderBlockF, EncoderBlockF, decoderBlockSpec, encoderBlockSpec)
 import Torch.GraduallyTyped.NN.Transformer.Type (STransformerStyle, TransformerStyle)
 import Torch.GraduallyTyped.NN.Type (HasDropout, SHasDropout)
-import Torch.GraduallyTyped.Prelude.TypeLits (SNat (..))
 import Torch.GraduallyTyped.Prelude.TypeLits
 import Torch.GraduallyTyped.RequiresGradient (Gradient, RequiresGradient, SGradient (..))
 import Torch.GraduallyTyped.Shape.Type (Dim, Name, SDim, Size)
 

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/Prelude.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/Prelude.hs
@@ -75,7 75,7 @@ import Control.Applicative (Applicative (liftA2))
 import Control.Monad (MonadPlus, guard, unless, when)
 import Data.Kind (Constraint, Type)
 import Data.Proxy (Proxy (..))
-import Data.Singletons (Demote, SingKind, fromSing)
 import Data.Singletons (Demote, SingKind, fromSing, Sing(..))
 import Data.Type.Bool (If, type (||))
 import Data.Type.Equality (type (==))
 import GHC.Exts (Any)
@@ -188,13 188,13 @@ type family Snd (t :: (k, k')) :: k' where
 --
 -- >>> :kind! Elem String '[]
 -- Elem String '[] :: Bool
--- = 'False
 -- = False
 -- >>> :kind! Elem String '[Int, String]
 -- Elem String '[Int, String] :: Bool
--- = 'True
 -- = True
 -- >>> :kind! Elem String '[Int, Bool]
 -- Elem String '[Int, Bool] :: Bool
--- = 'False
 -- = False
 type family Elem (e :: t) (es :: [t]) :: Bool where
  Elem _ '[] = 'False
  Elem x (x ': _) = 'True
@@ -276,13 276,13 @@ type family Concat (xs :: [k]) (ys :: [k]) :: [k] where
 --
 -- >>> :kind! Contains (Either Int String) Int
 -- Contains (Either Int String) Int :: Bool
--- = 'True
 -- = True
 -- >>> :kind! Contains (Either Int String) Bool
 -- Contains (Either Int String) Bool :: Bool
--- = 'False
 -- = False
 -- >>> :kind! Contains (Either Int String) Either
 -- Contains (Either Int String) Either :: Bool
--- = 'True
 -- = True
 type Contains :: k -> k' -> Bool
 type family Contains (f :: k) (a :: k') :: Bool where
  Contains a a = 'True

diff --git a/experimental/gradually-typed/src/Torch/GraduallyTyped/Prelude/TypeLits.hs b/experimental/gradually-typed/src/Torch/GraduallyTyped/Prelude/TypeLits.hs
@@ -1,8 1,8 @@
 {-# LANGUAGE CPP #-}
 
 #if MIN_VERSION_singletons(3,0,0)
-module Torch.GraduallyTyped.Prelude.TypeLits (module GHC.TypeLits.Singletons) where
-import GHC.TypeLits.Singletons
 module Torch.GraduallyTyped.Prelude.TypeLits (module GHC.TypeLits) where
 import GHC.TypeLits
 #else
 module Torch.GraduallyTyped.Prelude.TypeLits (module Data.Singletons.TypeLits) where
 import Data.Singletons.TypeLits