Skip to content

Instantly share code, notes, and snippets.

@kosh04
Created November 25, 2009 13:12
Show Gist options
  • Save kosh04/242690 to your computer and use it in GitHub Desktop.
Save kosh04/242690 to your computer and use it in GitHub Desktop.
Brainf*ck interpreter written in newLISP
#!/usr/bin/newlisp
;; @module brainfuck.lsp
;; @description Brainf*ck Interpreter
;; @version 1.0 - first commit
;; @version 1.1 - speedup by using array. doc changes.
;; @author KOBAYASHI Shigeru <shigeru.kb[at]gmail.com>, 2009-2011
;; @license MIT licence
;; @location https://gist.github.com/242690
;;
;; This file is @link http://en.wikipedia.org/wiki/Brainfuck Brainfuck interpreter
;; written in newLISP. Works newlisp v.10.2.8 (or lator).
;;
;; <h3>command-line options</h3>
;; see details `newlisp brainfuck.lsp -help'
;;
;; @example
;; eval FILENAME with memsize=30000
;; $ newlisp brainfuck.lsp -memsize 30000 -eval-file FILENAME
;;
;; eval FILENAME from standard-input
;; $ cat FILENAME | newlisp brainfuck.lsp -
;;
;; eval from URL-FILE
;; $ newlisp brainfuck.lsp -eval-file http://localhost/bf-source.b
;;
;; convert FILENAME to C program
;; $ newlisp brainfuck.lsp -bfc FILENAME > foo.c
;;
;; print "Hello World!"
;; $ newlisp brainfuck.lsp -hello
;;
;; read and print loop
;; $ newlisp brainfuck.lsp -eval ",[.,]"
;;; Code:
(context 'Brainfuck)
(setf stdin 0 stdout 1 stderr 2)
(define (make-vector size)
(array size '(0))
;(dup 0 size)
)
(setf memsize 512)
(setf memory (make-vector memsize))
(define (trim-comment src)
(replace "[^[]+,.<>[-]]" src "" 0))
(define (Brainfuck:eval src)
(setf src (trim-comment src))
(let ((ptr 0) (i 0)
(srclen (length src)))
(setf memory (make-vector memsize))
(catch
(while (< i srclen)
;; (begin (! "tput clear") (println (i src)) (sleep 25))
(case (src i)
(">" (++ ptr))
("<" (-- ptr))
("+" (++ (memory ptr)))
("-" (-- (memory ptr)))
("." (write-char stdout (memory ptr)))
("," (setf (memory ptr) (or (read-char stdin)
(throw 'eof))))
("[" (when (= (memory ptr) 0)
(let ((level 1))
(while (!= level 0)
(++ i)
(case (src i)
("[" (++ level))
("]" (-- level)))))))
("]" (when (!= (memory ptr) 0)
(let ((level 1))
(while (!= level 0)
(-- i)
(case (src i)
("[" (-- level))
("]" (++ level))))))))
(++ i))))
true)
(define (bfc src-text)
(let ((buffer "")
(-> (lambda ()
(write-line buffer (apply string (args))))))
;; (-> "/* " src-text "*/")
(-> "#include <stdio.h>")
(-> "int main() {")
(-> " char mem[" memsize "]={0};")
(-> " char *p=mem;")
(dostring (c src-text)
(case (char c)
(">" (-> "++p;"))
("<" (-> "--p;"))
("+" (-> "++*p;"))
("-" (-> "--*p;"))
("." (-> "putchar(*p);"))
("," (-> "*p = getchar();"))
("[" (-> "while (*p) {"))
("]" (-> "}"))))
(-> " return 0;")
(-> "}")
buffer))
;(define (bfc-optimize src-text) )
(define (eval-file filename)
(Brainfuck:eval (read-file! filename)))
(define (bfc-file filename)
(bfc (read-file! filename)))
(define (eval-stream (fd stdin))
(Brainfuck:eval (echo fd "")))
(define (hello)
(Brainfuck:eval [text]
// print "Hello World!"
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+
++++++..+++.>++.<<+++++++++++++++.>.+++.------.---
-----.>+.>.
[/text]))
;;; Utility functions
(define (read-file! filename)
(or (read-file filename)
;; :if-does-not-exist
(throw-error (cons filename (sys-error)))))
(define (echo in (out stdout))
(while (read-line in)
(write-line out))
(cond ((string? out) out)
("else" true)))
;;; Call interactively
(signal 2 exit) ; SIGINT (Ctrl-C)
;;;###Usage
(setf help-text [text]
Brainf*ck interpreter for newLISP
Useage: newlisp brainfuck.lsp [option]... [file]...
Options:
-memsize MEMSIZE set internal memory size MEMSIZE
-eval TEXT eval TEXT directly
-eval-file FILENAME eval from FILENAME
- eval from standard intput
-bfc FILENAME convert FILENAME to C program
-cc FILENAME same as `-bfc' and execute it [for debug]
-help display this message
[/text])
(dolist (arg $main-args)
(case arg
("-memsize" (setf memsize (or (int (main-args (+ $idx 1))) memsize)))
("-eval" (Brainfuck:eval (main-args (+ $idx 1)))
(exit))
("-eval-file" (eval-file (main-args (+ $idx 1)))
(exit))
("-bfc" (print (bfc-file (main-args (+ $idx 1))))
(exit))
("-" (eval-stream stdin)
(exit))
("-hello" (hello)
(exit))
("-cc" (let (cfile "bfc.c")
(and (write-file cfile (bfc-file (main-args (+ $idx 1))))
(! (println
(case ostype
("Win32" ; require mingw-gcc
(setq cfile (real-path cfile))
(format {gcc "%s" && a.exe && del a.exe "%s"} cfile cfile))
(true
(format {gcc "%s" && ./a.out && rm a.out "%s"} cfile cfile))))))
(exit)))
("-help" (print help-text)
(exit))
))
(context MAIN)
;;; EOF
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment