Execute Brain****: Difference between revisions
(Added x86 section) |
(→{{header|Forth}}: Add Fortran.) |
||
Line 953: | Line 953: | ||
=={{header|Forth}}== |
=={{header|Forth}}== |
||
[[/Forth|Implementation in Forth]]. |
[[/Forth|Implementation in Forth]]. |
||
=={{header|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. |
|||
The source employs F90 so as to gain the convenience of a service routine SEEK contained within RUN that thereby has access to the instruction pointer - though it could have been passed as an additional parameter. Similarly, the [ and ] (or ] and [) are passed even though SEEK could determine them via WAY's value and some array accessing. The main idea is that the expression can fit on one line and special code is not used for the two cases.<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*(*) 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:D) = CHAR(ICHAR(STORE(D:D)) + 1) |
|||
CASE("-") !Subtract one. |
|||
STORE(D:D) = CHAR(ICHAR(STORE(D:D)) - 1) |
|||
CASE(".") !Write a character. |
|||
WRITE (MSG,1) STORE(D:D) |
|||
CASE(",") !Read a charactger. |
|||
READ (KBD,1) STORE(D:D) |
|||
CASE("[") !Conditionally, surge forward. |
|||
IF (ICHAR(STORE(D:D)).EQ.0) CALL SEEK("[","]",+1) |
|||
CASE("]") !Conditionally, retreat. |
|||
IF (ICHAR(STORE(D: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(AB,BA,WAY) !Seek the BA matching the AB. |
|||
CHARACTER*1 AB,BA !The dancers. |
|||
INTEGER WAY !Which direction. |
|||
INTEGER INDEEP !Nested brackets are allowed. |
|||
INDEEP = 0 !None have been counted. |
|||
I = I - 1 !Back to where C came from PROG. |
|||
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*30000 STORE !Probably rather more than is needed. |
|||
CHARACTER*(*) HELLOWORLD !Believe it or not... |
|||
PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]" |
|||
1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------" |
|||
2 //".--------.>>+.>++.") |
|||
KBD = 5 !Standard input. |
|||
MSG = 6 !Standard output. |
|||
CALL RUN(HELLOWORLD,STORE) !Have a go. |
|||
END !Enough.</lang> |
|||
Output: |
|||
<pre> |
|||
Hello World! |
|||
</pre> |
|||
=={{header|F_Sharp|F#}}== |
=={{header|F_Sharp|F#}}== |
Revision as of 12:47, 21 April 2016
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
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.
The source employs F90 so as to gain the convenience of a service routine SEEK contained within RUN that thereby has access to the instruction pointer - though it could have been passed as an additional parameter. Similarly, the [ and ] (or ] and [) are passed even though SEEK could determine them via WAY's value and some array accessing. The main idea is that the expression can fit on one line and special code is not used for the two cases.<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*(*) 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:D) = CHAR(ICHAR(STORE(D:D)) + 1) CASE("-") !Subtract one. STORE(D:D) = CHAR(ICHAR(STORE(D:D)) - 1) CASE(".") !Write a character. WRITE (MSG,1) STORE(D:D) CASE(",") !Read a charactger. READ (KBD,1) STORE(D:D) CASE("[") !Conditionally, surge forward. IF (ICHAR(STORE(D:D)).EQ.0) CALL SEEK("[","]",+1) CASE("]") !Conditionally, retreat. IF (ICHAR(STORE(D: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(AB,BA,WAY) !Seek the BA matching the AB. CHARACTER*1 AB,BA !The dancers. INTEGER WAY !Which direction. INTEGER INDEEP !Nested brackets are allowed. INDEEP = 0 !None have been counted. I = I - 1 !Back to where C came from PROG. 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*30000 STORE !Probably rather more than is needed. CHARACTER*(*) HELLOWORLD !Believe it or not... PARAMETER (HELLOWORLD = "++++++++[>++++[>++>+++>+++>+<<<<-]" 1 //" >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------" 2 //".--------.>>+.>++.") KBD = 5 !Standard input. MSG = 6 !Standard output.
CALL RUN(HELLOWORLD,STORE) !Have a go.
END !Enough.</lang>
Output:
Hello World!
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 / 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
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
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
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.
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
x86 Assembly
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
- Fortran
- F Sharp
- GAP
- Go
- Groovy
- Haskell
- Icon
- Unicon
- J
- Java
- JavaScript
- Limbo
- Lua
- Mathematica
- Wolfram Language
- Modula-3
- Nim
- OCaml
- PARI/GP
- Perl
- Perl 6
- Phix
- PHP
- PicoLisp
- PureBasic
- Python
- Racket
- Retro
- REXX
- Ruby
- Rust
- Scheme
- Seed7
- Sidef
- Standard ML
- Swift
- TI-83 BASIC
- TI-89 BASIC
- Tcl
- X86 Assembly
- Zkl
- GUISS/Omit