4 people like it.
Like the snippet!

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:

// 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 [] [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 waitingForDrawer : unit -> state

Full name: Script.waitingForDrawer

val waitingForLight : unit -> state

Full name: Script.waitingForLight

val unlockedPanel : unit -> state

Full name: Script.unlockedPanel

Previous Version Next Version Raw view Test code New version

More information

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