I appreciate any feedback on where I might alter or improve my code for this project. This is an old attempt at implementing a Hierarchical State Machine in F#. I'm from a C#/OO background mostly.
module FSharp.HSM
open Option
open System.Collections.Generic
exception NoTransition
exception NotInitialized
exception AlreadyStarted
type IStateMachine<'state,'event> =
abstract member StateChanged: IEvent<'state>
abstract member Init: 'state -> unit
abstract member State: 'state with get
abstract member IsIn: 'state -> bool
abstract member Fire: 'event -> unit
abstract member Fire: 'event * obj -> unit
type Transition<'state,'event> =
{ Event: 'event
NextState: 'event -> obj -> 'state option
Guard: unit -> bool }
type StateConfig<'state,'event> =
{ State: 'state
Entry: unit -> unit
Exit: unit -> unit
SuperState: 'state option
Parents: 'state list
AutoTransition: 'state option
Transitions: Transition<'state,'event> list }
type internal StateMachine<'state,'event when 'state : equality and 'event :equality>(stateList:StateConfig<'state,'event> list) =
let stateEvent = new Event<'state>()
let mutable current = stateList.Head.State
let mutable started = false
let states = stateList |> List.map (fun x -> x.State) |> List.toArray
let configs = new Dictionary<'state,StateConfig<'state,'event>>()
let find state : StateConfig<'state,'event> = configs.[state]
let rec getParents results state =
let currentConfig = stateList |> List.find (fun x -> x.State = state)
if isSome currentConfig.SuperState then
let super = get currentConfig.SuperState
getParents (super::results) super
else results |> List.rev
do
for stateConfig in stateList do
configs.[stateConfig.State] <- { stateConfig with Parents = getParents [] stateConfig.State }
let rec findTransition event state =
match state.Transitions |> List.tryFind (fun x -> x.Event = event), state.SuperState with
| None, None -> raise NoTransition
| None, Some x -> findTransition event (find x)
| Some x, _ -> x
let rec exitToCommonParent state limit =
match state.SuperState, limit with
| None, _ -> ()
| Some super, Some lim when super = lim -> ()
| Some super, _ ->
let superConfig = find super
superConfig.Exit()
exitToCommonParent superConfig limit
let rec findCommon (list1:'state list) list2 =
if list1.IsEmpty then None else
let restOfList1 = list1.Tail
match list2 |> List.tryFind (fun x -> x = list1.Head), restOfList1 with
| None, [] -> None
| None, _ -> findCommon restOfList1 list2
| Some x, _ -> Some(x)
let rec transition currentState newState =
let currentStateConfig = find currentState
let newStateConfig = find newState
let isSelf = currentStateConfig.State = newStateConfig.State
let moveToSub = not isSelf || newStateConfig.Parents |> List.exists (fun x -> x = currentState)
let commonParent = if isSelf then None else findCommon currentStateConfig.Parents newStateConfig.Parents
if not moveToSub || isSelf then
currentStateConfig.Exit()
exitToCommonParent currentStateConfig commonParent
//enter parents below common Parents before newState,
//but not if we just autoed from there..
match commonParent with
| None -> ()
| Some x -> //todo: optimize this
let revParents = newStateConfig.Parents |> List.rev
let index = revParents |> List.findIndex (fun y -> y = x)
for parent in revParents |> Seq.skip (index + 1) do
if parent <> currentState then (find parent).Entry()
current <- newState
newStateConfig.Entry()
stateEvent.Trigger newState
match newStateConfig.AutoTransition with
| None -> ()
| Some x -> transition newState x
interface IStateMachine<'state, 'event> with
///Initializes the state machine with its initial state
member this.Init state =
if started then raise AlreadyStarted else started <- true
let stateConfig = find state
current <- state
stateConfig.Entry()
stateEvent.Trigger current
match stateConfig.AutoTransition with
| None -> ()
| Some x -> transition state x
///Gets the current state
member this.State with get() = if not started then raise NotInitialized else current
///Raise on a state change
member this.StateChanged = stateEvent.Publish
///Check whether in state or parent state
member this.IsIn (state:'state) =
if not started then raise NotInitialized
if current = state then true else
(find current).Parents |> List.exists (fun x -> x = state)
///Fire an event without data
member this.Fire(event) =
if not started then raise NotInitialized
let cur = find current
let trans = findTransition event cur
if trans.Guard() then
let nextState = trans.NextState event null
if isSome nextState then
transition current (get nextState)
///Fire an event with data
member this.Fire(event, data) =
let cur = find current
let trans = findTransition event cur
if trans.Guard() then
let nextState = trans.NextState event data
if isSome nextState then
transition current (get nextState)
let create(stateList:StateConfig<'state,'event> list) = (new StateMachine<'state,'event>(stateList)) :> IStateMachine<'state,'event>
///Sets up a new state config
let configure state =
{ State = state; Entry = (fun () -> ()); Exit = (fun () -> ());
SuperState = None; Parents = []; AutoTransition = None; Transitions = [] }
///Sets an action on the entry of the state
let onEntry f state = {state with Entry = f }
///Sets an action on the exit of the state
let onExit f state = {state with Exit = f }
///Sets this state as a substate of the given state
let substateOf superState state = { state with SuperState = Some(superState) }
///Sets an auto transition to a new state
let transitionTo substate state = { state with AutoTransition = Some(substate) }
///Sets a transition to a new state on an event (same state allows re-entry)
let on event endState state =
{ state with Transitions =
{ Event = event; NextState = (fun _ _ -> Some(endState)); Guard = (fun () -> true) }::state.Transitions }
///Sets a guarded transition to a new state on an event (same state allows re-entry)
let onIf event guard endState state =
{ state with Transitions =
{ Event = event; NextState = (fun _ _ -> Some(endState)); Guard = guard }::state.Transitions }
///Sets an event handler (with or without data) which returns the new state to transition to
let handle event f state =
{ state with Transitions =
{ Event = event; NextState = f; Guard = (fun () -> true) }::state.Transitions }
///Sets a guarded event handler (with or without data) which returns the new state
let handleIf event guard f state =
{ state with Transitions =
{ Event = event; NextState = f; Guard = guard }::state.Transitions }
Here's a simple example from some test code:
type State =
| OffHook
| Ringing
| Connected //composite
| InCall
| OnHold
type Trigger =
| CallDialed
| HungUp
| CallConnected
| PlacedOnHold
| TakenOffHold
let mutable timerOn = false
let startTimer() =
printfn "%A connected" DateTime.Now
timerOn <- true
let stopTimer() =
printfn "%A ended" DateTime.Now
timerOn <- false
let newPhoneCall() =
[ configure OffHook
|> on CallDialed Ringing
configure Ringing
|> on CallConnected Connected
configure Connected
|> onEntry startTimer
|> onExit stopTimer
|> transitionTo InCall
|> on HungUp OffHook
configure InCall
|> substateOf Connected
|> on PlacedOnHold OnHold
configure OnHold
|> substateOf Connected
|> on TakenOffHold InCall ]
|> create
and a much more complicated example from an article about HSM's I used as a ref:
type State =
| S0
| S1
| S11
| S2
| S21
| S211
type Sig =
| A
| B
| C
| D
| E
| F
| G
| H
type ComplexHSM() =
let mutable foo = false
let hsm = [ configure S0
|> onEntry (fun () -> printfn "Enter S0")
|> onExit (fun () -> printfn "Exit S0")
|> transitionTo S1
|> on E S211
configure S1
|> onEntry (fun () -> printfn "Enter S1")
|> onExit (fun () -> printfn "Exit S1")
|> substateOf S0
|> transitionTo S11
|> on A S1
|> on B S11
|> on C S211
|> on D S0
|> on F S211
configure S11
|> onEntry (fun () -> printfn "Enter S11")
|> onExit (fun () -> printfn "Exit S11")
|> substateOf S1
|> on G S211
|> handleIf H (fun () -> foo) (fun event arg -> printfn "fooFal"; foo <- false; None)
configure S2
|> onEntry (fun () -> printfn "Enter S2")
|> onExit (fun () -> printfn "Exit S2")
|> substateOf S0
|> on C S1
|> on F S11
configure S21
|> onEntry (fun () -> printfn "Enter S21")
|> onExit (fun () -> printfn "Exit S21")
|> substateOf S2
|> transitionTo S211
|> on B S211
|> handleIf H (fun () -> not foo) (fun event arg -> printfn "fooTru"; foo <- true; Some(S21) )
configure S211
|> onEntry (fun () -> printfn "Enter S211")
|> onExit (fun () -> printfn "Exit S211")
|> substateOf S21
|> on D S21
|> on G S0 ]
|> create
member this.Hsm with get() = hsm