4 people like it.

Miss Grant's Controller

State machine example, from Martin Fowler's Domain-Specific Languages book, implemented as an Internal DSL in F#. The semantic model is implemented with F# discriminated unions. A custom operator (=>) specifies state transitions from events. Finally mutually recursive functions define the state machine.

 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: 
// Miss Grant's Controller as an Internal DSL in F#
// See Domain-Specific Languages: An Introductory Example by Martin Fowler
// http://www.informit.com/articles/article.aspx?p=1592379&seqNum=3

Semantic model type definitions

Internal DSL helper functions

let doorClosed =    event "D1CL"
let drawerOpened =  event "D2OP"
let lightOn =       event "L1ON"
let doorOpened =    event "D1OP"
let panelClosed =   event "PNCL"

let unlockPanel =   command "PNUL"
let lockPanel =     command "PNLK"
let lockDoor =      command "D1LK"
let unlockDoor =    command "D1UL"

let rec idle () = 
    state
        [unlockDoor; lockPanel]
        [doorClosed => active]
and active () =
    state 
        [] 
        [drawerOpened => waitingForLight
         lightOn => waitingForDrawer]       
and waitingForLight () =
    state [] [lightOn => unlockedPanel]
and waitingForDrawer () =
    state [] [drawerOpened => unlockedPanel]
and unlockedPanel () =
    state
        [unlockPanel; lockDoor]
        [panelClosed => idle]
type code = string
type event = Event of code
type command = Command of code
type transition = Transition of event * (unit -> state)
and state = State of command seq * transition seq
let event = Event
let command = Command
let state actions transitions = State(actions,transitions)
let (=>) event state = Transition(event,state)
val doorClosed : event

Full name: Script.doorClosed
Multiple items
val event : arg0:code -> event

Full name: Script.event

--------------------
type event = | Event of code

Full name: Script.event
val drawerOpened : event

Full name: Script.drawerOpened
val lightOn : event

Full name: Script.lightOn
val doorOpened : event

Full name: Script.doorOpened
val panelClosed : event

Full name: Script.panelClosed
val unlockPanel : command

Full name: Script.unlockPanel
Multiple items
val command : arg0:code -> command

Full name: Script.command

--------------------
type command = | Command of code

Full name: Script.command
val lockPanel : command

Full name: Script.lockPanel
val lockDoor : command

Full name: Script.lockDoor
val unlockDoor : command

Full name: Script.unlockDoor
val idle : unit -> state

Full name: Script.idle
Multiple items
val state : actions:seq<command> -> transitions:seq<transition> -> state

Full name: Script.state

--------------------
type state = | State of seq<command> * seq<transition>

Full name: Script.state
val active : unit -> state

Full name: Script.active
val waitingForLight : unit -> state

Full name: Script.waitingForLight
val waitingForDrawer : unit -> state

Full name: Script.waitingForDrawer
val unlockedPanel : unit -> state

Full name: Script.unlockedPanel

More information

Link:http://fssnip.net/5g
Posted:7 years ago
Author:
Tags: dsl