26

我正在建模一个系统，该系统具有创建资源的操作和消耗该资源的其他操作。但是，给定的资源只能使用一次 - 有没有办法可以保证在编译时？

具体来说，假设第一个操作烤蛋糕，还有另外两个操作，一个是“选择吃”蛋糕，一个是“选择吃蛋糕”，我只能做一个或另一个。

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

通过在我们使用蛋糕后在蛋糕上设置一个标志，很容易在运行时强制执行不保留已经吃过的蛋糕（反之亦然）的限制。但是有没有办法在编译时强制执行呢？

顺便说一句，这个问题是为了证明概念，所以我可以接受任何可以给我想要的静态安全的黑魔法。

4

3 回答 3

15

在 Haskell 中，它的基本版本可以用一个 GADT 来表示，该 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，它为我们do提供 -notation RebindableSyntax，并允许对它的定义BakeF比我们以前看到的更清晰。它也可以像普通的旧Freemonad 一样减少样板文件，尽管我发现人们不太可能在实际代码中的两个不同场合找到索引自由 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
于 2015-12-11T20:02:00.780 回答
7

Polakow 在他的 Haskell Symposium 论文Embedding a full linear lambda calculus in Haskell (pdf) 中展示了如何做到这一点。

主要思想是使用输入和输出上下文来索引每个构造函数，以跟踪各个子项中消耗的资源。

于 2015-12-11T18:56:57.797 回答
1

部分解决方案。我们可以定义一个包装类型

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)

客户创造Caked价值的唯一途径是：

eat :: Cake -> Caked ()
eat = undefined

keep :: Cake -> Caked ()
keep = undefined

我们将Cake在回调中分配值：

withCake :: (Cake -> Caked b) -> IO b
withCake = undefined

我认为，这将确保eat并且keep仅在回调中被调用一次。

问题：不适用于多个Cake分配，并且Cake值仍然可以逃脱回调的范围（幻像类型在这里有帮助吗？）

于 2015-12-11T17:00:20.937 回答