Skip to content

Instantly share code, notes, and snippets.

Created Dec 5, 2011
What would you like to do?
brainfuck interpreter in scheme
(define (new-bf)
(let ((tape (make-vector 30000 0))(ptr 0))
(define (reset [sz 30000]) (set! tape (make-vector sz 0)) (set! ptr 0))
(define (b>) (set! ptr (add1 ptr)))
(define (b<) (set! ptr (sub1 ptr)))
(define (b+) (vector-set! tape ptr (add1 (vector-ref tape ptr))))
(define (b-) (vector-set! tape ptr (sub1 (vector-ref tape ptr))))
(define (p) (write-byte (vector-ref tape ptr)))
(define (g) (vector-set! tape ptr (read-byte)))
(define ops `((#\..,p)(#\,.,g)(#\>.,b>)(#\<.,b<)(#\+.,b+)(#\-.,b-)))
(define (fuck-char char) (cond ((assoc char ops) => (lambda(_)((cdr _))))))
(define (find-cb code pos dir)
(let loop ((ctr 0) (p (+ pos dir)))
(let ((c (case (string-ref code p)((#\[)(add1 ctr))((#\])(sub1 ctr))(else ctr))))
(if (= c (- dir)) p (loop c (+ p dir))))))
(define (fuck code)
(let ((clen (string-length code)))
(let loop ((p 0))
(unless (>= p clen)
(if (eq? (string-ref code p) #\[)
(let* ((bp (find-cb code p 1)) (lc (substring code (add1 p) bp)))
(let l () (unless (= 0 (vector-ref tape ptr)) (fuck lc) (l)))
(loop (add1 bp)))
(begin (fuck-char (string-ref code p)) (loop (add1 p))))))))
(lambda(m)(case m ((fuck)fuck)((reset)(reset))((state)(values ptr tape))))))
(define bf (new-bf))
((bf 'fuck) "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.")
; => prints "Hello World!"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment