Polymorphise the type of some functions

What I've done is take the prelude functions that we use all the time
and polymorphise the higher-order arrows.

I left the first order arrow to multiplicity 1 whenever possible
because:
- We can cast them to any multiplicity by a simple 𝜂-expansion
- Any multiplicity involving multiplicity multiplication will hit the
  limitations of the type checker currently (it doesn't know that
  multiplication is associative, typically), so I really wanted a
  single multiplicity variable per type.

This does leave composition fully linear, unfortunately, because there
are two (independent) higher-order arrow, and there is no most general
choice of one to polymorphise.

It didn't work last time I tried, but @monoidal made a [cleverly short
patch](https://gitlab.haskell.org/ghc/ghc/-/merge_requests/4632) to
9.0 prior to release, and as he hinted to me last week, it does make
this polymorphisation possible.

Closes #309 .

examples/Test/Foreign.hs

@@ -63,30 +63,30 @@ instance Exception InjectedError
 -------------------------------------------------------------------------------
 
 invertNonGCList :: Property
-invertNonGCList = property Prelude.$ do
+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 Prelude.$ do
+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
 
 testExecptionOnMem :: Property
-testExecptionOnMem = property Prelude.$ do
+testExecptionOnMem = 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 Prelude.$ do
+nonGCHeapSort = property $ do
   xs <- forAll list
   let ys :: [(Int,())] = zip xs $ Prelude.replicate (Prelude.length xs) ()
   (Heap.sort ys) === (reverse $ sort ys)

src/Data/Array/Destination/Internal.hs

@@ -30,7 +30,7 @@ data DArray a where
 -- module.  @`alloc` n k@ must be called with a non-negative value of @n@.
 alloc :: Int -> (DArray a %1-> ()) %1-> Vector a
 alloc n writer = (\(Ur dest, vec) -> writer (DArray dest) `lseq` vec) $
-  unsafeDupablePerformIO Prelude.$ do
+  unsafeDupablePerformIO $ do
     destArray <- MVector.unsafeNew n
     vec <- Vector.unsafeFreeze destArray
     Prelude.return (Ur destArray, vec)
@@ -78,7 +78,7 @@ mirror v f arr =
 
 -- | Fill a destination array using the given index-to-value function.
 fromFunction :: (Int -> b) -> DArray b %1-> ()
-fromFunction f (DArray mvec) = unsafeDupablePerformIO Prelude.$ do
+fromFunction f (DArray mvec) = unsafeDupablePerformIO $ do
   let n = MVector.length mvec
   Prelude.sequence_ [MVector.unsafeWrite mvec m (f m) | m <- [0..n-1]]
 -- The use of the mutable array is linear, since getting the length does not

src/Prelude/Linear/Internal.hs

@@ -17,60 +17,52 @@ import Data.Functor.Identity
 -- simply reimplemented here. For harder function, we reuse the Prelude
 -- definition and make an unsafe cast.
 
--- | Beware: @($)@ is not compatible with the standard one because it is
--- higher-order and we don't have multiplicity polymorphism yet.
-($) :: (a %1-> b) %1-> a %1-> b
--- XXX: Temporary as `($)` should get its typing rule directly from the type
--- inference mechanism.
+-- XXX: Add runtime-representation polymorphism such that
+-- `($)`+`-XImpredicativeType` (starting with 9.2) has the complete behaviour of
+-- GHC's native `($)` rule.
+($) :: (a %p-> b) %q-> a %p-> b
 ($) f x = f x
 infixr 0 $
 
-(&) :: a %1-> (a %1-> b) %1-> b
+(&) :: a %p-> (a %p-> b) %q-> b
 x & f = f x
 infixl 1 &
 
-id :: a %1-> a
+id :: a %q-> a
 id x = x
 
-const :: a %1-> b -> a
+const :: a %q-> b -> a
 const x _ = x
 
-asTypeOf :: a %1-> a -> a
+asTypeOf :: a %q-> a -> a
 asTypeOf = const
 
 -- | @seq x y@ only forces @x@ to head normal form, therefore is not guaranteed
 -- to consume @x@ when the resulting computation is consumed. Therefore, @seq@
 -- cannot be linear in it's first argument.
-seq :: a -> b %1-> b
-seq x = Unsafe.toLinear (Prelude.seq x)
+seq :: a -> b %q-> b
+seq x y = Unsafe.toLinear (Prelude.seq x) y
 
-($!) :: (a %1-> b) %1-> a %1-> b
+($!) :: (a %p-> b) %q-> a %p-> b
 ($!) f !a = f a
 
--- | Beware, 'curry' is not compatible with the standard one because it is
--- higher-order and we don't have multiplicity polymorphism yet.
-curry :: ((a, b) %1-> c) %1-> a %1-> b %1-> c
+curry :: ((a, b) %p-> c) %q-> a %p-> b %p-> c
 curry f x y = f (x, y)
 
--- | Beware, 'uncurry' is not compatible with the standard one because it is
--- higher-order and we don't have multiplicity polymorphism yet.
-uncurry :: (a %1-> b %1-> c) %1-> (a, b) %1-> c
+uncurry :: (a %p-> b %p-> c) %q-> (a, b) %p-> c
 uncurry f (x,y) = f x y
 
 -- | Beware: @(.)@ is not compatible with the standard one because it is
--- higher-order and we don't have multiplicity polymorphism yet.
-(.) :: (b %1-> c) %1-> (a %1-> b) %1-> a %1-> c
+-- higher-order and we don't have sufficient multiplicity polymorphism yet.
+(.) :: (b %1-> c) %q-> (a %1-> b) %m-> a %n-> c
 f . g = \x -> f (g x)
 
--- XXX: temporary: with multiplicity polymorphism functions expecting a
--- non-linear arrow would allow a linear arrow passed, so this would be
--- redundant
 -- | Convenience operator when a higher-order function expects a non-linear
 -- arrow but we have a linear arrow.
 forget :: (a %1-> b) %1-> a -> b
 forget f a = f a
 
 -- XXX: Temporary, until newtype record projections are linear.
-runIdentity' :: Identity a %1-> a
+runIdentity' :: Identity a %p-> a
 runIdentity' (Identity x) = x
 

src/Streaming/Internal/Produce.hs

@@ -359,7 +359,7 @@ enumFromThen :: forall e m. (Control.Monad m, Enum e) =>
   e -> e -> AffineStream (Of e) m ()
 enumFromThen e e' = iterate e enumStep where
   enumStep :: e -> e
-  enumStep enum = toEnum Prelude.$
+  enumStep enum = toEnum $
     (fromEnum enum) + ((fromEnum e') - (fromEnum e))
     -- Think:  \enum -> enum + stepSize where stepSize = (e1 - e0)
 

src/System/IO/Resource.hs

@@ -18,7 +18,7 @@
 -- >>> import qualified Prelude
 -- >>> :{
 --  linearWriteToFile :: IO ()
---  linearWriteToFile = Linear.run Prelude.$ Control.do
+--  linearWriteToFile = Linear.run $ Control.do
 --    handle1 <- Linear.openFile "/home/user/test.txt" Linear.WriteMode
 --    handle2 <- Linear.hPutStrLn handle1 (Text.pack "hello there")
 --    () <- Linear.hClose handle2

src/System/IO/Resource/Internal.hs

@@ -52,7 +52,7 @@ run (RIO action) = do
         (restore (Linear.withLinearIO (action rrm)))
         (do -- release stray resources
            ReleaseMap releaseMap <- System.readIORef rrm
-           safeRelease Prelude.$ Ur.fmap snd Prelude.$ IntMap.toList releaseMap))
+           safeRelease $ Ur.fmap snd $ IntMap.toList releaseMap))
       -- Remarks: resources are guaranteed to be released on non-exceptional
       -- return. So, contrary to a standard bracket/ResourceT implementation, we
       -- only release exceptions in the release map upon exception.
@@ -103,7 +103,7 @@ newtype Handle = Handle (UnsafeResource System.Handle)
 openFile :: FilePath -> System.IOMode -> RIO Handle
 openFile path mode = Control.do
     h <- unsafeAcquire
-      (Linear.fromSystemIOU Prelude.$ System.openFile path mode)
+      (Linear.fromSystemIOU $ System.openFile path mode)
       (\h -> Linear.fromSystemIO $ System.hClose h)
     Control.return $ Handle h
 

test/Test/Data/Mutable/HashMap.hs

@@ -279,25 +279,22 @@ refLookup = defProperty $ do
   kvs <- forAll keyVals
   k <- forAll key
   let listLookup = List.lookup k (List.reverse kvs)
-  let (#.) = (Linear..)
-  let hmLookup = HashMap.fromList kvs (getFst #. HashMap.lookup k)
+  let hmLookup = HashMap.fromList kvs (getFst Linear.. HashMap.lookup k)
   listLookup === unur hmLookup
 
 refMap :: Property
 refMap = defProperty $ do
   let f k v = if mod k 5 < 3 then Just (show k ++ v) else Nothing
   let f' (k,v) = fmap ((,) k) (f k v)
   kvs <- forAll keyVals
-  let (#.) = (Linear..)
   let mappedList = mapMaybe f' (nubOrdOn fst (List.reverse kvs))
-  let mappedHm = HashMap.fromList kvs (HashMap.toList #. HashMap.mapMaybeWithKey f)
+  let mappedHm = HashMap.fromList kvs (HashMap.toList Linear.. HashMap.mapMaybeWithKey f)
   sort mappedList === sort (unur mappedHm)
 
 refSize :: Property
 refSize = defProperty $ do
   kvs <- forAll keyVals
-  let (#.) = (Linear..)
-  length (nubOrdOn fst kvs) === unur (HashMap.fromList kvs (getFst #. HashMap.size))
+  length (nubOrdOn fst kvs) === unur (HashMap.fromList kvs (getFst Linear.. HashMap.size))
 
 refToListFromList :: Property
 refToListFromList = defProperty $ do
@@ -382,7 +379,6 @@ refIntersectionWith = defProperty $ do
 shrinkToFitTest :: Property
 shrinkToFitTest = defProperty $ do
   kvs <- forAll keyVals
-  let (#.) = (Linear..)
-  let shrunk = (HashMap.fromList kvs (HashMap.toList #. HashMap.shrinkToFit))
+  let shrunk = (HashMap.fromList kvs (HashMap.toList Linear.. HashMap.shrinkToFit))
   sort (nubOrdOn fst (List.reverse kvs)) === sort (unur shrunk)