Add a ($^) application function which moves the argument

Closes #406
tweag · Apr 28, 2022 · bd9beae · bd9beae
1 parent 113a758
commit bd9beae
Show file tree

Hide file tree

Showing 3 changed files with 16 additions and 8 deletions.
diff --git a/src/Data/Unrestricted/Linear.hs b/src/Data/Unrestricted/Linear.hs
@@ -68,22 +68,22 @@ module Data.Unrestricted.Linear
 
     -- * Performing non-linear actions on linearly bound values
     Consumable (..),
-    Dupable (..),
-    Movable (..),
     lseq,
+    Dupable (..),
     dup,
     dup3,
     dup4,
     dup5,
     dup6,
     dup7,
-    module Data.Unrestricted.Linear.Internal.Instances,
+    Movable (..),
+    ($^),
   )
 where
 
 import Data.Unrestricted.Linear.Internal.Consumable
 import Data.Unrestricted.Linear.Internal.Dupable
-import Data.Unrestricted.Linear.Internal.Instances
+import Data.Unrestricted.Linear.Internal.Instances ()
 import Data.Unrestricted.Linear.Internal.Movable
 import Data.Unrestricted.Linear.Internal.Ur
 import Data.Unrestricted.Linear.Internal.UrT
diff --git a/src/Data/Unrestricted/Linear/Internal/Movable.hs b/src/Data/Unrestricted/Linear/Internal/Movable.hs
@@ -4,8 +4,10 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
 {-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE LinearTypes #-}
+{-# LANGUAGE PolyKinds #-}
 {-# LANGUAGE QuantifiedConstraints #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE StandaloneDeriving #-}
@@ -18,6 +20,7 @@
 module Data.Unrestricted.Linear.Internal.Movable
   ( -- * Movable
     Movable (..),
+    ($^),
     GMovable,
     genericMove,
   )
@@ -30,12 +33,11 @@ import qualified Data.Semigroup as Semigroup
 import Data.Unrestricted.Linear.Internal.Dupable
 import Data.Unrestricted.Linear.Internal.Ur
 import GHC.Tuple (Solo)
-import GHC.Types (Multiplicity (..))
+import GHC.Types
 import Generics.Linear
 import Prelude.Linear.Generically
 import Prelude.Linear.Internal
 import qualified Unsafe.Linear as Unsafe
-import Prelude (Bool (..), Char, Double, Float, Int, Ordering (..), Word)
 import qualified Prelude as Prelude
 
 -- | Use @'Movable' a@ to represent a type which can be used many times even
@@ -56,6 +58,11 @@ import qualified Prelude as Prelude
 class Dupable a => Movable a where
   move :: a %1 -> Ur a
 
+($^) :: forall {rep} a (b :: TYPE rep). Movable a => (a -> b) %1 -> a %1 -> b
+f $^ a =
+  move a & \case
+    Ur a' -> f a'
+
 -- -------------
 -- Instances
 

diff --git a/src/Prelude/Linear.hs b/src/Prelude/Linear.hs
@@ -137,11 +137,12 @@ module Prelude.Linear
     -- * Doing non-linear operations inside linear functions
     -- $
     Consumable (..),
-    Dupable (..),
-    Movable (..),
     lseq,
+    Dupable (..),
     dup,
     dup3,
+    Movable (..),
+    ($^),
     forget,
   )
 where