Merge pull request #469 from tweag/wip/no-case-workaround

Remove the ... & \case -> ... workaround

Author: aspiwack

bench/Data/Mutable/HashMap.hs

@@ -135,7 +135,7 @@ linear_hashmap inp@(BenchInput {pairs = kvs}) =
 
     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
 

docs/USER_GUIDE.md

@@ -107,39 +107,6 @@ lifetime (i.e, the scope) of `SomeType`.
 
 ## 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:

examples/Simple/TopSort.hs

@@ -13,7 +13,6 @@ import Data.HashMap.Mutable.Linear (HashMap)
 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 @@ topsort = reverse . postOrder . fmap (\(n, nbrs) -> (n, (nbrs, 0)))
 
 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 @@ postOrderHM nodes dag =
     -- 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 @@ postOrderHM nodes dag =
 
         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 @@ postOrderHM nodes dag =
 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 @@ pluckSources (s : ss) postOrd dag =
     -- 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 @@ findSources nodes dag =
 -- | 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 @@ mapAccum ::
   (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)

src/Control/Optics/Linear/Internal.hs

@@ -173,7 +173,7 @@ getConst' (Const x) = x
 
 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

src/Control/Optics/Linear/Prism.hs

@@ -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

src/Data/Array/Mutable/Linear/Internal.hs

@@ -190,7 +190,7 @@ slice ::
   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

src/Data/Functor/Linear/Internal/Traversable.hs

@@ -239,7 +239,7 @@ instance GTraversable U1 where
   {-# 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)

src/Data/HashMap/Mutable/Linear/Internal.hs

@@ -295,7 +295,7 @@ mapMaybeWithKey f (HashMap _ cap arr) =
             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 @@ intersectionWith combine (hm1 :: HashMap k a') hm2 =
       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 @@ lookup k hm =
 -- | 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 @@ shiftSegmentBackward ::
   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') ->

src/Data/List/Linear.hs

@@ -117,7 +117,7 @@ map = fmap
 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 @@ splitAt i = Unsafe.toLinear (Prelude.splitAt i)
 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
@@ -310,7 +310,7 @@ scanl1 f (x : xs) = scanl f x xs
 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 :: (Dupable a) => (a %1 -> a %1 -> a) -> [a] %1 -> [a]
 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' _ [] [] = ([], Nothing)
 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]

src/Data/Monoid/Linear/Internal/Semigroup.hs

@@ -126,14 +126,14 @@ instance (Semigroup a) => Semigroup (Identity a) where
 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 (Semigroup a) => Semigroup (Solo a) where
 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
 

src/Data/Ord/Linear/Internal/Ord.hs

@@ -115,7 +115,7 @@ instance (Consumable a, Ord a) => Ord [a] where
   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
 

src/Data/Replicator/Linear/Internal.hs

@@ -89,7 +89,7 @@ liftA2 f (Streamed sa) (Streamed sb) = Streamed (ReplicationStream.liftA2 f sa s
 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 (Streamed (ReplicationStream s give dups consumes)) =
 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 @@ class Elim n a b where
 
 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 'Z) a b where
 
 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' #-}

src/Data/Replicator/Linear/Internal/ReplicationStream.hs

@@ -70,11 +70,11 @@ pure x =
     (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 @@ liftA2 f (ReplicationStream sa givea dupsa consumesa) (ReplicationStream sb give
     (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

src/Data/Unrestricted/Linear/Internal/Instances.hs

@@ -47,17 +47,17 @@ newtype AsMovable a = AsMovable a
 
 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