Execute Brain****

From Rosetta Code
Revision as of 13:32, 22 April 2016 by Dinosaur (talk | contribs) (→‎{{header|Fortran}}: Ah yes, a further idea.)
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!

Axe

In this implementation, the array is limited to 768 bytes due to OS constraints. Call BF with pointers to the (null-terminated) program and input.

Note that this implementation has no error checking.

<lang axe>Lbl BF r₁→P r₂→I L₁→D Fill(D,768,0)

While {P} 

{P}→C
If C='+'
 {D}++
ElseIf C='-'
 {D}--
ElseIf C='>'
 D++
ElseIf C='<'
 D--
ElseIf C='.'
 Disp {D}▶Char
ElseIf C=','
 {I}→{D}
 I++
ElseIf C='['?{D}=0
 NEXT(P)→P
ElseIf C=']'
 PREV(P)→P
End
P++

End Return

Lbl NEXT r₁++ 1→S While S 

If {r₁}='['
 S++
ElseIf {r₁}=']'
 S--
End
r₁++

End r₁ Return

Lbl PREV r₁-- 1→S While S 

If {r₁}=']'
 S++
ElseIf {r₁}='['
 S--
End
r₁--

End r₁ Return</lang>

Example <lang axe>"++++++++++++++++++++++++++++++++[>+>+<<-]>>+++++++++++++++++++++++++<<++++++++++[>>.-<.<-]"→Str1 BF(Str1,0)</lang>

Output 

9▪8▪7▪6▪5▪4▪3▪2▪1▪0▪

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.

Fortran

Initial puzzlement as to the nature of the scratchpad was resolved: the source code being interpreted is in one storage area and the data scratchpad is another. Thus, self-modifying code is not in fact possible, so higher level of brain**** is precluded - as are still further opportunities offered by having the instruction and data pointers being in the data scratchpad rather than as separate items. Later experimentation showed that the initial value of all the STORE cells must be zero.

The source employs F90 so as to gain the convenience of a service routine SEEK contained within RUN that thereby has access to the PROG and the instruction pointer - though these could have been passed as additional parameters. The main idea is that the expression can fit on one line and special code is not used for the two cases. The STORE array of cells is represented as an array of CHARACTER*1 variables rather than a CHARACTER*n single variable. This means that an element is addressed as STORE(i), rather than STORE(i:i), and that STORE = CHAR(0) initialises the whole array to zero. If it were CHARACTER*n, then only the first character would be zero, all subsequent would be blanks. It is not clear what size a cell represents, but a single character suffices for the trial run. For usage that involves arithmetic, the ICHAR and CHAR functions are needed which work on values of 0:255. The cell array could be declared INTEGER*1 instead, which would allow arithmetic without sacrifices on the altar of type checking. Such a variable in two's complement has values of -128:127 however with only addition and subtraction supported this doesn't matter - the bit patterns are the same as for unsigned integers. Larger integer sizes are possible if required, but would require changes to the READ and WRITE statements because A1 format works at the high-order end of a multi-byte variable.

The PROG variable could also be regarded as an array of single characters, but such an array is not a suitable candidate for a text literal such as initialises HELLOWORLD.<lang Fortran> MODULE BRAIN !It will suffer. 

      INTEGER MSG,KBD
      CONTAINS		!A twisted interpreter.
       SUBROUTINE RUN(PROG,STORE)	!Code and data are separate!
        CHARACTER*(*) PROG	!So, this is the code.
        CHARACTER*(1) STORE(:)	!And this a work area.
        CHARACTER*1 C		!The code of the moment.
        INTEGER I,D		!Fingers to an instruction, and to data.
         D = 1		!First element of the store.
         I = 1		!First element of the prog.

         DO WHILE(I.LE.LEN(PROG))	!Off the end yet?
           C = PROG(I:I)		!Load the opcode fingered by I.
           I = I + 1			!Advance one. The classic.
           SELECT CASE(C)		!Now decode the instruction.
            CASE(">")			!Move the data finger one place right.
             D = D + 1
            CASE("<")			!Move the data finger one place left.
             D = D - 1
            CASE("+")			!Add one to the fingered datum.
             STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
            CASE("-")			!Subtract one.
             STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
            CASE(".")			!Write a character.
             WRITE (MSG,1) STORE(D)
            CASE(",")			!Read a charactger.
             READ (KBD,1) STORE(D)
            CASE("[")			!Conditionally, surge forward.
             IF (ICHAR(STORE(D)).EQ.0) CALL SEEK(+1)
            CASE("]")			!Conditionally, retreat.
             IF (ICHAR(STORE(D)).NE.0) CALL SEEK(-1)
            CASE DEFAULT		!For all others,

