linear-base 0.4.0 → 0.5.0

raw patch · 51 files changed

+813/−531 lines, 51 filesdep +ghc-bignumdep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-bignum

Dependency ranges changed: base

API changes (from Hackage documentation)

Files

• CHANGELOG.md +19/−0
• README.md +9/−1
• bench/Data/Mutable/HashMap.hs +1/−1
• bench/Data/Mutable/Quicksort.hs +40/−0
• bench/Main.hs +3/−1
• docs/USER_GUIDE.md +0/−33
• examples/Generic/Traverse.hs +0/−52
• examples/Main.hs +0/−18
• examples/Simple/Quicksort.hs +28/−17
• examples/Simple/TopSort.hs +8/−9
• examples/Test/Foreign.hs +0/−102
• examples/Test/Generic.hs +0/−11
• examples/Test/Quicksort.hs +0/−19
• linear-base.cabal +56/−44
• src/Control/Optics/Linear/Internal.hs +1/−1
• src/Control/Optics/Linear/Prism.hs +1/−1
• src/Data/Array/Mutable/Linear/Internal.hs +8/−8
• src/Data/Array/Mutable/Unlifted/Linear.hs +22/−3
• src/Data/Array/Polarized.hs +6/−8
• src/Data/Array/Polarized/Pull.hs +3/−2
• src/Data/Array/Polarized/Pull/Internal.hs +8/−3
• src/Data/Functor/Linear/Internal/Traversable.hs +1/−1
• src/Data/HashMap/Mutable/Linear/Internal.hs +10/−10
• src/Data/List/Linear.hs +8/−8
• src/Data/Monoid/Linear/Internal/Semigroup.hs +3/−3
• src/Data/Num/Linear.hs +127/−19
• src/Data/Ord/Linear/Internal/Ord.hs +1/−1
• src/Data/Replicator/Linear/Internal.hs +6/−6
• src/Data/Replicator/Linear/Internal/ReplicationStream.hs +4/−4
• src/Data/Set/Mutable/Linear/Internal.hs +3/−3
• src/Data/Unrestricted/Linear.hs +1/−1
• src/Data/Unrestricted/Linear/Internal/Instances.hs +34/−4
• src/Data/Unrestricted/Linear/Internal/Movable.hs +7/−7
• src/Data/V/Linear/Internal.hs +4/−4
• src/Data/Vector/Mutable/Linear/Internal.hs +7/−7
• src/Foreign/Marshal/Pure/Internal.hs +6/−6
• src/Streaming/Linear.hs +16/−16
• src/Streaming/Linear/Internal/Consume.hs +18/−18
• src/Streaming/Linear/Internal/Many.hs +13/−13
• src/Streaming/Linear/Internal/Process.hs +47/−47
• src/Streaming/Linear/Internal/Produce.hs +9/−9
• test-examples/Main.hs +16/−0
• test-examples/Test/Foreign.hs +102/−0
• test-examples/Test/Simple/Quicksort.hs +29/−0
• test/Main.hs +5/−1
• test/Test/Data/Functor/Linear.hs +59/−0
• test/Test/Data/List.hs +43/−0
• test/Test/Data/Mutable/Vector.hs +1/−1
• test/Test/Data/Polarized.hs +13/−1
• test/Test/Data/Replicator.hs +3/−3
• test/Test/Data/V.hs +4/−4

@@ -1,5 +1,24 @@ # Change Log +## [v0.5.0](https://github.com/tweag/linear-base/tree/v0.5.0) (2025-04-07)++[Full Changelog](https://github.com/tweag/linear-base/compare/v0.4.0...v0.5.0)++### Headline changes++- Data.List.Linear.{take,drop} take one list element too many [\#484](https://github.com/tweag/linear-base/issues/484)+- Remove pull array index \(unsafe\), add uncons. [\#475](https://github.com/tweag/linear-base/pull/475) ([sjoerdvisscher](https://github.com/sjoerdvisscher))+- Adds missing Data.Num.Linear.\* instances for Word, Integer, Natural, Float, Word8/16/32/64 Int8/16/32/64 [\#467](https://github.com/tweag/linear-base/pull/467) ([Qqwy](https://github.com/Qqwy))+- In scope-passing style: use a `Movable b` instead of `Ur b` (it's fully backward compatible compatible)[\#473](https://github.com/tweag/linear-base/pull/473) ([aspiwack](https://github.com/aspiwack))++### Miscellaneous++- Clarify Ur documentation [\#476](https://github.com/tweag/linear-base/issues/476)+- Test with GHC 9.10 and GHC 9.12+  - 9.10 [\#479](https://github.com/tweag/linear-base/pull/479) ([tbagrel1](https://github.com/tbagrel1))+  - 9.12 [\#487](https://github.com/tweag/linear-base/pull/487) ([aspiwack](https://github.com/aspiwack))+- Improve wording about Ur [\#478](https://github.com/tweag/linear-base/pull/478) ([aspiwack](https://github.com/aspiwack))+ ## [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)

@@ -1,9 +1,9 @@ # Linear base  [![License MIT](https://img.shields.io/badge/license-MIT-brightgreen.svg)](https://github.com/tweag/linear-base/blob/master/LICENSE)-[![Build status](https://badge.buildkite.com/5b60ab93dadba234a95e04e6568985918552dcc9e7685ede0d.svg?branch=master)](https://buildkite.com/tweag-1/linear-base) [![Hackage](https://img.shields.io/hackage/v/linear-base.svg?style=flat&color=brightgreen)][hackage-pkg] [![Stackage](https://stackage.org/package/linear-base/badge/nightly)][stackage-pkg]+[![Discord](https://img.shields.io/badge/Discord-100000?style=flat&logo=Discord&logoColor=C3C3C3&labelColor=4179DA&color=010101)][discord]  Linear base is a standard library for developing applications with linear types. It is named `linear-base` to be an analog to the original [`base`]@@ -39,6 +39,10 @@ {-# LANGUAGE LinearTypes #-} ``` +To get in touch, you can join our+[![Discord](https://img.shields.io/badge/Discord-100000?style=flat&logo=Discord&logoColor=C3C3C3&labelColor=4179DA&color=010101)][discord] server++ ## User Guide  If you already know what `-XLinearTypes` does and what the linear@@ -85,6 +89,9 @@ To contribute please see the [Design Document] for instructions and advice on making pull requests. +A great first step is to join our+[![Discord](https://img.shields.io/badge/Discord-100000?style=flat&logo=Discord&logoColor=C3C3C3&labelColor=4179DA&color=010101)][discord] server+ ## Licence  See the [Licence file](https://github.com/tweag/linear-base/blob/master/LICENSE).@@ -97,3 +104,4 @@ [Design Document]: https://github.com/tweag/linear-base/blob/master/docs/DESIGN.md [hackage-pkg]: https://hackage.haskell.org/package/linear-base [stackage-pkg]: https://www.stackage.org/nightly/package/linear-base+[discord]: https://discord.com/invite/7yg5GxzvDJ

@@ -135,7 +135,7 @@      look :: LMap.HashMap Key Int %1 -> Key -> LMap.HashMap Key Int     look hmap k =-      LMap.lookup k hmap Linear.& \case+      case LMap.lookup k hmap of         (Linear.Ur Nothing, hmap0) -> hmap0         (Linear.Ur (Just v), hmap0) -> Linear.seq (force v) hmap0 

