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.
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.
Its a good 10 second answer to "what can you do with composable control"
that would be impossible in its absence?
R./
Zack
#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