!Do nothing. 

           END SELECT			!That was simple.
         END DO		!See what comes next.

   1     FORMAT (A1,$)	!One character, no advance to the next line.
        CONTAINS	!Now for an assistant.
         SUBROUTINE SEEK(WAY)	!Look for the BA that matches the AB.
          INTEGER WAY		!Which direction: ±1.
          CHARACTER*1 AB,BA	!The dancers.
          INTEGER INDEEP	!Nested brackets are allowed.
           INDEEP = 0		!None have been counted.
           I = I - 1		!Back to where C came from PROG.
           AB = PROG(I:I)	!The starter.
           BA = "[ ]"(WAY + 2:WAY + 2)	!The stopper.
   1       IF (I.GT.LEN(PROG)) STOP "Out of code!"	!Perhaps not!
           IF (PROG(I:I).EQ.AB) THEN		!A starter? (Even if backwards)
             INDEEP = INDEEP + 1			!Yep.
           ELSE IF (PROG(I:I).EQ.BA) THEN	!A stopper?
             INDEEP = INDEEP - 1			!Yep.
           END IF				!A case statement requires constants.
           IF (INDEEP.GT.0) THEN	!Are we out of it yet?
             I = I + WAY			!No. Move.
             IF (I.GT.0) GO TO 1		!And try again.
             STOP "Back to 0!"			!Perhaps not.
           END IF			!But if we are out of the nest,
           I = I + 1			!Advance to the following instruction, either WAY.
         END SUBROUTINE SEEK	!Seek, and one shall surely find.
       END SUBROUTINE RUN	!So much for that.
     END MODULE BRAIN	!Simple in itself.

     PROGRAM POKE	!A tester.
     USE BRAIN		!In a rather bad way.
     CHARACTER*1 STORE(30000)	!Probably rather more than is needed.
     CHARACTER*(*) HELLOWORLD	!Believe it or not...
     PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]"
    1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------"
    2 //".--------.>>+.>++.")
     KBD = 5		!Standard input.
     MSG = 6		!Standard output.
     STORE = CHAR(0)	!Scrub.

     CALL RUN(HELLOWORLD,STORE)	!Have a go.

     END	!Enough.

</lang>

Output: 

Hello World!

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 / Wolfram Language

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

Nim

<lang nim>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.

Phix

<lang Phix>procedure bfi(string pgm) sequence jumptable = repeat(0,length(pgm)), 

        loopstack = {},
        data = repeat(0,10)    -- size??

integer skip = 0, ch, loopstart, pc, dp 

   --
   -- compile (pack/strip comments and link jumps)
   --
   for i=1 to length(pgm) do
       ch = pgm[i]
       switch ch do
           case '[': loopstack = append(loopstack,i-skip); 
                     pgm[i-skip] = ch;
           case ']': loopstart = loopstack[$]; 
                     loopstack = loopstack[1..-2]; 
                     jumptable[i-skip] = loopstart; 
                     jumptable[loopstart] = i-skip; 
                     fallthrough
           case '+','-','<','>',',','.': pgm[i-skip] = ch;
           default: skip += 1
       end switch
   end for
   if length(loopstack) then ?9/0 end if
   pgm = pgm[1..-1-skip]

   --
   -- main execution loop
   --
   pc = 1
   dp = 1
   while pc<=length(pgm) do
       ch = pgm[pc]
       switch ch do
           case '>': dp += 1 if dp>length(data) then dp = 1 end if
           case '<': dp -= 1 if dp<1 then dp = length(data) end if
           case '+': data[dp] += 1
           case '-': data[dp] -= 1
           case ',': data[dp] = getc(0)
           case '.': puts(1,data[dp])
           case '[': if data[dp]=0 then pc = jumptable[pc] end if
           case ']': if data[dp]!=0 then pc = jumptable[pc] end if
           default: ?9/0
       end switch
       pc += 1
   end while

end procedure

constant bf="++++++++[>++++[>++>++++>+++>+<<<<-]>++>->+>>+[<]<-]>>.>>.+.<.>>.<<<++.>---------.>------.<----.++++++++.>>+.>++.+++." constant fb="++++++++[>++++[>++>++++>+++>+<<<<-]>++>->+>>+[<]<-]>>.>>.+.<.>>.<<<+++.>---.>------.++++++++.<--.>>+.>++.+++.,"

bfi(bf) bfi(fb)</lang>

Output:
Phix Rocks!
Phix Sucks!

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)

Dynamic solution

Dynamic and unlimited. Unwraping cells. Checking syntax. <lang PicoLisp>(de brackets (Lst) 

  (let S NIL
     (make
        (for (I . X) Lst
           (case X
              ("[" (push 'S I))
              ("]"
                 (unless S (quit "Unbalanced '['"))
                 (link (list (pop 'S) I)) ) ) )
        (when S (quit "Unbalanced ']'")) ) ) )

(de lupbra (Lst N) 

  (find
     '((I)
        (or
           (= (car I) N)
           (= (cadr I) N) ) )
     Lst ) )

(de brain (L) 

  (let
     (D (0)
        DH 1
        DL 1  
        CH 1
        CL (length L)
        B (brackets L) )
     (loop
        (case (get L CH)
           (>
              (inc 'DH)
              (when (> DH DL)
                 (setq D (insert DH D 0))
                 (inc 'DL) ) )
           (<
              (dec 'DH)
              (when (< DH 1)
                 (setq D (insert DH D 0))
                 (inc 'DL)
                 (one DH) ) )
           (+ (inc (nth D DH)))
           (- (dec (nth D DH)))
           (. (prin (char (get D DH))))
           ("," (set (nth D DH) (char (key))))
           ("["
              (when (=0 (get D DH))
                 (setq CH (cadr (lupbra B CH))) ) )
           ("]"
              (when (n0 (get D DH))
                 (setq CH (car (lupbra B CH))) ) ) )
        (inc 'CH)
        (T (> CH CL)) ) ) )

(brain (chop ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-] >++++++++[<++++>-] <.>+++++++++++[<++++++++>-]<-.--------.+++.------.---

.[-]>++++++++[<++++>- ]<+.[-]++++++++++." ) )

(bye)</lang>

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: &nbsp: [1] <lang rexx>/*REXX program implements the Brainf*ck (self─censored) language. */ @.=0 /*initialize the infinite "tape". */ p =0 /*the "tape" cell pointer. */ ! =0 /* ! is the instruction pointer (IP).*/ parse arg $ /*allow user to specify a BrainF*ck pgm*/ 

                                                /* ┌──◄── No program? Then use default;*/

if $= then $=, /* ↓ it 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)    "
                                                /* [↑]   note the  Brainf*ck  comments.*/
    do !=1  while  !\==0  &  !<=length($)       /*keep executing  BF  as long as IP ¬ 0*/
    parse var  $  =(!)  x  +1                   /*obtain a  Brainf*ck instruction  (x),*/
                                                /*···it's the same as  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  "       "     "      "  " */
      when x=='>'  then   p=  p + 1             /*increment  "  instruction ptr   "  " */
      when x=='<'  then   p=  p - 1             /*decrement  "       "       "    "  " */
      when x=='['  then != forward()            /*go  forward to   ]+1   if  @.P = 0.  */
      when x==']'  then !=backward()            /* " backward  "   [+1    "   "  ¬ "   */
      when x== .   then call charout , d2c(@.p) /*display a  "tape"  cell to terminal. */
      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 all done. */ /*──────────────────────────────────────────────────────────────────────────────────────*/ forward: if @.p\==0 then return !; c=1 /*C: ◄─── is the [ nested counter.*/ 

                        do k=!+1  to length($);        ?=substr($, k, 1)
                        if ?=='['  then do; c=c+1;     iterate;                   end
                        if ?==']'  then do; c=c-1;     if c==0  then leave;       end
                        end   /*k*/
         return k

/*──────────────────────────────────────────────────────────────────────────────────────*/ backward: if @.p==0 then return !; c=1 /*C: ◄─── is the ] nested counter.*/ 

                        do k=!-1  to 1  by -1;         ?=substr($, k, 1)
                        if ?==']'  then do; c=c+1;     iterate;                   end
                        if ?=='['  then do; c=c-1;     if c==0  then return k+1;  end
                        end   /*k*/
         return k</lang>

output   when using the default program as input: 

Hello World!

Ruby

Implementation in Ruby.

Rust

<lang rust>use std::collections::HashMap; use std::env; use std::fs::File; use std::io::prelude::*; use std::io::stdin; use std::num::Wrapping;

fn main() { 

   let args: Vec<_> = env::args().collect();
   if args.len() < 2 {
       println!("Usage: {} [path] (--debug)", args[0]);
       return;
   }

   let src: Vec<char> = {
       let mut buf = String::new();
       match File::open(&args[1])
       {
           Ok(mut f) => { f.read_to_string(&mut buf).unwrap(); }
           Err(e)    => {
               println!("Error opening '{}': {}", args[1], e);
               return;
           }
       }

       buf.chars().collect()
   };

   // Launch options
   let debug = args.contains(&"--debug".to_owned());

   // One pass to find bracket pairs.
   let brackets: HashMap<usize, usize> = {
       let mut m = HashMap::new();
       let mut scope_stack = Vec::new();
       for (idx, ch) in src.iter().enumerate() {
           match ch {
               &'[' => { scope_stack.push(idx); }
               &']' => { m.insert(scope_stack.pop().unwrap(), idx); }
               _    => { /* ignore */ }
           }
       }

       m
   };

   let mut pc: usize = 0;                                  // Program counter
   let mut mem: [Wrapping<u8>;5000] = [Wrapping(0);5000];  // Program cemory
   let mut ptr: usize = 0;                                 // Pointer
   let mut stack: Vec<usize> = Vec::new();                 // Bracket stack

   let stdin_ = stdin();
   let mut reader = stdin_.lock().bytes();
   while pc < src.len() {
       let Wrapping(val) = mem[ptr];

       if debug {
           println!("(BFDB) PC: {:04} \tPTR: {:04} \t$PTR: {:03} \tSTACK_DEPTH: {} \tSYMBOL: {}", pc, ptr, val, stack.len(), src[pc]);
       }

       const ONE: Wrapping<u8> = Wrapping(1);
       match src[pc] {
           '>' => { ptr += 1; }
           '<' => { ptr -= 1; }

           '+' => { mem[ptr] = mem[ptr] + ONE; }
           '-' => { mem[ptr] = mem[ptr] - ONE; }

           '[' => {
               if val == 0 {
                   pc = brackets[&pc];
               } else {
                   stack.push(pc);
               }
           }
           ']' => {
               let matching_bracket = stack.pop().unwrap();
               if val != 0 {
                   pc = matching_bracket - 1;
               }
           }

           '.' => {
               if debug {
                   println!("(BFDB) STDOUT: '{}'", val as char);  // Intercept output
               } else {
                   print!("{}", val as char);
               }
           }
           ',' => {
               mem[ptr] = Wrapping(reader.next().unwrap().unwrap());
           }

           _   => { /* ignore */ }
       }

       pc += 1;
   }

}</lang>


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!

Original source [2].

Sidef

Translation of: Perl

<lang ruby>define tape_length = 50_000; define eof_val = -1; define unbalanced_exit_code = 1;

var cmd = 0; var cell = 0; var code = []; var loops = []; var tape = tape_length.of(0);

func get_input { 

   static input_buffer = [];
   input_buffer.len || (input_buffer = ((STDIN.readline \\ return eof_val).chomp.chars.map{.ord}));
   input_buffer.shift \\ eof_val;

}

func jump { 

   var depth = 0;
   while (depth >= 0) {
       ++cmd < code.len || Sys.exit(unbalanced_exit_code);
       if (code[cmd] == '[') {
           ++depth;
       }
       elsif (code[cmd] == ']') {
           --depth;
       }
   }

}

var commands = Hash.new( 

   '>' => { ++cell },
   '<' => { --cell },
   '+' => { ++tape[cell] },
   '-' => { --tape[cell] },
   '.' => { tape[cell].chr.print },
   ',' => { tape[cell] = get_input() },
   '[' => { tape[cell] ? loops.append(cmd) : jump() },
   ']' => { cmd = (loops.pop - 1) },

);

STDOUT.autoflush(1); code = ARGF.slurp.chars.grep {|c| commands.exists(c)}; var code_len = code.len;

while (cmd < code_len) { 

   commands{code[cmd]}.run;
   cmd++;

}</lang>

Standard ML

Implementation in Standard ML.

Swift

<lang Swift>import Foundation

let valids = [">", "<", "+", "-", ".", ",", "[", "]"] as Set<Character> var ip = 0 var dp = 0 var data = [UInt8](count: 30_000, repeatedValue: 0)

let input = Process.arguments

if input.count != 2 { 

   fatalError("Need one input file")

}

let infile: String!

do { 

   infile = try String(contentsOfFile: input[1], encoding: NSUTF8StringEncoding) ?? ""

} catch let err { 

   infile = ""

}

var program = ""

// remove invalid chars for c in infile.characters { 

   if valids.contains(c) {
       program += String(c)
   }

}

let numChars = program.characters.count

if numChars == 0 { 

   fatalError("Error reading file")

}

func increaseInstructionPointer() { 

   ip += 1

}

func executeInstruction(ins: Character) { 

   switch ins {
   case ">":
       dp += 1
       increaseInstructionPointer()
   case "<":
       dp -= 1
       increaseInstructionPointer()
   case "+":
       data[dp] = data[dp] &+ 1
       increaseInstructionPointer()
   case "-":
       data[dp] = data[dp] &- 1
       increaseInstructionPointer()
   case ".":
       print(Character(UnicodeScalar(data[dp])), terminator: "")
       increaseInstructionPointer()
   case ",":
       handleIn()
       increaseInstructionPointer()
   case "[":
       handleOpenBracket()
   case "]":
       handleClosedBracket()
   default:
       fatalError("What")
   }

}

func handleIn() { 

   let input = NSFileHandle.fileHandleWithStandardInput()
   let bytes = input.availableData.bytes
   let buf = unsafeBitCast(UnsafeBufferPointer(start: bytes, count: 1),
       UnsafeBufferPointer<UInt8>.self)
   
   data[dp] = buf[0]

}

func handleOpenBracket() { 

   if data[dp] == 0 {
       var i = 1
       
       while i > 0 {
           ip += 1
           let ins = program[program.startIndex.advancedBy(ip)]
           
           if ins == "[" {
               i += 1
           } else if ins == "]" {
               i -= 1
           }
       }
   } else {
       increaseInstructionPointer()
   }

}

func handleClosedBracket() { 

   if data[dp] != 0 {
       var i = 1
       
       while i > 0 {
           ip -= 1
           let ins = program[program.startIndex.advancedBy(ip)]
           
           if ins == "[" {
               i -= 1
           } else if ins == "]" {
               i += 1
           }
       }
   } else {
       increaseInstructionPointer()
   }

}

func tick() { 

   let ins = program[program.startIndex.advancedBy(ip)]
   
   if valids.contains(ins) {
       executeInstruction(ins)
   } else {
       increaseInstructionPointer()
   }

}

while ip != numChars { 

   tick()

}</lang>

TI-83 BASIC

Implementation in TI-83 BASIC.

TI-89 BASIC

Implementation in TI-89 Basic.

Tcl

Implementation in Tcl.

x86 Assembly

Implementation in x86

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=47095"