Execute Brain****
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.
You are encouraged to solve this task according to the task description, using any language you may know.
An implementation need only properly implement the following instructions:
- [ (left bracket)
- ] (right bracket)
- + (plus sign)
- - (minus sign)
- < (less than sign)
- > (greater than sign)
- , (comma)
- . (period)
Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory.
ALGOL 68
Ada
AutoHotkey
AutoIt
<lang AutoIt>; AutoFucck
- A AutoIt Brainfuck Interpreter
- by minx
- AutoIt Version
- 3.3.8.x
- Commands
- - DEC
- + INC
- [ LOOP START
- ] LOOP END
- . Output cell value as ASCII Chr
- , Input a ASCII char (cell value = ASCII code)
- Ouput cell value as integer
- ; Input a Integer
- _ Output a single whitespace
- / Output an Carriage Return and Line Feed
- You can load & save .atf Files.
- include <WindowsConstants.au3>
- include <EditConstants.au3>
- include <Array.au3>
- include <GUIConstants.au3>
- include <StaticCOnstants.au3>
HotKeySet("{F5}", "_Runn")
$hMain = GUICreate("Autofuck - Real Brainfuck Interpreter", 600, 525) $mMain = GUICtrlCreateMenu("File") Global $mCode = GUICtrlCreateMenu("Code") $mInfo = GUICtrlCreateMenu("Info") $mCredits = GUICtrlCreateMenuItem("Credits", $mInfo) $mFile_New = GUICtrlCreateMenuItem("New", $mMain) $mFile_Open = GUICtrlCreateMenuItem("Open", $mMain) $mFile_Save = GUICtrlCreateMenuItem("Save", $mMain) Global $mCode_Run = GUICtrlCreateMenuItem("Run [F5]", $mCode) Global $lStatus = GUICtrlCreateLabel("++ Autofuck started...", 5, 480, 590, 20, $SS_SUNKEN) GUICtrlSetFont(-1, Default, Default, Default, "Courier New") $eCode = GUICtrlCreateEdit("", 5, 5, 590, 350) GUICtrlSetFont(-1, Default, Default, Default, "Courier New") $eConsole = GUICtrlCreateEdit("", 5, 360, 590, 115, $ES_WANTRETURN) GUICtrlSetFont(-1, Default, Default, Default, "Courier New") GUISetState()
While 1 $nMsg = GUIGetMsg() Switch $nMsg Case $mFile_New GUICtrlSetData($eCode, "") Case $mFile_Open GUICtrlSetData($eCode, FileRead(FileOpenDialog("Open Autofuck script", @DesktopDir, "Autofuck (*.atf)"))) Case $mFile_Save FileWrite(FileOpen(StringReplace(FileSaveDialog("Save Autofuck script", @DesktopDir, "Autofuck (*.atf)"), ".atf", "") &".atf", 2), GUICtrlRead($eCode)) Case $GUI_EVENT_CLOSE Exit Case $mCredits MsgBox(0, "Autofuck", "Copyright by: "&@CRLF&"minx (autoit.de)"&@CRLF&"crashdemons (autoitscript.com)") EndSwitch WEnd
Func _Runn() $Timer = TimerInit() GUICtrlSetData($lStatus, "++ Program started") Global $tData=DllStructCreate('BYTE[65536]') Global $pData=0 GUICtrlSetData($eConsole, "") Local $aError[6]=[,'Unmatched closing bracket during search','Unmatched opening bracket during search','Unexpected closing bracket','Data pointer passed left boundary','Data pointer passed right boundary']
Local $sError= Local $i=_Run(GUICtrlRead($eCode)) If @error>=0 And @error<6 Then $sError=$aError[@error] If StringLen($sError) Then GUICtrlSetData($eConsole, 'ERROR: '&$sError&'.'&@CRLF&'Ending Instruction Pointer: '&($i-1)&@CRLF&'Current Data Pointer: '&$pData)
GUICtrlSetData($lStatus, "++ Program terminated. Runtime: "& Round( TimerDiff($Timer) / 1000, 4) &"s") EndFunc
Func _Run($Code,$iStart=1,$iEnd=0)
If $iEnd<1 Then $iEnd=StringLen($Code)
For $i = $iStart to $iEnd
Switch StringMid($Code, $i, 1)
Case ">"
$pData+=1
If $pData=65536 Then Return SetError(5,0,$i)
Case "<"
$pData-=1
If $pData<0 Then Return SetError(4,0,$i)
Case "+"
DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)+1,$pData+1)
Case "-"
DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)-1,$pData+1)
Case ":"
GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & (DllStructGetData($tData,1,$pData+1)))
Case "."
GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & Chr(DllStructGetData($tData,1,$pData+1)))
Case ";"
Local $cIn=StringMid(InputBox('Autofuck','Enter Number'),1)
DllStructSetData($tData,1,Number($cIn),$pData+1)
Case ","
Local $cIn=StringMid(InputBox('Autofuck','Enter one ASCII character'),1,1)
DllStructSetData($tData,1,Asc($cIn),$pData+1)
Case "["
Local $iStartSub=$i
Local $iEndSub=_MatchBracket($Code,$i,$iEnd)
If @error<>0 Then Return SetError(@error,0,$iEndSub)
While DllStructGetData($tData,1,$pData+1)<>0
Local $iRet=_Run($Code,$iStartSub+1,$iEndSub-1)
If @error<>0 Then Return SetError(@error,0,$iRet)
WEnd
$i=$iEndSub
Case ']'
Return SetError(3,0,$i)
Case "_" GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&" ") Case "/" GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&@CRLF)
EndSwitch Next Return 0
EndFunc
Func _MatchBracket($Code,$iStart=1,$iEnd=0)
If $iEnd<1 Then $iEnd=StringLen($Code)
Local $Open=0
For $i=$iStart To $iEnd
Switch StringMid($Code,$i,1)
Case '['
$Open+=1
Case ']'
$Open-=1
If $Open=0 Then Return $i
If $Open<0 Then Return SetError(1,0,$i)
EndSwitch
Next
If $Open>0 Then Return SetError(2,0,$i)
Return 0
EndFunc</lang>
BASIC
Implementation in BASIC (QuickBasic dialect).
BBC BASIC
<lang bbcbasic> 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
</lang> Output:
Hello World!
Brat
Burlesque
<lang burlesque> ".""X"r~"-""\/^^{vvvv}c!!!-.256.%{vvvv}c!sa\/"r~"+""\/^^{vvvv}c!!!+. 256.%{vvvv}c!sa\/"r~"[""{"r~"]""}{\/^^{vvvv}c!!!}w!"r~">""+."r~"<"" -."r~"X""\/^^{vvvv}c!!!L[+]\/+]\/+]^^3\/.+1RAp^\/+]\/[-1RA^^-]\/[-\/ "r~"\'\'1 128r@{vv0}m[0"\/.+pse!vvvv<-sh </lang>
However, this implementation does not support input. Also, output is visible only after the brainfuck program terminated. This is due to the limitation that Burlesque does not have actual I/O.
C
C#
C++
Clojure
<lang clojure>(ns brainfuck)
(def ^:dynamic *input*)
(def ^:dynamic *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>
The alternate implementation at Execute Brain****/Clojure showcases a rather different approach.
COBOL
Common Lisp
D
dodo0
<lang 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()</lang> Execution:
$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0 ++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@ Hello World!
E
Elena
ELENA VM Script: <lang elena>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 |=;</lang>
Erlang
Forth
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;
- An addition
Brainfuck("+++.<+++++.[->+<]>.");
- 3
- 5
- 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
Icon and Unicon
J
Java
JavaScript
Lua
Mathematica
<lang>bf[program_, input_] :=
Module[{p = Characters[program], pp = 0, m, mp = 0, bc = 0,
instr = StringToStream[input],
m[_] = 0;
While[pp < Length@p,
pp++;
Switch[ppp,
">", mp++,
"<", mp--,
"+", m[mp]++,
"-", m[mp]--,
".", BinaryWrite[OutputStream["stdout", 1], m[mp]],
",", m[mp] = BinaryRead[instr],
"[", If[m[mp] == 0,
bc = 1;
While[bc > 0, pp++; Switch[ppp, "[", bc++, "]", bc--]]],
"]", If[m[mp] != 0,
bc = -1;
While[bc < 0, pp--; Switch[ppp, "[", bc++, "]", bc--]]]]];
Close[instr];];
bf[program_] := bf[program, ""]</lang>
Expamle:
<lang>bf["++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++. <<+++++++++++++++.>.+++.------.--------.>+.>."]</lang>
Output:
Hello World!
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)
- bf(hello_world)
</lang>
OCaml
PARI/GP
A case statement would have been really useful here... <lang parigp>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] ) ) ) ) ) ) };</lang>
Perl
Perl 6
PHP
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
Python
Racket
Brainfudge is an implementation of Brain**** in Racket. Read the tutorial to see you can integrate a new language into the Racket system. The tutorial also shows how to get IDE support from DrRacket.
As an appetizer this runs in Racket as is:
<lang racket>
- lang planet dyoo/bf
++++++[>++++++++++++<-]>. >++++++++++[>++++++++++<-]>+. +++++++..+++.>++++[>+++++++++++<-]>. <+++[>----<-]>.<<<<<+++[>+++++<-]>. >>.+++.------.--------.>>+. </lang>
Retro
REXX
The REXX code is original, but the BRAINF░CK program was modified from the example given in Wikipedia: [1] <lang rexx>/*REXX program to implement the Brainf*ck (self-censored) language. */
- .=0 /*initialize the infinite "tape".*/
p=0 /*the "tape" cell pointer. */ !=0 /* ! is the instruction pointer.*/ parse arg $ /*allow CBLF to specify a BF pgm.*/
/* │ No pgm? Then use default.*/
if $= then $=, /* ↓ displays: Hello, World! */
"++++++++++ initialize cell #0 to 10; then loop: ",
"[ > +++++++ add 7 to cell #1; final result: 70 ",
" > ++++++++++ add 10 to cell #2; final result: 100 ",
" > +++ add 3 to cell #3; final result 30 ",
" > + add 1 to cell #4; final result 10 ",
" <<<< - ] decrement cell #0 ",
"> ++ . display 'H' which is ASCII 72 (decimal) ",
"> + . display 'e' which is ASCII 101 (decimal) ",
"+++++++ .. display 'll' which is ASCII 108 (decimal) {2}",
"+++ . display 'o' which is ASCII 111 (decimal) ",
"> ++ . display ' ' which is ASCII 32 (decimal) ",
"<< +++++++++++++++ . display 'W' which is ASCII 87 (decimal) ",
"> . display 'o' which is ASCII 111 (decimal) ",
"+++ . display 'r' which is ASCII 114 (decimal) ",
"------ . display 'l' which is ASCII 108 (decimal) ",
"-------- . display 'd' which is ASCII 100 (decimal) ",
"> + . display '!' which is ASCII 33 (decimal) "
/*(above) note Brainf*ck comments*/
do forever; !=!+1; if !==0 | !>length($) then leave; x=substr($,!,1)
select /*examine the current instruction*/
when x=='+' then #.p=#.p + 1 /*increment the "tape" cell by 1.*/
when x=='-' then #.p=#.p - 1 /*decrement the "tape" cell by 1.*/
when x=='>' then p=p + 1 /*increment the pointer by 1.*/
when x=='<' then p=p - 1 /*decrement the pointer by 1.*/
when x=='[' then != forward() /*go forward to ]+1 if #.P =0.*/
when x==']' then !=backward() /*go backward to [+1 if #.P ¬0.*/
when x=='.' then call charout ,d2c(#.p) /*display a "tape" cell.*/
when x==',' then do; say 'input a value:'; parse pull #.p; end
otherwise iterate
end /*select*/
end /*forever*/
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────FORWARD subroutine──────────────────*/ forward: if #.p\==0 then return !; c=1 /* C is the [ nested counter.*/
do k=!+1 to length($); z=substr($,k,1)
if z=='[' then do; c=c+1; iterate; end
if z==']' then do; c=c-1; if c==0 then leave; end
end /*k*/
return k /*──────────────────────────────────BACKWARD subroutine─────────────────*/ backward: if #.p==0 then return !; c=1 /* C is the ] nested counter.*/
do k=!-1 to 1 by -1; z=substr($,k,1)
if z==']' then do; c=c+1; iterate; end
if z=='[' then do; c=c-1; if c==0 then return k+1; end
end /*k*/</lang>
output when using the default program as input
Hello World!
Ruby
Seed7
<lang seed7>$ include "seed7_05.s7i";
const proc: brainF (in string: source, inout file: input, inout file: output) is func
local
var array char: memory is 100000 times '\0\';
var integer: dataPointer is 50000;
var integer: instructionPointer is 1;
var integer: nestingLevel is 0;
begin
while instructionPointer <= length(source) do
case source[instructionPointer] of
when {'>'}: incr(dataPointer);
when {'<'}: decr(dataPointer);
when {'+'}: incr(memory[dataPointer]);
when {'-'}: decr(memory[dataPointer]);
when {'.'}: write(output, memory[dataPointer]);
when {','}: memory[dataPointer] := getc(input);
when {'['}: # Forward if zero at dataPointer
if memory[dataPointer] = '\0\' then
nestingLevel := 1;
repeat
incr(instructionPointer);
case source[instructionPointer] of
when {'['}: incr(nestingLevel);
when {']'}: decr(nestingLevel);
end case;
until nestingLevel = 0;
end if;
when {']'}: # Backward if non-zero at dataPointer
if memory[dataPointer] <> '\0\' then
nestingLevel := 1;
repeat
decr(instructionPointer);
case source[instructionPointer] of
when {'['}: decr(nestingLevel);
when {']'}: incr(nestingLevel);
end case;
until nestingLevel = 0;
end if;
end case;
incr(instructionPointer);
end while;
end func;
const proc: brainF (in string: source) is func
begin brainF(source, IN, OUT); end func;
const proc: main is func
begin
brainF("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");
end func;</lang>
Output:
Hello World!