计算索引免费monad类型的详细信息

时间:2014-12-28 12:18:06

标签: haskell dsl

我一直在使用免费的monad来构建DSL。作为语言的一部分,有一个input命令,目的是反映类型级别的输入原语所期望的类型,以提高安全性。

例如,我希望能够编写以下程序。

concat :: Action '[String, String] ()
concat = do
  (x :: String) <- input
  (y :: String) <- input 
  output $ x ++ " " ++ y

与评估功能一起

eval :: Action params res -> HList params -> [String]
eval = ...

以下列方式运作..

> eval concat ("a" `HCons` "b" `HCons` HNil)
["a b"]

这是我到目前为止所拥有的。

data HList i where
  HNil :: HList '[]
  HCons :: h -> HList t -> HList (h ': t)

type family Append (a :: [k]) (b :: [k]) :: [k] where
  Append ('[]) l = l
  Append (e ': l) l' = e ': (Append l l')

data ActionF next where
   Input :: (a -> next) ->  ActionF next
   Output :: String -> next -> ActionF next

instance Functor ActionF where
  fmap f (Input c) = Input (fmap f c)
  fmap f (Output s n) = Output s (f n)

data FreeIx f i a where
  Return :: a -> FreeIx f '[] a
  Free :: f (FreeIx f i a) -> FreeIx f i a

type Action i a = FreeIx ActionF i a

liftF :: Functor f => f a -> FreeIx f i a
liftF = Free . fmap Return

input :: forall a . Action '[a] a
input = liftF (Input id)

output :: String -> Action '[] ()
output s = liftF (Output s ())

bind :: Functor f => FreeIx f t a -> (a -> FreeIx f v b) -> FreeIx f (Append t v) b
bind (Return a) f = f a
bind (Free x) f   = Free (fmap (flip bind f) x)

问题是liftF没有输入检查。

liftF :: Functor f => Proxy i -> f a -> FreeIx f i a
liftF p = Free . fmap Return

这是正确的方法吗?

我认为一些灵感可能来自effect monad包。这导致了ReturnFree的定义。

对于更多的背景故事:我已经在几个地方看到用户将以这种方式定义DSL,然后定义评估函数eval :: Action a -> [String] -> a或类似的东西。这种方法的明显问题是所有参数必须具有相同的类型,并且没有静态保证将提供正确数量的参数。这是试图解决这个问题。

6 个答案:

答案 0 :(得分:15)

我找到了解决这个问题的满意方案。这是对最终结果的预见:

addTwo = do
  (x :: Int) <- input
  (y :: Int) <- input 
  output $ show (x + y)

eval (1 ::: 2 ::: HNil) addTwo = ["3"]

完成此操作需要大量步骤。首先,我们需要观察ActionF数据类型本身已编入索引。我们将使用免费的monoid列表来调整FreeIx来构建索引monad。 Free的{​​{1}}构造函数需要捕获其两个索引之一的有限性的见证用于证明。我们将使用system due to András Kovács for writing proofs about appending type level lists来证明关联性和正确的身份。我们将describe indexed monads in the same manner as Oleg Grenrus。我们将使用FreeIx扩展名使用普通RebindbableSyntax表示法为IxMonad编写表达式。

序言

除了您的示例已经要求的所有扩展以及上面提到的do之外,我们还需要RebindbableSyntax来重复使用类型系列定义。

UndecidableInstances

我们将使用:~: GADT from Data.Type.Equality来操纵类型相等。

{-# LANGUAGE GADTs #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE KindSignatures #-}

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE RebindableSyntax #-}

由于我们将重新绑定import Data.Type.Equality import Data.Proxy 语法,因此我们会隐藏Monad导入中的所有MonadPrelude扩展名用于RebindableSyntax符号,无论函数do>>=>>是否在范围内。

fail

我们还有一些新的通用库代码。我给了import Prelude hiding (Monad, (>>=), (>>), fail, return) 一个中缀构造函数HList

:::

我已重命名data HList i where HNil :: HList '[] (:::) :: h -> HList t -> HList (h ': t) infixr 5 ::: 类型系列Append以镜像列表中的++运算符。

++

讨论type family (++) (a :: [k]) (b :: [k]) :: [k] where '[] ++ l = l (e ': l) ++ l' = e ': l ++ l' 形式的约束很有用。这些不存在于GADT之外的forall i. Functor (f i)内,可捕获the Dict GADT in constraints等约束。出于我们的目的,仅使用额外忽略的参数定义Haskell的版本就足够了。

Functor

索引ActionF

class Functor1 (f :: k -> * -> *) where fmap1 :: (a -> b) -> f i a -> f i b ActionF遗漏了某些内容,无法捕获有关方法要求的类型级别信息。我们将添加一个额外的索引类型Functor来捕获它。 i需要一种类型Input,而'[a]不需要任何类型Output。我们将这个新类型参数称为仿函数的索引。

'[]

我们会为data ActionF i next where Input :: (a -> next) -> ActionF '[a] next Output :: String -> next -> ActionF '[] next 撰写FunctorFunctor1个实例。

ActionF

FreeIx Reconstructed

我们将对instance Functor (ActionF i) where fmap f (Input c) = Input (fmap f c) fmap f (Output s n) = Output s (f n) instance Functor1 ActionF where fmap1 f = fmap f 进行两项更改。我们将改变索引的构造方式。 FreeIx构造函数将引用底层仿函数的索引,并生成一个Free,其索引是来自底层的索引的自由monoidal sum(FreeIx)仿函数和包裹++的索引。我们还要求FreeIx抓住证人证明底层函子的索引是有限的。

Free

我们可以为data FreeIx f (i :: [k]) a where Return :: a -> FreeIx f '[] a Free :: (WitnessList i) => f i (FreeIx f j a) -> FreeIx f (i ++ j) a 定义FunctorFunctor1个实例。

FreeIx

如果我们想将instance (Functor1 f) => Functor (FreeIx f i) where fmap f (Return a) = Return (f a) fmap f (Free x) = Free (fmap1 (fmap f) x) instance (Functor1 f) => Functor1 (FreeIx f) where fmap1 f = fmap f 与普通的无索引函子一起使用,我们可以将这些值提升为无约束的索引函子FreeIx。这个答案不需要这样做。

IxIdentityT

证明

我们需要证明有关附加类型级别列表的两个属性。为了写data IxIdentityT f i a = IxIdentityT {runIxIdentityT :: f a} instance Functor f => Functor (IxIdentityT f i) where fmap f = IxIdentityT . fmap f . runIxIdentityT instance Functor f => Functor1 (IxIdentityT f) where fmap1 f = fmap f ,我们需要证明正确的身份liftF。我们将此证明xs ++ '[] ~ xs称为附加权限身份。为了撰写appRightId,我们需要证明关联性bind,我们称之为xs ++ (yz ++ zs) ~ (xs ++ ys) ++ zs

证明是根据后继列表编写的,后者列表基本上是代理列表,每种类型appAssoc一个。

type SList xs ~ HFMap Proxy (HList xs)

以下相关性证明以及撰写此证明的方法是 due to András Kovács。通过仅使用data SList (i :: [k]) where SNil :: SList '[] SSucc :: SList t -> SList (h ': t) 作为我们解构的SList类型列表并将xs用于其他类型列表,我们可以延迟(可能无限期地)需要ProxyWitnessList个实例{1}}和ys

zs

appAssoc :: SList xs -> Proxy ys -> Proxy zs -> (xs ++ (ys ++ zs)) :~: ((xs ++ ys) ++ zs) appAssoc SNil ys zs = Refl appAssoc (SSucc xs) ys zs = case appAssoc xs ys zs of Refl -> Refl Refl的构造函数,只有在编译器拥有两种类型相等的证据时才能构造。 :~:上的模式匹配将类型相等的证明引入当前范围。

我们可以用类似的方式证明正确的身份

Refl

为了使用这些证明,我们为有限类型列表类构建见证列表。

appRightId :: SList xs -> xs :~: (xs ++ '[])
appRightId SNil = Refl
appRightId (SSucc xs) = case appRightId xs of Refl -> Refl

起重

配备class WitnessList (xs :: [k]) where witness :: SList xs instance WitnessList '[] where witness = SNil instance WitnessList xs => WitnessList (x ': xs) where witness = SSucc witness 我们可以将基础仿函数的提升值定义为appRightId

FreeIx

显式liftF :: forall f i a . (WitnessList i, Functor1 f) => f i a -> FreeIx f i a liftF = case appRightId (witness :: SList i) of Refl -> Free . fmap1 Return 适用于forallScopedTypeVariables构造函数和WitnessList i都需要证明索引的有限性FreeappRightId的证明用于说服编译器构造的appRightIdFreeIx f (i ++ '[]) a的类型相同。 FreeIx f i a来自'[],它包含在底层仿函数中。

我们的两个命令Returninput是按output编写的。

liftF

IxMonad和Binding

要使用type Action i a = FreeIx ActionF i a input :: Action '[a] a input = liftF (Input id) output :: String -> Action '[] () output s = liftF (Output s ()) ,我们将RebindableSyntax类定义为具有相同的函数名IxMonad(>>=)(>>)作为{{1}但是不同的类型。这个类在Oleg Grenrus's answer中描述。

fail

Monad实施class Functor1 m => IxMonad (m :: k -> * -> *) where type Unit :: k type Plus (i :: k) (j :: k) :: k return :: a -> m Unit a (>>=) :: m i a -> (a -> m j b) -> m (Plus i j) b (>>) :: m i a -> m j b -> m (Plus i j) b a >> b = a >>= const b fail :: String -> m i a fail s = error s 需要相关性证明bind。范围中唯一的FreeIx实例appAssoc是由解构的WitnessList构造函数捕获的实例。同样,明确的WitnessList i适用于Free

forall

ScopedTypeVariablesbind :: forall f i j a b. (Functor1 f) => FreeIx f i a -> (a -> FreeIx f j b) -> FreeIx f (i ++ j) b bind (Return a) f = f a bind (Free (x :: f i1 (FreeIx f j1 a))) f = case appAssoc (witness :: SList i1) (Proxy :: Proxy j1) (Proxy :: Proxy j) of Refl -> Free (fmap1 (`bind` f) x) bind个实例中唯一有趣的部分。

IxMonad

我们已经完成

所有困难的部分都已完成。我们可以用最直接的方式为FreeIx编写一个简单的解释器。唯一需要的技巧是避免instance (Functor1 f) => IxMonad (FreeIx f) where type Unit = '[] type Plus i j = i ++ j return = Return (>>=) = bind 构造函数Action xs ()上的模式匹配,直到知道类型列表HList非空为止,因为我们已在:::上匹配。

i

如果您对Input

的推断类型感到好奇
eval :: HList i -> Action i () -> [String]
eval inputs action = 
    case action of 
        Return () -> []
        Free (Input f) -> 
            case inputs of
                (x ::: xs) -> eval xs (f x)
        Free (Output s next) -> s : eval inputs next

它是

addTwo

答案 1 :(得分:11)

我有一个简单且通用的新解决方案。

到目前为止,在线程中我们使用了由monoid索引的monad,但是在这里我依赖于索引monad的另一个流行概念,即具有typestate转换的那个(Hoare逻辑风格):

    return :: a -> m i i a
    (>>=) :: m i j a -> (a -> m j k b) -> m i k b

我相信这两种方法是等价的(至少在理论上),因为我们通过使用内同态monoid索引来获得Hoare monad,并且我们也可以通过CPS编码在状态转换中的monoidal附加来反向。在实践中,Haskell的类型级和类级语言相当弱,因此在两个表示之间来回移动不是一种选择。

>>=的上述类型存在问题:它意味着我们必须以自上而下的顺序计算类型状态,即。即它强制IxFree的以下定义:

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

因此,如果我们有一个Free exp表达式,那么我们首先从i转换为j,然后从exp的构造函数转换为j,然后从k获取通过检查exp的子表达式来input。这意味着如果我们尝试在列表中累积-- compute transitions top-down test = do (x :: Int) <- input -- prepend Int to typestate (y :: String) <- input -- prepend String to typestate return () -- do nothing 类型,我们最终会得到一个反向列表:

eval

如果我们将类型附加到列表的末尾,则顺序是正确的。但是在Haskell中完成这项工作(尤其是使{-# LANGUAGE RebindableSyntax, DataKinds, GADTs, TypeFamilies, TypeOperators, PolyKinds, StandaloneDeriving, DeriveFunctor #-} import Prelude hiding (Monad(..)) class IxFunctor (f :: ix -> ix -> * -> *) where imap :: (a -> b) -> f i j a -> f i j b class IxFunctor m => IxMonad (m :: ix -> ix -> * -> *) where return :: a -> m i i a (>>=) :: m j k a -> (a -> m i j b) -> m i k b -- note the change of index orders (>>) :: m j k a -> m i j b -> m i k b -- here too a >> b = a >>= const b fail :: String -> m i j a fail = error data IxFree f i j a where Pure :: a -> IxFree f i i a Free :: f j k (IxFree f i j a) -> IxFree f i k a -- compute bottom-up instance IxFunctor f => Functor (IxFree f i j) where fmap f (Pure a) = Pure (f a) fmap f (Free fa) = Free (imap (fmap f) fa) instance IxFunctor f => IxFunctor (IxFree f) where imap = fmap instance IxFunctor f => IxMonad (IxFree f) where return = Pure Pure a >>= f = f a Free fa >>= f = Free (imap (>>= f) fa) liftf :: IxFunctor f => f i j a -> IxFree f i j a liftf = Free . imap Pure 工作)需要大量的校对,如果可能的话。

让我们自下而上计算类型状态。它使得我们根据语法树构建一些数据结构的各种计算更加自然,特别是它使我们的工作变得非常容易。

Action

现在实施data ActionF i j next where Input :: (a -> next) -> ActionF i (a ': i) next Output :: String -> next -> ActionF i i next deriving instance Functor (ActionF i j) instance IxFunctor ActionF where imap = fmap type family (++) xs ys where -- I use (++) here only for the type synonyms '[] ++ ys = ys (x ': xs) ++ ys = x ': (xs ++ ys) type Action' xs rest = IxFree ActionF rest (xs ++ rest) type Action xs a = forall rest. IxFree ActionF rest (xs ++ rest) a input :: Action '[a] a input = liftf (Input id) output :: String -> Action '[] () output s = liftf (Output s ()) data HList i where HNil :: HList '[] (:::) :: h -> HList t -> HList (h ': t) infixr 5 ::: eval :: Action' xs r a -> HList xs -> [String] eval (Pure a) xs = [] eval (Free (Input k)) (x ::: xs) = eval (k x) xs eval (Free (Output s nxt)) xs = s : eval nxt xs addTwice :: Action [Int, Int] () addTwice = do x <- input y <- input output (show $ x + y) 变得简单了。

Action' xs rest a

为了减少对用户的混淆,我引入了具有友好索引方案的类型同义词:xs表示该操作从rest读取,并且可能后跟包含Action读取的操作。 data IxStateF i j next where Put :: j -> next -> IxStateF j i next Get :: (i -> next) -> IxStateF i i next deriving instance Functor (IxStateF i j) instance IxFunctor IxStateF where imap = fmap put s = liftf (Put s ()) get = liftf (Get id) type IxState i j = IxFree IxStateF j i evalState :: IxState i o a -> i -> (a, o) evalState (Pure a) i = (a, i) evalState (Free (Get k)) i = evalState (k i) i evalState (Free (Put s k)) i = evalState k s test :: IxState Int String () test = do n <- get put (show $ n * 100) 是一个类型同义词,等同于线程问题中出现的同义词。

我们可以用这种方法实现各种DSL-s。反向打字顺序给它一点旋转,但我们可以做通常的索引monad所有相同。这是索引状态monad,例如:

VerifiedMonoid

现在,我相信这种方法比使用monoids进行索引更实际,因为Haskell没有类型类或一流类型级函数可以使monoid方法变得可口。如IdrisAgda这样的FreeIx课程会更好,其中包括除了常用方法之外的正确性证明。这样我们就可以编写一个{{1}},它在选择索引monoid时是通用的,而不仅限于提升列表或其他内容。

答案 2 :(得分:5)

关于索引monad的简短说明:它们是由monoids索引的monad。对于比较默认monad:

class Monad m where
  return :: a -> m a
  bind :: m a -> (a -> m b) -> m b
  -- or `bind` alternatives:
  fmap :: (a -> b) -> m a -> m b
  join :: m (m a) -> m a

monoid是一种配有mempty - 标识元素和(<>) :: a -> a -> a二元关联操作的类型。提升到类型级别,我们可以有Unit类型和Plus关联二进制类型操作。请注意,列表是值级别的免费monoid,HList是类型级别。

现在我们可以定义索引的monoid类:

class IxMonad m where
  type Unit
  type Plus i j

  return :: a -> m Unit a
  bind :: m i a -> (a -> m j b) -> m (Plus i j) b
  --
  fmap :: (a -> b) -> m i a -> m i b
  join :: m i (m j a) -> m (Plus i j) a

您可以为索引版本说明monad法律。您会注意到,对于要对齐的索引,它们必须遵守幺半群定律。


使用免费monad,你需要装备Functor returnjoin个操作。稍微改变你的定义:

data FreeIx f i a where
  Return :: a -> FreeIx f '[] a -- monoid laws imply we should have `[] as index here!
  Free :: f (FreeIx f k a) -> FreeIx f k a

bind :: Functor f => FreeIx f i a -> (a -> FreeIx f j b) -> FreeIx f (Append i j) b
bind (Return a) f = f a
bind (Free x) f   = Free (fmap (flip bind f) x)

我必须承认,我并非100%确定Free构造函数索引的合理性,但它们似乎有效。如果我们将wrap :: f (m a) -> m a类的函数MonadFree与法律一起考虑:

wrap (fmap f x) ≡ wrap (fmap return x) >>= f

以及对Free

free的评论
  

在实践中,您只需查看Free f fa(>>=)层,其中f执行替换并移植新的图层每个自由变量f

然后我们的想法是包装值不会影响索引


但是,您希望任何'[]值提升到任意索引的monadic值。这是一个非常合理的要求。但唯一有效的定义强制提升价值Unit - memptyliftF :: Functor f => f a -> FreeIx f '[] a liftF = Free . fmap Return 索引:

Return

如果您尝试将:: a -> FreeIx f k a定义更改为k[],而不是bind - 纯值可能有任意索引),那么data FreeIx m i a where FreeIx :: m a -> FreeIx m k a liftF :: Proxy i -> f a -> FreeIx f i a liftF _ = FreeIx returnIx :: Monad m => a -> FreeIx m i a returnIx = FreeIx . return bind :: Monad m => FreeIx m i a -> (a -> FreeIx m j b) -> FreeIx m (Append i j) b bind (FreeIx x) f = FreeIx $ x >>= (\x' -> case f x' of FreeIx y -> y) 定义不会进行类型检查。


我不确定您是否可以使免费索引monad仅使用小修正。一个想法是将任意monad提升为索引monad:

Functor

这种方法感觉有点像作弊,因为我们总是可以重新索引价值。


另一种方法是提醒 {{1}}它是一个索引编写器,或者使用索引编写器立即开始,如Cirdec's answer

答案 3 :(得分:5)

如果您愿意牺牲隐式排序并使用显式访问者,则可以使用Action '[Int, Int]实现ReaderT (HList '[Int, Int])。如果您使用提供镜头的vinyl等现有库,您可以编写如下内容:

-- Implemented with pseudo-vinyl
-- X and Y are Int fields, with accessors xField and yField
addTwo :: ReaderT (PlainRec '[X, Y]) Output ()
addTwo = do
  x <- view (rGet xField)
  y <- view (rGet yField)
  lift . output $ show (x + y) -- output :: String -> Output ()

通过约束传播强制执行类型安全:rGet xField引入了X成为记录成员的要求。

对于没有类型级机械的简单说明,请比较:

addTwo :: ReaderT (Int, Int) IO ()
addTwo = do
  x <- view _1
  y <- view _2
  lift . putStrLn $ show (x + y)

我们失去了排序属性,这是一个重大损失,特别是如果排序有意义,例如表示用户交互的顺序。

此外,我们现在 使用runReaderT(〜eval)。我们不能将用户输入与输出交错。

答案 4 :(得分:3)

  

编辑:我发布了更为一般的alternative answer。我离开   这个答案现在在这里,因为它可能是一个有用的例子   手工构建目标monad。

我的解决方案符合OP所要求的(尽管它涉及手动monad实例编写,因此当然还有改进的空间)。

effect-monad包(提到的OP)已经包含处理来自HList的读取的效果。它被称为ReadOnceReader。但是,对于Writer,我们还需要Output效果,在我看来,图书馆并没有让我们将这两者结合起来。

我们仍然可以理解ReadOnceReader并手动为所需语言编写AST。当然,AST应该是一个索引的monad。如果我们也可以通过索引的免费monad或操作monad来做到这一点,那将是很好的。到目前为止,我还没有获得过免费monad的成功。在查看运营单子后,我可能会更新我的答案。

预赛:

{-# LANGUAGE
    RebindableSyntax, DataKinds, ScopedTypeVariables,
    GADTs, TypeFamilies, TypeOperators,
    PolyKinds, StandaloneDeriving, DeriveFunctor #-}

import Prelude hiding (Monad(..))

data HList (xs :: [*]) where
  Nil  :: HList '[]
  (:>) :: x -> HList xs -> HList (x ': xs)
infixr 5 :>                     

type family (++) (xs :: [*]) (ys :: [*]) where
  '[] ++ ys = ys
  (x ': xs) ++ ys = x ': (xs ++ ys)

索引monad必须提供一种方法来组合(Plus)索引和身份(Unit)。简而言之,指数应该是幺半群。

class IxMonad (m :: k -> * -> *) where
  type Unit m :: k
  type Plus m (i :: k) (j :: k) :: k
  return :: a -> m (Unit m) a
  (>>=)  :: m i a -> (a -> m j b) -> m (Plus m i j) b
  fail   :: m i a

这里感兴趣的是Input的类型:我们将输入类型添加到下一次计算的结果索引中:

data Action i a where
  Return :: a -> Action '[] a
  Input  :: (x -> Action xs a) -> Action (x ': xs) a
  Output :: String -> Action i a -> Action i a
deriving instance Functor (Action i)

IxMonad实例和智能构造函数是完全标准的,eval函数也是直接实现的。

instance IxMonad Action where
  type Unit Action = '[]
  type Plus Action i j = i ++ j
  return = Return
  Return a     >>= f = f a
  Input k      >>= f = Input ((>>= f) . k)
  Output s nxt >>= f = Output s (nxt >>= f)
  fail = undefined

input :: Action '[a] a
input = Input Return

output :: String -> Action '[] ()
output s = Output s (Return ())

eval :: Action xs a -> HList xs -> [String]
eval (Return a)     xs        = []
eval (Input k)      (x :> xs) = eval (k x) xs
eval (Output s nxt) xs        = s : eval nxt xs

现在一切都按预期工作:

concat' :: Action '[String, String] ()
concat' = do
  (x :: String) <- input
  (y :: String) <- input 
  output $ x ++ " " ++ y

main = print $ eval concat' ("a" :> "b" :> Nil)
-- prints ["a b"]

答案 5 :(得分:1)

几年前我在github上有一个索引的免费monad的工作实现:

https://github.com/ekmett/indexed/blob/master/src/Indexed/Monad/Free.hs

它使用Conor McBride在Kleisli Arrows of Outrageous Fortune中提出的索引monad的形式,并且可以适应以本文所述的方式提供Bob Atkey风格的2索引免费monad。