Skip to content

Instantly share code, notes, and snippets.

@shkmr shkmr/bfi.scm Secret
Created Dec 3, 2015

Embed
What would you like to do?
Brainfuck in Gauche
; $Id: bfi.scm,v 1.5 2002/10/09 04:52:50 skimu Exp $
;;;
;;; Brainfuck
;;;
; The Language (from http://www.muppetlabs.com/~breadbox/bf/)
; A Brainfuck program has an implicit byte pointer, called "the pointer",
; which is free to move around within an array of 30000 bytes, initially
; all set to zero. The pointer itself is initialized to point to the
; beginning of this array.
; The Brainfuck programming language consists of eight commands, each of
; which is represented as a single character.
; > Increment the pointer.
; < Decrement the pointer.
; + Increment the byte at the pointer.
; - Decrement the byte at the pointer.
; . Output the byte at the pointer.
; , Input a byte and store it in the byte at the pointer.
; [ Jump past the matching ] if the byte at the pointer is zero.
; ] Jump to the matching [.
;;;
;;;
;;;
(use gauche.sequence)
(define a (make-vector 30000 0)) ; the array
(define p 0) ; the pointer
(define iport #f)
(define (bfi codes)
(if (null? codes)
0
(begin
(if (pair? (car codes))
(do () ((= (ref a p) 0) #t)
(bfi (car codes)))
(case (car codes)
((#\+) (inc! (ref a p)))
((#\-) (dec! (ref a p)))
((#\<) (dec! p))
((#\>) (inc! p))
((#\.) (write-byte (ref a p)) (flush))
((#\,) (set! (ref a p) (read-byte iport)))
(else
(errorf "Unknown command `~a'~%" (car codes)))))
(bfi (cdr codes)))))
(define (parse codes)
(let ((c (read-char)))
(if (eof-object? c) (reverse codes)
(case c
((#\+ #\- #\< #\> #\. #\,)
(parse (cons c codes)))
((#\[)
(parse (cons (parse '()) codes)))
((#\])
(reverse codes))
(else ; just ignore unknown word (may be comments)
(parse codes))))))
(define (run-string str)
(with-input-from-string str
(lambda ()
(vector-fill! a 0)
(set! p 0)
(bfi (parse '())))))
(define (main args)
(with-error-handler
(lambda (e) (format (current-error-port) "~%ERROR: ~a~%" (slot-ref e 'message)))
(lambda ()
(if (null? (cdr args))
(bfi (parse '()))
(begin
(set! iport (current-input-port))
(with-input-from-file (cadr args)
(lambda ()
(bfi (parse '())))))))))
;;;
;;; Debug utilities
;;;
(define (peek beg end)
(newline)
(do ((i beg (+ i 1)))
((>= i end) #t)
(format #t "~5,,,,5S " (integer->char (ref a i))))
(newline)
(do ((i beg (+ i 1)))
((>= i end) #t)
(format #t "~5D " (ref a i)))
(newline))
(define (p10) (peek 0 10))
(define (p1) (peek 0 1))
;;;
;;; Example
;;;
;;(run-string "
;; >+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]>++++++++[<++++>-]
;; <.>+++++++++++[<+++++>-]<.>++++++++[<+++>-]<.+++.------.--------.[-]>++++++++[
;; <++++>-]<+.[-]++++++++++.
;;")
;; -| Hello World!
;; -> #t
;;; EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
You can’t perform that action at this time.