diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,5 +1,27 @@ # Change Log +## [v0.4.0](https://github.com/tweag/linear-base/tree/v0.4.0) (2023-10-13) + +[Full Changelog](https://github.com/tweag/linear-base/compare/v0.3.1...v0.4.0) + +### Headline changes + +- Deprecate cycle, repeat, and iterate for lists [\#458](https://github.com/tweag/linear-base/pull/458) ([treeowl](https://github.com/treeowl)) +- Compability with GHC 9.8 [\#457](https://github.com/tweag/linear-base/pull/457) ([monoidal](https://github.com/monoidal)) +- Drop compatibility with GHC 9.0 [\#442](https://github.com/tweag/linear-base/pull/442) ([aspiwack](https://github.com/aspiwack)) +- Implements `Semigroup` / `Monoid` instances for `Ur` [\#461](https://github.com/tweag/linear-base/pull/461) ([konn](https://github.com/konn)) +- Adds `Functor` instances for the linear arrow [\#460](https://github.com/tweag/linear-base/pull/460) ([konn](https://github.com/konn)) + - This fixes an issue with linear lenses \(both `Data` and `Control`\) [\#459](https://github.com/tweag/linear-base/issues/459) + + +### Miscellaneous + +- Implement toSystemIO safely [\#444](https://github.com/tweag/linear-base/pull/444) ([treeowl](https://github.com/treeowl)) +- Stop testing with GHC 9.2, though it this version is still expected to work [\#448](https://github.com/tweag/linear-base/pull/448) ([tbagrel1](https://github.com/tbagrel1)) +- Benchmarks: + - Moving from gauge to tasty-bench [\#449](https://github.com/tweag/linear-base/pull/449) ([tbagrel1](https://github.com/tbagrel1)) + - More array benchmarks [\#451](https://github.com/tweag/linear-base/pull/451) ([aspiwack](https://github.com/aspiwack)) + ## [v0.3.1](https://github.com/tweag/linear-base/tree/v0.3.1) (2023-03-17) [Full Changelog](https://github.com/tweag/linear-base/compare/v0.3.0...v0.3.1) @@ -114,7 +136,7 @@ - Add `Data.Arity.Linear` module containing type-level helpers to deal with n-ary linear functions and type-level structural integers [\#390](https://github.com/tweag/linear-base/pull/390) ([aspiwack](https://github.com/aspiwack)), [\#391](https://github.com/tweag/linear-base/pull/391) ([tbagrel1](https://github.com/tbagrel1)) - Add `void` function to consume `Control.Functor.Linear.Functor` inner value [\#387](https://github.com/tweag/linear-base/pull/387) ([tbagrel1](https://github.com/tbagrel1)) - Add inspection tests to check inlining of `Data.Replicator.Linear.elim` and `Data.V.Linear.{make,elim}` [\#367](https://github.com/tweag/linear-base/pull/367) ([tbagrel1](https://github.com/tbagrel1)) -- Add `genericTraverse` to `Data.Functor.Linear` for `Generics.Linear.Generic1` types [\#366](https://github.com/tweag/linear-base/pull/366) ([tbagrel1](https://github.com/tbagrel1)), [\#384](https://github.com/tweag/linear-base/pull/384) ([aspiwack](https://github.com/aspiwack)), [\#385](https://github.com/tweag/linear-base/pull/385) ([treeowl](https://github.com/treeowl)) +- Add `genericTraverse` to `Data.Functor.Linear` for `Generics.Linear.Generic1` types [\#366](https://github.com/tweag/linear-base/pull/366) ([tbagrel1](https://github.com/tbagrel1)), [\#384](https://github.com/tweag/linear-base/pull/384) ([aspiwack](https://github.com/aspiwack)), [\#385](https://github.com/tweag/linear-base/pull/385) ([treeowl](https://github.com/treeowl)) - Add `Unsafe.toLinearN` (and narrow the scope of some coercions in the module internals) [\#346](https://github.com/tweag/linear-base/pull/346) ([treeowl](https://github.com/treeowl)) - Add newtype `Data.Unrestricted.Linear.AsMovable` to derive `Consumable` and `Dupable` from `Movable` [\#357](https://github.com/tweag/linear-base/pull/357) ([tbagrel1](https://github.com/tbagrel1)) - Add `Data.Unrestricted.Linear.{Consumable,Dupable,Moveable}` instances for all Word and Int types [\#352](https://github.com/tweag/linear-base/pull/352) ([googleson78](https://github.com/googleson78)) diff --git a/bench/Data/Mutable/Array.hs b/bench/Data/Mutable/Array.hs --- a/bench/Data/Mutable/Array.hs +++ b/bench/Data/Mutable/Array.hs @@ -1,49 +1,63 @@ -{-# LANGUAGE BangPatterns #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE GADTs #-} {-# LANGUAGE LinearTypes #-} +{-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE NumericUnderscores #-} -{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE QuantifiedConstraints #-} +{-# LANGUAGE RankNTypes #-} +{-# LANGUAGE StandaloneKindSignatures #-} +-- Uncomment the line below to observe the generated (optimised) Core. It will +-- land in a file named “Array.dump-simpl” +-- {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -dsuppress-uniques #-} + module Data.Mutable.Array (benchmarks) where import Control.DeepSeq (rnf) import qualified Data.Array.Mutable.Linear as Array.Linear -import Data.Function ((&)) +import qualified Data.Array.Mutable.Linear as Array.Linear.Array +import qualified Data.Foldable +import Data.Functor.Compose +import Data.Kind +import qualified Data.Sequence import qualified Data.Unrestricted.Linear as Linear import qualified Data.Vector -import Gauge +import Prelude.Linear (($), (&)) import qualified Prelude.Linear as Linear - -dontFuse :: a -> a -dontFuse a = a -{-# NOINLINE dontFuse #-} +import Test.Tasty.Bench +import Prelude hiding (($)) arr_size :: Int -arr_size = 10_000_000 +arr_size = 1_000 benchmarks :: Benchmark benchmarks = bgroup "arrays" - [ runImpls "toList" bToList arr_size, - runImpls "map" bMap arr_size, - runImpls "reads" bReads arr_size - ] + $ runImpls + [ bAlloc, + bToList, + bMap, + bReads, + bSets + ] -------------------------------------------------------------------------------- -data Impls - = Impls - (Array.Linear.Array Int %1 -> ()) - (Data.Vector.Vector Int -> ()) +data Impl where + Impl :: String -> (forall arr. (ArrayThing arr) => arr Int %1 -> ()) -> Impl -runImpls :: String -> Impls -> Int -> Benchmark -runImpls name impls size = - let Impls linear dataVector = impls - in bgroup - name - [ bench "Data.Array.Mutable.Linear" $ whnf (runLinear linear) size, - bench "Data.Vector" $ whnf (runDataVector dataVector) size - ] +runImpls :: [Impl] -> [Benchmark] +runImpls = map (runImpl arr_size) + +runImpl :: Int -> Impl -> Benchmark +runImpl sz0 (Impl name impl) = + bgroup + name + [ bench "Data.Array.Mutable.Linear" $ whnf (runLinear impl) sz0, + bench "Data.Vector" $ whnf (runDataVector (cleanup impl)) sz0, + bench "Data.Sequence" $ whnf (runSequence (cleanup impl)) sz0 + ] where runLinear :: (Array.Linear.Array Int %1 -> ()) -> Int -> () runLinear cb sz = Linear.unur (Array.Linear.alloc sz 0 (\a -> Linear.move (cb a))) @@ -51,73 +65,127 @@ runDataVector :: (Data.Vector.Vector Int -> ()) -> Int -> () runDataVector cb sz = cb (Data.Vector.replicate sz 0) --------------------------------------------------------------------------------- + runSequence :: (Data.Sequence.Seq Int -> ()) -> Int -> () + runSequence cb sz = cb (Data.Sequence.replicate sz 0) +{-# INLINE runImpl #-} -bToList :: Impls -bToList = Impls linear dataVector - where - linear :: Array.Linear.Array Int %1 -> () - linear hm = - hm - Linear.& Array.Linear.toList - Linear.& Linear.lift rnf - Linear.& Linear.unur +type ArrayThing :: (Type -> Type) -> Constraint +class ArrayThing arr where + size :: arr a %1 -> (Linear.Ur Int, arr a) + get :: Int -> arr a %1 -> (Linear.Ur a, arr a) + set :: Int -> a -> arr a %1 -> arr a + toList :: arr a %1 -> Linear.Ur [a] + amap :: (a -> b) -> arr a %1 -> arr b - dataVector :: Data.Vector.Vector Int -> () - dataVector hm = - hm - & Data.Vector.toList - & rnf -{-# NOINLINE bToList #-} + -- | Note: I [Arnaud Spiwack] initially thought I could use + -- 'Consumable'/'consume' for this. But it doesn't work because the natural + -- 'consume' function for `Ur x` doesn't evaluate the `x` at all. We need to + -- evaluate the `x` in the 'Vector' instance. + force :: arr a %1 -> () -bMap :: Impls -bMap = Impls linear dataVector +type UArrayThing :: (Type -> Type) -> Constraint +class UArrayThing arr where + usize :: arr a -> Int + uget :: Int -> arr a -> a + uset :: Int -> a -> arr a -> arr a + utoList :: arr a -> [a] + uamap :: (a -> b) -> arr a -> arr b + uforce :: arr a -> () + +instance ArrayThing Array.Linear.Array where + size = Array.Linear.Array.size + get = Array.Linear.Array.unsafeGet + set = Array.Linear.Array.unsafeSet + toList = Array.Linear.Array.toList + amap = Array.Linear.Array.map + force = Linear.consume + +instance (UArrayThing arr) => ArrayThing (Compose Linear.Ur arr) where + size (Compose (Linear.Ur arr)) = (Linear.Ur (usize arr), Compose (Linear.Ur arr)) + get i (Compose (Linear.Ur arr)) = (Linear.Ur (uget i arr), Compose (Linear.Ur arr)) + set i a (Compose (Linear.Ur arr)) = Compose (Linear.Ur (uset i a arr)) + toList (Compose (Linear.Ur arr)) = Linear.Ur (utoList arr) + amap f (Compose (Linear.Ur arr)) = Compose (Linear.Ur (uamap f arr)) + force (Compose (Linear.Ur arr)) = uforce arr + +instance UArrayThing Data.Vector.Vector where + usize = Data.Vector.length + uget i v = v Data.Vector.! i + uset i a v = v Data.Vector.// [(i, a)] + utoList = Data.Vector.toList + uamap = Data.Vector.map + uforce = (`seq` ()) + +instance UArrayThing Data.Sequence.Seq where + usize = Data.Sequence.length + uget i s = Data.Sequence.index s i + uset = Data.Sequence.update + utoList = Data.Foldable.toList + uamap = fmap + + -- I'm not sure about this one: on the one hand it forces the data structure + -- to be allocated. On the other hand, it will do an extra traversal. Maybe + -- there's a better comparison that can be done. + uforce s = (foldMap (\_ -> Strict) s) `seq` () + +cleanup :: ((Compose Linear.Ur f a) %1 -> b) -> (f a -> b) +cleanup k a = k (Compose (Linear.Ur a)) + +data Strict = Strict + +instance Semigroup Strict where + Strict <> x = x + +instance Monoid Strict where + mempty = Strict + +-------------------------------------------------------------------------------- + +bToList :: Impl +bToList = Impl "toList" impl where - linear :: Array.Linear.Array Int %1 -> () - linear hm = - hm - Linear.& Array.Linear.map (+ 1) - Linear.& Array.Linear.unsafeGet 5 - Linear.& (`Linear.lseq` ()) + impl :: (ArrayThing arr) => arr Int %1 -> () + impl arr = arr & toList & Linear.lift rnf & Linear.unur - dataVector :: Data.Vector.Vector Int -> () - dataVector hm = - hm - & Data.Vector.map (+ 1) - & dontFuse -- This looks like cheating, I know. But we're trying to measure - -- the speed of `map`, and without this, `vector` fuses the `map` - -- with the subsequent `index` to skip writing to the rest of the - -- vector. - & (`Data.Vector.unsafeIndex` 5) - & (`seq` ()) -{-# NOINLINE bMap #-} +bMap :: Impl +bMap = Impl "map" impl + where + impl :: (ArrayThing arr) => arr Int %1 -> () + impl arr = + case arr & amap (+ 1) & get 5 of + (Linear.Ur _, arr') -> force arr' -bReads :: Impls -bReads = Impls linear dataVector +bReads :: Impl +bReads = Impl "reads" impl where - linear :: Array.Linear.Array Int %1 -> () - linear hm = - hm - Linear.& Array.Linear.size - Linear.& \(Linear.Ur sz, arr) -> - arr - Linear.& go 0 sz + impl :: (ArrayThing arr) => arr Int %1 -> () + impl arr0 = + case size arr0 of + (Linear.Ur sz, arr) -> go 0 sz arr where - go :: Int -> Int -> Array.Linear.Array Int %1 -> () + go :: (ArrayThing arr) => Int -> Int -> arr Int %1 -> () go start end arr | start < end = - Array.Linear.unsafeGet start arr - Linear.& \(Linear.Ur i, arr') -> i `Linear.seq` go (start + 1) end arr' - | otherwise = arr `Linear.lseq` () + case get start arr of + (Linear.Ur i, arr') -> i `Linear.seq` go (start + 1) end arr' + | otherwise = force arr - dataVector :: Data.Vector.Vector Int -> () - dataVector v = - let sz = Data.Vector.length v - in go 0 sz +bAlloc :: Impl +bAlloc = Impl "alloc" impl + where + impl :: (ArrayThing arr) => arr Int %1 -> () + impl = force + +bSets :: Impl +bSets = Impl "successive writes (very unfair to vector)" impl + where + impl :: (ArrayThing arr) => arr Int %1 -> () + impl arr0 = + case size arr0 of + (Linear.Ur sz, arr) -> go 0 sz arr where - go :: Int -> Int -> () - go start end + go :: (ArrayThing arr) => Int -> Int -> arr Int %1 -> () + go start end arr | start < end = - (v Data.Vector.! start) `seq` go (start + 1) end - | otherwise = () -{-# NOINLINE bReads #-} + go (start + 1) end Linear.$ set start 42 arr + | otherwise = force arr diff --git a/bench/Data/Mutable/HashMap.hs b/bench/Data/Mutable/HashMap.hs --- a/bench/Data/Mutable/HashMap.hs +++ b/bench/Data/Mutable/HashMap.hs @@ -11,7 +11,7 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TupleSections #-} -module Data.Mutable.HashMap (hmbench) where +module Data.Mutable.HashMap (benchmarks) where import Control.DeepSeq (NFData (..), deepseq, force) import qualified Control.Monad.Random as Random @@ -25,9 +25,9 @@ import Data.List (foldl') import qualified Data.Unrestricted.Linear as Linear import GHC.Generics (Generic) -import Gauge import qualified Prelude.Linear as Linear import qualified System.Random.Shuffle as Random +import Test.Tasty.Bench -- # Exported benchmarks ------------------------------------------------------------------------------- @@ -60,8 +60,8 @@ instance NFData BenchInput -hmbench :: Benchmark -hmbench = +benchmarks :: Benchmark +benchmarks = bgroup "hashmaps" [ bgroup "linear-base:Data.HashMap.Mutable.Linear" $ diff --git a/bench/Main.hs b/bench/Main.hs --- a/bench/Main.hs +++ b/bench/Main.hs @@ -1,12 +1,12 @@ module Main where import qualified Data.Mutable.Array as Array -import Data.Mutable.HashMap (hmbench) -import Gauge +import qualified Data.Mutable.HashMap as HashMap +import Test.Tasty.Bench (defaultMain) main :: IO () main = do defaultMain - [ hmbench, - Array.benchmarks + [ Array.benchmarks, + HashMap.benchmarks ] diff --git a/examples/Foreign/List.hs b/examples/Foreign/List.hs --- a/examples/Foreign/List.hs +++ b/examples/Foreign/List.hs @@ -22,7 +22,7 @@ -- TODO: generating appropriate instances using the Generic framework instance - Manual.Representable a => + (Manual.Representable a) => Manual.MkRepresentable (List a) (Maybe (a, Box (List a))) where toRepr Nil = Nothing @@ -31,7 +31,7 @@ ofRepr Nothing = Nil ofRepr (Just (a, l)) = Cons a l -instance Manual.Representable a => Manual.Representable (List a) where +instance (Manual.Representable a) => Manual.Representable (List a) where type AsKnown (List a) = Manual.AsKnown (Maybe (a, Box (List a))) -- Remark: this is a bit wasteful, we could implement an allocation-free map by @@ -49,11 +49,11 @@ withPools (pool1, pool2) a' l' = Cons (f a') (Manual.alloc (map f l' pool1) pool2) -foldr :: forall a b. Manual.Representable a => (a %1 -> b %1 -> b) -> b %1 -> List a %1 -> b +foldr :: forall a b. (Manual.Representable a) => (a %1 -> b %1 -> b) -> b %1 -> List a %1 -> b foldr _f seed Nil = seed foldr f seed (Cons a l) = f a (foldr f seed (Manual.deconstruct l)) -foldl :: forall a b. Manual.Representable a => (b %1 -> a %1 -> b) -> b %1 -> List a %1 -> b +foldl :: forall a b. (Manual.Representable a) => (b %1 -> a %1 -> b) -> b %1 -> List a %1 -> b foldl _f seed Nil = seed foldl f seed (Cons a l) = foldl f (f seed a) (Manual.deconstruct l) @@ -61,7 +61,7 @@ -- | Make a 'List' from a stream. 'List' is a type of strict lists, therefore -- the stream must terminate otherwise 'unfold' will loop. Not tail-recursive. -unfold :: forall a s. Manual.Representable a => (s -> Maybe (a, s)) -> s -> Pool %1 -> List a +unfold :: forall a s. (Manual.Representable a) => (s -> Maybe (a, s)) -> s -> Pool %1 -> List a unfold step state pool = dispatch (step state) (dup pool) where -- XXX: ^ The reason why we need to `dup` the pool before we know whether the @@ -76,7 +76,7 @@ -- | Linear variant of 'unfold'. Note how they are implemented exactly -- identically. They could be merged if multiplicity polymorphism was supported. -unfoldL :: forall a s. Manual.Representable a => (s %1 -> Maybe (a, s)) -> s %1 -> Pool %1 -> List a +unfoldL :: forall a s. (Manual.Representable a) => (s %1 -> Maybe (a, s)) -> s %1 -> Pool %1 -> List a unfoldL step state pool = dispatch (step state) (dup pool) where dispatch :: Maybe (a, s) %1 -> (Pool, Pool) %1 -> List a @@ -84,14 +84,14 @@ dispatch (Just (a, next)) (pool1, pool2) = Cons a (Manual.alloc (unfoldL step next pool1) pool2) -ofList :: Manual.Representable a => [a] -> Pool %1 -> List a +ofList :: (Manual.Representable a) => [a] -> Pool %1 -> List a ofList l pool = unfold List.uncons l pool -toList :: Manual.Representable a => List a %1 -> [a] +toList :: (Manual.Representable a) => List a %1 -> [a] toList l = foldr (:) [] l -- | Like unfold but builds the list in reverse, and tail recursive -runfold :: forall a s. Manual.Representable a => (s -> Maybe (a, s)) -> s -> Pool %1 -> List a +runfold :: forall a s. (Manual.Representable a) => (s -> Maybe (a, s)) -> s -> Pool %1 -> List a runfold step state pool = loop state Nil pool where loop :: s -> List a %1 -> Pool %1 -> List a @@ -102,5 +102,5 @@ dispatch (Just (a, next)) !acc (pool1, pool2) = loop next (Cons a (Manual.alloc acc pool1)) pool2 -ofRList :: Manual.Representable a => [a] -> Pool %1 -> List a +ofRList :: (Manual.Representable a) => [a] -> Pool %1 -> List a ofRList l pool = runfold List.uncons l pool diff --git a/examples/Simple/FileIO.hs b/examples/Simple/FileIO.hs --- a/examples/Simple/FileIO.hs +++ b/examples/Simple/FileIO.hs @@ -8,7 +8,6 @@ {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} -{-# LANGUAGE TypeInType #-} {-# LANGUAGE TypeOperators #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} diff --git a/examples/Simple/Quicksort.hs b/examples/Simple/Quicksort.hs --- a/examples/Simple/Quicksort.hs +++ b/examples/Simple/Quicksort.hs @@ -55,7 +55,7 @@ & \arr3 -> partition arr3 pivot (lx + 1) (rx - 1) -- | @swap a i j@ exchanges the positions of values at @i@ and @j@ of @a@. -swap :: HasCallStack => Array Int %1 -> Int -> Int -> Array Int +swap :: (HasCallStack) => Array Int %1 -> Int -> Int -> Array Int swap arr i j = Array.read arr i & \(Ur ival, arr1) -> diff --git a/linear-base.cabal b/linear-base.cabal --- a/linear-base.cabal +++ b/linear-base.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: linear-base -version: 0.3.1 +version: 0.4.0 license: MIT license-file: LICENSE copyright: (c) Tweag Holding and affiliates @@ -132,7 +132,7 @@ default-language: Haskell2010 build-depends: - base >=4.15 && <5, + base >=4.16 && <5, containers, ghc-prim, hashable, @@ -214,13 +214,14 @@ default-language: Haskell2010 build-depends: base, + containers, vector, deepseq, - gauge, hashtables, hashable, linear-base, random, random-shuffle, + tasty-bench >= 0.3, unordered-containers, MonadRandom diff --git a/src/Control/Functor/Linear/Internal/Class.hs b/src/Control/Functor/Linear/Internal/Class.hs --- a/src/Control/Functor/Linear/Internal/Class.hs +++ b/src/Control/Functor/Linear/Internal/Class.hs @@ -47,11 +47,12 @@ import qualified Data.Functor.Linear.Internal.Applicative as Data import qualified Data.Functor.Linear.Internal.Functor as Data import Data.Functor.Sum +import Data.Kind (FUN) import Data.Monoid.Linear hiding (Sum) import Data.Type.Bool import Data.Unrestricted.Linear.Internal.Consumable import GHC.TypeLits -import GHC.Types (Type) +import GHC.Types (Multiplicity (..), Type) import Generics.Linear import Prelude.Linear.Generically import Prelude.Linear.Internal @@ -77,16 +78,16 @@ -- @f a@ holds only one value of type @a@ and represents a computation -- producing an @a@ with an effect. All control functors are data functors, -- but not all data functors are control functors. -class Data.Functor f => Functor f where +class (Data.Functor f) => Functor f where -- | Map a linear function @g@ over a control functor @f a@. -- Note that @g@ is used linearly over the single @a@ in @f a@. fmap :: (a %1 -> b) %1 -> f a %1 -> f b -- | Apply the control @fmap@ over a data functor. -dataFmapDefault :: Functor f => (a %1 -> b) -> f a %1 -> f b +dataFmapDefault :: (Functor f) => (a %1 -> b) -> f a %1 -> f b dataFmapDefault f = fmap f -(<$>) :: Functor f => (a %1 -> b) %1 -> f a %1 -> f b +(<$>) :: (Functor f) => (a %1 -> b) %1 -> f a %1 -> f b (<$>) = fmap {-# INLINE (<$>) #-} @@ -95,7 +96,7 @@ -- | @ -- ('<&>') = 'flip' 'fmap' -- @ -(<&>) :: Functor f => f a %1 -> (a %1 -> b) %1 -> f b +(<&>) :: (Functor f) => f a %1 -> (a %1 -> b) %1 -> f b (<&>) a f = f <$> a {-# INLINE (<&>) #-} @@ -139,10 +140,10 @@ liftA2 f x y = f <$> x <*> y -- | Apply the control @pure@ over a data applicative. -dataPureDefault :: Applicative f => a -> f a +dataPureDefault :: (Applicative f) => a -> f a dataPureDefault x = pure x -instance Monoid a => Applicative ((,) a) where +instance (Monoid a) => Applicative ((,) a) where pure x = (mempty, x) (a, f) <*> (b, x) = (a <> b, f x) @@ -172,7 +173,7 @@ -- | Control linear monads. -- A linear monad is one in which you sequence linear functions in a context, -- i.e., you sequence functions of the form @a %1-> m b@. -class Applicative m => Monad m where +class (Applicative m) => Monad m where {-# MINIMAL (>>=) #-} -- | @x >>= g@ applies a /linear/ function @g@ linearly (i.e., using it @@ -187,26 +188,26 @@ -- | This class handles pattern-matching failure in do-notation. -- See "Control.Monad.Fail" for details. -class Monad m => MonadFail m where +class (Monad m) => MonadFail m where fail :: String -> m a -return :: Monad m => a %1 -> m a +return :: (Monad m) => a %1 -> m a return x = pure x {-# INLINE return #-} -- | Given an effect-producing computation that produces an effect-producing computation -- that produces an @a@, simplify it to an effect-producing -- computation that produces an @a@. -join :: Monad m => m (m a) %1 -> m a +join :: (Monad m) => m (m a) %1 -> m a join action = action >>= id -- | Use this operator to define Applicative instances in terms of Monad instances. -ap :: Monad m => m (a %1 -> b) %1 -> m a %1 -> m b +ap :: (Monad m) => m (a %1 -> b) %1 -> m a %1 -> m b ap f x = f >>= (\f' -> fmap f' x) -- | Fold from left to right with a linear monad. -- This is a linear version of 'NonLinear.foldM'. -foldM :: forall m a b. Monad m => (b %1 -> a %1 -> m b) -> b %1 -> [a] %1 -> m b +foldM :: forall m a b. (Monad m) => (b %1 -> a %1 -> m b) -> b %1 -> [a] %1 -> m b foldM _ i [] = return i foldM f i (x : xs) = f i x >>= \i' -> foldM f i' xs @@ -234,7 +235,7 @@ instance Functor ((,,,,) a b c d) -instance Monoid a => Monad ((,) a) where +instance (Monoid a) => Monad ((,) a) where (a, x) >>= f = go a (f x) where go :: a %1 -> (a, b) %1 -> (a, b) @@ -250,6 +251,9 @@ instance (Functor f, Functor g) => Functor (Compose f g) +instance Functor (FUN 'One a) where + fmap = (.) + ------------------------ -- Generics instances -- ------------------------ @@ -268,7 +272,7 @@ NoPar1 Par1 = 'False -- If the generic type does not use its parameter, we can linearly coerce the parameter to any other type. -class NoPar1 f ~ 'True => Unused f where +class (NoPar1 f ~ 'True) => Unused f where unused :: f a %1 -> f b instance Unused U1 where @@ -284,7 +288,7 @@ unused (L1 l) = L1 (unused l) unused (R1 r) = R1 (unused r) -instance Unused f => Unused (M1 i c f) where +instance (Unused f) => Unused (M1 i c f) where unused (M1 a) = M1 (unused a) instance (Unused' (NoPar1 l) l r, (NoPar1 l || NoPar1 r) ~ 'True) => Unused (l :.: r) where @@ -293,7 +297,7 @@ class Unused' (left_unused :: Bool) l r where unused' :: l (r a) %1 -> l (r b) -instance Unused l => Unused' 'True l r where +instance (Unused l) => Unused' 'True l r where unused' = unused instance (Functor l, Unused r) => Unused' 'False l r where @@ -328,7 +332,7 @@ fmap f (L1 a) = L1 (fmap f a) fmap f (R1 a) = R1 (fmap f a) -instance Functor f => Functor (M1 j c f) where +instance (Functor f) => Functor (M1 j c f) where fmap f (M1 a) = M1 (fmap f a) instance Functor Par1 where diff --git a/src/Control/Functor/Linear/Internal/Instances.hs b/src/Control/Functor/Linear/Internal/Instances.hs --- a/src/Control/Functor/Linear/Internal/Instances.hs +++ b/src/Control/Functor/Linear/Internal/Instances.hs @@ -27,9 +27,9 @@ -- # Basic instances ------------------------------------------------------------------------------- -instance Functor f => Data.Functor (Data f) where +instance (Functor f) => Data.Functor (Data f) where fmap f (Data x) = Data (fmap f x) -instance Applicative f => Data.Applicative (Data f) where +instance (Applicative f) => Data.Applicative (Data f) where pure x = Data (pure x) Data f <*> Data x = Data (f <*> x) diff --git a/src/Control/Functor/Linear/Internal/Kan.hs b/src/Control/Functor/Linear/Internal/Kan.hs --- a/src/Control/Functor/Linear/Internal/Kan.hs +++ b/src/Control/Functor/Linear/Internal/Kan.hs @@ -62,11 +62,11 @@ newtype Curried g h a = Curried {runCurried :: forall r. g (a %1 -> r) %1 -> h r} -instance Data.Functor g => Data.Functor (Curried g h) where +instance (Data.Functor g) => Data.Functor (Curried g h) where fmap f (Curried g) = Curried (g . Data.fmap (. f)) {-# INLINE fmap #-} -instance Functor g => Functor (Curried g h) where +instance (Functor g) => Functor (Curried g h) where fmap f (Curried g) = Curried (\x -> g (fmap (\y -> y . f) x)) {-# INLINE fmap #-} @@ -82,7 +82,7 @@ Curried mf <*> Curried ma = Curried (ma . mf . fmap (.)) {-# INLINE (<*>) #-} -lowerCurriedC :: Applicative f => Curried f g a %1 -> g a +lowerCurriedC :: (Applicative f) => Curried f g a %1 -> g a lowerCurriedC (Curried f) = f (pure id) {-# INLINE lowerCurriedC #-} @@ -96,13 +96,13 @@ fmap f (Yoneda m) = Yoneda (\k -> m (k . f)) {-# INLINE fmap #-} -instance Applicative f => Data.Applicative (Yoneda f) where +instance (Applicative f) => Data.Applicative (Yoneda f) where pure a = Yoneda (\f -> pure (f a)) {-# INLINE pure #-} Yoneda m <*> Yoneda n = Yoneda (\f -> m (\g -> f . g) <*> n id) {-# INLINE (<*>) #-} -instance Applicative f => Applicative (Yoneda f) where +instance (Applicative f) => Applicative (Yoneda f) where pure a = Yoneda (\f -> pure (f a)) {-# INLINE pure #-} Yoneda m <*> Yoneda n = Yoneda (\f -> m (\g -> f . g) <*> n id) @@ -113,10 +113,10 @@ {-# INLINE lowerYoneda #-} -- This bit comes from lens. -liftCurriedYonedaC :: Applicative f => f a %1 -> Curried (Yoneda f) (Yoneda f) a +liftCurriedYonedaC :: (Applicative f) => f a %1 -> Curried (Yoneda f) (Yoneda f) a liftCurriedYonedaC fa = Curried (`yap` fa) {-# INLINE liftCurriedYonedaC #-} -yap :: Applicative f => Yoneda f (a %1 -> b) %1 -> f a %1 -> Yoneda f b +yap :: (Applicative f) => Yoneda f (a %1 -> b) %1 -> f a %1 -> Yoneda f b yap (Yoneda k) fa = Yoneda (\ab_r -> k (\g -> ab_r . g) <*> fa) {-# INLINE yap #-} diff --git a/src/Control/Functor/Linear/Internal/MonadTrans.hs b/src/Control/Functor/Linear/Internal/MonadTrans.hs --- a/src/Control/Functor/Linear/Internal/MonadTrans.hs +++ b/src/Control/Functor/Linear/Internal/MonadTrans.hs @@ -11,5 +11,5 @@ import Control.Functor.Linear.Internal.Class -class (forall m. Monad m => Monad (t m)) => MonadTrans t where - lift :: Monad m => m a %1 -> t m a +class (forall m. (Monad m) => Monad (t m)) => MonadTrans t where + lift :: (Monad m) => m a %1 -> t m a diff --git a/src/Control/Functor/Linear/Internal/Reader.hs b/src/Control/Functor/Linear/Internal/Reader.hs --- a/src/Control/Functor/Linear/Internal/Reader.hs +++ b/src/Control/Functor/Linear/Internal/Reader.hs @@ -51,10 +51,10 @@ runReaderT :: ReaderT r m a %1 -> r %1 -> m a runReaderT (ReaderT f) = f -instance Data.Functor m => Data.Functor (ReaderT r m) where +instance (Data.Functor m) => Data.Functor (ReaderT r m) where fmap f = mapReaderT (Data.fmap f) -instance Functor m => Functor (ReaderT r m) where +instance (Functor m) => Functor (ReaderT r m) where fmap f = mapReaderT (fmap f) instance (Data.Applicative m, Dupable r) => Data.Applicative (ReaderT r m) where @@ -70,7 +70,7 @@ type Reader r = ReaderT r Identity -ask :: Applicative m => ReaderT r m r +ask :: (Applicative m) => ReaderT r m r ask = ReaderT pure withReaderT :: (r' %1 -> r) %1 -> ReaderT r m a %1 -> ReaderT r' m a @@ -79,7 +79,7 @@ local :: (r %1 -> r) %1 -> ReaderT r m a %1 -> ReaderT r m a local = withReaderT -reader :: Monad m => (r %1 -> a) %1 -> ReaderT r m a +reader :: (Monad m) => (r %1 -> a) %1 -> ReaderT r m a reader f = ReaderT (return . f) runReader :: Reader r a %1 -> r %1 -> a @@ -94,23 +94,23 @@ withReader :: (r' %1 -> r) %1 -> Reader r a %1 -> Reader r' a withReader = withReaderT -asks :: Monad m => (r %1 -> a) %1 -> ReaderT r m a +asks :: (Monad m) => (r %1 -> a) %1 -> ReaderT r m a asks f = ReaderT (return . f) -instance Dupable r => MonadTrans (ReaderT r) where +instance (Dupable r) => MonadTrans (ReaderT r) where lift x = ReaderT (`lseq` x) -- # Instances for nonlinear ReaderT ------------------------------------------------------------------------------- -instance Functor m => Functor (NonLinear.ReaderT r m) where +instance (Functor m) => Functor (NonLinear.ReaderT r m) where fmap f (NonLinear.ReaderT g) = NonLinear.ReaderT $ \r -> fmap f (g r) -instance Applicative m => Applicative (NonLinear.ReaderT r m) where +instance (Applicative m) => Applicative (NonLinear.ReaderT r m) where pure x = NonLinear.ReaderT $ \_ -> pure x NonLinear.ReaderT f <*> NonLinear.ReaderT x = NonLinear.ReaderT $ \r -> f r <*> x r -instance Monad m => Monad (NonLinear.ReaderT r m) where +instance (Monad m) => Monad (NonLinear.ReaderT r m) where NonLinear.ReaderT x >>= f = NonLinear.ReaderT $ \r -> x r >>= (\a -> runReaderT' (f a) r) -- XXX: Temporary, until newtype record projections are linear. diff --git a/src/Control/Functor/Linear/Internal/State.hs b/src/Control/Functor/Linear/Internal/State.hs --- a/src/Control/Functor/Linear/Internal/State.hs +++ b/src/Control/Functor/Linear/Internal/State.hs @@ -68,7 +68,7 @@ runStateT :: StateT s m a %1 -> s %1 -> m (a, s) runStateT (StateT f) = f -state :: Applicative m => (s %1 -> (a, s)) %1 -> StateT s m a +state :: (Applicative m) => (s %1 -> (a, s)) %1 -> StateT s m a state f = StateT (pure . f) runState :: State s a %1 -> s %1 -> (a, s) @@ -80,7 +80,7 @@ withStateT :: (s %1 -> s) %1 -> StateT s m a %1 -> StateT s m a withStateT r (StateT f) = StateT (f . r) -execStateT :: Functor m => StateT s m () %1 -> s %1 -> m s +execStateT :: (Functor m) => StateT s m () %1 -> s %1 -> m s execStateT f = fmap (\((), s) -> s) . (runStateT f) -- | Use with care! @@ -99,39 +99,39 @@ -- | Use with care! -- This consumes the final state, so might be costly at runtime. -evalState :: Consumable s => State s a %1 -> s %1 -> a +evalState :: (Consumable s) => State s a %1 -> s %1 -> a evalState f = runIdentity' . evalStateT f -modify :: Applicative m => (s %1 -> s) %1 -> StateT s m () +modify :: (Applicative m) => (s %1 -> s) %1 -> StateT s m () modify f = state $ \s -> ((), f s) -- TODO: add strict version of `modify` -- | @replace s@ will replace the current state with the new given state, and -- return the old state. -replace :: Applicative m => s %1 -> StateT s m s +replace :: (Applicative m) => s %1 -> StateT s m s replace s = state $ (\s' -> (s', s)) -- # Instances of StateT ------------------------------------------------------------------------------- -instance Functor m => Functor (NonLinear.StateT s m) where +instance (Functor m) => Functor (NonLinear.StateT s m) where fmap f (NonLinear.StateT x) = NonLinear.StateT $ \s -> fmap (\(a, s') -> (f a, s')) $ x s -instance Data.Functor m => Data.Functor (StateT s m) where +instance (Data.Functor m) => Data.Functor (StateT s m) where fmap f (StateT x) = StateT (\s -> Data.fmap (\(a, s') -> (f a, s')) (x s)) -instance Functor m => Functor (StateT s m) where +instance (Functor m) => Functor (StateT s m) where fmap f (StateT x) = StateT (\s -> fmap (\(a, s') -> (f a, s')) (x s)) -instance Monad m => Applicative (StateT s m) where +instance (Monad m) => Applicative (StateT s m) where pure x = StateT (\s -> return (x, s)) StateT mf <*> StateT mx = StateT $ \s -> do (f, s') <- mf s (x, s'') <- mx s' return (f x, s'') -instance Monad m => Monad (StateT s m) where +instance (Monad m) => Monad (StateT s m) where StateT mx >>= f = StateT $ \s -> do (x, s') <- mx s runStateT (f x) s' diff --git a/src/Control/Monad/IO/Class/Linear.hs b/src/Control/Monad/IO/Class/Linear.hs --- a/src/Control/Monad/IO/Class/Linear.hs +++ b/src/Control/Monad/IO/Class/Linear.hs @@ -10,7 +10,7 @@ -- | Like 'NonLinear.MonadIO' but allows to lift both linear -- and non-linear 'IO' actions into a linear monad. -class Linear.Monad m => MonadIO m where +class (Linear.Monad m) => MonadIO m where liftIO :: Linear.IO a %1 -> m a liftSystemIO :: System.IO a -> m a liftSystemIO io = liftIO (Linear.fromSystemIO io) diff --git a/src/Control/Optics/Linear/Internal.hs b/src/Control/Optics/Linear/Internal.hs --- a/src/Control/Optics/Linear/Internal.hs +++ b/src/Control/Optics/Linear/Internal.hs @@ -78,7 +78,7 @@ newtype Optic_ arr s t a b = Optical (a `arr` b -> s `arr` t) type Optic c s t a b = - forall arr. c arr => Optic_ arr s t a b + forall arr. (c arr) => Optic_ arr s t a b type Iso s t a b = Optic Profunctor s t a b @@ -96,10 +96,10 @@ type Traversal' s a = Traversal s s a a -swap :: SymmetricMonoidal m u => Iso (a `m` b) (c `m` d) (b `m` a) (d `m` c) +swap :: (SymmetricMonoidal m u) => Iso (a `m` b) (c `m` d) (b `m` a) (d `m` c) swap = iso Bifunctor.swap Bifunctor.swap -assoc :: SymmetricMonoidal m u => Iso (a `m` (b `m` c)) (d `m` (e `m` f)) ((a `m` b) `m` c) ((d `m` e) `m` f) +assoc :: (SymmetricMonoidal m u) => Iso (a `m` (b `m` c)) (d `m` (e `m` f)) ((a `m` b) `m` c) ((d `m` e) `m` f) assoc = iso Bifunctor.lassoc Bifunctor.rassoc (.>) :: Optic_ arr s t a b -> Optic_ arr a b x y -> Optic_ arr s t x y @@ -113,7 +113,7 @@ prism :: (b %1 -> t) -> (s %1 -> Either t a) -> Prism s t a b prism b s = Optical $ \f -> dimap s (either id id) (second (rmap b f)) -traversal :: (forall f. Control.Applicative f => (a %1 -> f b) -> s %1 -> f t) -> Traversal s t a b +traversal :: (forall f. (Control.Applicative f) => (a %1 -> f b) -> s %1 -> f t) -> Traversal s t a b traversal trav = Optical $ wander trav _1 :: Lens (a, c) (b, c) a b @@ -134,7 +134,7 @@ _Nothing :: Prism' (Maybe a) () _Nothing = prism (\() -> Nothing) Left -traversed :: Traversable t => Traversal (t a) (t b) a b +traversed :: (Traversable t) => Traversal (t a) (t b) a b traversed = Optical $ wander traverse over :: Optic_ (FUN 'One) s t a b -> (a %1 -> b) -> s %1 -> t @@ -171,7 +171,7 @@ getConst' :: Const a b %1 -> a getConst' (Const x) = x -lengthOf :: MultIdentity r => Optic_ (NonLinear.Kleisli (Const (Sum r))) s t a b -> s -> r +lengthOf :: (MultIdentity r) => Optic_ (NonLinear.Kleisli (Const (Sum r))) s t a b -> s -> r lengthOf l s = (gets l (const (Sum one)) s) & \case Sum r -> r diff --git a/src/Data/Array/Destination/Internal.hs b/src/Data/Array/Destination/Internal.hs --- a/src/Data/Array/Destination/Internal.hs +++ b/src/Data/Array/Destination/Internal.hs @@ -45,7 +45,7 @@ -- | @fill a dest@ fills a singleton destination array. -- Caution, @'fill' a dest@ will fail is @dest@ isn't of length exactly one. -fill :: HasCallStack => a %1 -> DArray a %1 -> () +fill :: (HasCallStack) => a %1 -> DArray a %1 -> () fill a (DArray mvec) = if MVector.length mvec /= 1 then error "Destination.fill: requires a destination of size 1" $ a @@ -54,7 +54,7 @@ & Unsafe.toLinear (\x -> unsafeDupablePerformIO (MVector.write mvec 0 x)) -- | @dropEmpty dest@ consumes and empty array and fails otherwise. -dropEmpty :: HasCallStack => DArray a %1 -> () +dropEmpty :: (HasCallStack) => DArray a %1 -> () dropEmpty (DArray mvec) | MVector.length mvec > 0 = error "Destination.dropEmpty on non-empty array." | otherwise = mvec `seq` () @@ -71,7 +71,7 @@ -- | Fills the destination array with the contents of given vector. -- -- Errors if the given vector is smaller than the destination array. -mirror :: HasCallStack => Vector a -> (a %1 -> b) -> DArray b %1 -> () +mirror :: (HasCallStack) => Vector a -> (a %1 -> b) -> DArray b %1 -> () mirror v f arr = size arr & \(Ur sz, arr') -> if Vector.length v < sz diff --git a/src/Data/Array/Mutable/Linear/Internal.hs b/src/Data/Array/Mutable/Linear/Internal.hs --- a/src/Data/Array/Mutable/Linear/Internal.hs +++ b/src/Data/Array/Mutable/Linear/Internal.hs @@ -62,7 +62,7 @@ -- | Allocate a constant array given a size and an initial value -- The size must be non-negative, otherwise this errors. alloc :: - HasCallStack => + (HasCallStack) => Int -> a -> (Array a %1 -> Ur b) %1 -> @@ -89,7 +89,7 @@ -- | Allocate an array from a list fromList :: - HasCallStack => + (HasCallStack) => [a] -> (Array a %1 -> Ur b) %1 -> Ur b @@ -117,7 +117,7 @@ -- | Sets the value of an index. The index should be less than the arrays -- size, otherwise this errors. -set :: HasCallStack => Int -> a -> Array a %1 -> Array a +set :: (HasCallStack) => Int -> a -> Array a %1 -> Array a set i x arr = unsafeSet i x (assertIndexInRange i arr) -- | Same as 'set', but does not do bounds-checking. The behaviour is undefined @@ -128,7 +128,7 @@ -- | Get the value of an index. The index should be less than the arrays 'size', -- otherwise this errors. -get :: HasCallStack => Int -> Array a %1 -> (Ur a, Array a) +get :: (HasCallStack) => Int -> Array a %1 -> (Ur a, Array a) get i arr = unsafeGet i (assertIndexInRange i arr) -- | Same as 'get', but does not do bounds-checking. The behaviour is undefined @@ -151,7 +151,7 @@ -- and b[i] = a[i] for i < size a, -- and b[i] = x for size a <= i < n. -- @ -resize :: HasCallStack => Int -> a -> Array a %1 -> Array a +resize :: (HasCallStack) => Int -> a -> Array a %1 -> Array a resize newSize seed (Array arr :: Array a) | newSize < 0 = Unlifted.lseq @@ -182,7 +182,7 @@ -- and b[j] = a[i+j] for 0 <= j < n -- @ slice :: - HasCallStack => + (HasCallStack) => -- | Start offset Int -> -- | Target size @@ -223,7 +223,7 @@ ------------------------------------------------------------------------------- -- | Same as 'set', but takes the 'Array' as the first parameter. -write :: HasCallStack => Array a %1 -> Int -> a -> Array a +write :: (HasCallStack) => Array a %1 -> Int -> a -> Array a write arr i a = set i a arr -- | Same as 'unsafeSet', but takes the 'Array' as the first parameter. @@ -231,7 +231,7 @@ unsafeWrite arr i a = unsafeSet i a arr -- | Same as 'get', but takes the 'Array' as the first parameter. -read :: HasCallStack => Array a %1 -> Int -> (Ur a, Array a) +read :: (HasCallStack) => Array a %1 -> Int -> (Ur a, Array a) read arr i = get i arr -- | Same as 'unsafeGet', but takes the 'Array' as the first parameter. @@ -259,7 +259,7 @@ ------------------------------------------------------------------------------- -- | Check if given index is within the Array, otherwise panic. -assertIndexInRange :: HasCallStack => Int -> Array a %1 -> Array a +assertIndexInRange :: (HasCallStack) => Int -> Array a %1 -> Array a assertIndexInRange i arr = size arr & \(Ur s, arr') -> if 0 <= i && i < s diff --git a/src/Data/Array/Polarized/Pull.hs b/src/Data/Array/Polarized/Pull.hs --- a/src/Data/Array/Polarized/Pull.hs +++ b/src/Data/Array/Polarized/Pull.hs @@ -59,7 +59,7 @@ zipWith f x y = Data.fmap (uncurry f) (zip x y) -- | Fold a pull array using a monoid. -foldMap :: Monoid m => (a %1 -> m) -> Array a %1 -> m +foldMap :: (Monoid m) => (a %1 -> m) -> Array a %1 -> m foldMap f = foldr ((<>) . f) mempty -- I'm fairly sure this can be used safely diff --git a/src/Data/Array/Polarized/Pull/Internal.hs b/src/Data/Array/Polarized/Pull/Internal.hs --- a/src/Data/Array/Polarized/Pull/Internal.hs +++ b/src/Data/Array/Polarized/Pull/Internal.hs @@ -68,7 +68,7 @@ foldr :: (a %1 -> b %1 -> b) -> b %1 -> Array a %1 -> b foldr f z (Array g n) = go f z g n where - go :: (_ %1 -> _ %1 -> _) -> _ %1 -> _ -> _ -> _ + go :: (_) => (_ %1 -> _ %1 -> _) -> _ %1 -> _ -> _ -> _ go _ z' _ 0 = z' go f' z' g' k = go f' (f' (g' (k - 1)) z') g' (k - 1) diff --git a/src/Data/Array/Polarized/Push.hs b/src/Data/Array/Polarized/Push.hs --- a/src/Data/Array/Polarized/Push.hs +++ b/src/Data/Array/Polarized/Push.hs @@ -39,7 +39,7 @@ -- | Push arrays are un-allocated finished arrays. These are finished -- computations passed along or enlarged until we are ready to allocate. data Array a where - Array :: (forall m. Monoid m => (a -> m) -> m) %1 -> Array a + Array :: (forall m. (Monoid m) => (a -> m) -> m) %1 -> Array a -- Developer notes: -- @@ -78,7 +78,7 @@ -- | @`make` x n@ creates a constant push array of length @n@ in which every -- element is @x@. -make :: HasCallStack => a -> Int -> Array a +make :: (HasCallStack) => a -> Int -> Array a make x n | n < 0 = error "Making a negative length push array" | otherwise = Array (\makeA -> mconcat $ Prelude.replicate n (makeA x)) @@ -92,7 +92,7 @@ cons :: a -> Array a %1 -> Array a cons x (Array k) = Array (\writeA -> (writeA x) <> (k writeA)) -foldMap :: Monoid b => (a -> b) -> Array a %1 -> b +foldMap :: (Monoid b) => (a -> b) -> Array a %1 -> b foldMap f (Array k) = k f unzip :: Array (a, b) %1 -> (Array a, Array b) diff --git a/src/Data/Bifunctor/Linear/Internal/SymmetricMonoidal.hs b/src/Data/Bifunctor/Linear/Internal/SymmetricMonoidal.hs --- a/src/Data/Bifunctor/Linear/Internal/SymmetricMonoidal.hs +++ b/src/Data/Bifunctor/Linear/Internal/SymmetricMonoidal.hs @@ -31,7 +31,7 @@ -- * @lassoc . rassoc = id@ -- * @second swap . rassoc . first swap = rassoc . swap . rassoc@ class - Bifunctor m => + (Bifunctor m) => SymmetricMonoidal (m :: Type -> Type -> Type) (u :: Type) | m -> u, u -> m diff --git a/src/Data/Either/Linear.hs b/src/Data/Either/Linear.hs --- a/src/Data/Either/Linear.hs +++ b/src/Data/Either/Linear.hs @@ -29,13 +29,13 @@ either _ g (Right y) = g y -- | Get all the left elements in order, and consume the right ones. -lefts :: Consumable b => [Either a b] %1 -> [a] +lefts :: (Consumable b) => [Either a b] %1 -> [a] lefts [] = [] lefts (Left a : xs) = a : lefts xs lefts (Right b : xs) = lseq b (lefts xs) -- | Get all the right elements in order, and consume the left ones. -rights :: Consumable a => [Either a b] %1 -> [b] +rights :: (Consumable a) => [Either a b] %1 -> [b] rights [] = [] rights (Left a : xs) = lseq a (rights xs) rights (Right b : xs) = b : rights xs diff --git a/src/Data/Functor/Linear/Internal/Applicative.hs b/src/Data/Functor/Linear/Internal/Applicative.hs --- a/src/Data/Functor/Linear/Internal/Applicative.hs +++ b/src/Data/Functor/Linear/Internal/Applicative.hs @@ -68,7 +68,7 @@ -- It is a simple exercise to verify that these are equivalent to the definition -- of 'Applicative'. Hence that the choice of linearity of the various arrow is -- indeed natural. -class Functor f => Applicative f where +class (Functor f) => Applicative f where {-# MINIMAL pure, (liftA2 | (<*>)) #-} pure :: a -> f a (<*>) :: f (a %1 -> b) %1 -> f a %1 -> f b @@ -83,7 +83,7 @@ deriving via Generically1 (Const x) instance - Monoid x => Applicative (Const x) + (Monoid x) => Applicative (Const x) deriving via Generically1 Ur @@ -93,7 +93,7 @@ deriving via Generically1 ((,) a) instance - Monoid a => Applicative ((,) a) + (Monoid a) => Applicative ((,) a) deriving via Generically1 (Product (f :: Type -> Type) g) @@ -125,7 +125,7 @@ (Compose f) <*> (Compose x) = Compose (liftA2 (<*>) f x) liftA2 f (Compose x) (Compose y) = Compose (liftA2 (liftA2 f) x y) -instance Applicative m => Applicative (NonLinear.ReaderT r m) where +instance (Applicative m) => Applicative (NonLinear.ReaderT r m) where pure x = NonLinear.ReaderT (\_ -> pure x) NonLinear.ReaderT f <*> NonLinear.ReaderT x = NonLinear.ReaderT (\r -> f r <*> x r) @@ -167,11 +167,12 @@ gliftA2 :: (a %1 -> b %1 -> c) -> f a %1 -> f b %1 -> f c instance - Unsatisfiable - ( 'Text "Cannot derive a data Applicative instance for" - ':$$: s - ':$$: 'Text "because empty types cannot implement pure." - ) => + ( Unsatisfiable + ( 'Text "Cannot derive a data Applicative instance for" + ':$$: s + ':$$: 'Text "because empty types cannot implement pure." + ) + ) => GApplicative s V1 where gpure = unsatisfiable @@ -183,7 +184,7 @@ {-# INLINE gpure #-} {-# INLINE gliftA2 #-} -instance GApplicative s f => GApplicative s (M1 i c f) where +instance (GApplicative s f) => GApplicative s (M1 i c f) where gpure = M1 Prelude.. gpure @s gliftA2 f (M1 x) (M1 y) = M1 (gliftA2 @s f x y) {-# INLINE gpure #-} @@ -208,35 +209,37 @@ {-# INLINE gliftA2 #-} instance - Unsatisfiable - ( 'Text "Cannot derive a data Applicative instance for" - ':$$: s - ':$$: 'Text "because sum types do not admit a uniform Applicative definition." - ) => + ( Unsatisfiable + ( 'Text "Cannot derive a data Applicative instance for" + ':$$: s + ':$$: 'Text "because sum types do not admit a uniform Applicative definition." + ) + ) => GApplicative s (x :+: y) where gpure = unsatisfiable gliftA2 = unsatisfiable -instance GApplicative s f => GApplicative s (MP1 m f) where +instance (GApplicative s f) => GApplicative s (MP1 m f) where gpure a = MP1 (gpure @s a) gliftA2 f (MP1 a) (MP1 b) = MP1 (gliftA2 @s f a b) {-# INLINE gpure #-} {-# INLINE gliftA2 #-} -instance Monoid c => GApplicative s (K1 i c) where +instance (Monoid c) => GApplicative s (K1 i c) where gpure _ = K1 mempty gliftA2 _ (K1 x) (K1 y) = K1 (x <> y) {-# INLINE gpure #-} {-# INLINE gliftA2 #-} instance - Unsatisfiable - ( 'Text "Cannot derive a data Applicative instance for" - ':$$: s - ':$$: 'Text "because it contains one or more primitive unboxed fields." - ':$$: 'Text "Such unboxed types lack canonical monoid operations." - ) => + ( Unsatisfiable + ( 'Text "Cannot derive a data Applicative instance for" + ':$$: s + ':$$: 'Text "because it contains one or more primitive unboxed fields." + ':$$: 'Text "Such unboxed types lack canonical monoid operations." + ) + ) => GApplicative s (URec a) where gpure = unsatisfiable diff --git a/src/Data/Functor/Linear/Internal/Functor.hs b/src/Data/Functor/Linear/Internal/Functor.hs --- a/src/Data/Functor/Linear/Internal/Functor.hs +++ b/src/Data/Functor/Linear/Internal/Functor.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE DataKinds #-} {-# LANGUAGE DerivingVia #-} {-# LANGUAGE EmptyCase #-} {-# LANGUAGE FlexibleContexts #-} @@ -30,8 +31,10 @@ import Data.Functor.Identity import Data.Functor.Product import Data.Functor.Sum +import Data.Kind (FUN) import Data.Unrestricted.Linear.Internal.Consumable import Data.Unrestricted.Linear.Internal.Ur +import GHC.Types (Multiplicity (..)) import Generics.Linear import Prelude.Linear.Generically import Prelude.Linear.Internal @@ -47,7 +50,7 @@ class Functor f where fmap :: (a %1 -> b) -> f a %1 -> f b -(<$>) :: Functor f => (a %1 -> b) -> f a %1 -> f b +(<$>) :: (Functor f) => (a %1 -> b) -> f a %1 -> f b (<$>) = fmap infixl 4 <$> -- same fixity as base.<$> @@ -126,11 +129,14 @@ instance Functor Ur where fmap f (Ur a) = Ur (f a) +instance Functor (FUN 'One a) where + fmap = (.) + --------------------------------- -- Monad transformer instances -- --------------------------------- -instance Functor m => Functor (NonLinear.ReaderT r m) where +instance (Functor m) => Functor (NonLinear.ReaderT r m) where fmap f (NonLinear.ReaderT g) = NonLinear.ReaderT (\r -> fmap f (g r)) -- The below transformers are all Data.Functors and all fail to be @@ -142,16 +148,16 @@ -- To give applicative instances for ContT (resp. StateT), we require the -- parameter r (resp. s) to be Movable. -instance Functor m => Functor (NonLinear.MaybeT m) where +instance (Functor m) => Functor (NonLinear.MaybeT m) where fmap f (NonLinear.MaybeT x) = NonLinear.MaybeT $ fmap (fmap f) x -instance Functor m => Functor (NonLinear.ExceptT e m) where +instance (Functor m) => Functor (NonLinear.ExceptT e m) where fmap f (NonLinear.ExceptT x) = NonLinear.ExceptT $ fmap (fmap f) x instance Functor (NonLinear.ContT r m) where fmap f (NonLinear.ContT x) = NonLinear.ContT $ \k -> x (\a -> k (f a)) -instance Functor m => Functor (Strict.StateT s m) where +instance (Functor m) => Functor (Strict.StateT s m) where fmap f (Strict.StateT x) = Strict.StateT (\s -> fmap (\(a, s') -> (f a, s')) (x s)) ------------------------ @@ -176,7 +182,7 @@ instance Functor (K1 i v) where fmap _ (K1 c) = K1 c -instance Functor f => Functor (M1 i c f) where +instance (Functor f) => Functor (M1 i c f) where fmap f (M1 a) = M1 (fmap f a) instance Functor Par1 where @@ -185,7 +191,7 @@ instance (Functor f, Functor g) => Functor (f :.: g) where fmap f (Comp1 a) = Comp1 (fmap (fmap f) a) -instance Functor f => Functor (MP1 m f) where +instance (Functor f) => Functor (MP1 m f) where fmap f (MP1 x) = MP1 (fmap f x) instance Functor UAddr where diff --git a/src/Data/Functor/Linear/Internal/Traversable.hs b/src/Data/Functor/Linear/Internal/Traversable.hs --- a/src/Data/Functor/Linear/Internal/Traversable.hs +++ b/src/Data/Functor/Linear/Internal/Traversable.hs @@ -65,14 +65,14 @@ -- by Mauro Jaskelioff and Ondrej Rypacek, -- in /Mathematically-Structured Functional Programming/, 2012, online at -- . -class Data.Functor t => Traversable t where +class (Data.Functor t) => Traversable t where {-# MINIMAL traverse | sequence #-} - traverse :: Control.Applicative f => (a %1 -> f b) -> t a %1 -> f (t b) + traverse :: (Control.Applicative f) => (a %1 -> f b) -> t a %1 -> f (t b) {-# INLINE traverse #-} traverse f x = sequence (Data.fmap f x) - sequence :: Control.Applicative f => t (f a) %1 -> f (t a) + sequence :: (Control.Applicative f) => t (f a) %1 -> f (t a) {-# INLINE sequence #-} sequence = traverse id @@ -92,10 +92,10 @@ forM = for {-# INLINE forM #-} -mapAccumL :: Traversable t => (a %1 -> b %1 -> (a, c)) -> a %1 -> t b %1 -> (a, t c) +mapAccumL :: (Traversable t) => (a %1 -> b %1 -> (a, c)) -> a %1 -> t b %1 -> (a, t c) mapAccumL f s t = swap $ Control.runState (traverse (\b -> Control.state $ \i -> swap $ f i b) t) s -mapAccumR :: Traversable t => (a %1 -> b %1 -> (a, c)) -> a %1 -> t b %1 -> (a, t c) +mapAccumR :: (Traversable t) => (a %1 -> b %1 -> (a, c)) -> a %1 -> t b %1 -> (a, t c) mapAccumR f s t = swap $ runStateR (traverse (\b -> StateR $ \i -> swap $ f i b) t) s swap :: (a, b) %1 -> (b, a) @@ -164,7 +164,7 @@ instance (Traversable f, Traversable g) => Traversable (f :+: g) where traverse = genericTraverse -instance Traversable f => Traversable (M1 i c f) where +instance (Traversable f) => Traversable (M1 i c f) where traverse = genericTraverse instance Traversable Par1 where @@ -202,9 +202,9 @@ -- TODO: developer documentation on why we use this type rather than the more -- straightforward type of `traverse`. Used, for instance, in the -- generic-deriving package. - gtraverse :: Control.Applicative f => (a %1 -> f b) -> t a %1 -> Curried (Yoneda f) (Yoneda f) (t b) + gtraverse :: (Control.Applicative f) => (a %1 -> f b) -> t a %1 -> Curried (Yoneda f) (Yoneda f) (t b) -instance GTraversable t => GTraversable (M1 i c t) where +instance (GTraversable t) => GTraversable (M1 i c t) where gtraverse f (M1 x) = lcoerce (gtraverse f x) {-# INLINE gtraverse #-} diff --git a/src/Data/HashMap/Mutable/Linear/Internal.hs b/src/Data/HashMap/Mutable/Linear/Internal.hs --- a/src/Data/HashMap/Mutable/Linear/Internal.hs +++ b/src/Data/HashMap/Mutable/Linear/Internal.hs @@ -133,7 +133,7 @@ -- | Run a computation with an empty 'HashMap' with given capacity. empty :: forall k v b. - Keyed k => + (Keyed k) => Int -> (HashMap k v %1 -> Ur b) %1 -> Ur b @@ -142,7 +142,7 @@ in Array.alloc cap Nothing (\arr -> scope (HashMap 0 cap arr)) -- | Create an empty HashMap, using another as a uniqueness proof. -allocBeside :: Keyed k => Int -> HashMap k' v' %1 -> (HashMap k v, HashMap k' v') +allocBeside :: (Keyed k) => Int -> HashMap k' v' %1 -> (HashMap k v, HashMap k' v') allocBeside size (HashMap s' c' arr) = let cap = max 1 size in Array.allocBeside cap Nothing arr & \(arr', arr'') -> @@ -151,7 +151,7 @@ -- | Run a computation with an 'HashMap' containing given key-value pairs. fromList :: forall k v b. - Keyed k => + (Keyed k) => [(k, v)] -> (HashMap k v %1 -> Ur b) %1 -> Ur b @@ -229,7 +229,7 @@ -- | A general modification function; which can insert, update or delete -- a value of the key. See 'alterF', for an even more general function. -alter :: Keyed k => (Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v +alter :: (Keyed k) => (Maybe v -> Maybe v) -> k -> HashMap k v %1 -> HashMap k v alter f key hm = runIdentity $ alterF (\v -> Identity (Ur (f v))) key hm where runIdentity :: Identity a %1 -> a @@ -238,17 +238,17 @@ -- | Insert a key value pair to a 'HashMap'. It overwrites the previous -- value if it exists. -insert :: Keyed k => k -> v -> HashMap k v %1 -> HashMap k v +insert :: (Keyed k) => k -> v -> HashMap k v %1 -> HashMap k v insert k v = alter (\_ -> Just v) k -- | Delete a key from a 'HashMap'. Does nothing if the key does not -- exist. -delete :: Keyed k => k -> HashMap k v %1 -> HashMap k v +delete :: (Keyed k) => k -> HashMap k v %1 -> HashMap k v delete = alter (\_ -> Nothing) -- | 'insert' (in the provided order) the given key-value pairs to -- the hashmap. -insertAll :: Keyed k => [(k, v)] -> HashMap k v %1 -> HashMap k v +insertAll :: (Keyed k) => [(k, v)] -> HashMap k v %1 -> HashMap k v insertAll [] hmap = hmap insertAll ((k, v) : xs) hmap = insertAll xs (insert k v hmap) @@ -257,13 +257,13 @@ -- | A version of 'fmap' which can throw out the elements. -- -- Complexity: O(capacity hm) -mapMaybe :: Keyed k => (v -> Maybe v') -> HashMap k v %1 -> HashMap k v' +mapMaybe :: (Keyed k) => (v -> Maybe v') -> HashMap k v %1 -> HashMap k v' mapMaybe f = mapMaybeWithKey (\_k v -> f v) -- | Same as 'mapMaybe', but also has access to the keys. mapMaybeWithKey :: forall k v v'. - Keyed k => + (Keyed k) => (k -> v -> Maybe v') -> HashMap k v %1 -> HashMap k v' @@ -321,20 +321,20 @@ & \arr3 -> mapAndPushBack (ix + 1) end (True, dec) (count + 1) arr3 -- | Complexity: O(capacity hm) -filterWithKey :: Keyed k => (k -> v -> Bool) -> HashMap k v %1 -> HashMap k v +filterWithKey :: (Keyed k) => (k -> v -> Bool) -> HashMap k v %1 -> HashMap k v filterWithKey f = mapMaybeWithKey (\k v -> if f k v then Just v else Nothing) -- | Complexity: O(capacity hm) -filter :: Keyed k => (v -> Bool) -> HashMap k v %1 -> HashMap k v +filter :: (Keyed k) => (v -> Bool) -> HashMap k v %1 -> HashMap k v filter f = filterWithKey (\_k v -> f v) -- | Union of two maps using the provided function on conflicts. -- -- Complexity: O(min(capacity hm1, capacity hm2) unionWith :: - Keyed k => + (Keyed k) => (v -> v -> v) -> HashMap k v %1 -> HashMap k v %1 -> @@ -367,14 +367,14 @@ -- | A right-biased union. -- -- Complexity: O(min(capacity hm1, capacity hm2) -union :: Keyed k => HashMap k v %1 -> HashMap k v %1 -> HashMap k v +union :: (Keyed k) => HashMap k v %1 -> HashMap k v %1 -> HashMap k v union hm1 hm2 = unionWith (\_v1 v2 -> v2) hm1 hm2 -- | Intersection of two maps with the provided combine function. -- -- Complexity: O(min(capacity hm1, capacity hm2) intersectionWith :: - Keyed k => + (Keyed k) => (a -> b -> c) -> HashMap k a %1 -> HashMap k b %1 -> @@ -408,7 +408,7 @@ -- This is only useful after a lot of deletes. -- -- Complexity: O(capacity hm) -shrinkToFit :: Keyed k => HashMap k a %1 -> HashMap k a +shrinkToFit :: (Keyed k) => HashMap k a %1 -> HashMap k a shrinkToFit hm = size hm & \(Ur size, hm') -> let targetSize = @@ -432,7 +432,7 @@ capacity (HashMap ct cap arr) = (Ur cap, HashMap ct cap arr) -- | Look up a value from a 'HashMap'. -lookup :: Keyed k => k -> HashMap k v %1 -> (Ur (Maybe v), HashMap k v) +lookup :: (Keyed k) => k -> HashMap k v %1 -> (Ur (Maybe v), HashMap k v) lookup k hm = idealIndexForKey k hm & \(Ur idx, hm') -> probeFrom k 0 idx hm' `chainU` \case @@ -444,7 +444,7 @@ (Ur Nothing, h) -- | Check if the given key exists. -member :: Keyed k => k -> HashMap k v %1 -> (Ur Bool, HashMap k v) +member :: (Keyed k) => k -> HashMap k v %1 -> (Ur Bool, HashMap k v) member k hm = lookup k hm & \case (Ur Nothing, hm') -> (Ur False, hm') @@ -484,7 +484,7 @@ instance Prelude.Semigroup (HashMap k v) where (<>) = error "Prelude.<>: invariant violation, unrestricted HashMap" -instance Keyed k => Semigroup (HashMap k v) where +instance (Keyed k) => Semigroup (HashMap k v) where (<>) = union -- # Internal library @@ -495,7 +495,7 @@ Array.toList robinArr & \(Ur xs) -> show xs idealIndexForKey :: - Keyed k => + (Keyed k) => k -> HashMap k v %1 -> (Ur Int, HashMap k v) @@ -506,7 +506,7 @@ -- a full hashmap, return a probe result: the place the key already -- exists, a place to swap from, or an unfilled cell to write over. probeFrom :: - Keyed k => + (Keyed k) => k -> PSL -> Int -> @@ -528,7 +528,7 @@ -- | Try to insert at a given index with a given PSL. So the -- probing starts from the given index (with the given PSL). tryInsertAtIndex :: - Keyed k => + (Keyed k) => HashMap k v %1 -> Int -> RobinVal k v -> @@ -550,7 +550,7 @@ -- following the deleted cell, backwards by one and decrement -- their PSLs. shiftSegmentBackward :: - Keyed k => + (Keyed k) => Int -> Int -> RobinArr k v %1 -> @@ -574,7 +574,7 @@ -- | Makes sure that the map is not exceeding its utilization threshold -- (constMaxUtilization), resizes (constGrowthFactor) if necessary. -growMapIfNecessary :: Keyed k => HashMap k v %1 -> HashMap k v +growMapIfNecessary :: (Keyed k) => HashMap k v %1 -> HashMap k v growMapIfNecessary (HashMap sz cap arr) = let load = fromIntegral sz / fromIntegral cap in if load Prelude.< constMaxLoadFactor @@ -587,7 +587,7 @@ -- -- Invariant: Given capacity should be greater than the size, this is not -- checked. -resize :: Keyed k => Int -> HashMap k v %1 -> HashMap k v +resize :: (Keyed k) => Int -> HashMap k v %1 -> HashMap k v resize targetSize (HashMap _ _ arr) = Array.allocBeside targetSize Nothing arr & \(newArr, oldArr) -> Array.toList oldArr & \(Ur elems) -> diff --git a/src/Data/List/Linear.hs b/src/Data/List/Linear.hs --- a/src/Data/List/Linear.hs +++ b/src/Data/List/Linear.hs @@ -114,7 +114,7 @@ -- | @filter p xs@ returns a list with elements satisfying the predicate. -- -- See 'Data.Maybe.Linear.mapMaybe' if you do not want the 'Dupable' constraint. -filter :: Dupable a => (a %1 -> Bool) -> [a] %1 -> [a] +filter :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> [a] filter _ [] = [] filter p (x : xs) = dup x & \case @@ -146,7 +146,7 @@ -- | 'span', applied to a predicate @p@ and a list @xs@, returns a tuple where -- first element is longest prefix (possibly empty) of @xs@ of elements that -- satisfy @p@ and second element is the remainder of the list. -span :: Dupable a => (a %1 -> Bool) -> [a] %1 -> ([a], [a]) +span :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> ([a], [a]) span _ [] = ([], []) span f (x : xs) = dup x & \case @@ -158,7 +158,7 @@ -- The partition function takes a predicate a list and returns the -- pair of lists of elements which do and do not satisfy the predicate, -- respectively. -partition :: Dupable a => (a %1 -> Bool) -> [a] %1 -> ([a], [a]) +partition :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> ([a], [a]) partition p (xs :: [a]) = foldr select ([], []) xs where select :: a %1 -> ([a], [a]) %1 -> ([a], [a]) @@ -170,7 +170,7 @@ -- | __NOTE__: This does not short-circuit and always traverses the -- entire list to consume the rest of the elements. -takeWhile :: Dupable a => (a %1 -> Bool) -> [a] %1 -> [a] +takeWhile :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> [a] takeWhile _ [] = [] takeWhile p (x : xs) = dup2 x & \(x', x'') -> @@ -178,7 +178,7 @@ then x'' : takeWhile p xs else (x'', xs) `lseq` [] -dropWhile :: Dupable a => (a %1 -> Bool) -> [a] %1 -> [a] +dropWhile :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> [a] dropWhile _ [] = [] dropWhile p (x : xs) = dup2 x & \(x', x'') -> @@ -188,13 +188,13 @@ -- | __NOTE__: This does not short-circuit and always traverses the -- entire list to consume the rest of the elements. -take :: Consumable a => Int -> [a] %1 -> [a] +take :: (Consumable a) => Int -> [a] %1 -> [a] take _ [] = [] take i (x : xs) | i Prelude.< 0 = (x, xs) `lseq` [] | otherwise = x : take (i - 1) xs -drop :: Consumable a => Int -> [a] %1 -> [a] +drop :: (Consumable a) => Int -> [a] %1 -> [a] drop _ [] = [] drop i (x : xs) | i Prelude.< 0 = x : xs @@ -215,7 +215,7 @@ transpose :: [[a]] %1 -> [[a]] transpose = Unsafe.toLinear NonLinear.transpose -traverse' :: Data.Applicative f => (a %1 -> f b) -> [a] %1 -> f [b] +traverse' :: (Data.Applicative f) => (a %1 -> f b) -> [a] %1 -> f [b] traverse' _ [] = Data.pure [] traverse' f (a : as) = (:) <$> f a <*> traverse' f as @@ -225,7 +225,7 @@ foldr :: (a %1 -> b %1 -> b) -> b %1 -> [a] %1 -> b foldr f = Unsafe.toLinear2 (NonLinear.foldr (\a b -> f a b)) -foldr1 :: HasCallStack => (a %1 -> a %1 -> a) -> [a] %1 -> a +foldr1 :: (HasCallStack) => (a %1 -> a %1 -> a) -> [a] %1 -> a foldr1 f = Unsafe.toLinear (NonLinear.foldr1 (\a b -> f a b)) foldl :: (b %1 -> a %1 -> b) -> b %1 -> [a] %1 -> b @@ -234,19 +234,19 @@ foldl' :: (b %1 -> a %1 -> b) -> b %1 -> [a] %1 -> b foldl' f = Unsafe.toLinear2 (NonLinear.foldl' (\b a -> f b a)) -foldl1 :: HasCallStack => (a %1 -> a %1 -> a) -> [a] %1 -> a +foldl1 :: (HasCallStack) => (a %1 -> a %1 -> a) -> [a] %1 -> a foldl1 f = Unsafe.toLinear (NonLinear.foldl1 (\a b -> f a b)) -foldl1' :: HasCallStack => (a %1 -> a %1 -> a) -> [a] %1 -> a +foldl1' :: (HasCallStack) => (a %1 -> a %1 -> a) -> [a] %1 -> a foldl1' f = Unsafe.toLinear (NonLinear.foldl1' (\a b -> f a b)) -- | Map each element of the structure to a monoid, -- and combine the results. -foldMap :: Monoid m => (a %1 -> m) -> [a] %1 -> m +foldMap :: (Monoid m) => (a %1 -> m) -> [a] %1 -> m foldMap f = foldr ((<>) . f) mempty -- | A variant of 'foldMap' that is strict in the accumulator. -foldMap' :: Monoid m => (a %1 -> m) -> [a] %1 -> m +foldMap' :: (Monoid m) => (a %1 -> m) -> [a] %1 -> m foldMap' f = foldl' (\acc a -> acc <> f a) mempty concat :: [[a]] %1 -> [a] @@ -255,10 +255,10 @@ concatMap :: (a %1 -> [b]) -> [a] %1 -> [b] concatMap f = Unsafe.toLinear (NonLinear.concatMap (forget f)) -sum :: AddIdentity a => [a] %1 -> a +sum :: (AddIdentity a) => [a] %1 -> a sum = foldl' (+) zero -product :: MultIdentity a => [a] %1 -> a +product :: (MultIdentity a) => [a] %1 -> a product = foldl' (*) one -- | __NOTE:__ This does not short-circuit, and always consumes the @@ -284,27 +284,30 @@ -- # Building Lists -------------------------------------------------- -iterate :: Dupable a => (a %1 -> a) -> a %1 -> [a] +{-# DEPRECATED iterate "The result cannot be consumed linearly, so this function is not useful." #-} +iterate :: (Dupable a) => (a %1 -> a) -> a %1 -> [a] iterate f a = dup2 a & \(a', a'') -> a' : iterate f (f a'') -repeat :: Dupable a => a %1 -> [a] +{-# DEPRECATED repeat "The result cannot be consumed linearly, so this function is not useful." #-} +repeat :: (Dupable a) => a %1 -> [a] repeat = iterate id +{-# DEPRECATED cycle "The result cannot be consumed linearly, so this function is not useful." #-} cycle :: (HasCallStack, Dupable a) => [a] %1 -> [a] cycle [] = Prelude.error "cycle: empty list" cycle xs = dup2 xs & \(xs', xs'') -> xs' ++ cycle xs'' -scanl :: Dupable b => (b %1 -> a %1 -> b) -> b %1 -> [a] %1 -> [b] +scanl :: (Dupable b) => (b %1 -> a %1 -> b) -> b %1 -> [a] %1 -> [b] scanl _ b [] = [b] scanl f b (x : xs) = dup2 b & \(b', b'') -> b' : scanl f (f b'' x) xs -scanl1 :: Dupable a => (a %1 -> a %1 -> a) -> [a] %1 -> [a] +scanl1 :: (Dupable a) => (a %1 -> a %1 -> a) -> [a] %1 -> [a] scanl1 _ [] = [] scanl1 f (x : xs) = scanl f x xs -scanr :: Dupable b => (a %1 -> b %1 -> b) -> b %1 -> [a] %1 -> [b] +scanr :: (Dupable b) => (a %1 -> b %1 -> b) -> b %1 -> [a] %1 -> [b] scanr _ b [] = [b] scanr f b (a : as) = scanr f b as & \case @@ -315,7 +318,7 @@ -- this branch is impossible since scanr never returns an empty list. Prelude.error "impossible" a -scanr1 :: Dupable a => (a %1 -> a %1 -> a) -> [a] %1 -> [a] +scanr1 :: (Dupable a) => (a %1 -> a %1 -> a) -> [a] %1 -> [a] scanr1 _ [] = [] scanr1 _ [a] = [a] scanr1 f (a : as) = @@ -328,7 +331,7 @@ -- be non-empty since 'as' is also non-empty. Prelude.error "impossible" a -replicate :: Dupable a => Int -> a %1 -> [a] +replicate :: (Dupable a) => Int -> a %1 -> [a] replicate i a | i Prelude.< 1 = a `lseq` [] | i Prelude.== 1 = [a] diff --git a/src/Data/Monoid/Linear/Internal/Monoid.hs b/src/Data/Monoid/Linear/Internal/Monoid.hs --- a/src/Data/Monoid/Linear/Internal/Monoid.hs +++ b/src/Data/Monoid/Linear/Internal/Monoid.hs @@ -30,6 +30,7 @@ import Data.Ord (Down (Down)) import Data.Proxy (Proxy (Proxy)) import Data.Unrestricted.Linear.Internal.Consumable (Consumable) +import qualified Data.Unrestricted.Linear.Internal.Ur as Ur import GHC.Types hiding (Any) import Prelude.Linear.Internal import Prelude (Maybe (Nothing)) @@ -40,7 +41,7 @@ -- -- Laws (same as 'Data.Monoid.Monoid'): -- * ∀ x ∈ G, x <> mempty = mempty <> x = x -class Semigroup a => Monoid a where +class (Semigroup a) => Monoid a where {-# MINIMAL mempty #-} mempty :: a @@ -49,14 +50,14 @@ -- convenience redefine -mconcat :: Monoid a => [a] %1 -> a +mconcat :: (Monoid a) => [a] %1 -> a mconcat (xs' :: [a]) = go mempty xs' where go :: a %1 -> [a] %1 -> a go acc [] = acc go acc (x : xs) = go (acc <> x) xs -mappend :: Monoid a => a %1 -> a %1 -> a +mappend :: (Monoid a) => a %1 -> a %1 -> a mappend = (<>) --------------- @@ -80,22 +81,22 @@ instance Monoid () where mempty = () -instance Monoid a => Monoid (Identity a) where +instance (Monoid a) => Monoid (Identity a) where mempty = Identity mempty -instance Consumable a => Monoid (Monoid.First a) where +instance (Consumable a) => Monoid (Monoid.First a) where mempty = Monoid.First Nothing -instance Consumable a => Monoid (Monoid.Last a) where +instance (Consumable a) => Monoid (Monoid.Last a) where mempty = Monoid.Last Nothing -instance Monoid a => Monoid (Down a) where +instance (Monoid a) => Monoid (Down a) where mempty = Down mempty -- Cannot add instance (Ord a, Bounded a) => Monoid (Max a); would require (NonLinear.Ord a, Consumable a) -- Cannot add instance (Ord a, Bounded a) => Monoid (Min a); would require (NonLinear.Ord a, Consumable a) -instance Monoid a => Monoid (Dual a) where +instance (Monoid a) => Monoid (Dual a) where mempty = Dual mempty instance Monoid (Endo a) where @@ -106,7 +107,7 @@ -- See System.IO.Linear for instance ... => Monoid (IO a) -- See System.IO.Resource.Internal for instance ... => Monoid (RIO a) -instance Semigroup a => Monoid (Maybe a) where +instance (Semigroup a) => Monoid (Maybe a) where mempty = Nothing -- See Data.List.Linear for instance ... => Monoid [a] @@ -121,7 +122,7 @@ instance (Monoid a, Monoid b) => Monoid (a, b) where mempty = (mempty, mempty) -instance Monoid a => Monoid (Const a b) where +instance (Monoid a) => Monoid (Const a b) where mempty = mempty -- See Data.Functor.Linear.Applicative for instance ... => Monoid (Ap f a) @@ -136,8 +137,13 @@ instance (Monoid a, Monoid b, Monoid c, Monoid d) => Monoid (a, b, c, d) where mempty = (mempty, mempty, mempty, mempty) -instance Monoid (f (g a)) => Monoid (Functor.Compose f g a) where +instance (Monoid (f (g a))) => Monoid (Functor.Compose f g a) where mempty = Compose mempty instance (Monoid a, Monoid b, Monoid c, Monoid d, Monoid e) => Monoid (a, b, c, d, e) where mempty = (mempty, mempty, mempty, mempty, mempty) + +-- | Useful to treat /unrestricted/ monoids as linear ones. +instance (Prelude.Monoid a) => Monoid (Ur.Ur a) where + mempty = Ur.Ur Prelude.mempty + {-# INLINE mempty #-} diff --git a/src/Data/Monoid/Linear/Internal/Semigroup.hs b/src/Data/Monoid/Linear/Internal/Semigroup.hs --- a/src/Data/Monoid/Linear/Internal/Semigroup.hs +++ b/src/Data/Monoid/Linear/Internal/Semigroup.hs @@ -49,6 +49,7 @@ import qualified Data.Semigroup as Prelude import qualified Data.Tuple.Linear.Compat as Tuple import Data.Unrestricted.Linear.Internal.Consumable (Consumable, lseq) +import qualified Data.Unrestricted.Linear.Internal.Ur as Ur import Data.Void (Void) import GHC.Tuple import GHC.Types hiding (Any) @@ -87,7 +88,7 @@ -- Instances -- --------------- -instance Semigroup a => Prelude.Semigroup (NonLinear a) where +instance (Semigroup a) => Prelude.Semigroup (NonLinear a) where NonLinear a <> NonLinear b = NonLinear (a <> b) -- Instances below are listed in the same order as in https://hackage.haskell.org/package/base-4.16.0.0/docs/Data-Semigroup.html @@ -119,36 +120,36 @@ instance Semigroup () where () <> () = () -instance Semigroup a => Semigroup (Identity a) where +instance (Semigroup a) => Semigroup (Identity a) where Identity x <> Identity y = Identity (x <> y) -instance Consumable a => Semigroup (Monoid.First a) where +instance (Consumable a) => Semigroup (Monoid.First a) where (Monoid.First Nothing) <> y = y x <> (Monoid.First y) = y & \case Nothing -> x Just y' -> y' `lseq` x -instance Consumable a => Semigroup (Monoid.Last a) where +instance (Consumable a) => Semigroup (Monoid.Last a) where x <> (Monoid.Last Nothing) = x (Monoid.Last x) <> y = x & \case Nothing -> y Just x' -> x' `lseq` y -instance Semigroup a => Semigroup (Down a) where +instance (Semigroup a) => Semigroup (Down a) where (Down x) <> (Down y) = Down (x <> y) -instance Consumable a => Semigroup (First a) where +instance (Consumable a) => Semigroup (First a) where x <> (First y) = y `lseq` x -instance Consumable a => Semigroup (Last a) where +instance (Consumable a) => Semigroup (Last a) where (Last x) <> y = x `lseq` y -- Cannot add instance Ord a => Semigroup (Max a); would require (NonLinear.Ord a, Consumable a) -- Cannot add instance Ord a => Semigroup (Min a); would require (NonLinear.Ord a, Consumable a) -instance Semigroup a => Semigroup (Dual a) where +instance (Semigroup a) => Semigroup (Dual a) where Dual x <> Dual y = Dual (y <> x) instance Semigroup (Endo a) where @@ -160,12 +161,12 @@ -- See System.IO.Resource.Internal for instance ... => Semigroup (RIO a) -- See Data.List.Linear for instance ... => Semigroup (NonEmpty a) -instance Semigroup a => Semigroup (Maybe a) where +instance (Semigroup a) => Semigroup (Maybe a) where x <> Nothing = x Nothing <> y = y Just x <> Just y = Just (x <> y) -instance Semigroup a => Semigroup (Solo a) where +instance (Semigroup a) => Semigroup (Solo a) where x <> y = Tuple.mkSolo (Tuple.unSolo x <> Tuple.unSolo y) -- See Data.List.Linear for instance ... => Semigroup [a] @@ -188,7 +189,7 @@ instance (Semigroup a, Semigroup b) => Semigroup (a, b) where (x1, x2) <> (y1, y2) = (x1 <> y1, x2 <> y2) -instance Semigroup a => Semigroup (Const a b) where +instance (Semigroup a) => Semigroup (Const a b) where Const x <> Const y = Const (x <> y) -- See Data.Functor.Linear.Applicative for instance ... => Semigroup (Ap f a) @@ -208,3 +209,8 @@ instance (Semigroup a, Semigroup b, Semigroup c, Semigroup d, Semigroup e) => Semigroup (a, b, c, d, e) where (x1, x2, x3, x4, x5) <> (y1, y2, y3, y4, y5) = (x1 <> y1, x2 <> y2, x3 <> y3, x4 <> y4, x5 <> y5) + +-- | Useful to treat /unrestricted/ semigroups as linear ones. +instance (Prelude.Semigroup a) => Semigroup (Ur.Ur a) where + (<>) = Ur.lift2 (Prelude.<>) + {-# INLINE (<>) #-} diff --git a/src/Data/Num/Linear.hs b/src/Data/Num/Linear.hs --- a/src/Data/Num/Linear.hs +++ b/src/Data/Num/Linear.hs @@ -57,12 +57,12 @@ infixl 6 + -- same fixity as base.+ -- | An 'Additive' type with an identity on @(+)@. -class Additive a => AddIdentity a where +class (Additive a) => AddIdentity a where zero :: a -- | An 'AddIdentity' with inverses that satisfies -- the laws of an [abelian group](https://en.wikipedia.org/wiki/Abelian_group) -class AddIdentity a => AdditiveGroup a where +class (AddIdentity a) => AdditiveGroup a where {-# MINIMAL negate | (-) #-} negate :: a %1 -> a negate x = zero - x @@ -76,7 +76,7 @@ infixl 7 * -- same fixity as base.* -- | A 'Multiplicative' type with an identity for @(*)@ -class Multiplicative a => MultIdentity a where +class (Multiplicative a) => MultIdentity a where one :: a -- | A [semiring](https://en.wikipedia.org/wiki/Semiring) class. This is @@ -169,10 +169,10 @@ getAdded (Adding x) = x {-# DEPRECATED getAdded "Use 'Data.Semigroup.Sum' (reexported as 'Data.Monoid.Linear.Sum') and pattern-match to extract the inner value linearly" #-} -instance Additive a => Semigroup (Adding a) where +instance (Additive a) => Semigroup (Adding a) where Adding a <> Adding b = Adding (a + b) -instance AddIdentity a => Monoid (Adding a) where +instance (AddIdentity a) => Monoid (Adding a) where mempty = Adding zero -- | A newtype wrapper to give the underlying monoid for a multiplicative structure. @@ -190,22 +190,22 @@ getMultiplied (Multiplying x) = x {-# DEPRECATED getMultiplied "Use 'Data.Semigroup.Product' (reexported as 'Data.Monoid.Linear.Product') and pattern-match to extract the inner value linearly" #-} -instance Multiplicative a => Semigroup (Multiplying a) where +instance (Multiplicative a) => Semigroup (Multiplying a) where Multiplying a <> Multiplying b = Multiplying (a * b) -instance MultIdentity a => Monoid (Multiplying a) where +instance (MultIdentity a) => Monoid (Multiplying a) where mempty = Multiplying one -instance Multiplicative a => Semigroup (Product a) where +instance (Multiplicative a) => Semigroup (Product a) where (Product x) <> (Product y) = Product (x * y) -instance Additive a => Semigroup (Sum a) where +instance (Additive a) => Semigroup (Sum a) where (Sum x) <> (Sum y) = Sum (x + y) -instance MultIdentity a => Monoid (Product a) where +instance (MultIdentity a) => Monoid (Product a) where mempty = Product one -instance AddIdentity a => Monoid (Sum a) where +instance (AddIdentity a) => Monoid (Sum a) where mempty = Sum zero deriving via MovableNum Prelude.Int instance Additive Prelude.Int diff --git a/src/Data/Ord/Linear/Internal/Eq.hs b/src/Data/Ord/Linear/Internal/Eq.hs --- a/src/Data/Ord/Linear/Internal/Eq.hs +++ b/src/Data/Ord/Linear/Internal/Eq.hs @@ -38,7 +38,7 @@ -- * Instances -instance Prelude.Eq a => Eq (Ur a) where +instance (Prelude.Eq a) => Eq (Ur a) where Ur x == Ur y = x Prelude.== y Ur x /= Ur y = x Prelude./= y diff --git a/src/Data/Ord/Linear/Internal/Ord.hs b/src/Data/Ord/Linear/Internal/Ord.hs --- a/src/Data/Ord/Linear/Internal/Ord.hs +++ b/src/Data/Ord/Linear/Internal/Ord.hs @@ -41,7 +41,7 @@ -- @<=@ since it requires calls: one to @<=@ and one to @==@. However, -- from a linear @compare@ it is easy to implement the others. Hence, the -- minimal complete definition only contains @compare@. -class Eq a => Ord a where +class (Eq a) => Ord a where {-# MINIMAL compare #-} -- | @compare x y@ returns an @Ordering@ which is @@ -91,7 +91,7 @@ -- * Instances -instance Prelude.Ord a => Ord (Ur a) where +instance (Prelude.Ord a) => Ord (Ur a) where Ur x `compare` Ur y = x `Prelude.compare` y instance (Consumable a, Ord a) => Ord (Prelude.Maybe a) where diff --git a/src/Data/Profunctor/Kleisli/Linear.hs b/src/Data/Profunctor/Kleisli/Linear.hs --- a/src/Data/Profunctor/Kleisli/Linear.hs +++ b/src/Data/Profunctor/Kleisli/Linear.hs @@ -56,28 +56,28 @@ -- properties still hold in this weaker setting. newtype Kleisli m a b = Kleisli {runKleisli :: a %1 -> m b} -instance Data.Functor f => Profunctor (Kleisli f) where +instance (Data.Functor f) => Profunctor (Kleisli f) where dimap f g (Kleisli h) = Kleisli (Data.fmap g . h . f) -instance Control.Functor f => Strong (,) () (Kleisli f) where +instance (Control.Functor f) => Strong (,) () (Kleisli f) where first (Kleisli f) = Kleisli (\(a, b) -> (,b) Control.<$> f a) second (Kleisli g) = Kleisli (\(a, b) -> (a,) Control.<$> g b) -instance Control.Applicative f => Strong Either Void (Kleisli f) where +instance (Control.Applicative f) => Strong Either Void (Kleisli f) where first (Kleisli f) = Kleisli (either (Data.fmap Left . f) (Control.pure . Right)) second (Kleisli g) = Kleisli (either (Control.pure . Left) (Data.fmap Right . g)) -instance Data.Applicative f => Monoidal (,) () (Kleisli f) where +instance (Data.Applicative f) => Monoidal (,) () (Kleisli f) where Kleisli f *** Kleisli g = Kleisli $ \(x, y) -> (,) Data.<$> f x Data.<*> g y unit = Kleisli $ \() -> Data.pure () -instance Data.Functor f => Monoidal Either Void (Kleisli f) where +instance (Data.Functor f) => Monoidal Either Void (Kleisli f) where Kleisli f *** Kleisli g = Kleisli $ \case Left a -> Left Data.<$> f a Right b -> Right Data.<$> g b unit = Kleisli $ \case {} -instance Control.Applicative f => Wandering (Kleisli f) where +instance (Control.Applicative f) => Wandering (Kleisli f) where wander traverse (Kleisli f) = Kleisli (traverse f) -- | Linear co-Kleisli arrows for the comonad `w`. These arrows are still @@ -87,7 +87,7 @@ -- strength, so we have fewer instances. newtype CoKleisli w a b = CoKleisli {runCoKleisli :: w a %1 -> b} -instance Data.Functor f => Profunctor (CoKleisli f) where +instance (Data.Functor f) => Profunctor (CoKleisli f) where dimap f g (CoKleisli h) = CoKleisli (g . h . Data.fmap f) instance Strong Either Void (CoKleisli (Data.Const x)) where diff --git a/src/Data/Profunctor/Linear.hs b/src/Data/Profunctor/Linear.hs --- a/src/Data/Profunctor/Linear.hs +++ b/src/Data/Profunctor/Linear.hs @@ -131,7 +131,7 @@ -- | Equivalently but less efficient in general: -- -- > wander :: Data.Traversable f => a `arr` b -> f a `arr` f b - wander :: forall s t a b. (forall f. Control.Applicative f => (a %1 -> f b) -> s %1 -> f t) -> a `arr` b -> s `arr` t + wander :: forall s t a b. (forall f. (Control.Applicative f) => (a %1 -> f b) -> s %1 -> f t) -> a `arr` b -> s `arr` t --------------- -- Instances -- @@ -184,23 +184,23 @@ instance Profunctor (Exchange a b) where dimap f g (Exchange p q) = Exchange (p . f) (g . q) -instance Prelude.Functor f => Profunctor (Kleisli f) where +instance (Prelude.Functor f) => Profunctor (Kleisli f) where dimap f g (Kleisli h) = Kleisli (\x -> forget g Prelude.<$> h (f x)) -instance Prelude.Functor f => Strong (,) () (Kleisli f) where +instance (Prelude.Functor f) => Strong (,) () (Kleisli f) where first (Kleisli f) = Kleisli (\(a, b) -> (,b) Prelude.<$> f a) second (Kleisli g) = Kleisli (\(a, b) -> (a,) Prelude.<$> g b) -instance Prelude.Applicative f => Strong Either Void (Kleisli f) where +instance (Prelude.Applicative f) => Strong Either Void (Kleisli f) where first (Kleisli f) = Kleisli $ \case Left x -> Prelude.fmap Left (f x) Right y -> Prelude.pure (Right y) -instance Prelude.Applicative f => Monoidal (,) () (Kleisli f) where +instance (Prelude.Applicative f) => Monoidal (,) () (Kleisli f) where Kleisli f *** Kleisli g = Kleisli (\(x, y) -> (,) Prelude.<$> f x Prelude.<*> g y) unit = Kleisli Prelude.pure -instance Prelude.Functor f => Monoidal Either Void (Kleisli f) where +instance (Prelude.Functor f) => Monoidal Either Void (Kleisli f) where Kleisli f *** Kleisli g = Kleisli $ \case Left a -> Left Prelude.<$> f a Right b -> Right Prelude.<$> g b diff --git a/src/Data/Set/Mutable/Linear/Internal.hs b/src/Data/Set/Mutable/Linear/Internal.hs --- a/src/Data/Set/Mutable/Linear/Internal.hs +++ b/src/Data/Set/Mutable/Linear/Internal.hs @@ -29,41 +29,41 @@ -- # Constructors and Mutators ------------------------------------------------------------------------------- -empty :: Keyed a => Int -> (Set a %1 -> Ur b) %1 -> Ur b +empty :: (Keyed a) => Int -> (Set a %1 -> Ur b) %1 -> Ur b empty s (f :: Set a %1 -> Ur b) = Linear.empty s (\hm -> f (Set hm)) -toList :: Keyed a => Set a %1 -> Ur [a] +toList :: (Keyed a) => Set a %1 -> Ur [a] toList (Set hm) = Linear.toList hm Linear.& \(Ur xs) -> Ur (Prelude.map Prelude.fst xs) -insert :: Keyed a => a -> Set a %1 -> Set a +insert :: (Keyed a) => a -> Set a %1 -> Set a insert a (Set hmap) = Set (Linear.insert a () hmap) -delete :: Keyed a => a -> Set a %1 -> Set a +delete :: (Keyed a) => a -> Set a %1 -> Set a delete a (Set hmap) = Set (Linear.delete a hmap) -union :: Keyed a => Set a %1 -> Set a %1 -> Set a +union :: (Keyed a) => Set a %1 -> Set a %1 -> Set a union (Set hm1) (Set hm2) = Set (Linear.unionWith (\_ _ -> ()) hm1 hm2) -intersection :: Keyed a => Set a %1 -> Set a %1 -> Set a +intersection :: (Keyed a) => Set a %1 -> Set a %1 -> Set a intersection (Set hm1) (Set hm2) = Set (Linear.intersectionWith (\_ _ -> ()) hm1 hm2) -- # Accessors ------------------------------------------------------------------------------- -size :: Keyed a => Set a %1 -> (Ur Int, Set a) +size :: (Keyed a) => Set a %1 -> (Ur Int, Set a) size (Set hm) = Linear.size hm Linear.& \(s, hm') -> (s, Set hm') -member :: Keyed a => a -> Set a %1 -> (Ur Bool, Set a) +member :: (Keyed a) => a -> Set a %1 -> (Ur Bool, Set a) member a (Set hm) = Linear.member a hm Linear.& \(b, hm') -> (b, Set hm') -fromList :: Keyed a => [a] -> (Set a %1 -> Ur b) %1 -> Ur b +fromList :: (Keyed a) => [a] -> (Set a %1 -> Ur b) %1 -> Ur b fromList xs f = Linear.fromList (Prelude.map (,()) xs) (\hm -> f (Set hm)) @@ -73,7 +73,7 @@ instance Prelude.Semigroup (Set a) where (<>) = Prelude.error "Prelude.(<>): invariant violation, unrestricted Set" -instance Keyed a => Semigroup (Set a) where +instance (Keyed a) => Semigroup (Set a) where (<>) = union instance Consumable (Set a) where diff --git a/src/Data/Tuple/Linear.hs b/src/Data/Tuple/Linear.hs --- a/src/Data/Tuple/Linear.hs +++ b/src/Data/Tuple/Linear.hs @@ -14,10 +14,10 @@ import Data.Unrestricted.Linear.Internal.Consumable import Prelude.Linear.Internal (curry, uncurry) -fst :: Consumable b => (a, b) %1 -> a +fst :: (Consumable b) => (a, b) %1 -> a fst (a, b) = lseq b a -snd :: Consumable a => (a, b) %1 -> b +snd :: (Consumable a) => (a, b) %1 -> b snd (a, b) = lseq a b swap :: (a, b) %1 -> (b, a) diff --git a/src/Data/Unrestricted/Linear/Internal/Consumable.hs b/src/Data/Unrestricted/Linear/Internal/Consumable.hs --- a/src/Data/Unrestricted/Linear/Internal/Consumable.hs +++ b/src/Data/Unrestricted/Linear/Internal/Consumable.hs @@ -52,7 +52,7 @@ -- | Consume the first argument and return the second argument. -- This is like 'seq' but the first argument is restricted to be 'Consumable'. -lseq :: Consumable a => a %1 -> b %1 -> b +lseq :: (Consumable a) => a %1 -> b %1 -> b lseq a b = seqUnit (consume a) b infixr 0 `lseq` -- same fixity as base.seq @@ -66,7 +66,7 @@ instance Consumable (Replicator.Replicator a) where consume = Replicator.consume -instance Consumable a => Consumable (Vector.Vector a) where +instance (Consumable a) => Consumable (Vector.Vector a) where consume xs = consume (Unsafe.toLinear Vector.toList xs) -- Prelude and primitive instances @@ -117,47 +117,47 @@ deriving via Generically (Solo a) instance - _ => Consumable (Solo a) + (_) => Consumable (Solo a) deriving via Generically (a, b) instance - _ => Consumable (a, b) + (_) => Consumable (a, b) deriving via Generically (a, b, c) instance - _ => Consumable (a, b, c) + (_) => Consumable (a, b, c) deriving via Generically (a, b, c, d) instance - _ => Consumable (a, b, c, d) + (_) => Consumable (a, b, c, d) deriving via Generically (a, b, c, d, e) instance - _ => Consumable (a, b, c, d, e) + (_) => Consumable (a, b, c, d, e) deriving via Generically (Prelude.Maybe a) instance - _ => Consumable (Prelude.Maybe a) + (_) => Consumable (Prelude.Maybe a) deriving via Generically (Prelude.Either e a) instance - _ => Consumable (Prelude.Either e a) + (_) => Consumable (Prelude.Either e a) deriving via Generically [a] instance - _ => Consumable [a] + (_) => Consumable [a] deriving via Generically (NonEmpty a) instance - _ => Consumable (NonEmpty a) + (_) => Consumable (NonEmpty a) deriving via Generically (Ur a) @@ -169,37 +169,37 @@ deriving via Generically (Semigroup.Arg a b) instance - _ => Consumable (Semigroup.Arg a b) + (_) => Consumable (Semigroup.Arg a b) -deriving newtype instance _ => Consumable (Semigroup.Min a) +deriving newtype instance (_) => Consumable (Semigroup.Min a) -deriving newtype instance _ => Consumable (Semigroup.Max a) +deriving newtype instance (_) => Consumable (Semigroup.Max a) -deriving newtype instance _ => Consumable (Semigroup.First a) +deriving newtype instance (_) => Consumable (Semigroup.First a) -deriving newtype instance _ => Consumable (Semigroup.Last a) +deriving newtype instance (_) => Consumable (Semigroup.Last a) -deriving newtype instance _ => Consumable (Semigroup.WrappedMonoid a) +deriving newtype instance (_) => Consumable (Semigroup.WrappedMonoid a) -deriving newtype instance _ => Consumable (Semigroup.Dual a) +deriving newtype instance (_) => Consumable (Semigroup.Dual a) deriving newtype instance Consumable Semigroup.All deriving newtype instance Consumable Semigroup.Any -deriving newtype instance _ => Consumable (Semigroup.Sum a) +deriving newtype instance (_) => Consumable (Semigroup.Sum a) -deriving newtype instance _ => Consumable (Semigroup.Product a) +deriving newtype instance (_) => Consumable (Semigroup.Product a) -- Data.Monoid instances -deriving newtype instance _ => Consumable (Monoid.First a) +deriving newtype instance (_) => Consumable (Monoid.First a) -deriving newtype instance _ => Consumable (Monoid.Last a) +deriving newtype instance (_) => Consumable (Monoid.Last a) -deriving newtype instance _ => Consumable (Monoid.Alt f a) +deriving newtype instance (_) => Consumable (Monoid.Alt f a) -deriving newtype instance _ => Consumable (Monoid.Ap f a) +deriving newtype instance (_) => Consumable (Monoid.Ap f a) -- ---------------- -- Generic deriving @@ -232,11 +232,11 @@ gconsume (a :*: b) = gconsume a `seqUnit` gconsume b {-# INLINE gconsume #-} -instance Consumable c => GConsumable (K1 i c) where +instance (Consumable c) => GConsumable (K1 i c) where gconsume (K1 c) = consume c {-# INLINE gconsume #-} -instance GConsumable f => GConsumable (M1 i t f) where +instance (GConsumable f) => GConsumable (M1 i t f) where gconsume (M1 a) = gconsume a {-# INLINE gconsume #-} @@ -249,7 +249,7 @@ gconsume (MP1 _) = () {-# INLINE gconsume #-} -instance GConsumable f => GConsumable (MP1 'One f) where +instance (GConsumable f) => GConsumable (MP1 'One f) where gconsume (MP1 x) = gconsume x {-# INLINE gconsume #-} diff --git a/src/Data/Unrestricted/Linear/Internal/Dupable.hs b/src/Data/Unrestricted/Linear/Internal/Dupable.hs --- a/src/Data/Unrestricted/Linear/Internal/Dupable.hs +++ b/src/Data/Unrestricted/Linear/Internal/Dupable.hs @@ -67,7 +67,7 @@ -- can have performance problems for recursive parameterized types. -- Specifically, the methods will not specialize to underlying 'Dupable' -- instances. See [this GHC issue](https://gitlab.haskell.org/ghc/ghc/-/issues/21131). -class Consumable a => Dupable a where +class (Consumable a) => Dupable a where {-# MINIMAL dupR | dup2 #-} -- | Creates a 'Replicator' for the given @a@. @@ -87,27 +87,27 @@ dup2 x = Replicator.elim (,) (dupR x) -- | Creates 3 @a@s from a @'Dupable' a@, in a linear fashion. -dup3 :: Dupable a => a %1 -> (a, a, a) +dup3 :: (Dupable a) => a %1 -> (a, a, a) dup3 x = Replicator.elim (,,) (dupR x) -- | Creates 4 @a@s from a @'Dupable' a@, in a linear fashion. -dup4 :: Dupable a => a %1 -> (a, a, a, a) +dup4 :: (Dupable a) => a %1 -> (a, a, a, a) dup4 x = Replicator.elim (,,,) (dupR x) -- | Creates 5 @a@s from a @'Dupable' a@, in a linear fashion. -dup5 :: Dupable a => a %1 -> (a, a, a, a, a) +dup5 :: (Dupable a) => a %1 -> (a, a, a, a, a) dup5 x = Replicator.elim (,,,,) (dupR x) -- | Creates 6 @a@s from a @'Dupable' a@, in a linear fashion. -dup6 :: Dupable a => a %1 -> (a, a, a, a, a, a) +dup6 :: (Dupable a) => a %1 -> (a, a, a, a, a, a) dup6 x = Replicator.elim (,,,,,) (dupR x) -- | Creates 7 @a@s from a @'Dupable' a@, in a linear fashion. -dup7 :: Dupable a => a %1 -> (a, a, a, a, a, a, a) +dup7 :: (Dupable a) => a %1 -> (a, a, a, a, a, a, a) dup7 x = Replicator.elim (,,,,,,) (dupR x) -- | Creates two @a@s from a @'Dupable' a@. Same function as 'dup2'. -dup :: Dupable a => a %1 -> (a, a) +dup :: (Dupable a) => a %1 -> (a, a) dup = dup2 ------------ @@ -158,7 +158,7 @@ deriving via Generically (Prelude.Maybe a) instance - Dupable a => Dupable (Prelude.Maybe a) + (Dupable a) => Dupable (Prelude.Maybe a) deriving via Generically (Prelude.Either a b) @@ -169,7 +169,7 @@ -- been able to find a way to get the generic version to specialize -- to a particular underlying Dupable. The recursion leads to the -- whole thing being a loop breaker and I don't know how to fix that. -instance Dupable a => Dupable [a] where +instance (Dupable a) => Dupable [a] where dupR = go where go :: [a] %1 -> Replicator [a] @@ -179,7 +179,7 @@ deriving via Generically (NonEmpty a) instance - Dupable a => Dupable (NonEmpty a) + (Dupable a) => Dupable (NonEmpty a) deriving via Generically (Ur a) @@ -194,7 +194,7 @@ deriving via Generically (Solo a) instance - Dupable a => Dupable (Solo a) + (Dupable a) => Dupable (Solo a) deriving via Generically (a, b) @@ -216,9 +216,9 @@ instance (Dupable a, Dupable b, Dupable c, Dupable d, Dupable e) => Dupable (a, b, c, d, e) -deriving newtype instance Dupable a => Dupable (Semigroup.Sum a) +deriving newtype instance (Dupable a) => Dupable (Semigroup.Sum a) -deriving newtype instance Dupable a => Dupable (Semigroup.Product a) +deriving newtype instance (Dupable a) => Dupable (Semigroup.Product a) deriving newtype instance Dupable Semigroup.All @@ -234,10 +234,10 @@ genericDupR :: (Generic a, GDupable (Rep a)) => a %1 -> Replicator a genericDupR x = Replicator.map to (gdupR (from x)) -class GConsumable f => GDupable f where +class (GConsumable f) => GDupable f where gdupR :: f a %1 -> Replicator (f a) -instance GDupable f => GDupable (M1 i c f) where +instance (GDupable f) => GDupable (M1 i c f) where gdupR (M1 x) = lcoerce (gdupR x) {-# INLINE gdupR #-} @@ -250,7 +250,7 @@ gdupR (R1 y) = Replicator.map R1 (gdupR y) {-# INLINE gdupR #-} -instance Dupable c => GDupable (K1 i c) where +instance (Dupable c) => GDupable (K1 i c) where gdupR = lcoerce (dupR @c) {-# INLINE gdupR #-} @@ -266,7 +266,7 @@ gdupR (MP1 x) = Replicator.pure (MP1 x) {-# INLINE gdupR #-} -instance GDupable f => GDupable (MP1 'One f) where +instance (GDupable f) => GDupable (MP1 'One f) where gdupR (MP1 x) = Replicator.map MP1 (gdupR x) {-# INLINE gdupR #-} diff --git a/src/Data/Unrestricted/Linear/Internal/Instances.hs b/src/Data/Unrestricted/Linear/Internal/Instances.hs --- a/src/Data/Unrestricted/Linear/Internal/Instances.hs +++ b/src/Data/Unrestricted/Linear/Internal/Instances.hs @@ -43,17 +43,17 @@ -- and 'Consumable' implementations for 'Movable' types. newtype AsMovable a = AsMovable a -instance Movable a => Movable (AsMovable a) where +instance (Movable a) => Movable (AsMovable a) where move (AsMovable x) = move x & \case Ur x' -> Ur (AsMovable x') -instance Movable a => Consumable (AsMovable a) where +instance (Movable a) => Consumable (AsMovable a) where consume x = move x & \case Ur _ -> () -instance Movable a => Dupable (AsMovable a) where +instance (Movable a) => Dupable (AsMovable a) where dupR x = move x & \case Ur x' -> Data.pure x' @@ -168,7 +168,7 @@ instance (Movable a, Prelude.Semigroup a) => Semigroup (MovableMonoid a) where MovableMonoid a <> MovableMonoid b = MovableMonoid (combine (move a) (move b)) where - combine :: Prelude.Semigroup a => Ur a %1 -> Ur a %1 -> a + combine :: (Prelude.Semigroup a) => Ur a %1 -> Ur a %1 -> a combine (Ur x) (Ur y) = x Prelude.<> y instance (Movable a, Prelude.Monoid a) => Monoid (MovableMonoid a) where diff --git a/src/Data/Unrestricted/Linear/Internal/Movable.hs b/src/Data/Unrestricted/Linear/Internal/Movable.hs --- a/src/Data/Unrestricted/Linear/Internal/Movable.hs +++ b/src/Data/Unrestricted/Linear/Internal/Movable.hs @@ -53,7 +53,7 @@ -- -- * @case move x of {Ur _ -> ()} = consume x@ -- * @case move x of {Ur x -> (x, x)} = dup2 x@ -class Dupable a => Movable a where +class (Dupable a) => Movable a where move :: a %1 -> Ur a -- ------------- @@ -100,7 +100,7 @@ deriving via Generically (Solo a) instance - Movable a => Movable (Solo a) + (Movable a) => Movable (Solo a) deriving via Generically (a, b) @@ -122,7 +122,7 @@ instance (Movable a, Movable b, Movable c, Movable d, Movable e) => Movable (a, b, c, d, e) -instance Movable a => Movable (Prelude.Maybe a) where +instance (Movable a) => Movable (Prelude.Maybe a) where move (Prelude.Nothing) = Ur Prelude.Nothing move (Prelude.Just x) = Data.fmap Prelude.Just (move x) @@ -130,7 +130,7 @@ move (Prelude.Left a) = Data.fmap Prelude.Left (move a) move (Prelude.Right b) = Data.fmap Prelude.Right (move b) -instance Movable a => Movable [a] where +instance (Movable a) => Movable [a] where -- The explicit go function lets this specialize. move = go where @@ -138,16 +138,16 @@ go [] = Ur [] go (a : l) = (:) Data.<$> move a Data.<*> go l -instance Movable a => Movable (NonEmpty a) where +instance (Movable a) => Movable (NonEmpty a) where move (x :| xs) = (:|) Data.<$> move x Data.<*> move xs instance Movable (Ur a) where move (Ur a) = Ur (Ur a) -- Some stock instances -deriving newtype instance Movable a => Movable (Semigroup.Sum a) +deriving newtype instance (Movable a) => Movable (Semigroup.Sum a) -deriving newtype instance Movable a => Movable (Semigroup.Product a) +deriving newtype instance (Movable a) => Movable (Semigroup.Product a) deriving newtype instance Movable Semigroup.All @@ -162,7 +162,7 @@ genericMove :: (Generic a, GMovable (Rep a)) => a %1 -> Ur a genericMove = Data.fmap to . gmove . from -class GDupable f => GMovable f where +class (GDupable f) => GMovable f where gmove :: f p %1 -> Ur (f p) instance GMovable V1 where @@ -182,16 +182,16 @@ gmove b & \case (Ur y) -> Ur (x :*: y) -instance Movable c => GMovable (K1 i c) where +instance (Movable c) => GMovable (K1 i c) where gmove (K1 c) = lcoerce (move c) -instance GMovable f => GMovable (M1 i t f) where +instance (GMovable f) => GMovable (M1 i t f) where gmove (M1 a) = lcoerce (gmove a) instance GMovable (MP1 'Many f) where gmove (MP1 x) = Ur (MP1 x) -instance GMovable f => GMovable (MP1 'One f) where +instance (GMovable f) => GMovable (MP1 'One f) where gmove (MP1 a) = gmove a & \case Ur x -> Ur (MP1 x) instance GMovable UChar where diff --git a/src/Data/Unrestricted/Linear/Internal/UrT.hs b/src/Data/Unrestricted/Linear/Internal/UrT.hs --- a/src/Data/Unrestricted/Linear/Internal/UrT.hs +++ b/src/Data/Unrestricted/Linear/Internal/UrT.hs @@ -29,14 +29,14 @@ runUrT :: UrT m a %1 -> m (Ur a) runUrT (UrT ma) = ma -instance Linear.Functor m => Functor (UrT m) where +instance (Linear.Functor m) => Functor (UrT m) where fmap f (UrT ma) = UrT (Linear.fmap (\(Ur a) -> Ur (f a)) ma) -instance Linear.Applicative m => Applicative (UrT m) where +instance (Linear.Applicative m) => Applicative (UrT m) where pure a = UrT (Linear.pure (Ur a)) UrT mf <*> UrT ma = UrT (Linear.liftA2 (\(Ur f) (Ur a) -> Ur (f a)) mf ma) -instance Linear.Monad m => Monad (UrT m) where +instance (Linear.Monad m) => Monad (UrT m) where UrT ma >>= f = UrT (ma Linear.>>= (\(Ur a) -> case f a of (UrT mb) -> mb)) -- | Lift a computation to the @UrT@ monad, provided that the type @a@ can be used unrestricted. @@ -46,5 +46,5 @@ -- | Extract the inner computation linearly, the inverse of `liftUrT`. -- -- > evalUrT (liftUrT m) = m -evalUrT :: Linear.Functor m => UrT m a %1 -> m a +evalUrT :: (Linear.Functor m) => UrT m a %1 -> m a evalUrT u = Linear.fmap unur (runUrT u) diff --git a/src/Data/V/Linear.hs b/src/Data/V/Linear.hs --- a/src/Data/V/Linear.hs +++ b/src/Data/V/Linear.hs @@ -11,7 +11,7 @@ -- -- >>> :set -XLinearTypes -- >>> :set -XTypeApplications --- >>> :set -XTypeInType +-- >>> :set -XDataKinds -- >>> :set -XTypeFamilies -- >>> import Prelude.Linear -- >>> import qualified Data.V.Linear as V diff --git a/src/Data/V/Linear/Internal.hs b/src/Data/V/Linear/Internal.hs --- a/src/Data/V/Linear/Internal.hs +++ b/src/Data/V/Linear/Internal.hs @@ -84,18 +84,18 @@ infixl 4 <*> -- same fixity as base.<*> -- | Splits the head and tail of the 'V', returning an unboxed tuple. -uncons# :: 1 <= n => V n a %1 -> (# a, V (n - 1) a #) +uncons# :: (1 <= n) => V n a %1 -> (# a, V (n - 1) a #) uncons# = Unsafe.toLinear uncons'# where - uncons'# :: 1 <= n => V n a -> (# a, V (n - 1) a #) + uncons'# :: (1 <= n) => V n a -> (# a, V (n - 1) a #) uncons'# (V xs) = (# Vector.head xs, V (Vector.tail xs) #) {-# INLINEABLE uncons# #-} -- | Splits the head and tail of the 'V', returning a boxed tuple. -uncons :: 1 <= n => V n a %1 -> (a, V (n - 1) a) +uncons :: (1 <= n) => V n a %1 -> (a, V (n - 1) a) uncons = Unsafe.toLinear uncons' where - uncons' :: 1 <= n => V n a -> (a, V (n - 1) a) + uncons' :: (1 <= n) => V n a -> (a, V (n - 1) a) uncons' (V xs) = (Vector.head xs, V (Vector.tail xs)) {-# INLINEABLE uncons #-} @@ -234,14 +234,14 @@ ------------------------------------------------------------------------------- -- | Returns the type-level 'Nat' of the context as a term-level integer. -theLength :: forall n. KnownNat n => Prelude.Int +theLength :: forall n. (KnownNat n) => Prelude.Int theLength = Prelude.fromIntegral (natVal' @n (proxy# @_)) -pure :: forall n a. KnownNat n => a -> V n a +pure :: forall n a. (KnownNat n) => a -> V n a pure a = V $ Vector.replicate (theLength @n) a -- | Creates a 'V' of the specified size by consuming a 'Replicator'. -fromReplicator :: forall n a. KnownNat n => Replicator a %1 -> V n a +fromReplicator :: forall n a. (KnownNat n) => Replicator a %1 -> V n a fromReplicator = let n' = theLength @n in V . Unsafe.toLinear Vector.fromList . Replicator.take n' -- | Produces a @'V' n a@ from a 'Dupable' value @a@. diff --git a/src/Data/V/Linear/Internal/Instances.hs b/src/Data/V/Linear/Internal/Instances.hs --- a/src/Data/V/Linear/Internal/Instances.hs +++ b/src/Data/V/Linear/Internal/Instances.hs @@ -26,15 +26,15 @@ instance Data.Functor (V n) where fmap = V.map -instance KnownNat n => Data.Applicative (V n) where +instance (KnownNat n) => Data.Applicative (V n) where pure = V.pure a <*> b = a V.<*> b -instance KnownNat n => Prelude.Applicative (V n) where +instance (KnownNat n) => Prelude.Applicative (V n) where pure = V.pure V fs <*> V xs = V $ Vector.zipWith ($) fs xs -instance KnownNat n => Data.Traversable (V n) where +instance (KnownNat n) => Data.Traversable (V n) where traverse f (V xs) = (V . Unsafe.toLinear (Vector.fromListN (V.theLength @n))) Data.<$> Data.traverse f (Unsafe.toLinear Vector.toList xs) diff --git a/src/Data/Vector/Mutable/Linear/Internal.hs b/src/Data/Vector/Mutable/Linear/Internal.hs --- a/src/Data/Vector/Mutable/Linear/Internal.hs +++ b/src/Data/Vector/Mutable/Linear/Internal.hs @@ -50,7 +50,7 @@ -- equal to the size of the given array. -- -- This is a constant time operation. -fromArray :: HasCallStack => Array a %1 -> Vector a +fromArray :: (HasCallStack) => Array a %1 -> Vector a fromArray arr = Array.size arr & \(Ur size', arr') -> Vec size' arr' @@ -62,7 +62,7 @@ -- | Allocate a constant vector of a given non-negative size (and error on a -- bad size) constant :: - HasCallStack => + (HasCallStack) => Int -> a -> (Vector a %1 -> Ur b) %1 -> @@ -74,7 +74,7 @@ | otherwise = Array.alloc size' x (f . fromArray) -- | Allocator from a list -fromList :: HasCallStack => [a] -> (Vector a %1 -> Ur b) %1 -> Ur b +fromList :: (HasCallStack) => [a] -> (Vector a %1 -> Ur b) %1 -> Ur b fromList xs f = Array.fromList xs (f . fromArray) -- | Number of elements inside the vector. @@ -112,32 +112,32 @@ -- | Write to an element . Note: this will not write to elements beyond the -- current size of the vector and will error instead. -set :: HasCallStack => Int -> a -> Vector a %1 -> Vector a +set :: (HasCallStack) => Int -> a -> Vector a %1 -> Vector a set ix val vec = unsafeSet ix val (assertIndexInRange ix vec) -- | Same as 'write', but does not do bounds-checking. The behaviour is undefined -- when passed an invalid index. -unsafeSet :: HasCallStack => Int -> a -> Vector a %1 -> Vector a +unsafeSet :: (HasCallStack) => Int -> a -> Vector a %1 -> Vector a unsafeSet ix val (Vec size' arr) = Vec size' (Array.unsafeSet ix val arr) -- | Read from a vector, with an in-range index and error for an index that is -- out of range (with the usual range @0..size-1@). -get :: HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a) +get :: (HasCallStack) => Int -> Vector a %1 -> (Ur a, Vector a) get ix vec = unsafeGet ix (assertIndexInRange ix vec) -- | Same as 'read', but does not do bounds-checking. The behaviour is undefined -- when passed an invalid index. -unsafeGet :: HasCallStack => Int -> Vector a %1 -> (Ur a, Vector a) +unsafeGet :: (HasCallStack) => Int -> Vector a %1 -> (Ur a, Vector a) unsafeGet ix (Vec size' arr) = Array.unsafeGet ix arr & \(val, arr') -> (val, Vec size' arr') -- | Same as 'modify', but does not do bounds-checking. unsafeModify :: - HasCallStack => + (HasCallStack) => (a -> (a, b)) -> Int -> Vector a %1 -> @@ -152,7 +152,7 @@ -- | Modify a value inside a vector, with an ability to return an extra -- information. Errors if the index is out of bounds. modify :: - HasCallStack => + (HasCallStack) => (a -> (a, b)) -> Int -> Vector a %1 -> @@ -160,7 +160,7 @@ modify f ix vec = unsafeModify f ix (assertIndexInRange ix vec) -- | Same as 'modify', but without the ability to return extra information. -modify_ :: HasCallStack => (a -> a) -> Int -> Vector a %1 -> Vector a +modify_ :: (HasCallStack) => (a -> a) -> Int -> Vector a %1 -> Vector a modify_ f ix vec = modify (\a -> (f a, ())) ix vec & \(Ur (), vec') -> vec' @@ -244,7 +244,7 @@ & \(Ur vec) -> Ur (Vector.take sz vec) -- | Same as 'set', but takes the 'Vector' as the first parameter. -write :: HasCallStack => Vector a %1 -> Int -> a -> Vector a +write :: (HasCallStack) => Vector a %1 -> Int -> a -> Vector a write arr i a = set i a arr -- | Same as 'unsafeSafe', but takes the 'Vector' as the first parameter. @@ -252,7 +252,7 @@ unsafeWrite arr i a = unsafeSet i a arr -- | Same as 'get', but takes the 'Vector' as the first parameter. -read :: HasCallStack => Vector a %1 -> Int -> (Ur a, Vector a) +read :: (HasCallStack) => Vector a %1 -> Int -> (Ur a, Vector a) read arr i = get i arr -- | Same as 'unsafeGet', but takes the 'Vector' as the first parameter. @@ -297,7 +297,7 @@ -- | Grows the vector to the closest power of growthFactor to -- fit at least n more elements. -growToFit :: HasCallStack => Int -> Vector a %1 -> Vector a +growToFit :: (HasCallStack) => Int -> Vector a %1 -> Vector a growToFit n vec = capacity vec & \(Ur cap, vec') -> size vec' & \(Ur s', vec'') -> @@ -321,7 +321,7 @@ -- | Resize the vector to a non-negative size. In-range elements are preserved, -- the possible new elements are bottoms. -unsafeResize :: HasCallStack => Int -> Vector a %1 -> Vector a +unsafeResize :: (HasCallStack) => Int -> Vector a %1 -> Vector a unsafeResize newSize (Vec size' ma) = Vec (min size' newSize) @@ -332,7 +332,7 @@ ) -- | Check if given index is within the Vector, otherwise panic. -assertIndexInRange :: HasCallStack => Int -> Vector a %1 -> Vector a +assertIndexInRange :: (HasCallStack) => Int -> Vector a %1 -> Vector a assertIndexInRange i vec = size vec & \(Ur s, vec') -> if 0 <= i && i < s diff --git a/src/Debug/Trace/Linear.hs b/src/Debug/Trace/Linear.hs --- a/src/Debug/Trace/Linear.hs +++ b/src/Debug/Trace/Linear.hs @@ -42,7 +42,7 @@ -- | Like 'trace', but uses 'show' on the argument to convert it to -- a 'String'. -traceShow :: Show a => a -> b %1 -> b +traceShow :: (Show a) => a -> b %1 -> b traceShow a = Unsafe.toLinear (NonLinear.traceShow a) -- | Like 'trace' but returns the message instead of a third value. @@ -61,7 +61,7 @@ -- | Like 'trace' but returning unit in an arbitrary 'Applicative' -- context. Allows for convenient use in do-notation. -traceM :: Applicative f => String %1 -> f () +traceM :: (Applicative f) => String %1 -> f () traceM s = trace s $ pure () -- | Like 'traceM', but uses 'show' on the argument to convert it to a diff --git a/src/Foreign/Marshal/Pure/Internal.hs b/src/Foreign/Marshal/Pure/Internal.hs --- a/src/Foreign/Marshal/Pure/Internal.hs +++ b/src/Foreign/Marshal/Pure/Internal.hs @@ -39,7 +39,7 @@ -- the one that was released with 8.2, and that `mtl` fails to compile against -- it), therefore, I'm redefining `Dict` here, as it's cheap. data Dict :: Constraint -> Type where - Dict :: c => Dict c + Dict :: (c) => Dict c -- TODO: organise into sections @@ -48,7 +48,7 @@ -- base types. class KnownRepresentable a where storable :: Dict (Storable a) - default storable :: Storable a => Dict (Storable a) + default storable :: (Storable a) => Dict (Storable a) storable = Dict -- This ought to be read a `newtype` around `Storable`. This type is abstract, @@ -88,13 +88,13 @@ (Dict, Dict, Dict) -> Dict -- TODO: move to the definition of Ur -instance Storable a => Storable (Ur a) where +instance (Storable a) => Storable (Ur a) where sizeOf _ = sizeOf (undefined :: a) alignment _ = alignment (undefined :: a) peek ptr = Ur <$> peek (castPtr ptr :: Ptr a) poke ptr (Ur a) = poke (castPtr ptr :: Ptr a) a -instance KnownRepresentable a => KnownRepresentable (Ur a) where +instance (KnownRepresentable a) => KnownRepresentable (Ur a) where storable | Dict <- storable @a = Dict -- Below is a KnownRepresentable instance for Maybe. The Storable instance is @@ -105,7 +105,7 @@ -- case. But I believe that to improve on it we need to rethink the abstraction -- in more depths. -instance Storable a => Storable (Maybe a) where +instance (Storable a) => Storable (Maybe a) where sizeOf x = sizeOf (stripMaybe x) + 1 alignment x = alignment (stripMaybe x) peek ptr = do @@ -130,7 +130,7 @@ stripPtr :: Ptr a -> a stripPtr _ = error "stripPtr" -instance KnownRepresentable a => KnownRepresentable (Maybe a) where +instance (KnownRepresentable a) => KnownRepresentable (Maybe a) where storable | Dict <- storable @a = Dict -- | Laws of 'Representable': @@ -191,7 +191,7 @@ toKnown (a, b, c) = (toKnown a, toKnown b, toKnown c) ofKnown (x, y, z) = (ofKnown x, ofKnown y, ofKnown z) -instance Representable a => Representable (Maybe a) where +instance (Representable a) => Representable (Maybe a) where type AsKnown (Maybe a) = Maybe (AsKnown a) toKnown (Just x) = Just (toKnown x) toKnown Nothing = Nothing @@ -215,7 +215,7 @@ -- * 'toRepr' must be total -- * 'ofRepr' may be partial, but must be total on the image of 'toRepr' -- * @ofRepr . toRepr = id@ -class Representable b => MkRepresentable a b | a -> b where +class (Representable b) => MkRepresentable a b | a -> b where toRepr :: a %1 -> b ofRepr :: b %1 -> a @@ -253,7 +253,7 @@ -- Precondition: in `insertAfter start ptr`, `next start` must be initalised, -- and so must be `prev =<< peek (next start)` -insertAfter :: Storable a => DLL a -> a -> IO (Ptr (DLL a)) +insertAfter :: (Storable a) => DLL a -> a -> IO (Ptr (DLL a)) insertAfter start ptr = do secondLink <- peek $ next start newLink <- DLL <$> new start <*> new ptr <*> new secondLink @@ -344,12 +344,12 @@ -- Movable. In order to be useful, need some kind of borrowing on the values, I -- guess. 'Box' can be realloced, but not RC pointers. -reprPoke :: forall a. Representable a => Ptr a -> a %1 -> IO () +reprPoke :: forall a. (Representable a) => Ptr a -> a %1 -> IO () reprPoke ptr a | Dict <- storable @(AsKnown a) = Unsafe.toLinear (poke (castPtr ptr :: Ptr (AsKnown a))) (toKnown a) -reprNew :: forall a. Representable a => a %1 -> IO (Ptr a) +reprNew :: forall a. (Representable a) => a %1 -> IO (Ptr a) reprNew a = Unsafe.toLinear mkPtr a where @@ -369,7 +369,7 @@ -- write bespoke constructors). -- | Store a value @a@ on the system heap that is not managed by the GC. -alloc :: forall a. Representable a => a %1 -> Pool %1 -> Box a +alloc :: forall a. (Representable a) => a %1 -> Pool %1 -> Box a alloc a (Pool pool) = Unsafe.toLinear mkPtr a where @@ -382,13 +382,13 @@ -- TODO: would be better in linear IO, for we pretend that we are making an -- unrestricted 'a', where really we are not. -reprPeek :: forall a. Representable a => Ptr a -> IO a +reprPeek :: forall a. (Representable a) => Ptr a -> IO a reprPeek ptr | Dict <- storable @(AsKnown a) = do knownRepr <- peek (castPtr ptr :: Ptr (AsKnown a)) return (ofKnown knownRepr) -- | Retrieve the value stored on system heap memory. -deconstruct :: Representable a => Box a %1 -> a +deconstruct :: (Representable a) => Box a %1 -> a deconstruct (Box poolPtr ptr) = unsafeDupablePerformIO $ mask_ $ do res <- reprPeek ptr diff --git a/src/Prelude/Linear/Internal.hs b/src/Prelude/Linear/Internal.hs --- a/src/Prelude/Linear/Internal.hs +++ b/src/Prelude/Linear/Internal.hs @@ -79,6 +79,6 @@ runIdentity' (Identity x) = x -- | A linear version of 'Data.Coerce.coerce' for types of kind 'Data.Kind.Type'. -lcoerce :: forall a b. Coercible a b => a %1 -> b +lcoerce :: forall a b. (Coercible a b) => a %1 -> b lcoerce = coerce ((\x -> x) :: a %1 -> a) {-# INLINE CONLIKE lcoerce #-} diff --git a/src/Prelude/Linear/Unsatisfiable.hs b/src/Prelude/Linear/Unsatisfiable.hs --- a/src/Prelude/Linear/Unsatisfiable.hs +++ b/src/Prelude/Linear/Unsatisfiable.hs @@ -27,7 +27,7 @@ -- | A constraint that cannot be satisfied. Users should normally use -- 'Unsatisfiable' instead of using this class directly. -class Any => Bottom where +class (Any) => Bottom where unsatisfiable' :: Void -- | An unsatisfiable constraint with a user-provided error message. Under an @@ -45,5 +45,5 @@ -- | Produce a value of any type (and runtime representation) under -- an 'Unsatisfiable' or 'Bottom' constraint. -unsatisfiable :: forall {rep} (a :: TYPE rep). Bottom => a +unsatisfiable :: forall {rep} (a :: TYPE rep). (Bottom) => a unsatisfiable = case unsatisfiable' of {} diff --git a/src/Streaming/Linear.hs b/src/Streaming/Linear.hs --- a/src/Streaming/Linear.hs +++ b/src/Streaming/Linear.hs @@ -436,7 +436,7 @@ -- are linear. inspectC :: forall f m r a. - Control.Monad m => + (Control.Monad m) => (r %1 -> m a) -> (f (Stream f m r) %1 -> m a) -> Stream f m r %1 -> @@ -502,7 +502,7 @@ -- > Streaming.Prelude.unfoldr StreamingPrelude.next = id inspect :: forall f m r. - Control.Monad m => + (Control.Monad m) => Stream f m r %1 -> m (Either r (f (Stream f m r))) inspect = loop @@ -809,10 +809,10 @@ {-# INLINE mapsM_ #-} -- | Run the effects in a stream that merely layers effects. -run :: Control.Monad m => Stream m m r %1 -> m r +run :: (Control.Monad m) => Stream m m r %1 -> m r run = loop where - loop :: Control.Monad m => Stream m m r %1 -> m r + loop :: (Control.Monad m) => Stream m m r %1 -> m r loop stream = stream & \case Return r -> Control.return r diff --git a/src/Streaming/Linear/Internal/Consume.hs b/src/Streaming/Linear/Internal/Consume.hs --- a/src/Streaming/Linear/Internal/Consume.hs +++ b/src/Streaming/Linear/Internal/Consume.hs @@ -121,7 +121,7 @@ {-# INLINEABLE stdoutLn' #-} -- | Print the elements of a stream as they arise. -print :: Show a => Stream (Of a) IO r %1 -> IO r +print :: (Show a) => Stream (Of a) IO r %1 -> IO r print = stdoutLn' . map (Text.pack Prelude.. Prelude.show) -- | Write a stream to a handle and return the handle. @@ -165,7 +165,7 @@ -- > hoist S.effects . S.copy = id -- -- The similar @effects@ and @copy@ operations in @Data.ByteString.Streaming@ obey the same rules. -effects :: forall a m r. Control.Monad m => Stream (Of a) m r %1 -> m r +effects :: forall a m r. (Control.Monad m) => Stream (Of a) m r %1 -> m r effects stream = loop stream where loop :: Stream (Of a) m r %1 -> m r @@ -177,7 +177,7 @@ {-# INLINEABLE effects #-} -- | Remove the elements from a stream of values, retaining the structure of layers. -erase :: forall a m r. Control.Monad m => Stream (Of a) m r %1 -> Stream Identity m r +erase :: forall a m r. (Control.Monad m) => Stream (Of a) m r %1 -> Stream Identity m r erase stream = loop stream where loop :: Stream (Of a) m r %1 -> Stream Identity m r @@ -292,7 +292,7 @@ -- @ fold :: forall x a b m r. - Control.Monad m => + (Control.Monad m) => (x -> a -> x) -> x -> (x -> b) -> @@ -360,7 +360,7 @@ -- @ foldM :: forall x a m b r. - Control.Monad m => + (Control.Monad m) => (x %1 -> a -> m x) -> m x -> (x %1 -> m b) -> @@ -398,7 +398,7 @@ {-# INLINEABLE foldM_ #-} -- | Note: does not short circuit -all :: Control.Monad m => (a -> Bool) -> Stream (Of a) m r %1 -> m (Of Bool r) +all :: (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> m (Of Bool r) all f stream = fold (&&) True id (map f stream) {-# INLINEABLE all #-} @@ -408,7 +408,7 @@ {-# INLINEABLE all_ #-} -- | Note: does not short circuit -any :: Control.Monad m => (a -> Bool) -> Stream (Of a) m r %1 -> m (Of Bool r) +any :: (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> m (Of Bool r) any f stream = fold (||) False id (map f stream) {-# INLINEABLE any #-} @@ -462,7 +462,7 @@ -- | Note that 'head' exhausts the rest of the stream following the -- first element, performing all monadic effects via 'effects' -head :: Control.Monad m => Stream (Of a) m r %1 -> m (Of (Maybe a) r) +head :: (Control.Monad m) => Stream (Of a) m r %1 -> m (Of (Maybe a) r) head str = str & \case Return r -> Control.return (Nothing :> r) @@ -482,11 +482,11 @@ effects rest Control.>>= \r -> lseq r $ Control.return (Just a) {-# INLINEABLE head_ #-} -last :: Control.Monad m => Stream (Of a) m r %1 -> m (Of (Maybe a) r) +last :: (Control.Monad m) => Stream (Of a) m r %1 -> m (Of (Maybe a) r) last = loop Nothing where loop :: - Control.Monad m => + (Control.Monad m) => Maybe a -> Stream (Of a) m r %1 -> m (Of (Maybe a) r) @@ -571,7 +571,7 @@ -- 3 -- 1 -- @ -length :: Control.Monad m => Stream (Of a) m r %1 -> m (Of Int r) +length :: (Control.Monad m) => Stream (Of a) m r %1 -> m (Of Int r) length = fold (\n _ -> n + 1) 0 id {-# INLINE length #-} @@ -608,7 +608,7 @@ -- v -- ["u","v"] -- @ -toList :: Control.Monad m => Stream (Of a) m r %1 -> m (Of [a] r) +toList :: (Control.Monad m) => Stream (Of a) m r %1 -> m (Of [a] r) toList = fold (\diff a ls -> diff (a : ls)) id (\diff -> diff []) {-# INLINE toList #-} @@ -618,7 +618,7 @@ -- It is basically the same as Prelude 'mapM' which, like 'replicateM', -- 'sequence' and similar operations on traversable containers -- is a leading cause of space leaks. -toList_ :: Control.Monad m => Stream (Of a) m () %1 -> m [a] +toList_ :: (Control.Monad m) => Stream (Of a) m () %1 -> m [a] toList_ = fold_ (\diff a ls -> diff (a : ls)) id (\diff -> diff []) {-# INLINE toList_ #-} @@ -656,13 +656,13 @@ maximum_ = fold_ getMax Nothing id . map Just {-# INLINE maximum_ #-} -getMin :: Ord a => Maybe a -> Maybe a -> Maybe a +getMin :: (Ord a) => Maybe a -> Maybe a -> Maybe a getMin = mCompare Prelude.min -getMax :: Ord a => Maybe a -> Maybe a -> Maybe a +getMax :: (Ord a) => Maybe a -> Maybe a -> Maybe a getMax = mCompare Prelude.max -mCompare :: Ord a => (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a +mCompare :: (Ord a) => (a -> a -> a) -> Maybe a -> Maybe a -> Maybe a mCompare _ Nothing Nothing = Nothing mCompare _ (Just a) Nothing = Just a mCompare _ Nothing (Just a) = Just a @@ -673,7 +673,7 @@ -- still more general 'destroy' foldrM :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> m r %1 -> m r) -> Stream (Of a) m r %1 -> m r diff --git a/src/Streaming/Linear/Internal/Interop.hs b/src/Streaming/Linear/Internal/Interop.hs --- a/src/Streaming/Linear/Internal/Interop.hs +++ b/src/Streaming/Linear/Internal/Interop.hs @@ -26,14 +26,14 @@ -- > reread readIORef :: IORef (Maybe a) -> Stream (Of a) IO () -- > reread Streams.read :: System.IO.Streams.InputStream a -> Stream (Of a) IO () reread :: - Control.Monad m => + (Control.Monad m) => (s -> m (Ur (Maybe a))) -> s -> Stream (Of a) m () reread f s = reread' f s where reread' :: - Control.Monad m => + (Control.Monad m) => (s -> m (Ur (Maybe a))) -> s -> Stream (Of a) m () diff --git a/src/Streaming/Linear/Internal/Many.hs b/src/Streaming/Linear/Internal/Many.hs --- a/src/Streaming/Linear/Internal/Many.hs +++ b/src/Streaming/Linear/Internal/Many.hs @@ -105,13 +105,13 @@ -- unzip = 'expand' $ \p ((a,b) :> abs) -> b :> p (a :> abs) -- @ unzip :: - Control.Monad m => + (Control.Monad m) => Stream (Of (a, b)) m r %1 -> Stream (Of a) (Stream (Of b) m) r unzip = loop where loop :: - Control.Monad m => + (Control.Monad m) => Stream (Of (a, b)) m r %1 -> Stream (Of a) (Stream (Of b) m) r loop stream = @@ -155,7 +155,7 @@ -- the same length, but one needs to perform some effects to obtain the -- end-of-stream result, that stream is treated as a residual. zipWithR :: - Control.Monad m => + (Control.Monad m) => (a -> b -> c) -> Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> @@ -163,7 +163,7 @@ zipWithR = loop where loop :: - Control.Monad m => + (Control.Monad m) => (a -> b -> c) -> Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> @@ -184,7 +184,7 @@ {-# INLINEABLE zipWithR #-} zipWith :: - Control.Monad m => + (Control.Monad m) => (a -> b -> c) -> Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> @@ -204,7 +204,7 @@ -- | @zip@ zips two streams exhausing the remainder of the longer -- stream and consuming its effects. zip :: - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> Stream (Of (a, b)) m (r1, r2) @@ -213,7 +213,7 @@ -- | @zipR@ zips two streams keeping the remainder if there is one. zipR :: - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> Stream (Of (a, b)) m (ZipResidual a b m r1 r2) @@ -235,7 +235,7 @@ -- | Like @zipWithR@ but with three streams. zipWith3R :: - Control.Monad m => + (Control.Monad m) => (a -> b -> c -> d) -> Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> @@ -244,7 +244,7 @@ zipWith3R = loop where loop :: - Control.Monad m => + (Control.Monad m) => (a -> b -> c -> d) -> Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> @@ -275,7 +275,7 @@ -- | Like @zipWith@ but with three streams zipWith3 :: - Control.Monad m => + (Control.Monad m) => (a -> b -> c -> d) -> Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> @@ -293,7 +293,7 @@ -- | Like @zipR@ but with three streams. zip3 :: - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> Stream (Of c) m r3 %1 -> @@ -303,7 +303,7 @@ -- | Like @zipR@ but with three streams. zip3R :: - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r1 %1 -> Stream (Of b) m r2 %1 -> Stream (Of c) m r3 %1 -> @@ -313,7 +313,7 @@ -- | Internal function to consume a stream remainder to -- get the payload -extractResult :: Control.Monad m => Either r (Stream (Of a) m r) %1 -> m r +extractResult :: (Control.Monad m) => Either r (Stream (Of a) m r) %1 -> m r extractResult (Left r) = Control.return r extractResult (Right s) = effects s @@ -368,7 +368,7 @@ -- The return values of both streams are returned. mergeBy :: forall m a r s. - Control.Monad m => + (Control.Monad m) => (a -> a -> Ordering) -> Stream (Of a) m r %1 -> Stream (Of a) m s %1 -> diff --git a/src/Streaming/Linear/Internal/Process.hs b/src/Streaming/Linear/Internal/Process.hs --- a/src/Streaming/Linear/Internal/Process.hs +++ b/src/Streaming/Linear/Internal/Process.hs @@ -123,7 +123,7 @@ -- that can add an element to the functor that is itself a stream. -- Basically `consFirstChunk 42 [[1,2,3],[4,5]] = [[42,1,2,3],[4,5]]`. consFirstChunk :: - Control.Monad m => + (Control.Monad m) => a -> Stream (Stream (Of a) m) m r %1 -> Stream (Stream (Of a) m) m r @@ -173,7 +173,7 @@ -- > inspect :: Control.Monad m => Stream (Of a) m r %1-> m (Either r (Of a (Stream (Of a) m r))) next :: forall a m r. - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r)) next stream = loop stream @@ -265,7 +265,7 @@ -- @ break :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r) @@ -295,7 +295,7 @@ -- @ breaks :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r @@ -336,7 +336,7 @@ -- @ breakWhen :: forall m a x b r. - Control.Monad m => + (Control.Monad m) => (x -> a -> x) -> x -> (x -> b) -> @@ -357,7 +357,7 @@ -- | Breaks on the first element to satisfy the predicate breakWhen' :: - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r) @@ -366,7 +366,7 @@ -- | Stream elements until one fails the condition, return the rest. span :: - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r) @@ -387,7 +387,7 @@ -- @ groupBy :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> a -> Bool) -> Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r @@ -543,7 +543,7 @@ -- > filter p = hoist effects (partition p) partition :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r @@ -566,13 +566,13 @@ -- > rights = S.effects . partitionEithers -- > rights = S.concat partitionEithers :: - Control.Monad m => + (Control.Monad m) => Stream (Of (Either a b)) m r %1 -> Stream (Of a) (Stream (Of b) m) r partitionEithers = loop where loop :: - Control.Monad m => + (Control.Monad m) => Stream (Of (Either a b)) m r %1 -> Stream (Of a) (Stream (Of b) m) r loop stream = @@ -588,10 +588,10 @@ -- | The 'catMaybes' function takes a 'Stream' of 'Maybe's and returns -- a 'Stream' of all of the 'Just' values. 'concat' has the same behavior, -- but is more general; it works for any foldable container type. -catMaybes :: Control.Monad m => Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r +catMaybes :: (Control.Monad m) => Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r catMaybes stream = loop stream where - loop :: Control.Monad m => Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r + loop :: (Control.Monad m) => Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r loop stream = stream & \case Return r -> Return r @@ -606,7 +606,7 @@ -- is added on to the result 'Stream'. If it is @'Just' b@, then @b@ is included in the result 'Stream'. mapMaybe :: forall a b m r. - Control.Monad m => + (Control.Monad m) => (a -> Maybe b) -> Stream (Of a) m r %1 -> Stream (Of b) m r @@ -631,7 +631,7 @@ -- only containing the 'Just' values. mapMaybeM :: forall a m b r. - Control.Monad m => + (Control.Monad m) => (a -> m (Maybe (Ur b))) -> Stream (Of a) m r %1 -> Stream (Of b) m r @@ -681,7 +681,7 @@ -- ahpla -- ateb -- @ -map :: Control.Monad m => (a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r +map :: (Control.Monad m) => (a -> b) -> Stream (Of a) m r %1 -> Stream (Of b) m r map f = maps (\(x :> rest) -> f x :> rest) {-# INLINEABLE map #-} @@ -733,14 +733,14 @@ -- -- See also 'chain' for a variant of this which ignores the return value of the function and just uses the side effects. mapM :: - Control.Monad m => + (Control.Monad m) => (a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r mapM f s = loop f s where loop :: - Control.Monad m => + (Control.Monad m) => (a -> m (Ur b)) -> Stream (Of a) m r %1 -> Stream (Of b) m r @@ -1053,7 +1053,7 @@ -- @ copy :: forall a m r. - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r copy = Effect . Control.return . loop @@ -1069,7 +1069,7 @@ -- | An alias for @copy@. duplicate :: forall a m r. - Control.Monad m => + (Control.Monad m) => Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r duplicate = copy @@ -1158,7 +1158,7 @@ -- goodbye -- @ store :: - Control.Monad m => + (Control.Monad m) => (Stream (Of a) (Stream (Of a) m) r %1 -> t) -> Stream (Of a) m r %1 -> t @@ -1214,7 +1214,7 @@ -- > sequence :: Control.Monad m => Stream (Of (m a)) m r %1-> Stream (Of a) m r sequence :: forall a m r. - Control.Monad m => + (Control.Monad m) => Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r sequence = loop @@ -1254,7 +1254,7 @@ False -> Step (a :> loop (Set.insert (f a) set) as) -- | More efficient versions of above when working with 'Int's that use 'Data.IntSet.IntSet'. -nubInt :: Control.Monad m => Stream (Of Int) m r %1 -> Stream (Of Int) m r +nubInt :: (Control.Monad m) => Stream (Of Int) m r %1 -> Stream (Of Int) m r nubInt = nubIntOn id {-# INLINE nubInt #-} @@ -1278,7 +1278,7 @@ -- | Skip elements of a stream that fail a predicate filter :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m r @@ -1297,7 +1297,7 @@ -- | Skip elements of a stream that fail a monadic test filterM :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> m Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m r @@ -1327,7 +1327,7 @@ -- @ intersperse :: forall a m r. - Control.Monad m => + (Control.Monad m) => a -> Stream (Of a) m r %1 -> Stream (Of a) m r @@ -1399,7 +1399,7 @@ -- @ dropWhile :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> Stream (Of a) m r %1 -> Stream (Of a) m r @@ -1438,7 +1438,7 @@ -- @ scan :: forall a x b m r. - Control.Monad m => + (Control.Monad m) => (x -> a -> x) -> x -> (x -> b) -> @@ -1476,7 +1476,7 @@ -- @ scanM :: forall a x b m r. - Control.Monad m => + (Control.Monad m) => (x %1 -> a -> m (Ur x)) -> m (Ur x) -> (x %1 -> m (Ur b)) -> @@ -1515,7 +1515,7 @@ -- @ scanned :: forall a x b m r. - Control.Monad m => + (Control.Monad m) => (x -> a -> x) -> x -> (x -> b) -> @@ -1587,7 +1587,7 @@ -- > Lazy.foldrChunks S.cons (return ()) :: Lazy.ByteString -> Stream (Of Strict.ByteString) m () -- -- and so on. -cons :: Control.Monad m => a -> Stream (Of a) m r %1 -> Stream (Of a) m r +cons :: (Control.Monad m) => a -> Stream (Of a) m r %1 -> Stream (Of a) m r cons a str = Step (a :> str) {-# INLINE cons #-} @@ -1629,7 +1629,7 @@ -- @ slidingWindow :: forall a b m. - Control.Monad m => + (Control.Monad m) => Int -> Stream (Of a) m b %1 -> Stream (Of (Seq.Seq a)) m b diff --git a/src/Streaming/Linear/Internal/Produce.hs b/src/Streaming/Linear/Internal/Produce.hs --- a/src/Streaming/Linear/Internal/Produce.hs +++ b/src/Streaming/Linear/Internal/Produce.hs @@ -86,7 +86,7 @@ -- \>\>\> S.sum $ do {yield 1; yield 2; yield 3} -- 6 :> () -- @ -yield :: Control.Monad m => a -> Stream (Of a) m () +yield :: (Control.Monad m) => a -> Stream (Of a) m () yield x = Step $ x :> Return () {-# INLINE yield #-} @@ -98,21 +98,21 @@ -- 2 -- 3 -- @ -each' :: Control.Monad m => [a] -> Stream (Of a) m () +each' :: (Control.Monad m) => [a] -> Stream (Of a) m () each' xs = Prelude.foldr (\a stream -> Step $ a :> stream) (Return ()) xs {-# INLINEABLE each' #-} -- | Build a @Stream@ by unfolding steps starting from a seed. In particular note -- that @S.unfoldr S.next = id@. unfoldr :: - Control.Monad m => + (Control.Monad m) => (s %1 -> m (Either r (Ur a, s))) -> s %1 -> Stream (Of a) m r unfoldr step s = unfoldr' step s where unfoldr' :: - Control.Monad m => + (Control.Monad m) => (s %1 -> m (Either r (Ur a, s))) -> s %1 -> Stream (Of a) m r @@ -154,7 +154,7 @@ | n < 0 = Prelude.error "Cannot replicate a stream of negative length" | otherwise = loop n a where - loop :: Control.Monad m => Int -> a -> Stream (Of a) m () + loop :: (Control.Monad m) => Int -> a -> Stream (Of a) m () loop n a | n == 0 = Return () | otherwise = Effect $ Control.return $ Step $ a :> loop (n - 1) a @@ -171,7 +171,7 @@ -- 2015-08-18 00:57:36.124785 UTC -- @ replicateM :: - Control.Monad m => + (Control.Monad m) => Int -> m (Ur a) -> Stream (Of a) m () @@ -179,7 +179,7 @@ | n < 0 = Prelude.error "Cannot replicate a stream of negative length" | otherwise = loop n ma where - loop :: Control.Monad m => Int -> m (Ur a) -> Stream (Of a) m () + loop :: (Control.Monad m) => Int -> m (Ur a) -> Stream (Of a) m () loop n ma | n == 0 = Return () | otherwise = Effect $ Control.do @@ -189,7 +189,7 @@ -- | Replicate a constant element and zip it with the finite stream which -- is the first argument. replicateZip :: - Control.Monad m => + (Control.Monad m) => Stream (Of x) m r -> a -> Stream (Of (a, x)) m r @@ -198,7 +198,7 @@ untilRight :: forall m a r. - Control.Monad m => + (Control.Monad m) => m (Either (Ur a) r) -> Stream (Of a) m r untilRight mEither = Effect loop @@ -261,7 +261,7 @@ -- Drop the element it succeeds on. untilM :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> m Bool) -> AffineStream (Of a) m r %1 -> Stream (Of a) m r @@ -285,7 +285,7 @@ -- | Like 'untilM' but without the monadic test. until :: forall a m r. - Control.Monad m => + (Control.Monad m) => (a -> Bool) -> AffineStream (Of a) m r %1 -> Stream (Of a) m r @@ -307,7 +307,7 @@ -- | Zip a finite stream with an affine stream. zip :: forall a x m r1 r2. - Control.Monad m => + (Control.Monad m) => Stream (Of x) m r1 %1 -> AffineStream (Of a) m r2 %1 -> Stream (Of (x, a)) m (r1, r2) @@ -348,10 +348,10 @@ Control.return $ Left (Text.pack line :> ()) -- | An affine stream of reading lines, crashing on failed parse. -readLn :: Read a => AffineStream (Of a) IO () +readLn :: (Read a) => AffineStream (Of a) IO () readLn = AffineStream () readALine Control.pure where - readALine :: Read a => () %1 -> IO (Either (Of a ()) ()) + readALine :: (Read a) => () %1 -> IO (Either (Of a ()) ()) readALine () = Control.do Ur line <- fromSystemIOU System.getLine Control.return $ Left (Prelude.read line :> ()) @@ -359,7 +359,7 @@ -- | An affine stream iterating an initial state forever. iterate :: forall a m. - Control.Monad m => + (Control.Monad m) => a -> (a -> a) -> AffineStream (Of a) m () @@ -375,7 +375,7 @@ -- | An affine stream monadically iterating an initial state forever. iterateM :: forall a m. - Control.Monad m => + (Control.Monad m) => m (Ur a) -> (a -> m (Ur a)) -> AffineStream (Of a) m () @@ -406,7 +406,7 @@ leftoverEffects (Ur _, str) = effects str stepStream :: - Control.Functor f => + (Control.Functor f) => (Ur (Stream f m r), Stream f m r) %1 -> m (Either (f (Ur (Stream f m r), Stream f m r)) r) stepStream (Ur s, str) = @@ -467,30 +467,30 @@ stdinLnZip stream = Control.fmap (\(r, ()) -> r) $ zip stream stdinLn {-# INLINE stdinLnZip #-} -readLnN :: Read a => Int -> Stream (Of a) IO () +readLnN :: (Read a) => Int -> Stream (Of a) IO () readLnN n = take n readLn {-# INLINE readLnN #-} -readLnUntilM :: Read a => (a -> IO Bool) -> Stream (Of a) IO () +readLnUntilM :: (Read a) => (a -> IO Bool) -> Stream (Of a) IO () readLnUntilM test = untilM test readLn {-# INLINE readLnUntilM #-} -readLnUntil :: Read a => (a -> Bool) -> Stream (Of a) IO () +readLnUntil :: (Read a) => (a -> Bool) -> Stream (Of a) IO () readLnUntil test = until test readLn {-# INLINE readLnUntil #-} -readLnZip :: Read a => Stream (Of x) IO r %1 -> Stream (Of (x, a)) IO r +readLnZip :: (Read a) => Stream (Of x) IO r %1 -> Stream (Of (x, a)) IO r readLnZip stream = Control.fmap (\(r, ()) -> r) $ zip stream readLn {-# INLINE readLnZip #-} -- | Iterate a pure function from a seed value, -- streaming the results forever. -iterateN :: Control.Monad m => Int -> (a -> a) -> a -> Stream (Of a) m () +iterateN :: (Control.Monad m) => Int -> (a -> a) -> a -> Stream (Of a) m () iterateN n step a = take n $ iterate a step {-# INLINE iterateN #-} iterateZip :: - Control.Monad m => + (Control.Monad m) => Stream (Of x) m r -> (a -> a) -> a -> @@ -502,7 +502,7 @@ -- | Iterate a monadic function from a seed value, -- streaming the results forever. iterateMN :: - Control.Monad m => + (Control.Monad m) => Int -> (a -> m (Ur a)) -> m (Ur a) -> @@ -511,7 +511,7 @@ {-# INLINE iterateMN #-} iterateMZip :: - Control.Monad m => + (Control.Monad m) => Stream (Of x) m r %1 -> (a -> m (Ur a)) -> m (Ur a) -> diff --git a/src/Streaming/Linear/Internal/Type.hs b/src/Streaming/Linear/Internal/Type.hs --- a/src/Streaming/Linear/Internal/Type.hs +++ b/src/Streaming/Linear/Internal/Type.hs @@ -167,7 +167,7 @@ -- # MonadTrans for (Stream f m) ------------------------------------------------------------------------------- -instance Control.Functor f => Control.MonadTrans (Stream f) where +instance (Control.Functor f) => Control.MonadTrans (Stream f) where lift :: (Control.Functor m, Control.Functor f) => m a %1 -> Stream f m a lift = Effect . Control.fmap Control.return {-# INLINE lift #-} diff --git a/src/System/IO/Linear.hs b/src/System/IO/Linear.hs --- a/src/System/IO/Linear.hs +++ b/src/System/IO/Linear.hs @@ -61,6 +61,7 @@ import Data.IORef (IORef) import qualified Data.IORef as System import GHC.Exts (RealWorld, State#) +import qualified GHC.IO as System (IO (..)) import Prelude.Linear hiding (IO) import qualified System.IO as System import qualified Unsafe.Linear as Unsafe @@ -110,7 +111,7 @@ -- | Convert a linear IO action to a "System.IO" action. toSystemIO :: IO a %1 -> System.IO a -toSystemIO = Unsafe.coerce -- basically just subtyping +toSystemIO (IO f) = System.IO (\s -> f s) -- | Use at the top of @main@ function in your program to switch to the -- linearly typed version of 'IO': @@ -156,10 +157,10 @@ cont :: (# State# RealWorld, () #) %1 -> IO b %1 -> (# State# RealWorld, b #) cont (# s', () #) y' = unIO y' s' -instance Semigroup a => Semigroup (IO a) where +instance (Semigroup a) => Semigroup (IO a) where (<>) = Control.liftA2 (<>) -instance Monoid a => Monoid (IO a) where +instance (Monoid a) => Monoid (IO a) where mempty = Control.pure mempty -- $ioref @@ -186,11 +187,11 @@ -- See [here](http://dev.stephendiehl.com/hask/index.html#control.exception) -- to learn about exceptions. -throwIO :: Exception e => e -> IO a +throwIO :: (Exception e) => e -> IO a throwIO e = fromSystemIO $ System.throwIO e catch :: - Exception e => + (Exception e) => IO (Ur a) -> (e -> IO (Ur a)) -> IO (Ur a) diff --git a/src/System/IO/Resource/Linear/Internal.hs b/src/System/IO/Resource/Linear/Internal.hs --- a/src/System/IO/Resource/Linear/Internal.hs +++ b/src/System/IO/Resource/Linear/Internal.hs @@ -83,7 +83,7 @@ Linear.withLinearIO (moveLinearIO finalizer) `finally` safeRelease fs -- Should be just an application of a linear `(<$>)`. - moveLinearIO :: Movable a => Linear.IO a %1 -> Linear.IO (Ur a) + moveLinearIO :: (Movable a) => Linear.IO a %1 -> Linear.IO (Ur a) moveLinearIO action' = Control.do result <- action' Control.return $ move result diff --git a/src/Unsafe/Linear.hs b/src/Unsafe/Linear.hs --- a/src/Unsafe/Linear.hs +++ b/src/Unsafe/Linear.hs @@ -116,7 +116,7 @@ -- :: (a %m-> b -> c %1-> d) %1-> (a %1-> b %1-> c %x-> d) -- 'toLinear3' = toLinearN \@3 -- @ -toLinearN :: forall n f g. ToLinearN n f g => f %1 -> g +toLinearN :: forall n f g. (ToLinearN n f g) => f %1 -> g -- See Note: Core size toLinearN f = case unsafeLinearityProofN @n @f @g of UnsafeRefl -> f @@ -168,7 +168,7 @@ class ToLinearN' arrs f g where prf :: UnsafeEquality f g -instance a ~ b => ToLinearN' 'Z (a :: TYPE rep) (b :: TYPE rep) where +instance (a ~ b) => ToLinearN' 'Z (a :: TYPE rep) (b :: TYPE rep) where prf = UnsafeRefl -- We use heterogeneous equality here to shift @rep ~ 'LiftedRep@ to the left diff --git a/test/Test/Data/Mutable/Array.hs b/test/Test/Data/Mutable/Array.hs --- a/test/Test/Data/Mutable/Array.hs +++ b/test/Test/Data/Mutable/Array.hs @@ -90,7 +90,7 @@ compInts (Ur x) (Ur y) = Ur (x === y) -- XXX: This is a terrible name -getFst :: Consumable b => (a, b) %1 -> a +getFst :: (Consumable b) => (a, b) %1 -> a getFst (a, b) = lseq b a -- # Tests diff --git a/test/Test/Data/Mutable/HashMap.hs b/test/Test/Data/Mutable/HashMap.hs --- a/test/Test/Data/Mutable/HashMap.hs +++ b/test/Test/Data/Mutable/HashMap.hs @@ -141,7 +141,7 @@ getFst (a, b) = lseq b a compareMaybes :: - Eq a => + (Eq a) => Ur (Maybe a) %1 -> Ur (Maybe a) %1 -> Ur Bool diff --git a/test/Test/Data/Mutable/Set.hs b/test/Test/Data/Mutable/Set.hs --- a/test/Test/Data/Mutable/Set.hs +++ b/test/Test/Data/Mutable/Set.hs @@ -127,7 +127,7 @@ testEqual (Ur x) (Ur y) = Ur (x === y) -- XXX: This is a terrible name -getFst :: Consumable b => (a, b) %1 -> a +getFst :: (Consumable b) => (a, b) %1 -> a getFst (a, b) = lseq b a -- # Tests diff --git a/test/Test/Data/Mutable/Vector.hs b/test/Test/Data/Mutable/Vector.hs --- a/test/Test/Data/Mutable/Vector.hs +++ b/test/Test/Data/Mutable/Vector.hs @@ -105,10 +105,10 @@ compInts (Ur x) (Ur y) = Ur (x === y) -- XXX: This is a terrible name -getFst :: Consumable b => (a, b) %1 -> a +getFst :: (Consumable b) => (a, b) %1 -> a getFst (a, b) = lseq b a -getSnd :: Consumable a => (a, b) %1 -> b +getSnd :: (Consumable a) => (a, b) %1 -> b getSnd (a, b) = lseq a b -- # Tests