Execute Brain****: Difference between revisions
m (→{{header|Sidef}}: modified code to work with Sidef 2.10) |
m (→{{header|Sidef}}: minor code fix) |
||
Line 1,927: | Line 1,927: | ||
func get_input { |
func get_input { |
||
static input_buffer = |
static input_buffer = []; |
||
input_buffer.len || (input_buffer = STDIN.readline); |
input_buffer.len || (input_buffer = ((STDIN.readline \\ return eof_val).chomp.chars.map{.ord})); |
||
input_buffer |
input_buffer.shift \\ eof_val; |
||
} |
} |
||
Line 1,948: | Line 1,948: | ||
'>' => { ++cell }, |
'>' => { ++cell }, |
||
'<' => { --cell }, |
'<' => { --cell }, |
||
'+' => { tape[cell] |
'+' => { ++tape[cell] }, |
||
'-' => { tape[cell] |
'-' => { --tape[cell] }, |
||
'.' => { tape[cell].chr.print }, |
'.' => { tape[cell].chr.print }, |
||
',' => { tape[cell] = get_input() }, |
',' => { tape[cell] = get_input() }, |
||
Line 1,956: | Line 1,956: | ||
); |
); |
||
STDOUT.autoflush(1); |
|||
code = ARGF.slurp. |
code = ARGF.slurp.chars.grep {|c| commands.exists(c)}; |
||
var code_len = code.len; |
var code_len = code.len; |
||
Revision as of 02:13, 22 October 2015
You are encouraged to solve this task according to the task description, using any language you may know.
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
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
AutoIt
<lang AutoIt>; AutoFucck
- A AutoIt Brainfuck Interpreter
- by minx
- AutoIt Version
- 3.3.8.x
- Commands
- - DEC
- + INC
- [ LOOP START
- ] LOOP END
- . Output cell value as ASCII Chr
- , Input a ASCII char (cell value = ASCII code)
- Ouput cell value as integer
- ; Input a Integer
- _ Output a single whitespace
- / Output an Carriage Return and Line Feed
- You can load & save .atf Files.
- include <WindowsConstants.au3>
- include <EditConstants.au3>
- include <Array.au3>
- include <GUIConstants.au3>
- include <StaticCOnstants.au3>
HotKeySet("{F5}", "_Runn")
$hMain = GUICreate("Autofuck - Real Brainfuck Interpreter", 600, 525) $mMain = GUICtrlCreateMenu("File") Global $mCode = GUICtrlCreateMenu("Code") $mInfo = GUICtrlCreateMenu("Info") $mCredits = GUICtrlCreateMenuItem("Credits", $mInfo) $mFile_New = GUICtrlCreateMenuItem("New", $mMain) $mFile_Open = GUICtrlCreateMenuItem("Open", $mMain) $mFile_Save = GUICtrlCreateMenuItem("Save", $mMain) Global $mCode_Run = GUICtrlCreateMenuItem("Run [F5]", $mCode) Global $lStatus = GUICtrlCreateLabel("++ Autofuck started...", 5, 480, 590, 20, $SS_SUNKEN) GUICtrlSetFont(-1, Default, Default, Default, "Courier New") $eCode = GUICtrlCreateEdit("", 5, 5, 590, 350) GUICtrlSetFont(-1, Default, Default, Default, "Courier New") $eConsole = GUICtrlCreateEdit("", 5, 360, 590, 115, $ES_WANTRETURN) GUICtrlSetFont(-1, Default, Default, Default, "Courier New") GUISetState()
While 1 $nMsg = GUIGetMsg() Switch $nMsg Case $mFile_New GUICtrlSetData($eCode, "") Case $mFile_Open GUICtrlSetData($eCode, FileRead(FileOpenDialog("Open Autofuck script", @DesktopDir, "Autofuck (*.atf)"))) Case $mFile_Save FileWrite(FileOpen(StringReplace(FileSaveDialog("Save Autofuck script", @DesktopDir, "Autofuck (*.atf)"), ".atf", "") &".atf", 2), GUICtrlRead($eCode)) Case $GUI_EVENT_CLOSE Exit Case $mCredits MsgBox(0, "Autofuck", "Copyright by: "&@CRLF&"minx (autoit.de)"&@CRLF&"crashdemons (autoitscript.com)") EndSwitch WEnd
Func _Runn() $Timer = TimerInit() GUICtrlSetData($lStatus, "++ Program started") Global $tData=DllStructCreate('BYTE[65536]') Global $pData=0 GUICtrlSetData($eConsole, "") Local $aError[6]=[,'Unmatched closing bracket during search','Unmatched opening bracket during search','Unexpected closing bracket','Data pointer passed left boundary','Data pointer passed right boundary']
Local $sError= Local $i=_Run(GUICtrlRead($eCode)) If @error>=0 And @error<6 Then $sError=$aError[@error] If StringLen($sError) Then GUICtrlSetData($eConsole, 'ERROR: '&$sError&'.'&@CRLF&'Ending Instruction Pointer: '&($i-1)&@CRLF&'Current Data Pointer: '&$pData)
GUICtrlSetData($lStatus, "++ Program terminated. Runtime: "& Round( TimerDiff($Timer) / 1000, 4) &"s") EndFunc
Func _Run($Code,$iStart=1,$iEnd=0)
If $iEnd<1 Then $iEnd=StringLen($Code) For $i = $iStart to $iEnd Switch StringMid($Code, $i, 1) Case ">" $pData+=1 If $pData=65536 Then Return SetError(5,0,$i) Case "<" $pData-=1 If $pData<0 Then Return SetError(4,0,$i) Case "+" DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)+1,$pData+1) Case "-" DllStructSetData($tData,1,DllStructGetData($tData,1,$pData+1)-1,$pData+1) Case ":" GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & (DllStructGetData($tData,1,$pData+1)))
Case "."
GUICtrlSetData($eConsole, GUICtrlRead($eConsole) & Chr(DllStructGetData($tData,1,$pData+1))) Case ";" Local $cIn=StringMid(InputBox('Autofuck','Enter Number'),1) DllStructSetData($tData,1,Number($cIn),$pData+1)
Case ","
Local $cIn=StringMid(InputBox('Autofuck','Enter one ASCII character'),1,1) DllStructSetData($tData,1,Asc($cIn),$pData+1) Case "[" Local $iStartSub=$i Local $iEndSub=_MatchBracket($Code,$i,$iEnd) If @error<>0 Then Return SetError(@error,0,$iEndSub) While DllStructGetData($tData,1,$pData+1)<>0 Local $iRet=_Run($Code,$iStartSub+1,$iEndSub-1) If @error<>0 Then Return SetError(@error,0,$iRet) WEnd $i=$iEndSub Case ']' Return SetError(3,0,$i)
Case "_" GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&" ") Case "/" GUICtrlSetData($eConsole, GUICtrlRead($eConsole)&@CRLF)
EndSwitch Next Return 0
EndFunc
Func _MatchBracket($Code,$iStart=1,$iEnd=0)
If $iEnd<1 Then $iEnd=StringLen($Code) Local $Open=0 For $i=$iStart To $iEnd Switch StringMid($Code,$i,1) Case '[' $Open+=1 Case ']' $Open-=1 If $Open=0 Then Return $i If $Open<0 Then Return SetError(1,0,$i) EndSwitch Next If $Open>0 Then Return SetError(2,0,$i) Return 0
EndFunc</lang>
AWK
Expects the program (not the program file) to be the first argument to the script. Cells don't wrap (trivial if desired) and the code and arena are unbounded.
<lang AWK>BEGIN { bf=ARGV[1]; ARGV[1] = "" compile(bf) execute() }
- Strips non-instructions, builds the jump table.
function compile(s, i,j,k,f) { c = split(s, src, "") j = 0 for(i = 1; i <= c; i++) { if(src[i] ~ /[\-\+\[\]\<\>,\.]/) code[j++] = src[i]
if(src[i] == "[") { marks[j] = 1 } else if(src[i] == "]") { f = 0 for(k = j; k > 0; k--) { if(k in marks) { jump[k-1] = j - 1 jump[j-1] = k - 1 f = 1 delete marks[k] break } } if(!f) { print "Unmatched ]" exit 1 } } } }
function execute( pc,p,i) { pc = p = 0 while(pc in code) { i = code[pc]
if(i == "+") arena[p]++ else if(i == "-") arena[p]-- else if(i == "<") p-- else if(i == ">") p++ else if(i == ".") printf("%c", arena[p]) else if(i == ",") { while(1) { if (goteof) break if (!gotline) { gotline = getline if(!gotline) goteof = 1 if (goteof) break line = $0 } if (line == "") { gotline=0 m[p]=10 break } if (!genord) { for(i=1; i<256; i++) ord[sprintf("%c",i)] = i genord=1 } c = substr(line, 1, 1) line=substr(line, 2) arena[p] = ord[c] break }
} else if((i == "[" && arena[p] == 0) || (i == "]" && arena[p] != 0)) pc = jump[pc] pc++ } } </lang>
- Output:
$ awk -f /tmp/bf.awk '++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>>>+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++.<+++++++.--------.<<<<<+.<+++.---.' Goodbye, World!
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
Burlesque
<lang burlesque> ".""X"r~"-""\/^^{vvvv}c!!!-.256.%{vvvv}c!sa\/"r~"+""\/^^{vvvv}c!!!+. 256.%{vvvv}c!sa\/"r~"[""{"r~"]""}{\/^^{vvvv}c!!!}w!"r~">""+."r~"<"" -."r~"X""\/^^{vvvv}c!!!L[+]\/+]\/+]^^3\/.+1RAp^\/+]\/[-1RA^^-]\/[-\/ "r~"\'\'1 128r@{vv0}m[0"\/.+pse!vvvv<-sh </lang>
However, this implementation does not support input. Also, output is visible only after the brainfuck program terminated. This is due to the limitation that Burlesque does not have actual I/O.
C
C#
C++
Clojure
<lang clojure>(ns brainfuck)
(def ^:dynamic *input*)
(def ^:dynamic *output*)
(defrecord Data [ptr cells])
(defn inc-ptr [next-cmd]
(fn [data] (next-cmd (update-in data [:ptr] inc))))
(defn dec-ptr [next-cmd]
(fn [data] (next-cmd (update-in data [:ptr] dec))))
(defn inc-cell [next-cmd]
(fn [data] (next-cmd (update-in data [:cells (:ptr data)] (fnil inc 0)))))
(defn dec-cell [next-cmd]
(fn [data] (next-cmd (update-in data [:cells (:ptr data)] (fnil dec 0)))))
(defn output-cell [next-cmd]
(fn [data] (set! *output* (conj *output* (get (:cells data) (:ptr data) 0))) (next-cmd data)))
(defn input-cell [next-cmd]
(fn [data] (let [[input & rest-input] *input*] (set! *input* rest-input) (next-cmd (update-in data [:cells (:ptr data)] input)))))
(defn if-loop [next-cmd loop-cmd]
(fn [data] (next-cmd (loop [d data] (if (zero? (get (:cells d) (:ptr d) 0)) d (recur (loop-cmd d)))))))
(defn terminate [data] data)
(defn split-cmds [cmds]
(letfn [(split [[cmd & rest-cmds] loop-cmds] (when (nil? cmd) (throw (Exception. "invalid commands: missing ]"))) (case cmd \[ (let [[c l] (split-cmds rest-cmds)] (recur c (str loop-cmds "[" l "]"))) \] [(apply str rest-cmds) loop-cmds] (recur rest-cmds (str loop-cmds cmd))))] (split cmds "")))
(defn compile-cmds cmd & rest-cmds
(if (nil? cmd) terminate (case cmd \> (inc-ptr (compile-cmds rest-cmds)) \< (dec-ptr (compile-cmds rest-cmds)) \+ (inc-cell (compile-cmds rest-cmds)) \- (dec-cell (compile-cmds rest-cmds)) \. (output-cell (compile-cmds rest-cmds)) \, (input-cell (compile-cmds rest-cmds)) \[ (let [[cmds loop-cmds] (split-cmds rest-cmds)] (if-loop (compile-cmds cmds) (compile-cmds loop-cmds))) \] (throw (Exception. "invalid commands: missing [")) (compile-cmds rest-cmds))))
(defn compile-and-run [cmds input]
(binding [*input* input *output* []] (let [compiled-cmds (compile-cmds cmds)] (println (compiled-cmds (Data. 0 {})))) (println *output*) (println (apply str (map char *output*)))))
</lang> <lang clojure>brainfuck> (compile-and-run "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." []) {:ptr 4, :cells {4 10, 3 33, 2 100, 1 87, 0 0}} [72 101 108 108 111 32 87 111 114 108 100 33 10] Hello World!
nil </lang>
The alternate implementation at Execute Brain****/Clojure showcases a rather different approach.
COBOL
Common Lisp
Implementation in Common Lisp.
D
dodo0
<lang dodo0>#Import some functions clojure('count', 1) -> size clojure('nth', 2) -> charAt clojure('inc', 1) -> inc clojure('dec', 1) -> dec clojure('char', 1) -> char clojure('int', 1) -> int clojure('read-line', 0) -> readLine
- The characters we will need
charAt("\n", 0) -> newLine charAt("@", 0) -> exitCommand charAt("+", 0) -> incrCommand charAt("-", 0) -> decrCommand charAt("<", 0) -> shlCommand charAt(">", 0) -> shrCommand charAt(".", 0) -> printCommand charAt(",", 0) -> inputCommand charAt("[", 0) -> repeatCommand charAt("]", 0) -> endCommand
- Read a character from a line of input.
fun readChar -> return ( readLine() -> line size(line) -> length
#Return the ith character and a continuation fun nextFromLine -> i, return ( '='(i, length) -> eol if (eol) -> ( return(newLine, readChar) #end of line ) | charAt(line, i) -> value inc(i) -> i fun next (-> return) nextFromLine(i, return) | next return(value, next) ) | nextFromLine
nextFromLine(0, return) #first character (position 0) ) | readChar
- Define a buffer as a value and a left and right stack
fun empty (-> return, throw) throw("Error: out of bounds") | empty fun fill (-> return, throw) return(0, fill) | fill
fun makeBuffer -> value, left, right, return ( fun buffer (-> return) return(value, left, right) | buffer return(buffer) ) | makeBuffer
fun push -> value, stack, return ( fun newStack (-> return, throw) return(value, stack) | newStack return(newStack) ) | push
- Brainf*** operations
fun noop -> buffer, input, return ( return(buffer, input) ) | noop
fun selectOp -> command, return ( '='(command, incrCommand) -> eq if (eq) -> ( fun increment -> buffer, input, return ( buffer() -> value, left, right inc(value) -> value makeBuffer(value, left, right) -> buffer return(buffer, input) ) | increment return(increment) ) | '='(command, decrCommand) -> eq if (eq) -> ( fun decrement -> buffer, input, return ( buffer() -> value, left, right dec(value) -> value makeBuffer(value, left, right) -> buffer return(buffer, input) ) | decrement return(decrement) ) | '='(command, shlCommand) -> eq if (eq) -> ( fun shiftLeft -> buffer, input, return ( buffer() -> value, left, right push(value, right) -> right left() -> value, left ( makeBuffer(value, left, right) -> buffer return(buffer, input) ) | message println(message) -> exit() ) | shiftLeft return(shiftLeft) ) | '='(command, shrCommand) -> eq if (eq) -> ( fun shiftRight -> buffer, input, return ( buffer() -> value, left, right push(value, left) -> left right() -> value, right ( makeBuffer(value, left, right) -> buffer return(buffer, input) ) | message println(message) -> exit() ) | shiftRight return(shiftRight) ) | '='(command, printCommand) -> eq if (eq) -> ( fun putChar -> buffer, input, return ( buffer() -> value, left, right char(value) -> value 'print'(value) -> dummy 'flush'() -> dummy return(buffer, input) ) | putChar return(putChar) ) | '='(command, inputCommand) -> eq if (eq) -> ( fun getChar -> buffer, input, return ( input() -> letter, input int(letter) -> letter buffer() -> value, left, right makeBuffer(letter, left, right) -> buffer return(buffer, input) ) | getChar return(getChar) ) | return(noop) ) | selectOp
- Repeat until zero operation
fun whileLoop -> buffer, input, continue, break ( buffer() -> value, left, right '='(value, 0) -> zero if (zero) -> ( break(buffer, input) ) | continue(buffer, input) -> buffer, input whileLoop(buffer, input, continue, break) ) | whileLoop
- Convert the Brainf*** program into dodo0 instructions
fun compile -> input, endmark, return ( input() -> command, input
'='(command, endmark) -> eq if (eq) -> ( return(noop, input) #the end, stop compiling ) | #Put in sequence the current operation and the rest of the program fun chainOp -> op, input, return ( compile(input, endmark) -> program, input fun exec -> buffer, input, return ( op(buffer, input) -> buffer, input program(buffer, input, return) ) | exec return(exec, input) ) | chainOp
'='(command, repeatCommand) -> eq if (eq) -> ( compile(input, endCommand) -> body, input #compile until "]"
#Repeat the loop body until zero fun repeat -> buffer, input, return ( whileLoop(buffer, input, body, return) ) | repeat chainOp(repeat, input, return) ) | selectOp(command) -> op chainOp(op, input, return) ) | compile
- Main program
compile(readChar, exitCommand) -> program, input makeBuffer(0, empty, fill) -> buffer input() -> nl, input #consume newline from input
- Execute the program instructions
program(buffer, input) -> buffer, input exit()</lang> Execution:
$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0 ++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@ Hello World!
E
Elena
Erlang
Forth
F#
GAP
<lang gap># Here . and , print and read an integer, not a character Brainfuck := function(prog)
local pointer, stack, leftcells, rightcells, instr, stackptr, len, output, input, jump, i, j, set, get; input := InputTextUser(); output := OutputTextUser(); instr := 1; pointer := 0; leftcells := [ ]; rightcells := [ ]; stack := [ ]; stackptr := 0; len := Length(prog); jump := [ ];
get := function() local p; if pointer >= 0 then p := pointer + 1; if IsBound(rightcells[p]) then return rightcells[p]; else return 0; fi; else p := -pointer; if IsBound(leftcells[p]) then return leftcells[p]; else return 0; fi; fi; end; set := function(value) local p; if pointer >= 0 then p := pointer + 1; if value = 0 then Unbind(rightcells[p]); else rightcells[p] := value; fi; else p := -pointer; if value = 0 then Unbind(leftcells[p]); else leftcells[p] := value; fi; fi; end; # find jumps for faster execution for i in [1 .. len] do if prog[i] = '[' then stackptr := stackptr + 1; stack[stackptr] := i; elif prog[i] = ']' then j := stack[stackptr]; stackptr := stackptr - 1; jump[i] := j; jump[j] := i; fi; od;
while instr <= len do c := prog[instr]; if c = '<' then pointer := pointer - 1; elif c = '>' then pointer := pointer + 1; elif c = '+' then set(get() + 1); elif c = '-' then set(get() - 1); elif c = '.' then WriteLine(output, String(get())); elif c = ',' then set(Int(Chomp(ReadLine(input)))); elif c = '[' then if get() = 0 then instr := jump[instr]; fi; elif c = ']' then if get() <> 0 then instr := jump[instr]; fi; fi; instr := instr + 1; od; CloseStream(input); CloseStream(output); # for debugging purposes, return last state return [leftcells, rightcells, pointer];
end;
- An addition
Brainfuck("+++.<+++++.[->+<]>.");
- 3
- 5
- 8</lang>
Go
Fixed size data store, no bounds checking. <lang go>package main
import "fmt"
func main() {
// example program is current Brain**** solution to // Hello world/Text task. only requires 10 bytes of data store! bf(10, `++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++
++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>> >+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++. <+++++++.--------.<<<<<+.<+++.---.`) }
func bf(dLen int, is string) {
ds := make([]byte, dLen) // data store var dp int // data pointer for ip := 0; ip < len(is); ip++ { switch is[ip] { case '>': dp++ case '<': dp-- case '+': ds[dp]++ case '-': ds[dp]-- case '.': fmt.Printf("%c", ds[dp]) case ',': fmt.Scanf("%c", &ds[dp]) case '[': if ds[dp] == 0 { for nc := 1; nc > 0; { ip++ if is[ip] == '[' { nc++ } else if is[ip] == ']' { nc-- } } } case ']': if ds[dp] != 0 { for nc := 1; nc > 0; { ip-- if is[ip] == ']' { nc++ } else if is[ip] == '[' { nc-- } } } } }
}</lang>
- Output:
Goodbye, World!
Groovy
<lang groovy>class BrainfuckProgram {
def program = , memory = [:] def instructionPointer = 0, dataPointer = 0
def execute() { while (instructionPointer < program.size()) { switch(program[instructionPointer++]) { case '>': dataPointer++; break; case '<': dataPointer--; break; case '+': memory[dataPointer] = memoryValue + 1; break; case '-': memory[dataPointer] = memoryValue - 1; break; case ',': memory[dataPointer] = System.in.read(); break; case '.': print((char)memoryValue); break; case '[': handleLoopStart(); break; case ']': handleLoopEnd(); break; } } }
private getMemoryValue() { memory[dataPointer] ?: 0 }
private handleLoopStart() { if (memoryValue) return
int depth = 1; while (instructionPointer < program.size()) { switch(program[instructionPointer++]) { case '[': depth++; break; case ']': if (!(--depth)) return; } } throw new IllegalStateException('Could not find matching end bracket') }
private handleLoopEnd() { int depth = 0 while (instructionPointer >= 0) { switch(program[--instructionPointer]) { case ']': depth++; break; case '[': if (!(--depth)) return; break; } } throw new IllegalStateException('Could not find matching start bracket') }
}</lang> Testing: <lang groovy>new BrainfuckProgram(program: '++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.').execute()</lang>
- Output:
Hello World!
Haskell
Icon and Unicon
Implementation in Icon/Unicon.
J
Java
JavaScript
Limbo
Expects the program to be the first argument, compiles to bytecode (without optimization), uses a 1MB array of cells (and wraps), includes some rudimentary compiler diagnostics.
<lang Limbo>implement Bf;
include "sys.m"; sys: Sys; include "draw.m";
Bf: module { init: fn(nil: ref Draw->Context, args: list of string); ARENASZ: con 1024 * 1024; EXIT, INC, DEC, JZ, JNZ, INCP, DECP, READ, WRITE: con iota; };
init(nil: ref Draw->Context, args: list of string) { sys = load Sys Sys->PATH; args = tl args; if(args == nil || len args != 1) { sys->fprint(sys->fildes(2), "usage: bf program"); raise "fail:usage"; } code := compile(hd args); execute(code, array[ARENASZ] of { * => byte 0 }); }
compile(p: string): array of int { marks: list of int = nil; code := array[len p * 2 + 1] of { * => EXIT }; pc := 0; for(i := 0; i < len p; i++) { case p[i] { '-' => code[pc++] = DEC; '+' => code[pc++] = INC; '<' => code[pc++] = DECP; '>' => code[pc++] = INCP; ',' => code[pc++] = READ; '.' => code[pc++] = WRITE; '[' => code[pc++] = JZ; marks = pc++ :: marks; ']' => if(marks == nil) { sys->fprint(sys->fildes(2), "bf: unmatched ']' at character %d.", pc); raise "fail:errors"; } c := hd marks; marks = tl marks; code[pc++] = JNZ; code[c] = pc; code[pc++] = c; } } if(marks != nil) { sys->fprint(sys->fildes(2), "bf: unmatched '['."); raise "fail:errors"; } return code; }
execute(code: array of int, arena: array of byte) { pc := 0; p := 0; buf := array[1] of byte; stopreading := 0; for(;;) { case code[pc] { DEC => arena[p]--; INC => arena[p]++; DECP => p--; if(p < 0) p = len arena - 1; INCP => p = (p + 1) % len arena; READ => if(!stopreading) { n := sys->read(sys->fildes(0), buf, 1); if(n < 1) { arena[p] = byte 0; stopreading = 1; } else { arena[p] = buf[0]; } } WRITE => buf[0] = arena[p]; sys->write(sys->fildes(1), buf, 1); JNZ => if(arena[p] != byte 0) pc = code[pc + 1]; else pc++; JZ => if(arena[p] == byte 0) pc = code[pc + 1]; else pc++; EXIT => return; } pc++; } } </lang>
- Output:
Using the example code from Hello world/Text:
% bf '++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++ ++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>> >+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++. <+++++++.--------.<<<<<+.<+++.---.' Goodbye, World!
Lua
Mathematica
<lang>bf[program_, input_] :=
Module[{p = Characters[program], pp = 0, m, mp = 0, bc = 0, instr = StringToStream[input]}, m[_] = 0; While[pp < Length@p, pp++; Switch[ppp, ">", mp++, "<", mp--, "+", m[mp]++, "-", m[mp]--, ".", BinaryWrite["stdout", m[mp]], ",", m[mp] = BinaryRead[instr], "[", If[m[mp] == 0, bc = 1; While[bc > 0, pp++; Switch[ppp, "[", bc++, "]", bc--]]], "]", If[m[mp] != 0, bc = -1; While[bc < 0, pp--; Switch[ppp, "[", bc++, "]", bc--]]]]]; Close[instr];];
bf[program_] := bf[program, ""]</lang>
Expamle:
<lang>bf["++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++. <<+++++++++++++++.>.+++.------.--------.>+.>."]</lang>
- Output:
Hello World!
Modula-3
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
PARI/GP
A case statement would have been really useful here... <lang parigp>BF(prog)={ prog=Vec(Str(prog)); my(codeptr,ptr=1,v=vector(1000),t); while(codeptr++ <= #prog, t=prog[codeptr]; if(t=="+", v[ptr]++ , if(t=="-", v[ptr]-- , if(t==">", ptr++ , if(t=="<", ptr-- , if(t=="[" && !v[ptr], t=1; while(t, if(prog[codeptr++]=="[",t++); if(prog[codeptr]=="]",t--) ); ); if(t=="]"&&v[ptr], t=1; while(t, if(prog[codeptr--]=="[",t--); if(prog[codeptr]=="]",t++) ) ); if(t==".", print1(Strchr(v[ptr])) ); if(t==",", v[ptr]=Vecsmall(input)[1] ) ) ) ) ) ) };</lang>
Perl
Perl 6
PHP
See also this alternate implementation.
<lang php><?php function brainfuck_interpret(&$s, &$_s, &$d, &$_d, &$i, &$_i, &$o) {
do { switch($s[$_s]) { case '+': $d[$_d] = chr(ord($d[$_d]) + 1); break; case '-': $d[$_d] = chr(ord($d[$_d]) - 1); break; case '>': $_d++; if(!isset($d[$_d])) $d[$_d] = chr(0); break; case '<': $_d--; break; case '.': $o .= $d[$_d]; break; case ',': $d[$_d] = $_i==strlen($i) ? chr(0) : $i[$_i++]; break; case '[': if((int)ord($d[$_d]) == 0) { $brackets = 1; while($brackets && $_s++ < strlen($s)) { if($s[$_s] == '[') $brackets++; else if($s[$_s] == ']') $brackets--; } } else { $pos = $_s++-1; if(brainfuck_interpret($s, $_s, $d, $_d, $i, $_i, $o)) $_s = $pos; } break; case ']': return ((int)ord($d[$_d]) != 0); } } while(++$_s < strlen($s));
}
function brainfuck($source, $input=) {
$data = array(); $data[0] = chr(0); $data_index = 0; $source_index = 0; $input_index = 0; $output = ; brainfuck_interpret($source, $source_index, $data, $data_index, $input, $input_index, $output); return $output;
}
$code = "
>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.> >+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.
"; $inp = '123'; print brainfuck( $code, $inp ); </lang>
PicoLisp
This solution uses a doubly-linked list for the cell space. That list consists of a single cell initially, and grows automatically in both directions. The value in each cell is unlimited. <lang PicoLisp>(off "Program")
(de compile (File)
(let Stack NIL (setq "Program" (make (in File (while (char) (case @ (">" (link '(setq Data (or (cddr Data) (con (cdr Data) (cons 0 (cons Data))) ) ) ) ) ("<" (link '(setq Data (or (cadr Data) (set (cdr Data) (cons 0 (cons NIL Data))) ) ) ) ) ("+" (link '(inc Data))) ("-" (link '(dec Data))) ("." (link '(prin (char (car Data))))) ("," (link '(set Data (char (read))))) ("[" (link '(setq Code ((if (=0 (car Data)) cdar cdr) Code) ) ) (push 'Stack (chain (cons))) ) ("]" (unless Stack (quit "Unbalanced ']'") ) (link '(setq Code ((if (n0 (car Data)) cdar cdr) Code) ) ) (let (There (pop 'Stack) Here (cons There)) (chain (set There Here)) ) ) ) ) ) ) ) (when Stack (quit "Unbalanced '['") ) ) )
(de execute ()
(let Data (cons 0 (cons)) # Create initial cell (for (Code "Program" Code) # Run program (eval (pop 'Code)) ) (while (cadr Data) # Find beginning of data (setq Data @) ) (filter prog Data '(T NIL .)) ) ) # Return data space</lang>
- Output:
: (compile "hello.bf") -> NIL : (execute) Goodbye, World! -> (0 10 33 44 71 87 98 100 114 121)
Alternative solution
# This implements a BrainFuck *interpreter* similar to the "official" one. # It has 30000 unsigned 8-bit cells with wrapping, going off the bounds # of the memory results in an error. (de bf (Prg) (let (P Prg S NIL D (need 30000 0) Dp D F T ) (while P (case (car P) ("+" (if F (set Dp (% (inc (car Dp) 256))))) ("-" (if F (set Dp (% (dec (car Dp) 256))))) (">" (if F (setq Dp (cdr Dp)))) ("<" (if F (setq Dp (prior Dp D)))) ("." (if F (prin (char (car Dp))))) ("," (if F (set Dp (char (read))))) ("[" (push 'S (if F (prior P Prg))) (setq F (n0 (car Dp))) ) ("]" (and (setq F (pop 'S)) (n0 (car Dp)) (setq P F) ) ) ) (pop 'P) ) ) ) # A little "Hello world! test of the interpreter." (bf (chop ">+++++++++[<++++++++>-]<.>+++++++[<++++>-]<+.+++++++..+++.[-] >++++++++[<++++>-] <.>+++++++++++[<++++++++>-]<-.--------.+++.------.--- -----.[-]>++++++++[<++++>- ]<+.[-]++++++++++." ) ) (bye)
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
Python
Racket
Brainfudge is an implementation of Brain**** in Racket. Read the tutorial to see you can integrate a new language into the Racket system. The tutorial also shows how to get IDE support from DrRacket.
As an appetizer this runs in Racket as is:
<lang racket>
- lang planet dyoo/bf
++++++[>++++++++++++<-]>. >++++++++++[>++++++++++<-]>+. +++++++..+++.>++++[>+++++++++++<-]>. <+++[>----<-]>.<<<<<+++[>+++++<-]>. >>.+++.------.--------.>>+. </lang>
Retro
REXX
The REXX code is original, but the BRAINF░CK program was modified from the example given in Wikipedia: [1] <lang rexx>/*REXX program to implement the Brainf*ck (self-censored) language. */
- .=0 /*initialize the infinite "tape".*/
p=0 /*the "tape" cell pointer. */ !=0 /* ! is the instruction pointer.*/ parse arg $ /*allow CBLF to specify a BF pgm.*/
/* │ No pgm? Then use default.*/
if $= then $=, /* ↓ displays: Hello, World! */
"++++++++++ initialize cell #0 to 10; then loop: ", "[ > +++++++ add 7 to cell #1; final result: 70 ", " > ++++++++++ add 10 to cell #2; final result: 100 ", " > +++ add 3 to cell #3; final result 30 ", " > + add 1 to cell #4; final result 10 ", " <<<< - ] decrement cell #0 ", "> ++ . display 'H' which is ASCII 72 (decimal) ", "> + . display 'e' which is ASCII 101 (decimal) ", "+++++++ .. display 'll' which is ASCII 108 (decimal) {2}", "+++ . display 'o' which is ASCII 111 (decimal) ", "> ++ . display ' ' which is ASCII 32 (decimal) ", "<< +++++++++++++++ . display 'W' which is ASCII 87 (decimal) ", "> . display 'o' which is ASCII 111 (decimal) ", "+++ . display 'r' which is ASCII 114 (decimal) ", "------ . display 'l' which is ASCII 108 (decimal) ", "-------- . display 'd' which is ASCII 100 (decimal) ", "> + . display '!' which is ASCII 33 (decimal) " /*(above) note Brainf*ck comments*/ do forever; !=!+1; if !==0 | !>length($) then leave; x=substr($,!,1) select /*examine the current instruction*/ when x=='+' then #.p=#.p + 1 /*increment the "tape" cell by 1.*/ when x=='-' then #.p=#.p - 1 /*decrement the "tape" cell by 1.*/ when x=='>' then p=p + 1 /*increment the pointer by 1.*/ when x=='<' then p=p - 1 /*decrement the pointer by 1.*/ when x=='[' then != forward() /*go forward to ]+1 if #.P =0.*/ when x==']' then !=backward() /*go backward to [+1 if #.P ¬0.*/ when x=='.' then call charout ,d2c(#.p) /*display a "tape" cell.*/ when x==',' then do; say 'input a value:'; parse pull #.p; end otherwise iterate end /*select*/ end /*forever*/
exit /*stick a fork in it, we're done.*/ /*──────────────────────────────────FORWARD subroutine──────────────────*/ forward: if #.p\==0 then return !; c=1 /* C is the [ nested counter.*/
do k=!+1 to length($); z=substr($,k,1) if z=='[' then do; c=c+1; iterate; end if z==']' then do; c=c-1; if c==0 then leave; end end /*k*/
return k /*──────────────────────────────────BACKWARD subroutine─────────────────*/ backward: if #.p==0 then return !; c=1 /* C is the ] nested counter.*/
do k=!-1 to 1 by -1; z=substr($,k,1) if z==']' then do; c=c+1; iterate; end if z=='[' then do; c=c-1; if c==0 then return k+1; end end /*k*/</lang>
- Output:
when using the default program as input
Hello World!
Ruby
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
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
<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.
TI-83 BASIC
Implementation in TI-83 BASIC.
TI-89 BASIC
Implementation in TI-89 Basic.
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/]
- Programming Tasks
- Solutions by Programming Task
- Compilers and Interpreters
- Implementations
- Brainf*** Implementations
- Brainf*** related
- ALGOL 68
- Ada
- AppleScript
- AutoHotkey
- AutoIt
- AWK
- Axe
- BASIC
- Applesoft BASIC
- BBC BASIC
- Brat
- Burlesque
- C
- C sharp
- C++
- Clojure
- COBOL
- Common Lisp
- D
- Dodo0
- E
- Elena
- Erlang
- Forth
- F Sharp
- GAP
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Limbo
- Lua
- Mathematica
- Modula-3
- Nim
- OCaml
- PARI/GP
- Perl
- Perl 6
- PHP
- PicoLisp
- PureBasic
- Python
- Racket
- Retro
- REXX
- Ruby
- Rust
- Scheme
- Seed7
- Sidef
- Standard ML
- TI-83 BASIC
- TI-89 BASIC
- Tcl
- Zkl
- GUISS/Omit