linear-base 0.2.0 → 0.3.0

raw patch · 40 files changed

+436/−220 lines, 40 filesdep ~tasty-hedgehognew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: tasty-hedgehog

API changes (from Hackage documentation)

Files

• CHANGELOG.md +27/−0
• bench/Data/Mutable/HashMap.hs +2/−1
• examples/Generic/Traverse.hs +15/−11
• examples/Test/Foreign.hs +8/−7
• examples/Test/Quicksort.hs +4/−2
• ghc92/Prelude/Linear/Internal/Generically.hs +26/−0
• ghc92/Prelude/Linear/Internal/TypeEq.hs +8/−0
• ghc94/Prelude/Linear/Internal/Generically.hs +10/−0
• ghc94/Prelude/Linear/Internal/TypeEq.hs +16/−0
• linear-base.cabal +9/−2
• src/Control/Functor/Linear.hs +2/−0
• src/Control/Functor/Linear/Internal/Class.hs +2/−2
• src/Control/Functor/Linear/Internal/Kan.hs +1/−0
• src/Control/Functor/Linear/Internal/State.hs +13/−0
• src/Data/Array/Mutable/Linear/Internal.hs +1/−1
• src/Data/Functor/Linear/Internal/Applicative.hs +9/−6
• src/Data/Monoid/Linear/Internal/Monoid.hs +1/−1
• src/Data/Ord/Linear/Internal/Eq.hs +18/−0
• src/Data/Ord/Linear/Internal/Ord.hs +18/−0
• src/Data/Replicator/Linear.hs +8/−8
• src/Data/Tuple/Linear.hs +3/−3
• src/Data/Unrestricted/Linear.hs +2/−2
• src/Data/Unrestricted/Linear/Internal/Consumable.hs +0/−1
• src/Data/Unrestricted/Linear/Internal/Dupable.hs +0/−1
• src/Data/V/Linear/Internal.hs +2/−1
• src/Data/V/Linear/Internal/Instances.hs +5/−0
• src/Foreign/Marshal/Pure/Internal.hs +1/−0
• src/Prelude/Linear.hs +5/−0
• src/Prelude/Linear/Generically.hs +3/−16
• src/Prelude/Linear/Internal.hs +10/−1
• src/Streaming/Linear/Internal/Many.hs +3/−3
• src/Streaming/Linear/Internal/Produce.hs +8/−4
• src/System/IO/Resource/Linear.hs +10/−2
• src/System/IO/Resource/Linear/Internal.hs +77/−45
• test/Test/Data/Destination.hs +6/−5
• test/Test/Data/Mutable/Array.hs +21/−20
• test/Test/Data/Mutable/HashMap.hs +22/−20
• test/Test/Data/Mutable/Set.hs +16/−14
• test/Test/Data/Mutable/Vector.hs +33/−31
• test/Test/Data/Polarized.hs +11/−10

@@ -1,5 +1,32 @@ # Change Log +## [v0.3.0](https://github.com/tweag/linear-base/tree/v0.3.0) (2022-10-26)++[Full Changelog](https://github.com/tweag/linear-base/compare/v0.2.0...v0.3.0)++### Headline changes++- Support GHC 9.4 in addition to GHC 9.2 and GHC 9.0 (GHC 9.0 is no longer tested though) [\#427](https://github.com/tweag/linear-base/pull/427) ([matthew-healy](https://github.com/matthew-healy))+  - Update `shell.nix` to enable building with GHC 9.4.1 [\#429](https://github.com/tweag/linear-base/pull/429) ([matthew-healy](https://github.com/matthew-healy))+- Improvement of the resource-aware `IO` (`RIO`) monad's interface+  - Add some `Handle` operations to `RIO` [\#425](https://github.com/tweag/linear-base/pull/425) ([endgame](https://github.com/endgame))+  - The `Handle` type is now transparent, to make extensions of the API possible [\#428](https://github.com/tweag/linear-base/pull/428) ([aspiwack](https://github.com/aspiwack))++### Miscellaneous++- `Monoid (Maybe a)` requires only `Semigroup a`, not `Monoid a` [\#409](https://github.com/tweag/linear-base/pull/409) ([treeowl](https://github.com/treeowl))+- Add `evalState(T)` [\#411](https://github.com/tweag/linear-base/pull/411) ([andreasabel](https://github.com/andreasabel))+- Add `Movable` instances for several primitive types, as well as (non-linear) `Applicative`, `Foldable`, `Traversable` instances for `V`. [\#416](https://github.com/tweag/linear-base/pull/416) ([sellout](https://github.com/sellout))+- Fix typo in comment: resrouce -\> resource [\#421](https://github.com/tweag/linear-base/pull/421) ([undergroundquizscene](https://github.com/undergroundquizscene))+- Fix haddock hyperlink reference \(minor typo\) [\#420](https://github.com/tweag/linear-base/pull/420) ([undergroundquizscene](https://github.com/undergroundquizscene))+- Fix haddock links in `Data.Replicator.Linear` [\#423](https://github.com/tweag/linear-base/pull/423) ([undergroundquizscene](https://github.com/undergroundquizscene))+- Add `CONTRIBUTING.md` [\#426](https://github.com/tweag/linear-base/pull/426) ([tbagrel1](https://github.com/tbagrel1))++### Internal++- Upgrade GHC to 9.2 [\#414](https://github.com/tweag/linear-base/pull/414) ([aspiwack](https://github.com/aspiwack))+  - Don't use deprecated `testProperty` from tasty-hedgehog [\#415](https://github.com/tweag/linear-base/pull/415) ([aspiwack](https://github.com/aspiwack))+ ## [v0.2.0](https://github.com/tweag/linear-base/tree/v0.2.0) - 2022-03-25  [Full Changelog](https://github.com/tweag/linear-base/compare/v0.1.0...v0.2.0)

