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>
AWK
Expects the program (not the program file) to be the first argument to the script. Cells don't wrap (trivial if desired) and the code and arena are unbounded.
<lang AWK>BEGIN { bf=ARGV[1]; ARGV[1] = "" compile(bf) execute() }
- Strips non-instructions, builds the jump table.
function compile(s, i,j,k,f) { c = split(s, src, "") j = 0 for(i = 1; i <= c; i++) { if(src[i] ~ /[\-\+\[\]\<\>,\.]/) code[j++] = src[i]
if(src[i] == "[") { marks[j] = 1 } else if(src[i] == "]") { f = 0 for(k = j; k > 0; k--) { if(k in marks) { jump[k-1] = j - 1 jump[j-1] = k - 1 f = 1 delete marks[k] break } } if(!f) { print "Unmatched ]" exit 1 } } } }
function execute( pc,p,i) { pc = p = 0 while(pc in code) { i = code[pc]
if(i == "+") arena[p]++ else if(i == "-") arena[p]-- else if(i == "<") p-- else if(i == ">") p++ else if(i == ".") printf("%c", arena[p]) else if(i == ",") { while(1) { if (goteof) break if (!gotline) { gotline = getline if(!gotline) goteof = 1 if (goteof) break line = $0 } if (line == "") { gotline=0 m[p]=10 break } if (!genord) { for(i=1; i<256; i++) ord[sprintf("%c",i)] = i genord=1 } c = substr(line, 1, 1) line=substr(line, 2) arena[p] = ord[c] break }
} else if((i == "[" && arena[p] == 0) || (i == "]" && arena[p] != 0)) pc = jump[pc] pc++ } } </lang>
- Output:
$ awk -f /tmp/bf.awk '++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>>>+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++.<+++++++.--------.<<<<<+.<+++.---.' Goodbye, World!
BASIC
Implementation in BASIC (QuickBasic dialect).
Applesoft BASIC
<lang ApplesoftBasic>0 ON NOT T GOTO 20 : FOR A = T TO L : B = PEEK(S + P) : ON C%(ASC(MID$(C$, A, T))) GOSUB 1, 2, 3, 4, 5, 8, 6, 7 : NEXT A : END 1 P = P + T : ON P < E GOTO 11 : O = 1E99 2 P = P - T : ON P > M GOTO 11 : O = 1E99 3 B = B + T : B = B - (B > U) * B : GOTO 9 4 B = B - T : B = B - (B < 0) * (B - U) : GOTO 9 5 PRINT CHR$(B); : RETURN 6 D = T : ON NOT B GOTO 10 : RETURN 7 D = M : ON NOT NOT B GOTO 10 : RETURN 8 GET B$ : B = LEN(B$) : IF B THEN B = ASC(B$) 9 POKE S + P, B : RETURN 10 FOR K = D TO 0 STEP 0 : A = A + D : K = K + D%(ASC(MID$(C$, A, T))) : NEXT K : RETURN 11 RETURN 20 HIMEM: 38401 21 LOMEM: 8185 22 DIM C%(14999) : CLEAR 23 POKE 105, PEEK(175) 24 POKE 106, PEEK(176) 25 POKE 107, PEEK(175) 26 POKE 108, PEEK(176) 27 POKE 109, PEEK(175) 28 POKE 110, PEEK(176) 29 HIMEM: 8192 30 T = 1 31 M = -1 32 S = 8192 33 E = 30000 34 U = 255 35 DIM C%(255), D%(255) 43 C%(ASC("+")) = 3 44 C%(ASC(",")) = 6 45 C%(ASC("-")) = 4 46 C%(ASC(".")) = 5 60 C%(ASC("<")) = 2 62 C%(ASC(">")) = 1 91 C%(ASC("[")) = 7 92 D%(ASC("[")) = 1 93 C%(ASC("]")) = 8 94 D%(ASC("]")) = -1 95 C$ = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>->+>>+[<]<-]>>.>>---.+++++++..+++.>.<<-.>.+++.------.--------.>+.>++.+++." 98 L = LEN(C$) 99 GOTO</lang>
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
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!
Groovy
<lang groovy>class BrainfuckProgram {
def program = , memory = [:] def instructionPointer = 0, dataPointer = 0
def execute() { while (instructionPointer < program.size()) { switch(program[instructionPointer++]) { case '>': dataPointer++; break; case '<': dataPointer--; break; case '+': memory[dataPointer] = memoryValue + 1; break; case '-': memory[dataPointer] = memoryValue - 1; break; case ',': memory[dataPointer] = System.in.read(); break; case '.': print((char)memoryValue); break; case '[': handleLoopStart(); break; case ']': handleLoopEnd(); break; } } }
private getMemoryValue() { memory[dataPointer] ?: 0 }
private handleLoopStart() { if (memoryValue) return
int depth = 1; while (instructionPointer < program.size()) { switch(program[instructionPointer++]) { case '[': depth++; break; case ']': if (!(--depth)) return; } } throw new IllegalStateException('Could not find matching end bracket') }
private handleLoopEnd() { int depth = 0 while (instructionPointer >= 0) { switch(program[--instructionPointer]) { case ']': depth++; break; case '[': if (!(--depth)) return; break; } } throw new IllegalStateException('Could not find matching start bracket') }
}</lang> Testing: <lang groovy>new BrainfuckProgram(program: '++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.').execute()</lang>
- Output:
Hello World!
Haskell
Icon and Unicon
J
Java
JavaScript
Limbo
Expects the program to be the first argument, compiles to bytecode (without optimization), uses a 1MB array of cells (and wraps), includes some rudimentary compiler diagnostics.
<lang Limbo>implement Bf;
include "sys.m"; sys: Sys; include "draw.m";
Bf: module { init: fn(nil: ref Draw->Context, args: list of string); ARENASZ: con 1024 * 1024; EXIT, INC, DEC, JZ, JNZ, INCP, DECP, READ, WRITE: con iota; };
init(nil: ref Draw->Context, args: list of string) { sys = load Sys Sys->PATH; args = tl args; if(args == nil || len args != 1) { sys->fprint(sys->fildes(2), "usage: bf program"); raise "fail:usage"; } code := compile(hd args); execute(code, array[ARENASZ] of { * => byte 0 }); }
compile(p: string): array of int { marks: list of int = nil; code := array[len p * 2 + 1] of { * => EXIT }; pc := 0; for(i := 0; i < len p; i++) { case p[i] { '-' => code[pc++] = DEC; '+' => code[pc++] = INC; '<' => code[pc++] = DECP; '>' => code[pc++] = INCP; ',' => code[pc++] = READ; '.' => code[pc++] = WRITE; '[' => code[pc++] = JZ; marks = pc++ :: marks; ']' => if(marks == nil) { sys->fprint(sys->fildes(2), "bf: unmatched ']' at character %d.", pc); raise "fail:errors"; } c := hd marks; marks = tl marks; code[pc++] = JNZ; code[c] = pc; code[pc++] = c; } } if(marks != nil) { sys->fprint(sys->fildes(2), "bf: unmatched '['."); raise "fail:errors"; } return code; }
execute(code: array of int, arena: array of byte) { pc := 0; p := 0; buf := array[1] of byte; stopreading := 0; for(;;) { case code[pc] { DEC => arena[p]--; INC => arena[p]++; DECP => p--; if(p < 0) p = len arena - 1; INCP => p = (p + 1) % len arena; READ => if(!stopreading) { n := sys->read(sys->fildes(0), buf, 1); if(n < 1) { arena[p] = byte 0; stopreading = 1; } else { arena[p] = buf[0]; } } WRITE => buf[0] = arena[p]; sys->write(sys->fildes(1), buf, 1); JNZ => if(arena[p] != byte 0) pc = code[pc + 1]; else pc++; JZ => if(arena[p] == byte 0) pc = code[pc + 1]; else pc++; EXIT => return; } pc++; } } </lang>
- Output:
Using the example code from Hello world/Text:
% bf '++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++ ++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>> >+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++. <+++++++.--------.<<<<<+.<+++.---.' Goodbye, World!
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["stdout", 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;
}
$code = "
>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.> >+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.
"; $inp = '123'; print brainfuck( $code, $inp ); </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!