有没有办法在Haskell中模拟线性类型?

有没有办法在Haskell中模拟线性类型?,haskell,types,linear-types,Haskell,Types,Linear Types,我正在为一个系统建模,该系统有一个创建资源的操作和其他消耗该资源的操作。然而,给定的资源只能被消耗一次——有没有一种方法可以保证在编译时这样做 具体来说,假设第一个操作烘焙蛋糕,还有两个其他操作,一个用于“选择吃”蛋糕,另一个用于“选择吃蛋糕”,我只能做其中一个 -- This is my current "weakly typed" interface: bake :: IO Cake eat :: Cake -> IO () keep :: Cake -> IO () --

我正在为一个系统建模,该系统有一个创建资源的操作和其他消耗该资源的操作。然而,给定的资源只能被消耗一次——有没有一种方法可以保证在编译时这样做

具体来说,假设第一个操作烘焙蛋糕,还有两个其他操作,一个用于“选择吃”蛋糕,另一个用于“选择吃蛋糕”,我只能做其中一个

-- 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!
——这是我当前的“弱类型”界面:
烤蛋糕
吃:蛋糕->IO()
保存::蛋糕->IO()
--这没关系
做

布朗尼部分溶液。我们可以定义一个包装器类型

data Caked a = Caked { getCacked :: IO a } -- ^ internal constructor
其中我们不导出构造函数/访问器

它将有两个几乎相同但不完全相同的绑定函数:

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)
客户端创建结块的
值的唯一方法是:

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研讨会论文中展示了如何做到这一点


其主要思想是使用一个输入和一个输出上下文对每个构造函数进行索引,该上下文跟踪在各个子项中消耗的资源。

在Haskell中,基本版本可以用一个GADT表示,该GADT由一个饼库索引(由
Nat
-s列表表示):

不幸的是,我们无法从
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,这使我们可以使用
rebindabletsyntax
进行
do
-表示,并允许对
BakeF
进行定义,这比我们以前看到的更加清晰。它还可以像普通的老式
Free
monad一样简化样板文件,尽管我发现人们在实际代码中不太可能在两种不同的情况下使用索引的Free 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
{-#语言
类型族、GADT、类型运算符、部分类型签名、独立派生、,
数据种类、多种类、NoImplicitPrelude、可重绑定语法、派生函数#-}
导入前奏隐藏(单子(..)
导入GHC.TypeLits
导入数据。代理
导入GHC.Exts
类函子f,其中
imap::(a->b)->f i j a->f i j b
类IxFunctor m=>IxMonad m其中
return::a->m i a
(>>=)::MIJA->(a->MJKB)->MIKB
失败::字符串->m i j a
infixl 1>>
infixl 1>>=
(>>)::IxMonad m=>MIJA->MJKB->MIKB
ma>>mb=ma>>=const mb
数据IxFree f i j a其中
纯::a->IxFree f i a
Free::fij(ixfreefjka)->ixfreefika
liftf::ix函子f=>fija->ixfreeffija
liftf=免费。imap纯
实例IxFunctor f=>IxFunctor(IxFree f),其中
imap f(纯a)=纯(f a)
imap f(自由fa)=自由(imap(imap f)fa)
实例IxFunctor f=>IxMonad(IxFree f),其中
返回=纯
纯a>>=f=f a
自由fa>=f=自由(imap(>=f)fa)
失败=错误
--烘烤用的旧东西
键入新的cs系列,其中
新'[]=0
新(c):cs)=c+1
键入族元素c cs::约束,其中
元素c(c):cs=()
元素c(c'':cs)=元素c cs
键入family Remove c cs where
删除c'[]='[]
删除c(c):cs)=cs
删除c(c“”:cs)=c“”:删除c cs
--现在BakeF的返回类型指数直接表示了这种变化
--从旧商店到新商店。
数据BakeF cs'k在哪里
BakeF::(代理(新cs)->k)->BakeF cs(新cs):cs)k
EatF::Elem c cs=>Proxy c->k->BakeF cs(删除c cs)k
KeepF::elemcs=>Proxy c->k->BakeF cs k
派生实例函子(BakeF cs')
实例IxFunctor BakeF,其中imap=fmap
类型Bake=IxFree BakeF
bake=liftf(BakeF id)
eat c=liftf(EatF c())
keep c=liftf(KeepF c())
ok::烘焙“[]”_
好的

cake1您是否可以使用幻像类型来指示蛋糕是否已被吃掉,例如
data cake a=cake
data eat
data Fresh
然后
bake=cake::cake Fresh
eat::cake Fresh->cake eat;eat Cake=Cake
?@epsilonhalbe当然可以,但如果你当时做了
eatenCookie,我明白了-因此你需要编写自己版本的
,可能有用:。我看过另一篇类似的论文,但我现在很难找到它。。。在Agda中,这是一种天真的方法。
用蛋糕(\cake->eat cake`afterCake`(\()->withCake(\cake'->eat cake))
看起来它吃了
蛋糕
两次(而且
蛋糕
没有时间)。@Daniel Wagner你说得对。也许圣莫纳德的幻影式技术可以填补这个漏洞。是相同的,但是在索引(只有形状被索引)容器上有严格正索引的自由单子。我没有包括
keep
构造函数,因为我不满意
keep
既不改变输入也不改变输出索引的事实。在我看来,
keep
应该从
eat
这样的上下文中排除蛋糕,但在输出中包含蛋糕。我的朋友会这么做,但我
{-# 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