@@ -1,6 +1,7 @@ {-# LANGUAGE BangPatterns #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE LinearTypes #-}@@ -39,7 +40,7 @@  deriving instance Generic Key -deriving instance NFData Key+deriving anyclass instance NFData Key  instance Hashable Key where   hash (Key x) =

@@ -3,6 +3,7 @@ {-# LANGUAGE DerivingVia #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE LinearTypes #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE StandaloneDeriving #-} {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TypeApplications #-}@@ -17,7 +18,7 @@ import Hedgehog import Prelude.Linear import Test.Tasty-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude  data Pair a = MkPair a a@@ -31,18 +32,21 @@ instance Data.Traversable Pair where   traverse = genericTraverse -pairTest :: TestTree-pairTest =-  testProperty "traverse via genericTraverse with WithLog and Pair" $-    property $-      ( Data.traverse-          (\x -> (Sum (1 :: Int), 2 * x))-          (MkPair 3 4 :: Pair Int)-      )-        === (Sum 2, (MkPair 6 8))- genericTraverseTests :: TestTree genericTraverseTests =   testGroup     "genericTraverse examples"     [pairTest]++pairTest :: TestTree+pairTest =+  testPropertyNamed "traverse via genericTraverse with WithLog and Pair" "propertyPairTest" propertyPairTest++propertyPairTest :: Property+propertyPairTest =+  property $+    ( Data.traverse+        (\x -> (Sum (1 :: Int), 2 * x))+        (MkPair 3 4 :: Pair Int)+    )+      === (Sum 2, (MkPair 6 8))

@@ -1,4 +1,5 @@ {-# LANGUAGE LinearTypes #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}@@ -18,7 +19,7 @@ import qualified Hedgehog.Range as Range import Prelude.Linear import Test.Tasty-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude  -- # Organizing tests@@ -36,16 +37,16 @@ listExampleTests =   testGroup     "list tests"-    [ testProperty "List.toList . List.fromList = id" invertNonGCList,-      testProperty "map id = id" mapIdNonGCList,-      testProperty "memory freed post-exception" testExecptionOnMem+    [ testPropertyNamed "List.toList . List.fromList = id" "invertNonGCList" invertNonGCList,+      testPropertyNamed "map id = id" "mapIdNonGCList" mapIdNonGCList,+      testPropertyNamed "memory freed post-exception" "testExceptionOnMem" testExceptionOnMem     ]  heapExampleTests :: TestTree heapExampleTests =   testGroup     "heap tests"-    [testProperty "sort = heapsort" nonGCHeapSort]+    [testPropertyNamed "sort = heapsort" "nonGCHeapSort" nonGCHeapSort]  -- # Internal library -------------------------------------------------------------------------------@@ -86,8 +87,8 @@             eqList (List.ofList xs p0) (List.map id (List.ofList xs p1) p2)   assert boolTest -testExecptionOnMem :: Property-testExecptionOnMem = property $ do+testExceptionOnMem :: Property+testExceptionOnMem = property $ do   xs <- forAll list   let bs = xs ++ (throw InjectedError)   let writeBadList = Manual.withPool (move . List.toList . List.ofRList bs)

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ module Test.Quicksort (quickSortTests) where  import Data.List (sort)@@ -6,10 +8,10 @@ import qualified Hedgehog.Range as Range import Simple.Quicksort (quickSort) import Test.Tasty-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed)  quickSortTests :: TestTree-quickSortTests = testProperty "quicksort sorts" testQuicksort+quickSortTests = testPropertyNamed "quicksort sorts" "testQuicksort" testQuicksort  testQuicksort :: Property testQuicksort = property $ do

@@ -0,0 +1,26 @@+-- | Prior to GHC 9.4, linear-base defined its own versions of @Generically@ and+-- @Generically1@. As a temporary workaround to enable compilation on both GHC+-- 9.4 and 9.2, this module exposes linear-base's own implementations of those+-- types, while the 9.4 version simply re-exports @Generics.Linear@.+module Prelude.Linear.Internal.Generically+  ( Generically (..),+    Generically1 (..),+    module Generics.Linear,+  )+where++import Generics.Linear++-- | A datatype whose instances are defined generically, using the+-- 'Generics.Linear.Generic' representation.+-- Generic instances can be derived via @'Generically' A@ using+-- @-XDerivingVia@.+newtype Generically a = Generically a++-- | A type whose instances are defined generically, using the+-- 'Generics.Linear.Generic1' representation. 'Generically1' is a higher-kinded+-- version of 'Generically'.+--+-- Generic instances can be derived for type constructors via+-- @'Generically1' F@ using @-XDerivingVia@.+newtype Generically1 f a = Generically1 (f a)

@@ -0,0 +1,8 @@+-- | As of GHC 9.4, @~@ is a type operator exported from `Data.Type.Equality`+-- rather than a language construct. As a temporary workaround to enable+-- compilation on both GHC 9.4 and 9.2, this module is empty, while the GHC+-- 9.4 version re-exports the new type  operator. As a result, files which+-- depend on this module will likely have -Wno-unused-imports enabled (and+-- potentially also -Wno-dodgy exports if they re-export it). These should be+-- removed once support for GHC 9.2 is dropped.+module Prelude.Linear.Internal.TypeEq where

@@ -0,0 +1,10 @@+-- | Prior to GHC 9.4, linear-base defined its own versions of `Generically` and+-- `Generically1`. As a temporary workaround to enable compilation on both+-- GHC 9.4 and 9.2, this module simply re-exports Generics.Linear, while the+-- 9.2 version exposes linear-base's own implementations.+module Prelude.Linear.Internal.Generically+  ( module Generics.Linear,+  )+where++import Generics.Linear

@@ -0,0 +1,16 @@+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE NoImplicitPrelude #-}++-- | As of GHC 9.4, @~@ is a type operator exported from `Data.Type.Equality`+-- rather than a language construct. As a temporary workaround to enable+-- compilation on both GHC 9.4 and 9.2, this module re-exports the new type+-- operator, while the 9.2 version is empty. As a result, files which depend+-- on this module will likely have -Wno-unused-imports enabled (and potentially+-- also -Wno-dodgy exports if they re-export it). These should be removed once+-- support for GHC 9.2 is dropped.+module Prelude.Linear.Internal.TypeEq+  ( type (~),+  )+where++import Data.Type.Equality (type (~))

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               linear-base-version:            0.2.0+version:            0.3.0 license:            MIT license-file:       LICENSE copyright:          (c) Tweag Holding and affiliates@@ -102,6 +102,8 @@         Prelude.Linear.Generically         Prelude.Linear.GenericUtil         Prelude.Linear.Internal+        Prelude.Linear.Internal.Generically+        Prelude.Linear.Internal.TypeEq         Prelude.Linear.Unsatisfiable         Streaming.Linear         Streaming.Linear.Internal.Consume@@ -117,6 +119,11 @@         Unsafe.Linear      hs-source-dirs:   src+    if impl(ghc >= 9.4.0)+        hs-source-dirs: ghc94+    else+        hs-source-dirs: ghc92+     default-language: Haskell2010     build-depends: @@ -156,7 +163,7 @@         containers,         hedgehog,         tasty,-        tasty-hedgehog,+        tasty-hedgehog >= 1.2,         mmorph,         vector 

@@ -48,11 +48,13 @@     State,     state,     runState,+    evalState,     execState,     mapState,     withState,     StateT (..),     runStateT,+    evalStateT,     execStateT,     mapStateT,     withStateT,

@@ -241,12 +241,12 @@       go b1 (b2, y) = (b1 <> b2, y)  deriving via-  Generically1 (Sum f g)+  Generically1 (Sum (f :: Type -> Type) g)   instance     (Functor f, Functor g) => Functor (Sum f g)  deriving via-  Generically1 (Compose f g)+  Generically1 (Compose (f :: Type -> Type) (g :: Type -> Type))   instance     (Functor f, Functor g) => Functor (Compose f g) 

@@ -1,6 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE LinearTypes #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_HADDOCK hide #-} 

@@ -21,6 +21,8 @@     runState,     mapStateT,     mapState,+    evalStateT,+    evalState,     execStateT,     execState,     withStateT,@@ -36,6 +38,7 @@ import Data.Functor.Identity import qualified Data.Functor.Linear.Internal.Applicative as Data import qualified Data.Functor.Linear.Internal.Functor as Data+import qualified Data.Tuple.Linear as Linear import Data.Unrestricted.Linear.Internal.Consumable import Data.Unrestricted.Linear.Internal.Dupable import Prelude.Linear.Internal@@ -80,6 +83,11 @@ execStateT :: Functor m => StateT s m () %1 -> s %1 -> m s execStateT f = fmap (\((), s) -> s) . (runStateT f) +-- | Use with care!+--   This consumes the final state, so might be costly at runtime.+evalStateT :: (Functor m, Consumable s) => StateT s m a %1 -> s %1 -> m a+evalStateT f = fmap Linear.fst . runStateT f+ mapState :: ((a, s) %1 -> (b, s)) %1 -> State s a %1 -> State s b mapState f = mapStateT (Identity . f . runIdentity') @@ -88,6 +96,11 @@  execState :: State s () %1 -> s %1 -> s execState f = runIdentity' . execStateT f++-- | 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 f = runIdentity' . evalStateT f  modify :: Applicative m => (s %1 -> s) %1 -> StateT s m () modify f = state $ \s -> ((), f s)

@@ -120,7 +120,7 @@ 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+-- | Same as 'set', but does not do bounds-checking. The behaviour is undefined -- if an out-of-bounds index is provided. unsafeSet :: Int -> a -> Array a %1 -> Array a unsafeSet ix val (Array arr) =

@@ -32,7 +32,7 @@ import Data.Monoid.Linear hiding (Product) import Data.Unrestricted.Linear.Internal.Ur (Ur (..)) import GHC.TypeLits-import Generics.Linear+import GHC.Types import Prelude.Linear.Generically import Prelude.Linear.Internal import Prelude.Linear.Unsatisfiable@@ -96,12 +96,12 @@     Monoid a => Applicative ((,) a)  deriving via-  Generically1 (Product f g)+  Generically1 (Product (f :: Type -> Type) g)   instance     (Applicative f, Applicative g) => Applicative (Product f g)  deriving via-  Generically1 (f :*: g)+  Generically1 ((f :: Type -> Type) :*: g)   instance     (Applicative f, Applicative g) => Applicative (f :*: g) @@ -168,7 +168,8 @@  instance   Unsatisfiable-    ( 'Text "Cannot derive a data Applicative instance for" ':$$: s+    ( 'Text "Cannot derive a data Applicative instance for"+        ':$$: s         ':$$: 'Text "because empty types cannot implement pure."     ) =>   GApplicative s V1@@ -208,7 +209,8 @@  instance   Unsatisfiable-    ( 'Text "Cannot derive a data Applicative instance for" ':$$: s+    ( 'Text "Cannot derive a data Applicative instance for"+        ':$$: s         ':$$: 'Text "because sum types do not admit a uniform Applicative definition."     ) =>   GApplicative s (x :+: y)@@ -230,7 +232,8 @@  instance   Unsatisfiable-    ( 'Text "Cannot derive a data Applicative instance for" ':$$: s+    ( '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."     ) =>

@@ -106,7 +106,7 @@ -- See System.IO.Linear for instance ... => Monoid (IO a) -- See System.IO.Resource.Internal for instance ... => Monoid (RIO a) -instance Monoid a => Monoid (Maybe a) where+instance Semigroup a => Monoid (Maybe a) where   mempty = Nothing  -- See Data.List.Linear for instance ... => Monoid [a]

@@ -12,7 +12,9 @@ where  import Data.Bool.Linear+import Data.Int (Int16, Int32, Int64, Int8) import Data.Unrestricted.Linear+import Data.Word (Word16, Word32, Word64, Word8) import Prelude.Linear.Internal import qualified Prelude @@ -81,6 +83,22 @@ deriving via MovableEq Prelude.Char instance Eq Prelude.Char  deriving via MovableEq Prelude.Ordering instance Eq Prelude.Ordering++deriving via MovableEq Int16 instance Eq Int16++deriving via MovableEq Int32 instance Eq Int32++deriving via MovableEq Int64 instance Eq Int64++deriving via MovableEq Int8 instance Eq Int8++deriving via MovableEq Word16 instance Eq Word16++deriving via MovableEq Word32 instance Eq Word32++deriving via MovableEq Word64 instance Eq Word64++deriving via MovableEq Word8 instance Eq Word8  newtype MovableEq a = MovableEq a 

@@ -14,10 +14,12 @@ where  import Data.Bool.Linear (Bool (..), not)+import Data.Int (Int16, Int32, Int64, Int8) import Data.Monoid.Linear import Data.Ord (Ordering (..)) import Data.Ord.Linear.Internal.Eq import Data.Unrestricted.Linear+import Data.Word (Word16, Word32, Word64, Word8) import Prelude.Linear.Internal import qualified Prelude @@ -140,6 +142,22 @@ deriving via MovableOrd Prelude.Char instance Ord Prelude.Char  deriving via MovableOrd Prelude.Ordering instance Ord Prelude.Ordering++deriving via MovableOrd Int16 instance Ord Int16++deriving via MovableOrd Int32 instance Ord Int32++deriving via MovableOrd Int64 instance Ord Int64++deriving via MovableOrd Int8 instance Ord Int8++deriving via MovableOrd Word16 instance Ord Word16++deriving via MovableOrd Word32 instance Ord Word32++deriving via MovableOrd Word64 instance Ord Word64++deriving via MovableOrd Word8 instance Ord Word8  newtype MovableOrd a = MovableOrd a 

@@ -2,8 +2,8 @@ {-# LANGUAGE NoImplicitPrelude #-}  -- | This module defines a stream-like type named 'Replicator', which is--- mainly used in the definition of the 'Data.Unrestricted.Dupable' class--- to provide efficient linear duplication.+-- mainly used in the definition of the 'Data.Unrestricted.Linear.Dupable'+-- class to provide efficient linear duplication. -- The API of 'Replicator' is close to the one of an infinite stream: it -- can either produce a new value linearly (with 'next' or 'next#'), or be -- linearly discarded (with 'consume' or 'extract').@@ -11,12 +11,12 @@ -- A crucial aspect, from a performance standpoint, is that the 'pure' function -- (which takes an unrestricted argument) is implemented efficiently: the -- 'Replicator' returns /the same/ value on each call to 'next'. That is, the--- pointer is always shared. This will allow 'Data.Unrestricted.Movable' types--- to be given an efficient instance of 'Data.Unrestricted.Dupable'. Instances--- of both 'Data.Unrestricted.Movable' and 'Data.Unrestricted.Dupable' typically--- involve deep copies. The implementation of 'pure' lets us make sure that, for--- @Movable@ types, only one deep copy is performed, rather than one per--- additional replica.+-- pointer is always shared. This will allow 'Data.Unrestricted.Linear.Movable'+-- types to be given an efficient instance of 'Data.Unrestricted.Linear.Dupable'.+-- Instances of both 'Data.Unrestricted.Linear.Movable' and+-- 'Data.Unrestricted.Linear.Dupable' typically involve deep copies. The+-- implementation of 'pure' lets us make sure that, for @Movable@ types, only one+-- deep copy is performed, rather than one per additional replica. -- -- Strictly speaking, the implementation of '(<*>)' plays a role in all this as -- well:

@@ -1,7 +1,7 @@ {-# LANGUAGE LinearTypes #-} {-# LANGUAGE NoImplicitPrelude #-} --- | This module provides linear functions commonly used on tuples+-- | This module provides linear functions commonly used on tuples. module Data.Tuple.Linear   ( fst,     snd,@@ -11,8 +11,8 @@   ) where -import Data.Unrestricted.Linear-import Prelude.Linear.Internal+import Data.Unrestricted.Linear.Internal.Consumable+import Prelude.Linear.Internal (curry, uncurry)  fst :: Consumable b => (a, b) %1 -> a fst (a, b) = lseq b a

@@ -22,8 +22,8 @@ -- If a type is 'Consumable', you can __consume__ it in a linear function that -- doesn't need that value to produce it's result: ----- > first :: Consumable b => (a,b) %1-> a--- > first (a,b) = withConsume (consume b) a+-- > fst :: Consumable b => (a,b) %1-> a+-- > fst (a,b) = withConsume (consume b) a -- >   where -- >     withConsume :: () %1-> a %1-> a -- >     withConsume () x = x

@@ -36,7 +36,6 @@ import Data.Void (Void) import GHC.Tuple (Solo) import GHC.Types (Multiplicity (..))-import Generics.Linear import Prelude.Linear.Generically import Prelude.Linear.Internal import qualified Unsafe.Linear as Unsafe

@@ -39,7 +39,6 @@ import Data.Unrestricted.Linear.Internal.Ur (Ur) import GHC.Tuple (Solo (..)) import GHC.Types (Multiplicity (..))-import Generics.Linear import Prelude.Linear.Generically import Prelude.Linear.Internal import qualified Unsafe.Linear as Unsafe

@@ -1,6 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveTraversable #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -56,7 +57,7 @@ -- | @'V' n a@ represents an immutable sequence of @n@ elements of type @a@ -- (like a n-tuple), with a linear 'Data.Functor.Linear.Applicative' instance. newtype V (n :: Nat) (a :: Type) = V (Vector a)-  deriving (Prelude.Eq, Prelude.Ord, Prelude.Functor)+  deriving (Prelude.Eq, Prelude.Ord, Prelude.Show, Prelude.Foldable, Prelude.Functor, Prelude.Traversable)  -- Using vector rather than, say, 'Array' (or directly 'Array#') because it -- offers many convenience function. Since all these unsafeCoerces probably

@@ -18,6 +18,7 @@ import GHC.TypeLits import Prelude.Linear.Internal import qualified Unsafe.Linear as Unsafe+import qualified Prelude  -- # Instances of V -------------------------------------------------------------------------------@@ -28,6 +29,10 @@ instance KnownNat n => Data.Applicative (V n) where   pure = V.pure   a <*> b = a V.<*> b++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   traverse f (V xs) =

@@ -13,6 +13,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-orphans #-} {-# OPTIONS_HADDOCK hide #-}

@@ -1,5 +1,8 @@ {-# LANGUAGE LinearTypes #-} {-# LANGUAGE NoImplicitPrelude #-}+-- TODO: Disabled while we still support GHC 9.2 to enable+-- the import of the empty TypeEq module there.+{-# OPTIONS_GHC -Wno-dodgy-exports -Wno-unused-imports #-}  -- | This module provides a replacement for 'Prelude' with -- support for linear programming via linear versions of@@ -30,6 +33,7 @@     Prelude.Char,     module Data.Maybe.Linear,     module Data.Either.Linear,+    module Prelude.Linear.Internal.TypeEq,      -- * Tuples     Prelude.fst,@@ -158,6 +162,7 @@ import Data.Tuple.Linear import Data.Unrestricted.Linear import Prelude.Linear.Internal+import Prelude.Linear.Internal.TypeEq import qualified Prelude  -- | Replacement for the flip function with generalized multiplicities.

@@ -2,29 +2,16 @@ {-# LANGUAGE NoImplicitPrelude #-}  module Prelude.Linear.Generically-  ( Generically (..),-    unGenerically,-    Generically1 (..),+  ( unGenerically,     unGenerically1,+    module Prelude.Linear.Internal.Generically,   ) where --- | A datatype whose instances are defined generically, using the--- 'Generics.Linear.Generic' representation.--- Generic instances can be derived via @'Generically' A@ using--- @-XDerivingVia@.-newtype Generically a = Generically a+import Prelude.Linear.Internal.Generically  unGenerically :: Generically a %1 -> a unGenerically (Generically a) = a---- | A type whose instances are defined generically, using the--- 'Generics.Linear.Generic1' representation. 'Generically1' is a higher-kinded--- version of 'Generically'.------ Generic instances can be derived for type constructors via--- @'Generically1' F@ using @-XDerivingVia@.-newtype Generically1 f a = Generically1 (f a)  unGenerically1 :: Generically1 f a %1 -> f a unGenerically1 (Generically1 fa) = fa

@@ -3,16 +3,25 @@ {-# LANGUAGE LinearTypes #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeOperators #-} {-# LANGUAGE NoImplicitPrelude #-}+-- TODO: Disabled while we still support GHC 9.2 to enable+-- the import of the empty TypeEq module there.+{-# OPTIONS_GHC -Wno-dodgy-exports -Wno-unused-imports #-} {-# OPTIONS_HADDOCK hide #-}  -- | This is a very very simple prelude, which doesn't depend on anything else -- in the linear-base library.-module Prelude.Linear.Internal where+module Prelude.Linear.Internal+  ( module Prelude.Linear.Internal,+    module Prelude.Linear.Internal.TypeEq,+  )+where  import Data.Coerce import Data.Functor.Identity import GHC.Exts (TYPE)+import Prelude.Linear.Internal.TypeEq  -- A note on implementation: to avoid silly mistakes, very easy functions are -- simply reimplemented here. For harder function, we reuse the Prelude

@@ -128,10 +128,10 @@ (2) If the streams are of different length, do we keep or throw out the remainder of the longer stream? -* We are assuming not to take infinite streams as input and instead deal with+\* We are assuming not to take infinite streams as input and instead deal with reasonably small finite streams.-* To avoid making choices for the user, we keep both end-of-stream payloads-* The default zips (ones without a prime in the name) use @effects@ to consume+\* To avoid making choices for the user, we keep both end-of-stream payloads+\* The default zips (ones without a prime in the name) use @effects@ to consume the remainder stream after zipping. We include zip function variants that return no remainder (for equal length streams), or the remainder of the longer stream.

@@ -277,7 +277,8 @@           testResult & \case             False ->               Control.return $-                Step $ a :> loop test (AffineStream next step end)+                Step $+                  a :> loop test (AffineStream next step end)             True -> Control.fmap Control.return $ end next {-# INLINEABLE untilM #-} @@ -320,7 +321,8 @@       stream & \case         Return r1 ->           Effect $-            Control.fmap (\r2 -> Control.return $ (r1, r2)) $ end s+            Control.fmap (\r2 -> Control.return $ (r1, r2)) $+              end s         Effect m ->           Effect $             Control.fmap (\str -> loop str (AffineStream s step end)) m@@ -367,7 +369,8 @@     stepper :: Ur a %1 -> m (Either (Of a (Ur a)) ())     stepper (Ur a) =       Control.return $-        Left $ a :> Ur (step a)+        Left $+          a :> Ur (step a)  -- | An affine stream monadically iterating an initial state forever. iterateM ::@@ -413,7 +416,8 @@           m Control.>>= (\stream -> stepStream (Ur s, stream))         Step f ->           Control.return $-            Left $ Control.fmap ((,) (Ur s)) f+            Left $+              Control.fmap ((,) (Ur s)) f  -- | An affine stream iterating an enumerated stream forever. enumFrom :: (Control.Monad m, Enum e) => e -> AffineStream (Of e) m ()

@@ -39,6 +39,7 @@      -- ** File I/O     openFile,+    openBinaryFile,     System.IOMode (..),      -- ** Working with Handles@@ -49,14 +50,21 @@     hGetLine,     hPutStr,     hPutStrLn,+    hSeek,+    System.SeekMode (..),+    hTell,      -- * Creating new types of resources     -- $new-resources-    UnsafeResource,-    unsafeRelease,+    Resource,+    release,     unsafeAcquire,     unsafeFromSystemIOResource,     unsafeFromSystemIOResource_,++    -- * Deprecated symbols+    UnsafeResource,+    unsafeRelease,   ) where 

@@ -6,6 +6,8 @@ {-# LANGUAGE LinearTypes #-} {-# LANGUAGE QualifiedDo #-} {-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-} {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# OPTIONS_HADDOCK hide #-} @@ -14,7 +16,6 @@ import Control.Exception (finally, mask, onException) import qualified Control.Functor.Linear as Control import qualified Control.Monad as Ur (fmap)-import Data.Coerce import qualified Data.Functor.Linear as Data import Data.IORef (IORef) import qualified Data.IORef as System@@ -23,7 +24,21 @@ import Data.Monoid (Ap (..)) import Data.Text (Text) import qualified Data.Text.IO as Text-import Prelude.Linear hiding (IO)+import Prelude.Linear+  ( Additive ((+)),+    Bool (..),+    Char,+    FilePath,+    Int,+    Integer,+    Monoid,+    Movable (..),+    Semigroup,+    Ur (..),+    fst,+    snd,+    ($),+  ) import qualified System.IO as System import qualified System.IO.Linear as Linear import qualified Prelude@@ -98,74 +113,86 @@  -- files --- Remark: Handle needs to be private otherwise `Data.Coerce.coerce` could wreak--- Havoc on the abstraction. But we could provide a smart constructor/view to--- unsafely convert to file handles in order for the Handle API to be--- extensible.--newtype Handle = Handle (UnsafeResource System.Handle)+type Handle = Resource System.Handle --- | See 'System.IO.openFile'+-- | See @System.IO.'System.IO.openFile'@ openFile :: FilePath -> System.IOMode -> RIO Handle-openFile path mode = Control.do-  h <--    unsafeAcquire-      (Linear.fromSystemIOU $ System.openFile path mode)-      (\h -> Linear.fromSystemIO $ System.hClose h)-  Control.return $ Handle h+openFile path mode =+  unsafeAcquire+    (Linear.fromSystemIOU $ System.openFile path mode)+    (\h -> Linear.fromSystemIO $ System.hClose h) +-- | See @System.IO.'System.IO.openBinaryFile'@+--+-- @since 0.3.0+openBinaryFile :: FilePath -> System.IOMode -> RIO Handle+openBinaryFile path mode =+  unsafeAcquire+    (Linear.fromSystemIOU $ System.openFile path mode)+    (\h -> Linear.fromSystemIO $ System.hClose h)++-- | Specialised alias for 'release' hClose :: Handle %1 -> RIO ()-hClose (Handle h) = unsafeRelease h+hClose = release  hIsEOF :: Handle %1 -> RIO (Ur Bool, Handle)-hIsEOF = coerce (unsafeFromSystemIOResource System.hIsEOF)+hIsEOF = unsafeFromSystemIOResource System.hIsEOF  hGetChar :: Handle %1 -> RIO (Ur Char, Handle)-hGetChar = coerce (unsafeFromSystemIOResource System.hGetChar)+hGetChar = unsafeFromSystemIOResource System.hGetChar  hPutChar :: Handle %1 -> Char -> RIO Handle-hPutChar h c = flipHPutChar c h -- needs a multiplicity polymorphic flip-  where-    flipHPutChar :: Char -> Handle %1 -> RIO Handle-    flipHPutChar c =-      coerce (unsafeFromSystemIOResource_ (\h' -> System.hPutChar h' c))+hPutChar h c = unsafeFromSystemIOResource_ (\h' -> System.hPutChar h' c) h  hGetLine :: Handle %1 -> RIO (Ur Text, Handle)-hGetLine = coerce (unsafeFromSystemIOResource Text.hGetLine)+hGetLine = unsafeFromSystemIOResource Text.hGetLine  hPutStr :: Handle %1 -> Text -> RIO Handle-hPutStr h s = flipHPutStr s h -- needs a multiplicity polymorphic flip-  where-    flipHPutStr :: Text -> Handle %1 -> RIO Handle-    flipHPutStr s =-      coerce (unsafeFromSystemIOResource_ (\h' -> Text.hPutStr h' s))+hPutStr h s = unsafeFromSystemIOResource_ (\h' -> Text.hPutStr h' s) h  hPutStrLn :: Handle %1 -> Text -> RIO Handle-hPutStrLn h s = flipHPutStrLn s h -- needs a multiplicity polymorphic flip-  where-    flipHPutStrLn :: Text -> Handle %1 -> RIO Handle-    flipHPutStrLn s =-      coerce (unsafeFromSystemIOResource_ (\h' -> Text.hPutStrLn h' s))+hPutStrLn h s = unsafeFromSystemIOResource_ (\h' -> Text.hPutStrLn h' s) h +-- | See @System.IO.'System.IO.hSeek'@.+--+-- @since 0.3.0+hSeek :: Handle %1 -> System.SeekMode -> Integer -> RIO Handle+hSeek h mode i = unsafeFromSystemIOResource_ (\h' -> System.hSeek h' mode i) h++-- | See @System.IO.'System.IO.hTell'@.+--+-- @since 0.3.0+hTell :: Handle %1 -> RIO (Ur Integer, Handle)+hTell = unsafeFromSystemIOResource System.hTell+ -- new-resources  -- | The type of system resources.  To create and use resources, you need to -- use the API since the constructor is not released.-data UnsafeResource a where-  UnsafeResource :: Int -> a -> UnsafeResource a+data Resource a where+  UnsafeResource :: Int -> a -> Resource a +-- | Deprecated alias for 'Resource'+type UnsafeResource = Resource++{-# DEPRECATED UnsafeResource "UnsafeResource has been renamed to Resource" #-}+ -- Note that both components are unrestricted. --- | Given an unsafe resource, release it with the linear IO action provided--- when the resrouce was acquired.-unsafeRelease :: UnsafeResource a %1 -> RIO ()-unsafeRelease (UnsafeResource key _) = RIO (\st -> Linear.mask_ (releaseWith key st))+-- | @'release' r@ calls the release function provided when @r@ was acquired.+release :: Resource a %1 -> RIO ()+release (UnsafeResource key _) = RIO (\st -> Linear.mask_ (releaseWith key st))   where     releaseWith key rrm = Control.do       Ur (ReleaseMap releaseMap) <- Linear.readIORef rrm       () <- releaseMap IntMap.! key       Linear.writeIORef rrm (ReleaseMap (IntMap.delete key releaseMap)) +-- | Deprecated alias of the 'release' function+unsafeRelease :: Resource a %1 -> RIO ()+unsafeRelease = release+{-# DEPRECATED unsafeRelease "unsafeRelease has been renamed to release" #-}+ -- | Given a resource in the "System.IO.Linear.IO" monad, and -- given a function to release that resource, provides that resource in -- the @RIO@ monad. For example, releasing a @Handle@ from "System.IO"@@ -174,7 +201,7 @@ unsafeAcquire ::   Linear.IO (Ur a) ->   (a -> Linear.IO ()) ->-  RIO (UnsafeResource a)+  RIO (Resource a) unsafeAcquire acquire release = RIO $ \rrm ->   Linear.mask_     ( Control.do@@ -197,13 +224,16 @@ -- | Given a "System.IO" computation on an unsafe resource, -- lift it to @RIO@ computaton on the acquired resource. -- That is function of type @a -> IO b@ turns into a function of type--- @UnsafeResource a %1-> RIO (Ur b)@--- along with threading the @UnsafeResource a@.+-- @Resource a %1-> RIO (Ur b)@+-- along with threading the @Resource a@. --+-- 'unsafeFromSystemIOResource' is only safe to use on actions which do not release+-- the resource.+-- -- Note that the result @b@ can be used non-linearly. unsafeFromSystemIOResource ::   (a -> System.IO b) ->-  (UnsafeResource a %1 -> RIO (Ur b, UnsafeResource a))+  (Resource a %1 -> RIO (Ur b, Resource a)) unsafeFromSystemIOResource action (UnsafeResource key resource) =   unsafeFromSystemIO     ( do@@ -211,9 +241,11 @@         Prelude.return (Ur c, UnsafeResource key resource)     ) +-- | Specialised variant of 'unsafeFromSystemIOResource' for actions that don't+-- return a value. unsafeFromSystemIOResource_ ::   (a -> System.IO ()) ->-  (UnsafeResource a %1 -> RIO (UnsafeResource a))+  (Resource a %1 -> RIO (Resource a)) unsafeFromSystemIOResource_ action resource = Control.do   (Ur _, resource) <- unsafeFromSystemIOResource action resource   Control.return resource

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}  module Test.Data.Destination (destArrayTests) where@@ -9,7 +10,7 @@ import qualified Hedgehog.Range as Range import Prelude.Linear import Test.Tasty-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude  -- # Tests and Utlities@@ -19,10 +20,10 @@ destArrayTests =   testGroup     "Destination array tests"-    [ testProperty "alloc . mirror = id" roundTrip,-      testProperty "alloc . replicate = V.replicate" replicateTest,-      testProperty "alloc . fill = V.singleton" fillTest,-      testProperty "alloc n . fromFunction (+s) = V.fromEnum n s" fromFuncEnum+    [ testPropertyNamed "alloc . mirror = id" "roundTrip" roundTrip,+      testPropertyNamed "alloc . replicate = V.replicate" "replicateTest" replicateTest,+      testPropertyNamed "alloc . fill = V.singleton" "fillTest" fillTest,+      testPropertyNamed "alloc n . fromFunction (+s) = V.fromEnum n s" "fromFuncEnum" fromFuncEnum     ]  list :: Gen [Int]

@@ -30,7 +30,7 @@ import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear hiding ((>)) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed)  -- # Exported Tests --------------------------------------------------------------------------------@@ -41,30 +41,31 @@ group :: [TestTree] group =   -- All tests for exprs of the form (read (const ...) i)-  [ testProperty "∀ s,i,x. read (alloc s x) i = x" readAlloc,-    testProperty "∀ a,s,x,i. read (snd (allocBeside s x a)) i = x" allocBeside,-    testProperty "∀ s,a,i. i < length a, read (resize s 42 a) i = read a i" readResize,-    testProperty "∀ a,i,x. read (write a i x) i = x " readWrite1,-    testProperty "∀ a,i,j/=i,x. read (write a j x) i = read a i" readWrite2,+  [ testPropertyNamed "∀ s,i,x. read (alloc s x) i = x" "readAlloc" readAlloc,+    testPropertyNamed "∀ a,s,x,i. read (snd (allocBeside s x a)) i = x" "allocBeside" allocBeside,+    testPropertyNamed "∀ s,a,i. i < length a, read (resize s 42 a) i = read a i" "readResize" readResize,+    testPropertyNamed "∀ a,i,x. read (write a i x) i = x " "readWrite1" readWrite1,+    testPropertyNamed "∀ a,i,j/=i,x. read (write a j x) i = read a i" "readWrite2" readWrite2,     -- All tests for exprs of the form (length (const ...))-    testProperty "∀ s,x. len (alloc s x) = s" lenAlloc,-    testProperty "∀ a,i,x. len (write a i x) = len a" lenWrite,-    testProperty "∀ a,s,x. len (resize s x a) = s" lenResizeSeed,+    testPropertyNamed "∀ s,x. len (alloc s x) = s" "lenAlloc" lenAlloc,+    testPropertyNamed "∀ a,i,x. len (write a i x) = len a" "lenWrite" lenWrite,+    testPropertyNamed "∀ a,s,x. len (resize s x a) = s" "lenResizeSeed" lenResizeSeed,     -- Tests against a reference implementation-    testProperty+    testPropertyNamed       "∀ a,ix. toList . write a ix = (\\l -> take ix l ++ [a] ++ drop (ix+1) l) . toList"+      "writeRef"       writeRef,-    testProperty "∀ ix. read ix a = (toList a) !! i" readRef,-    testProperty "size = length . toList" sizeRef,-    testProperty "∀ a,s,x. resize s x a = take s (toList a ++ repeat x)" resizeRef,-    testProperty "∀ s,n. slice s n = take s . drop n" sliceRef,-    testProperty "f <$> fromList xs == fromList (f <$> xs)" refFmap,-    testProperty "toList . fromList = id" refToListFromList,-    testProperty "toList . freeze . fromList = id" refFreeze,-    testProperty "dup2 produces identical arrays" refDupable,+    testPropertyNamed "∀ ix. read ix a = (toList a) !! i" "readRef" readRef,+    testPropertyNamed "size = length . toList" "sizeRef" sizeRef,+    testPropertyNamed "∀ a,s,x. resize s x a = take s (toList a ++ repeat x)" "resizeRef" resizeRef,+    testPropertyNamed "∀ s,n. slice s n = take s . drop n" "sliceRef" sliceRef,+    testPropertyNamed "f <$> fromList xs == fromList (f <$> xs)" "refFmap" refFmap,+    testPropertyNamed "toList . fromList = id" "refToListFromList" refToListFromList,+    testPropertyNamed "toList . freeze . fromList = id" "refFreeze" refFreeze,+    testPropertyNamed "dup2 produces identical arrays" "refDupable" refDupable,     -- Regression tests-    testProperty "do not reorder reads and writes" readAndWriteTest,-    testProperty "do not evaluate values unnecesesarily" strictnessTest+    testPropertyNamed "do not reorder reads and writes" "readAndWriteTest" readAndWriteTest,+    testPropertyNamed "do not evaluate values unnecesesarily" "strictnessTest" strictnessTest   ]  -- # Internal Library

@@ -37,7 +37,7 @@ import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear import Test.Tasty-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed)  -- # Exported Tests --------------------------------------------------------------------------------@@ -48,31 +48,33 @@ group :: [TestTree] group =   [ -- Axiomatic tests-    testProperty "∀ k,v,m. lookup k (insert m k v) = Just v" lookupInsert1,-    testProperty+    testPropertyNamed "∀ k,v,m. lookup k (insert m k v) = Just v" "lookupInsert1" lookupInsert1,+    testPropertyNamed       "∀ k,v,m,k'/=k. lookup k'(insert m k v) = lookup k' m"+      "lookuInsert2"       lookupInsert2,-    testProperty "∀ k,m. lookup k (delete m k) = Nothing" lookupDelete1,-    testProperty+    testPropertyNamed "∀ k,m. lookup k (delete m k) = Nothing" "lookupDelete1" lookupDelete1,+    testPropertyNamed       "∀ k,m,k'/=k. lookup k' (delete m k) = lookup k' m"+      "lookupDelete2"       lookupDelete2,-    testProperty "∀ k,v,m. member k (insert m k v) = True" memberInsert,-    testProperty "∀ k,m. member k (delete m k) = False" memberDelete,-    testProperty "∀ k,v,m. size (insert (m-k) k v) = 1+ size (m-k)" sizeInsert,-    testProperty "∀ k,m with k. size (delete m k) + 1 = size m" deleteSize,+    testPropertyNamed "∀ k,v,m. member k (insert m k v) = True" "memberInsert" memberInsert,+    testPropertyNamed "∀ k,m. member k (delete m k) = False" "memberDelete" memberDelete,+    testPropertyNamed "∀ k,v,m. size (insert (m-k) k v) = 1+ size (m-k)" "sizeInsert" sizeInsert,+    testPropertyNamed "∀ k,m with k. size (delete m k) + 1 = size m" "deleteSize" deleteSize,     -- Homorphism tests against a reference implementation-    testProperty "insert k v h = fromList (toList h ++ [(k,v)])" refInsert,-    testProperty "delete k h = fromList (filter (!= k . fst) (toList h))" refDelete,-    testProperty "fst . lookup k h = lookup k (toList h)" refLookup,-    testProperty "mapMaybe f h = fromList . mapMaybe (uncurry f) . toList" refMap,-    testProperty "size = length . toList" refSize,-    testProperty "toList . fromList = id" refToListFromList,-    testProperty "filter f (fromList xs) = fromList (filter f xs)" refFilter,-    testProperty "fromList xs <> fromList ys = fromList (xs <> ys)" refMappend,-    testProperty "unionWith reference" refUnionWith,-    testProperty "intersectionWith reference" refIntersectionWith,+    testPropertyNamed "insert k v h = fromList (toList h ++ [(k,v)])" "refInsert" refInsert,+    testPropertyNamed "delete k h = fromList (filter (!= k . fst) (toList h))" "refDelete" refDelete,+    testPropertyNamed "fst . lookup k h = lookup k (toList h)" "refLookup" refLookup,+    testPropertyNamed "mapMaybe f h = fromList . mapMaybe (uncurry f) . toList" "refMap" refMap,+    testPropertyNamed "size = length . toList" "refSize" refSize,+    testPropertyNamed "toList . fromList = id" "refToListFromList" refToListFromList,+    testPropertyNamed "filter f (fromList xs) = fromList (filter f xs)" "refFilter" refFilter,+    testPropertyNamed "fromList xs <> fromList ys = fromList (xs <> ys)" "refMappend" refMappend,+    testPropertyNamed "unionWith reference" "refUnionWith" refUnionWith,+    testPropertyNamed "intersectionWith reference" "refIntersectionWith" refIntersectionWith,     -- Misc-    testProperty "toList . shrinkToFit = toList" shrinkToFitTest+    testPropertyNamed "toList . shrinkToFit = toList" "shrinkToFitTest" shrinkToFitTest   ]  -- # Internal Library

@@ -70,7 +70,7 @@ import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed)  -- # Exported Tests --------------------------------------------------------------------------------@@ -81,23 +81,25 @@ group :: [TestTree] group =   -- Tests of the form [accessor (mutator)]-  [ testProperty "∀ x. member (insert s x) x = True" memberInsert1,-    testProperty "∀ x,y/=x. member (insert s x) y = member s y" memberInsert2,-    testProperty "∀ x. member (delete s x) x = False" memberDelete1,-    testProperty "∀ x,y/=x. member (delete s x) y = member s y" memberDelete2,-    testProperty "∀ s, x \\in s. size (insert s x) = size s" sizeInsert1,-    testProperty "∀ s, x \\notin s. size (insert s x) = size s + 1" sizeInsert2,-    testProperty "∀ s, x \\in s. size (delete s x) = size s - 1" sizeDelete1,-    testProperty "∀ s, x \\notin s. size (delete s x) = size s" sizeDelete2,+  [ testPropertyNamed "∀ x. member (insert s x) x = True" "memberInsert1" memberInsert1,+    testPropertyNamed "∀ x,y/=x. member (insert s x) y = member s y" "memberInsert2" memberInsert2,+    testPropertyNamed "∀ x. member (delete s x) x = False" "memberDelete1" memberDelete1,+    testPropertyNamed "∀ x,y/=x. member (delete s x) y = member s y" "memberDelete2" memberDelete2,+    testPropertyNamed "∀ s, x \\in s. size (insert s x) = size s" "sizeInsert1" sizeInsert1,+    testPropertyNamed "∀ s, x \\notin s. size (insert s x) = size s + 1" "sizeInsert2" sizeInsert2,+    testPropertyNamed "∀ s, x \\in s. size (delete s x) = size s - 1" "sizeDelete1" sizeDelete1,+    testPropertyNamed "∀ s, x \\notin s. size (delete s x) = size s" "sizeDelete2" sizeDelete2,     -- Homomorphism tests-    testProperty "sort . nub = sort . toList" toListFromList,-    testProperty "member x s = elem x (toList s)" memberHomomorphism,-    testProperty "size = length . toList" sizeHomomorphism,-    testProperty+    testPropertyNamed "sort . nub = sort . toList" "toListFromList" toListFromList,+    testPropertyNamed "member x s = elem x (toList s)" "memberHomomorphism" memberHomomorphism,+    testPropertyNamed "size = length . toList" "sizeHomomorphism" sizeHomomorphism,+    testPropertyNamed       "sort . nub ((toList s) ∪ (toList s')) = sort . toList (s ∪ s')"+      "unionHomomorphism"       unionHomomorphism,-    testProperty+    testPropertyNamed       "sort . nub ((toList s) ∩ (toList s')) = sort . toList (s ∩ s')"+      "intersecHomomorphism"       intersectHomomorphism   ] 

@@ -32,7 +32,7 @@ import qualified Hedgehog.Range as Range import qualified Prelude.Linear as Linear hiding ((>)) import Test.Tasty (TestTree, testGroup)-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed)  -- # Exported Tests --------------------------------------------------------------------------------@@ -43,43 +43,45 @@ group :: [TestTree] group =   -- All tests for exprs of the form (read (const ...) i)-  [ testProperty "∀ s,i,x. read (constant s x) i = x" readConst,-    testProperty "∀ a,i,x. read (write a i x) i = x " readWrite1,-    testProperty "∀ a,i,j/=i,x. read (write a j x) i = read a i" readWrite2,-    testProperty "∀ a,x,(i < len a). read (push a x) i = read a i" readPush1,-    testProperty "∀ a,x. read (push a x) (len a) = x" readPush2,+  [ testPropertyNamed "∀ s,i,x. read (constant s x) i = x" "readConst" readConst,+    testPropertyNamed "∀ a,i,x. read (write a i x) i = x " "readWrite1" readWrite1,+    testPropertyNamed "∀ a,i,j/=i,x. read (write a j x) i = read a i" "readWrite2" readWrite2,+    testPropertyNamed "∀ a,x,(i < len a). read (push a x) i = read a i" "readPush1" readPush1,+    testPropertyNamed "∀ a,x. read (push a x) (len a) = x" "readPush2" readPush2,     -- All tests for exprs of the form (length (const ...))-    testProperty "∀ s,x. len (constant s x) = s" lenConst,-    testProperty "∀ a,i,x. len (write a i x) = len a" lenWrite,-    testProperty "∀ a,x. len (push a x) = 1 + len a" lenPush,+    testPropertyNamed "∀ s,x. len (constant s x) = s" "lenConst" lenConst,+    testPropertyNamed "∀ a,i,x. len (write a i x) = len a" "lenWrite" lenWrite,+    testPropertyNamed "∀ a,x. len (push a x) = 1 + len a" "lenPush" lenPush,     -- Tests against a reference implementation-    testProperty+    testPropertyNamed       "write ix a v = (\\l -> take ix l ++ [a] ++ drop (ix+1) l) . toList"+      "refWrite"       refWrite,-    testProperty "fst $ modify f ix v = snd $ f ((toList v) !! ix)" refModify1,-    testProperty+    testPropertyNamed "fst $ modify f ix v = snd $ f ((toList v) !! ix)" "refModify1" refModify1,+    testPropertyNamed       "snd (modify f i v) = write (toList v) i (fst (f ((toList v) !! i))))"+      "refModify2"       refModify2,-    testProperty "toList . push x = snoc x . toList" refPush,-    testProperty "toList . pop = init . toList" refPop,-    testProperty "read ix v = (toList v) !! ix" refRead,-    testProperty "size = length . toList" refSize,-    testProperty "toList . shrinkToFit = toList" refShrinkToFit,-    testProperty "pop . push _ = id" refPopPush,-    testProperty "push . pop = id" refPushPop,-    testProperty "slice s n = take s . drop n" refSlice,-    testProperty "toList . fromList = id" refToListFromList,-    testProperty "toList can be implemented with repeated pops" refToListViaPop,-    testProperty "fromList can be implemented with repeated pushes" refFromListViaPush,-    testProperty "toList works with extra capacity" refToListWithExtraCapacity,-    testProperty "fromList xs <> fromList ys = fromList (xs <> ys)" refMappend,-    testProperty "mapMaybe f (fromList xs) = fromList (mapMaybe f xs)" refMapMaybe,-    testProperty "filter f (fromList xs) = fromList (filter f xs)" refFilter,-    testProperty "f <$> fromList xs == fromList (f <$> xs)" refFmap,-    testProperty "toList . freeze . fromList = id" refFreeze,+    testPropertyNamed "toList . push x = snoc x . toList" "refPush" refPush,+    testPropertyNamed "toList . pop = init . toList" "refPop" refPop,+    testPropertyNamed "read ix v = (toList v) !! ix" "refRead" refRead,+    testPropertyNamed "size = length . toList" "refSize" refSize,+    testPropertyNamed "toList . shrinkToFit = toList" "refShrinkToFit" refShrinkToFit,+    testPropertyNamed "pop . push _ = id" "refPopPush" refPopPush,+    testPropertyNamed "push . pop = id" "refPushPop" refPushPop,+    testPropertyNamed "slice s n = take s . drop n" "refSlice" refSlice,+    testPropertyNamed "toList . fromList = id" "refToListFromList" refToListFromList,+    testPropertyNamed "toList can be implemented with repeated pops" "refToListViaPop" refToListViaPop,+    testPropertyNamed "fromList can be implemented with repeated pushes" "refFromListViaPush" refFromListViaPush,+    testPropertyNamed "toList works with extra capacity" "refToListWithExtraCapacity" refToListWithExtraCapacity,+    testPropertyNamed "fromList xs <> fromList ys = fromList (xs <> ys)" "refMappend" refMappend,+    testPropertyNamed "mapMaybe f (fromList xs) = fromList (mapMaybe f xs)" "refMapMaybe" refMapMaybe,+    testPropertyNamed "filter f (fromList xs) = fromList (filter f xs)" "refFilter" refFilter,+    testPropertyNamed "f <$> fromList xs == fromList (f <$> xs)" "refFmap" refFmap,+    testPropertyNamed "toList . freeze . fromList = id" "refFreeze" refFreeze,     -- Regression tests-    testProperty "push on an empty vector should succeed" snocOnEmptyVector,-    testProperty "do not reorder reads and writes" readAndWriteTest+    testPropertyNamed "push on an empty vector should succeed" "snocOnEmptyVector" snocOnEmptyVector,+    testPropertyNamed "do not reorder reads and writes" "readAndWriteTest" readAndWriteTest   ]  -- # Internal Library

@@ -1,3 +1,4 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE NoImplicitPrelude #-}  module Test.Data.Polarized (polarizedArrayTests) where@@ -11,7 +12,7 @@ import qualified Hedgehog.Range as Range import Prelude.Linear import Test.Tasty-import Test.Tasty.Hedgehog (testProperty)+import Test.Tasty.Hedgehog (testPropertyNamed) import qualified Prelude  {- TODO:@@ -28,15 +29,15 @@ polarizedArrayTests =   testGroup     "Polarized arrays"-    [ testProperty "Push.alloc . transfer . Pull.fromVector = id" polarRoundTrip,-      testProperty "Push.append ~ Vec.append" pushAppend,-      testProperty "Push.make ~ Vec.replicate" pushMake,-      testProperty "Pull.append ~ Vec.append" pullAppend,-      testProperty "Pull.asList . Pull.fromVector ~ id" pullAsList,-      testProperty "Pull.singleton x = [x]" pullSingleton,-      testProperty "Pull.splitAt ~ splitAt" pullSplitAt,-      testProperty "Pull.make ~ Vec.replicate" pullMake,-      testProperty "Pull.zip ~ zip" pullZip+    [ testPropertyNamed "Push.alloc . transfer . Pull.fromVector = id" "polarRoundTrip" polarRoundTrip,+      testPropertyNamed "Push.append ~ Vec.append" "pushAppend" pushAppend,+      testPropertyNamed "Push.make ~ Vec.replicate" "pushMake" pushMake,+      testPropertyNamed "Pull.append ~ Vec.append" "pullAppend" pullAppend,+      testPropertyNamed "Pull.asList . Pull.fromVector ~ id" "pullAsList" pullAsList,+      testPropertyNamed "Pull.singleton x = [x]" "pullSingleton" pullSingleton,+      testPropertyNamed "Pull.splitAt ~ splitAt" "pullSplitAt" pullSplitAt,+      testPropertyNamed "Pull.make ~ Vec.replicate" "pullMake" pullMake,+      testPropertyNamed "Pull.zip ~ zip" "pullZip" pullZip     ]  list :: Gen [Int]