Execute Brain****: Difference between revisions

From Rosetta Code
Content added Content deleted
(PHP version, Tested, works fine)
(Added AppleScript)
Line 22: Line 22:
[[/Ada|Implementation in Ada]].
[[/Ada|Implementation in Ada]].


=={{header|AppleScript}}==
<lang AppleScript>
set codeString to text returned of (display dialog "Enter BF code:" buttons "OK" default answer "")
set inputString to text returned of (display dialog "Enter input string" buttons "OK" default answer "")
set codePointer to 1
set loopPosns to {}
set tape to {}
set tapePointer to 1
set output to {}
set inputPointer to 1

on betterMod(x, y) -- so -2 mod 256 is 254 instead of -2
local x
local y
try
return -y * (round (x / y) rounding down) + x
on error eMsg number eNum
error "Can't call betterMod() on " & eMsg number eNum
end try
end betterMod

repeat while codePointer ≤ length of codeString
set theChar to (get character codePointer of codeString)
if (theChar = "+") then
if (length of tape < tapePointer) then
set tape to tape & 0
end if
set item tapePointer of tape to betterMod(((get item tapePointer of tape) + 1), 256)
else if (theChar = "-") then
if (length of tape < tapePointer) then
set tape to tape & 0
end if
set item tapePointer of tape to betterMod(((get item tapePointer of tape) - 1), 256)
else if (theChar = "<") then
set tapePointer to tapePointer - 1
else if (theChar = ">") then
set tapePointer to tapePointer + 1
else if (theChar = "[") then
set loopPosns to loopPosns & codePointer
else if (theChar = "]") then
if (item tapePointer of tape ≠ 0) then
set codePointer to (item (length of loopPosns) of loopPosns) - 1
set loopPosns to items 1 thru ((length of loopPosns)) of loopPosns
end if
else if (theChar = ".") then
set output to output & item tapePointer of tape
else if (theChar = ",") then
if (length of tape < tapePointer) then
set tape to tape & 0
end if
if (inputPointer > length of inputString) then
set inputPointer to 1
end if
set item tapePointer of tape to id of item inputPointer of inputString
set inputPointer to inputPointer + 1
end if
set codePointer to codePointer + 1
end repeat

set strout to string id output
display dialog strout
</lang>
=={{header|AutoHotkey}}==
=={{header|AutoHotkey}}==



Revision as of 14:26, 5 March 2014

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 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

Implementation in Algol 68.

Ada

Implementation in Ada.

AppleScript

<lang AppleScript> set codeString to text returned of (display dialog "Enter BF code:" buttons "OK" default answer "") set inputString to text returned of (display dialog "Enter input string" buttons "OK" default answer "") set codePointer to 1 set loopPosns to {} set tape to {} set tapePointer to 1 set output to {} set inputPointer to 1

on betterMod(x, y) -- so -2 mod 256 is 254 instead of -2 local x local y try return -y * (round (x / y) rounding down) + x on error eMsg number eNum error "Can't call betterMod() on " & eMsg number eNum end try end betterMod

repeat while codePointer ≤ length of codeString set theChar to (get character codePointer of codeString) if (theChar = "+") then if (length of tape < tapePointer) then set tape to tape & 0 end if set item tapePointer of tape to betterMod(((get item tapePointer of tape) + 1), 256) else if (theChar = "-") then if (length of tape < tapePointer) then set tape to tape & 0 end if set item tapePointer of tape to betterMod(((get item tapePointer of tape) - 1), 256) else if (theChar = "<") then set tapePointer to tapePointer - 1 else if (theChar = ">") then set tapePointer to tapePointer + 1 else if (theChar = "[") then set loopPosns to loopPosns & codePointer else if (theChar = "]") then if (item tapePointer of tape ≠ 0) then set codePointer to (item (length of loopPosns) of loopPosns) - 1 set loopPosns to items 1 thru ((length of loopPosns)) of loopPosns end if else if (theChar = ".") then set output to output & item tapePointer of tape else if (theChar = ",") then if (length of tape < tapePointer) then set tape to tape & 0 end if if (inputPointer > length of inputString) then set inputPointer to 1 end if set item tapePointer of tape to id of item inputPointer of inputString set inputPointer to inputPointer + 1 end if set codePointer to codePointer + 1 end repeat

set strout to string id output display dialog strout </lang>

AutoHotkey

Implementation in 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.
  1. include <WindowsConstants.au3>
  2. include <EditConstants.au3>
  3. include <Array.au3>
  4. include <GUIConstants.au3>
  5. 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() }

  1. 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

Implementation in 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

Implementation in C.

C#

Implementation in C#.

C++

Implementation in 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

Implementation in COBOL.

Common Lisp

Implementation in Common Lisp.

D

Implementation in 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

  1. 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

  1. 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

  1. 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

  1. 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

  1. 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

  1. 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

  1. Main program

compile(readChar, exitCommand) -> program, input makeBuffer(0, empty, fill) -> buffer input() -> nl, input #consume newline from input

  1. 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

Implementation in E.

Elena

Implementation in Elena

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!

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

Implementation in Haskell.

Icon and Unicon

Implementation in Icon/Unicon.

J

Implementation in J.

Java

Implementation in Java.

JavaScript

Implementation in 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

Implementation in 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

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.

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

Implementation in Perl.

Perl 6

Implementation in 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

Implementation in PureBasic

Python

Implementation in 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>

  1. lang planet dyoo/bf

++++++[>++++++++++++<-]>. >++++++++++[>++++++++++<-]>+. +++++++..+++.>++++[>+++++++++++<-]>. <+++[>----<-]>.<<<<<+++[>+++++<-]>. >>.+++.------.--------.>>+. </lang>

Retro

Implementation in 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. */

  1. .=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

Implementation in 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!

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.