-----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----- ____________________ Racket Users list: http://lists.racket-lang.org/users