@@ -0,0 +1,40 @@+{-# LANGUAGE NumericUnderscores #-}++module Data.Mutable.Quicksort (benchmarks) where++import Control.DeepSeq (force)+import Control.Exception (evaluate)+import Data.List (sort)+import Simple.Quicksort (quicksortUsingArray, quicksortUsingList)+import System.Random+import Test.Tasty.Bench++-- Follows thread from https://discourse.haskell.org/t/linear-haskell-quicksort-performance/10280++gen :: StdGen+gen = mkStdGen 4541645642++randomListBuilder :: Int -> IO [Int]+randomListBuilder size = evaluate $ force $ take size (randoms gen :: [Int])++sizes :: [Int]+sizes = [1_000, 50_000, 1_000_000]++benchmarks :: Benchmark+benchmarks =+  bgroup+    "quicksort"+    ( ( \size ->+          env (randomListBuilder size) $ \randomList ->+            bgroup+              ("size " ++ (show size))+              [ bench "quicksortUsingArray" $+                  nf quicksortUsingArray randomList,+                bench "quicksortUsingList" $+                  nf quicksortUsingList randomList,+                bench "sortStdLib" $+                  nf sort randomList+              ]+      )+        <$> sizes+    )

@@ -2,11 +2,13 @@  import qualified Data.Mutable.Array as Array import qualified Data.Mutable.HashMap as HashMap+import qualified Data.Mutable.Quicksort as Quicksort import Test.Tasty.Bench (defaultMain)  main :: IO () main = do   defaultMain     [ Array.benchmarks,-      HashMap.benchmarks+      HashMap.benchmarks,+      Quicksort.benchmarks     ]

@@ -107,39 +107,6 @@  ## Temporary limitations -### Case statements are not linear--The following definition will **fail** to type check:--```haskell-maybeFlip :: Int %1-> Int %1-> (a,a) -> a-maybeFlip i j (x,y) = case i < j of-  True -> x-  False -> y-```--The scrutinee on (i.e., `x` in `case x of ...`) is considered to be-consumed many times. It's a limitation of the current implementation-of the type checker.--For now, we can mimic a linear case statement using the-`-XLambdaCase` language extension and the `(&)` from `Prelude.Linear`:--```haskell-{-# LANGUAGE LambdaCase #-}-import Prelude.Linear ((&))--maybeFlip :: Int %1-> Int %1-> (a,a) -> a-maybeFlip i j (x,y) =  i < j & \case-  True -> x-  False -> y-```--The `(&)` operator is like `($)` with the argument order flipped.--This workaround will no longer be needed in GHC 9.2, where this limitation-has been lifted and `case` can be used in a linear context.- ### `let` and `where` bindings are not linear  The following will **fail** to type check:

@@ -1,52 +0,0 @@-{-# LANGUAGE DataKinds #-}-{-# LANGUAGE DeriveAnyClass #-}-{-# LANGUAGE DerivingVia #-}-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE LinearTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE StandaloneDeriving #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE TypeFamilies #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Generic.Traverse (genericTraverseTests) where--import Data.Functor.Linear (genericTraverse)-import qualified Data.Functor.Linear as Data-import Generics.Linear.TH-import Hedgehog-import Prelude.Linear-import Test.Tasty-import Test.Tasty.Hedgehog (testPropertyNamed)-import qualified Prelude--data Pair a = MkPair a a-  deriving (Show, Prelude.Eq)--$(deriveGeneric1 ''Pair)--instance Data.Functor Pair where-  fmap f (MkPair x y) = MkPair (f x) (f y)--instance Data.Traversable Pair where-  traverse = genericTraverse--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,18 +0,0 @@-module Main where--import Test.Foreign (foreignGCTests)-import Test.Generic (genericTests)-import Test.Quicksort (quickSortTests)-import Test.Tasty--main :: IO ()-main = defaultMain allTests--allTests :: TestTree-allTests =-  testGroup-    "All tests"-    [ foreignGCTests,-      quickSortTests,-      genericTests-    ]

@@ -1,8 +1,12 @@ {-# LANGUAGE LinearTypes #-} {-# LANGUAGE NoImplicitPrelude #-} +-- Uncomment the line below to observe the generated (optimised) Core. It will+-- land in a file named “Quicksort.dump-simpl”+-- {-# OPTIONS_GHC -ddump-simpl -ddump-to-file -dsuppress-all -dsuppress-uniques #-}+ -- | This module implements quicksort with mutable arrays from linear-base-module Simple.Quicksort (quickSort) where+module Simple.Quicksort where  import Data.Array.Mutable.Linear (Array) import qualified Data.Array.Mutable.Linear as Array@@ -13,15 +17,22 @@ -- # Quicksort ------------------------------------------------------------------------------- -quickSort :: [Int] -> [Int]-quickSort xs = unur $ Array.fromList xs $ Array.toList . arrQuicksort+quicksortUsingList :: (Ord a) => [a] -> [a]+quicksortUsingList [] = []+quicksortUsingList (x : xs) = quicksortUsingList ltx ++ x : quicksortUsingList gex+  where+    ltx = [y | y <- xs, y < x]+    gex = [y | y <- xs, y >= x] -arrQuicksort :: Array Int %1 -> Array Int-arrQuicksort arr =+quicksortUsingArray :: (Ord a) => [a] -> [a]+quicksortUsingArray xs = unur $ Array.fromList xs $ Array.toList . quicksortArray++quicksortArray :: (Ord a) => Array a %1 -> Array a+quicksortArray arr =   Array.size arr     & \(Ur len, arr1) -> go 0 (len - 1) arr1 -go :: Int -> Int -> Array Int %1 -> Array Int+go :: (Ord a) => Int -> Int -> Array a %1 -> Array a go lo hi arr   | lo >= hi = arr   | otherwise =@@ -39,23 +50,23 @@ -- @arr'[j] > pivot@ for @ix < j <= hi@, -- @arr'[k] = arr[k]@ for @k < lo@ and @k > hi@, and -- @arr'@ is a permutation of @arr@.-partition :: Array Int %1 -> Int -> Int -> Int -> (Array Int, Ur Int)-partition arr pivot lx rx-  | (rx < lx) = (arr, Ur (lx - 1))+partition :: (Ord a) => Array a %1 -> a -> Int -> Int -> (Array a, Ur Int)+partition arr pivot lo hi+  | (hi < lo) = (arr, Ur (lo - 1))   | otherwise =-      Array.read arr lx+      Array.read arr lo         & \(Ur lVal, arr1) ->-          Array.read arr1 rx+          Array.read arr1 hi             & \(Ur rVal, arr2) -> case (lVal <= pivot, pivot < rVal) of-              (True, True) -> partition arr2 pivot (lx + 1) (rx - 1)-              (True, False) -> partition arr2 pivot (lx + 1) rx-              (False, True) -> partition arr2 pivot lx (rx - 1)+              (True, True) -> partition arr2 pivot (lo + 1) (hi - 1)+              (True, False) -> partition arr2 pivot (lo + 1) hi+              (False, True) -> partition arr2 pivot lo (hi - 1)               (False, False) ->-                swap arr2 lx rx-                  & \arr3 -> partition arr3 pivot (lx + 1) (rx - 1)+                swap arr2 lo hi+                  & \arr3 -> partition arr3 pivot (lo + 1) (hi - 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 a %1 -> Int -> Int -> Array a swap arr i j =   Array.read arr i     & \(Ur ival, arr1) ->

@@ -13,7 +13,6 @@ import qualified Data.HashMap.Mutable.Linear as HMap import Data.Maybe.Linear (catMaybes) import Data.Unrestricted.Linear-import Prelude.Linear ((&)) import qualified Prelude.Linear as Linear  -- # The topological sort of a DAG@@ -36,7 +35,7 @@  postOrderHM :: [Node] -> InDegGraph %1 -> Ur [Node] postOrderHM nodes dag =-  findSources nodes (computeInDeg nodes dag) & \case+  case findSources nodes (computeInDeg nodes dag) of     (dag, Ur sources) -> pluckSources sources [] dag   where     -- O(V + N)@@ -46,7 +45,7 @@     -- Increment in-degree of all neighbors     incChildren :: InDegGraph %1 -> Ur Node %1 -> InDegGraph     incChildren dag (Ur node) =-      HMap.lookup node dag & \case+      case HMap.lookup node dag of         (Ur Nothing, dag) -> dag         (Ur (Just (xs, i)), dag) -> incNodes (move xs) dag       where@@ -55,7 +54,7 @@          incNode :: InDegGraph %1 -> Ur Node %1 -> InDegGraph         incNode dag (Ur node) =-          HMap.lookup node dag & \case+          case HMap.lookup node dag of             (Ur Nothing, dag') -> dag'             (Ur (Just (n, d)), dag') ->               HMap.insert node (n, d + 1) dag'@@ -66,10 +65,10 @@ pluckSources :: [Node] -> [Node] -> InDegGraph %1 -> Ur [Node] pluckSources [] postOrd dag = lseq dag (move postOrd) pluckSources (s : ss) postOrd dag =-  HMap.lookup s dag & \case+  case HMap.lookup s dag of     (Ur Nothing, dag) -> pluckSources ss (s : postOrd) dag     (Ur (Just (xs, i)), dag) ->-      walk xs dag & \case+      case walk xs dag of         (dag', Ur newSrcs) ->           pluckSources (newSrcs ++ ss) (s : postOrd) dag'   where@@ -81,7 +80,7 @@     -- Decrement the degree of a node, save it if it is now a source     decDegree :: Node -> InDegGraph %1 -> (InDegGraph, Ur (Maybe Node))     decDegree node dag =-      HMap.lookup node dag & \case+      case HMap.lookup node dag of         (Ur Nothing, dag') -> (dag', Ur Nothing)         (Ur (Just (n, d)), dag') ->           checkSource node (HMap.insert node (n, d - 1) dag')@@ -94,7 +93,7 @@ -- | Check if a node is a source, and if so return it checkSource :: Node -> InDegGraph %1 -> (InDegGraph, Ur (Maybe Node)) checkSource node dag =-  HMap.lookup node dag & \case+  case HMap.lookup node dag of     (Ur Nothing, dag) -> (dag, Ur Nothing)     (Ur (Just (xs, 0)), dag) -> (dag, Ur (Just node))     (Ur (Just (xs, n)), dag) -> (dag, Ur Nothing)@@ -103,5 +102,5 @@   (a -> b %1 -> (b, Ur c)) -> [a] -> b %1 -> (b, Ur [c]) mapAccum f [] b = (b, Ur []) mapAccum f (x : xs) b =-  mapAccum f xs b & \case+  case mapAccum f xs b of     (b, Ur cs) -> second (Data.fmap (: cs)) (f x b)

@@ -1,102 +0,0 @@-{-# LANGUAGE LinearTypes #-}-{-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeApplications #-}-{-# LANGUAGE NoImplicitPrelude #-}--module Test.Foreign (foreignGCTests) where--import Control.Exception hiding (assert)-import Control.Monad (void)-import Data.Typeable-import qualified Foreign.Heap as Heap-import Foreign.List (List)-import qualified Foreign.List as List-import qualified Foreign.Marshal.Pure as Manual-import Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import Prelude.Linear-import Test.Tasty-import Test.Tasty.Hedgehog (testPropertyNamed)-import qualified Prelude---- # Organizing tests----------------------------------------------------------------------------------foreignGCTests :: TestTree-foreignGCTests =-  testGroup-    "foreignGCTests"-    [ listExampleTests,-      heapExampleTests-    ]--listExampleTests :: TestTree-listExampleTests =-  testGroup-    "list tests"-    [ 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"-    [testPropertyNamed "sort = heapsort" "nonGCHeapSort" nonGCHeapSort]---- # Internal library----------------------------------------------------------------------------------list :: Gen [Int]-list = Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 100))--eqList ::-  forall a.-  (Manual.Representable a, Movable a, Eq a) =>-  List a %1 ->-  List a %1 ->-  Ur Bool-eqList l1 l2 = move $ (List.toList l1) == (List.toList l2)--data InjectedError = InjectedError-  deriving (Typeable, Show)--instance Exception InjectedError---- # Properties----------------------------------------------------------------------------------invertNonGCList :: Property-invertNonGCList = property $ do-  xs <- forAll list-  let xs' =-        unur $-          Manual.withPool (\p -> move $ List.toList $ List.ofList xs p)-  xs === xs'--mapIdNonGCList :: Property-mapIdNonGCList = property $ do-  xs <- forAll list-  let boolTest = unur $-        Manual.withPool $ \p ->-          dup3 p & \(p0, p1, p2) ->-            eqList (List.ofList xs p0) (List.map id (List.ofList xs p1) p2)-  assert boolTest--testExceptionOnMem :: Property-testExceptionOnMem = property $ do-  xs <- forAll list-  let bs = xs ++ (throw InjectedError)-  let writeBadList = Manual.withPool (move . List.toList . List.ofRList bs)-  let ignoreCatch = \_ -> Prelude.return ()-  evalIO (catch @InjectedError (void (evaluate writeBadList)) ignoreCatch)--nonGCHeapSort :: Property-nonGCHeapSort = property $ do-  xs <- forAll list-  let ys :: [(Int, ())] = zip xs $ Prelude.replicate (Prelude.length xs) ()-  (Heap.sort ys) === (reverse $ sort ys)

@@ -1,11 +0,0 @@-module Test.Generic (genericTests) where--import Generic.Traverse (genericTraverseTests)-import Test.Tasty--genericTests :: TestTree-genericTests =-  testGroup-    "Generic tests"-    [ genericTraverseTests-    ]

@@ -1,19 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Test.Quicksort (quickSortTests) where--import Data.List (sort)-import Hedgehog-import qualified Hedgehog.Gen as Gen-import qualified Hedgehog.Range as Range-import Simple.Quicksort (quickSort)-import Test.Tasty-import Test.Tasty.Hedgehog (testPropertyNamed)--quickSortTests :: TestTree-quickSortTests = testPropertyNamed "quicksort sorts" "testQuicksort" testQuicksort--testQuicksort :: Property-testQuicksort = property $ do-  xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int $ Range.linear 0 100)-  sort xs === quickSort xs

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               linear-base-version:            0.4.0+version:            0.5.0 license:            MIT license-file:       LICENSE copyright:          (c) Tweag Holding and affiliates@@ -21,13 +21,26 @@     type:     git     location: https://github.com/tweag/linear-base -common warnings-    ghc-options: -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances+common build-opts+    ghc-options: -O2 -Wall -Wcompat -Wincomplete-record-updates -Wincomplete-uni-patterns -Wnoncanonical-monad-instances                  -- Additional warnings we may consider adding:                  -- * -Wredundant-constraints : would need deactivating in the modules which use Nat+common rts-opts-multithread+    ghc-options: -threaded -rtsopts "-with-rtsopts=-N"+common rts-opts-monothread-stats+    ghc-options: -rtsopts "-with-rtsopts=-T"  library-    import: warnings+    import: build-opts+    hs-source-dirs:     src+    if impl(ghc >= 9.4.0)+        hs-source-dirs: src-version-changes/ghc94/after+    else+        hs-source-dirs: src-version-changes/ghc94/before+    if impl(ghc >= 9.6.0)+        hs-source-dirs: src-version-changes/ghc96/after+    else+        hs-source-dirs: src-version-changes/ghc96/before     exposed-modules:         Control.Monad.IO.Class.Linear         Control.Functor.Linear@@ -118,23 +131,12 @@         System.IO.Resource.Linear         System.IO.Resource.Linear.Internal         Unsafe.Linear--    hs-source-dirs:   src-    if impl(ghc >= 9.4.0)-        hs-source-dirs: src-version-changes/ghc94/after-    else-        hs-source-dirs: src-version-changes/ghc94/before-    if impl(ghc >= 9.6.0)-        hs-source-dirs: src-version-changes/ghc96/after-    else-        hs-source-dirs: src-version-changes/ghc96/before-     default-language: Haskell2010     build-depends:-         base >=4.16 && <5,         containers,         ghc-prim,+        ghc-bignum,         hashable,         linear-generics >= 0.2,         storable-tuple,@@ -143,23 +145,42 @@         vector >=0.12.2,         primitive +library examples+    import: build-opts+    hs-source-dirs: examples+    exposed-modules:+        Foreign.List+        Foreign.Heap+        Simple.FileIO+        Simple.Pure+        Simple.Quicksort+        Simple.TopSort+    build-depends:+        base,+        linear-base,+        storable-tuple,+        vector,+        text+    default-language: Haskell2010+ test-suite test-    import: warnings+    import: build-opts+    import: rts-opts-multithread     type:             exitcode-stdio-1.0     main-is:          Main.hs     hs-source-dirs:   test     other-modules:         Test.Data.Destination+        Test.Data.Functor.Linear+        Test.Data.List         Test.Data.Mutable.Array-        Test.Data.Mutable.Vector         Test.Data.Mutable.HashMap         Test.Data.Mutable.Set+        Test.Data.Mutable.Vector         Test.Data.Polarized-        Test.Data.V         Test.Data.Replicator-+        Test.Data.V     default-language: Haskell2010-    ghc-options:      -threaded -rtsopts -with-rtsopts=-N     build-depends:         inspection-testing,         tasty-inspection-testing,@@ -170,47 +191,37 @@         tasty,         tasty-hedgehog >= 1.2,         mmorph,-        vector+        vector,+        linear-generics -test-suite examples-    import: warnings+test-suite test-examples+    import: build-opts+    import: rts-opts-multithread     type:             exitcode-stdio-1.0     main-is:          Main.hs-    hs-source-dirs:   examples+    hs-source-dirs:   test-examples     other-modules:         Test.Foreign-        Test.Quicksort-        Test.Generic-        Foreign.List-        Foreign.Heap-        Simple.FileIO-        Simple.Pure-        Simple.Quicksort-        Simple.TopSort-        Generic.Traverse-+        Test.Simple.Quicksort     default-language: Haskell2010-    ghc-options:      -threaded -rtsopts -with-rtsopts=-N     build-depends:         base,         linear-base,         tasty,         tasty-hedgehog,         hedgehog,-        storable-tuple,-        vector,-        text,-        linear-generics+        examples -benchmark mutable-data-    import: warnings+benchmark bench+    import: build-opts+    import: rts-opts-monothread-stats     type:             exitcode-stdio-1.0     main-is:          Main.hs     hs-source-dirs:   bench     other-modules:         Data.Mutable.HashMap         Data.Mutable.Array-+        Data.Mutable.Quicksort     default-language: Haskell2010     build-depends:         base,@@ -224,4 +235,5 @@         random-shuffle,         tasty-bench >= 0.3,         unordered-containers,-        MonadRandom+        MonadRandom,+        examples

@@ -173,7 +173,7 @@  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+  case gets l (const (Sum one)) s of     Sum r -> r  -- XXX: the below two functions will be made redundant with multiplicity

@@ -23,7 +23,7 @@ -- -- (This is a bit of a toy example since we could use @over@ for this.) -- formatLicenceName :: PersonId %1-> PersonId -- formatLicenceName personId =---   Data.fmap modLisc (match pIdLiscPrism personId) & \case+--   case Data.fmap modLisc (match pIdLiscPrism personId) of --     Left personId' -> personId' --     Right lisc -> build pIdLiscPrism lisc --   where

@@ -62,11 +62,11 @@ -- | Allocate a constant array given a size and an initial value -- The size must be non-negative, otherwise this errors. alloc ::-  (HasCallStack) =>+  (HasCallStack, Movable b) =>   Int ->   a ->-  (Array a %1 -> Ur b) %1 ->-  Ur b+  (Array a %1 -> b) %1 ->+  b alloc s x f   | s < 0 =       (error ("Array.alloc: negative size: " ++ show s) :: x %1 -> x)@@ -89,11 +89,11 @@  -- | Allocate an array from a list fromList ::-  (HasCallStack) =>+  (HasCallStack, Movable b) =>   [a] ->-  (Array a %1 -> Ur b) %1 ->-  Ur b-fromList list (f :: Array a %1 -> Ur b) =+  (Array a %1 -> b) %1 ->+  b+fromList list (f :: Array a %1 -> b) =   alloc     (Prelude.length list)     (error "invariant violation: unintialized array position")@@ -190,7 +190,7 @@   Array a %1 ->   (Array a, Array a) slice from targetSize arr =-  size arr & \case+  case size arr of     (Ur s, Array old)       | s < from + targetSize ->           Unlifted.lseq

@@ -60,13 +60,32 @@ -- | Allocate a mutable array of given size using a default value. -- -- The size should be non-negative.-alloc :: Int -> a -> (Array# a %1 -> Ur b) %1 -> Ur b-alloc (GHC.I# s) a f =+alloc :: (Movable b) => Int -> a -> (Array# a %1 -> b) %1 -> b+alloc i a f = case move (unsafe_alloc i a f) of+  Ur b -> b+{-# INLINEABLE alloc #-}++-- The `alloc` function is split in two. One very unsafe below (it's very+-- unsafe, because `unafe_alloc 57 0 id` returns an unrestricted _mutable_+-- `Array#` breaking the module's invariants). Because `unsafe_alloc` calls+-- `runRW#`, it's marked as `NOINLINE`.+--+-- It's made safe by the wrapping function `alloc`, which restricts `b` to be+-- `Movable` (`Array#` is crucially not `Movable`, therefore `alloc 57 0 id`+-- doesn't type). Furthermore, `alloc` cases on `move` to make sure that all the+-- effects have been run by the time we evaluate the result of an `alloc`. It's+-- fine that `alloc` is inlined: its semantics is preserved by program+-- transformations. It's useful that `alloc` be inlined, because in most+-- instance `case move … of` will trigger a case-of-known-constructor avoiding+-- an extra allocation. This is in particular the case for the common case where+-- `b = Ur x`.+unsafe_alloc :: Int -> a -> (Array# a %1 -> b) %1 -> b+unsafe_alloc (GHC.I# s) a f =   let new = GHC.runRW# Prelude.$ \st ->         case GHC.newArray# s a st of           (# _, arr #) -> Array# arr    in f new-{-# NOINLINE alloc #-} -- prevents runRW# from floating outwards+{-# NOINLINE unsafe_alloc #-} -- prevents runRW# from floating outwards  -- For the reasoning behind these NOINLINE pragmas, see the discussion at: -- https://github.com/tweag/linear-base/pull/187#pullrequestreview-489183531

@@ -55,14 +55,12 @@ -- vecfilter vec f = Push.alloc (transfer (loop (Pull.fromVector vec) f)) --   where --     loop :: Pull.Array a -> (a -> Bool) -> Pull.Array a---     loop arr f = case Pull.findLength arr of---       (0,_) -> Pull.fromFunction (error "empty") 0---       (n,_) -> case Pull.split 1 arr of---         (head, tail) -> case Pull.index head 0 of---           (a,_) ->---             if f a---             then Pull.append (Pull.singleton a) (loop tail f)---             else loop tail f+--     loop arr f = case Pull.uncons arr of+--       Nothing -> Pull.empty+--       Just (a, as) ->+--         if f a+--         then Pull.append (Pull.singleton a) (loop as f)+--         else loop as f -- @ -- --

@@ -13,6 +13,7 @@     fromVector,     make,     singleton,+    empty,      -- * Consumption     toVector,@@ -27,7 +28,7 @@     findLength,     split,     reverse,-    index,+    uncons,   ) where @@ -45,7 +46,7 @@ import qualified Data.Functor.Linear as Data import Data.Vector (Vector) import qualified Data.Vector as Vector-import Prelude.Linear hiding (foldMap, foldr, reverse, zip, zipWith)+import Prelude.Linear hiding (foldMap, foldr, reverse, uncons, zip, zipWith) import qualified Unsafe.Linear as Unsafe  -- | Convert a pull array into a list.

@@ -37,6 +37,10 @@ -- is interesting in and of itself: I think this is like an n-ary With), and -- changing the other arrows makes no difference) +-- | Create an empty pull array+empty :: Array a+empty = fromFunction (\_ -> error "Data.Array.Polarized.Pull.Internal.empty: this should never be called") 0+ -- | Produce a pull array of lenght 1 consisting of solely the given element. singleton :: a %1 -> Array a singleton = Unsafe.toLinear (\x -> fromFunction (\_ -> x) 1)@@ -110,6 +114,7 @@ reverse :: Array a %1 -> Array a reverse (Array f n) = Array (\x -> f (n + 1 - x)) n --- | Index a pull array (without checking bounds)-index :: Array a %1 -> Int -> (a, Array a)-index (Array f n) ix = (f ix, Array f n)+-- | Decompose an array into its head and tail, returns @Nothing@ if the array is empty.+uncons :: Array a %1 -> Maybe (a, Array a)+uncons (Array _ 0) = Nothing+uncons (Array f n) = Just (f 0, fromFunction (\x -> f (x + 1)) (n - 1))

@@ -239,7 +239,7 @@   {-# INLINE gtraverse #-}  instance GTraversable V1 where-  gtraverse _ v = Control.pure ((\case {}) v)+  gtraverse _ v = Control.pure (case v of {})  instance GTraversable UAddr where   gtraverse _ (UAddr x) = Control.pure (UAddr x)

@@ -133,10 +133,10 @@ -- | Run a computation with an empty 'HashMap' with given capacity. empty ::   forall k v b.-  (Keyed k) =>+  (Keyed k, Movable b) =>   Int ->-  (HashMap k v %1 -> Ur b) %1 ->-  Ur b+  (HashMap k v %1 -> b) %1 ->+  b empty size scope =   let cap = max 1 size    in Array.alloc cap Nothing (\arr -> scope (HashMap 0 cap arr))@@ -151,10 +151,10 @@ -- | Run a computation with an 'HashMap' containing given key-value pairs. fromList ::   forall k v b.-  (Keyed k) =>+  (Keyed k, Movable b) =>   [(k, v)] ->-  (HashMap k v %1 -> Ur b) %1 ->-  Ur b+  (HashMap k v %1 -> b) %1 ->+  b fromList xs scope =   let cap =         max@@ -295,7 +295,7 @@             then (Ur count, shiftSegmentBackward dec (end + 1) arr 0)             else (Ur count, arr)       | otherwise =-          Array.unsafeRead arr ix & \case+          case Array.unsafeRead arr ix of             (Ur Nothing, arr1) ->               mapAndPushBack (ix + 1) end (False, 0) count arr1             (Ur (Just (RobinVal (PSL p) k v)), arr1) -> case f' k v of@@ -397,7 +397,7 @@       HashMap k c     go _ hm (Ur []) acc = hm `lseq` acc     go f hm (Ur ((k, b) : xs)) acc =-      lookup k hm & \case+      case lookup k hm of         (Ur Nothing, hm') -> go f hm' (Ur xs) acc         (Ur (Just a), hm') -> go f hm' (Ur xs) (insert k (f a b) acc) @@ -446,7 +446,7 @@ -- | Check if the given key exists. member :: (Keyed k) => k -> HashMap k v %1 -> (Ur Bool, HashMap k v) member k hm =-  lookup k hm & \case+  case lookup k hm of     (Ur Nothing, hm') -> (Ur False, hm')     (Ur (Just _), hm') -> (Ur True, hm') @@ -557,7 +557,7 @@   Int ->   RobinArr k v shiftSegmentBackward dec s arr ix =-  Array.unsafeRead arr ix & \case+  case Array.unsafeRead arr ix of     (Ur Nothing, arr') -> arr'     (Ur (Just (RobinVal 0 _ _)), arr') -> arr'     (Ur (Just val), arr') ->

