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