Question

我想使用Haskell进行有限状态机分析和文档编制。我希望该库具有足够的通用性，在实例化特定的FSM时几乎不需要样板。

状态机定义基于状态s，事件e和动作a。主要要求是：

将计算机显示为文本（定义或派生Show）。
以精美的形式显示，例如为Graphviz发出dot表示法。
确定有向图的正确性（对正确性的某些定义），终止条件和其他属性。
使用状态机定义来帮助确保以其他语言实现FSM的测试覆盖范围（源代码生成，测试覆盖范围分析）。

我的初始实现如下：

import Data.List

data StateMachine s e a =
    StateMachine { 
                   states :: [s]                    -- ^states that the machine can be in
                 , events :: [e]                    -- ^events that the machine can process
                 , actions :: [a]                   -- ^actions the machine can perform
                 , initialStates :: [s]             -- ^starting states
                 , transitions :: [((s,e),(a,s))]   -- ^state transitions
                 }

-- |Find the action and next state for an event in the given state
nextOperation :: (Ord s, Ord e, Eq a) => 
                 StateMachine s e a -> s -> e -> Maybe (a, s)
nextOperation sm st ev = lookup (st, ev) (transitions sm)

-- |Find the next state from this state for an event, if present
nextTransition :: (Ord s, Ord e, Eq a) => StateMachine s e a -> s -> e -> Maybe s
nextTransition sm st ev = fmap snd $ nextOperation sm st ev
allNextStates :: (Ord s, Ord e, Eq a) => StateMachine s e a -> s -> [e] -> [s]
allNextStates _ _ [] = []
allNextStates sm st (ev:es) = case nextTransition sm st ev of
                                Just st' -> st': allNextStates sm st es
                                Nothing  -> allNextStates sm st es

-- |Compute the set of states reachable from a state
reachableStates :: (Ord s, Ord e, Eq a) => StateMachine s e a -> s -> [s]
reachableStates sm st = nub $ allNextStates sm st (events sm)

-- |Compute the transitive closure from the initial states
transitiveClosure :: (Ord s, Ord e, Eq a) => StateMachine s e a -> [s]
transitiveClosure sm = transitives sm (initialStates sm) (initialStates sm)
    where
        transitives :: (Ord s, Ord e, Eq a) => StateMachine s e a -> [s] -> [s] -> [s]
        transitives _ [] reach = reach
        transitives stm reachable@(st: sts) reach =
             let r = reachableStates stm st
                 rs = [r' | r' <- r, not (r' `elem` reach)]
             in
                if null rs
                then transitives stm sts reach
                else transitives stm (sts ++ rs) (reach ++ rs)

从那里开始，几乎所有测试可达性所需的操作都可以轻松构建传递闭包。但是，我到处都遇到了(Ord s, Ord e, Eq a)约束，并且一直遇到“模棱两可”的问题。就像我可以使用Java中的抽象类轻松定义它一样，这也激怒了我。

我的第二种方法是使用类型族，但这并不顺利。第一步是类的定义：

{-# language TypeFamilies #-}
{-# language MultiParamTypeClasses #-}

...    

class (Ord s, Show s) => SMstate s
class (Ord e, Show e) => SMevent e
class (Eq a, Show a) => SMaction a

class (SMstate s, SMevent e, SMaction a) => MachineState s e a where
    data MS s e a
    allEvents      :: MS s e a -> [e]
    initialStates  :: MS s e a -> [s]
    allStates      :: MS s e a -> [s]
    allActions     :: MS s e a -> [a]
    nextOperation  :: MS s e a -> s -> e -> Maybe (a,s)
nextTransition :: MS s e a -> s -> e -> Maybe s
nextTransition sm st ev = fmap snd $ nextOperation sm st ev
nextState      :: MS s e a -> s -> e -> s
nextState sm st ev = case nextTransition sm st ev of
                        Just st' -> st'
                        Nothing  -> st
allNextStates  :: MS s e a -> s -> [e] -> [s]
allNextStates _ _ [] = []
allNextStates sm st (ev:evs) =
    let nextStates = allNextStates sm st evs
    in  (maybeToList $ nextTransition sm st ev) ++ nextStates
reachableStates :: MS s e a -> s -> [s]
reachableStates sm s = nub $ allNextStates sm s (allEvents sm)
transitiveClosure :: MS s e a -> [s]
transitiveClosure sm = transitivesOf sm (initialStates sm) (initialStates sm)
    where
        transitivesOf :: MachineState s e a => MS s e a -> [s] -> [s] -> [s]
        transitivesOf _ [] reach = reach
        transitivesOf sm reachable@(st:sts) reach =
            let r = reachableStates sm st
                rs = [r' | r' <- r, r' `notElem` reach]
            in
                if null rs
                then transitivesOf sm sts reach
                else transitivesOf sm (sts ++ rs) (reach ++ rs)

由于将类约束连接到MachineState周围的定义中，因此我不必担心传播约束。

类型家庭是否可以做到这一点？如何将StateMachine连接到MachineState类？

Answer 1

该数据系列实际上无法完成您具体设置的StateMachine无法完成的任何工作。唯一真正的区别是约束被打包为单个约束，例如MachineState的“超类”。但这不需要数据系列-您也可以使用

class (SMstate s, SMevent e, SMaction a) => MachineState s e a
 {- Empty! -}

data StateMachine s e a =
    StateMachine { states :: [s]
                 , ... }

实际上，您甚至根本不需要一个类：

{-# LANGUAGE ConstraintKinds #-}
type MachineState s e a = (Ord s, Show s, Ord e, Show e, Eq a, Show a)

...尽管我会怀疑始终要求Show 是个好主意。

所以，不，我想说数据族不是路要走的路。您的原始方法是解决问题的方法，只需列出每个函数实际需要的约束。

如果您遇到模棱两可的类型，则可能意味着您偶然在函数中提到了类型变量，该变量不不使用完整的StateMachine，而仅使用了一些例如动作列表。在这种情况下，通常只需除去约束即可。

在某些应用程序中，模糊类型实际上是有用的。我认为您的情况并非如此，但是您可以签出-XTypeApplications扩展名，这是调用具有歧义类型的函数所必需的。

一个常规的工作流程，我建议这样做：

以签名启动功能，但没有任何约束且实现为空。

nextOperation :: StateMachine s e a -> s -> e -> Maybe (a, s)
nextOperation = _

让GHC的打孔功能有助于您编写实现。
添加编译器所需的任何约束。

如果它还抱怨缺少扩展名，以下是我总是会毫无保留地执行的操作：

FlexibleInstances（包括TypeSynonymInstances）
FlexibleContexts
TypeFamilies
GADTs
ConstraintKinds

并非毫无争议，但IMO也没什么大不了的

UndecidableInstances
LiberalTypeSynonyms
AllowAmbiguousTypes + TypeApplications
Rank2Types

请勿使用，除非您真的要

OverlappingInstances（分别是Overlapping / Overlappable编译指示）
绝对不是IncoherentInstances
ImpredicativeTypes

Answer 2

过去我需要一些状态机，而AFAIR一切都归结为一个转换函数和一些基本类型类的使用。您的nextOperation函数应该足够

例如，假设我有

type Transition s e a :: s -> e -> Maybe (a,s)

data State = Pending | InProgress | Processed 
data Even = Start | Finished

nextOperation :: Transition State Event (IO ())
nextOperation Pending Start = Just (print "started", InProgress)
nextOperation InProgress Finished = Just (print "finished", Processed)
nextOperation _ _ = Nothing

您可以创建一个给定转换列表的函数，以创建类似nextOperation的函数

fromTransition :: [(s, e), (a,s)] -> s -> e -> Maybe (a,s)

（我让您实现它）

要编写transitiveClosure函数，您需要所有状态，所有事件和所有初始状态的列表。使用[minBound .. maxBound]可以轻松完成所有状态和所有事件的处理，这需要从GHC自动生成的Enum和Bounded约束，所以您只需要

data State = Pending | InProgress | Processed deriving (Eq, Show, Enum, Bounded)

对于初始状态，您有两个选择，您可以将其作为参数传递给transiveiveClosure或创建新的类型类

class Initials a where
     initials :: [a]

有一些常见实例

实例首字母（），其中首字母= [（）] 实例缩写（也许是a），其中缩写= [Nothing] 实例Initials Bool，其中缩写= [False] 实例编号a =>首字母a，其中首字母= [0]

元组之类的东西开始变得有趣

instance (Initials a, Initials b) => Initials (a,b) 
     where initials = liftA2 (,) initials initials

当然还有State

instance Initials State where initials = [Pending]

然后transitiveClosure仅需要以下签名

transitiveClosure :: ( Bounded s, Enum s, Initials s
                     , Bounded e, Enum )
                  => (Transition s e a) -> [s]

我们仅创建了一个类型类（Initials），该类型类与状态机无关（几乎）没有任何事情可用于其他用途。此外，通过(,)实例，您可以轻松扩展状态并免费获得新的缩写状态。

其他所有功能都只是操作或创建Transition的功能（我在这里使用类型同义词，但您可以只使用普通功能类型）。某些功能可能比其他功能（例如，Show或Ord，Enum等...）更禁忌。

TL; DR 简而言之，状态机只是转换函数s -> e -> Maybe (a,s)。 Haskell是一种功能性语言，因此我们实际上可以将其建模为一种功能。没有了

如何打包状态机库

2 个答案: