Execute Brain****: Difference between revisions

From Rosetta Code
Content added Content deleted
(generalize a bit)
(OOO pretty)
Line 3: Line 3:


An implementation need only properly implement the following instructions:
An implementation need only properly implement the following instructions:
{| class="wikitable"
* [     (left bracket)
!Command
* ]     (right bracket)
!Description
* +     (plus sign)
|-
* -     (minus sign)
| style="text-align:center"| <code>&gt;</code> || Move the pointer to the right
* &lt; &nbsp; &nbsp; (less than sign)
|-
* &gt; &nbsp; &nbsp; (greater than sign)
| style="text-align:center"| <code>&lt;</code> || Move the pointer to the left
* , &nbsp; &nbsp; (comma)
|-
* . &nbsp; &nbsp; (period)
| style="text-align:center"| <code>+</code> || Increment the memory cell under the pointer
|-
| style="text-align:center"| <code>-</code> || Decrement the memory cell under the pointer
|-
| style="text-align:center"| <code>.</code> || Output the character signified by the cell at the pointer
|-
| style="text-align:center"| <code>,</code> || Input a character and store it in the cell at the pointer
|-
| style="text-align:center"| <code>[</code> || Jump past the matching <code>]</code> if the cell under the pointer is 0
|-
| style="text-align:center"| <code>]</code> || Jump back to the matching <code>[</code> if the cell under the pointer is nonzero
|}
Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory.
Any cell size is allowed, EOF support is optional, as is whether you have bounded or unbounded memory.
<br>
<br>

Revision as of 17:57, 12 August 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:

Command Description
> Move the pointer to the right
< Move the pointer to the left
+ Increment the memory cell under the pointer
- Decrement the memory cell under the pointer
. Output the character signified by the cell at the pointer
, Input a character and store it in the cell at the pointer
[ Jump past the matching ] if the cell under the pointer is 0
] Jump back to the matching [ if the cell under the pointer is nonzero

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

Outputs debug in a .txt file similar to that of brainfuck.tk <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 set step to 0

set thePath to (path to desktop as Unicode text) & "log.txt" set debug to (open for access file thePath with write permission)

write (step as string) & " (" & ((codePointer - 1) as string) & "): (The program contains " & ((length of codeString) as string) & " instructions.) " to debug

set step 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 repeat while (length of tape < tapePointer) set tape to tape & 0 end repeat set item tapePointer of tape to betterMod(((get item tapePointer of tape) + 1), 256) write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | a[" & ((tapePointer - 1) as string) & "]= " & ((item tapePointer of tape) as string) & " " to debug else if (theChar = "-") then repeat while (length of tape < tapePointer) set tape to tape & 0 end repeat set item tapePointer of tape to betterMod(((get item tapePointer of tape) - 1), 256) write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | a[" & ((tapePointer - 1) as string) & "]= " & ((item tapePointer of tape) as string) & " " to debug else if (theChar = "<") then set tapePointer to tapePointer - 1 write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | array pos. now " & ((tapePointer - 1) as string) & " " to debug

else if (theChar = ">") then set tapePointer to tapePointer + 1 write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | array pos. now " & ((tapePointer - 1) as string) & " " to debug

else if (theChar = "[") then repeat while (length of tape < tapePointer) set tape to tape & 0 end repeat write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | Array[" & ((tapePointer - 1) as string) & "] is '" & ((item tapePointer of tape) as string) & "'" to debug if (item tapePointer of tape ≠ 0) then set loopPosns to loopPosns & codePointer write " ** Loop nesting level: " & (((length of loopPosns) - 1) as string) & ". " to debug else write " " & (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | Not entering a loop but skipping to instruction number " to debug set matchLoops to 1 repeat while matchLoops ≠ 0 set codePointer to codePointer + 1 if (item codePointer of codeString = "[") then set matchLoops to matchLoops + 1 else if (item codePointer of codeString = "]") then set matchLoops to matchLoops - 1 end if end repeat write ((codePointer - 1) as string) & " " to debug end if

else if (theChar = "]") then repeat while (length of tape < tapePointer) set tape to tape & 0 end repeat write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | Array[" & ((tapePointer - 1) as string) & "] is '" & ((item tapePointer of tape) as string) & "' " to debug if (item tapePointer of tape ≠ 0) then write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | looping back to " & (((item (length of loopPosns) of loopPosns) - 1) as string) & " " to debug set codePointer to (item (length of loopPosns) of loopPosns) - 1 end if if (length of loopPosns > 1) then set loopPosns to items 1 thru ((length of loopPosns) - 1) of loopPosns else set loopPosns to {} end if

else if (theChar = ".") then repeat while (length of tape < tapePointer) set tape to tape & 0 end repeat write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | output '" & ((item tapePointer of tape) as string) & "' " & string id (item tapePointer of tape) & " " to debug set output to output & item tapePointer of tape

else if (theChar = ",") then repeat while (length of tape < tapePointer) set tape to tape & 0 end repeat 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 write (step as string) & " (" & ((codePointer - 1) as string) & "): " & (item codePointer of codeString) & " | read in " & string id (item tapePointer of tape) & " (" & ((item tapePointer of tape) as string) & ") " to debug end if

set codePointer to codePointer + 1 set step to step + 1 end repeat

set strout to string id output display dialog strout close access debug </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 os

var 

 code = if paramCount() > 0: readFile paramStr 1
        else: readAll stdin
 tape = newSeq[char]()
 d    = 0
 i    = 0

proc run(skip = false): bool = 

 while d >= 0 and i < code.len:
   if d >= tape.len: tape.add '\0'

   if code[i] == '[':
     inc i
     let p = i
     while run(tape[d] == '\0'): i = p
   elif code[i] == ']':
     return tape[d] != '\0'
   elif not skip:
     case code[i]
     of '+': inc tape[d]
     of '-': dec tape[d]
     of '>': inc d
     of '<': dec d
     of '.': stdout.write tape[d]
     of ',': tape[d] = stdin.readChar
     else: discard

   inc i

discard run()</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.


Scheme

See Execute_Brain****/Scheme.

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.

zkl

<lang zkl>fcn bf(pgm,input=""){ pgm=pgm.text; // handle both String and Data 

  const CELLS=0d30_000;
  if(Void==pgm.span("[","]")){ println("Mismatched brackets"); return(); }
  fcn(code,z,jmpTable){ // build jump table (for [ & ])
     if(span:=code.span("[","]")){

a,b:=span; b+=a-1; jmpTable[a+z]=b+z; jmpTable[b+z]=a+z; self.fcn(code[a+1,b-a-1],z+a+1,jmpTable); self.fcn(code[b+1,*],z+b+1,jmpTable); 

     }
  }(pgm,0,jmpTable:=D());

  tape:=CELLS.pump(Data(CELLS,Int),0);
  ip:=dp:=0; input=input.walker();
  try{
     while(1){

switch(pgm[ip]){ case(">"){ dp+=1 } case("<"){ dp-=1 } case("+"){ tape[dp]=tape[dp]+1 } case("-"){ tape[dp]=tape[dp]-1 } case("."){ tape[dp].toChar().print() } case(","){ c:=input._next(); tape[dp]=(c and input.value or 0); } case("["){ if(0==tape[dp]){ ip=jmpTable[ip] }} case("]"){ if(tape[dp]) { ip=jmpTable[ip] }} } ip+=1; 

     } // while
  }catch(IndexError){}  // read past end of tape == end of program

}</lang> <lang zkl> // print Hello World! bf("++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++.." 

  "+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.");

   // print @

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

  // read 3 characters, inc by 1 and print: "abc"-->"bcd"

bf(",>,>,><<<[+.>]","abc"); println();

bf(",>++++++[<-------->-],[<+>-]<.","23"); println(); // add two digits 

   // "Enter your name:", prints name backwards

bf(">+++++++++++++++++++++++++++++++++++++++++" 

  "++++++++++++++++++++++++++++.++++++++++++++"
  "+++++++++++++++++++++++++++.++++++.-------------"
  "--.+++++++++++++.>++++++++++++++++++++++++++"
  "++++++.<+++++++.----------.++++++.---.>.<----.----------"
  "---.++++++++++++.--------.-----------------------------------"
  "--------.>.<>>>+[>,----------]++++++++++.<[+++++++++"
  "+.<][<]","Sam Iam\n");

   // word count

bf(File("wc.b").read(),"This\n is a test"); 

   // rot13

bf(File("rot13.b").read(),"This is a test 123");</lang>

Output:
Hello World!
@
bcd
5
Enter your name: 
maI maS
       	1	4	15
Guvf vf n grfg 123^CCntl C noted

The rot13 program is from the Wikipedia and has an infinite loop as it expects a different EoF than I use.

The word count program is: 

>>>+>>>>>+>>+>>+[<<],[
    -[-[-[-[-[-[-[-[<+>-[>+<-[>-<-[-[-[<++[<++++++>-]<
        [>>[-<]<[>]<-]>>[<+>-[<->[-]]]]]]]]]]]]]]]]
    <[-<<[-]+>]<<[>>>>>>+<<<<<<-]>[>]>>>>>>>+>[
        <+[
            >+++++++++<-[>-<-]++>[<+++++++>-[<->-]+[+>>>>>>]]
            <[>+<-]>[>>>>>++>[-]]+<
        ]>[-<<<<<<]>>>>
    ],
]+<++>>>[[+++++>>>>>>]<+>+[[<++++++++>-]<.<<<<<]>>>>>>>>]
[Counts lines, words, bytes. Assumes no-change-on-EOF or EOF->0.
Daniel B Cristofani (cristofdathevanetdotcom)
http://www.hevanet.com/cristofd/brainfuck/]
Retrieved from "https://rosettacode.org/wiki/Execute_Brain****?oldid=47069"