有没有办法在 Haskell 中模拟线性类型?
Is there a way to emulate linear types in Haskell?
我正在为一个系统建模,该系统具有创建资源的操作和消耗该资源的其他操作。但是,给定的资源只能使用一次 - 有没有一种方法可以在编译时保证?
为了具体起见,假设第一个操作是烤蛋糕,还有另外两个操作,一个用于 "choosing to eat" 蛋糕,一个用于 "choosing to have the cake",我只能做一个或其他.
-- This is my current "weakly typed" interface:
bake :: IO Cake
eat :: Cake -> IO ()
keep :: Cake -> IO ()
-- This is OK
do
brownie <- bake
muffin <- bake
eat brownie
keep muffin
-- Eating and having the same cake is not OK:
do
brownie <- bake
eat brownie
keep brownie -- oops! already eaten!
通过在使用蛋糕后设置一个标志,可以很容易地在运行时强制执行不保留已经吃过的蛋糕(反之亦然)的限制。但是有没有办法在编译时强制执行此操作?
顺便说一句,这个问题是为了证明概念,所以我可以接受任何可以给我想要的静态安全的黑魔法。
部分解决方案。我们可以定义一个包装器类型
data Caked a = Caked { getCacked :: IO a } -- ^ internal constructor
其中我们不导出constructor/accessor。
它将有两个几乎但不太像的绑定函数:
beforeCake :: IO a -> (a -> Caked b) -> Caked b
beforeCake a f = Caked (a >>= getCaked . f)
afterCake :: Caked a -> (a -> IO b) -> Caked b
afterCake (Caked a) f = Caked (a >>= f)
客户创造 Caked
价值的唯一途径是:
eat :: Cake -> Caked ()
eat = undefined
keep :: Cake -> Caked ()
keep = undefined
我们将在回调中分配 Cake
个值:
withCake :: (Cake -> Caked b) -> IO b
withCake = undefined
我认为这将确保 eat
和 keep
在回调中只被调用一次。
问题:不适用于多个 Cake
分配,并且 Cake
值仍然可以脱离回调的范围(幻像类型在这里有帮助吗?)
Polakow 在他的 Haskell 研讨会论文 Embedding a full linear lambda calculus in Haskell (pdf) 中展示了如何做到这一点。
主要思想是使用输入和输出上下文为每个构造函数建立索引,跟踪各个子项中消耗的资源。
在 Haskell 中,其基本版本可以用蛋糕商店索引的 GADT 表示(由 Nat
-s 的列表表示):
{-# LANGUAGE
TypeFamilies, GADTs, TypeOperators, PartialTypeSignatures,
DataKinds, PolyKinds #-}
import GHC.TypeLits
import Data.Proxy
import GHC.Exts
-- Allocate a new cake
type family New cs where
New '[] = 0
New (c ': cs) = c + 1
-- Constraint satisfiable if "c" is in "cs"
type family Elem c cs :: Constraint where
Elem c (c ': cs) = ()
Elem c (c' ': cs) = Elem c cs
type family Remove c cs where
Remove c '[] = '[]
Remove c (c ': cs) = cs
Remove c (c' ': cs) = c' ': Remove c cs
data Bake :: [Nat] -> [Nat] -> * -> * where
Pure :: a -> Bake cs cs a
Bake :: (Proxy (New cs) -> Bake (New cs ': cs) cs' a) -> Bake cs cs' a
Eat :: Elem c cs => Proxy c -> Bake (Remove c cs) cs' a -> Bake cs cs' a
Keep :: Elem c cs => Proxy c -> Bake cs cs' a -> Bake cs cs' a
ok :: Bake '[] _ _
ok =
Bake $ \cake1 ->
Bake $ \cake2 ->
Eat cake1 $
Keep cake2 $
Eat cake2 $
Pure ()
not_ok :: Bake '[] _ _
not_ok =
Bake $ \cake1 ->
Bake $ \cake2 ->
Eat cake1 $
Keep cake1 $ -- we already ate that
Eat cake2 $
Pure ()
遗憾的是,我们无法从 Bake
操作中删除类型注释并保留类型以进行推断:
foo =
Bake $ \cake1 ->
Bake $ \cake2 ->
Eat cake1 $
Pure ()
-- Error: Could not deduce (Elem (New cs0) (New cs0 + 1 : New cs0 : cs0))
显然,(Elem (New cs0) (New cs0 + 1 : New cs0 : cs0))
对所有cs0
都是可满足的,但是GHC看不到这一点,因为它不能决定New cs0
是否不等于New cs0 + 1
,因为GHC 不能对灵活的 cs0
变量做任何假设。
如果我们添加 NoMonomorphismRestriction
,foo
会进行类型检查,但是通过将所有 Elem
约束推到顶部,甚至会导致错误的程序进行类型检查。虽然这仍然会阻止使用不正确的术语做任何有用的事情,但这是一个相当丑陋的解决方案。
更一般地说,我们可以将 Bake
表示为索引自由 monad,它让我们用 RebindableSyntax
表示 do
-notation,并允许 BakeF
的定义比我们之前看到的要清晰一些。它还可以像普通的旧 Free
monad 一样减少样板文件,尽管我发现人们不太可能在实际代码中的两个不同场合发现索引自由 monad 的用途。
{-# LANGUAGE
TypeFamilies, GADTs, TypeOperators, PartialTypeSignatures, StandaloneDeriving,
DataKinds, PolyKinds, NoImplicitPrelude, RebindableSyntax, DeriveFunctor #-}
import Prelude hiding (Monad(..))
import GHC.TypeLits
import Data.Proxy
import GHC.Exts
class IxFunctor f where
imap :: (a -> b) -> f i j a -> f i j b
class IxFunctor m => IxMonad m where
return :: a -> m i i a
(>>=) :: m i j a -> (a -> m j k b) -> m i k b
fail :: String -> m i j a
infixl 1 >>
infixl 1 >>=
(>>) :: IxMonad m => m i j a -> m j k b -> m i k b
ma >> mb = ma >>= const mb
data IxFree f i j a where
Pure :: a -> IxFree f i i a
Free :: f i j (IxFree f j k a) -> IxFree f i k a
liftf :: IxFunctor f => f i j a -> IxFree f i j a
liftf = Free . imap Pure
instance IxFunctor f => IxFunctor (IxFree f) where
imap f (Pure a) = Pure (f a)
imap f (Free fa) = Free (imap (imap f) fa)
instance IxFunctor f => IxMonad (IxFree f) where
return = Pure
Pure a >>= f = f a
Free fa >>= f = Free (imap (>>= f) fa)
fail = error
-- Old stuff for Bake
type family New cs where
New '[] = 0
New (c ': cs) = c + 1
type family Elem c cs :: Constraint where
Elem c (c ': cs) = ()
Elem c (c' ': cs) = Elem c cs
type family Remove c cs where
Remove c '[] = '[]
Remove c (c ': cs) = cs
Remove c (c' ': cs) = c' ': Remove c cs
-- Now the return type indices of BakeF directly express the change
-- from the old store to the new store.
data BakeF cs cs' k where
BakeF :: (Proxy (New cs) -> k) -> BakeF cs (New cs ': cs) k
EatF :: Elem c cs => Proxy c -> k -> BakeF cs (Remove c cs) k
KeepF :: Elem c cs => Proxy c -> k -> BakeF cs cs k
deriving instance Functor (BakeF cs cs')
instance IxFunctor BakeF where imap = fmap
type Bake = IxFree BakeF
bake = liftf (BakeF id)
eat c = liftf (EatF c ())
keep c = liftf (KeepF c ())
ok :: Bake '[] _ _
ok = do
cake1 <- bake
cake2 <- bake
eat cake1
keep cake2
eat cake2
-- not_ok :: Bake '[] _ _
-- not_ok = do
-- cake1 <- bake
-- cake2 <- bake
-- eat cake1
-- keep cake1 -- already ate it
-- eat cake2
我正在为一个系统建模,该系统具有创建资源的操作和消耗该资源的其他操作。但是,给定的资源只能使用一次 - 有没有一种方法可以在编译时保证?
为了具体起见,假设第一个操作是烤蛋糕,还有另外两个操作,一个用于 "choosing to eat" 蛋糕,一个用于 "choosing to have the cake",我只能做一个或其他.
-- This is my current "weakly typed" interface:
bake :: IO Cake
eat :: Cake -> IO ()
keep :: Cake -> IO ()
-- This is OK
do
brownie <- bake
muffin <- bake
eat brownie
keep muffin
-- Eating and having the same cake is not OK:
do
brownie <- bake
eat brownie
keep brownie -- oops! already eaten!
通过在使用蛋糕后设置一个标志,可以很容易地在运行时强制执行不保留已经吃过的蛋糕(反之亦然)的限制。但是有没有办法在编译时强制执行此操作?
顺便说一句,这个问题是为了证明概念,所以我可以接受任何可以给我想要的静态安全的黑魔法。
部分解决方案。我们可以定义一个包装器类型
data Caked a = Caked { getCacked :: IO a } -- ^ internal constructor
其中我们不导出constructor/accessor。
它将有两个几乎但不太像的绑定函数:
beforeCake :: IO a -> (a -> Caked b) -> Caked b
beforeCake a f = Caked (a >>= getCaked . f)
afterCake :: Caked a -> (a -> IO b) -> Caked b
afterCake (Caked a) f = Caked (a >>= f)
客户创造 Caked
价值的唯一途径是:
eat :: Cake -> Caked ()
eat = undefined
keep :: Cake -> Caked ()
keep = undefined
我们将在回调中分配 Cake
个值:
withCake :: (Cake -> Caked b) -> IO b
withCake = undefined
我认为这将确保 eat
和 keep
在回调中只被调用一次。
问题:不适用于多个 Cake
分配,并且 Cake
值仍然可以脱离回调的范围(幻像类型在这里有帮助吗?)
Polakow 在他的 Haskell 研讨会论文 Embedding a full linear lambda calculus in Haskell (pdf) 中展示了如何做到这一点。
主要思想是使用输入和输出上下文为每个构造函数建立索引,跟踪各个子项中消耗的资源。
在 Haskell 中,其基本版本可以用蛋糕商店索引的 GADT 表示(由 Nat
-s 的列表表示):
{-# LANGUAGE
TypeFamilies, GADTs, TypeOperators, PartialTypeSignatures,
DataKinds, PolyKinds #-}
import GHC.TypeLits
import Data.Proxy
import GHC.Exts
-- Allocate a new cake
type family New cs where
New '[] = 0
New (c ': cs) = c + 1
-- Constraint satisfiable if "c" is in "cs"
type family Elem c cs :: Constraint where
Elem c (c ': cs) = ()
Elem c (c' ': cs) = Elem c cs
type family Remove c cs where
Remove c '[] = '[]
Remove c (c ': cs) = cs
Remove c (c' ': cs) = c' ': Remove c cs
data Bake :: [Nat] -> [Nat] -> * -> * where
Pure :: a -> Bake cs cs a
Bake :: (Proxy (New cs) -> Bake (New cs ': cs) cs' a) -> Bake cs cs' a
Eat :: Elem c cs => Proxy c -> Bake (Remove c cs) cs' a -> Bake cs cs' a
Keep :: Elem c cs => Proxy c -> Bake cs cs' a -> Bake cs cs' a
ok :: Bake '[] _ _
ok =
Bake $ \cake1 ->
Bake $ \cake2 ->
Eat cake1 $
Keep cake2 $
Eat cake2 $
Pure ()
not_ok :: Bake '[] _ _
not_ok =
Bake $ \cake1 ->
Bake $ \cake2 ->
Eat cake1 $
Keep cake1 $ -- we already ate that
Eat cake2 $
Pure ()
遗憾的是,我们无法从 Bake
操作中删除类型注释并保留类型以进行推断:
foo =
Bake $ \cake1 ->
Bake $ \cake2 ->
Eat cake1 $
Pure ()
-- Error: Could not deduce (Elem (New cs0) (New cs0 + 1 : New cs0 : cs0))
显然,(Elem (New cs0) (New cs0 + 1 : New cs0 : cs0))
对所有cs0
都是可满足的,但是GHC看不到这一点,因为它不能决定New cs0
是否不等于New cs0 + 1
,因为GHC 不能对灵活的 cs0
变量做任何假设。
如果我们添加 NoMonomorphismRestriction
,foo
会进行类型检查,但是通过将所有 Elem
约束推到顶部,甚至会导致错误的程序进行类型检查。虽然这仍然会阻止使用不正确的术语做任何有用的事情,但这是一个相当丑陋的解决方案。
更一般地说,我们可以将 Bake
表示为索引自由 monad,它让我们用 RebindableSyntax
表示 do
-notation,并允许 BakeF
的定义比我们之前看到的要清晰一些。它还可以像普通的旧 Free
monad 一样减少样板文件,尽管我发现人们不太可能在实际代码中的两个不同场合发现索引自由 monad 的用途。
{-# LANGUAGE
TypeFamilies, GADTs, TypeOperators, PartialTypeSignatures, StandaloneDeriving,
DataKinds, PolyKinds, NoImplicitPrelude, RebindableSyntax, DeriveFunctor #-}
import Prelude hiding (Monad(..))
import GHC.TypeLits
import Data.Proxy
import GHC.Exts
class IxFunctor f where
imap :: (a -> b) -> f i j a -> f i j b
class IxFunctor m => IxMonad m where
return :: a -> m i i a
(>>=) :: m i j a -> (a -> m j k b) -> m i k b
fail :: String -> m i j a
infixl 1 >>
infixl 1 >>=
(>>) :: IxMonad m => m i j a -> m j k b -> m i k b
ma >> mb = ma >>= const mb
data IxFree f i j a where
Pure :: a -> IxFree f i i a
Free :: f i j (IxFree f j k a) -> IxFree f i k a
liftf :: IxFunctor f => f i j a -> IxFree f i j a
liftf = Free . imap Pure
instance IxFunctor f => IxFunctor (IxFree f) where
imap f (Pure a) = Pure (f a)
imap f (Free fa) = Free (imap (imap f) fa)
instance IxFunctor f => IxMonad (IxFree f) where
return = Pure
Pure a >>= f = f a
Free fa >>= f = Free (imap (>>= f) fa)
fail = error
-- Old stuff for Bake
type family New cs where
New '[] = 0
New (c ': cs) = c + 1
type family Elem c cs :: Constraint where
Elem c (c ': cs) = ()
Elem c (c' ': cs) = Elem c cs
type family Remove c cs where
Remove c '[] = '[]
Remove c (c ': cs) = cs
Remove c (c' ': cs) = c' ': Remove c cs
-- Now the return type indices of BakeF directly express the change
-- from the old store to the new store.
data BakeF cs cs' k where
BakeF :: (Proxy (New cs) -> k) -> BakeF cs (New cs ': cs) k
EatF :: Elem c cs => Proxy c -> k -> BakeF cs (Remove c cs) k
KeepF :: Elem c cs => Proxy c -> k -> BakeF cs cs k
deriving instance Functor (BakeF cs cs')
instance IxFunctor BakeF where imap = fmap
type Bake = IxFree BakeF
bake = liftf (BakeF id)
eat c = liftf (EatF c ())
keep c = liftf (KeepF c ())
ok :: Bake '[] _ _
ok = do
cake1 <- bake
cake2 <- bake
eat cake1
keep cake2
eat cake2
-- not_ok :: Bake '[] _ _
-- not_ok = do
-- cake1 <- bake
-- cake2 <- bake
-- eat cake1
-- keep cake1 -- already ate it
-- eat cake2