Question

编辑：用户@apocalisp和@BenjaminHodgson在下面留下了很棒的答案，跳过阅读大部分问题并跳转到他们的答案。

问题的TLDR ：我怎样才能从FSM表示组合爆炸的第一张图片到第二张图片，在那里您需要在继续之前访问所有这些图片。

我想构建一个有限状态机（实际上是在Haskell中，但我首先尝试使用Idris来查看它是否可以指导我的Haskell）哪里有一些必须访问的临时状态在达到最终状态之前。如果我能用一些状态的谓词任意约束FSM，那就太好了。

在下图中，有Initial个状态，3个临时状态A, B, C和Final状态。如果我没有弄错，在“正常”FSM中，您将始终需要n!个临时状态来表示可能路径的每个组合。

这是不可取的。

相反，使用类型系列，可能还有依赖类型，我认为应该可以有一种随身携带的状态，并且只有当它通过时某些谓词将被允许进入最终状态。（这是否使推倒自动机而不是FSM？）

到目前为止，我的代码（ idris ），通过类比，正在添加成分来制作沙拉，顺序无关紧要，但他们都需要将其制作成：

data SaladState = Initial | AddingIngredients | ReadyToEat

record SaladBowl where
       constructor MkSaladBowl
       lettuce, tomato, cucumber : Bool

data HasIngredient : (ingredient : SaladBowl -> Bool) -> (bowl : SaladBowl ** ingredient bowl = True) -> Type where
     Bowl : HasIngredient ingredient bowl

data HasIngredients : (ingredients : List (SaladBowl -> Bool))
                     -> (bowl : SaladBowl ** (foldl (&&) True (map (\i => i bowl) ingredients) = True)) 
                     -> Type where
     Bowlx : HasIngredients ingredients bowl

data SaladAction : (ty : Type) -> SaladState -> (ty -> SaladState) -> Type where
     GetBowl     : SaladAction SaladBowl Initial (const Initial)
     AddLettuce  : SaladBowl -> SaladAction (bowl ** HasIngredient lettuce bowl)  st (const AddingIngredients)
     AddTomato   : SaladBowl -> SaladAction (bowl ** HasIngredient tomato bowl)   st (const AddingIngredients)
     AddCucumber : SaladBowl -> SaladAction (bowl ** HasIngredient cucumber bowl) st (const AddingIngredients)
     MixItUp     : SaladBowl -> SaladAction (bowl ** (HasIngredients [lettuce, tomato, cucumber] bowl)) AddingIngredients (const ReadyToEat)
     Pure : (res : ty) -> SaladAction ty (state_fn res) state_fn
     (>>=) : SaladAction a state1 state2_fn
           -> ((res : a) -> SaladAction b (state2_fn res) state3_fn)
           -> SaladAction b state1 state3_fn

emptyBowl : SaladBowl
emptyBowl = MkSaladBowl False False False

prepSalad1 : SaladAction SaladBowl Initial (const ReadyToEat)
prepSalad1 = do
           (b1 ** _) <- AddTomato emptyBowl
           (b2 ** _) <- AddLettuce b1
           (b3 ** _) <- AddCucumber b2
           MixItUp b3

编译器应该出错的计数器示例程序：

BAD : SaladAction SaladBowl Initial (const ReadyToEat)
BAD = do
           (b1 ** _) <- AddTomato emptyBowl
           (b2 ** _) <- AddTomato emptyBowl
           (b3 ** _) <- AddLettuce b2
           (b4 ** _) <- AddCucumber b3
           MixItUp b4

BAD' : SaladAction SaladBowl Initial (const ReadyToEat)
BAD' = do
           (b1 ** _) <- AddTomato emptyBowl
           MixItUp b1

我最终希望“成分”成为Sums而不是Bools（data Lettuce = Romaine | Iceberg | Butterhead），以及更强大的语义，我可以说“你必须首先添加生菜，或菠菜，但不能同时添加”。< / p>

真的，我感到非常彻底迷失，我想我上面的代码已经走向了完全错误的方向......我怎样才能构建这个FSM（PDA？）来排除坏程序？我特别喜欢使用Haskell，也许使用 Indexed Monads ？

Answer 1

索引状态monad 就是这样做的。

常规State s monad模拟状态机（具体为 Mealy 机器），其状态字母为s类型。这种数据类型实际上只是一个函数：

newtype State s a = State { run :: s -> (a, s) }

类型a -> State s b的函数是一个输入字母a和输出字母b的机器。但它实际上只是(a, s) -> (b, s)类型的函数。

排除一台机器的输入类型和另一台机器的输出类型，我们可以组成两台机器：

(>>=) :: State s a -> (a -> State s b) -> State s b
m >>= f = State (\s1 -> let (a, s2) = run m s1 in run (f a) s2)

换句话说，State s是 monad 。

