Execute Brain****
From Rosetta Code
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.
[edit] ALGOL 68
[edit] Ada
[edit] AutoHotkey
[edit] BASIC
Implementation in BASIC (QuickBasic dialect).
[edit] BBC BASIC
bf$ = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>" + \
\ ">---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++."
PROCbrainfuck(bf$)
END
DEF PROCbrainfuck(b$)
LOCAL B%, K%, M%, P%
DIM M% LOCAL 65535
B% = 1 : REM pointer to string
K% = 0 : REM bracket counter
P% = 0 : REM pointer to memory
FOR B% = 1 TO LEN(b$)
CASE MID$(b$,B%,1) OF
WHEN "+": M%?P% += 1
WHEN "-": M%?P% -= 1
WHEN ">": P% += 1
WHEN "<": P% -= 1
WHEN ".": VDU M%?P%
WHEN ",": M%?P% = GET
WHEN "[":
IF M%?P% = 0 THEN
K% = 1
B% += 1
WHILE K%
IF MID$(b$,B%,1) = "[" THEN K% += 1
IF MID$(b$,B%,1) = "]" THEN K% -= 1
B% += 1
ENDWHILE
ENDIF
WHEN "]":
IF M%?P% <> 0 THEN
K% = -1
B% -= 1
WHILE K%
IF MID$(b$,B%,1) = "[" THEN K% += 1
IF MID$(b$,B%,1) = "]" THEN K% -= 1
B% -= 1
ENDWHILE
ENDIF
ENDCASE
NEXT
ENDPROC
Output:
Hello World!
[edit] Brat
[edit] C
[edit] C#
[edit] C++
[edit] 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*)))))
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
[edit] Common Lisp
Implementation in Common Lisp.
[edit] D
[edit] dodo0
#Import some functions
clojure('count', 1) -> size
clojure('nth', 2) -> charAt
clojure('inc', 1) -> inc
clojure('dec', 1) -> dec
clojure('char', 1) -> char
clojure('int', 1) -> int
clojure('read-line', 0) -> readLine
#The characters we will need
charAt("\n", 0) -> newLine
charAt("@", 0) -> exitCommand
charAt("+", 0) -> incrCommand
charAt("-", 0) -> decrCommand
charAt("<", 0) -> shlCommand
charAt(">", 0) -> shrCommand
charAt(".", 0) -> printCommand
charAt(",", 0) -> inputCommand
charAt("[", 0) -> repeatCommand
charAt("]", 0) -> endCommand
#Read a character from a line of input.
fun readChar -> return
(
readLine() -> line
size(line) -> length
#Return the ith character and a continuation
fun nextFromLine -> i, return
(
'='(i, length) -> eol
if (eol) ->
(
return(newLine, readChar) #end of line
)
|
charAt(line, i) -> value
inc(i) -> i
fun next (-> return) nextFromLine(i, return) | next
return(value, next)
)
| nextFromLine
nextFromLine(0, return) #first character (position 0)
)
| readChar
#Define a buffer as a value and a left and right stack
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
#Brainf*** operations
fun noop -> buffer, input, return
(
return(buffer, input)
)
| noop
fun selectOp -> command, return
(
'='(command, incrCommand) -> eq
if (eq) ->
(
fun increment -> buffer, input, return
(
buffer() -> value, left, right
inc(value) -> value
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| increment
return(increment)
)
|
'='(command, decrCommand) -> eq
if (eq) ->
(
fun decrement -> buffer, input, return
(
buffer() -> value, left, right
dec(value) -> value
makeBuffer(value, left, right) -> buffer
return(buffer, input)
)
| decrement
return(decrement)
)
|
'='(command, shlCommand) -> eq
if (eq) ->
(
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
return(shiftLeft)
)
|
'='(command, shrCommand) -> eq
if (eq) ->
(
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
return(shiftRight)
)
|
'='(command, printCommand) -> eq
if (eq) ->
(
fun putChar -> buffer, input, return
(
buffer() -> value, left, right
char(value) -> value
'print'(value) -> dummy
'flush'() -> dummy
return(buffer, input)
)
| putChar
return(putChar)
)
|
'='(command, inputCommand) -> eq
if (eq) ->
(
fun getChar -> buffer, input, return
(
input() -> letter, input
int(letter) -> letter
buffer() -> value, left, right
makeBuffer(letter, left, right) -> buffer
return(buffer, input)
)
| getChar
return(getChar)
)
|
return(noop)
)
| selectOp
#Repeat until zero operation
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
#Convert the Brainf*** program into dodo0 instructions
fun compile -> input, endmark, return
(
input() -> command, input
'='(command, endmark) -> eq
if (eq) ->
(
return(noop, input) #the end, stop compiling
)
|
#Put in sequence the current operation and the rest of the program
fun chainOp -> op, input, return
(
compile(input, endmark) -> program, input
fun exec -> buffer, input, return
(
op(buffer, input) -> buffer, input
program(buffer, input, return)
)
| exec
return(exec, input)
)
| chainOp
'='(command, repeatCommand) -> eq
if (eq) ->
(
compile(input, endCommand) -> body, input #compile until "]"
#Repeat the loop body until zero
fun repeat -> buffer, input, return
(
whileLoop(buffer, input, body, return)
)
| repeat
chainOp(repeat, input, return)
)
|
selectOp(command) -> op
chainOp(op, input, return)
)
| compile
#Main program
compile(readChar, exitCommand) -> program, input
makeBuffer(0, empty, fill) -> buffer
input() -> nl, input #consume newline from input
#Execute the program instructions
program(buffer, input) -> buffer, input
exit()
Execution:
$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0 ++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@ Hello World!
[edit] E
[edit] Elena
ELENA VM Script:
statement ::= next;
statement ::= prev;
statement ::= inc;
statement ::= dec;
statement ::= out;
statement ::= in;
statement ::= "[" while;
statement ::= idle;
next ::= ">";
prev ::= "<";
inc ::= "+";
dec ::= "-";
out ::= ".";
in ::= ",";
idle ::= $any;
while ::= statement while_r;
while_r ::= "]";
while_r ::= statement while_r;
tape ::= statement statements;
statements ::= statement statements;
statements ::= $eps;
start ::= tape;
tape =>
// 1: append
&subject
// 2: goto
&subject
// 3: loop
&subject
// 4: inc action
&1 1 &echo
// 5: dec action
&1 -1 &echo
// 6: next action
&2 1 &echo
// 7: prev action
&2 -1 &echo
// 8: output action
&__write &nil 'program'output &wrap
// 9: group
&nil
sys'dynamics'groupvariable
&std'basic'factory'array_size &sys'vm'routines'egetprop 1024 &prop
&std'basic'factory'pattern &sys'vm'routines'egetprop 0 std'basic'widecharvar &prop
&union2
std'basic'factory'patternarrayfactory
std'basic'factory'newarray
0 ^refer
~ sys'dynamics'group_member ^append
// :: append method
&1 &__append &9 &prop
~ sys'dynamics'group_member ^append
// :: goto method
&2 &__append &std'dictionary'index &9 &wrap &prop
~ sys'dynamics'group_member ^append
// :: loop method
&3 &__run &std'patterns'ewhilenotzero &9 &wrap &prop
~ sys'dynamics'group_member ^append
// 10: in action
&__save &__get &nil 'program'input &nil &action &wrap
// build command batch
&cast
$body
&9
^ invoke;
inc => &4 |= $body;
dec => &5 |= $body;
next => &6 |= $body;
prev => &7 |= $body;
out => &8 |= $body;
in => &10 |= $body;
while => &3 &__eval &cast $body &wrap &echo |=;
[edit] Erlang
[edit] Forth
[edit] F#
[edit] 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;
# An addition
Brainfuck("+++.<+++++.[->+<]>.");
# 3
# 5
# 8
[edit] Go
Fixed size data store, no bounds checking.
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--
}
}
}
}
}
}
Output:
Goodbye, World!
[edit] Haskell
[edit] Icon and Unicon
Implementation in Icon/Unicon.
[edit] J
[edit] Java
[edit] JavaScript
[edit] Lua
[edit] Modula-3
[edit] 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)
# bf(hello_world)
[edit] OCaml
[edit] PARI/GP
A case statement would have been really useful here...
BF(prog)={
prog=Vec(Str(prog));
my(codeptr,ptr=1,v=vector(1000),t);
while(codeptr++ <= #prog,
t=prog[codeptr];
if(t=="+",
v[ptr]++
,
if(t=="-",
v[ptr]--
,
if(t==">",
ptr++
,
if(t=="<",
ptr--
,
if(t=="[" && !v[ptr],
t=1;
while(t,
if(prog[codeptr++]=="[",t++);
if(prog[codeptr]=="]",t--)
);
);
if(t=="]"&&v[ptr],
t=1;
while(t,
if(prog[codeptr--]=="[",t--);
if(prog[codeptr]=="]",t++)
)
);
if(t==".",
print1(Strchr(v[ptr]))
);
if(t==",",
v[ptr]=Vecsmall(input)[1]
)
)
)
)
)
)
};
[edit] Perl
[edit] Perl 6
[edit] PHP
See also this alternate implementation.
<?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;
}
?>
[edit] 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.
(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
Output:
: (compile "hello.bf") -> NIL : (execute) Goodbye, World! -> (0 10 33 44 71 87 98 100 114 121)
[edit] 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)
[edit] PureBasic
[edit] Python
[edit] Retro
[edit] Ruby
[edit] Standard ML
Implementation in Standard ML.
[edit] TI-83 BASIC
Implementation in TI-83 BASIC.
[edit] TI-89 BASIC
Implementation in TI-89 Basic.
[edit] Tcl
Categories:
- Compilers and Interpreters
- Programming Tasks
- Solutions by Programming Task
- Implementations
- Brainf*** Implementations
- Brainf*** related
- ALGOL 68
- Ada
- AutoHotkey
- BASIC
- BBC BASIC
- Brat
- C
- C sharp
- C++
- Clojure
- Common Lisp
- D
- Dodo0
- E
- Elena
- Erlang
- Forth
- F Sharp
- GAP
- Go
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Lua
- Modula-3
- Nimrod
- OCaml
- PARI/GP
- Perl
- Perl 6
- PHP
- PHP examples needing attention
- Examples needing attention
- PicoLisp
- PureBasic
- Python
- Retro
- Ruby
- Standard ML
- TI-83 BASIC
- TI-89 BASIC
- Tcl
- GUISS/Omit
