http://usingcsp.com

CSP.fs

type Proc<'T> =
    | P of ('T -> option<Proc<'T>>)

exception Bleep

let def f =
    P (fun x -> try Some (f x) with Bleep | MatchFailureException _ -> None)

let rec ( <||> ) (P a) (P b) =
    let f x =
        match a x, b x with
        | Some dA, Some dB -> Some (dA <||> dB)
        | _ -> None
    P f

let fix f =
    let rec g x = let (P m) = s.Value in m x
    and s : Lazy<_> = lazy f (P g)
    P g

let stop () =
    P (fun _ -> None)

let ( ^-> ) a b =
    P (fun x -> if x = a then Some b else None)

let d x (P f) =
    match f x with
    | Some y -> y
    | None -> raise Bleep

let menu xs (P f) =
    let ok x = Option.isSome (f x)
    List.filter ok xs

let ds xs p =
    List.fold (fun p x -> d x p) p xs

type Vocab =
    | Choc
    | Coin
    | Right
    | Toffee
    | Up

let voc =
    [ Choc; Coin; Right; Toffee; Up ]

let vending =
    Coin ^-> Choc ^-> stop ()

let counter =
    def (function
    | Up -> stop ()
    | Right -> Right ^-> Up ^-> stop ())

let define f =
    fix (fun self -> def (f self))

let vending2 =
    fix (fun vending2 -> Coin ^-> def (function
    | Choc -> vending2
    | Toffee -> vending2))

let greedyCustomer =
    define (fun gc -> function
    | Toffee -> gc
    | Choc -> gc
    | Coin -> Choc ^-> gc)

let test () =
    menu voc (ds [Coin; Choc] (greedyCustomer <||> vending2))

type LoicVocab =
    | GetUp
    | GoHome
    | GotoWork
    | FixBugs
    | ReadReddit
    | Talk

let loicVoc =
    [
        GetUp
        GoHome
        GotoWork
        FixBugs
        ReadReddit
        Talk
    ]

let loic =
    GetUp ^-> GotoWork ^->
        define (fun talkative ->
            let enoughTalk =
                define (fun enoughTalk -> function
                | FixBugs -> enoughTalk
                | ReadReddit -> enoughTalk
                | GoHome -> stop ())
            function
            | FixBugs -> talkative
            | ReadReddit -> talkative
            | Talk -> enoughTalk
            | GoHome -> stop ())