@@ -117,7 +117,7 @@ filter :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> [a] filter _ [] = [] filter p (x : xs) =-  dup x & \case+  case dup x of     (x', x'') ->       if p x'         then x'' : filter p xs@@ -149,10 +149,10 @@ span :: (Dupable a) => (a %1 -> Bool) -> [a] %1 -> ([a], [a]) span _ [] = ([], []) span f (x : xs) =-  dup x & \case+  case dup x of     (x', x'') ->       if f x'-        then span f xs & \case (ts, fs) -> (x'' : ts, fs)+        then case span f xs of (ts, fs) -> (x'' : ts, fs)         else ([x''], xs)  -- The partition function takes a predicate a list and returns the@@ -191,13 +191,13 @@ take :: (Consumable a) => Int -> [a] %1 -> [a] take _ [] = [] take i (x : xs)-  | i Prelude.< 0 = (x, xs) `lseq` []+  | i Prelude.<= 0 = (x, xs) `lseq` []   | otherwise = x : take (i - 1) xs  drop :: (Consumable a) => Int -> [a] %1 -> [a] drop _ [] = [] drop i (x : xs)-  | i Prelude.< 0 = x : xs+  | i Prelude.<= 0 = x : xs   | otherwise = x `lseq` drop (i - 1) xs  -- | The intersperse function takes an element and a list and@@ -310,7 +310,7 @@ 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+  case scanr f b as of     (b' : bs') ->       dup2 b' & \(b'', b''') ->         f a b'' : b''' : bs'@@ -322,7 +322,7 @@ scanr1 _ [] = [] scanr1 _ [a] = [a] scanr1 f (a : as) =-  scanr1 f as & \case+  case scanr1 f as of     (a' : as') ->       dup2 a' & \(a'', a''') ->         f a a'' : a''' : as'@@ -364,7 +364,7 @@ zipWith' _ (a : as) [] = ([], Just (Left (a :| as))) zipWith' _ [] (b : bs) = ([], Just (Right (b :| bs))) zipWith' f (a : as) (b : bs) =-  zipWith' f as bs & \case+  case zipWith' f as bs of     (cs, rest) -> (f a b : cs, rest)  zipWith3 :: forall a b c d. (Consumable a, Consumable b, Consumable c) => (a %1 -> b %1 -> c %1 -> d) -> [a] %1 -> [b] %1 -> [c] %1 -> [d]

@@ -126,14 +126,14 @@ instance (Consumable a) => Semigroup (Monoid.First a) where   (Monoid.First Nothing) <> y = y   x <> (Monoid.First y) =-    y & \case+    case y of       Nothing -> x       Just y' -> y' `lseq` x  instance (Consumable a) => Semigroup (Monoid.Last a) where   x <> (Monoid.Last Nothing) = x   (Monoid.Last x) <> y =-    x & \case+    case x of       Nothing -> y       Just x' -> x' `lseq` y @@ -174,7 +174,7 @@ instance (Consumable a, Consumable b) => Semigroup (Either a b) where   Left x <> y = x `lseq` y   x <> y =-    y & \case+    case y of       Left y' -> y' `lseq` x       Right y' -> y' `lseq` x 

@@ -42,8 +42,11 @@  -- TODO: flesh out laws +import qualified Data.Int import Data.Monoid.Linear import Data.Unrestricted.Linear+import qualified Data.Word+import GHC.Num.Natural (Natural) import qualified Unsafe.Linear as Unsafe import qualified Prelude @@ -208,38 +211,143 @@ instance (AddIdentity a) => Monoid (Sum a) where   mempty = Sum zero +{- ORMOLU_DISABLE -} deriving via MovableNum Prelude.Int instance Additive Prelude.Int--deriving via MovableNum Prelude.Double instance Additive Prelude.Double- deriving via MovableNum Prelude.Int instance AddIdentity Prelude.Int--deriving via MovableNum Prelude.Double instance AddIdentity Prelude.Double- deriving via MovableNum Prelude.Int instance AdditiveGroup Prelude.Int--deriving via MovableNum Prelude.Double instance AdditiveGroup Prelude.Double- deriving via MovableNum Prelude.Int instance Multiplicative Prelude.Int+deriving via MovableNum Prelude.Int instance MultIdentity Prelude.Int+deriving via MovableNum Prelude.Int instance Semiring Prelude.Int+deriving via MovableNum Prelude.Int instance Ring Prelude.Int+deriving via MovableNum Prelude.Int instance FromInteger Prelude.Int+deriving via MovableNum Prelude.Int instance Num Prelude.Int +deriving via MovableNum Prelude.Word instance Additive Prelude.Word+deriving via MovableNum Prelude.Word instance AddIdentity Prelude.Word+deriving via MovableNum Prelude.Word instance AdditiveGroup Prelude.Word+deriving via MovableNum Prelude.Word instance Multiplicative Prelude.Word+deriving via MovableNum Prelude.Word instance MultIdentity Prelude.Word+deriving via MovableNum Prelude.Word instance Semiring Prelude.Word+deriving via MovableNum Prelude.Word instance Ring Prelude.Word+deriving via MovableNum Prelude.Word instance FromInteger Prelude.Word+deriving via MovableNum Prelude.Word instance Num Prelude.Word++deriving via MovableNum Prelude.Double instance Additive Prelude.Double+deriving via MovableNum Prelude.Double instance AddIdentity Prelude.Double+deriving via MovableNum Prelude.Double instance AdditiveGroup Prelude.Double deriving via MovableNum Prelude.Double instance Multiplicative Prelude.Double+deriving via MovableNum Prelude.Double instance MultIdentity Prelude.Double+deriving via MovableNum Prelude.Double instance Semiring Prelude.Double+deriving via MovableNum Prelude.Double instance Ring Prelude.Double+deriving via MovableNum Prelude.Double instance FromInteger Prelude.Double+deriving via MovableNum Prelude.Double instance Num Prelude.Double -deriving via MovableNum Prelude.Int instance MultIdentity Prelude.Int+deriving via MovableNum Prelude.Float instance Additive Prelude.Float+deriving via MovableNum Prelude.Float instance AddIdentity Prelude.Float+deriving via MovableNum Prelude.Float instance AdditiveGroup Prelude.Float+deriving via MovableNum Prelude.Float instance Multiplicative Prelude.Float+deriving via MovableNum Prelude.Float instance MultIdentity Prelude.Float+deriving via MovableNum Prelude.Float instance Semiring Prelude.Float+deriving via MovableNum Prelude.Float instance Ring Prelude.Float+deriving via MovableNum Prelude.Float instance FromInteger Prelude.Float+deriving via MovableNum Prelude.Float instance Num Prelude.Float -deriving via MovableNum Prelude.Double instance MultIdentity Prelude.Double+deriving via MovableNum Prelude.Integer instance Additive Prelude.Integer+deriving via MovableNum Prelude.Integer instance AddIdentity Prelude.Integer+deriving via MovableNum Prelude.Integer instance AdditiveGroup Prelude.Integer+deriving via MovableNum Prelude.Integer instance Multiplicative Prelude.Integer+deriving via MovableNum Prelude.Integer instance MultIdentity Prelude.Integer+deriving via MovableNum Prelude.Integer instance Semiring Prelude.Integer+deriving via MovableNum Prelude.Integer instance Ring Prelude.Integer+deriving via MovableNum Prelude.Integer instance FromInteger Prelude.Integer+deriving via MovableNum Prelude.Integer instance Num Prelude.Integer -deriving via MovableNum Prelude.Int instance Semiring Prelude.Int+deriving via MovableNum Natural instance Additive Natural+deriving via MovableNum Natural instance AddIdentity Natural+deriving via MovableNum Natural instance AdditiveGroup Natural+deriving via MovableNum Natural instance Multiplicative Natural+deriving via MovableNum Natural instance MultIdentity Natural+deriving via MovableNum Natural instance Semiring Natural+-- NOTE: Natural is not a Ring; no element but 0 has an additive inverse.+deriving via MovableNum Natural instance FromInteger Natural -deriving via MovableNum Prelude.Double instance Semiring Prelude.Double+deriving via MovableNum Data.Int.Int8 instance Additive Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance AddIdentity Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance AdditiveGroup Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance Multiplicative Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance MultIdentity Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance Semiring Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance Ring Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance FromInteger Data.Int.Int8+deriving via MovableNum Data.Int.Int8 instance Num Data.Int.Int8 -deriving via MovableNum Prelude.Int instance Ring Prelude.Int+deriving via MovableNum Data.Int.Int16 instance Additive Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance AddIdentity Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance AdditiveGroup Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance Multiplicative Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance MultIdentity Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance Semiring Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance Ring Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance FromInteger Data.Int.Int16+deriving via MovableNum Data.Int.Int16 instance Num Data.Int.Int16 -deriving via MovableNum Prelude.Double instance Ring Prelude.Double+deriving via MovableNum Data.Int.Int32 instance Additive Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance AddIdentity Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance AdditiveGroup Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance Multiplicative Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance MultIdentity Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance Semiring Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance Ring Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance FromInteger Data.Int.Int32+deriving via MovableNum Data.Int.Int32 instance Num Data.Int.Int32 -deriving via MovableNum Prelude.Int instance FromInteger Prelude.Int+deriving via MovableNum Data.Int.Int64 instance Additive Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance AddIdentity Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance AdditiveGroup Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance Multiplicative Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance MultIdentity Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance Semiring Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance Ring Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance FromInteger Data.Int.Int64+deriving via MovableNum Data.Int.Int64 instance Num Data.Int.Int64 -deriving via MovableNum Prelude.Double instance FromInteger Prelude.Double+deriving via MovableNum Data.Word.Word8 instance Additive Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance AddIdentity Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance AdditiveGroup Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance Multiplicative Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance MultIdentity Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance Semiring Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance Ring Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance FromInteger Data.Word.Word8+deriving via MovableNum Data.Word.Word8 instance Num Data.Word.Word8 -deriving via MovableNum Prelude.Int instance Num Prelude.Int+deriving via MovableNum Data.Word.Word16 instance Additive Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance AddIdentity Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance AdditiveGroup Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance Multiplicative Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance MultIdentity Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance Semiring Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance Ring Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance FromInteger Data.Word.Word16+deriving via MovableNum Data.Word.Word16 instance Num Data.Word.Word16 -deriving via MovableNum Prelude.Double instance Num Prelude.Double+deriving via MovableNum Data.Word.Word32 instance Additive Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance AddIdentity Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance AdditiveGroup Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance Multiplicative Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance MultIdentity Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance Semiring Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance Ring Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance FromInteger Data.Word.Word32+deriving via MovableNum Data.Word.Word32 instance Num Data.Word.Word32++deriving via MovableNum Data.Word.Word64 instance Additive Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance AddIdentity Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance AdditiveGroup Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance Multiplicative Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance MultIdentity Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance Semiring Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance Ring Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance FromInteger Data.Word.Word64+deriving via MovableNum Data.Word.Word64 instance Num Data.Word.Word64+{- ORMOLU_ENABLE -}

@@ -115,7 +115,7 @@   compare xs [] = xs `lseq` GT   compare [] ys = ys `lseq` LT   compare (x : xs) (y : ys) =-    compare x y & \case+    case compare x y of       EQ -> compare xs ys       res -> (xs, ys) `lseq` res 

@@ -89,7 +89,7 @@ next :: Replicator a %1 -> (a, Replicator a) next (Moved x) = (x, Moved x) next (Streamed (ReplicationStream s give dups consumes)) =-  dups s & \case+  case dups s of     (s1, s2) -> (give s1, Streamed (ReplicationStream s2 give dups consumes)) {-# INLINEABLE next #-} @@ -98,18 +98,18 @@ next# :: Replicator a %1 -> (# a, Replicator a #) next# (Moved x) = (# x, Moved x #) next# (Streamed (ReplicationStream s give dups consumes)) =-  dups s & \case+  case dups s of     (s1, s2) -> (# give s1, Streamed (ReplicationStream s2 give dups consumes) #) {-# INLINEABLE next# #-}  -- | @'take' n as@ is a list of size @n@, containing @n@ replicas from @as@. take :: Prelude.Int -> Replicator a %1 -> [a] take 0 r =-  consume r & \case+  case consume r of     () -> [] take 1 r = [extract r] take n r =-  next r & \case+  case next r of     (a, r') -> a : take (n - 1) r'  -- | Returns the next item from @'Replicator' a@ and efficiently consumes@@ -170,7 +170,7 @@  instance Elim 'Z a b where   elim' b r =-    consume r & \case+    case consume r of       () -> b   {-# INLINE elim' #-} @@ -180,6 +180,6 @@  instance (Elim ('S n) a b) => Elim ('S ('S n)) a b where   elim' g r =-    next r & \case+    case next r of       (a, r') -> elim' @('S n) (g a) r'   {-# INLINE elim' #-}

@@ -70,11 +70,11 @@     (sf, sx)     (\(sf', sx') -> givef sf' (givex sx'))     ( \(sf', sx') ->-        (dupsf sf', dupsx sx') & \case+        case (dupsf sf', dupsx sx') of           ((sf1, sf2), (sx1, sx2)) -> ((sf1, sx1), (sf2, sx2))     )     ( \(sf', sx') ->-        consumesf sf' & \case+        case consumesf sf' of           () -> consumesx sx'     ) @@ -84,11 +84,11 @@     (sa, sb)     (\(sa', sb') -> f (givea sa') (giveb sb'))     ( \(sa', sb') ->-        (dupsa sa', dupsb sb') & \case+        case (dupsa sa', dupsb sb') of           ((sa1, sa2), (sb1, sb2)) -> ((sa1, sb1), (sa2, sb2))     )     ( \(sa', sb') ->-        consumesa sa' & \case+        case consumesa sa' of           () -> consumesb sb'     ) -- We need to inline this to get good results with generic deriving

@@ -29,8 +29,8 @@ -- # Constructors and Mutators ------------------------------------------------------------------------------- -empty :: (Keyed a) => Int -> (Set a %1 -> Ur b) %1 -> Ur b-empty s (f :: Set a %1 -> Ur b) =+empty :: (Keyed a, Movable b) => Int -> (Set a %1 -> b) %1 -> b+empty s (f :: Set a %1 -> b) =   Linear.empty s (\hm -> f (Set hm))  toList :: (Keyed a) => Set a %1 -> Ur [a]@@ -63,7 +63,7 @@ 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, Movable b) => [a] -> (Set a %1 -> b) %1 -> b fromList xs f =   Linear.fromList (Prelude.map (,()) xs) (\hm -> f (Set hm)) 

@@ -4,7 +4,7 @@ -- = /Critical/ Definition: Restricted -- -- In a linear function @f :: a %1-> b@, the argument @a@ must--- be used in a linear way. Its use is __restricted__ while+-- be used in a linear way. Its use is __restricted__. By contrast, -- an argument in a non-linear function is __unrestricted__. -- -- Hence, a linear function with an argument of @Ur a@ (@Ur@ is short for

@@ -33,6 +33,8 @@ import qualified Data.V.Linear.Internal as V import qualified Data.Vector as Vector import GHC.Int+import GHC.Num.Integer (Integer (..))+import GHC.Num.Natural (Natural (..)) import GHC.TypeLits import GHC.Word import Prelude.Linear.Internal@@ -45,17 +47,17 @@  instance (Movable a) => Movable (AsMovable a) where   move (AsMovable x) =-    move x & \case+    case move x of       Ur x' -> Ur (AsMovable x')  instance (Movable a) => Consumable (AsMovable a) where   consume x =-    move x & \case+    case move x of       Ur _ -> ()  instance (Movable a) => Dupable (AsMovable a) where   dupR x =-    move x & \case+    case move x of       Ur x' -> Data.pure x'  deriving via (AsMovable Int8) instance Consumable Int8@@ -146,6 +148,33 @@   -- copying an 'Word64#' and using it several times. /!\   move (W64# i) = Unsafe.toLinear (\j -> Ur (W64# j)) i +deriving via (AsMovable Integer) instance Consumable Integer++deriving via (AsMovable Integer) instance Dupable Integer++instance Movable Integer where+  -- /!\ 'Integer' is a sum type whose three possibilities each are strict wrappers of unboxed unlifed data types.+  -- (source: https://hackage.haskell.org/package/ghc-bignum-1.2/docs/GHC-Num-Integer.html#t:Integer)+  -- Therefore it cannot have any linear values hidden in a closure anywhere. Therefore it is safe to call+  -- non-linear functions linearly on this type: there is no difference between+  -- copying an 'Integer' and using it several times. /!\+  move (IS i) = Unsafe.toLinear (\j -> Ur (IS j)) i+  move (IP i) = Unsafe.toLinear (\j -> Ur (IP j)) i+  move (IN i) = Unsafe.toLinear (\j -> Ur (IN j)) i++deriving via (AsMovable Natural) instance Consumable Natural++deriving via (AsMovable Natural) instance Dupable Natural++instance Movable Natural where+  -- /!\ 'Natural' is a sum type whose two possibilities each are strict wrappers of unboxed unlifed data types.+  -- (source: https://hackage.haskell.org/package/ghc-bignum-1.2/docs/GHC-Num-Natural.html#t:Natural)+  -- Therefore it cannot have any linear values hidden in a closure anywhere. Therefore it is safe to call+  -- non-linear functions linearly on this type: there is no difference between+  -- copying an 'Integer' and using it several times. /!\+  move (NS i) = Unsafe.toLinear (\j -> Ur (NS j)) i+  move (NB i) = Unsafe.toLinear (\j -> Ur (NB j)) i+ -- TODO: instances for longer primitive tuples -- TODO: default instances based on the Generic framework @@ -157,7 +186,8 @@  instance (KnownNat n, Dupable a) => Dupable (V n a) where   dupR (V xs) =-    V . Unsafe.toLinear (Vector.fromListN (V.theLength @n))+    V+      . Unsafe.toLinear (Vector.fromListN (V.theLength @n))       Data.<$> dupR (Unsafe.toLinear Vector.toList xs)  -- Some stock instances

@@ -172,15 +172,15 @@   gmove U1 = Ur U1  instance (GMovable f, GMovable g) => GMovable (f :+: g) where-  gmove (L1 a) = gmove a & \case (Ur x) -> Ur (L1 x)-  gmove (R1 a) = gmove a & \case (Ur x) -> Ur (R1 x)+  gmove (L1 a) = case gmove a of Ur x -> Ur (L1 x)+  gmove (R1 a) = case gmove a of Ur x -> Ur (R1 x)  instance (GMovable f, GMovable g) => GMovable (f :*: g) where   gmove (a :*: b) =-    gmove a & \case-      (Ur x) ->-        gmove b & \case-          (Ur y) -> Ur (x :*: y)+    case gmove a of+      Ur x ->+        case gmove b of+          Ur y -> Ur (x :*: y)  instance (Movable c) => GMovable (K1 i c) where   gmove (K1 c) = lcoerce (move c)@@ -192,7 +192,7 @@   gmove (MP1 x) = Ur (MP1 x)  instance (GMovable f) => GMovable (MP1 'One f) where-  gmove (MP1 a) = gmove a & \case Ur x -> Ur (MP1 x)+  gmove (MP1 a) = case gmove a of Ur x -> Ur (MP1 x)  instance GMovable UChar where   gmove (UChar c) = Unsafe.toLinear (\x -> Ur (UChar x)) c

@@ -78,8 +78,8 @@  (<*>) :: V n (a %1 -> b) %1 -> V n a %1 -> V n b (V fs) <*> (V xs) =-  V $-    Unsafe.toLinear2 (Vector.zipWith (\f x -> f $ x)) fs xs+  V+    $ Unsafe.toLinear2 (Vector.zipWith (\f x -> f $ x)) fs xs  infixl 4 <*> -- same fixity as base.<*> @@ -145,13 +145,13 @@  instance Elim 'Z a b where   elim' b v =-    consume v & \case+    case consume v of       () -> b   {-# INLINE elim' #-}  instance (1 <= 1 + PeanoToNat n, (1 + PeanoToNat n) - 1 ~ PeanoToNat n, Elim n a b) => Elim ('S n) a b where   elim' g v =-    uncons v & \case+    case uncons v of       (a, v') -> elim' @n (g a) v'   {-# INLINE elim' #-} 

@@ -56,17 +56,17 @@     & \(Ur size', arr') -> Vec size' arr'  -- Allocate an empty vector-empty :: (Vector a %1 -> Ur b) %1 -> Ur b+empty :: (Movable b) => (Vector a %1 -> b) %1 -> b empty f = Array.fromList [] (f . fromArray)  -- | Allocate a constant vector of a given non-negative size (and error on a -- bad size) constant ::-  (HasCallStack) =>+  (HasCallStack, Movable b) =>   Int ->   a ->-  (Vector a %1 -> Ur b) %1 ->-  Ur b+  (Vector a %1 -> b) %1 ->+  b constant size' x f   | size' < 0 =       (error ("Trying to construct a vector of size " ++ show size') :: x %1 -> x)@@ -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, Movable b) => [a] -> (Vector a %1 -> b) %1 -> b fromList xs f = Array.fromList xs (f . fromArray)  -- | Number of elements inside the vector.@@ -101,7 +101,7 @@ -- 'shrinkToFit' to remove the wasted space. pop :: Vector a %1 -> (Ur (Maybe a), Vector a) pop vec =-  size vec & \case+  case size vec of     (Ur 0, vec') ->       (Ur Nothing, vec')     (Ur s, vec') ->@@ -201,7 +201,7 @@       -- Otherwise, read an element, write if the predicate is true and advance       -- the write cursor; otherwise keep the write cursor skipping the element.       | otherwise =-          unsafeGet r vec' & \case+          case unsafeGet r vec' of             (Ur a, vec'')               | Just b <- f a ->                   go (r + 1) (w + 1) s (unsafeSet w (Unsafe.coerce b) vec'')

@@ -29,10 +29,10 @@ import Foreign.Ptr import Foreign.Storable import Foreign.Storable.Tuple ()-import Prelude.Linear hiding (Eq (..), ($))+import Prelude.Linear hiding (Eq (..)) import System.IO.Unsafe import qualified Unsafe.Linear as Unsafe-import Prelude (Eq (..), return, ($), (<$>), (<*>), (=<<))+import Prelude (Eq (..), return, (<$>), (<*>), (=<<))  -- XXX: [2018-02-09] I'm having trouble with the `constraints` package (it seems -- that the version of Type.Reflection.Unsafe in the linear ghc compiler is not@@ -290,12 +290,12 @@ -- TODO: document individual functions  -- | Given a linear computation that manages memory, run that computation.-withPool :: (Pool %1 -> Ur b) %1 -> Ur b-withPool scope = Unsafe.toLinear performScope scope+withPool :: forall b. (Movable b) => (Pool %1 -> b) %1 -> b+withPool scope = unur $ Unsafe.toLinear performScope scope   where     -- XXX: do ^ without `toLinear` by using linear IO -    performScope :: (Pool %1 -> Ur b) -> Ur b+    performScope :: (Pool %1 -> b) -> Ur b     performScope scope' = unsafeDupablePerformIO $ do       -- Initialise the pool       backPtr <- malloc@@ -303,7 +303,7 @@       start <- DLL nullPtr nullPtr <$> new end -- always at the start of the list       poke backPtr start       -- Run the computation-      evaluate (scope' (Pool start))+      evaluate (move $ scope' (Pool start))         `finally`         -- Clean up remaining variables.         (freeAll start end)

@@ -65,7 +65,7 @@ import Data.Functor.Sum import Data.Unrestricted.Linear import GHC.Stack-import Prelude.Linear (($), (&), (.))+import Prelude.Linear (($), (.)) import Streaming.Linear.Internal.Process (destroyExposed) import Streaming.Linear.Internal.Type import qualified Streaming.Prelude.Linear as Stream@@ -244,7 +244,7 @@       Stream f m r     unfold' step state = Effect $ Control.do       either <- step state-      either & \case+      case either of         Left r -> Control.return $ Return r         Right (fs) -> Control.return $ Step $ Control.fmap (unfold step) fs {-# INLINEABLE unfold #-}@@ -261,7 +261,7 @@     loop :: Stream f m r     loop = Effect $ Control.do       maybeVal <- action-      maybeVal & \case+      case maybeVal of         Nothing -> Control.return $ Step $ Data.pure loop         Just r -> Control.return $ Return r {-# INLINEABLE untilJust #-}@@ -344,7 +344,7 @@   where     loop :: Stream f m r %1 -> Stream g m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Step f -> Effect $ Control.fmap Step $ transform $ Control.fmap loop f         Effect m -> Effect $ Control.fmap loop m@@ -461,10 +461,10 @@     loop :: Stream (Sum f g) m r %1 -> Stream (Sum (Stream f m) (Stream g m)) m r     loop str = Control.do       e <- Control.lift $ inspect str-      e & \case+      case e of         Left r -> Control.return r         Right ostr ->-          ostr & \case+          case ostr of             InR gstr -> Step $ InR $ Control.fmap loop $ cleanR (Step (InR gstr))             InL fstr -> Step $ InL $ Control.fmap loop $ cleanL (Step (InL fstr)) @@ -474,7 +474,7 @@         go :: Stream (Sum f g) m r %1 -> Stream f m (Stream (Sum f g) m r)         go s = Control.do           e <- Control.lift $ inspect s-          e & \case+          case e of             Left r -> Control.return $ Control.return r             Right (InL fstr) -> Step $ Control.fmap go fstr             Right (InR gstr) -> Control.return $ Step (InR gstr)@@ -485,7 +485,7 @@         go :: Stream (Sum f g) m r %1 -> Stream g m (Stream (Sum f g) m r)         go s = Control.do           e <- Control.lift $ inspect s-          e & \case+          case e of             Left r -> Control.return $ Control.return r             Right (InL fstr) -> Control.return $ Step (InL fstr)             Right (InR gstr) -> Step $ Control.fmap go gstr@@ -509,7 +509,7 @@   where     loop :: Stream f m r %1 -> m (Either r (f (Stream f m r)))     loop stream =-      stream & \case+      case stream of         Return r -> Control.return (Left r)         Effect m -> m Control.>>= loop         Step fs -> Control.return (Right fs)@@ -552,7 +552,7 @@       LT -> Prelude.error "splitsAt called with negative index" $ stream       EQ -> Return stream       GT ->-        stream & \case+        case stream of           Return r -> Return $ Return r           Effect m -> Effect $ Control.fmap (loop n) m           Step f -> Step $ Control.fmap (loop (n - 1)) f@@ -587,7 +587,7 @@   where     loop :: Stream (Stream f m) m r %1 -> Stream f m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step f -> Control.do@@ -612,7 +612,7 @@   where     go0 :: Stream (t m) m r %1 -> t m r     go0 f =-      f & \case+      case f of         Return r -> Control.return r         Effect m -> Control.lift m Control.>>= go0         Step fstr -> Control.do@@ -621,7 +621,7 @@      go1 :: Stream (t m) m r %1 -> t m r     go1 f =-      f & \case+      case f of         Return r -> Control.return r         Effect m -> Control.lift m Control.>>= go1         Step fstr -> Control.do@@ -736,7 +736,7 @@   where     loop :: Stream (Compose m f) m r %1 -> Stream f m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (Compose mfs) -> Effect $ Control.do@@ -814,7 +814,7 @@   where     loop :: (Control.Monad m) => Stream m m r %1 -> m r     loop stream =-      stream & \case+      case stream of         Return r -> Control.return r         Effect m -> m Control.>>= loop         Step mrest -> mrest Control.>>= loop@@ -915,7 +915,7 @@   where     loop :: Stream f m r %1 -> m b     loop stream =-      stream & \case+      case stream of         Return r -> Control.return $ done r         Effect m -> m Control.>>= loop         Step f -> Control.return $ construct $ Control.fmap (theEffect . loop) f

@@ -68,7 +68,7 @@ import qualified Data.Text as Text import qualified Data.Text.IO as Text import Data.Unrestricted.Linear-import Prelude.Linear (($), (&), (.))+import Prelude.Linear (($), (.)) import Streaming.Linear.Internal.Process import Streaming.Linear.Internal.Type import qualified System.IO as System@@ -112,7 +112,7 @@   where     loop :: Stream (Of Text) IO r %1 -> IO r     loop stream =-      stream & \case+      case stream of         Return r -> Control.return r         Effect ms -> ms Control.>>= stdoutLn'         Step (str :> stream) -> Control.do@@ -130,7 +130,7 @@   where     loop :: Handle %1 -> Stream (Of Text) RIO r %1 -> RIO (r, Handle)     loop handle stream =-      stream & \case+      case stream of         Return r -> Control.return (r, handle)         Effect ms -> ms Control.>>= toHandle handle         Step (text :> stream') -> Control.do@@ -170,7 +170,7 @@   where     loop :: Stream (Of a) m r %1 -> m r     loop stream =-      stream & \case+      case stream of         Return r -> Control.return r         Effect ms -> ms Control.>>= effects         Step (_ :> stream') -> effects stream'@@ -182,7 +182,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream Identity m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Step (_ :> stream') -> Step $ Identity (erase stream')         Effect ms -> Effect $ ms Control.>>= (Control.return . erase)@@ -242,7 +242,7 @@   where     loop :: Stream (Of a) m r %1 -> m r     loop stream =-      stream & \case+      case stream of         Return r -> Control.return r         Effect ms -> ms Control.>>= mapM_ f         Step (a :> stream') -> Control.do@@ -302,7 +302,7 @@   where     loop :: Stream (Of a) m r %1 -> m (Of b r)     loop stream =-      stream & \case+      case stream of         Return r -> Control.return $ g x :> r         Effect ms -> ms Control.>>= fold f x g         Step (a :> stream') -> fold f (f x a) g stream'@@ -335,7 +335,7 @@   where     loop :: Stream (Of a) m r %1 -> m b     loop stream =-      stream & \case+      case stream of         Return r -> lseq r $ Control.return $ g x         Effect ms -> ms Control.>>= fold_ f x g         Step (a :> stream') -> fold_ f (f x a) g stream'@@ -370,7 +370,7 @@   where     loop :: Stream (Of a) m r %1 -> m (b, r)     loop stream =-      stream & \case+      case stream of         Return r -> mx Control.>>= g Control.>>= (\b -> Control.return (b, r))         Effect ms -> ms Control.>>= foldM f mx g         Step (a :> stream') -> foldM f (mx Control.>>= \x -> f x a) g stream'@@ -391,7 +391,7 @@   where     loop :: Stream (Of a) m r %1 -> m b     loop stream =-      stream & \case+      case stream of         Return r -> lseq r $ mx Control.>>= g         Effect ms -> ms Control.>>= foldM_ f mx g         Step (a :> stream') -> foldM_ f (mx Control.>>= \x -> f x a) g stream'@@ -464,7 +464,7 @@ -- first element, performing all monadic effects via 'effects' head :: (Control.Monad m) => Stream (Of a) m r %1 -> m (Of (Maybe a) r) head str =-  str & \case+  case str of     Return r -> Control.return (Nothing :> r)     Effect m -> m Control.>>= head     Step (a :> rest) ->@@ -475,7 +475,7 @@ -- first element, performing all monadic effects via 'effects' head_ :: (Consumable r, Control.Monad m) => Stream (Of a) m r %1 -> m (Maybe a) head_ str =-  str & \case+  case str of     Return r -> lseq r $ Control.return Nothing     Effect m -> m Control.>>= head_     Step (a :> rest) ->@@ -491,7 +491,7 @@       Stream (Of a) m r %1 ->       m (Of (Maybe a) r)     loop m s =-      s & \case+      case s of         Return r -> Control.return (m :> r)         Effect m -> m Control.>>= last         Step (a :> rest) -> loop (Just a) rest@@ -506,7 +506,7 @@       Stream (Of a) m r %1 ->       m (Maybe a)     loop m s =-      s & \case+      case s of         Return r -> lseq r $ Control.return m         Effect m -> m Control.>>= last_         Step (a :> rest) -> loop (Just a) rest@@ -522,7 +522,7 @@   where     loop :: Stream (Of a) m r %1 -> m (Of Bool r)     loop stream =-      stream & \case+      case stream of         Return r -> Control.return $ False :> r         Effect ms -> ms Control.>>= elem a         Step (a' :> stream') -> case a == a' of@@ -542,7 +542,7 @@   where     loop :: Stream (Of a) m r %1 -> m Bool     loop stream =-      stream & \case+      case stream of         Return r -> lseq r $ Control.return False         Effect ms -> ms Control.>>= elem_ a         Step (a' :> stream') -> case a == a' of@@ -681,7 +681,7 @@   where     loop :: Stream (Of a) m r %1 -> m r     loop stream =-      stream & \case+      case stream of         Return r -> Control.return r         Effect m -> m Control.>>= foldrM step         Step (a :> as) -> step a (foldrM step as)@@ -702,7 +702,7 @@   where     loop :: Stream (Of a) m r %1 -> t m r     loop stream =-      stream & \case+      case stream of         Return r -> Control.return r         Effect ms -> (Control.lift ms) Control.>>= foldrT step         Step (a :> as) -> step a (foldrT step as)

@@ -36,7 +36,7 @@ where  import qualified Control.Functor.Linear as Control-import Prelude.Linear (($), (&))+import Prelude.Linear (($)) import Streaming.Linear.Internal.Consume import Streaming.Linear.Internal.Type import Prelude (Either (..), Ord (..), Ordering (..))@@ -115,7 +115,7 @@       Stream (Of (a, b)) m r %1 ->       Stream (Of a) (Stream (Of b) m) r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop $ Control.lift m         Step ((a, b) :> rest) -> Step (a :> Effect (Step (b :> Return (loop rest))))@@ -169,14 +169,14 @@       Stream (Of b) m r2 %1 ->       Stream (Of c) m (ZipResidual a b m r1 r2)     loop f st1 st2 =-      st1 & \case+      case st1 of         Effect ms -> Effect $ Control.fmap (\s -> loop f s st2) ms         Return r1 ->-          st2 & \case+          case st2 of             Return r2 -> Return $ Left3 (r1, r2)             st2' -> Return $ Middle3 (r1, st2')         Step (a :> as) ->-          st2 & \case+          case st2 of             Effect ms ->               Effect $ Control.fmap (\s -> loop f (Step (a :> as)) s) ms             Return r2 -> Return $ Right3 (Step (a :> as), r2)@@ -191,7 +191,7 @@   Stream (Of c) m (r1, r2) zipWith f s1 s2 = Control.do   result <- zipWithR f s1 s2-  result & \case+  case result of     Left3 rets -> Control.return rets     Middle3 (r1, s2') -> Control.do       r2 <- Control.lift $ effects s2'@@ -251,20 +251,20 @@       Stream (Of c) m r3 %1 ->       Stream (Of d) m (ZipResidual3 a b c m r1 r2 r3)     loop f s1 s2 s3 =-      s1 & \case+      case s1 of         Effect ms -> Effect $ Control.fmap (\s -> loop f s s2 s3) ms         Return r1 ->-          (s2, s3) & \case+          case (s2, s3) of             (Return r2, Return r3) -> Return (Left r1, Left r2, Left r3)             (s2', s3') -> Return (Left r1, Right s2', Right s3')         Step (a :> as) ->-          s2 & \case+          case s2 of             Effect ms ->               Effect $                 Control.fmap (\s -> loop f (Step $ a :> as) s s3) ms             Return r2 -> Return (Right (Step $ a :> as), Left r2, Right s3)             Step (b :> bs) ->-              s3 & \case+              case s3 of                 Effect ms ->                   Effect $                     Control.fmap (\s -> loop f (Step $ a :> as) (Step $ b :> bs) s) ms@@ -283,7 +283,7 @@   Stream (Of d) m (r1, r2, r3) zipWith3 f s1 s2 s3 = Control.do   result <- zipWith3R f s1 s2 s3-  result & \case+  case result of     (res1, res2, res3) -> Control.do       r1 <- Control.lift $ extractResult res1       r2 <- Control.lift $ extractResult res2@@ -377,14 +377,14 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m s %1 -> Stream (Of a) m (r, s)     loop s1 s2 =-      s1 & \case+      case s1 of         Return r ->           Effect $ effects s2 Control.>>= \s -> Control.return $ Return (r, s)         Effect ms ->           Effect $             ms Control.>>= \s1' -> Control.return $ mergeBy comp s1' s2         Step (a :> as) ->-          s2 & \case+          case s2 of             Return s ->               Effect $ effects as Control.>>= \r -> Control.return $ Return (r, s)             Effect ms ->

@@ -96,7 +96,7 @@ import qualified Data.Set as Set import Data.Unrestricted.Linear import GHC.Stack-import Prelude.Linear (($), (&), (.))+import Prelude.Linear (($), (.)) import Streaming.Linear.Internal.Type import System.IO.Linear import Text.Read (readMaybe)@@ -128,7 +128,7 @@   Stream (Stream (Of a) m) m r %1 ->   Stream (Stream (Of a) m) m r consFirstChunk a stream =-  stream & \case+  case stream of     Return r -> Step (Step (a :> Return (Return r)))     Effect m -> Effect $ Control.fmap (consFirstChunk a) m     Step f -> Step (Step (a :> f))@@ -151,7 +151,7 @@       Stream f m r %1 ->       b     loop stream =-      stream & \case+      case stream of         Return r -> done r         Effect m -> theEffect (Control.fmap loop m)         Step f -> construct (Control.fmap loop f)@@ -180,7 +180,7 @@   where     loop :: Stream (Of a) m r %1 -> m (Either r (Ur a, Stream (Of a) m r))     loop stream =-      stream & \case+      case stream of         Return r -> Control.return $ Left r         Effect ms -> ms Control.>>= next         Step (a :> as) -> Control.return $ Right (Ur a, as)@@ -196,7 +196,7 @@   where     loop :: Stream (Of a) m r %1 -> m (Maybe (a, Stream (Of a) m r))     loop stream =-      stream & \case+      case stream of         Return r -> lseq r $ Control.return Nothing         Effect ms -> ms Control.>>= uncons         Step (a :> as) -> Control.return $ Just (a, as)@@ -219,7 +219,7 @@     loop :: Int -> Stream f m r %1 -> Stream f m (Stream f m r)     loop n stream = case Prelude.compare n 0 of       GT ->-        stream & \case+        case stream of           Return r -> Return (Return r)           Effect m -> Effect $ m Control.>>= (Control.return . splitAt n)           Step f -> Step $ Control.fmap (splitAt (n - 1)) f@@ -244,7 +244,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ m Control.>>= (Control.return . split x)         Step (a :> as) -> case a == x of@@ -273,7 +273,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)     loop stream =-      stream & \case+      case stream of         Return r -> Return (Return r)         Effect m -> Effect $ Control.fmap (break f) m         Step (a :> as) -> case f a of@@ -303,7 +303,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (breaks f) m         Step (a :> as) -> case f a of@@ -347,7 +347,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m (Stream (Of a) m r)     loop stream =-      stream & \case+      case stream of         Return r -> Return (Return r)         Effect m -> Effect $ Control.fmap (breakWhen step x end pred) m         Step (a :> as) -> case pred (end (step x a)) of@@ -395,11 +395,11 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Stream (Of a) m) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (groupBy equals) m         Step (a :> as) ->-          as & \case+          case as of             Return r -> Step (Step (a :> Return (Return r)))             Effect m ->               Effect $@@ -523,7 +523,7 @@   where     fromSum :: Sum f g (Stream f (Stream g m) r) %1 -> (Stream f (Stream g m) r)     fromSum x =-      x & \case+      case x of         InL fss -> Step fss         InR gss -> Effect (Step $ Control.fmap Return gss) {-# INLINEABLE separate #-}@@ -551,7 +551,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect (Control.fmap loop (Control.lift m))         Step (a :> as) -> case pred a of@@ -576,7 +576,7 @@       Stream (Of (Either a b)) m r %1 ->       Stream (Of a) (Stream (Of b) m) r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop (Control.lift m)         Step (Left a :> as) -> Step (a :> loop as)@@ -593,7 +593,7 @@   where     loop :: (Control.Monad m) => Stream (Of (Maybe a)) m r %1 -> Stream (Of a) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap catMaybes m         Step (maybe :> as) -> case maybe of@@ -614,7 +614,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of b) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect ms -> Effect $ ms Control.>>= (Control.return . mapMaybe f)         Step (a :> s) -> case f a of@@ -639,12 +639,12 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of b) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (mapMaybeM f) m         Step (a :> as) -> Effect $ Control.do           mb <- f a-          mb & \case+          case mb of             Nothing -> Control.return $ mapMaybeM f as             Just (Ur b) -> Control.return $ Step (b :> mapMaybeM f as) {-# INLINEABLE mapMaybeM #-}@@ -668,7 +668,7 @@   where     loop :: Stream f m r %1 -> Stream f n r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ f $ Control.fmap loop m         Step f -> Step $ Control.fmap loop f@@ -706,7 +706,7 @@   where     loop :: Stream f m r %1 -> Stream g m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (maps phi) m         Step f -> Step (phi (Control.fmap loop f))@@ -745,7 +745,7 @@       Stream (Of a) m r %1 ->       Stream (Of b) m r     loop f stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (loop f) m         Step (a :> as) -> Effect $ Control.do@@ -773,7 +773,7 @@   where     loop :: Stream f m r %1 -> Stream g m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step f -> Step $ Control.fmap loop $ phi f@@ -825,7 +825,7 @@   where     loop :: Stream f m r %1 -> Stream g m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step f -> Effect $ Control.fmap Step $ phi $ Control.fmap loop f@@ -854,7 +854,7 @@   where     loop :: Stream f m r %1 -> Stream g m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step f -> Effect $ Control.fmap (Step . Control.fmap loop) $ phi f@@ -873,7 +873,7 @@   where     loop :: Stream f m r %1 -> Stream g m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step f -> Effect $ Control.fmap (Step . Control.fmap loop) $ phi f@@ -891,7 +891,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream f m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (a :> as) -> Control.do@@ -929,7 +929,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream f m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (a :> as) -> Step $ Control.fmap (`lseq` (loop as)) (f a)@@ -1060,7 +1060,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) (Stream (Of a) m) r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop (Control.lift m)         Step (a :> as) -> Effect $ Step (a :> Return (Step (a :> loop as)))@@ -1193,7 +1193,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (a :> as) -> Effect $ Control.do@@ -1221,7 +1221,7 @@   where     loop :: Stream (Of (m (Ur a))) m r %1 -> Stream (Of a) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (ma :> mas) -> Effect $ Control.do@@ -1246,7 +1246,7 @@   where     loop :: Set.Set b -> Stream (Of a) m r %1 -> Stream (Of a) m r     loop !set stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (loop set) m         Step (a :> as) -> case Set.member (f a) set of@@ -1268,7 +1268,7 @@   where     loop :: IntSet.IntSet -> Stream (Of a) m r %1 -> Stream (Of a) m r     loop !set stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (loop set) m         Step (a :> as) -> case IntSet.member (f a) set of@@ -1286,7 +1286,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (a :> as) -> case pred a of@@ -1305,12 +1305,12 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (a :> as) -> Effect $ Control.do           bool <- pred a-          bool & \case+          case bool of             True -> Control.return $ Step (a :> loop as)             False -> Control.return $ loop as {-# INLINE filterM #-}@@ -1332,7 +1332,7 @@   Stream (Of a) m r %1 ->   Stream (Of a) m r intersperse x stream =-  stream & \case+  case stream of     Return r -> Return r     Effect m -> Effect $ Control.fmap (intersperse x) m     Step (a :> as) -> loop a as@@ -1341,7 +1341,7 @@     -- element named 'x'     loop :: a -> Stream (Of a) m r %1 -> Stream (Of a) m r     loop !a stream =-      stream & \case+      case stream of         Return r -> Step (a :> Return r)         Effect m -> Effect $ Control.fmap (loop a) m         Step (a' :> as) -> Step (a :> Step (x :> loop a' as))@@ -1379,7 +1379,7 @@     where       loop :: Stream (Of a) m r %1 -> Stream (Of a) m r       loop stream =-        stream & \case+        case stream of           Return r -> Return r           Effect m -> Effect $ Control.fmap (drop n) m           Step (_ :> as) -> drop (n - 1) as@@ -1407,7 +1407,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of a) m r     loop stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap loop m         Step (a :> as) -> case pred a of@@ -1448,7 +1448,7 @@   where     loop :: x -> Stream (Of a) m r %1 -> Stream (Of b) m r     loop !acc stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (loop acc) m         Step (a :> as) -> Step (done acc' :> loop acc' as)@@ -1486,7 +1486,7 @@   where     loop :: Stream (Of a) m r %1 -> Stream (Of b) m r     loop stream =-      stream & \case+      case stream of         Return r -> Effect $ Control.do           Ur x <- mx           Ur b <- done x@@ -1525,7 +1525,7 @@   where     loop :: x -> Stream (Of a) m r %1 -> Stream (Of (a, b)) m r     loop !x stream =-      stream & \case+      case stream of         Return r -> Return r         Effect m -> Effect $ Control.fmap (loop x) m         Step (a :> as) -> Control.do@@ -1562,7 +1562,7 @@     loop :: Stream (Of a) IO r %1 -> Stream (Of a) IO r     loop stream = Control.do       e <- Control.lift $ next stream-      e & \case+      case e of         Left r -> Return r         Right (Ur a, rest) -> Control.do           Step (a :> Return ()) -- same as yield@@ -1605,7 +1605,7 @@   Stream f m r %1 ->   Stream f m r wrapEffect ma action stream =-  stream & \case+  case stream of     Return r -> Return r     Effect m -> Effect $ Control.do       a <- ma@@ -1640,7 +1640,7 @@     window :: Seq.Seq a -> Stream (Of a) m b %1 -> Stream (Of (Seq.Seq a)) m b     window !sequ str = Control.do       e <- Control.lift (next str)-      e & \case+      case e of         Left r -> Control.return r         Right (Ur a, rest) -> Control.do           Step $ (sequ Seq.|> a) :> Return () -- same as yield@@ -1653,7 +1653,7 @@       window (Seq.drop 1 sequ) str     setup n' sequ str = Control.do       e <- Control.lift $ next str-      e & \case+      case e of         Left r -> Control.do           Step (sequ :> Return ()) -- same as yield           Control.return r

@@ -49,7 +49,7 @@ import qualified Data.Text as Text import Data.Unrestricted.Linear import GHC.Stack-import Prelude.Linear (($), (&))+import Prelude.Linear (($)) import Streaming.Linear.Internal.Consume (effects) import Streaming.Linear.Internal.Process import Streaming.Linear.Internal.Type@@ -206,7 +206,7 @@     loop :: m (Stream (Of a) m r)     loop = Control.do       either <- mEither-      either & \case+      case either of         Left (Ur a) ->           Control.return $ Step $ a :> (untilRight mEither)         Right r -> Control.return $ Return r@@ -249,7 +249,7 @@       | n <= 0 = Effect $ Control.fmap Control.return $ end s       | otherwise = Effect $ Control.do           next <- step s-          next & \case+          case next of             Right r -> Control.return (Return r)             Left fx ->               Control.return $@@ -270,11 +270,11 @@     loop :: (a -> m Bool) -> AffineStream (Of a) m r %1 -> Stream (Of a) m r     loop test (AffineStream s step end) = Effect $ Control.do       next <- step s-      next & \case+      case next of         Right r -> Control.return (Return r)         Left (a :> next) -> Control.do           testResult <- test a-          testResult & \case+          case testResult of             False ->               Control.return $                 Step $@@ -294,7 +294,7 @@     loop :: (a -> Bool) -> AffineStream (Of a) m r %1 -> Stream (Of a) m r     loop test (AffineStream s step end) = Effect $ Control.do       next <- step s-      next & \case+      case next of         Right r -> Control.return (Return r)         Left (a :> next) -> case test a of           True -> Control.fmap Control.return $ end next@@ -318,7 +318,7 @@       AffineStream (Of a) m r2 %1 ->       Stream (Of (x, a)) m (r1, r2)     loop stream (AffineStream s step end) =-      stream & \case+      case stream of         Return r1 ->           Effect $             Control.fmap (\r2 -> Control.return $ (r1, r2)) $@@ -328,7 +328,7 @@             Control.fmap (\str -> loop str (AffineStream s step end)) m         Step (x :> rest) -> Effect $ Control.do           next <- step s-          next & \case+          case next of             Right r2 -> Control.do               r1 <- effects rest               Control.return (Return (r1, r2))@@ -410,7 +410,7 @@       (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) =-      str & \case+      case str of         Return r -> lseq r $ stepStream (Ur s, s)         Effect m ->           m Control.>>= (\stream -> stepStream (Ur s, stream))

@@ -0,0 +1,16 @@+module Main where++import Test.Foreign (foreignGCTests)+import Test.Simple.Quicksort (quicksortTests)+import Test.Tasty++main :: IO ()+main = defaultMain allTests++allTests :: TestTree+allTests =+  testGroup+    "All tests"+    [ foreignGCTests,+      quicksortTests+    ]

@@ -0,0 +1,102 @@+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Foreign (foreignGCTests) where++import Control.Exception hiding (assert)+import Control.Monad (void)+import Data.Typeable+import qualified Foreign.Heap as Heap+import Foreign.List (List)+import qualified Foreign.List as List+import qualified Foreign.Marshal.Pure as Manual+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Prelude.Linear+import Test.Tasty+import Test.Tasty.Hedgehog (testPropertyNamed)+import qualified Prelude++-- # Organizing tests+-------------------------------------------------------------------------------++foreignGCTests :: TestTree+foreignGCTests =+  testGroup+    "foreignGCTests"+    [ listExampleTests,+      heapExampleTests+    ]++listExampleTests :: TestTree+listExampleTests =+  testGroup+    "list tests"+    [ 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"+    [testPropertyNamed "sort = heapsort" "nonGCHeapSort" nonGCHeapSort]++-- # Internal library+-------------------------------------------------------------------------------++list :: Gen [Int]+list = Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 100))++eqList ::+  forall a.+  (Manual.Representable a, Movable a, Eq a) =>+  List a %1 ->+  List a %1 ->+  Ur Bool+eqList l1 l2 = move $ (List.toList l1) == (List.toList l2)++data InjectedError = InjectedError+  deriving (Typeable, Show)++instance Exception InjectedError++-- # Properties+-------------------------------------------------------------------------------++invertNonGCList :: Property+invertNonGCList = property $ do+  xs <- forAll list+  let xs' =+        unur $+          Manual.withPool (\p -> move $ List.toList $ List.ofList xs p)+  xs === xs'++mapIdNonGCList :: Property+mapIdNonGCList = property $ do+  xs <- forAll list+  let boolTest = unur $+        Manual.withPool $ \p ->+          dup3 p & \(p0, p1, p2) ->+            eqList (List.ofList xs p0) (List.map id (List.ofList xs p1) p2)+  assert boolTest++testExceptionOnMem :: Property+testExceptionOnMem = property $ do+  xs <- forAll list+  let bs = xs ++ (throw InjectedError)+  let writeBadList = Manual.withPool (move . List.toList . List.ofRList bs)+  let ignoreCatch = \_ -> Prelude.return ()+  evalIO (catch @InjectedError (void (evaluate writeBadList)) ignoreCatch)++nonGCHeapSort :: Property+nonGCHeapSort = property $ do+  xs <- forAll list+  let ys :: [(Int, ())] = zip xs $ Prelude.replicate (Prelude.length xs) ()+  (Heap.sort ys) === (reverse $ sort ys)

@@ -0,0 +1,29 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Simple.Quicksort (quicksortTests) where++import Data.List (sort)+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Simple.Quicksort (quicksortUsingArray, quicksortUsingList)+import Test.Tasty+import Test.Tasty.Hedgehog (testPropertyNamed)++quicksortTests :: TestTree+quicksortTests =+  testGroup+    "quicksort tests"+    [ testPropertyNamed "sort xs === quicksortUsingArray xs" "testQuicksortUsingArray" testQuicksortUsingArray,+      testPropertyNamed "sort xs === quicksortUsingList xs" "testQuicksortUsingList" testQuicksortUsingList+    ]++testQuicksortUsingArray :: Property+testQuicksortUsingArray = property $ do+  xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int $ Range.linear 0 100)+  sort xs === quicksortUsingArray xs++testQuicksortUsingList :: Property+testQuicksortUsingList = property $ do+  xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int $ Range.linear 0 100)+  sort xs === quicksortUsingList xs

@@ -4,6 +4,8 @@ module Main where  import Test.Data.Destination (destArrayTests)+import Test.Data.Functor.Linear (genericTests)+import Test.Data.List (listTests) import Test.Data.Mutable.Array (mutArrTests) import Test.Data.Mutable.HashMap (mutHMTests) import Test.Data.Mutable.Set (mutSetTests)@@ -27,7 +29,9 @@           mutHMTests,           mutSetTests,           destArrayTests,-          polarizedArrayTests+          polarizedArrayTests,+          listTests,+          genericTests         ],       testGroup         "Inspection tests"

@@ -0,0 +1,59 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DerivingVia #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LinearTypes #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE StandaloneDeriving #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Data.Functor.Linear (genericTests) where++import Data.Functor.Linear (genericTraverse)+import qualified Data.Functor.Linear as Data+import Generics.Linear.TH+import Hedgehog+import Prelude.Linear+import Test.Tasty+import Test.Tasty.Hedgehog (testPropertyNamed)+import qualified Prelude++data Pair a = MkPair a a+  deriving (Show, Prelude.Eq)++$(deriveGeneric1 ''Pair)++instance Data.Functor Pair where+  fmap f (MkPair x y) = MkPair (f x) (f y)++instance Data.Traversable Pair where+  traverse = genericTraverse++genericTests :: TestTree+genericTests =+  testGroup+    "Generic tests"+    [ genericTraverseTests+    ]++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))

@@ -0,0 +1,43 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE NoImplicitPrelude #-}++module Test.Data.List (listTests) where++import qualified Data.List.Linear as List+import Hedgehog+import qualified Hedgehog.Gen as Gen+import qualified Hedgehog.Range as Range+import Prelude.Linear+import Test.Tasty+import Test.Tasty.Hedgehog (testPropertyNamed)+import qualified Prelude++listTests :: TestTree+listTests =+  testGroup+    "List tests"+    [ testPropertyNamed "take n ++ drop n = id" "take_drop" take_drop,+      testPropertyNamed "length . take n = const n" "take_length" take_length+    ]++take_drop :: Property+take_drop = property $ do+  n <- forAll $ Gen.int (Range.linear 0 50)+  classify "0" $ n == 0+  xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 40))+  classify "length > n" $ Prelude.length xs > n+  List.take n xs ++ List.drop n xs === xs++take_length :: Property+take_length = property $ do+  n <- forAll $ Gen.int (Range.linear 0 50)+  classify "0" $ n == 0+  xs <- forAll $ Gen.list (Range.linear 0 1000) (Gen.int (Range.linear 0 40))+  classify "length > n" $ Prelude.length xs > n+  case Prelude.length xs > n of+    True -> do+      annotate "Prelude.length xs > n"+      Prelude.length (List.take n xs) === n+    False -> do+      annotate "Prelude.length xs < n"+      Prelude.length (List.take n xs) === Prelude.length xs

@@ -354,7 +354,7 @@   where     popAll :: [a] -> Vector.Vector a %1 -> Ur [a]     popAll acc vec =-      Vector.pop vec Linear.& \case+      case Vector.pop vec of         (Ur Nothing, vec') -> vec' `lseq` Ur acc         (Ur (Just x), vec') -> popAll (x : acc) vec' 

@@ -6,6 +6,7 @@ import qualified Data.Array.Polarized as Polar import qualified Data.Array.Polarized.Pull as Pull import qualified Data.Array.Polarized.Push as Push+import Data.Functor.Linear (fmap) import qualified Data.Vector as Vector import Hedgehog import qualified Hedgehog.Gen as Gen@@ -34,10 +35,12 @@       testPropertyNamed "Push.make ~ Vec.replicate" "pushMake" pushMake,       testPropertyNamed "Pull.append ~ Vec.append" "pullAppend" pullAppend,       testPropertyNamed "Pull.asList . Pull.fromVector ~ id" "pullAsList" pullAsList,+      testPropertyNamed "Pull.empty = []" "pullEmpty" pullEmpty,       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+      testPropertyNamed "Pull.zip ~ zip" "pullZip" pullZip,+      testPropertyNamed "Pull.uncons ~ uncons" "pullUncons" pullUncons     ]  list :: Gen [Int]@@ -88,6 +91,10 @@   xs <- forAll list   xs === Pull.asList (Pull.fromVector (Vector.fromList xs)) +pullEmpty :: Property+pullEmpty = property Prelude.$ do+  ([] :: [Int]) === Pull.asList Pull.empty+ pullSingleton :: Property pullSingleton = property Prelude.$ do   x <- forAll randInt@@ -115,3 +122,8 @@   let xs' = Pull.fromVector (Vector.fromList xs)   let ys' = Pull.fromVector (Vector.fromList ys)   zip xs ys === Pull.asList (Pull.zip xs' ys')++pullUncons :: Property+pullUncons = property Prelude.$ do+  xs <- forAll list+  uncons xs === fmap (fmap Pull.asList) (Pull.uncons (Pull.fromVector (Vector.fromList xs)))

@@ -23,9 +23,9 @@  manualElim3 :: (a %1 -> a %1 -> a %1 -> [a]) %1 -> Replicator a %1 -> [a] manualElim3 f r =-  Replicator.next r & \case+  case Replicator.next r of     (x, r') ->-      Replicator.next r' & \case+      case Replicator.next r' of         (y, r'') ->-          Replicator.extract r'' & \case+          case Replicator.extract r'' of             z -> f x y z

@@ -32,11 +32,11 @@  manualElim3 :: (a %1 -> a %1 -> a %1 -> [a]) %1 -> V 3 a %1 -> [a] manualElim3 f v =-  V.uncons v & \case+  case V.uncons v of     (x, v') ->-      V.uncons v' & \case+      case V.uncons v' of         (y, v'') ->-          V.uncons v'' & \case+          case V.uncons v'' of             (z, v''') ->-              V.consume v''' & \case+              case V.consume v''' of                 () -> f x y z