Skip to content

Instantly share code, notes, and snippets.

Embed
What would you like to do?
#lang racket
(module+ test
(require rackunit))
(define state-machine
'((init (c more))
(more (a more)
(d more)
(r end))
(end)))
(define (run machine init-state stream)
(define (walker state stream)
(cond
[(empty? stream) #t]
[else
(let* ([in (first stream)]
[transitions (rest (assv state machine))]
[new-state (assv in transitions)])
(if new-state
(walker (first (rest new-state)) (rest stream))
#f))]))
(walker init-state stream))
(module+ test
(check-true (run state-machine 'init '(c a d a d d r)))
(check-false (run state-machine 'init '(c a d a d d r r))))
(define machine
(letrec ([init
(lambda (stream)
(cond
[(empty? stream) #t]
[else
(case (first stream)
[(c) (more (rest stream))]
[else #f])]))]
[more
(lambda (stream)
(cond
[(empty? stream) #t]
[else
(case (first stream)
[(a) (more (rest stream))]
[(d) (more (rest stream))]
[(r) (end (rest stream))]
[else #f])]))]
[end
(lambda (stream)
(cond
[(empty? stream) #t]
[else
(case (first stream)
[else #f])]))])
init))
(module+ test
(check-true (machine '(c a d a d d r)))
(check-false (machine '(c a d a d d r r))))
(define-syntax automaton
(syntax-rules (:)
[(_ init-state
(state : response ...)
...)
(let-syntax
([process-state
(syntax-rules (accept →)
[(_ accept)
(lambda (stream)
(cond
[(empty? stream) #t]
[else #f]))]
[(_ (label → target) (... ...))
(lambda (stream)
(cond
[(empty? stream) #f]
[else
(case (first stream)
[(label) (target (rest stream))]
(... ...)
[else #f])]))])])
(letrec ([state
(process-state response ...)]
...)
init-state))]))
(define m (automaton init
[init : (c → more)]
[more : (a → more)
(d → more)
(r → end)]
[end : accept]))
(module+ test
(check-true (m '(c a d a d d r)))
(check-false (m '(c a d a d d r r)))
(check-true (m '(c a d r)))
(check-false (m '(c a d a)))
(check-true (m '(c a d a r)))
(check-false (m '(c a d a r r))))
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment