; brainfuck
(define (filter pred? xs)
(let loop ((xs xs) (ys '()))
(cond ((null? xs) (reverse ys))
((pred? (car xs))
(loop (cdr xs) (cons (car xs) ys)))
(else (loop (cdr xs) ys)))))
(define (compile prog)
(list->vector
(filter (lambda (c) (member c (string->list "><+-.,[]")))
(string->list prog))))
(define (forward-match iv ip)
(let loop ((ip (+ ip 1)) (n 0))
(cond ((char=? (vector-ref iv ip) #\[)
(loop (+ ip 1) (+ n 1)))
((char=? (vector-ref iv ip) #\])
(if (zero? n) ip
(loop (+ ip 1) (- n 1))))
(else (loop (+ ip 1) n)))))
(define (backward-match iv ip)
(let loop ((ip (- ip 1)) (n 0))
(cond ((char=? (vector-ref iv ip) #\])
(loop (- ip 1) (+ n 1)))
((char=? (vector-ref iv ip) #\[)
(if (zero? n) ip
(loop (- ip 1) (- n 1))))
(else (loop (- ip 1) n)))))
(define (brainfuck prog)
(let* ((iv (compile prog))
(len (vector-length iv))
(dv (make-vector 30000 0)))
(let loop ((ip 0) (dp 0))
(when (< ip len)
(case (vector-ref iv ip)
((#\>) (loop (+ ip 1) (+ dp 1)))
((#\<) (loop (+ ip 1) (- dp 1)))
((#\+) (vector-set! dv dp (+ (vector-ref dv dp) 1))
(loop (+ ip 1) dp))
((#\-) (vector-set! dv dp (- (vector-ref dv dp) 1))
(loop (+ ip 1) dp))
((#\.) (display (integer->char (vector-ref dv dp)))
(loop (+ ip 1) dp))
((#\,) (vector-set! dv dp (char->integer (read-char)))
(loop (+ ip 1) dp))
((#\[) (if (zero? (vector-ref dv dp))
(loop (+ (forward-match iv ip) 1) dp)
(loop (+ ip 1) dp)))
((#\]) (if (zero? (vector-ref dv dp))
(loop (+ ip 1) dp)
(loop (+ (backward-match iv ip) 1) dp))))))))
(define hello (string-append
"+++++ +++++ initialize counter (cell #0) to 10"
"[ use loop to set the next four cells to 70/100/30/10"
" > +++++ ++ add 7 to cell #1"
" > +++++ +++++ add 10 to cell #2"
" > +++ add 3 to cell #3"
" > + add 1 to cell #4"
" <<<< - decrement counter (cell #0)"
"]"
"> ++ . print 'H'"
"> + . print 'e'"
"+++++ ++ . print 'l'"
". print 'l'"
"+++ . print 'o'"
"> ++ . print ' '"
"<< +++++ +++++ +++++ . print 'W'"
"> . print 'o'"
"+++ . print 'r'"
"----- - . print 'l'"
"----- --- . print 'd'"
"> + . print '!'"
"> . print '\n'"))
(brainfuck hello)
(define fib (string-append
">++++++++++>+>+["
" [+++++[>++++++++<-]>.<++++++[>--------<-]+<<<]>.>>["
" [-]<[>+<-]>>[<<+>+>-]<[>+<-[>+<-[>+<-[>+<-[>+<-[>+<-"
" [>+<-[>+<-[>+<-[>[-]>+>+<<<-[>+<-]]]]]]]]]]]+>>>"
" ]<<<"
"]"))
(brainfuck fib)