Execute Brain****: Difference between revisions

From Rosetta Code
Content added Content deleted
m ({{omit from|GUISS}})
(Added dodo0 implementation)
Line 230: Line 230:
++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."));
++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."));
}</lang>
}</lang>

=={{header|dodo0}}==

<lang dodo0>clojure('count', 1) -> count
clojure('nth', 2) -> charAt
clojure('inc', 1) -> inc
clojure('dec', 1) -> dec
clojure('char', 1) -> char
clojure('int', 1) -> int
charAt("\n", 0) -> newLine
charAt("@", 0) -> exitCommand
charAt("+", 0) -> incrCommand
charAt("-", 0) -> decrCommand
charAt("<", 0) -> shlCommand
charAt(">", 0) -> shrCommand
charAt(".", 0) -> printCommand
charAt(",", 0) -> readCommand
charAt("[", 0) -> repeatCommand
charAt("]", 0) -> endCommand

fun readChar -> return
(
'read-line'() -> line
count(line) -> length
fun nextFromLine -> i, return
(
'='(i, length) -> eol
if (eol) ->
(
return(newLine, readChar)
)
|
charAt(line, i) -> value
inc(i) -> i
fun next (-> return) nextFromLine(i, return) | next
return(value, next)
)
| nextFromLine
nextFromLine(0, return)
)
| readChar

fun empty (-> return, throw) throw("Error: out of bounds") | empty
fun fill (-> return, throw) return(0, fill) | fill

fun makeBuffer -> value, left, right, return
(
fun buffer (-> return) return(value, left, right) | buffer
return(buffer)
)
| makeBuffer

fun push -> value, stack, return
(
fun newStack (-> return, throw) return(value, stack) | newStack
return(newStack)
)
| push

