[racket] Finite State Machines of Arbitrary Size using Racket's composable control
-----BEGIN PGP SIGNED MESSAGE-----
Hash: SHA1
Hi Zack,
On 15-05-12 18:56, Galler wrote:
> This code was generated in response to the user who sought to
> implement run-length encoding of a bit-vector on Sunday night.
>
> I didn't post this to the board b/c there's a much easier way to
> solve problem using regular expressions, which Eli B.
> demonstrated.
>
> But, the (infinite-k-pump) function strikes me as a correct and
> complete way to implement finite state machines (FSM) of aribtrary
> size in racket using composable control.
It seems that this function as you present it below is just the
2-state state-machine that solves the problem of that user, but that
it could be used as a template for how to implement arbitrary (larger)
FSMs.
> Its a toy, but maybe of some pedagogical use.
>
> Jay's web server works essentially the same way, though instead of
> one-byte signals, he's using http-requests.
Interesting. That would be the webserver that's built in to Racket right?
> Its a good 10 second answer to "what can you do with composable
> control" that would be impossible in its absence?
Unfortunately my grasp on composable control is tenuous at best, so
this 10 second answer goes over my head :(. In what way is this
solution impossible without it? I mean FSMs can be implemented without
it (and not just in the theoretical Turing-complete tarpit way).
Marijn
> #lang racket
>
> ;Finite State Machine of arbitrary size using composable control
>
>
> (require racket/control rackunit rackunit/text-ui)
>
> (define/contract (list-of-ranges-of-ones vtr) (-> (vectorof (or/c 1
> 0)) list?) (read (open-input-string (with-output-to-string (λ _
> (display "(")
>
> (encoding-scheme-helper (prompt (infinite-k-pump))
>
> (vector->list (vector-append vtr #(0)))) (display ")"))))))
>
> ;recursive function. Note the prompt which is how far the
> invocation of abort, in (infinite-k-pump) wipes out stack (define
> (encoding-scheme-helper kont lst) (unless (null? lst)
> (encoding-scheme-helper (prompt (kont (car lst))) (cdr lst))))
>
> (define (infinite-k-pump) (let ((counter 0)) (letrec
> ((incr-counter (λ _ (set! counter (add1 counter)))) (B (λ
> (signal) (if (= signal 0) (begin (display (sub1 counter)) (display
> ")") (incr-counter) (A (let/cc k (abort k)))) (begin
> (incr-counter) (B (let/cc k (abort k))))))) (A (λ (signal) (if (=
> signal 0) (begin (incr-counter) (A (let/cc k (abort k)))) (begin
> (display "( ") (display counter) (display " ") (incr-counter) (B
> (let/cc k (abort k)))))))) ;init function is A (A (let/cc k (abort
> k))))))
>
> ;(run-tests does-it-work?) ; 12 success(es) 0 failure(s) 0 error(s)
> 12 test(s) run
>
> (define does-it-work? (test-suite "Tests for FSM" (check-equal?
> (list-of-ranges-of-ones #(0)) '()) (check-equal?
> (list-of-ranges-of-ones #(0 0))'()) (check-equal?
> (list-of-ranges-of-ones #(0 0 0)) '()) (check-equal?
> (list-of-ranges-of-ones #(1)) '((0 0))) (check-equal?
> (list-of-ranges-of-ones #(1 1)) '((0 1))) (check-equal?
> (list-of-ranges-of-ones #(1 1 1)) '((0 2))) (check-equal?
> (list-of-ranges-of-ones #(1 1 1 0)) '((0 2))) (check-equal?
> (list-of-ranges-of-ones #(0 1 1 1)) '((1 3))) (check-equal?
> (list-of-ranges-of-ones #(0 1 1 1 0)) '((1 3))) (check-equal?
> (list-of-ranges-of-ones #( 0 1 1 1 0 0 0 1 1 1 0)) '((1 3) (7 9)))
> (check-equal? (list-of-ranges-of-ones #( 1 1 1 1 0 0 0 1 1 1 1))
> '((0 3) (7 10))) (check-equal? (list-of-ranges-of-ones #( 0 1 0 1 0
> 1 0 1 0 1 0)) '((1 1) (3 3) (5 5) (7 7) (9 9)))))
>
> ____________________ Racket Users list:
> http://lists.racket-lang.org/users
-----BEGIN PGP SIGNATURE-----
Version: GnuPG v2.0.19 (GNU/Linux)
Comment: Using GnuPG with Mozilla - http://enigmail.mozdev.org/
iEYEARECAAYFAk+57v8ACgkQp/VmCx0OL2yIBgCdGzqbOwJjBeKUrQgdYI4BcLwV
alUAmgMY4pm1cqy42e0Swy6g4tpvW/Pj
=RuYb
-----END PGP SIGNATURE-----