8 people like it.

Finite State Machine Parser

Based on Uncle Bob's State Machine Compiler for Clean Code video series, parser implemented with FParsec, see https://github.com/unclebob/CC_SMC for the Java implementation.

Abstract Syntax Tree

1: 
2: 
3: 
4: 
5: 
6: 
7: 

type Name = string
type Event = Event of Name
type State = State of Name
type Action = Action of Name
type Transition = Transition of State * Event * State * Action list
type Logic = Transition list
type Header = Header of Name * Name

Parser

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 
30: 
31: 
32: 
33: 
34: 
35: 
36: 
37: 
38: 
39: 

open FParsec

let pname = many1SatisfyL isLetter "name"

let pheader = pname .>> pstring ":" .>> spaces1 .>>. pname .>> spaces
              |>> fun (key,value) -> Header(key,value)

let pstate = pname .>> spaces1 |>> State
let pevent = pname .>> spaces1 |>> Event
let paction = pname |>> Action

let pactions = 
   paction |>> fun action -> [action]
   <|> between (pstring "{") (pstring "}") (many (paction .>> spaces))

let psubtransition =
   pipe3 pevent pstate pactions (fun ev ns act -> ev,ns,act)

let ptransition1 =
   pstate .>>. psubtransition
   |>> fun (os,(ev,ns,act)) -> [Transition(os,ev,ns,act)]

let ptransitionGroup =
   let psub = spaces >>. psubtransition .>> spaces
   pstate .>>. (between (pstring "{") (pstring "}") (many1 psub))
   |>> fun (os,subs) -> [for (ev,ns,act) in subs -> Transition(os,ev,ns,act)]

let ptransitions =
   let ptrans = attempt ptransition1 <|> ptransitionGroup
   between (pstring "{") (pstring "}") (many (spaces >>. ptrans .>> spaces))
   |>> fun trans -> List.collect id trans

let pfsm =
   spaces >>. many pheader .>>. ptransitions .>> spaces

let parse code =
   match run pfsm code with
   | Success(result,_,_) -> result
   | Failure(msg,_,_) -> failwith msg

Example 1

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 

let example1 = "Actions: Turnstile
          FSM: OneCoinTurnstile
          Initial: Locked
          {
            Locked Coin Unlocked {alarmOff unlock}
            Locked Pass Locked  alarmOn
            Unlocked Coin Unlocked thankyou
            Unlocked Pass Locked lock
          }
"
parse example1
(*
val it : Header list * Transition list =
  ([Header ("Actions","Turnstile"); 
    Header ("FSM","OneCoinTurnstile");
    Header ("Initial","Locked")],
   [Transition
      (State "Locked",Event "Coin",State "Unlocked", [Action "alarmOff"; Action "unlock"]);
    Transition 
      (State "Locked",Event "Pass",State "Locked",[Action "alarmOn"]);
    Transition
      (State "Unlocked",Event "Coin",State "Unlocked", [Action "thankyou"]);
    Transition 
      (State "Unlocked",Event "Pass",State "Locked",[Action "lock"])])

*)

Example 2

 1: 
 2: 
 3: 
 4: 
 5: 
 6: 
 7: 
 8: 
 9: 
10: 
11: 
12: 
13: 
14: 
15: 
16: 
17: 
18: 
19: 
20: 
21: 
22: 
23: 
24: 
25: 
26: 
27: 
28: 
29: 

let example2 = "Actions: Turnstile
          FSM: OneCoinTurnstile
          Initial: Locked{
             Locked {
               Coin Unlocked {alarmOff unlock}
               Pass Locked {alarmOn}
             }
                       
           Unlocked {
               Coin Unlocked {thankyou}
               Pass Locked {lock}
             }
          }
"
parse example2
(*
val it : Header list * Transition list =
  ([Header ("Actions","Turnstile"); 
    Header ("FSM","OneCoinTurnstile");
    Header ("Initial","Locked")],
   [Transition
      (State "Locked",Event "Coin",State "Unlocked", [Action "alarmOff"; Action "unlock"]);
    Transition 
      (State "Locked",Event "Pass",State "Locked",[Action "alarmOn"]);
    Transition
      (State "Unlocked",Event "Coin",State "Unlocked", [Action "thankyou"]);
    Transition 
      (State "Unlocked",Event "Pass",State "Locked",[Action "lock"])])
*)
Multiple items
val string : value:'T -> string

Full name: Microsoft.FSharp.Core.Operators.string

--------------------
type string = System.String

Full name: Microsoft.FSharp.Core.string
Multiple items
union case Event.Event: Name -> Event

--------------------
module Event

from Microsoft.FSharp.Control

--------------------
type Event = | Event of Name

Full name: Script.Event

--------------------
type Event<'T> =
  new : unit -> Event<'T>
  member Trigger : arg:'T -> unit
  member Publish : IEvent<'T>

Full name: Microsoft.FSharp.Control.Event<_>

--------------------
type Event<'Delegate,'Args (requires delegate and 'Delegate :> Delegate)> =
  new : unit -> Event<'Delegate,'Args>
  member Trigger : sender:obj * args:'Args -> unit
  member Publish : IEvent<'Delegate,'Args>

Full name: Microsoft.FSharp.Control.Event<_,_>

--------------------
new : unit -> Event<'T>

--------------------
new : unit -> Event<'Delegate,'Args>
type Name = string

Full name: Script.Name
Multiple items
union case State.State: Name -> State

--------------------
type State = | State of Name

Full name: Script.State
Multiple items
union case Action.Action: Name -> Action

--------------------
type Action = | Action of Name

Full name: Script.Action
Multiple items
union case Transition.Transition: State * Event * State * Action list -> Transition

--------------------
type Transition = | Transition of State * Event * State * Action list

Full name: Script.Transition
type 'T list = List<'T>

Full name: Microsoft.FSharp.Collections.list<_>
type Logic = Transition list

Full name: Script.Logic
Multiple items
union case Header.Header: Name * Name -> Header

--------------------
type Header = | Header of Name * Name

Full name: Script.Header
namespace FParsec
val pname : Parser<string,unit>

Full name: Script.pname
val many1SatisfyL : (char -> bool) -> string -> Parser<string,'u>

Full name: FParsec.CharParsers.many1SatisfyL
val isLetter : char -> bool

Full name: FParsec.CharParsers.isLetter
val pheader : Parser<Header,unit>

Full name: Script.pheader
val pstring : string -> Parser<string,'u>

Full name: FParsec.CharParsers.pstring
val spaces1 : Parser<unit,'u>

Full name: FParsec.CharParsers.spaces1
val spaces : Parser<unit,'u>

Full name: FParsec.CharParsers.spaces
val key : string
val value : string
val pstate : Parser<State,unit>

Full name: Script.pstate
val pevent : Parser<Event,unit>

Full name: Script.pevent
val paction : Parser<Action,unit>

Full name: Script.paction
val pactions : Parser<Action list,unit>

Full name: Script.pactions
val action : Action
val between : Parser<'a,'u> -> Parser<'b,'u> -> Parser<'c,'u> -> Parser<'c,'u>

Full name: FParsec.Primitives.between
val many : Parser<'a,'u> -> Parser<'a list,'u>

Full name: FParsec.Primitives.many
val psubtransition : Parser<(Event * State * Action list),unit>

Full name: Script.psubtransition
val pipe3 : Parser<'a,'u> -> Parser<'b,'u> -> Parser<'c,'u> -> ('a -> 'b -> 'c -> 'd) -> Parser<'d,'u>

Full name: FParsec.Primitives.pipe3
val ev : Event
val ns : State
val act : Action list
val ptransition1 : Parser<Transition list,unit>

Full name: Script.ptransition1
val os : State
val ptransitionGroup : Parser<Transition list,unit>

Full name: Script.ptransitionGroup
val psub : Parser<(Event * State * Action list),unit>
val many1 : Parser<'a,'u> -> Parser<'a list,'u>

Full name: FParsec.Primitives.many1
val subs : (Event * State * Action list) list
val ptransitions : Parser<Transition list,unit>

Full name: Script.ptransitions
val ptrans : Parser<Transition list,unit>
val attempt : Parser<'a,'u> -> Parser<'a,'u>

Full name: FParsec.Primitives.attempt
val trans : Transition list list
Multiple items
module List

from Microsoft.FSharp.Collections

--------------------
type List<'T> =
  | ( [] )
  | ( :: ) of Head: 'T * Tail: 'T list
  interface IEnumerable
  interface IEnumerable<'T>
  member Head : 'T
  member IsEmpty : bool
  member Item : index:int -> 'T with get
  member Length : int
  member Tail : 'T list
  static member Cons : head:'T * tail:'T list -> 'T list
  static member Empty : 'T list

Full name: Microsoft.FSharp.Collections.List<_>
val collect : mapping:('T -> 'U list) -> list:'T list -> 'U list

Full name: Microsoft.FSharp.Collections.List.collect
val id : x:'T -> 'T

Full name: Microsoft.FSharp.Core.Operators.id
val pfsm : Parser<(Header list * Transition list),unit>

Full name: Script.pfsm
val parse : code:string -> Header list * Transition list

Full name: Script.parse
val code : string
val run : Parser<'Result,unit> -> string -> ParserResult<'Result,unit>

Full name: FParsec.CharParsers.run
union case ParserResult.Success: 'Result * 'UserState * Position -> ParserResult<'Result,'UserState>
val result : Header list * Transition list
union case ParserResult.Failure: string * ParserError * 'UserState -> ParserResult<'Result,'UserState>
val msg : string
val failwith : message:string -> 'T

Full name: Microsoft.FSharp.Core.Operators.failwith
val example1 : string

Full name: Script.example1
val example2 : string

Full name: Script.example2
Raw view Test code New version

More information

Link:http://fssnip.net/oN
Posted:10 years ago
Author:Phillip Trelford
Tags: ast , parser , fparsec

This web site is created using F# and Suave web server. It is hosted on Azure and the source code is on GitHub. Contributions are welcome!

The first version of fssnip.net has been created by @tomaspetricek back in 2010. This web site is a new, open-source and contribution-friendly version.