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: 
34: 
35: 
36: 
37: 
38: 
39: 
40: 
41: 
42: 
43: 
44:

// 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

// [omit:Semantic model type definitions]
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
// [/omit]

// [omit:Internal DSL helper functions]
let event = Event
let command = Command
let state actions transitions = State(actions,transitions)
let (=>) event state = Transition(event,state)
// [/omit]

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]

Multiple items
val string : value:'T -> string

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

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

Full name: Microsoft.FSharp.Core.string

type event = | Event of code

Full name: Script.event

Multiple items
union case event.Event: code -> event

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

from Microsoft.FSharp.Control

--------------------
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 code = string

Full name: Script.code

type command = | Command of code

Full name: Script.command

union case command.Command: code -> command

type transition = | Transition of event * (unit -> state)

Full name: Script.transition

union case transition.Transition: event * (unit -> state) -> transition

type unit = Unit

Full name: Microsoft.FSharp.Core.unit

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

Full name: Script.state

union case state.State: seq<command> * seq<transition> -> state

Multiple items
val seq : sequence:seq<'T> -> seq<'T>

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

--------------------
type seq<'T> = System.Collections.Generic.IEnumerable<'T>

Full name: Microsoft.FSharp.Collections.seq<_>

Multiple items
val event : arg0:code -> event

Full name: Script.event

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

Full name: Script.event

Multiple items
val command : arg0:code -> command

Full name: Script.command

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

Full name: Script.command

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 actions : seq<command>

val transitions : seq<transition>

Multiple items
val event : event

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

Full name: Script.event

Multiple items
val state : (unit -> state)

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

Full name: Script.state

val doorClosed : event

Full name: Script.doorClosed

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

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

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

Next Version Raw view Test code New version

More information

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