fun increment -> buffer, input, return
(
buffer() -> value, left, right
inc(value) -> value
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| increment

fun decrement -> buffer, input, return
(
buffer() -> value, left, right
dec(value) -> value
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| decrement

fun shiftLeft -> buffer, input, return
(
buffer() -> value, left, right
push(value, right) -> right
left() -> value, left
(
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| message
println(message) ->
exit()
)
| shiftLeft

fun shiftRight -> buffer, input, return
(
buffer() -> value, left, right
push(value, left) -> left
right() -> value, right
(
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| message
println(message) ->
exit()
)
| shiftRight

fun putChar -> buffer, input, return
(
buffer() -> value, left, right
char(value) -> value
'print'(value) -> dummy
return(buffer, input)
)
| putChar

fun getChar -> buffer, input, return
(
input() -> letter, input
int(letter) -> letter
buffer() -> value, left, right
makeBuffer(letter, left, right) -> buffer
return(buffer, input)
)
| getChar

fun whileLoop -> buffer, input, continue, break
(
buffer() -> value, left, right
'='(value, 0) -> zero
if (zero) ->
(
break(buffer, input)
)
|
(
continue(buffer, input) -> buffer, input
whileLoop(buffer, input, continue, break)
)
)
| whileLoop

fun noop -> buffer, input, return
(
return(buffer, input)
)
| noop

fun compile -> input, endmark, return
(
input() -> command, input
'='(command, repeatCommand) -> opRepeat
'='(command, endmark) -> opEnd

if (opRepeat) ->
(
compile(input, endCommand) -> body, input
compile(input, endmark) -> program, input
fun repeat -> buffer, input, return
(
whileLoop(buffer, input, body) -> buffer, input
program(buffer, input, return)
)
| repeat
return(repeat, input)
)
|
if (opEnd) ->
(
return(noop, input)
)
|
(
fun select -> return
(
'='(command, incrCommand) -> y
if (y) ->
return(increment)
|
'='(command, decrCommand) -> y
if (y) ->
return(decrement)
|
'='(command, printCommand) -> y
if (y) ->
return(putChar)
|
'='(command, readCommand) -> y
if (y) ->
return(getChar)
|
'='(command, shlCommand) -> y
if (y) ->
return(shiftLeft)
|
'='(command, shrCommand) -> y
if(y) ->
return(shiftRight)
|
(
'str'("Unexpected input, skipping: ", command) -> message
println(message) ->
return(noop)
)
)
| select

select() -> op
compile(input, endmark) -> program, input

fun exec -> buffer, input, return
(
op(buffer, input) -> buffer, input
program(buffer, input, return)
)
| exec
return(exec, input)
)
)
| compile

compile(readChar, exitCommand) -> program, input
makeBuffer(0, empty, fill) -> buffer

program(buffer, input) -> buffer, input
exit()</lang>
Execution:
<pre>
$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@
Hello World!
</pre>


=={{header|E}}==
=={{header|E}}==

Revision as of 22:33, 28 September 2011

Task
Execute Brain****
You are encouraged to solve this task according to the task description, using any language you may know.
Execute Brain**** is an implementation of Brainf***. Other implementations of Brainf***.

RCBF is a set of Brainf*** compilers and interpreters written for Rosetta Code in a variety of languages. Below are links to each of the versions of RCBF.

An implementation need only properly implement the '[', ']', '+', '-', '<', '>', ',', and '.' instructions. Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory.

ALGOL 68

Implementation in Algol 68.

Ada

Implementation in Ada.

AutoHotkey

Implementation in AutoHotkey.

BASIC

Implementation in BASIC (QuickBasic dialect).

Brat

Implementation in Brat

C

Implementation in C.

C#

Implementation in C#.

C++

Implementation in C++.

Clojure

<lang clojure>(ns brainfuck)

(def *input*)

(def *output*)

(defrecord Data [ptr cells])

(defn inc-ptr [next-cmd]

 (fn [data]
   (next-cmd (update-in data [:ptr] inc))))

(defn dec-ptr [next-cmd]

 (fn [data]
   (next-cmd (update-in data [:ptr] dec))))

(defn inc-cell [next-cmd]

 (fn [data]
   (next-cmd (update-in data [:cells (:ptr data)] (fnil inc 0)))))

(defn dec-cell [next-cmd]

 (fn [data]
   (next-cmd (update-in data [:cells (:ptr data)] (fnil dec 0)))))

(defn output-cell [next-cmd]

 (fn [data]
   (set! *output* (conj *output* (get (:cells data) (:ptr data) 0)))
   (next-cmd data)))

(defn input-cell [next-cmd]

 (fn [data]
   (let [[input & rest-input] *input*]
     (set! *input* rest-input)
     (next-cmd (update-in data [:cells (:ptr data)] input)))))

(defn if-loop [next-cmd loop-cmd]

 (fn [data]
   (next-cmd (loop [d data]
               (if (zero? (get (:cells d) (:ptr d) 0))
                 d
                 (recur (loop-cmd d)))))))

(defn terminate [data] data)

(defn split-cmds [cmds]

 (letfn [(split [[cmd & rest-cmds] loop-cmds]
                (when (nil? cmd) (throw (Exception. "invalid commands: missing ]")))
                (case cmd
                      \[ (let [[c l] (split-cmds rest-cmds)]
                           (recur c (str loop-cmds "[" l "]")))
                      \] [(apply str rest-cmds) loop-cmds]
                      (recur rest-cmds (str loop-cmds cmd))))]
   (split cmds "")))

(defn compile-cmds cmd & rest-cmds

 (if (nil? cmd)
   terminate
   (case cmd
         \> (inc-ptr (compile-cmds rest-cmds))
         \< (dec-ptr (compile-cmds rest-cmds))
         \+ (inc-cell (compile-cmds rest-cmds))
         \- (dec-cell (compile-cmds rest-cmds))
         \. (output-cell (compile-cmds rest-cmds))
         \, (input-cell (compile-cmds rest-cmds))
         \[ (let [[cmds loop-cmds] (split-cmds rest-cmds)]
              (if-loop (compile-cmds cmds) (compile-cmds loop-cmds)))
         \] (throw (Exception. "invalid commands: missing ["))
         (compile-cmds rest-cmds))))

(defn compile-and-run [cmds input]

 (binding [*input* input *output* []]
   (let [compiled-cmds (compile-cmds cmds)]
    (println (compiled-cmds (Data. 0 {}))))
   (println *output*)
   (println (apply str (map char *output*)))))

</lang> <lang clojure>brainfuck> (compile-and-run "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." []) {:ptr 4, :cells {4 10, 3 33, 2 100, 1 87, 0 0}} [72 101 108 108 111 32 87 111 114 108 100 33 10] Hello World!

nil </lang>

Common Lisp

Implementation in Common Lisp.

D

Implementation in D.

Alternative version, simpler and faster: <lang d>import core.stdc.stdio: getchar, putchar, EOF; import core.stdc.stdlib: exit;

void brainfuckRun(const string code) {

   static pure int[int] matchBraces(const string code)
       out(result) {
           foreach (k, v; result) {
               assert(k >=0 && k < code.length);
               assert(v >=0 && v < code.length);
               assert(v in result);
           }
       } body {
           int[int] loops;
           int[] loopStack;
           foreach (i, instruction; code) {
               if (instruction == '[')
                   loopStack ~= i;
               else if (instruction == ']') {
                   assert(loopStack.length);
                   loops[i] = loopStack[$ - 1];
                   loopStack.length -= 1;
                   loops[loops[i]] = i;
               }
           }
           assert(!loopStack.length);
           return loops;
       }
   static void runCode(const string code, const int[int] loops) {
       enum char empty = '\0';
       char[30_000] tape = empty;
       int cell, index;
       while (index < cast(int)code.length) {
           immutable int instruction = code[index];
           switch (instruction) {
               case '>': cell++; assert(cell < tape.length); break;
               case '<': cell--; assert(cell >= 0); break;
               case '+': tape[cell]++; break;
               case '-': tape[cell]--; break;
               case '.': putchar(tape[cell]); break;
               case ',':
                   int c = getchar();
                   if (c == EOF)
                       exit(1);
                   tape[cell] = cast(char)c;
                   break;
               case '[':
                   if (tape[cell] == empty)
                       index = loops[index];
                   break;
               case ']':
                   if (tape[cell] != empty)
                       index = loops[index];
                   break;
               default: break;
           }
           index++;
       }
   }
   int[int] loops = matchBraces(code);
   runCode(code, loops);

}

void main() {

   brainfuckRun("++++++++++[>+++++++>++++++++++>+++>+<<<<-]
     >++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");

}</lang> Faster partially compile-time version (code generated at compile-time, run at run time): <lang d>import core.stdc.stdio, core.stdc.stdlib;

pure string ctbf(in string code) {

 string r;
 foreach (c; code)
   switch (c) {
     case '>': r ~= "i++; assert(i < m.length);"; break;
     case '<': r ~= "i--; assert(i >= 0);";       break;
     case '+': r ~= "m[i]++;";                    break;
     case '-': r ~= "m[i]--;";                    break;
     case '[': r ~= "while (m[i]) {";             break;
     case ']': r ~= "}";                          break;
     case '.': r ~= "putchar(m[i]);";             break;
     case ',': r ~= "int d = getchar();
                     if (d == EOF) exit(1);
                     m[i] = cast(char)d;";        break;
     default:                                     break;
   }
 return r;

}

void main() {

 char[30_000] m = '\0';
 size_t i;
 mixin(ctbf("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++
   ++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."));

}</lang>

dodo0

<lang dodo0>clojure('count', 1) -> count clojure('nth', 2) -> charAt clojure('inc', 1) -> inc clojure('dec', 1) -> dec clojure('char', 1) -> char clojure('int', 1) -> int charAt("\n", 0) -> newLine charAt("@", 0) -> exitCommand charAt("+", 0) -> incrCommand charAt("-", 0) -> decrCommand charAt("<", 0) -> shlCommand charAt(">", 0) -> shrCommand charAt(".", 0) -> printCommand charAt(",", 0) -> readCommand charAt("[", 0) -> repeatCommand charAt("]", 0) -> endCommand

fun readChar -> return ( 'read-line'() -> line count(line) -> length

fun nextFromLine -> i, return ( '='(i, length) -> eol if (eol) -> ( return(newLine, readChar) ) | charAt(line, i) -> value inc(i) -> i fun next (-> return) nextFromLine(i, return) | next return(value, next) ) | nextFromLine

nextFromLine(0, return) ) | readChar

fun empty (-> return, throw) throw("Error: out of bounds") | empty fun fill (-> return, throw) return(0, fill) | fill

fun makeBuffer -> value, left, right, return ( fun buffer (-> return) return(value, left, right) | buffer return(buffer) ) | makeBuffer

fun push -> value, stack, return ( fun newStack (-> return, throw) return(value, stack) | newStack return(newStack) ) | push

fun increment -> buffer, input, return ( buffer() -> value, left, right inc(value) -> value makeBuffer(value, left, right) -> buffer return(buffer, input) ) | increment

fun decrement -> buffer, input, return ( buffer() -> value, left, right dec(value) -> value makeBuffer(value, left, right) -> buffer return(buffer, input) ) | decrement

fun shiftLeft -> buffer, input, return ( buffer() -> value, left, right push(value, right) -> right left() -> value, left ( makeBuffer(value, left, right) -> buffer return(buffer, input) ) | message println(message) -> exit() ) | shiftLeft

fun shiftRight -> buffer, input, return ( buffer() -> value, left, right push(value, left) -> left right() -> value, right ( makeBuffer(value, left, right) -> buffer return(buffer, input) ) | message println(message) -> exit() ) | shiftRight

fun putChar -> buffer, input, return ( buffer() -> value, left, right char(value) -> value 'print'(value) -> dummy return(buffer, input) ) | putChar

fun getChar -> buffer, input, return ( input() -> letter, input int(letter) -> letter buffer() -> value, left, right makeBuffer(letter, left, right) -> buffer return(buffer, input) ) | getChar

fun whileLoop -> buffer, input, continue, break ( buffer() -> value, left, right '='(value, 0) -> zero if (zero) -> ( break(buffer, input) ) | ( continue(buffer, input) -> buffer, input whileLoop(buffer, input, continue, break) ) ) | whileLoop

fun noop -> buffer, input, return ( return(buffer, input) ) | noop

fun compile -> input, endmark, return ( input() -> command, input '='(command, repeatCommand) -> opRepeat '='(command, endmark) -> opEnd

if (opRepeat) -> ( compile(input, endCommand) -> body, input compile(input, endmark) -> program, input fun repeat -> buffer, input, return ( whileLoop(buffer, input, body) -> buffer, input program(buffer, input, return) ) | repeat return(repeat, input) ) | if (opEnd) -> ( return(noop, input) ) | ( fun select -> return ( '='(command, incrCommand) -> y if (y) -> return(increment) | '='(command, decrCommand) -> y if (y) -> return(decrement) | '='(command, printCommand) -> y if (y) -> return(putChar) | '='(command, readCommand) -> y if (y) -> return(getChar) | '='(command, shlCommand) -> y if (y) -> return(shiftLeft) | '='(command, shrCommand) -> y if(y) -> return(shiftRight) | ( 'str'("Unexpected input, skipping: ", command) -> message println(message) -> return(noop) ) ) | select

select() -> op compile(input, endmark) -> program, input

fun exec -> buffer, input, return ( op(buffer, input) -> buffer, input program(buffer, input, return) ) | exec return(exec, input) ) ) | compile

compile(readChar, exitCommand) -> program, input makeBuffer(0, empty, fill) -> buffer

program(buffer, input) -> buffer, input exit()</lang> Execution:

$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0 
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@
Hello World!

E

Implementation in E.

Erlang

Implementation in Erlang.

Forth

Implementation in Forth.

F#

Implementation in F#.

GAP

<lang gap># Here . and , print and read an integer, not a character Brainfuck := function(prog)

 local pointer, stack, leftcells, rightcells, instr, stackptr, len,
   output, input, jump, i, j, set, get;
 input := InputTextUser();
 output := OutputTextUser();
 instr := 1;
 pointer := 0;
 leftcells := [ ];
 rightcells := [ ];
 stack := [ ];
 stackptr := 0;
 len := Length(prog);
 jump := [ ];
 get := function()
   local p;
   if pointer >= 0 then
     p := pointer + 1;
     if IsBound(rightcells[p]) then
       return rightcells[p];
     else
       return 0;
     fi;
   else
     p := -pointer;
     if IsBound(leftcells[p]) then
       return leftcells[p];
     else
       return 0;
     fi;
   fi;
 end;
 
 set := function(value)
   local p;
   if pointer >= 0 then
     p := pointer + 1;
     if value = 0 then
       Unbind(rightcells[p]);
     else
       rightcells[p] := value;
     fi;
   else
     p := -pointer;
     if value = 0 then
       Unbind(leftcells[p]);
     else
       leftcells[p] := value;
     fi;
   fi;
 end;
 
 # find jumps for faster execution
 for i in [1 .. len] do
   if prog[i] = '[' then
     stackptr := stackptr + 1;
     stack[stackptr] := i;
   elif prog[i] = ']' then
     j := stack[stackptr];
     stackptr := stackptr - 1;
     jump[i] := j;
     jump[j] := i;
   fi;
 od;
 while instr <= len do
   c := prog[instr];
   if c = '<' then
     pointer := pointer - 1;
   elif c = '>' then
     pointer := pointer + 1;
   elif c = '+' then
     set(get() + 1);
   elif c = '-' then
     set(get() - 1);
   elif c = '.' then
     WriteLine(output, String(get()));
   elif c = ',' then
     set(Int(Chomp(ReadLine(input))));
   elif c = '[' then
     if get() = 0 then
       instr := jump[instr];
     fi;
   elif c = ']' then
     if get() <> 0 then
       instr := jump[instr];
     fi;
   fi;
   instr := instr + 1;
 od;
 CloseStream(input);
 CloseStream(output);
 # for debugging purposes, return last state
 return [leftcells, rightcells, pointer];

end;

  1. An addition

Brainfuck("+++.<+++++.[->+<]>.");

  1. 3
  2. 5
  3. 8</lang>

Go

Fixed size data store, no bounds checking. <lang go>package main

import "fmt"

func main() {

   // example program is current Brain**** solution to
   // Hello world/Text task.  only requires 10 bytes of data store!
   bf(10, `++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++

++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>> >+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++. <+++++++.--------.<<<<<+.<+++.---.`) }

func bf(dLen int, is string) {

   ds := make([]byte, dLen) // data store
   var dp int               // data pointer
   for ip := 0; ip < len(is); ip++ {
       switch is[ip] {
       case '>':
           dp++
       case '<':
           dp--
       case '+':
           ds[dp]++
       case '-':
           ds[dp]--
       case '.':
           fmt.Printf("%c", ds[dp])
       case ',':
           fmt.Scanf("%c", &ds[dp])
       case '[':
           if ds[dp] == 0 {
               for nc := 1; nc > 0; {
                   ip++
                   if is[ip] == '[' {
                       nc++
                   } else if is[ip] == ']' {
                       nc--
                   }
               }
           }
       case ']':
           if ds[dp] != 0 {
               for nc := 1; nc > 0; {
                   ip--
                   if is[ip] == ']' {
                       nc++
                   } else if is[ip] == '[' {
                       nc--
                   }
               }
           }
       }
   }

}</lang> Output:

Goodbye, World!

Haskell

Implementation in Haskell.

Icon and Unicon

Implementation in Icon/Unicon.

J

Implementation in J.

Java

Implementation in Java.

JavaScript

Implementation in JavaScript.

Lua

Implementation in Lua.

Modula-3

Implementation in Modula-3.

Nimrod

<lang nimrod> import strutils

proc jumpBackward(pos: var int, program: string) =

 var level = 1
 while pos > 0 and level != 0:
   dec pos
   case program[pos]
   of '[':
     dec level
   of ']':
     inc level
   else:
     discard 1
 dec pos

proc jumpForward(pos: var int, program: string) =

 var level = 1
 while pos < program.len and level != 0:
   inc pos
   case program[pos]
   of ']':
     inc level
   of '[':
     dec level
   else:
     discard 1

proc bf(program: string) =

 var tape: array[0..20, int]
 var pointer = 0
 var pos = 0
 var indent = 0
 while pos < program.len:
   var token = program[pos]
   case token
   of '+':
     inc tape[pointer]
   of '-':
     dec tape[pointer]
   of ',':
     tape[pointer] = int(stdin.readChar())
   of '.':
     stdout.write(chr(tape[pointer]))
   of '[':
     if tape[pointer] == 0:
       jumpForward(pos, program)
   of ']':
     if tape[pointer] != 0:
       jumpBackward(pos, program)
   of '>':
     inc pointer
   of '<':
     dec pointer
   else:
     discard 1
   inc pos

var addition = ",>++++++[<-------->-],[<+>-]<." var hello_world = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."

bf(addition)

  1. bf(hello_world)

</lang>

OCaml

Implementation in OCaml.

Perl

Implementation in Perl.

Perl 6

Implementation in Perl 6.

PHP

This example may be incorrect.
Near-duplicate entries; gurus please check.
Please verify it and remove this message. If the example does not match the requirements or does not work, replace this message with Template:incorrect or fix the code yourself.

See also this alternate implementation.

<lang php><?php function brainfuck_interpret(&$s, &$_s, &$d, &$_d, &$i, &$_i, &$o) {

  do {
    switch($s[$_s]) {
      case '+': $d[$_d] = chr(ord($d[$_d]) + 1); break;
      case '-': $d[$_d] = chr(ord($d[$_d]) - 1); break;
      case '>': $_d++; if(!isset($d[$_d])) $d[$_d] = chr(0); break;
      case '<': $_d--; break;
      case '.': $o .= $d[$_d]; break;
      case ',': $d[$_d] = $_i==strlen($i) ? chr(0) : $i[$_i++]; break;
      case '[':
        if((int)ord($d[$_d]) == 0) {
          $brackets = 1;
          while($brackets && $_s++ < strlen($s)) {
            if($s[$_s] == '[')
              $brackets++;
            else if($s[$_s] == ']')
              $brackets--;
          }
        }
        else {
            $pos = $_s++-1;
          if(brainfuck_interpret($s, $_s, $d, $_d, $i, $_i, $o))
            $_s = $pos;
        }
        break;
      case ']': return ((int)ord($d[$_d]) != 0);
   }
 } while(++$_s < strlen($s));

}

function brainfuck($source, $input=) {

 $data         = array();
 $data[0]      = chr(0);
 $data_index   = 0;
 $source_index = 0;
 $input_index  = 0;
 $output       = ;
 
 brainfuck_interpret($source, $source_index,
                     $data,   $data_index,
                     $input,  $input_index,
                     $output);
 return $output;

} ?> </lang>

PicoLisp

This solution uses a doubly-linked list for the cell space. That list consists of a single cell initially, and grows automatically in both directions. The value in each cell is unlimited. <lang PicoLisp>(off "Program")

(de compile (File)

  (let Stack NIL
     (setq "Program"
        (make
           (in File
              (while (char)
                 (case @
                    (">"
                       (link
                          '(setq Data
                             (or
                                (cddr Data)
                                (con (cdr Data) (cons 0 (cons Data))) ) ) ) )
                    ("<"
                       (link
                          '(setq Data
                             (or
                                (cadr Data)
                                (set (cdr Data) (cons 0 (cons NIL Data))) ) ) ) )
                    ("+" (link '(inc Data)))
                    ("-" (link '(dec Data)))
                    ("." (link '(prin (char (car Data)))))
                    ("," (link '(set Data (char (read)))))
                    ("["
                       (link
                          '(setq Code
                             ((if (=0 (car Data)) cdar cdr) Code) ) )
                       (push 'Stack (chain (cons))) )
                    ("]"
                       (unless Stack
                          (quit "Unbalanced ']'") )
                       (link
                          '(setq Code
                             ((if (n0 (car Data)) cdar cdr) Code) ) )
                       (let (There (pop 'Stack)  Here (cons There))
                          (chain (set There Here)) ) ) ) ) ) ) )
     (when Stack
        (quit "Unbalanced '['") ) ) )

(de execute ()

  (let Data (cons 0 (cons))              # Create initial cell
     (for (Code "Program"  Code)         # Run program
        (eval (pop 'Code)) )
     (while (cadr Data)                  # Find beginning of data
        (setq Data @) )
     (filter prog Data '(T NIL .)) ) )   # Return data space</lang>

Output:

: (compile "hello.bf")
-> NIL

: (execute)
Goodbye, World!
-> (0 10 33 44 71 87 98 100 114 121)

Alternative solution

# This implements a BrainFuck *interpreter* similar to the "official" one.
# It has 30000 unsigned 8-bit cells with wrapping, going off the bounds
# of the memory results in an error.
(de bf (Prg)
   (let (P Prg S NIL D (need 30000 0) Dp D F T )
      (while P
         (case (car P)
            ("+" (if F (set Dp (% (inc (car Dp) 256)))))
            ("-" (if F (set Dp (% (dec (car Dp) 256)))))
            (">" (if F (setq Dp (cdr Dp))))
            ("<" (if F (setq Dp (prior Dp D))))
            ("." (if F (prin (char (car Dp)))))
            ("," (if F (set Dp (char (read)))))
            ("["
             (push 'S (if F (prior P Prg)))
             (setq F (n0 (car Dp))) )
            ("]"
             (and (setq F (pop 'S))
                (n0 (car Dp))
                (setq P F) ) ) )
         (pop 'P) ) ) )

# A little "Hello world! test of the interpreter."
(bf (chop ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-]
>++++++++[<++++>-] <.>+++++++++++[<++++++++>-]<-.--------.+++.------.---
-----.[-]>++++++++[<++++>- ]<+.[-]++++++++++." ) )
(bye)

PureBasic

Implementation in PureBasic

Python

Implementation in Python.

Retro

Implementation in Retro.

Ruby

Implementation in Ruby.

Standard ML

Implementation in Standard ML.

TI-83 BASIC

Implementation in TI-83 BASIC.

TI-89 BASIC

Implementation in TI-89 Basic.

Tcl

Implementation in Tcl.