How to represent a simple finite state machine in Ocaml?

Question

I have written some state machine in C++ and Java but never in a functional language like Ocaml

Problem is I don't know if I can just adapt code from the object languages versions, since in Ocaml records and variants are more powerful than class;

So, I need an event-driven finite state machine (hierarchical like in UML), easily configurable

Could someone experienced in the field post a simple sample of that ? Just to avoid the most common traps

thanks :)

EDIT 16/03 : Is it possible to do it without mutable state ? And I'd like to encapsulate it properly under the name "FSM", should I choose a module or a class ?

Attenuation

possible duplicate of automata in ocaml – Jejune

Answer 1

Usually, you create a record corresponding to a state of the automata, and you have another type for the event triggering the transition to another state. In the state record, you have a map to find, for each event, the new state.

Let's suppose your transitions are triggered by strings:

type event = string

module EventMap = Map.Make(struct
    type t = event
    let compare = compare
  end)

type state = {
  state_info : ...; (* the content of that state, id, comment, etc. *)
  mutable state_transitions : state EventMap.t;
}

let next_state current_state event =
  try
    EventMap.find event current_state.state_transitions
  with Not_found -> current_state

Here, I supposed that unknown events stay on the same state, but you could have an error state in the record...

Gaillardia

Is it possible to do it without mutable state ? And I'd like to encapsulate it properly under the name "FSM", should I choose a module or a class ? – Attenuation

Answer 2

It depends on how you have to operate the FSM, e.g., if you need to be able to store its state and continue later, or if you just want to execute it immediately. In the latter case, it's trivial to do it as a bunch of tail-recursive functions.

For example, assume the regexp C((A|B)*CD)* -- the following mutually recursive functions are a direct implementation of the respective FSM that recognises a list matching this regexp (if I didn't make any mistake :) ):

type alphabet = A | B | C | D

let rec s1 = function
  | C :: rest -> s2 rest
  | _ -> false

and s2 = function
  | [] -> true
  | (A | B) :: rest -> s2 rest
  | C :: rest -> s3 rest
  | _ -> false

and s3 = function
  | D :: rest -> s2 rest
  | _ -> false

Every function corresponds to exactly one state of the automaton and implements its transition function. Applying s1 : alphabet list -> bool will run the FSM on the argument.

PS: Note how this is an application demonstrating the benefit and elegance of tail call optimization...

Coverall

Answer 3

There is an excellent answer which demonstrates expressiveness and elegance of OCaml in representing finite state machine here:

automata in ocaml

For more serious use, you could try to look at some finite state machine library like fsm library here.

Rathbone

Answer 4

I recently created an FSM module in OCaml which you can find here

I have some special requirements for my FSM implementation which could make it not quite as nice to look at as some of the others pointed out here, however, I think the way you declare the FSM itself is kind of nice and declarative. The special requirement is that I need to be able to generate code in HDL (hardware description language) from a declarative description of the FSM in addition to being able to simulate the FSM's operation in the OCaml version. Because of this I needed to use predicate expressions instead of transition functions (otherwise, how would I translate a function to a string?) So mainly you want to focus on the FSM module there and the create and eval_fsm functions there.

Here is an example of usage:

(*********************************************************
 * FSM testing *******************************************
*)

(* inputs to the FSM *)
let full         = Var({name ="full"; value  = F});;
let ten_minutes  = Var({name = "ten_minutes"; value = F});;
let empty        = Var({name = "empty"; value = F});;
let five_minutes = Var({name = "five_minutes"; value =F});;


(* T is true,    F is false *)
let _ = 
  assign full         F ;
  assign ten_minutes  F ;
  assign empty        F ;
  assign five_minutes F ;;

(* outputs from the FSM *)
let water_on     = Var({name = "water_on";    value = F});;
let agitate      = Var({name = "agitate";     value = F});;
let drain        = Var({name = "drain"  ;     value = F});;
let start_timer  = Var({name = "start_timer"; value = F});;
let motor_on     = Var({name = "motor_on";    value = F});;
let washed       = Var({name = "washed";    value = F});;
let soap         = Var({name = "soap";        value = F});;

let reset_actions = 
  assign water_on      F;
  assign agitate       F;
  assign drain         F;
  assign start_timer   F;
  assign motor_on      F;;

module WashStates = 
  struct
   type t =  START | FILL | WASH | DRAIN |  RINSE | SPIN | STOP
     deriving(Show, Enum)    
   let start_state = START
  end 

module LogicExp = 
  struct
    type t     = boolean Logic.bexp
    type var_t = boolean Logic.variable
    let eval_exp exp = to_bool (Logic.eval exp)
    let var_to_s     = var_to_s
  end

module WashFSM = FSM(WashStates)(LogicExp) 

open WashStates

(* declare the state table *)
(*   CS,   PREDICATE,               NS,    ACTIONs *)
let my_fsm = [
  (START, Const(T),                 FILL, [(water_on,   T); 
                                           (soap,       T)]);
  (FILL,  Bop(And,full,soap),       WASH, [(water_on,   F);
                                           (agitate,    T);
                                           (washed,     T);
                                           (start_timer,T)]);
  (WASH,  ten_minutes,              DRAIN,[(agitate,    F);
                                           (start_timer,F); 
                                           (empty,      T)]); 
  (DRAIN, Bop(And,empty,soap),      FILL, [(drain,      F); 
                                           (soap,       F);
                                           (water_on,   T)] );
  (FILL,  Bop(And,full,Not(soap)),  RINSE,[(water_on,   F); 
                                           (soap,       F);
                                           (empty,      F);
                                           (agitate,    T)]);
  (RINSE, ten_minutes,              DRAIN, [(agitate,   F);
                                            (empty,     T)] );
  (DRAIN, Bop(And,empty,Not(soap)), SPIN,  [(motor_on,  T);
                                            (start_timer,T)]);
  (SPIN,  five_minutes,             STOP,  [(water_on,  F);
                                            (drain,     F);
                                            (start_timer,F);
                                            (motor_on,  F)]);
  (STOP,  Const(T),                 STOP,  [(motor_on,  F)]);
];; 


let st_table, current_state = WashFSM.create my_fsm in

let _ = assign full T in
let current_state = WashFSM.eval_fsm st_table current_state  in
let _ = assign ten_minutes T in
let current_state = WashFSM.eval_fsm st_table current_state  in
let current_state = WashFSM.eval_fsm st_table current_state  in
let _ = (assign ten_minutes F);(assign empty T) in
let current_state = WashFSM.eval_fsm st_table current_state  in

let _ = assign five_minutes T in
let current_state = WashFSM.eval_fsm st_table current_state  in
let _ = assign five_minutes F in
let _ = assign ten_minutes T in
let current_state = WashFSM.eval_fsm st_table current_state  in
let current_state = WashFSM.eval_fsm st_table current_state  in
let _ = assign five_minutes T in
let _ = WashFSM.eval_fsm st_table current_state  in
(*...and so on...*)

(Please excuse the ";;" endings - I wanted to be able to cut & paste this code into the REPL)

Some of the code used here is found in the Logic project on my github (fsm.ml is part of that project). The predicate expression evaluates to either T or F (true or false). If true, then the transition is made from current state to next state. Const T means always transition. An expression such as:

Bop(And, full, soap) 

Means that if both full and soap are T (true) then the expression evaluates to true.

Spurn