但有时（如你的情况），我们需要改变中间状态的类型。这是索引状态monad的用武之地。它有两个状态字母。 IxState i j a模拟一台机器，其开始状态必须在i，最终状态将在j中：

newtype IxState i j a = IxState { run :: i -> (a, j) }

常规State s monad等同于IxState s s。我们可以像IxState一样轻松地撰写State。实现与以前相同，但类型签名更通用：

(>>>=) :: IxState i j a -> (a -> IxState j k b) -> IxState i k b
m >>>= f = IxState (\s1 -> let (a, s2) = run m s1 in run (f a) s2)

IxState不完全是monad，而是索引monad 。

我们现在只需要一种指定状态类型约束的方法。对于沙拉的例子，我们想要这样的东西：

mix :: IxState (Salad r) Ready ()

这是一台机器，其输入状态是一些不完整的Salad，由成分r组成，其输出状态为Ready，表示我们的沙拉已准备好食用。

使用类型级别列表，我们可以这样说：

data Salad xs = Salad
data Ready = Ready
data Lettuce
data Cucumber
data Tomato

空沙拉有一个空的成分清单。

emptyBowl :: IxState x (Salad '[]) ()
emptyBowl = iput Salad

我们可以在任何沙拉中加入生菜：

addLettuce :: IxState (Salad r) (Salad (Lettuce ': r)) ()
addLettuce = iput Salad

我们可以为番茄和黄瓜重复相同的事情。

现在mix的类型只需要：

mix :: IxState (Salad '[Lettuce, Cucumber, Tomato]) Ready ()
mix = const Ready

如果我们尝试将尚未添加Lettuce，Cucumber和Tomato的沙拉按此顺序混合，我们会收到类型错误。例如。这将是一个类型错误：

emptyBowl >>>= \_ -> addLettuce >>>= \_ -> mix

但理想情况下，我们希望能够以任何顺序添加成分。所以我们需要对我们的类型级别列表进行约束，要求证明特定成分在我们的沙拉中的某个位置：

class Elem xs x

instance {-# OVERLAPS #-} Elem (x ': xs) x
instance Elem xs x => Elem (y ': xs) x

Elem xs x现在证明类型x位于类型级列表xs中。第一个实例（基本案例）说x显然是x ': xs的一个元素。第二个实例表示如果类型x是xs的元素，那么对于任何类型y ': xs，它也是y的元素。 OVERLAPS是必要的，以确保Haskell知道首先检查基本情况。

以下是完整列表：

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FlexibleContexts #-}

import Control.Monad.Indexed
import Control.Monad.Indexed.State

data Lettuce
data Tomato
data Cucumber

data Ready = Ready

class Elem xs x

instance {-# OVERLAPS #-} Elem (x ': xs) x
instance Elem xs x => Elem (y ': xs) x

data Salad xs = Salad

emptyBowl :: IxState x (Salad '[]) ()
emptyBowl = iput Salad

addLettuce :: IxState (Salad r) (Salad (Lettuce ': r)) ()
addLettuce = iput Salad

addTomato :: IxState (Salad r) (Salad (Tomato ': r)) ()
addTomato = iput Salad

addCucumber :: IxState (Salad r) (Salad (Cucumber ': r)) ()
addCucumber = iput Salad

mix :: (Elem r Lettuce, Elem r Tomato, Elem r Cucumber)
    => IxState (Salad r) Ready ()
mix = imodify mix'
  where mix' = const Ready

x >>> y = x >>>= const y

-- Compiles
test = emptyBowl >>> addLettuce >>> addTomato >>> addCucumber >>> mix

-- Fails with a compile-time type error
fail = emptyBowl >>> addTomato >>> mix

Answer 2

你的问题有点模糊，但我把它读作“我怎样才能逐步建立一个异构的'上下文'并在我在范围内拥有正确类型的值后创建一个记录？”下面是我如何为这个特殊的猫设置皮肤：不是通过一些monadic上下文来线程化输入和输出类型，让我们只使用普通的函数。如果你想使用聪明的类型级机制，你可以将它与你传递的值一起使用，而不是围绕特定的计算概念构建你的程序。

足够的胡扯。我将把异构上下文表示为嵌套元组。我将使用单位（()）来表示空的上下文，我将通过将上下文嵌套到新元组的左元素中来向上下文添加类型。因此，包含Int，Bool和Char的上下文如下所示：

type IntBoolChar = ((((), Int), Bool), Char)

希望您能看到如何逐步添加沙拉碗中的成分：

-- we will *not* be using this type like a state monad
addLettuce :: a -> (a, Lettuce)
addLettuce = (, Romaine)

addOlives :: a -> (a, Olive)
addOlives = (, Kalamata)

addCheese :: a -> (a, Cheese)
addCheese = (, Feta)

addGreekSaladIngredients :: a -> (((a, Lettuce), Olive), Cheese)
-- yes, i know you also need tomatoes and onions for a Greek salad. i'm trying to keep the example short
addGreekSaladIngredients = addCheese . addOlives . addLettuce

这不是高级魔术。它可以在任何语言中使用元组。我甚至在C＃中围绕这个想法设计了现实世界的API，以部分弥补C＃在Haskell中使用Applicative语法时缺乏currying的问题。 Here's an example来自我的解析器组合库：starting with an empty permutation parser，你Add一些不同类型的原子解析器，然后是Build一个解析器，它以不对顺序运行这些解析器方式，返回他们的结果的嵌套元组，然后你可以手工扁平。

问题的另一半是关于将这种背景的价值转化为记录。

data Salad = Salad {
    _lettuce :: Lettuce,
    _olive :: Olive,
    _cheese :: Cheese
}

您可以使用以下简单类以顺序不敏感的方式将嵌套元组一般映射到这样的记录：

class Has a s where
    has :: Lens' s a

-- this kind of function can be written generically using TH or Generics
toSalad :: (Has Lettuce s, Has Olive s, Has Cheese s) => s -> Salad
toSalad x = Salad (x^.has) (x^.has) (x^.has)

（这是对the HasX classes that lens generates with Template Haskell的直接概括。）

唯一需要某种类型聪明的部分是自动为嵌套元组实例化Has。我们需要区分两种情况：我们正在寻找的类型的项目位于一对的右侧，或者它位于该对左侧的嵌套元组内部的某个位置。问题在于，在一般情况下，这两种情况对于阐述者来说看起来是一样的：实例解析是通过简单的句法类型匹配过程实现的;不检查类型的等式，也不会发生回溯。

结果是我们需要The Advanced Overlap Trick。简而言之，该技巧使用封闭类型族来基于类型相等性来调度类型类。我们在两种选择之间进行选择，因此这是少数几种可以接受类型级布尔值的情况之一。

type family Here a as where
    Here a (_, a) = True
    Here a (_, b) = False

class Has' (here :: Bool) a s where
    has' :: Proxy here -> Lens' s a

instance Has' True a (as, a) where
    has' _ = _2
instance Has a as => Has' False a (as, b) where
    has' _ = _1.has

instance Has' (Here a (as, b)) a (as, b) => Has a (as, b) where
    has = has' (Proxy :: Proxy (Here a (as, b)))

此程序将停止第一个匹配类型的搜索。如果你的沙拉需要两种不同类型的生菜，你必须用newtype包裹一个。实际上，当你将这个缺点与重叠实例的复杂性结合起来时，我并不相信Has抽象会付出代价。我只是手工弄平了元组：

toSalad :: (((a, Lettuce), Olive), Cheese) -> Salad
toSalad (((_, l), o), c) = Salad l o c

但你确实失去了对顺序不敏感。

以下是一个示例用法：

greekSalad = toSalad $ addGreekSaladIngredients ()

ghci> greekSalad
Salad {_lettuce = Romaine, _olive = Kalamata, _cheese = Feta}  -- after deriving Show

这是完成的程序

{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeInType #-}
{-# LANGUAGE ScopedTypeVariables #-}

import Control.Lens hiding (has, has')
import Data.Proxy

data Lettuce = Romaine deriving (Show)
data Olive = Kalamata deriving (Show)
data Cheese = Feta deriving (Show)

data Salad = Salad {
    _lettuce :: Lettuce,
    _olive :: Olive,
    _cheese :: Cheese
} deriving (Show)

-- we will *not* be using this type like a state monad
addLettuce :: a -> (a, Lettuce) -- <<< Tuple Sections
addLettuce = (, Romaine)

addOlives :: a -> (a, Olive)
addOlives = (, Kalamata)

addCheese :: a -> (a, Cheese)
addCheese = (, Feta)

addGreekSaladIngredients :: a -> (((a, Lettuce), Olive), Cheese)
addGreekSaladIngredients = addCheese . addOlives . addLettuce

class Has a s where
  has :: Lens' s a

type family Here a as where
    Here a (_, a) = True
    Here a (_, b) = False

class Has' (here :: Bool) a s where
    has' :: Proxy here -> Lens' s a

instance Has' True a (as, a) where
    has' _ = _2

instance Has a as => Has' False a (as, b) where
    has' _ = _1.has

instance  Has' (Here a (as, b)) a (as, b) => Has a (as, b) where -- <<< Undecidable Instances
    has = has' (Proxy :: Proxy (Here a (as, b)))

toSalad :: (Has Lettuce s, Has Olive s, Has Cheese s) => s -> Salad
toSalad x = Salad (x ^. has) (x ^. has) (x ^. has)

greekSalad = toSalad $ addGreekSaladIngredients ()

-- nonSaladsError = toSalad $ (addCheese . addOlives) ()

如何在Haskell / Idris中使用约束有限状态机？

2 个答案: