Execute Brain****

From Rosetta Code
(Redirected from RCBF)
Task
Execute Brain****
You are encouraged to solve this task according to the task description, using any language you may know.
Execute Brain**** is an implementation of Brainf***. Other implementations of Brainf***.

RCBF is a set of Brainf*** compilers and interpreters written for Rosetta Code in a variety of languages.

Below are links to each of the versions of RCBF.

An implementation need only properly implement the following instructions:

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

Any cell size is allowed,   EOF   (End-O-File)   support is optional, as is whether you have bounded or unbounded memory.

11l

F bf(source)
   V tape = DefaultDict[Int, Int]()
   V cell = 0
   V ptr = 0
   L ptr < source.len
      S source[ptr]
         ‘>’
            cell++
         ‘<’
            cell--
         ‘+’
            tape[cell]++
         ‘-’
            tape[cell]--
         ‘.’
            :stdout.write(Char(code' tape[cell]))
         ‘,’
            tape[cell] = :stdin.read(1).code
         ‘[’
            I tape[cell] == 0
               V nesting_level = 0
               L
                  S source[ptr]
                     ‘[’
                        nesting_level++
                     ‘]’
                        I --nesting_level == 0
                           L.break
                  ptr++
         ‘]’
            I tape[cell] != 0
               V nesting_level = 0
               L
                  S source[ptr]
                     ‘[’
                        I --nesting_level == 0
                           L.break
                     ‘]’
                        nesting_level++
                  ptr--
      ptr++

bf(‘++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.’)

68000 Assembly

Takes a Brainfuck program as a command line parameter. Escape character (escape key!) is handled as a 0 when inputting characters. Does NOT support break, so programs that don't end by themselves will run forever.

;
; Brainfuck interpreter by Thorham
;
; 68000+ AmigaOs2+
;
; Cell size is a byte
;
    incdir  "asminc:"

    include "dos/dosextens.i"
    include "lvo/lvos.i"

execBase equ 4

start

; parse command line parameter

    move.l  a0,fileName

    move.b  (a0)+,d0
    beq     exit ; no parameter

    cmp.b   #'"',d0 ; filter out double quotes
    bne     .loop

    addq.l  #1,fileName

.loop
    move.b  (a0)+,d0

    cmp.b   #'"',d0 ; filter out double quotes
    beq     .done

    cmp.b   #32,d0
    bge     .loop

.done
    clr.b   -(a0) ; end of string

; open dos library

    move.l  execBase,a6

    lea     dosName,a1
    moveq   #36,d0
    jsr     _LVOOpenLibrary(a6)
    move.l  d0,dosBase
    beq     exit

; get stdin and stdout handles

    move.l  dosBase,a6

    jsr     _LVOInput(a6)
    move.l  d0,stdIn
    beq     exit

    jsr     _LVOOutput(a6)
    move.l  d0,stdOut
    beq     exit

    move.l  stdIn,d1
    jsr     _LVOFlush(a6)

; open file

    move.l  fileName,d1
    move.l  #MODE_OLDFILE,d2
    jsr     _LVOOpen(a6)
    move.l  d0,fileHandle
    beq     exit

; examine file

    lea     fileInfoBlock,a4

    move.l  fileHandle,d1
    move.l  a4,d2
    jsr     _LVOExamineFH(a6)
    tst.w   d0
    beq     exit

; exit if the file is a folder

    tst.l   fib_DirEntryType(a4)
    bge     exit

; allocate file memory

    move.l  execBase,a6

    move.l  fib_Size(a4),d0
    beq     exit ; exit if file is empty
    clr.l   d1
    jsr     _LVOAllocVec(a6)
    move.l  d0,program
    beq     exit

; read file

    move.l  dosBase,a6

    move.l  fileHandle,d1
    move.l  program,d2
    move.l  fib_Size(a4),d3
    jsr     _LVORead(a6)
    tst     d0
    ble     exit ; exit if read didn't succeed

; close file

    move.l  fileHandle,d1
    jsr     _LVOClose(a6)
    clr.l   fileHandle

; clear tape (bss section is allocated by os but not cleared)

    lea     tape,a0
    lea     tapeEnd,a1

.loopClear
    clr.b   (a0)+
    cmp.l   a0,a1
    bne     .loopClear

; interpreter

    move.l  program,a2
    lea     tape,a3

    clr.l   d2

    move.l  a2,d6 ; start of program
    move.l  a2,d7 ; end of program
    add.l   fib_Size(a4),d7

loop
    move.b  (a2)+,d2

    cmp.b   #">",d2
    beq     .incPtr

    cmp.b   #"<",d2
    beq     .decPtr

    cmp.b   #"+",d2
    beq     .incMem

    cmp.b   #"-",d2
    beq     .decMem

    cmp.b   #".",d2
    beq     .outMem

    cmp.b   #",",d2
    beq     .inMem

    cmp.b   #"[",d2
    beq     .jmpForward

    cmp.b   #"]",d2
    beq     .jmpBack

; next command

.next
    cmp.l   d7,a2 ; test end of program
    blt     loop

; end of program reached

    bra     exit

; command implementations

.incPtr
    addq.l  #1,a3
    cmp.l   #tapeEnd,a3 ; test end of tape
    bge     exit
    bra     .next

.decPtr
    subq.l  #1,a3
    cmp.l   #tape,a3 ; test start of tape
    blt     exit
    bra     .next

.incMem
    addq.b  #1,(a3)
    bra     .next

.decMem
    subq.b  #1,(a3)
    bra     .next

.outMem
    move.l  stdOut,d1
    move.b  (a3),d2
    jsr     _LVOFPutC(a6)
    bra     .next

.inMem
    move.l  stdIn,d1
    jsr     _LVOFGetC(a6)

    cmp.b   #27,d0 ; convert escape to 0
    bne     .notEscape
    moveq   #0,d0
.notEscape
    move.b  d0,(a3)

    bra     .next

.jmpForward
    tst.b   (a3)
    bne     .next

    move.l  a2,a4
    clr.l   d3

.loopf
    cmp.l   d7,a4 ; test end of program
    bge     exit

    move.b  (a4)+,d2

    cmp.b   #"[",d2
    bne     .lf

    addq.l  #1,d3
    bra     .loopf
.lf
    cmp.b   #"]",d2
    bne     .loopf

    subq.l  #1,d3
    bge     .loopf

    move.l  a4,a2
    bra     .next

.jmpBack
    tst.b   (a3)
    beq     .next

    move.l  a2,a4
    clr.l   d3

.loopb
    move.b  -(a4),d2

    cmp.l   d6,a4 ; test start of program
    blt     exit

    cmp.b   #"]",d2
    bne     .lb

    addq.l  #1,d3
    bra     .loopb
.lb
    cmp.b   #"[",d2
    bne     .loopb

    subq.l  #1,d3
    bgt     .loopb

    move.l  a4,a2
    bra     .next

; cleanup and exit

exit
    move.l  dosBase,a6

    move.l  fileHandle,d1
    beq     .noFile
    jsr     _LVOClose(a6)
.noFile

    move.l  execBase,a6

    move.l  program,a1
    tst.l   a1
    beq     .noMem
    jsr     _LVOFreeVec(a6)
.noMem

    move.l  dosBase,a1
    tst.l   a1
    beq     .noLib
    jsr     _LVOCloseLibrary(a6)
.noLib

    rts

; data

    section data,data_p

dosBase
    dc.l    0

fileName
    dc.l    0

fileHandle
    dc.l    0

fileInfoBlock
    dcb.b   fib_SIZEOF

stdIn
    dc.l    0

stdOut
    dc.l    0

program
    dc.l    0

dosName
    dc.b    "dos.library",0

; tape memory

    section mem,bss_p

tape
    ds.b    1024*64
tapeEnd

8080 Assembly

In order to allow Brain**** programs to run at a somewhat acceptable speed on 8080-based computers, this program compiles the input to 8080 machine code, which it appends to itself. Contractions and clear loops are optimized. It expects to run under CP/M.

	;;; 	CP/M Brainfuck compiler/interpreter, with a few optimizations
getch:	equ	1	; Read character from console
putch:	equ	2	; Print character to console
puts:	equ	9	; Print string to console
fopen:	equ	15	; Open file
fread:	equ	20	; Read from file
dmaoff:	equ	26	; Set DMA address
fcb:	equ	5Ch	; FCB for first command line argument
EOFCH:	equ	-1	; Value stored on the tape on EOF
	org	100h
	jmp	start
	;;;	Print the character on the tape, saving HL (tape location),
	;;;	and including CR/LF translation.
bfout:	push	h	; Keep tape location
	mov	a,m	; What are we printing?
	cpi	10	; Newline?
	jnz	outch	; If not, just print the character.
	mvi	e,13	; Otherwise, print a carriage return first.
	mvi	c,putch
	call	5
	pop	h	; Then get the tape back
	push	h
outch:	mov	e,m	; Print the character in A.
	mvi	c,putch
	call	5
	pop	h	; Restore tape location.
	ret
	;;;	Read a character and store it on the tape, including CR/LF
	;;;	translation; ^Z is EOF.
bfin:	push	h	; Keep tape location
	lda	bfeoff	; Have we seen EOF yet?
	ana	a
	jnz	bfeof	; If so, return EOF.
	mvi	c,getch	; Otherwise, read character
	call	5 
	cpi	26	; Was it EOF?
	jz	bfeof	; Then handle EOF.
	cpi	13	; Was it CR? (Pressing 'Enter' only gives CR.)
	jnz	bfin_s	; If not, just store the character.
	mvi	c,putch	; Otherwise, output a LF (only CR is echoed as well)
	mvi	e,10
	call	5
	mvi	a,10	; And then store a LF instead of the CR.
bfin_s:	pop	h	; Restore tape location
	mov	m,a	; Store the character
	ret
bfeof:	sta	bfeoff	; Set the EOF flag (A is nonzero here)
	pop	h	; Restore tape location
	mvi	m,EOFCH	; Store EOF return value.
	ret
bfeoff:	db	0	; EOF flag, EOF seen if nonzero.
	;;;	Print mismatched brackets error
brkerr:	lxi	d,ebrk
	;;;	Print error message under DE and quit
err:	mvi	c,puts	; Print string
	call	5
	rst	0	; Then quit
	;;;	Error messages.
efile:	db	'Cannot read file.$'
ebrk:	db	'Mismatched brackets.$'
	;;;	BF characters
bfchr:	db	'+-<>,.[]',26
	;;;	Main program
start:	lhld	6 	; Set stack pointer to highest available address
	sphl
	mvi	c,fopen	; Try to open the file given on the command line
	lxi	d,fcb
	call	5
	inr	a	; A=FF on error,
	lxi	d,efile	; so if we couldn't open the file, say so, and stop
	jz	err
	;;;	Read file into memory in its entirety
	lxi 	d,pgm	; Start of input
block:	mvi	c,dmaoff
	push	d	; Keep current address on stack 
	call	5	; Set DMA to location of current block
	mvi	c,fread	; Read 128-byte block to that address
	lxi	d,fcb
	call	5
	dcr	a	; A=1 = end of file
	jz	fdone
	inr	a	; Otherwise, A<>0 = error
	lxi	d,efile
	jnz	err
	pop	h	; Retrieve DMA address
	lxi	d,128	; Add 128 (advance to next block)
	dad	d
	xchg		; Put in DE
	jmp	block	; Go get next block.
fdone:	pop	h	; When done, find next address
	mvi	m,26	; Write EOF, so file always ends with EOF.
	;;;	Filter out all the non-BF characters
	lxi 	h,pgm	; Output pointer
	push	h 	; On stack
	lxi	b,pgm	; Input pointer	
filter:	ldax	b	; Get current character
	inx	b	; Look at next char next time
	lxi	h,bfchr	; Test against 9 brainfuck characters (8 + EOF)
	mvi	e,9
filchk:	cmp	m	; Is it a match?
	jz	filfnd	; Then we found it
	inx	h
	dcr	e
	jnz	filchk 
	jmp	filter	; Otherwise, try next character
filfnd:	pop	h	; Get pointer from stack
	mov	m,a	; Store current character
	inx	h	; Move pointer
	push	h	; Store pointer back on stack
	cpi	26	; Reached the end?
	jnz	filter	; If not, keep going.
	;;;	Move the program as high up into memory as possible.
	lxi	h,-1024	; Keep 1K stack space (allowing 512 levels of nested
	dad	sp	; loops)
	pop	d	; Source pointer in DE (destination in HL)
move:	ldax	d	; Copy backwards
	dcx	d
	mov	m,a
	dcx 	h
	ana	a	; Until zero is reached
	jnz	move
	inx	h	; Move pointer to byte after zero
	inx	h
	;;;	Compile the Brainfuck code into 8080 machine code
	lxi	b,0	; Push zero on stack (as boundary marker)
	push	b
	lxi 	d,pgm	; DE = start of binary area (HL at start of source)
compil:	mov	a,m	; Get source byte
	cpi	'+'	; Plus or minus - change the tape value 
	jz	tapval
	cpi	'-'
	jz	tapval
	cpi	'<'	; Left or right - move the tape
	jz	tapmov
	cpi	'>'
	jz 	tapmov
	cpi	'.'	; Input and output
	jz	chout
	cpi	','
	jz	chin
	cpi	'['	; Start of loop
	jz	loops	
	cpi	']'	; End of loop
	jz 	loope
	cpi	26	; EOF?
	jz	cdone
	inx	h	; Anything else is ignored
	jmp	compil
	;;;	Write code for '+' or '-' (change cell value)
tapval:	mvi	c,0	; C = change in value necessary
tapv_s:	mov	a,m	; Get current byte
	cpi	'+'	; If plus, 
	jz	tapinc	; Then we need to increment
	cpi	'-'	; If minus,
	jz	tapdec 	; Then we need to decrement
	;;;	The effect of the last instructions should be to
	;;;	change the cell at the tape head by C.
	;;;	If -3 <= B <= 3, INR M/DCR M are most efficient.
	;;;	Otherwise, MVI A,NN / ADD M / MOV M,A is most efficient.
	mov	a,c
	ana	a	; Zero?
	jz	compil	; Then we do nothing.
	cpi	4	; Larger than 3?
	jc	tapinr	; If not, 'INR M' * C
	cpi	-3	; Smaller than -3?
	jnc	tapdcr	; Then, 'DCR M' * -C
	xchg		; Otherwise, use an ADD instruction
	mvi	m,3Eh	; 'MVI A,'
	inx	h
	mov	m,c	; C (all math is mod 256)
	inx	h
	mvi	m,86h	; 'ADD M'
	inx	h
	mvi 	m,77h	; 'MOV M,A'
	inx	h
	xchg
	jmp	compil
tapinc:	inr	c	; '+' means one more
	inx	h	; Check next byte
	jmp	tapv_s
tapdec:	dcr	c	; '-' means one less
	inx	h	; Check next byte
	jmp	tapv_s
tapinr:	mvi	a,34h	; INR M (increment cell)
	jmp	wrbyte
tapdcr:	mvi	a,35h	; DCR M (decrement cell)
	jmp	wrnegc
	;;;	Write code for '<' or '>' (move tape head)
tapmov:	lxi	b,0	; BC = change in value necessary
tapm_s:	mov	a,m	; Get current byte
	cpi	'>'	; If right,
	jz	taprgt	; Then we need to move the tape right
	cpi	'<'	; If left,
	jz	taplft	; Then we need to move the tape left
	;;;	Move the tape by BC.
	;;;	If -4 <= BC <= 4, INX H/DCX H are most efficient.
	;;;	Otherwise, LXI B,NNNN / DAD B is most efficient.
	mov	a,b	; Is the displacement zero?
	ora	c
	jz	compil	; Then do nothing
	mov	a,b	; Otherwise, is the high byte 0?
	ana	a
	jnz	tbchi	; If not, it might be FF, but
	mov	a,c	; if so, is low byte <= 4?
	cpi	5
	jc	tapinx	; Then we need to write 'INX H' C times
	xra	a	; Otherwise, do it the long way
tbchi:	inr	a	; Is the high byte FF?
	jnz	tapwbc	; If not, we'll have to do it the long way
	mov	a,c	; But if so, is low byte >= -4?
	cpi	-4	
	jnc	tapdcx	; Then we can write 'DCX H' -C times
tapwbc:	xchg		; Otherwise, use a DAD instruction
	mvi	m,1h	; 'LXI B,'
	inx	h
	mov	m,c	; Low byte
	inx	h
	mov	m,b	; High byte
	inx	h
	mvi	m,9h	; 'DAD B'
	inx	h
	xchg
	jmp	compil
taprgt:	inx	b	; '>' is one to the right
	inx	h	; Check next byte
	jmp	tapm_s
taplft:	dcx	b	; '<' is one to the left
	inx	h	; Check next byte
	jmp	tapm_s
tapinx:	mvi	a,23h	; INX H (move tape right)
	jmp	wrbyte
tapdcx:	mvi	a,2Bh	; DCX H (move tape left)
	jmp	wrnegc
	;;;	Write the byte in A, -C times, to [DE++]
wrnegc: mov	b,a	; Keep A
	mov	a,c	; Negate C
	cma
	inr	a
	mov	c,a
	mov	a,b
	;;;	Write the byte in A, C times, to [DE++]
wrbyte:	stax	d
	inx	d
	dcr	c
	jnz	wrbyte
	jmp	compil
	;;;	Write code to print the current tape value
chout:	inx	h	; We know the cmd is '.', so skip it
	lxi	b,bfout	; Call the output routine
	jmp	wrcall
	;;;	Write code to read a character and store it on the tape
chin:	inx	h	; We know the cmd is ',', so skip it
	lxi	b,bfin
	;;;	Write code to CALL the routine with address BC
wrcall:	xchg
	mvi	m,0CDh	; CALL
	inx	h
	mov	m,c	; Low byte
	inx	h
	mov	m,b	; High byte
	inx	h
	xchg
	jmp	compil
	;;;	Write code to start a loop
loops:	inx	h	; We know the first cmd is '['
	mov	b,h	; Check for '-]'
	mov	c,l
	ldax	b
	cpi	'-'	
	jnz	loopsw	; If not '-', it's a real loop
	inx	b
	ldax 	b
	cpi	']'
	jz	lzero	; If ']', we just need to set the cell to 0
	;;;	Code for loop: MOV A,M / ANA A / JZ cmd-past-loop
loopsw:	xchg		; Destination pointer in HL
	mvi	m,7Eh	; MOV A,M
	inx	h
	mvi	m,0A7h	; ANA A
	inx	h
	mvi	m,0CAh	; JZ
	inx	h
	inx	h	; Advance past where the destination will go
	inx	h	; (End of loop will fill it in)
	push	h 	; Store the address to jump back to on the stack
	xchg
	jmp	compil
	;;;	Code to set a cell to zero in one go: MVI M,0
lzero:	inx	h	; Move past '-]'
	inx	h
	xchg		; Destination pointer in HL
	mvi	m,36h	; MVI M,
	inx	h
	mvi	m,0	; 0
	inx	h
	xchg
	jmp	compil
	;;;	Write code to end a loop: MOV A,M / ANA A / JNZ loop-start
loope:	inx	h	; We know the first cmd is ']'
	xchg		; Destination pointer in HL
	mvi	m,7Eh	; MOV A,M
	inx	h
	mvi	m,0A7h	; ANA A
	inx	h
	mvi	m,0C2h	; JNZ
	inx	h
	pop	b	; Get loop-start from the stack
	mov	a,b	; If it is 0, we've hit the sentinel, which means
	ora	c	; mismatched brackets
	jz	brkerr
	mov	m,c	; Store loop-start, low byte first,
	inx	h
	mov	m,b	; then high byte.
	inx	h
	dcx	b	; The two bytes before loop-start must be filled in
	mov	a,h	; with the address of the cmd past the loop, high
	stax	b	; byte last,
	dcx	b
	mov	a,l	; then low byte
	stax 	b
	xchg	
	jmp	compil
	;;;	Done: finish the code with a RST 0 to end the program
cdone:	xchg
	mvi	m,0C7h
	pop 	b 	; If the brackets are all matched, there should be
	mov	a,b	; a zero on the stack.
	ora	c
	jnz	brkerr
	;;;	Initialize the tape. The fastest way to fill up memory on the
	;;;	8080 is to push values to the stack, so we will fill it up
	;;;	with zeroes, and position the tape there.
	;;;	HL contains the top of the program.
	lxi	d,32	; The Brainfuck program doesn't use the stack, so
	dad	d	; reserving 16 levels for CP/M is more than enough.
	mov	a,l	; Complement the value (almost negation, but low bit
	cma		; doesn't really matter here)
	mov	l,a
	mov	a,h
	cma
	mov	h,a
	dad	sp	; Add the current stack pointer, giving bytes to fill
	ana	a	; Zero carry
	mov	a,h	; Divide value by two (we push words)
	rar
	mov	h,a
	mov	a,l
	rar
	mov	l,a
	lxi	d,0
ztape:	push	d	; Zero out the tape (on the stack)
	dcx	h
	mov	a,h
	ora	l
	jnz	ztape 
	dad	sp	; HL is now 0, add SP to get tape bottom
	;;;	The compiled program is stored after this point, so we just
	;;;	fall through into it.
	nop		; No-op (sentinel value)
pgm:	equ	$	; Compiled BF program stored here.
Output:
A>type hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.

A>brainfk hello.bf
Hello World!

A>

8086 Assembly

Translation of: 8080 Assembly

Like the 8080 version, this program compiles its BF input to 8086 machine code, and then jumps to it. Contractions and clear loops are optimized, and the 8086's memory segmentation is used to provide a circular 64k-cell tape with 8-bit cells.

	;;;	MS-DOS Brainf*** interpreter/compiler
	cpu	8086
putch:	equ	2h		; Print character
puts:	equ	9h		; Print string
open:	equ	3Dh		; Open file
read:	equ	3Fh		; Read from file
exit:	equ	4Ch		; Exit to DOS
flags:	equ	33h		; Set break flags
CMDLEN:	equ	80h		; Address of length of command line argument
CMDARG:	equ	81h		; Address of text of command line argument
BRK:	equ	1		; Break flag 
EOFCH:	equ	-1		; Written to the tape on EOF
section	.text
	org	100h
	;;;	See if there is enough memory
	mov	sp,stack.top	; Move stack inward to free up memory
	mov	ax,cs		; Get allocated memory size from DOS
	dec	ax		; (It is at location 3 in the MCB, which
	mov	es,ax		; is located one paragraph above CS.)
	mov	ax,[es:3]
	mov	bx,sp		; The amount of memory the program itself
	mov	cl,4		; needs is from CS:0 up to CS:SP in bytes,
	shr	bx,cl		; shifted right by 4 to give paragraphs;
	inc	bx		; making sure to round up.
	mov	bp,cs		; The paragraph right after this is used
	add	bp,bx 		; as the segment base for BF's memory.
	sub	ax,bx		; Free mem = allocated mem - program mem
	cmp	ax,128*1024/16	; We'll require at least 128k bytes
	jae	mem_ok		; (for two separate code and data segments)
	mov	dx,err.mem	; If we don't have enough,
	jmp	error		; give an error message. 
	;;;	Stop on Ctrl+C
mem_ok:	mov	ax,flags<<8|BRK
	mov	dl,1
	int	21h
	;;;	See if a command line argument was given
	mov	bl,[CMDLEN]	; Get length of argument
	test	bl,bl		; See if it's zero
	jnz	arg_ok
	mov	dx,err.usage	; Print usage string if no argument given
	jmp	error
arg_ok:	xor	bh,bh
	mov	[CMDARG+bx],bh	; Terminate the argument string with a zero
	mov	ax,open<<8	; Try to open the file for reading
	mov	dx,CMDARG+1	; Skip first item (always 1)
	int	21h
	jnc	fileok
	mov	dx,err.file	; Print file error if it fails
	jmp	error
fileok: mov	di,ax		; Keep file handle in DI
	xor	si,si		; Keep pointer in SI
	mov	ds,bp		; Start reading into the memory past our stack
block:	mov	ah,read		; Read from file
	mov	bx,di
	mov	cx,0FFFEh
	mov	dx,si		; To the place just beyond the last read
	int	21h
	jnc	.rdok
	mov	dx,err.file	; Read error
	jmp	error
.rdok:	test	ax,ax		; If zero bytes read, we're done
	jz	.done
	add	si,ax		; Move pointer past read
	jnc	block		; If there's still room, do another read
	mov	dx,err.mem	; If we overshot, then give memory error
	jmp	error
.done:	mov	[si],byte 0	; Zero-terminate the data
	;;;	Filter out all non-BF characters
	push	ds		; Set ES to DS 
	pop	es
	xor	si,si		; Source and destination pointer to beginning
	xor	di,di
filter:	lodsb			; Get byte from source
	xor	bx,bx		; See if byte is BF command
.test:	cmp	al,[cs:bx+bfchar]	; Test against current character
	je	.match		; If a match, we found it
	inc	bx		; If not, try next possible command
	cmp	bx,8
	jbe	.test
	jmp	filter		; If we didn't find it, ignore this character
.match:	stosb			; We found it, keep it
	test	al,al		; If zero, we found the end,
	jnz	filter		; Otherwise, do next character
	;;;	Compile the BF source into 8086 machine code
	add	bp,65536/16	; Set ES to point to the start of the second
	mov	es,bp		; 64k (4k paragraphs) that we allocated earlier
	xor	di,di		; Start at address zero,
	push	di		; Store a zero on the stack as boundary marker,
	mov	ax,stop		; At 0000, store a far pointer to the
	stosw			; cleanup routine,
	mov	ax,cs
	stosw
	mov	ax,bfout	; At 0004, store a far pointer to the
	stosw			; output routine,
	mov	ax,cs
	stosw
	mov	ax,bfin		; At 0008, store a far pointer to the
	stosw			; input routine,
	mov	ax,cs
	stosw			; Compiled BF code starts at 000C.
	xor	si,si		; Start at beginning of BF source code	
compil:	lodsb			; Get current command
.ch:	cmp	di,-16		; See if we still have 16 bytes free
	jb	.fch		; (Loop is 11 bytes, +5 for INT 21h/4Ch at end)
	mov	dx,err.mem	; If not, we're out of memory 
	jmp	error
.fch:	cmp	al,'+'		; + and - change the value of the current cell
	je	tapval
	cmp	al,'-'
	je	tapval
	cmp	al,'>'		; < and > move the tape
	je	tapmov
	cmp	al,'<'
	je	tapmov
	cmp	al,','		; I/O
	jne	.tsout		; Conditional jumps are limited to 128-byte
	jmp	chin		; displacement
.tsout:	cmp	al,'.'
	jne	.tsls
	jmp	chout
.tsls:	cmp	al,'['		; Loops 
	jne	.tsle
	jmp	loops
.tsle:	cmp	al,']'
	jne	.tsend
	jmp	loope
.tsend:	test	al,al 		; Reached zero?
	jnz 	compil		; If not, next command
	jmp	cdone		; If so, we're done
	;;;	Compile a string of +s and -s into an 8086 instruction
tapval:	xor	cl,cl		; Count up contiguous +s and -s modulo 256
.ch:	cmp	al,'+'		
	je	.inc
	cmp	al,'-'
	je	.dec
	test	cl,cl		; If zero,
	jz	compil.ch	; it's a no-op. 
	mov	bl,al		; Otherwise, keep next character
	cmp	cl,-1		; If -1, decrement cell
	mov	ax,0FFEh	; DEC BYTE [BX]
	je	.wword
	cmp	cl,1		; If 1, increment cell
	mov	ax,07FEh	; INC BYTE [BX]
	je	.wword
	mov	ax,0780h	; ADD BYTE [BX],
	stosw
	mov	al,cl		; change to cell
	stosb
	mov	al,bl		; Move next character back into AL
	jmp	compil.ch	; Compile next command
.inc:	inc	cl		; Increment cell
	lodsb	
	jmp	.ch
.dec:	dec	cl		; Decrement cell
	lodsb
	jmp	.ch
.wword:	stosw			; Write instruction word
	mov	al,bl		; Move next character back into AL
	jmp 	compil.ch	; Compile next command
	;;;	Compile a string of <s and >s into an 8086 instruction
tapmov:	xor	cx,cx		; Count up contiguous <s and >s modulo 65536
.ch:	cmp	al,'>'
	je	.right
	cmp	al,'<'
	je	.left
	test	cx,cx		; Is there any net movement at all?
	jnz	.move		; If so, generate a move instruction
	jmp	compil.ch	; But otherwise it's a no-op, ignore it
.move:	mov	bl,al		; Otherwise, keep next character
	cmp	cx,4		; If CX<4, a series of INC BX are best
	mov	al,43h		; INC BX
	jb	.wbyte
	neg	cx
	cmp	cx,4		; If -CX<4, a series of DEC BX are best
	mov	al,4Bh		; DEC BX
	jb	.wbyte
	neg	cx
	mov	ax,0C381h	; ADD BX,
	stosw
	mov	ax,cx		; tape movement
	stosw
	mov	al,bl		; Move next character back into AL
	jmp	compil.ch	; Compile next command
.left:	dec	cx		; Left: decrement pointer
	lodsb
	jmp	.ch
.right:	inc	cx		; Right: increment pointer
	lodsb
	jmp	.ch
.wbyte:	rep	stosb		; Write AL, CX times.
	mov	al,bl		; Move next character back into AL
	jmp	compil.ch	; Compile next command
	;;;	Compile BF input
chin:	mov	al,2Eh		; CS segment override
	stosb
	mov	ax,1EFFh	; CALL FAR PTR
	stosw
	mov	ax,8		; Pointer to input routine at address 8
	stosw
	jmp	compil		; Compile next command
	;;;	Compile BF output
chout:	mov	al,2Eh		; CS segment override
	stosb
	mov	ax,1EFFh	; CALL FAR PTR
	stosw
	mov	ax,4		; Pointer to output routine at address 4
	stosw
	jmp	compil
	;;;	Compile start of loop
loops:	cmp	word [si],5D2Dh	; Are the next two characters '-]'?
	je	.zero		; Then just set the cell to zero
	mov	ax,078Ah	; Otherwise, write out a real loop
	stosw			; ^- MOV AL,[BX]
	mov	ax,0C084h	; TEST AL,AL
	stosw
	mov	ax,0575h	; JNZ loop-body
	stosw
	mov	al,0B8h		; MOV AX,  (simulate absolute near jmp)
	stosb
	xor	ax,ax		; loop-end (we don't know it yet so 0)
	stosw
	mov	ax,0E0FFh	; JMP AX
	stosw
	push	di		; Store addr of loop body on stack 
	jmp	compil		; Compile next command
.zero:	mov	ax,07C6h	; MOV BYTE [BX],
	stosw
	xor	al,al		; 0
	stosb
	inc	si		; Move past -]
	inc	si
	jmp	compil		; Compile next command
	;;;	Compile end of loop
loope:	pop	bx		; Retrieve address of loop body from stack
	test	bx,bx 		; If it is zero, we've hit the top of stack
	jz	.ebrkt		; so the brackets aren't balanced.
	mov	ax,078Ah	; MOV AL,[BX]
	stosw
	mov	ax,0C084h	; TEST AL,AL
	stosw
	mov	ax,0574h	; JZ loop-end
	stosw
	mov	al,0B8h		; MOV AX, (simulate absolute near jmp)
	stosb
	mov	ax,bx		; loop-start
	stosw
	mov	ax,0E0FFh	; JMP AX
	stosw
	mov	[es:bx-4],di	; Store loop-end in matching loop start code
	jmp	compil
.ebrkt:	mov	dx,err.brk
	jmp	error
	;;;	Compilation is done. 
cdone:	mov	al,2Eh		; Code to jump to cleanup routine
	stosb			; ^- CS segment override
	mov	ax,2EFFh	; JMP FAR PTR 
	stosw
	pop	ax		; Should be zero if all loops closed 
	stosw
	test	ax,ax		; Were all loops closed?
	jz	.lp_ok
	mov	dx,err.brk	; If not, print error
	jmp	error
.lp_ok:	mov	[cs:cp],word 12	; Make far pointer to start of BF code
	mov	[cs:cp+2],bp	; (which starts at ES:0C = BP:0C)
	mov	ax,ds		; Set both DS and ES to BF tape segment
	mov	es,ax		; (also the initial source segment)
	xor	ax,ax		; Clear the tape (set all bytes to zero)
	mov	cx,32768	
	rep	stosw
	xor	bx,bx		; Tape begins at address 0
	xor	cx,cx		; No EOF and char buffer is empty
	jmp	far [cs:cp]	; Jump into the BF code
	;;;	BF program jumps here to stop the program
stop:	mov	ax,exit<<8|0	; Quit to DOS with return code 0
	int	21h
	;;;	Print error message in CS:DX and quit with errorlevel 2
error:	push	cs		; Set DS to CS
	pop	ds
	mov	ah,puts		; Print DS:DX
	int	21h
	mov	ax,exit<<8|2	; Quit to DOS
	int	21h
	;;;	Output subroutine called by the BF program (far call)
bfout:	mov	ah,putch	; Prepare to write character
	mov	dl,[bx] 	; Get character from tape
	cmp 	dl,10		; Is it LF?
	jne	.wr		; If not, just write it
	mov	dl,13		; Otherwise, print CR first,
	int	21h 
	mov	dl,10		; then LF.
.wr:	int	21h		; Write character
	retf
	;;;	Input subroutine called by the BF program (far call)
	;;;	Buffered input with CR/LF translation
	;;;	Note: this keeps state in registers!
	;;;	CL = chars left in buffer, CH = set if EOF seen,
	;;;	SI = buffer pointer, ES = BF data segment
bfin:	test	ch,ch		; EOF seen?
	jnz	.r_eof
	mov	ax,cs		; Set DS to our segment
	mov	ds,ax
.getch:	test	cl,cl		; Characters left in buffer?
	jnz	.retch		; If so, return next character
	mov	bp,bx		; Keep BF tape pointer
	mov	ah,read		; Read
	xor	bx,bx		; From STDIN
	mov	cx,255		; Max 255 characters
	mov	dx,ibuf		; Into the buffer
	int	21h
	mov	bx,bp		; Restore tape pointer
	jc	.ioerr		; If carry set, I/O error
	test	ax,ax		; If nothing returned, EOF
	jz	.s_eof
	mov	cx,ax		; Otherwise, set character count,
	mov	si,ibuf		; set buffer pointer back to start,
	jmp	.getch		; and return first character from buffer.
.s_eof:	inc	ch		; We've seen EOF now
.r_eof:	mov	al,EOFCH	; Return EOF
	jmp	.ret
.retch:	lodsb			; Get char from buffer
	dec	cl		; One fewer character left
	cmp	al,26		; ^Z = EOF when reading from keyboard
	je	.s_eof
	cmp	al,10		; If it is LF, ignore it and get another
	je	.getch
	cmp	al,13		; If it is CR, return LF instead
	jne	.ret
	mov	al,10
.ret:	mov	dx,es		; Set DS back to BF's data segment
	mov	ds,dx
	mov	[bx],al		; Put character on tape
	retf
.ioerr:	mov	dx,err.io	; Print I/O error and quit
	jmp	error
section	.data
bfchar:	db	'+-<>,.[]',0
err:	;;;	Error messages
.usage:	db	'BRAINFK PGM.B',13,10,10,9,'Run the BF program in PGM.B$'
.file:	db	'Cannot read file$'
.brk:	db	'Mismatched brackets$'
.mem:	db	'Out of memory$'
.io:	db	'I/O Error$'
section	.bss
cp:	resw	2		; Far pointer to start of BF code
ibuf:	resb	256		; 255 char input buffer
stack:	resw	512		; 512 words for the stack
.top:	equ	$
Output:
C:\>type hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.

C:\>brainfk hello.bf
Hello World!

C:\>

Ada

Implementation in Ada.

Agena

Tested with Agena 2.9.5 Win32

# Brain**** interpreter

# execute the Brain**** program in the code string
bf := proc( code :: string ) is
    local address       := 1;  # current data address
    local pc            := 1;  # current position in code
    local data          := []; # data - initially empty
    local input         := ""; # user input - initially empty
    local bfOperations  :=     # table of operations and their implemntations
          [ ">" ~ proc() is inc address, 1 end
          , "<" ~ proc() is dec address, 1 end
          , "+" ~ proc() is inc data[ address ], 1 end
          , "-" ~ proc() is dec data[ address ], 1 end
          , "." ~ proc() is io.write( char( data[ address ] ) ) end
          , "," ~ proc() is
                      # get next input character, converted to an integer
                      while input = ""
                      do
                          # no input left - get the next line
                          input := io.read()
                      od;
                      data[ address ] := abs( input[ 1 ] );
                      # remove the latest character from the input
                      if size input < 2
                      then
                          input := ""
                      else
                          input := input[ 2 to -1 ]
                      fi
                  end
          , "[" ~ proc() is
                      if data[ address ] = 0
                      then
                          # skip to the end of the loop
                          local depth := 0;
                          do
                              inc pc, 1;
                              if code[ pc ] = "["
                              then
                                  inc depth, 1
                              elif code[ pc ] = "]"
                              then
                                  dec depth, 1
                              fi
                          until depth < 0
                      fi
                  end
          , "]" ~ proc() is
                      if data[ address ] <> 0
                      then
                          # skip to the start of the loop
                          local depth := 0;
                          do
                              dec pc, 1;
                              if code[ pc ] = "["
                              then
                                  dec depth, 1
                              elif code[ pc ] = "]"
                              then
                                  inc depth, 1
                              fi
                          until depth < 0
                      fi
                  end
          ];
    # execute the operations - ignore anything invalid
    while pc <= size code
    do
        if  data[ address ] = null
        then
            data[ address ] := 0
        fi;
        if  bfOperations[ code[ pc ] ] <> null
        then
            bfOperations[ code[ pc ] ]()
        fi;
        inc pc, 1
    od
end;

# prompt for Brain**** code and execute it, repeating until an empty code string is entered
scope
    local code;
    do
        io.write( "BF> " );
        code := io.read();
        bf( code )
    until code = ""
epocs;

ALGOL 68

Interpreter

Implementation in Algol 68.

Transpiler

Based on the interpreter. Attempts to optimise consecutive +, -, <, > and ? operations.

BEGIN # Brain**** -> Algol 68 transpiler #
      # a single line of Brain**** code is prompted for and read from #
      # standard input, the generated code is written to standard output #
      # the original code is included in the output as a comment #

    # transpiles the Brain**** code in code list to Algol 68 #
    PROC generate = ( STRING code list )VOID:
    BEGIN

        PROC emit  = ( STRING code )VOID: print( ( code, newline ) );
        PROC emit1 = ( STRING code )VOID:
             print( ( IF need semicolon THEN ";" ELSE "" FI
                    , newline, indent, code
                    )
                  );
        PROC next  = CHAR: IF   c pos > c max
                           THEN "$"
                           ELSE CHAR result = code list[ c pos ];
                                c pos +:= 1;
                                result
                           FI;

        # address and data modes and the data space #
        emit( "BEGIN" );
        emit( "  MODE DADDR = INT; # data address #" );
        emit( "  MODE DATA  = INT;" );
        emit( "  DATA zero  = 0;" );
        emit( "  [-255:255]DATA data;  # finite data space #" );
        emit( "  FOR i FROM LWB data TO UPB data DO data[i] := zero OD;" );
        emit( "  DADDR addr := ( UPB data + LWB data ) OVER 2;" );

        # actual code # 

        STRING indent         := "  ";
        BOOL   need semicolon := FALSE;
        INT    c pos          := LWB code list;
        INT    c max           = UPB code list;
        CHAR   c              := next;
        WHILE c /= "$" DO
            IF   c = "?"
            THEN emit1( "SKIP" );
                 need semicolon := TRUE;
                 WHILE ( c := next ) = "?" DO SKIP OD
            ELIF c = "<" OR c = ">"
            THEN CHAR op code   = c;
                 CHAR assign op = IF c = ">" THEN "+" ELSE "-" FI;
                 INT incr      := 1;
                 WHILE ( c := next ) = op code DO incr +:= 1 OD;
                 emit1( "addr " + assign op + ":= " + whole( incr, 0 ) );
                 need semicolon := TRUE
            ELIF c = "+" OR c = "-"
            THEN CHAR op code   = c;
                 INT incr      := 1;
                 WHILE ( c := next ) = op code DO incr +:= 1 OD;
                 emit1( "data[ addr ] " + op code + ":= " + whole( incr, 0 ) );
                 need semicolon := TRUE
            ELIF c = "."
            THEN emit1( "print( ( REPR data[ addr ] ) )" );
                 need semicolon := TRUE;
                 c              := next
            ELIF c = ","
            THEN emit1( "data[ addr ] := ABS read char" );
                 need semicolon := TRUE;
                 c              := next
            ELIF c = "["
            THEN emit1( "WHILE data[ addr ] /= zero DO" );
                 indent        +:= "  ";
                 need semicolon := FALSE;
                 c              := next
            ELIF c = "]"
            THEN need semicolon := FALSE;
                 indent         := indent[ LWB indent + 2 : ];
                 emit1( "OD" );
                 need semicolon := TRUE;
                 c              := next
            ELSE
                 print( ( "Invalid op code: """, c, """", newline ) );
                 c              := next
            FI
        OD;
        emit( "" );
        emit( "END" )
 
    END # gen # ;
 
    # get the code to transpile and output it as a comment at the start #
    # of the code #
    print( ( "CO BF> " ) );
    STRING bf code;
    read( ( bf code, newline ) );
    print( ( newline, bf code, newline, "CO", newline ) );
    # transpile the code #
    generate( bf code )

END

With the following input:

>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.

The follwoing Algol 68 program is output:

CO BF>
>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.
CO
BEGIN
  MODE DADDR = INT; # data address #
  MODE DATA  = INT;
  DATA zero  = 0;
  [-255:255]DATA data;  # finite data space #
  FOR i FROM LWB data TO UPB data DO data[i] := zero OD;
  DADDR addr := ( UPB data + LWB data ) OVER 2;

  addr +:= 1;
  data[ addr ] +:= 8;
  WHILE data[ addr ] /= zero DO
    addr -:= 1;
    data[ addr ] +:= 9;
    addr +:= 1;
    data[ addr ] -:= 1
  OD;
  addr -:= 1;
  print( ( REPR data[ addr ] ) );
  addr +:= 2;
  data[ addr ] +:= 1;
  addr +:= 1;
  data[ addr ] +:= 1;
  addr +:= 1;
  data[ addr ] +:= 2;
  addr +:= 1;
  WHILE data[ addr ] /= zero DO
    data[ addr ] -:= 1
  OD;
  data[ addr ] +:= 1;
  addr -:= 1;
  WHILE data[ addr ] /= zero DO
    addr +:= 1;
    WHILE data[ addr ] /= zero DO
      data[ addr ] -:= 1;
      addr +:= 1;
      data[ addr ] +:= 1;
      addr -:= 2;
      data[ addr ] +:= 4;
      addr +:= 1
    OD;
    addr -:= 2
  OD;
  addr +:= 1;
  print( ( REPR data[ addr ] ) );
  data[ addr ] +:= 7;
  print( ( REPR data[ addr ] ) );
  print( ( REPR data[ addr ] ) );
  data[ addr ] +:= 3;
  print( ( REPR data[ addr ] ) );
  addr +:= 2;
  data[ addr ] +:= 7;
  print( ( REPR data[ addr ] ) );
  addr -:= 3;
  WHILE data[ addr ] /= zero DO
    WHILE data[ addr ] /= zero DO
      data[ addr ] -:= 1
    OD;
    addr -:= 1;
    WHILE data[ addr ] /= zero DO
      data[ addr ] -:= 1
    OD;
    addr +:= 1
  OD;
  addr -:= 1;
  data[ addr ] +:= 15;
  print( ( REPR data[ addr ] ) );
  addr +:= 2;
  print( ( REPR data[ addr ] ) );
  data[ addr ] +:= 3;
  print( ( REPR data[ addr ] ) );
  data[ addr ] -:= 6;
  print( ( REPR data[ addr ] ) );
  data[ addr ] -:= 8;
  print( ( REPR data[ addr ] ) );
  addr +:= 2;
  data[ addr ] +:= 1;
  print( ( REPR data[ addr ] ) );
  addr +:= 1;
  data[ addr ] +:= 4;
  print( ( REPR data[ addr ] ) )
END

Which when run, produces the following:

Output:
Hello World!

Amazing Hopper

Based on the ALGOL 68's "transpiler". Program generated is ANSI C:

/*
  BFC.COM
  BrainF**k's Pseudo-compiler!
  Mr_Dalien. NOV 26, 2021
*/
#include <hopper.h>

#proto checkMove(_S_,_OPE_,_CODE_,_BF_)
#proto check(_S_,_OPE_,_CODE_,_BF_)
#proto tabulation(_S_)

main:
  
  total arg,minus(1) zero?
  do {
      {"\LR","Bad filename!\OFF\n"}print
      {0}return
  }
  filename = [&2]    // get filename parameter 2 (parameter 1 is "bfc.com")
  
  sf="",{filename}exist?,not,
  do{
      {"File: \LR",filename,"\OFF"," don't exist!\n"}print
      {0}return
  }
  {filename}load string(sf)   // load file as string
  --sf                        // "load string" load adding a newline at the EOS. "--sf" delete it!
  
  // determine tape size:
  rightMove=0,{">",sf}count at, mov(rightMove)
  leftMove=0,{"<",sf}count at, mov(leftMove)
  totalCells = 0
  prec(0)   // precision 0 decimals: all number are integers!
  {0}{rightMove}minus(leftMove), cpy(totalCells),lt?
  do{
      {"In file \LR",filename,"\OFF",": program bad formed!\n"}print
      {0}return
  }
  
  // start process!
  nLen=0, {sf}len,mov(nLen)
  
  i=1,       // index
  res={},    // new file "C"
  space=5    // tab space
  // header:
  {"#include <stdio.h>","int main(){","     int ptr=0, i=0, cell["},{totalCells},xtostr,cat,{"];"}cat,push all(res)
  {"     for( i=0; i<",totalCells},xtostr,cat,{"; ++i) cell[i]=0;"}cat,push(res)
  
  iwhile={},swOk=0,true(swOk)
  cntMove=0
  v=""
  __PRINCIPAL__:
     [i:i]get(sf),mov(v),
     switch(v)
        case(">")::do{ 
           _checkMove(">","+","ptr",sf), 
           _tabulation(space),{"if(ptr>="}cat,{totalCells},xtostr,cat
                              {") perror(\"Program pointer overflow\");"}cat,push(res),
           exit
        }
        case("<")::do{
           _checkMove("<","-","ptr",sf), 
           _tabulation(space),{"if(ptr<0) perror(\"Program pointer underflow\");"}cat,push(res),
           exit
        }
        case("+")::do{
           _check("+","+","cell[ptr]",sf), exit
        }
        case("-")::do{
           _check("-","-","cell[ptr]",sf), exit
        }
        case("[")::do{
           {"]"}push(iwhile)
           _tabulation(space),{"while(cell[ptr])"}cat,push(res),
           _tabulation(space),{"{"}cat,push(res)
           space += 5
           exit
        }
        case("]")::do{
           try
               pop(iwhile),kill
               space -= 5, _tabulation(space),{"}"}cat,push(res)
           catch(e)
              {"SIMBOL: ",v,", POS: ",i,": \LR","Symbol out of context \OFF"}println
              false(swOk)
           finish
           exit
        }
        case(".")::do{
            _tabulation(space),{"putchar(cell[ptr]);"}cat,push(res)
            exit
        }
        case(",")::do{
            _tabulation(space),{"cell[ptr] = getc(stdin);"}cat,push(res)
            exit
        }
       // otherwise?
        {"WARNING! SIMBOL(ASCII): ",v}asc,{", POS: ",i,": \LY","Invalid code, is ommited!\OFF\n"}print

     end switch
     {cntMove}neg?    // exist more "<" than ">" ??
     do { 
        {"SIMBOL: ",v,", POS: ",i,": \LR","Underflow detected!\OFF\n"}print
        false(swOk)
     }
     ++i,{nLen,i}le?,{swOk},and,jt(__PRINCIPAL__)
  
  {swOk} do{
     _tabulation(space),{"return 0;"}cat,push(res)
     space -=5
     {"}"}push(res)

     name="",   {"",".bf",filename},transform,mov(name),  // bye bye ".bf"!
     cname="",  {name,".c"}cat,mov(cname),                // hello <filename>.c!
     {"\n"}tok sep                     // save array with newlines
     {res,cname},save                  // save the array into the <filename>.c" 
     {" "}tok sep                      // "join" need this!
     executable="",  {"gcc ",cname," -o ",name} join(executable)  // line to compile new filename
     {executable}execv                 // do compile c program generated!
  
     /* OPTIONAL: remove <filename>.c */
     // {"rm ",cname}cat,execv
  }
  {"\LG","Compilation terminated "}
  if({swOk}not)
     {"\LR","with errors!\OFF\n"}
  else
     {"successfully!\OFF\n"}
  end if
  print
exit(0)

.locals
checkMove(simb,operator,code,bfprg)
   c=1,
   {cntMove},iif({operator}eqto("+"),1,-1),add,mov(cntMove)
   __SUB_MOVE__:
      ++i,[i:i]get(sf),{simb}eq? 
      do{ ++c,
          {cntMove},iif({operator}eqto("+"),1,-1),add,mov(cntMove)
          jmp(__SUB_MOVE__)
      }
   _tabulation(space),{code}cat,{operator}cat,{"= "}cat,{c}xtostr,cat,{";"}cat
   push(res)
   --i
back
check(simb,operator,code,bfprg)
   c=1,
   __SUB__:
      ++i,[i:i]get(sf),{simb}eq? do{ ++c, jmp(__SUB__) }
   _tabulation(space),{code}cat,{operator}cat,{"= "}cat,{c}xtostr,cat,{";"}cat
   push(res)
   --i
back
tabulation(space)
   {" "}replyby(space)
back

With the following input (holamundo.bf), passed as parameter:

>++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>>+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++.

The follwoing ANSI C program is output:

#include <stdio.h>
int main(){
     int ptr=0, i=0, cell[7];
     for( i=0; i<7; ++i) cell[i]=0;
     ptr+= 1;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 8;
     while(cell[ptr])
     {
          ptr-= 1;
          if(ptr<0) perror("Program pointer underflow");
          cell[ptr]+= 9;
          ptr+= 1;
          if(ptr>=7) perror("Program pointer overflow");
          cell[ptr]-= 1;
     }
     ptr-= 1;
     if(ptr<0) perror("Program pointer underflow");
     putchar(cell[ptr]);
     ptr+= 2;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 1;
     ptr+= 1;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 1;
     ptr+= 1;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 2;
     ptr+= 1;
     if(ptr>=7) perror("Program pointer overflow");
     while(cell[ptr])
     {
          cell[ptr]-= 1;
     }
     cell[ptr]+= 1;
     ptr-= 1;
     if(ptr<0) perror("Program pointer underflow");
     while(cell[ptr])
     {
          ptr+= 1;
          if(ptr>=7) perror("Program pointer overflow");
          while(cell[ptr])
          {
               cell[ptr]-= 1;
               ptr+= 1;
               if(ptr>=7) perror("Program pointer overflow");
               cell[ptr]+= 1;
               ptr-= 2;
               if(ptr<0) perror("Program pointer underflow");
               cell[ptr]+= 4;
               ptr+= 1;
               if(ptr>=7) perror("Program pointer overflow");
          }
          ptr-= 2;
          if(ptr<0) perror("Program pointer underflow");
     }
     ptr+= 1;
     if(ptr>=7) perror("Program pointer overflow");
     putchar(cell[ptr]);
     cell[ptr]+= 7;
     putchar(cell[ptr]);
     putchar(cell[ptr]);
     cell[ptr]+= 3;
     putchar(cell[ptr]);
     ptr+= 2;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 7;
     putchar(cell[ptr]);
     ptr-= 3;
     if(ptr<0) perror("Program pointer underflow");
     while(cell[ptr])
     {
          while(cell[ptr])
          {
               cell[ptr]-= 1;
          }
          ptr-= 1;
          if(ptr<0) perror("Program pointer underflow");
          while(cell[ptr])
          {
               cell[ptr]-= 1;
          }
          ptr+= 1;
          if(ptr>=7) perror("Program pointer overflow");
     }
     ptr-= 1;
     if(ptr<0) perror("Program pointer underflow");
     cell[ptr]+= 15;
     putchar(cell[ptr]);
     ptr+= 2;
     if(ptr>=7) perror("Program pointer overflow");
     putchar(cell[ptr]);
     cell[ptr]+= 3;
     putchar(cell[ptr]);
     cell[ptr]-= 6;
     putchar(cell[ptr]);
     cell[ptr]-= 8;
     putchar(cell[ptr]);
     ptr+= 2;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 1;
     putchar(cell[ptr]);
     ptr+= 1;
     if(ptr>=7) perror("Program pointer overflow");
     cell[ptr]+= 4;
     putchar(cell[ptr]);
     return 0;
}
Output:
  Hello World!

AppleScript

Outputs debug in a .txt file similar to that of brainfuck.tk

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

Arturo

;
; Brainf*ck compiler
; In Arturo
;
 
Tape: [0]
DataPointer: new 0
InstructionPointer: new 0
 
; Look for jumps in Code an register them
; in the Jumps table
 
precomputeJumps: function [][
    vstack: new []
    jumphash: new #[]
    instrPointer: 0
 
    while [instrPointer<CodeLength] [
        command: get split Code instrPointer
        if? command="[" -> 'vstack ++ instrPointer
        else [
            if command="]" [
                target: last vstack
                chop 'vstack
                jumphash\[target]: instrPointer
                jumphash\[instrPointer]: target
            ]
        ]
        instrPointer: instrPointer+1
    ]
    jumphash
]
 
; Check if current state is valid
 
StateIsValid: function [][
    all? @[
        0 =< DataPointer 
        DataPointer < size Tape
        0 =< InstructionPointer 
        InstructionPointer < CodeLength
    ]
]

; Compile the program
 
interpret: function [].export:[DataPointer,InstructionPointer,Tape][
    while [StateIsValid][
        command: get split Code InstructionPointer
        case [command=]
            when? ["+"] -> Tape\[DataPointer]: Tape\[DataPointer]+1
            when? ["-"] -> Tape\[DataPointer]: Tape\[DataPointer]-1
            when? [">"] [
                inc 'DataPointer
                if DataPointer = size Tape -> Tape: Tape ++ 0
            ]
            when? ["<"] -> dec 'DataPointer
            when? ["."] -> prints to :string to :char Tape\[DataPointer]
            when? [","][
                inp: to :integer input ""
                if inp=13 -> inp: 10
                if inp=3  -> panic "something went wrong!"
                set Tape DataPointer inp
            ]
            when? ["["] ->
                if 0 = get Tape DataPointer [ InstructionPointer: new get Jumps InstructionPointer ]

            when? ["]"] ->
                if 0 <> get Tape DataPointer [
                    InstructionPointer: new get Jumps InstructionPointer
                ]
 
        inc 'InstructionPointer
    ]
]
 
Code: ""
if? 1>size arg  -> Code: "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
else            -> Code: read arg\0

CodeLength: size Code
Jumps: precomputeJumps

interpret
Input:
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.
Output:
Hello World!

AutoHotkey

Implementation in AutoHotkey.

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

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.

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

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

Example

"++++++++++++++++++++++++++++++++[>+>+<<-]>>+++++++++++++++++++++++++<<++++++++++[>>.-<.<-]"→Str1
BF(Str1,0)

Output

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

BASIC

Implementation in BASIC (QuickBasic dialect).

Applesoft BASIC

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

BaCon

By the author of BaCon, Peter van Eerten.

REM
REM Brainfuck interpreter

REM Get the separate arguments
SPLIT ARGUMENT$ BY " " TO arg$ SIZE dim

IF dim < 2 THEN
    PRINT "Usage: bf <file>"
    END
ENDIF

REM Determine size
filesize = FILELEN(arg$[1])

REM Get the contents
OPEN arg$[1] FOR READING AS bf

REM claim memory
txt = MEMORY(filesize)

REM Read file into memory
GETBYTE txt FROM bf SIZE filesize

CLOSE FILE bf

REM Initialize work memory
mem = MEMORY(30000)

REM This is The Pointer pointing to memory
thepointer = 0

REM This is the cursor pointing in the current program
cursor = 0

REM Start interpreting program
WHILE cursor < filesize DO

    command = PEEK(txt + cursor)

    SELECT command
        CASE 62
            INCR thepointer

        CASE 60
            DECR thepointer

        CASE 43
            POKE mem + thepointer, PEEK(mem + thepointer) + 1

        CASE 45
            POKE mem + thepointer, PEEK(mem + thepointer) - 1

        CASE 46
            PRINT CHR$(PEEK(mem + thepointer));

        CASE 44
            key = GETKEY
            POKE mem + thepointer, key

        CASE 91
            jmp = 1
            IF ISFALSE(PEEK(mem + thepointer)) THEN
                REPEAT
                    INCR cursor
                    IF PEEK(txt + cursor) = 91 THEN
                        INCR jmp
                    ELIF PEEK(txt + cursor) = 93 THEN
                        DECR jmp
                    END IF
                UNTIL PEEK(txt + cursor) = 93 AND NOT(jmp)
            END IF

        CASE 93
            jmp = 1
            IF ISTRUE(PEEK(mem + thepointer)) THEN
                REPEAT
                    DECR cursor
                    IF PEEK(txt + cursor) = 93 THEN
                        INCR jmp
                    ELIF PEEK(txt + cursor) = 91 THEN
                        DECR jmp
                    END IF
                UNTIL PEEK(txt + cursor) = 91 AND NOT(jmp)
            END IF
    END SELECT

    INCR cursor
WEND

BBC BASIC

      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
Output:
Hello World!

Commodore BASIC

Translation of: TRS-80 BASIC

Changed hello-world text to all-caps to avoid re-coding it all for PETSCII.

100 REM BRAINF*CK FOR COMMODORE BASIC
110 DB=0:REM SET TO 1 FOR DEBUGGING
120 P$=""
130 READ C$
140 P$=P$+C$
150 IF LEN(C$)<>0 THEN 130
160 REM PAIR UP BRACKETS INTO B%
170 DIM B%(LEN(P$))
180 REM TRACK OPEN BRACKETS IN O%
190 DIM O%(INT(LEN(P$)/2)):O=0
200 FOR I=1 TO LEN(P$)
210 : I$=MID$(P$,I,1)
220 : IF I$="[" THEN O%(O)=I:O=O+1
230 : IF I$<>"]" THEN 270
240 : IF O=0 THEN PRINT "UNMATCHED BRACKET AT"I". ABORTING.":END
250 : O=O-1:M=O%(O)
260 : B%(I)=M:B%(M)=I
270 NEXT I
280 IF O THEN PRINT "UNMATCHED BRACKETS AT EOF. ABORTING.":END
290 REM SET MS TO NUMBER OF MEMORY CELLS NEEDED.
300 REM THE BF SPEC REQUIRES 30000, WHICH WILL WORK ON C64 OR 48K+ PET.
310 AN UNEXPANDED VIC-20 WILL HANDLE 1000, A C-16 9000. THE DEMO ONLY NEEDS 4.
320 MS=4:DIM M%(MS/2-1):MP=0
330 REM FUNCTION TO READ BYTE AT CELL N
340 DEF FNMP(N)=INT(M%(INT(N/2)) / (1+255*(N AND 1))) AND 255
350 FOR I=1 TO LEN(P$)
360 : IF MP<0 OR MP>=MS THEN PRINT "ERROR: MP OUT OF RANGE AT"I:END
370 : IF DB THEN PRINT "IP:"I"("I$") MP: "MP"("FNMP(MP)")"
380 : I$=MID$(P$,I,1)
390 : IF I$<>"[" THEN 420
400 : IF FNMP(MP)=0 THEN I=B%(I)
410 : GOTO 530
420 : IF I$<>"]" THEN 450
430 : IF FNMP(MP) THEN I=B%(I)
440 : GOTO 530
450 : IF I$="<" THEN MP=MP-1:GOTO 530
460 : IF I$=">" THEN MP=MP+1:GOTO 530
470 : IF I$="-" THEN V=FNMP(MP)-1:GOTO 560
480 : IF I$="+" THEN V=FNMP(MP)+1:GOTO 560
490 : IF I$="." THEN PRINTCHR$(FNMP(MP));:GOTO 530
500 : IF I$<>"," THEN 530
510 : GET K$:IF K$="" THEN 510
520 : V=ASC(K$):GOTO 560
530 NEXT I
540 END
550 REM UPDATE CELL AT MP WITH VALUE IN V
560 M=INT(MP/2):O=M%(M):V=V AND 255
570 N0=(O AND -256)+V
580 N1=(V*256+(O AND 255))
590 M%(M) = (MP AND 1)*N1 - ((MP AND 1)=0)*N0
600 GOTO 530
610 REM HELLO, WORLD PROGRAM
620 DATA "+++++++++[>++++++++<-]>."
630 DATA "---."
640 DATA "+++++++..+++."
650 DATA ">>++++[<+++++++++++>-]<."
660 DATA ">++++[<--->-]<."
670 DATA "<++++++++."
680 DATA "--------."
690 DATA "+++."
700 DATA "------."
710 DATA "--------."
720 DATA ">>[++][<+++++++>-]<+."
730 DATA ">++++++++++."
740 DATA ""
Output:
HELLO, WORLD!

FreeBASIC

' Intérprete de brainfuck
' FB 1.05.0 Win64
'

Const BF_error_memoria_saturada As Integer = 2
Const BF_error_memoria_insuficiente As Integer = 4
Const BF_error_codigo_saturado As Integer = 8
Const BF_error_desbordamiento_codigo As Integer = 16

Dim BFcodigo As String = ">++++++++++[>+++>+++++++>++++++++++>+++++++++++>++++++++++++>++++++++++++++++[<]>-]>>>>>>+.<<<<++.>>+.---.<---.<<++.>>>+.>---.<+.<+++.>+.<<<+."
Dim codigo_error As Integer

Function EjecutarBF (BFcodigo As String, tammem As Uinteger) As Integer
    Dim As String memoria = String(tammem, 0)
    Dim As Uinteger puntero_instrucciones, puntero_datos
    Dim As Integer nivel_de_alcance
    
    For puntero_instrucciones = 0 To Len(BFcodigo)
        Select Case Chr(BFcodigo[puntero_instrucciones])
        Case ">"
            puntero_datos += 1
            If (puntero_datos > tammem - 1) Then Return BF_error_memoria_saturada
        Case "<"
            puntero_datos -= 1
            If (puntero_datos > tammem - 1) Then Return BF_error_memoria_insuficiente
        Case "+"
            memoria[puntero_datos] += 1
        Case "-"
            memoria[puntero_datos] -= 1
        Case "."
            Print Chr(memoria[puntero_datos]);
        Case ","
            memoria[puntero_datos] = Asc(Input(1))
        Case "["
            If (memoria[puntero_datos] = 0) Then
                Dim nivel_antiguo As Uinteger = nivel_de_alcance
                nivel_de_alcance += 1
                Do Until (nivel_de_alcance = nivel_antiguo)
                    puntero_instrucciones += 1
                    If (puntero_instrucciones > Len(BFcodigo) - 1) Then Return BF_error_codigo_saturado
                    Select Case Chr(BFcodigo[puntero_instrucciones])
                    Case "["
                        nivel_de_alcance += 1
                    Case "]"
                        nivel_de_alcance -= 1
                    End Select
                Loop
            Else
                nivel_de_alcance += 1
            End If
            Continue For
        Case "]"
            If (memoria[puntero_datos] = 0) Then
                nivel_de_alcance -= 1
                Continue For
            Else
                Dim nivel_antiguo As Integer = nivel_de_alcance
                nivel_de_alcance -= 1
                Do Until (nivel_de_alcance = nivel_antiguo)
                    puntero_instrucciones -= 1
                    If (puntero_instrucciones > Len(BFcodigo) - 1) Then Return BF_error_desbordamiento_codigo
                    Select Case Chr(BFcodigo[puntero_instrucciones])
                    Case "["
                        nivel_de_alcance += 1
                    Case "]"
                        nivel_de_alcance -= 1
                    End Select
                Loop
            End If
            Continue For
        Case Else
            Continue For
        End Select
    Next puntero_instrucciones
    Return -1
End Function


Cls
codigo_error = EjecutarBF(BFcodigo, 1024)
If codigo_error Then
    Sleep
Else
    Print "codigo de error: " & codigo_error
End If
End
Output:
íHola mundo!

GW-BASIC

10 REM BRAINFK INTERPRETER FOR GW-BASIC
20 INPUT "File to open? ",INFILE$
30 DIM TAPE(10000):  REM memory is 10000 long
40 DIM PRG$(5000):   REM programs can be 5000 symbols long
50 PRG$ = ""
60 OPEN(INFILE$) FOR INPUT AS #1
70 S = 0 : REM instruction pointer
80 WHILE NOT EOF(1)
90 LINE INPUT #1, LIN$
100 FOR P = 1 TO LEN(LIN$)
110 C$=MID$(LIN$,P,1)
120 IF C$="+" OR C$="-" OR C$="." OR C$="," OR C$ = "<" OR C$=">" OR C$="[" OR C$="]" THEN S=S+1:PRG$(S)=C$
130 NEXT P
140 WEND
150 PRLEN = S
160 REM ok, the program has been read in. now set up the variables
170 P = 0 : REM tape pointer
180 S = 1 : REM instruction pointer
190 K = 0 : REM bracket counter
200 WHILE S<=PRLEN: REM as long as there are still instructions to come
210 IF INKEY$="Q" THEN END
220 IF PRG$(S) = "+" THEN GOSUB 320
230 IF PRG$(S) = "-" THEN GOSUB 350
240 IF PRG$(S) = ">" THEN GOSUB 380
250 IF PRG$(S) = "<" THEN GOSUB 420
260 IF PRG$(S) = "." THEN GOSUB 460
270 IF PRG$(S) = "," THEN GOSUB 490
280 IF PRG$(S) = "[" THEN GOSUB 650 ELSE IF PRG$(S) = "]" THEN GOSUB 550
290 S = S + 1
300 WEND
310 END
320 REM the + instruction
330 TAPE(P) = TAPE(P) + 1
340 RETURN
350 REM the - instruction
360 TAPE(P) = TAPE(P)-1
370 RETURN
380 REM the > instruction
390 P = P + 1
400 IF P > 10000 THEN P = P - 10000 : REM circular tape, because why not?
410 RETURN
420 REM the < instruction
430 P = P - 1
440 IF P < 0 THEN P = P + 10000
450 RETURN
460 REM the . instruction
470 PRINT CHR$(TAPE(P));
480 RETURN
490 REM the , instruction
500 BEEP   :   REM use the beep as a signal that input is expected
510 G$ = INKEY$
520 IF G$ = "" THEN GOTO 510
530 TAPE(P) = ASC(G$)
540 RETURN
550 REM the ] instruction
560 IF TAPE(P)=0 THEN RETURN :  REM do nothing
570 K = 1 : REM otherwise it's some bracket counting
580 WHILE K > 0
590 S = S - 1
600 IF S = 0 THEN PRINT "Backtrack beyond start of program!" : END
610 IF PRG$(S) = "]" THEN K = K + 1
620 IF PRG$(S) = "[" THEN K = K - 1
630 WEND
640 RETURN
650 REM the [ instruction
660 IF TAPE(P)<> 0 THEN RETURN
670 K = 1
680 WHILE K>0
690 S = S + 1
700 IF S>PRLEN THEN PRINT "Advance beyond end of program!" : END
710 IF PRG$(S) = "]" THEN K = K - 1
720 IF PRG$(S) = "[" THEN K = K + 1
730 WEND
740 RETURN
Output:

Tested with the factorial code.

File to open? FACTOR.BF
1
1
2
6
24
120
720
5040
40320
362880

PureBasic

Implementation in PureBasic

TI-83 BASIC

Implementation in TI-83 BASIC.

TI-89 BASIC

Implementation in TI-89 Basic.

TRS-80 BASIC

This should work in Level II BASIC on any TRS-80, even a Model I. However, allocating the full 30,000-cell memory tape requires 48K of RAM.

The default character set on the TRS-80 lacks square brackets; their positions are taken by ↑ and ← characters instead. The code below uses square brackets, which will paste into emulators as the arrows; to type on a real machine the user will have to make the substitution manually.

To allow for programs that better resemble the standard visually, this interpreter also accepts parentheses as equivalent; that will break code containing parentheticals in comments, however, so edit lines 340 and 370 to suit your needs.

100 REM BRAINF*CK FOR TRS-80 LEVEL II BASIC
103 DB=0:REM SET TO 1 FOR DEBUGGING
105 REM FIRST MAKE SURE WE HAVE ENOUGH STRING HEAP FOR PROGRAM
110 READ C$:C=LEN(C$):IF C>M THEN M=C
120 PS=PS+C
130 IF C THEN 110
135 REM ALLOCATE THE HEAP
140 CLEAR 2*(PS+M)
145 REM RE-READ PROGRAM, REMEMBERING IT THIS TIME
150 RESTORE
160 P$=""
170 READ C$
180 P$=P$+C$
190 IF LEN(C$)<>0 THEN 170
195 REM PAIR UP BRACKETS INTO B%
200 DIM B%(LEN(P$))
205 REM TRACK OPEN BRACKETS IN O%
210 DIM O%(INT(LEN(P$)/2)):O=0
220 FOR I=1 TO LEN(P$)
230 : I$=MID$(P$,I,1)
240 : IF I$="(" OR I$="[" THEN O%(O)=I:O=O+1
250 : IF I$<>")" AND I$<>"]" THEN 290
260 : IF O=0 THEN PRINT "UNMATCHED BRACKET AT"I". ABORTING.":END
270 : O=O-1:M=O%(O)
280 : B%(I)=M:B%(M)=I
290 NEXT I
300 IF O THEN PRINT "UNMATCHED BRACKETS AT EOF. ABORTING.":END
303 REM SET MS TO NUMBER OF MEMORY CELLS NEEDED
305 REM THE BF SPEC REQUIRES 30000, WHICH DOES WORK ON A SYSTEM WITH 48K RAM.
307 REM THE DEMO HELLO-WORLD PROGRAM ONLY REQUIRES 4 CELLS.
310 MS=4:DIM M%(MS/2-1):MP=0
313 REM FUNCTION TO READ BYTE AT CELL N
315 DEF FNMP(N)=INT(M%(INT(N/2)) / (1+255*(N AND 1))) AND 255
320 FOR I=1 TO LEN(P$)
323 : IF MP<0 OR MP>=MS THEN PRINT "ERROR: MP OUT OF RANGE AT"I:END
327 : IF DB THEN PRINT "IP:"I"("I$") MP:"MP"("FNMP(MP)")"
330 : I$=MID$(P$,I,1)
340 : IF I$<>"(" AND I$<>"[" THEN 370
350 : IF FNMP(MP)=0 THEN I=B%(I)
360 : GOTO 480
370 : IF I$<>")" AND I$<>"]" THEN 400
380 : IF FNMP(MP) THEN I=B%(I)
390 : GOTO 480
400 : IF I$="<" THEN MP=MP-1:GOTO 480
410 : IF I$=">" THEN MP=MP+1:GOTO 480
420 : IF I$="-" THEN V=FNMP(MP)-1:GOTO 500
430 : IF I$="+" THEN V=FNMP(MP)+1:GOTO 500
440 : IF I$="." THEN ?CHR$(FNMP(MP));:GOTO 480
450 : IF I$<>"," THEN 480
460 : K$=INKEY$:IF K$="" THEN 460
470 : V=ASC(K$):GOTO 500
480 NEXT I
490 END
495 REM UPDATE CELL AT MP WITH VALUE IN V
500 M=INT(MP/2):O=M%(M):V=V AND 255
510 N0=(O AND -256)+V
520 N1=(V*256+(O AND 255))
530 M%(M) = (MP AND 1)*N1 - ((MP AND 1)=0)*N0
540 GOTO 480
545 REM HELLO, WORLD PROGRAM
570 DATA "+++++++++[>++++++++<-]>."
580 DATA "<+++++[>+++++<-]>++++."
590 DATA "+++++++..+++."
600 DATA ">>++++[<+++++++++++>-]<."
610 DATA ">++++[<--->-]<."
620 DATA "<++++++++."
630 DATA "--------."
640 DATA "+++."
650 DATA "------."
660 DATA "--------."
670 DATA ">>[++][<+++++++>-]<+."
680 DATA ">++++++++++."
690 DATA ""
Output:
Hello, world!

Visual Basic .NET

Imports System

Module Program
  Sub Main(args As String())
    Brainfug("++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.")
  End Sub

  Sub Brainfug(code As String, Optional input As String = Nothing)
    Dim inp As Integer = 1 ' input pointer if we use an input string
    Dim tape(29999) As Integer ' yes, 29999 makes an array of 30000
    Dim p As Integer
    For i = 1 To code.Length
      Dim c As Char = Mid(code, i, 1)
      Select c
        Case ">"
          p += 1
        Case "<"
          p -= 1
        Case "+"
          tape(p) += 1
        Case "-"
          tape(p) -= 1
        Case "."
          Try
            Console.Write(Chr(tape(p)))
          Catch ex As NotSupportedException
            Console.Write(".")
          End Try
        Case ","
          If input Is Nothing then
            tape(p) = Console.Read()
          Else
            Try
              tape(p) = AscW(Mid(input, inp, 1))
            Catch ex As ArgumentException
              Console.WriteLine("Panic: Out of input!")
              Environment.Exit(1)
            End Try
            inp += 1
          End If
        Case "["
          If tape(p) = 0
            Dim nest = 1
            While nest
              i += 1
              Select Mid(code, i, 1)
                Case "]"
                  nest -= 1
                Case "["
                  nest += 1
              End Select
            End While
          End If
        Case "]"
          If tape(p) <> 0
            Dim nest = 1
            While nest
              i -= 1
              Select Mid(code, i, 1)
                Case "["
                  nest -= 1
                Case "]"
                  nest += 1
              End Select
            End While
          End If
      End Select
    Next
  End Sub
End Module
Output:
Hello World!

ZX Spectrum Basic

The bracket loop could be accelerated to prevent searching the string every time, but it runs.

10 GO SUB 1000
20 LET e=LEN p$
30 LET a$=p$(ip)
40 IF a$=">" THEN LET dp=dp+1
50 IF a$="<" THEN LET dp=dp-1
60 IF a$="+" THEN LET d(dp)=d(dp)+1
70 IF a$="-" THEN LET d(dp)=d(dp)-1
80 IF a$="." THEN PRINT CHR$ d(dp);
90 IF a$="," THEN INPUT d(dp)
100 IF a$="[" THEN GO SUB 500
110 IF a$="]" THEN LET bp=bp-1: IF d(dp)<>0 THEN LET ip=b(bp)-1
120 LET ip=ip+1
130 IF ip>e THEN PRINT "eof": STOP
140 GO TO 30

499 REM match close
500 LET bc=1: REM bracket counter
510 FOR x=ip+1 TO e
520 IF p$(x)="[" THEN LET bc=bc+1
530 IF p$(x)="]" THEN LET bc=bc-1
540 IF bc=0 THEN LET b(bp)=ip: LET be=x: LET x=e: REM bc will be 0 once all the subnests have been counted over
550 IF bc=0 AND d(dp)=0 THEN LET ip=be: LET bp=bp-1
560 NEXT x
570 LET bp=bp+1
580 RETURN

999 REM initialisation
1000 DIM d(100): REM data stack
1010 LET dp=1: REM data pointer
1020 LET ip=1: REM instruction pointer
1030 DIM b(30): REM bracket stack
1040 LET bp=1: REM bracket pointer
1050 LET p$="++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>+++++.": REM program, marginally modified from Wikipedia; outputs CHR$ 13 at the end instead of CHR$ 10 as ZX Spectrum Basic handles the carriage return better than the line feed
1060 RETURN
Output:
Hello World!
eof

9 STOP statement, 130:3

BCPL

get "libhdr"

manifest
$(  bfeof = 0
$)

let reads(v) be
$(  let ch = ?
    v%0 := 0
    ch := rdch()
    until ch = '*N' do
    $(  v%0 := v%0 + 1
        v%(v%0) := ch
        ch := rdch()
    $)
$)

let contains(str, ch) = valof
$(  for i = 1 to str%0 do
        if ch = str%i then resultis true
    resultis false
$)

let readbf(file, v) = valof
$(  let i, ch = 1, ?
    let curin = input()
    v%0 := 0
    selectinput(file)
    ch := rdch()
    until ch = endstreamch do
    $(  if contains("+-<>.,[]", ch) then
        $(  v%i := ch
            i := i + 1
        $)
        ch := rdch()
    $)
    
    v%i := 0
    endread()
    selectinput(curin)
    resultis i + 1
$)

let bfout(ch) be wrch(ch=10 -> '*N', ch)
let bfin() = valof
$(  let ch = rdch()
    resultis ch = endstreamch -> bfeof, ch
$)

let scan(v, i, dir) = valof
$(  let d = 1
    until d = 0 do
    $(  i := i + dir
        if v%i = 0 then
        $(  writes("Unbalanced brackets*N")
            resultis 0
        $)
        if v%i = '[' then d := d + dir
        if v%i = ']' then d := d - dir
    $)
    resultis i
$)

let run(v, m) be
$(  let i = 1
    until v%i = 0 do
    $(  switchon v%i into
        $(  case '+': v%m := v%m + 1 ; endcase 
            case '-': v%m := v%m - 1 ; endcase
            case '>': m := m + 1 ; endcase
            case '<': m := m - 1 ; endcase
            case '.': bfout(v%m) ; endcase
            case ',': v%m := bfin() ; endcase
            case '[':
                if v%m = 0 then i := scan(v, i, 1)
                if i = 0 then return
                endcase
            case ']':
                unless v%m = 0 do i := scan(v, i, -1)
                if i = 0 then return 
                endcase
        $)
        i := i + 1
    $)
$)

let start() be
$(  let fname = vec 63
    let file = ?
    
    writes("Filename? ")
    reads(fname)
    file := findinput(fname)
    
    test file = 0 then 
        writes("Cannot open file.*N")
    else
    $(  let mvec = getvec(maxvec())
        let m = readbf(file, mvec)
        run(mvec, m)
        freevec(mvec)
    $)
$)
Output:
Filename? hello.bf
Hello World!

Binary Lambda Calculus

The following 224-byte program

0000000    44  51  a1  01  84  55  d5  02  b7  70  30  22  ff  32  f0  00
0000020    bf  f9  85  7f  5e  e1  6f  95  7f  7d  ee  c0  e5  54  68  00
0000040    58  55  fd  fb  e0  45  57  fd  eb  fb  f0  b6  f0  2f  d6  07
0000060    e1  6f  73  d7  f1  14  bc  c0  0b  ff  2e  1f  a1  6f  66  17
0000100    e8  5b  ef  2f  cf  ff  13  ff  e1  ca  34  20  0a  c8  d0  0b
0000120    99  ee  1f  e5  ff  7f  5a  6a  1f  ff  0f  ff  87  9d  04  d0
0000140    ab  00  05  db  23  40  b7  3b  28  cc  c0  b0  6c  0e  74  10
0000160    2b  2b  2b  2b  2b  2b  2b  2b  2b  2b  5b  3e  2b  2b  2b  2b
0000200    2b  2b  2b  3e  2b  2b  2b  2b  2b  2b  2b  2b  2b  2b  3e  2b
0000220    2b  2b  3e  2b  3c  3c  3c  3c  2d  5d  3e  2b  2b  2e  3e  2b
0000240    2e  2b  2b  2b  2b  2b  2b  2b  2e  2e  2b  2b  2b  2e  3e  2b
0000260    2b  2e  3c  3c  2b  2b  2b  2b  2b  2b  2b  2b  2b  2b  2b  2b
0000300    2b  2b  2b  2e  3e  2e  2b  2b  2b  2e  2d  2d  2d  2d  2d  2d
0000320    2e  2d  2d  2d  2d  2d  2d  2d  2d  2e  3e  2b  2e  3e  2e  5d

consists of the 112-byte brainfuck interpreter https://github.com/tromp/AIT/blob/master/bf.blc8 followed by the 112-byte brainfuck hello world program

++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.]

and produces output

Hello World!

Brainf***

Brain**** in Brain**** Yey! Credits to Frans, NYYRIKKI, Daniel B Cristofani for the code.

Frans:

"I started to think about a BF interpreter written in BF, and because I did not want to write BF code directly, I started with writing a C program that could generate BF code for often used constructs. After some experimentation, I decided to implement a direct execution mode (making use of a define), so that I didn't have to go through the generate-interpret cycle. This resulted in the BF interpreter in BF generation program. If the macro symbol EXECUTE is not defined, this program when executed generates a BF interpreter in BF. This BF interpreter expects as input a BF program terminated with an exclamation mark, followed by the input for the program to be interpreted. I by no means claim that this BF interpreter in BF is the shortest possible. (Actually, NYYRIKKI wrote a much short one and Daniel B. Cristofani an even shorter one.) The BF interpreter in BF (when filtered through a comment remover) looks like:"

>>>,[->+>+<<]>>[-<<+>>]>++++[<++++++++>-]<+<[->>+>>+<<<<]>>>>[-<<<<+>>
>>]<<<[->>+>+<<<]>>>[-<<<+>>>]<<[>[->+<]<[-]]>[-]>[[-]<<<<->-<[->>+>>+
<<<<]>>>>[-<<<<+>>>>]<<<[->>+>+<<<]>>>[-<<<+>>>]<<[>[->+<]<[-]]>[-]>]<
<<<[->>+<<]>[->+<]>[[-]<<<[->+>+<<]>>[-<<+>>]>++++++[<+++++++>-]<+<[->
>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<
[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>
>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<+>>>
>[-]]<<<[->+>+<<]>>[-<<+>>]>+++++[<+++++++++>-]<<[->>>+>+<<<<]>>>>[-<<
<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<->-<[
->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]
]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<++>>>>[-]]<<<[->+>+<<]
>>[-<<+>>]>++++++[<++++++++++>-]<<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+
>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>
>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->
>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<+++>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>+++
+++[<++++++++++>-]<++<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-
<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>
]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>
+<<]>+>[<->[-]]<[<<<<++++>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>+++++[<+++++++
++>-]<+<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->
>+<<]>[-]]<[-]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<
]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]
]<[<<<<+++++>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>++++[<+++++++++++>-]<<[->>>
+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-
]>>[[-]<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>
]<[<[->>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<++++++
>>>>[-]]<<<[->+>+<<]>>[-<<+>>]>+++++++[<+++++++++++++>-]<<[->>>+>+<<<<
]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]
<<<<->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->
>+<<]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<+++++++>>>>[-
]]<<<[->+>+<<]>>[-<<+>>]>+++++++[<+++++++++++++>-]<++<[->>>+>+<<<<]>>>
>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<]>[-]]<[-]>>[[-]<<<<
->-<[->>>+>+<<<<]>>>>[-<<<<+>>>>]<<<[->+>>+<<<]>>>[-<<<+>>>]<[<[->>+<<
]>[-]]<[-]>>]<<<<[->>>+<<<]>[->>+<<]>+>[<->[-]]<[<<<<++++++++>>>>[-]]<
<<<[->>+>+<<<]>>>[-<<<+>>>]<[<<<[->>>>>>>>>+<+<<<<<<<<]>>>>>>>>[-<<<<<
<<<+>>>>>>>>]<<<<<<<[->>>>>>>>>+<<+<<<<<<<]>>>>>>>[-<<<<<<<+>>>>>>>]>[
<[->>>>>+<<<<<]>[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>+>-]>>[-]<[->+<]<<[[-<
<<<<+>>>>>]<<<<<-]<<<<<<<<+>[-]>>[-]]<,[->+>+<<]>>[-<<+>>]>++++[<+++++
+++>-]<+<[->>+>>+<<<<]>>>>[-<<<<+>>>>]<<<[->>+>+<<<]>>>[-<<<+>>>]<<[>[
->+<]<[-]]>[-]>[[-]<<<<->-<[->>+>>+<<<<]>>>>[-<<<<+>>>>]<<<[->>+>+<<<]
>>>[-<<<+>>>]<<[>[->+<]<[-]]>[-]>]<<<<[->>+<<]>[->+<]>]<<<<<[-][->>>>>
>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>
+>-]>>[[-<+<+>>]<<[->>+<<]>[-<+>[<->[-]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[
-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>
>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+>>>>>>
>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>+<<<<[[-<<<<<+>>>>>]<<<
<<-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<
]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->>+<<]>[-[-<+>[<->[-]]]]<[[
-]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<
[-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>
>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]
>>>-<<<<[[-<<<<<+>>>>>]<<<<<-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<
+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->
>+<<]>[-[-[-<+>[<->[-]]]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[
-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<
<<<->+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>
>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->>+<<]>[-[-[-[-<+>[<->[-]]]]]]<[[-
]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[
-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<+>+[->>>>>>>>>+<<<<<<+<<<]>
>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>
>]<<[->>+<<]>[-[-[-[-[-<+>[<->[-]]]]]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[-<
<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>>>
>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>
>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>.<<<<[[-<<<<<+>>>>>]<<<<<
-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>
[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+<+>>]<<[->>+<<]>[-[-[-[-[-[-<+>[<->[-]
]]]]]]]<[[-]<[->+>+<<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<
-]<<<<<<<<[-]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<
<<<<<<<<]>>>>>>>>>[-<<<<<<<<<+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<
<]>>>>+>-]>>>,<<<<[[-<<<<<+>>>>>]<<<<<-]<<<<<<<<+[->>>>>>>>>+<<<<<<+<<
<]>>>[-<<<+>>>]>>>>>>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-][-]]>>[-<+
<+>>]<<[->>+<<]>[-[-[-[-[-[-[-<+>[<->[-]]]]]]]]]<[[-]<[->+>+<<]>>[-<<+
>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>>>[-<<<<<
<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-<<<<<<<<<
+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>[-<<<+>+>>]<<[->
>+<<]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]>[-<<<<<<+>>>>>>]>+<<<<<<
<[>>>>>>>-<<<<<<<[-]]<<<[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>[<[-
>>>>>+<<<<<]>[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>+>-]>[[-]<+[<[->>>>>+<<<<
<]>[->>>>>+<<<<<]>>>>+>>>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-<<<+>>>[<<
<->>>[-]]]]]]]]]<<<[<+>[-]]>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-[-<<<+>
>>[<<<->>>[-]]]]]]]]]]<<<[<->[-]]<]>[-]]<<[->>>>>+<<<<<]>>>>>+>[-]]>>[
-<+<+>>]<<[->>+<<]>[-[-[-[-[-[-[-[-<+>[<->[-]]]]]]]]]]<[[-][-]<[->+>+<
<]>>[-<<+>>]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]<<<<<<<<[-]>>>>>>>
>>[-<<<<<<<<<+>>>>>>>>>]<<<<<<<<<<[->>>>>>>>>>+<+<<<<<<<<<]>>>>>>>>>[-
<<<<<<<<<+>>>>>>>>>]>[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>>+>-]>>>[-<<<+>
+>>]<<[->>+<<]<<[[-<<<<<+>>>>>]>[-<<<<<+>>>>>]<<<<<<-]>[-<<<<<<+>>>>>>
]<<<<<<[->>>>>>>+<<<<<<<]<<<[->>>>>>>>>+<<<<<<+<<<]>>>[-<<<+>>>]>>>>>>
[<[->>>>>+<<<<<]>[->>>>>+<<<<<]>[->>>>>+<<<<<]>>>+>-]>[[-]<+[<[-<<<<<+
>>>>>]>[-<<<<<+>>>>>]<<<<<<->>>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-<<<+
>>>[<<<->>>[-]]]]]]]]]<<<[<->[-]]>[->>+<<<+>]<[->+<]>>>[-[-[-[-[-[-[-[
-<<<+>>>[<<<->>>[-]]]]]]]]]]<<<[<+>[-]]<]>[-]]<<[->>>>>+<<<<<]>>>>>+>[
-]]>>]

NYYRIKKI:

"Hi,

I saw your Brain**** interpreter for Brain**** and it encouraged me to write my own version of it. I now write to you as I thought, you might be interested about it.

I wanted to write as fast version as possible so I wrote it directly with Brain****. Here is a list of key tricks, that I used to get maximum performance:

  • I used loader routine, that removes comments before executing and converts BF code to internal format. In the internal format numbers 1-8 are used for commands and zero is used to terminate execution (code before line split) This is because handling small numbers is much more effective than handling large numbers in BF.
  • I used special IF (x)=0 stucture like this: >+<[>-]>[THEN >] to avoid slow byte copying loops. (Command backup etc.)
  • I used 3 bytes for each program element to get maximum speed. Using less would have caused program it self get more slow and complex and using more would have slowed down memory seek. For program memory I used 2 bytes for each element.

Data is not transferred between memory and program. In "[" command I only move Z flag. (Value in memory is more likely to be NZ and "0" is faster to move than "1")

This program works same way as yours. Only difference is, that program termination character is ":" instead of "!" No more explaining... here is the code:"

>>>+[,>+++++++[<------>-]<[->+>+<<]>>[-<<+>>]<->+<[>-<[-]]>[-<<[-]++++
+>>>>>]<<[->+>+<<]>>[-<<+>>]<-->+<[>-<[-]]>[-<<[-]++++++++>>>>>]<<[->+
>+<<]>>[-<<+>>]<--->+<[>-<[-]]>[-<<[-]++++++>>>>>]<<[->+>+<<]>>[-<<+>>
]<---->+<[>-<[-]]>[-<<[-]+++++++>>>>>]<<[->+>+<<]>>[-<<+>>]++++++[<---
>-]+<[>-<[-]]>[-<<[-]++++>>>>>]<<[->+>+<<]>>[-<<+>>]+++++[<---->-]+<[>
-<[-]]>[-<<[-]+++>>>>>]<<[->+>+<<]>>[-<<+>>]+++++++[<------->-]+<[>-<[
-]]>[-<<[-]+>>>>>]<<[->+>+<<]>>[-<<+>>]+++++++[<------->-]<-->+<[>-<[-
]]>[-<<[-]++>>>>>]<++++[<---->-]<]<<<[<<<]>>>
[-->+<[>-]>[>]<<++>[-<<<<
<+[>-->+<[>-]>[-<<+>>>]<<+>+<[>-]>[-<<->>>]<<+<[-<<<+>>>]<<<]>>>>>]<->
+<[>-]>[>]<<+>[-<->>>[>>>]>[->+>>+<<<]>[-<+>]>>[-[->>+<<]+>>]+>[->+<]>
[-<+>>>[-]+<<]+>>[-<<->>]<<<<[->>[-<<+>>]<<<<]>>[-<<<<<+>>>>>]<<<<<<<[
>>[-<<<+>>>]<<<<<]+>>[>-->+<[>-]>[-<<->>>]<<+>+<[>-]>[-<<+>>>]<<+<[->>
>+<<<]>>>]<]<--->+<[>-]>[->>[>>>]>+<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>-<
<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>]>>[-[->>+<<]+>>]+>+<
[-<<]<<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>]>>[-[->>+<<]+
>>]+>-<[-<<]<<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>]>>[-[-
>>+<<]+>>]+>.<[-<<]<<<<<[<<<]>>]<<->+<[>-]>[->>[>>>]>[->+>>+<<<]>[-<+>
]>>[-[->>+<<]+>>]+>,<[-<<]<<<<<[<<<]>>]<<++++++++>>>]

Daniel B. Cristofani

>>>+[[-]>>[-]++>+>+++++++[<++++>>++<-]++>>+>+>+++++[>++>++++++<<-]+>>>,<++[[>[
->>]<[>>]<<-]<[<]<+>>[>]>[<+>-[[<+>-]>]<[[[-]<]++<-[<+++++++++>[<->-]>>]>>]]<<
]<]<[[<]>[[>]>>[>>]+[<<]<[<]<+>>-]>[>]+[->>]<<<<[[<<]<[<]+<<[+>+<<-[>-->+<<-[>
+<[>>+<<-]]]>[<+>-]<]++>>-->[>]>>[>>]]<<[>>+<[[<]<]>[[<<]<[<]+[-<+>>-[<<+>++>-
[<->[<<+>>-]]]<[>+<-]>]>[>]>]>[>>]>>]<<[>>+>>+>>]<<[->>>>>>>>]<<[>.>>>>>>>]<<[
>->>>>>]<<[>,>>>]<<[>+>]<<[+<<]<]
[input a brain**** program and its input, separated by an exclamation point.
Daniel B Cristofani (cristofdathevanetdotcom)
http://www.hevanet.com/cristofd/brainfuck/]

Links: [[1]]

[[2]]

[[3]]

Franco C. Bartolabac, a 12 y/o boi.

Brat

Implementation in Brat

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

However, this implementation does not support input. Also, output is visible only after the brainfuck program terminated. This is due to the limitation that Burlesque does not have actual I/O.

C

Implementation in C.

C#

Implementation in C#.

C++

Implementation in C++.

Clojure

(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*)))))
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

The alternate implementation at Execute Brain****/Clojure showcases a rather different approach.

CLU

tape = cluster is new, left, right, get_cell, set_cell 
    ac = array[char]
    rep = record [
        cells: ac,
        index: int
    ]
    
    new = proc () returns (cvt)
        t: rep := rep${ 
            cells: ac$predict(0, 30000),
            index: 0
        }
        ac$addh(t.cells, '\000')
        return(t)
    end new
    
    left = proc (t: cvt)
        t.index := t.index - 1
        if t.index < ac$low(t.cells) then ac$addl(t.cells, '\000') end
    end left
    
    right = proc (t: cvt)
        t.index := t.index + 1
        if t.index > ac$high(t.cells) then ac$addh(t.cells, '\000') end
    end right
    
    get_cell = proc (t: cvt) returns (int)
        return (char$c2i(t.cells[t.index]) // 256)
    end get_cell
    
    set_cell = proc (t: cvt, i: int)
        t.cells[t.index] := char$i2c(i // 256)
    end set_cell
end tape

program = cluster is parse, fetch, jump
    loop_jump = struct[from, to: int]
    alj = array[loop_jump]
    slj = sequence[loop_jump]
    
    rep = struct [
        loops: slj,
        code: string
    ]
    
    parse = proc (s: string) returns (cvt) signals (bad_loops)
        ac = array[char]
        
        prog: ac := ac$predict(1, string$size(s))
        loops: alj := alj$[]
        loop_stack: array[int] := array[int]$[]
        
        for c: char in string$chars(s) do 
            if string$indexc(c, "+-<>,.[]") = 0 then continue end
            ac$addh(prog, c)
            if c = '[' then 
                array[int]$addh(loop_stack, ac$high(prog))
            elseif c = ']' then
                here: int := ac$high(prog)
                there: int := array[int]$remh(loop_stack)
                    except when bounds: signal bad_loops end
                alj$addh(loops, loop_jump${from: here, to: there})
                alj$addh(loops, loop_jump${from: there, to: here})
            end
        end

        if ~array[int]$empty(loop_stack) then signal bad_loops end
        return (rep${loops: slj$a2s(loops), code: string$ac2s(prog)})
    end parse
    
    fetch = proc (p: cvt, i: int) returns (char) signals (bounds)
        return (p.code[i]) resignal bounds
    end fetch

    jump = proc (p: cvt, i: int) returns (int) signals (not_found)
        for j: loop_jump in slj$elements(p.loops) do
            if j.from = i then return (j.to) end
        end
        signal not_found
    end jump
end program 

brainf = cluster is make, run
    rep = struct [
        prog: program,
        mem: tape,
        inp, out: stream
    ]
    
    make = proc (p: program, i, o: stream) returns (cvt)
        return (rep${
            prog: p,
            inp: i,
            out: o,
            mem: tape$new()
        })
    end make
    
    read = proc (p: rep) returns (int)
        return (char$c2i(stream$getc(p.inp)))
        except when end_of_file:
            return (0)
        end
    end read
    
    write = proc (p: rep, c: int)
        stream$putc(p.out, char$i2c(c))
    end write
    
    run = proc (p: cvt)
        ip: int := 1
        while true do
            op: char := p.prog[ip] except when bounds: break end
            if     op = '+' then p.mem.cell := p.mem.cell + 1
            elseif op = '-' then p.mem.cell := p.mem.cell - 1
            elseif op = '>' then tape$right(p.mem)
            elseif op = '<' then tape$left(p.mem)
            elseif op = ',' then p.mem.cell := read(p)
            elseif op = '.' then write(p, p.mem.cell)
            elseif op = '[' cand p.mem.cell = 0 then
                ip := program$jump(p.prog, ip)
            elseif op = ']' cand p.mem.cell ~= 0 then
                ip := program$jump(p.prog, ip)
            end
            ip := ip + 1
        end
    end run
end brainf

read_whole_stream = proc (s: stream) returns (string) 
    chars: array[char] := array[char]$predict(1, 4096)
    while true do
        array[char]$addh(chars, stream$getc(s))
        except when end_of_file: break end
    end
    return (string$ac2s(chars))
end read_whole_stream 

start_up = proc ()
    pi: stream := stream$primary_input()
    po: stream := stream$primary_output()
    
    stream$puts(po, "Filename? ")
    fname: file_name := file_name$parse(stream$getl(pi))
    file: stream := stream$open(fname, "read")
    code: string := read_whole_stream(file)
    stream$close(file)
    
    prog: program := program$parse(code)
    interp: brainf := brainf$make(prog, pi, po)
    brainf$run(interp)
end start_up
Output:
$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ ./brainf
Filename? hello.bf
Hello World!

COBOL

Implementation in COBOL.

Comefrom0x10

This interpreter takes a command line argument with the path to a Brain**** program. It uses strings as storage, so storage is unbounded on both sides of the pointer, but behavior is undefined for cell values lower than zero or higher than 0x10ffff.

pointer_alpha = 1/0
pointer_numeric = 1/0
tape_behind = ''
tape_ahead = 1/0
tape_pos = 0 # only for debugging
array_behind = 1/0
array_ahead = ''
set_tape_ahead = array_ahead
array_ahead = 1/0
#
shift
  comefrom if array_ahead is array_ahead
  cdr = 1/0
  cdr = array_ahead
  shift_tail = cdr
  new_cell
    comefrom shift if shift_tail is ''
    itoa = 0
    shift_tail = itoa
  car = 1/0
  car = array_ahead
  array_behind = car array_behind
  done = shift_tail
  array_ahead = shift_tail
  comefrom shift if array_ahead is done

set_pointer_alpha = 1/0
set_pointer_alpha
  comefrom if set_pointer_alpha
  atoi = set_pointer_alpha
  cdr = tape_ahead
  set_tape_ahead = set_pointer_alpha cdr
  set_pointer_alpha = 1/0

set_tape_ahead = 1/0
set_pointer_vals
  comefrom if set_tape_ahead
  tape_ahead = set_tape_ahead
  car = tape_ahead
  pointer_alpha = car
  atoi = pointer_alpha
  pointer_numeric = atoi
  set_tape_ahead = 1/0

pointer_change = 1/0
change_pointer_val
  comefrom if pointer_change
  car = tape_ahead
  cdr = tape_ahead
  itoa = pointer_numeric + pointer_change
  set_tape_ahead = itoa cdr
  pointer_change = 1/0

file = 0 # initialize to something other than undefined so jump from file works when read fails
read_path = argv
error_reading_program
  comefrom file if file + 0 is 0
  'Error: cannot read Brainfuck program at "' read_path '"'
  ''

program_loaded
  comefrom file if file is file
  program_behind = ''
  program_ahead = file

  run
    comefrom program_loaded
    opcode = 1/0
    opcode_numeric = 1/0
    in_buffer = '' # cf0x10 stdin is line-buffered
    jumping = 0
    moving = 1
    comefrom run

    comefrom execute if opcode_numeric is 0
    ''
    execute
      comefrom run if moving
      # can be useful for debugging:
      #program_ahead moving ':' jumping '@' tape_pos ':' pointer_numeric
      car = program_ahead
      atoi = car
      opcode_numeric = atoi
      opcode = car
      opcode = 1/0

      #

    program_forward
      comefrom execute if moving > 0
      array_behind = program_behind
      array_ahead = 1/0
      array_ahead = program_ahead
      program_behind = array_behind
      program_ahead = array_ahead

      forward_jump
        comefrom execute if opcode is '['

        jump
          comefrom forward_jump if pointer_numeric is 0
          jumping = jumping + 1
          moving = 1
        match_brace
          comefrom forward_jump if jumping < 0
          jumping = jumping + 1
          stop_jump
            comefrom match_brace if jumping is 0
            moving = 1

    program_backward
      comefrom execute if moving < 0
      array_behind = program_ahead
      array_ahead = 1/0
      array_ahead = program_behind
      program_behind = array_ahead
      program_ahead = array_behind

      backward_jump
        comefrom execute if opcode is ']'

        jump
          comefrom backward_jump if pointer_numeric > 0
          jumping = jumping - 1
          moving = -1
        match_brace
          comefrom backward_jump if jumping > 0
          jumping = jumping - 1
          stop_jump
            comefrom match_brace if jumping is 0
            moving = 1

    op
      comefrom execute if opcode

      moving = 1
      do_op = opcode
      comefrom op if jumping
      #
      forward
        comefrom op if do_op is '>'
        tape_pos = tape_pos + 1
        array_ahead = 1/0
        array_behind = tape_behind
        array_ahead = tape_ahead
        tape_behind = array_behind
        set_tape_ahead = array_ahead
      backward
        comefrom op if do_op is '<'
        tape_pos = tape_pos - 1
        array_ahead = 1/0
        array_behind = tape_ahead
        array_ahead = tape_behind
        tape_behind = array_ahead
        set_tape_ahead = array_behind

      increment
        comefrom op if do_op is '+'
        pointer_change = 1
      decrement
        comefrom op if do_op is '-'
        pointer_change = -1

      print
        comefrom op if do_op is '.'
        pointer_alpha...
      read
        comefrom op if do_op is ','
        #
        cdr = 1/0
        cdr = in_buffer
        car = in_buffer
        set_pointer_alpha = car
        cdr = in_buffer
        in_buffer = cdr
        comefrom stdin if stdin + 0 is 0
        #
        block_for_input
          comefrom read if cdr is ''
          stdin = ''
          in_buffer = stdin
          cdr = in_buffer
          comefrom stdin if stdin + 0 is 0

Common Lisp

Implementation in Common Lisp.

D

Implementation in D.

Delphi

Translation of: Pascal

Fix of #Pascal to run in Delphi.

program Execute_Brain;

{$APPTYPE CONSOLE}

uses
  Winapi.Windows,
  System.SysUtils;

const
  DataSize = 1024;                           // Size of Data segment
  MaxNest = 1000;                           // Maximum nesting depth of []

function Readkey: Char;
var
  InputRec: TInputRecord;
  NumRead: Cardinal;
  KeyMode: DWORD;
  StdIn: THandle;
begin
  StdIn := GetStdHandle(STD_INPUT_HANDLE);
  GetConsoleMode(StdIn, KeyMode);
  SetConsoleMode(StdIn, 0);

  repeat
    ReadConsoleInput(StdIn, InputRec, 1, NumRead);
    if (InputRec.EventType and KEY_EVENT <> 0) and InputRec.Event.KeyEvent.bKeyDown then
    begin
      if InputRec.Event.KeyEvent.AsciiChar <> #0 then
      begin
        Result := InputRec.Event.KeyEvent.UnicodeChar;
        Break;
      end;
    end;
  until FALSE;

  SetConsoleMode(StdIn, KeyMode);
end;

procedure ExecuteBF(Source: string);
var
  Dp: pByte;                          // Used as the Data Pointer
  DataSeg: Pointer;                        // Start of the DataSegment (Cell 0)
  Ip: pChar;                          // Used as instruction Pointer
  LastIp: Pointer;                        // Last adr of code.
  JmpStack: array[0..MaxNest - 1] of pChar;   // Stack to Keep track of active "[" locations
  JmpPnt: Integer;                        // Stack pointer ^^
  JmpCnt: Word;                           // Used to count brackets when skipping forward.

begin

  // Set up then data segment
  getmem(DataSeg, dataSize);
  Dp := DataSeg;
//  fillbyte(dp^,dataSize,0);
  FillChar(Dp^, DataSize, 0);

  // Set up the JmpStack
  JmpPnt := -1;

  // Set up Instruction Pointer
  Ip := @Source[1];
  LastIp := @Source[length(Source)];
  if Ip = nil then
    exit;

  // Main Execution loop
  repeat { until Ip > LastIp }
    case Ip^ of
      '<':
        dec(Dp);
      '>':
        inc(Dp);
      '+':
        inc(Dp^);
      '-':
        dec(Dp^);
      '.':
        write(chr(Dp^));
      ',':
        Dp^ := ord(ReadKey);
      '[':
        if Dp^ = 0 then
        begin
             // skip forward until matching bracket;
          JmpCnt := 1;
          while (JmpCnt > 0) and (Ip <= LastIp) do
          begin
            inc(Ip);
            case Ip^ of
              '[':
                inc(JmpCnt);
              ']':
                dec(JmpCnt);
              #0:
                begin
                  Writeln('Error brackets don''t match');
                  halt;
                end;
            end;
          end;
        end
        else
        begin
             // Add location to Jump stack
          inc(JmpPnt);
          JmpStack[JmpPnt] := Ip;
        end;
      ']':
        if Dp^ > 0 then
             // Jump Back to matching [
          Ip := JmpStack[JmpPnt]
        else             // Remove Jump from stack
          dec(JmpPnt);
    end;
    inc(Ip);
  until Ip > LastIp;
  freemem(DataSeg, dataSize);
end;

const
  HelloWorldWiki = '++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>' +
    '---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.';
  pressESCtoCont = '>[-]+++++++[<++++++++++>-]<->>[-]+++++++[<+++++++++++' +
    '+>-]<->>[-]++++[<++++++++>-]+>[-]++++++++++[<++++++++' +
    '++>-]>[-]++++++++[<++++++++++++++>-]<.++.+<.>..<<.<<.' +
    '-->.<.>>.>>+.-----.<<.[<<+>>-]<<.>>>>.-.++++++.<++++.' +
    '+++++.>+.<<<<++.>+[>+<--]>++++...';
  waitForEsc = '[-]>[-]++++[<+++++++>-]<->[-]>+[[-]<<[>+>+<<-]' + '>>[<' +
    '<+>>-],<[->-<]>]';

begin
  // Execute "Hello World" example from Wikipedia
  ExecuteBF(HelloWorldWiki);

  // Print text "press ESC to continue....." and wait for ESC to be pressed
  ExecuteBF(pressESCtoCont + waitForEsc);
end.

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

Execution:

$ java -classpath antlr-3.2.jar:clojure-1.2.0/clojure.jar:. clojure.main dodo/runner.clj bfc2.do0 
++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.@
Hello World!

E

Implementation in E.

EasyLang

proc exec code$ . .
   len mem[] 100
   dp = 1
   code$[] = strchars code$
   ip = 1
   while ip <= len code$[]
      if dp > len mem[]
         len mem[] len mem[] + 100
      .
      if dp < 1
         print "programm error"
         return
      .
      c$ = code$[ip]
      if c$ = "+"
         mem[dp] += 1
      elif c$ = "-"
         mem[dp] -= 1
      elif c$ = ">"
         dp += 1
      elif c$ = "<"
         dp -= 1
      elif c$ = "."
         write strchar mem[dp]
      elif c$ = ","
         print "input not implemented"
      elif c$ = "["
         if mem[dp] = 0
            br = 1
            repeat
               ip += 1
               if code$[ip] = "["
                  br += 1
               elif code$[ip] = "]"
                  br -= 1
               .
               until br = 0
            .
         else
            br[] &= ip
         .
      elif c$ = "]"
         ip = br[len br[]] - 1
         len br[] -1
      .
      ip += 1
   .
.
func syntax code$ .
   for i to len code$
      h$ = substr code$ i 1
      if h$ = "["
         br += 1
      elif h$ = "]"
         br -= 1
      .
      if br < 0
         return 0
      .
   .
   return if br = 0
.
repeat
   inp$ = input
   until inp$ = ""
   code$ &= inp$
.
if syntax code$ <> 1
   print "syntax error"
   return
.
exec code$
# 
input_data
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>
---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.

Elena

Implementation in Elena

Erlang

Implementation in Erlang.

F#

Implementation in F#.

Factor

Factor comes with a Brainf*** interpreter. See the implementation here.

Works with: Factor version 0.99 2020-07-03
USE: brainf***

"++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++." run-brainf***
Output:
Hello World!

Forth

Implementation in Forth.

Fortran

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

Interpreter

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

The PROG variable could also be regarded as an array of single characters, but such an array is not a suitable candidate for a text literal such as initialises HELLOWORLD.

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

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

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

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

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

      END	!Enough.

Output:

Hello World!

Compiler

Well, really a translator, as it translates the Brain*uck code into Fortran statements. This is relatively straightforward because the source code does not change and a simple translation scheme is possible. The standard problem with compilation is provided by forward references, specifically that the destination of a forwards jump is at an address that cannot be known until the code up to it has been produced. This can be handled in many ways, for instance with two passes where the first locates all the destinations so that the second can refer to them when generating code. Another method involves a "fixup table", whereby a record is kept of the locations of all leaps to as-yet unknown destinations, and when later those destinations are determined, the compiler goes back and fixes the destination fields. This all requires additional storage, in unknown amounts depending on the source being compiled.

The problem can be dodged with systems that generate say assembler source (or in this case, Fortran source) by developing some scheme for generating and using labels, merely placing them at the appropriate locations. The subsequent assembly (or Fortran compilation) will deal with these forwards references in its own way. The plan here is to recognise that a [...] sequence generates two labels, one at the location of the [ and the other at the ]. That's two labels per pair, so, count the labels and use an odd number for the [ LABEL = 2*NLABEL - 1 and the corresponding even number for the ], then keep in mind which is used at which end. Because a [...] sequence can contain nested [...] sequences, a stack is needed to keep track, and so, why not indent the source accordingly? On the other hand, there is no attempt at checking that the [...] bracketing is correct, and run-time checking that the data pointer remains within bounds is left to the Fortran compiler.

Since the increment and decrement instructions are often repeated, it is simple enough to scan ahead and count up the repetitions via a function (that also manipulates its environment), and convert a sequence of operations into a single operation. Thus, this is an optimising Brain*uck compiler!

The source involves adding a subroutine to the module and an extended main line for testing:

        SUBROUTINE BRAINFORT(PROG,N,INF,OUF,F)	!Stand strong!
Converts the Brain*uck in PROG into the equivalent furrytran source...
         CHARACTER*(*) PROG	!The Brain*uck source.
         INTEGER N		!A size for the STORE.
         INTEGER INF,OUF,F	!I/O unit numbers.
         INTEGER L		!A stepper.
         INTEGER LABEL,NLABEL,INDEEP,STACK(66)	!Labels cause difficulty.
         CHARACTER*1 C		!The operation of the moment.
         CHARACTER*36 SOURCE	!A scratchpad.
          WRITE (F,1) PROG,N	!The programme heading.
    1     FORMAT (6X,"PROGRAM BRAINFORT",/,	!Name it.
     1     "Code: ",A,/				!Show the provenance.
     2     6X,"CHARACTER*1 STORE(",I0,")",/	!Declare the working memory.
     3     6X,"INTEGER D",/			!The finger to the cell of the moment.
     4     6X,"STORE = CHAR(0)",/		!Clear to nulls, not spaces.
     5     6X,"D = 1",/)			!Start the data finger at the first cell.
          NLABEL = 0		!No labels seen.
          INDEEP = 0		!So, the stack is empty.
          LABEL = 0		!And the current label is absent.
          L = 1			!Start at the start.
Chug through the PROG.
          DO WHILE(L.LE.LEN(PROG))	!And step through to the end.
            C = PROG(L:L)		!The code of the moment.
            SELECT CASE(C)		!What to do?
             CASE(">")			!Move the data finger forwards one.
              WRITE (SOURCE,2) "D = D + ",RATTLE(">")	!But, catch multiple steps.
             CASE("<")			!Move the data finger back one.
              WRITE (SOURCE,2) "D = D - ",RATTLE("<")	!Rather than a sequence of one steps.
             CASE("+")			!Increment the fingered datum by one.
              WRITE (SOURCE,2) "STORE(D) = CHAR(ICHAR(STORE(D)) + ",	!Catching multiple increments.
     1         RATTLE("+"),")"						!And being careful over the placement of brackets.
             CASE("-")			!Decrement the fingered datum by one.
              WRITE (SOURCE,2) "STORE(D) = CHAR(ICHAR(STORE(D)) - ",	!Catching multiple decrements.
     1         RATTLE("-"),")"						!And closing brackets.
             CASE(".")			!Write a character.
              WRITE (SOURCE,2) "WRITE (",OUF,",'(A1,$)') STORE(D)"	!Using the given output unit.
             CASE(",")			!Read a charactger.
              WRITE (SOURCE,2) "READ (",INF,",'(A1)') STORE(D)"		!And the input unit.
             CASE("[")			!A label!
              NLABEL = NLABEL + 1		!Labels come in pairs due to [...]
              LABEL = 2*NLABEL - 1		!So this belongs to the [.
              INDEEP = INDEEP + 1		!I need to remember when later the ] is encountered.
              STACK(INDEEP) = LABEL + 1		!This will be the other label.
              WRITE (SOURCE,2) "IF (ICHAR(STORE(D)).EQ.0) GO TO ",	!So, go thee, therefore.
     1         STACK(INDEEP)			!Its placement will come, all going well.
             CASE("]")			!The end of a [...] pair.
              LABEL = STACK(INDEEP)		!This was the value of the label to be, now to be placed.
              WRITE (SOURCE,2) "IF (ICHAR(STORE(D)).NE.0) GO TO ",	!The conditional part
     1         LABEL - 1			!The branch back destination is known by construction.
              INDEEP = INDEEP - 1		!And we're out of the [...] sequence's consequences.
             CASE DEFAULT		!All others are ignored.
              SOURCE = "CONTINUE"		!So, just carry on.
            END SELECT			!Enough of all that.
    2       FORMAT (A,I0,A)	!Text, an integer, text.
Cast forth the statement.
            IF (LABEL.LE.0) THEN	!Is a label waiting?
              WRITE (F,3) SOURCE		!No. Just roll the source.
    3         FORMAT (<6 + 2*MIN(12,INDEEP)>X,A)!With indentation.
             ELSE			!But if there is a label,
              WRITE (F,4) LABEL,SOURCE		!Slightly more complicated.
    4         FORMAT (I5,<1 + 2*MIN(12,INDEEP)>X,A)	!I align my labels rightwards...
              LABEL = 0				!It is used.
            END IF			!So much for that statement.
            L = L + 1		!Advance to the next command.
          END DO		!And perhaps we're finished.

Closedown.
          WRITE (F,100)		!No more source.
  100     FORMAT (6X,"END")	!So, this is the end.
         CONTAINS	!A function with odd effects.
          INTEGER FUNCTION RATTLE(C)	!Advances thrugh multiple C, counting them.
           CHARACTER*1 C	!The symbol.
            RATTLE = 1		!We have one to start with.
    1       IF (L.LT.LEN(PROG)) THEN	!Further text to look at?
              IF (PROG(L + 1:L + 1).EQ.C) THEN	!Yes. The same again?
              	L = L + 1		!Yes. Advance the finger to it.
                RATTLE = RATTLE + 1	!Count another.
                GO TO 1			!And try again.
              END IF			!Rather than just one at a time.
            END IF			!Curse the double evaluation of WHILE(L < LEN(PROG) & ...)
          END FUNCTION RATTLE	!Computers excel at counting.
        END SUBROUTINE BRAINFORT!Their only need be direction as to what to count...
      END MODULE BRAIN	!Simple in itself.

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

      STORE = CHAR(0)	!Scrub.

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

      OPEN (F,FILE="BrainFort.for",STATUS="REPLACE",ACTION="WRITE")
      CALL BRAINFORT(HELLOWORLD,30000,KBD,MSG,F)
      END	!Enough.

And the output is...

      PROGRAM BRAINFORT
Code: ++++++++[>++++[>++>+++>+++>+<<<<-] >+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
      CHARACTER*1 STORE(30000)
      INTEGER D
      STORE = CHAR(0)
      D = 1

      STORE(D) = CHAR(ICHAR(STORE(D)) + 8)
    1   IF (ICHAR(STORE(D)).EQ.0) GO TO 2   
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 4)
    3     IF (ICHAR(STORE(D)).EQ.0) GO TO 4   
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 2)
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
          D = D + 1                           
          STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
          D = D - 4                           
          STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
    4   IF (ICHAR(STORE(D)).NE.0) GO TO 3   
        CONTINUE                            
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
        D = D + 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
        D = D + 2                           
        STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
    5     IF (ICHAR(STORE(D)).EQ.0) GO TO 6   
          D = D - 1                           
    6   IF (ICHAR(STORE(D)).NE.0) GO TO 5   
        D = D - 1                           
        STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
    2 IF (ICHAR(STORE(D)).NE.0) GO TO 1   
      D = D + 2                           
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 1                           
      STORE(D) = CHAR(ICHAR(STORE(D)) - 3)
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) + 7)
      WRITE (6,'(A1,$)') STORE(D)         
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 2                           
      WRITE (6,'(A1,$)') STORE(D)         
      D = D - 1                           
      STORE(D) = CHAR(ICHAR(STORE(D)) - 1)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D - 1                           
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) + 3)
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) - 6)
      WRITE (6,'(A1,$)') STORE(D)         
      STORE(D) = CHAR(ICHAR(STORE(D)) - 8)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 2                           
      STORE(D) = CHAR(ICHAR(STORE(D)) + 1)
      WRITE (6,'(A1,$)') STORE(D)         
      D = D + 1                           
      STORE(D) = CHAR(ICHAR(STORE(D)) + 2)
      WRITE (6,'(A1,$)') STORE(D)         
      END

Which, when compiled and run, produces...

Hello World!

In a transcription error, I included a space in the Brain*uck code, which was of course ignored by the interpreter. The compiler initially spat out

  4   IF (ICHAR(STORE(D)).NE.0) GO TO 3  
      IF (ICHAR(STORE(D)).NE.0) GO TO 3

because the CASE statement was followed by writing SOURCE out and the no-op had not changed it; the Fortran compiler made no complaint about the obviously pointless replication. So much for its analysis. For such "no-op" codes, fortran's CONTINUE statement is an obvious "no action" match.

Furor

argc 3 < { ."Usage: furor brainfuck.upu brainfuckpgmfile\n" }{
2 argv getfile // dup #s print free
sto bfpgm
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
tick sto startingtick
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem free // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g @bfpgm~ !{ rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero p zero m // Indexregiszterek lenullázása (inicializálás)
((( @p @bfpgm~ < )
§jumpingtable "+-<>[].,"
@[]bfpgm @p // Az épp aktuális brainfuck utasítás kódja
switch // Ugrás a megfelelő brainfuck funkció rutinjára
____: inc p (<) // default action
_3c_: @m !{ rts } dec m goto §____ // <
_3e_: @m @bfmem~ >= { rts } inc m goto §____ // >
_2b_: #c @[++]bfmem @m #g    goto §____ // +
_2d_: #c @[--]bfmem @m #g    goto §____ // -
_2c_: @bfmem @m getchar [^]  goto §____
_2e_: @[]bfmem @m printchar  goto §____
_5b_: @[]bfmem @m then §____
          zero d @p ++ @bfpgm~ {||
          {} []@bfpgm '[ == { inc d {<} }
          {} []@bfpgm '] == { @d !{ {+} sto p {>} } dec d }
|} (<)
_5d_: zero d 1 @p {|| {-} []@bfpgm '] == { inc d {<} }
      {-} []@bfpgm '[ == { @d !{ {} !sum p {>} } dec d }
|} (<)
)) rts
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „p” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „m” /* index a brainfuck memóriaterületre */ }
{ „d” /* munkaváltozó */ }
// ========================================
jumpingtable:
// +    -     <     >     [     ]     .     ,
§_2b_ §_2d_ §_3c_ §_3e_ §_5b_ §_5d_ §_2e_ §_2c_

Yet another solution:

###sysinclude stringextra.uh
argc 3 < { ."Usage: furor brainfuck.upu brainfuckpgmfile\n" }{
2 argv getfile
sto bfpgm
bfpgm '< >><<
bfpgm '> >><<
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
tick sto startingtick
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem free // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g @bfpgm~ !{ rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero p zero m // Indexregiszterek lenullázása (inicializálás)
((( @p @bfpgm~ < )
@p *2 [#n]@bfpgm // Az épp aktuális brainfuck utasítás kódja
§jumpingtable[] [goto] // Ugrás a megfelelő brainfuck funkció rutinjára

____: inc p (<)

_3c_: @m !{ rts }           @[]bfpgm @p 32 >> !sum m goto §____ // <
_3e_: @m @bfmem~ >= { rts } @[]bfpgm @p 32 >>  sum m goto §____ // >

_2b_: #c @[++]bfmem @m #g    goto §____ // +
_2d_: #c @[--]bfmem @m #g    goto §____ // -
_2c_: @bfmem @m getchar [^]  goto §____
_2e_: @[]bfmem @m printchar  goto §____
_5b_: @[]bfmem @m then §____
          zero d @p ++ @bfpgm {~|
          @@ '[ == { inc d {<} }
          @@ '] == { @d !{ {+} sto p {>} } dec d }
|} (<)

_5d_: zero d 1 @p {|| {-} []@bfpgm '] == { inc d {<} }
      {-} []@bfpgm '[ == { @d !{ {} !sum p {>} } dec d }
|} (<)
)) rts
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „p” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „m” /* index a brainfuck memóriaterületre */ }
{ „d” /* munkaváltozó */ }
// ========================================
jumpingtable:
//         00    01    02    03    04    05    06    07    08    09    0a    0b    0c    0d    0e    0f
/* 00 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 01 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 02 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_2b_ §_2c_ §_2d_ §_2e_ §____
/* 03 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_3c_ §____ §_3e_ §____
/* 04 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 05 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_5b_ §____ §_5d_ §____ §____
/* 06 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 07 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 08 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 09 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0a */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0b */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0c */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0d */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0e */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0f */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____

Peri

###sysinclude standard.uh
###sysinclude args.uh
###sysinclude str.uh
###sysinclude io.uh

#g argc 3 < { ."Usage: peri brainfuck02.upu brainfuckfile\n" }{
2 argv getfile
sto bfpgm
tick sto startingtick
@bfpgm '< >><<
@bfpgm '> >><<
@bfpgm '+ >><<
@bfpgm '- >><<
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem inv mem // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g bfpgm~ inv { rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero pp zero mm // Indexregiszterek lenullázása (inicializálás)
mainloop:
@pp bfpgm~ >= { rts }
@bfpgm @pp [] // Az épp aktuális brainfuck utasítás kódja
$ffffffff &
goto §jumpingtable[] // Ugrás a megfelelő brainfuck funkció rutinjára

____: ++() pp goto §mainloop
_3c_: @mm inv       { rts } @bfpgm @pp [] 32 >> inv sum mm goto §____ // <
_3e_: @mm bfmem~ >= { rts } @bfpgm @pp [] 32 >>     sum mm goto §____ // >
_2b_: @bfmem @mm [] @bfpgm @pp [] 32 >> #c + goto §minusba // +
_2d_: @bfmem @mm [] @bfpgm @pp [] 32 >> #c - minusba: @bfmem @mm inv rot inv [] #g goto §____ // -
_2c_: @bfmem @mm getchar inv []  goto §____
_2e_: @bfmem @mm [] printchar goto §____
_5b_: @bfmem @mm [] then §____
          zero dd @pp ++ bfpgm~ {{ ,
          @bfpgm {{}} [] '[ == { ++() dd {{<}} }
          @bfpgm {{}} [] '] == { @dd inv { {{+}}  sto pp {{>}} } --() dd }
}} goto §mainloop

_5d_: zero dd 1 @pp {{ , @bfpgm {{-}} [] '] == { ++() dd {{<}} }
      @bfpgm {{-}} [] '[ == { @dd inv { {{}}  inv sum pp {{>}} } --() dd }
}} goto §mainloop
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „pp” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „mm” /* index a brainfuck memóriaterületre */ }
{ „dd” /* munkaváltozó */ }
// ========================================
jumpingtable:
//         00    01    02    03    04    05    06    07    08    09    0a    0b    0c    0d    0e    0f
/* 00 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 01 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 02 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_2b_ §_2c_ §_2d_ §_2e_ §____
/* 03 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_3c_ §____ §_3e_ §____
/* 04 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 05 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §_5b_ §____ §_5d_ §____ §____
/* 06 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 07 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 08 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 09 */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0a */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0b */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0c */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0d */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0e */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____
/* 0f */ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____ §____

Yet another solution:

###sysinclude standard.uh
###sysinclude args.uh
###sysinclude str.uh
###sysinclude io.uh

#g argc 3 < { ."Usage: peri brainfuck02.upu brainfuckfile\n" }{
2 argv getfile
sto bfpgm
tick sto startingtick
@bfpgm '< >><<
@bfpgm '> >><<
@bfpgm '+ >><<
@bfpgm '- >><<
100000 mem dup maximize sto bfmem // Memóriaallokáció a brainfuck memóriaterület számára
sbr §brainfuck
NL
tick @startingtick #g - ."Time = " print ." tick\n"
@bfmem inv mem // A lefoglalt munkamemória felszabadítása
}
end
// ===================================================
brainfuck:
#g bfpgm~ inv { rts } // Ha nulla a brainfuck progi hossza, semmit se kell csinálni.
zero pp zero mm // Indexregiszterek lenullázása (inicializálás)

switchlabel:
switch "<>+-,.[]" §_3c_ §_3e_ §_2b_ §_2d_ §_2c_ §_2e_ §_5b_ §_5d_
mainloop:
safe case#c bfpgm[pp] §rtslabel   // Ugrás a megfelelő brainfuck funkció rutinjára
____: ++() pp goto §mainloop
_3c_: safe bfpgm[pp] §rtslabel hilo inv sum mm goto §____ // <
_3e_: safe bfpgm[pp] §rtslabel hilo     sum mm goto §____ // >
_2b_: bfpgm[pp] hilo safe     sum#c bfmem[mm] §safelabel goto §____ // +
_2d_: bfpgm[pp] hilo safe inv sum#c bfmem[mm] §safelabel goto §____ // -
_2c_: getchar safe inv bfmem[mm] §rtslabel goto §____
_2e_: safe bfmem[mm] §rtslabel printchar   goto §____
_5b_: safe bfmem[mm] §rtslabel then §____
      switch "[]" §lbl5b0 §lbl5b1
      zero dd @pp ++ bfpgm {~ ,
      {~?~} case
      {~<~}
      lbl5b0: ++() dd {~<~}
      lbl5b1: @dd inv { {~+~}  sto pp goto §switchlabel } --() dd
~} goto §switchlabel

_5d_: switch "[]" §lbl5d0 §lbl5d1
      zero dd 1 @pp {{ ,
      bfpgm[{{-}}] case
      {{<}}
      lbl5d1: ++() dd {{<}}
      lbl5d0: @dd inv { {{}} inv sum pp goto §switchlabel } --() dd
}} goto §switchlabel
rtslabel: rts
safelabel: ."Wrong program!" end
// ===================================================
{ „startingtick” }
{ „bfpgm” }
{ „bfmem” }
{ „pp” /* index az épp végrehajtandó brainfuck mnemonikra */ }
{ „mm” /* index a brainfuck memóriaterületre */ }
{ „dd” /* munkaváltozó */ }
// ===================================================

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

Go

Fixed size data store, no bounds checking.

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--
                    }
                }
            }
        }
    }
}
Output:
Goodbye, World!

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 String.valueOf(Character.toChars(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')
    }
}

Testing:

new BrainfuckProgram(program: '++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.').execute()
Output:
Hello World!


Haskell

Implementation in Haskell.

Icon and Unicon

Implementation in Icon/Unicon.

J

Implementation in J.

Janet

Implementation in Janet.

Java

Implementation in Java.

Another implementation:

import java.io.IOException;

public class Interpreter {

    public final static int MEMORY_SIZE = 65536;

    private final char[] memory = new char[MEMORY_SIZE];
    private int dp;
    private int ip;
    private int border;

    private void reset() {

        for (int i = 0; i < MEMORY_SIZE; i++) {
            memory[i] = 0;
        }
        ip = 0;
        dp = 0;
    }

    private void load(String program) {

        if (program.length() > MEMORY_SIZE - 2) {
            throw new RuntimeException("Not enough memory.");
        }

        reset();

        for (; dp < program.length(); dp++) {
            memory[dp] = program.charAt(dp);
        }

        // memory[border] = 0 marks the end of instructions. dp (data pointer) cannot move lower than the
        // border into the program area.
        border = dp;

        dp += 1;
    }

    public void execute(String program) {

        load(program);
        char instruction = memory[ip];

        while (instruction != 0) {

            switch (instruction) {
                case '>':
                    dp++;
                    if (dp == MEMORY_SIZE) {
                        throw new RuntimeException("Out of memory.");
                    }
                    break;
                case '<':
                    dp--;
                    if (dp == border) {
                        throw new RuntimeException("Invalid data pointer.");
                    }
                    break;
                case '+':
                    memory[dp]++;
                    break;
                case '-':
                    memory[dp]--;
                    break;
                case '.':
                    System.out.print(memory[dp]);
                    break;
                case ',':
                    try {
                        // Only works for one byte characters.
                        memory[dp] = (char) System.in.read();
                    } catch (IOException e) {
                        throw new RuntimeException(e);
                    }
                    break;
                case '[':
                    if (memory[dp] == 0) {
                        skipLoop();
                    }
                    break;
                case ']':
                    if (memory[dp] != 0) {
                        loop();
                    }
                    break;
                default:
                    throw new RuntimeException("Unknown instruction.");
            }

            instruction = memory[++ip];
        }
    }

    private void skipLoop() {

        int loopCount = 0;

        while (memory[ip] != 0) {
            if (memory[ip] == '[') {
                loopCount++;
            } else if (memory[ip] == ']') {
                loopCount--;
                if (loopCount == 0) {
                    return;
                }
            }
            ip++;
        }

        if (memory[ip] == 0) {
            throw new RuntimeException("Unable to find a matching ']'.");
        }
    }

    private void loop() {

        int loopCount = 0;

        while (ip >= 0) {
            if (memory[ip] == ']') {
                loopCount++;
            } else if (memory[ip] == '[') {
                loopCount--;
                if (loopCount == 0) {
                    return;
                }
            }
            ip--;
        }

        if (ip == -1) {
            throw new RuntimeException("Unable to find a matching '['.");
        }
    }

    public static void main(String[] args) {

        Interpreter interpreter = new Interpreter();
        interpreter.execute(">++++++++[-<+++++++++>]<.>>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.>->+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+.");
    }
}

JavaScript

Implementation in JavaScript.

Jsish

Part of the Jsi source kit unit tests. bf code from Hello World/text task entry.

/*
 * javascript bf interpreter
 * by wenxichang@163.com
 */

function execute(code)
{
    var mem = new Array(30000);
    var sp = 10000;
    var opcode = new String(code);
    var oplen = opcode.length;
    var ip = 0;
    var loopstack = new Array();
    var output = "";
    
    for (var i = 0; i < 30000; ++i) mem[i] = 0;
    
    while (ip < oplen) {
        switch(opcode[ip]) {
            case '+':
                mem[sp]++;
                break;
            case '-':
                mem[sp]--;
                break;
            case '>':
                sp++;
                break;
            case '<':
                sp--;
                break;
            case '.':
                if (mem[sp] != 10 && mem[sp] != 13) {
                    output = output + Util.fromCharCode(mem[sp]);
                } else {
                    puts(output);
                    output = "";
                }
                break;
            case ',':
                var s = console.input();
                if (!s) exit(0);
                
                mem[sp] = s.charCodeAt(0);
                break;
            case '[':
                if (mem[sp]) {
                    loopstack.push(ip);
                } else {
                    for (var k = ip, j = 0; k < oplen; k++) {
                        opcode[k] == '[' && j++;
                        opcode[k] == ']' && j--;
                        if (j == 0) break;
                    }
                    if (j == 0) ip = k;
                    else {
                        puts("Unmatched loop");
                        return false;
                    }
                }
                break;
            case ']':
                ip = loopstack.pop() - 1;
                break;
            default:
                break;
        }
        ip++;
    }
    return true;
};

if (Interp.conf('unitTest') > 0)  execute('
    ++++++++++[>+>+++>++++>+++++++ >++++++++>+++++++++>++++++++++>+++++++++
    ++>++++++++++++<<<<<<<<<-]>>>>+.>>>>+..<.<++++++++.>>>+.<<+.<<<<++++.<+
    +.>>>+++++++.>>>.+++.<+++++++.--------.<<<<<+.<+++.---.
');
Output:
prompt$ jsish --U bf.jsi
Goodbye, World!

Julia

Works with: Julia version 0.6
Translation of: Python
using DataStructures

function execute(src)
    pointers = Dict{Int,Int}()
    stack    = Int[]
    for (ptr, opcode) in enumerate(src)
        if opcode == '[' push!(stack, ptr) end
        if opcode == ']'
            if isempty(stack)
                src = src[1:ptr]
                break
            end
            sptr = pop!(stack)
            pointers[ptr], pointers[sptr] = sptr, ptr
        end
    end
    if ! isempty(stack) error("unclosed loops at $stack") end
    tape = DefaultDict{Int,Int}(0)
    cell, ptr = 0, 1
    while ptr  length(src)
        opcode = src[ptr]
        if     opcode == '>' cell += 1
        elseif opcode == '<' cell -= 1
        elseif opcode == '+' tape[cell] += 1
        elseif opcode == '-' tape[cell] -= 1
        elseif opcode == ',' tape[cell] = Int(read(STDIN, 1))
        elseif opcode == '.' print(STDOUT, Char(tape[cell]))
        elseif (opcode == '[' && tape[cell] == 0) ||
               (opcode == ']' && tape[cell] != 0) ptr = pointers[ptr]
        end
        ptr += 1
    end
end

const src = """\
    >++++++++[<+++++++++>-]<.>>+>+>++>[-]+<[>[->+<<++++>]<<]>.+++++++..+++.>
    >+++++++.<<<[[-]<[-]>]<+++++++++++++++.>>.+++.------.--------.>>+.>++++."""
execute(src)
Output:
Hello World!

Kotlin

Translation of: Groovy
// version 1.1.2

class Brainf__k(val prog: String, memSize: Int) {
    private val mem = IntArray(memSize)
    private var ip = 0
    private var dp = 0
    private val memVal get() = mem.getOrElse(dp) { 0 }

    fun execute() {
        while (ip < prog.length) {
            when (prog[ip++]) {
                '>' -> dp++
                '<' -> dp--
                '+' -> mem[dp] = memVal + 1
                '-' -> mem[dp] = memVal - 1
                ',' -> mem[dp] = System.`in`.read()
                '.' -> print(memVal.toChar())
                '[' -> handleLoopStart()
                ']' -> handleLoopEnd()
            }
        }
    }

    private fun handleLoopStart() {
        if (memVal != 0) return
        var depth = 1
        while (ip < prog.length) {
            when (prog[ip++]) {
                '[' -> depth++
                ']' -> if (--depth == 0) return
            }
        }
        throw IllegalStateException("Could not find matching end bracket")
    }

    private fun handleLoopEnd() {
        var depth = 0
        while (ip >= 0) {
            when (prog[--ip]) {
                ']' -> depth++
                '[' -> if (--depth == 0) return
            }
        }
        throw IllegalStateException("Could not find matching start bracket")
    }
}

fun main(args: Array<String>) {
    val prog = "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."
    Brainf__k(prog, 10).execute()
}
Output:
Hello World!

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.

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++;
	}
}
Output:

Using the example code from Hello world/Text:

% bf '++++++++++[>+>+++>++++>+++++++>++++++++>+++++++++>++
++++++++>+++++++++++>++++++++++++<<<<<<<<<-]>>>>+.>>>
>+..<.<++++++++.>>>+.<<+.<<<<++++.<++.>>>+++++++.>>>.+++.
<+++++++.--------.<<<<<+.<+++.---.'
Goodbye, World!

Lua

Implementation in Lua.

Simple meta-implementation using load

local funs = {
['>'] = 'ptr = ptr + 1; ',
['<'] = 'ptr = ptr - 1; ',
['+'] = 'mem[ptr] = mem[ptr] + 1; ',
['-'] = 'mem[ptr] = mem[ptr] - 1; ',
['['] = 'while mem[ptr] ~= 0 do ',
[']'] = 'end; ',
['.'] = 'io.write(string.char(mem[ptr])); ',
[','] = 'mem[ptr] = (io.read(1) or "\\0"):byte(); ',
}

local prog = [[
  local mem = setmetatable({}, { __index = function() return 0 end})
  local ptr = 1
]]

local source = io.read('*all')

for p = 1, #source do
  local snippet = funs[source:sub(p,p)]
  if snippet then prog = prog .. snippet end
end

load(prog)()

BTW very fast, considering how simple it is.

M2000 Interpreter

Module Checkit {
      \\ Brain**** Compiler
      
      Escape Off
      \\ no Esc function so we can use Ctrl+Z when input characters to terminate BF
      \\ ctrl+c open dialog for exit - by default in console mode
      
      Const skipmonitor as boolean=true, output as boolean=True
      Const ob$="{",cb$="}"
      Gosub CallOne
      \\ We use a group object with events.
      
      Group WithEvents BF=BrainF()
      
      Function BF_monitor {
            \\ Event functions have same scope as the module where belong
            If skipmonitor Then exit
            Read New pc, mem
            Print pc, mem
            Print "Press space bar": While Key$<>" " {}
      }
      Function BF_newline {
            If not skipmonitor then Print "newline" : exit
            if output then Print
      }
      Function BF_print {
            Read New c$
            If not skipmonitor then Print "character:";c$  : exit
            if output then Print c$;
      }
      
      Program$ = {++++++[>++++++++++++<-]>.
                  >++++++++++[>++++++++++<-]>+.
                  +++++++..+++.>++++[>+++++++++++<-]>.
                  <+++[>----<-]>.<<<<<+++[>+++++<-]>.
                  >>.+++.------.--------.>>+.
                  }
      Report Program$
      ExecBF(Program$)
      End
      
      Sub ExecBF(Code$)
            ClearMem()
            code$=filter$(code$, " "+chr$(10)+chr$(13))
            code$<=replace$(".","@", code$)
            code$<=replace$("-","-.D()", code$)
            code$<=replace$("+","-.A()", code$)
            code$<=replace$("<","-.L()", code$)
            code$<=replace$(">","-.R()", code$)
            code$<=replace$("@","-.P()", code$)
            code$<=replace$("[","-.S("+ob$,code$)
            code$<=replace$("]",cb$+")",code$)
            code$<=replace$(",","-.K()", code$)
            Rem : Print code$
            BF.Eval code$
            Print
      End Sub
      Sub ClearMem()
            Dim cMem(1 to 30000)=0
            For BF {
                  .Pc=1
                  .Zero=True
                  .Mem()=cMem()
            }
      End Sub
      CallOne:
      Class BrainF {
            events "monitor", "newline", "print"
            Dim Mem()
            Pc=1, Zero as Boolean=True
            Module UpdateZero {
                  .Zero<=.Mem(.Pc)=0
                  call event "monitor", .pc, .Mem(.pc)
            }
            Function A {   \\ +
                  .Mem(.Pc)++ 
                  .UpdateZero
            }
            Function D {  \\ -
                  .Mem(.Pc)-- 
                  .UpdateZero
            }
            Function R { \\ >
                  If .Pc=30000 Then Error "Upper Bound Error"
                  .Pc++
                  .UpdateZero
            }
            Function L { \\ <
                  If .Pc=1 Then Error "Lower Bound Error"
                  .Pc--
                  .UpdateZero
            }
            Function P { \\ .
                  Select Case .Mem(.Pc)
                  Case >31
                        Call Event "print", Chr$(.Mem(.Pc))
                  Case 10
                        Call Event "newline"
                  End Select
            }
            Function K {  \\ ,
                  .Mem(.Pc)=Asc(Key$)
                  \\ ctrl+z for exit
                  If .Mem(.Pc)=26 Then  Error "Finished"
                   .UpdateZero
            }
            Function S  { \\ [  
                  If .Zero then =0: exit
                  Read newEval$
                  Do {ret=Eval(newEval$)} until .Zero
            }
            Module Eval {
                  ret=eval(Letter$)
            }
      }
      Return
}
Checkit

Mathematica / Wolfram Language

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[p[[pp]],
        ">", 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[p[[pp]], "[", bc++, "]", bc--]]],
        "]", If[m[mp] != 0,
          bc = -1; 
          While[bc < 0, pp--; Switch[p[[pp]], "[", bc++, "]", bc--]]]]];
    Close[instr];];
bf[program_] := bf[program, ""]

Example:

bf["++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.
<<+++++++++++++++.>.+++.------.--------.>+.>."]
Output:
Hello World!

Miranda

#!/usr/bin/mira -exec
main :: [sys_message]
main = (interpret . read . hd . tl) $*

interpret :: [char]->[sys_message]
interpret prog = msgs where (tape, inp, msgs) = run empty_tape $- (parse prog)

instr ::= Left | Right | Inc | Dec | Read | Write | Loop [instr]

run :: tape->[char]->[instr]->(tape,[char],[sys_message])
run tape inp [] = (tape, inp, [])
run tape inp (instr:instrs)
    = (tape'', inp'', sysmsg ++ sysmsgs)
      where (tape', inp', sysmsg) = step tape inp instr
            (tape'', inp'', sysmsgs) = run tape' inp' instrs

step :: tape->[char]->instr->(tape,[char],[sys_message])
step tape inp Left        = (left tape,        inp,  [])
step tape inp Right       = (right tape,       inp,  [])
step tape inp Inc         = (apply (+1) tape,  inp,  [])
step tape inp Dec         = (apply (+-1) tape, inp,  [])
step tape inp Read        = (setval ch tape,   inp', [])
                            where (ch, inp') = getchar inp
step tape inp Write       = (tape, inp, [Stdout (decode (val tape):[])])
step tape inp (Loop prog) = (tape, inp, []), if val tape = 0
                          = (tape'', inp'', sysmsgs ++ sysmsgs'), otherwise
                            where (tape', inp', sysmsgs) = run tape inp prog
                                  (tape'', inp'', sysmsgs') = step tape' inp' (Loop prog)

getchar :: [char]->(num,[char])
getchar []     = (0, [])
getchar (x:xs) = (code x, xs)

parse :: [char] -> [instr]
parse [] = []
parse instrs
    = Left      : rest, if tok="<"
    = Right     : rest, if tok=">"
    = Inc       : rest, if tok="+"
    = Dec       : rest, if tok="-"
    = Read      : rest, if tok=","
    = Write     : rest, if tok="."
    = Loop loop : rest, if hd tok='['
    = rest,             otherwise
      where (tok, next) = token instrs
            rest = parse next
            loop = parse (init (tl tok))

token :: [char] -> ([char],[char])
token [] = ([],[])
token (']':xs) = error "] without ["
token ('[':xs) = ('[':l, rs) where (l, rs) = getloop xs
token (x:xs)   = (x:[], xs)

getloop :: [char] -> ([char],[char])
getloop = g 0
          where g 0 (']':xs) = ("]", xs)
                g n ('[':xs) = ('[':l,rs) where (l,rs) = g (n+1) xs
                g n (']':xs) = (']':l,rs) where (l,rs) = g (n-1) xs
                g n (x:xs)   = (x:l,rs) where (l,rs) = g n xs
                g n []       = error "[ without ]"

tape ::= Tape [num] num [num]

empty_tape :: tape
empty_tape = Tape [] 0 []

left :: tape->tape
left (Tape ls c [])      = Tape (c:ls) 0 []
left (Tape ls c (r:rs))  = Tape (c:ls) r rs

right :: tape->tape
right (Tape [] c rs)     = Tape [] 0 (c:rs)
right (Tape (l:ls) c rs) = Tape ls l (c:rs)

apply :: (num->num)->tape->tape
apply fn (Tape ls c rs)  = Tape ls (fn c mod 256) rs

val :: tape->num
val (Tape ls c rs) = c

setval :: num->tape->tape
setval v (Tape ls c rs) = Tape ls v rs

Modula-3

Implementation in Modula-3.

Nanoquery

// nanoquery has no function to get just a character
// so we have to implement our own
def get_char()
    c = ""
    while len(c)=0
        c = input()
    end
    return c[0]
end

// a function to handle fatal errors
def fatal_error(errtext)
    println "%" + errtext
    println "usage: " + args[1] + " [filename.bf]"
    exit
end
 
// get a filename from the command line and read the file in
fname = null
source = null
try
    fname = args[2]
    source = new(Nanoquery.IO.File, fname).readAll()
catch
    fatal_error("error while trying to read from specified file")
end

// start with one hundred cells and the pointer at 0
cells = {0} * 100
ptr   = 0

// loop through the instructions
loc = 0
while loc < len(source)
        instr = source[loc]
        
        if instr = ">"
                ptr += 1
                if ptr = len(cells)
                        cells.append(0)
                end
        else if instr = "<"
                ptr -= 1
                if ptr < 0
                        ptr = 0
                end
        else if instr = "+"
                cells[ptr] += 1
        else if instr = "-"
                cells[ptr] -= 1
        else if instr = "."
                print chr(cells[ptr])
        else if instr = ","
                cells[ptr] = ord(get_char())
        else if instr = "["
                if cells[ptr] = 0
                        while source[loc] != "]"
                                loc += 1
                        end
                end
        else if instr = "]"
                if cells[ptr] != 0
                        while source[loc] != "["
                                loc -= 1
                        end
                end
        else
                // do nothing
        end

        loc += 1
end

Never

record BFI
{
    cmd : char;
    next : BFI;
    jmp : BFI;
}

record MEM
{
    val : int;
    next : MEM;
    prev : MEM;
}

func compile(prog : string) -> BFI
{
    var i = 0;
    var n = BFI;
    var p = BFI;
    var j = BFI;
    var pgm = BFI;
    
    for (i = 0; i < length(prog); i = i + 1) {
        n = BFI('0', nil, nil);
    
        if (p != nil) {
            p.next = n
        } else {
            pgm = n
        };
        
        n.cmd = prog[i];
        p = n;
    
        if (prog[i] == '[') {
            n.jmp = j;
            j = n;
            0
        } else if (prog[i] == ']') {
            n.jmp = j;
            j = j.jmp;
            n.jmp.jmp = n;
            0
        } else {
            0
        }
    };
    
    pgm
}

func exec(pgm : BFI) -> int
{
    var m = MEM(0, nil, nil);
    var n = BFI;

    for (n = pgm; n != nil; n = n.next) {
        if (n.cmd == '+') {
            m.val = m.val + 1
        } else if (n.cmd == '-') {
            m.val = m.val - 1
        } else if (n.cmd == '.') {
            printc(chr(m.val));
            0
        } else if (n.cmd == ',') {
            m.val = read()
        } else if (n.cmd == '[') {
            if (m.val == 0) {
                n = n.jmp;
                0
            } else {
                0
            }
        } else if (n.cmd == ']') {
            if (m.val != 0) {
                n = n.jmp;
                0
            } else {
                0
            }
        } else if (n.cmd == '<') {
            m = m.prev;
            0
        } else if (n.cmd == '>') {
            if (m.next == nil) {
                m.next = MEM(0, nil, nil);
                m.next.prev = m;
                0
            } else {
                0
            };

            m = m.next;
            0
        } else {
            0
        }
    };
    
    0
}

func run(prog : string) -> int
{
    var pgm = BFI;

    pgm = compile(prog);
    exec(pgm);
    
    0
}

func main() -> int
{
    /* Hello World! */
    run("++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.");
    0
}

NewLISP

; This module translates a string containing a
; Brainf*** program into a list of NewLISP expressions.
; Attempts to optimize consecutive +, -, > and < operations
; as well as bracket loops.

; Create a namespace and put the following definitions in it

(context 'BF)

; If BF:quiet is true, BF:run will return the output of the
; Brainf*** program

(define quiet)

; If BF:show-timing is true, the amount of milliseconds spent
; in 'compiling' (actually translating) and running the
; resulting program will be shown

(define show-timing true)

; The Brainf*** program as a string of characters

(define src "")

; Checks for correct pairs of brackets

(define (well-formed?)
  (let (p 0)
    (dostring (i src (> 0 p))
      (case i
	("[" (++ p))
	("]" (-- p))))
    (zero? p)))

; Translate the Brainf*** command into S-expressions

(define (_compile)
  (let ((prog '())
	; Translate +
	(incr '(++ (tape i) n))
	; Translate -
	(decr '(-- (tape i) n))
	; Translate .
        (emit (if quiet
		'(push (char (tape i)) result -1)
                '(print (char (tape i)))))
	; Translate ,
	(store '(setf (tape i) (read-key)))
	; Check for loop condition
	(over? '(zero? (tape i)))
	; Current character of the program
	(m)
	; Find how many times the same character occurs
	(rep (fn ((n 1))
		 (while (= m (src 0))
		 (++ n)
		 (pop src))
	     n)))
    ; Traverse the program and translate recursively
    (until (or (empty? src) (= "]" (setq m (pop src))))
	   (case m
	     (">" (push (list '++ 'i (rep)) prog -1))
	     ("<" (push (list '-- 'i (rep)) prog -1))
	     ("+" (push (expand incr '((n (rep))) true) prog -1))
	     ("-" (push (expand decr '((n (rep))) true) prog -1))
	     ("." (push emit prog -1))
	     ("," (push store prog -1))
	     ("[" (push (append (list 'until over?)
				(_compile))
			prog -1))))
    prog))

(define (compile str , tim code)
  (setq src (join
	(filter (fn (x)
		    (member x '("<" ">" "-" "+"
				"." "," {[} {]})))
		(explode str))))
  ; Throw an error if the program is ill-formed
  (unless (well-formed?)
    (throw-error "Unbalanced brackets in Brainf*** source string"))
  (setq tim (time (setq code (cons 'begin (_compile)))))
  (and show-timing (println "Compilation time: " tim))
  code)

; Translate and run
; Tape size is optional and defaults to 30000 cells

(define (run str (size 30000))
  (let ((tape (array size '(0)))
	 (i 0)
	 (result '())
	 (tim 0)
	 (prog (compile str)))
    (setq tim (time (eval prog)))
    (and show-timing (println "Execution time: " tim))
    (and quiet (join result))))

; test - run it with (BF:test)

(define (test)
  (run "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>."))
  
; to interpret a string of Brainf*** code, use (BF:run <string>)
; to interpret a Brainf*** code file, use (BF:run (read-file <path-to-file>))

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()
Output:

If given in input the string ++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>., output is:

Hello World!

Objeck

class Brainfu_k {
  @program : String; @mem : Int[];
  @ip : Int;  @dp : Int;
  
  New(program : String, size : Int) {
    @program := program;
    @mem := Int → New[size];  
  }
  
  function : Main(args : String[]) ~ Nil {
    if(args → Size() = 2) {
      Brainfu_k → New(args[0], args[1] → ToInt()) → Execute();
    };
  }
  
  method : Execute() ~ Nil {
    while(@ip < @program → Size()) {
      instr := @program → Get(@ip);
      select(instr) {
        label '>': { @dp += 1; }
        label '<': { @dp -= 1; }
        label '+': { @mem[@dp] := @mem[@dp] + 1; }
        label '-': { @mem[@dp] := @mem[@dp] - 1; }
        label '.': { value := @mem[@dp] → As(Char); value → Print(); }        
        label ',': { @mem[@dp] := Read(); }
        label '[': { JumpForward(); }
        label ']': { JumpBack(); }
      };
      @ip += 1;
    };
  }
  
  method : JumpForward() ~ Nil {  
    depth := 1;
    if(@mem[@dp] = 0) {
      while(@ip < @program → Size()) {
        instr := @program → Get(@ip);
        if(instr = ']') {
          depth -= 1;  if(depth = 0) { return;  };  
        }
        else if(instr = '[') { depth += 1; };
        @ip += 1;
      };
      "*** Unbalanced jump ***" → ErrorLine();
      Runtime → Exit(1);
    };
  }
  
  method : JumpBack() ~ Nil {    
    depth := 1;
    if(@mem[@dp] <> 0) {
      while(@ip > 0) {
        @ip -= 1;
        instr := @program → Get(@ip);
        if(instr = '[') {
          depth -= 1;  if(depth = 0) { return; };
        }
        else if(instr = ']') { depth += 1; };
      };
      "*** Unbalanced jump ***" → ErrorLine();
      Runtime → Exit(1);
    };
  }
  
  method : Read() ~ Int {    
    in := IO.Console → ReadString();
    if(in → Size() > 0) { return in → ToInt(); };
    return 0;
  }
}

OCaml

Implementation in OCaml.

Ol

(define (bf program stack-length)
   (let ((program (string-append program "]")); end
         (program-counter 0)
         (stack (make-bytevector stack-length 0))
         (stack-pointer 0))
      (letrec ((skip (lambda (PC sp in)
                        (let loop ((pc PC) (sp sp) (in in))
                           (let ((ch (string-ref program pc))
                                 (pc (+ pc 1)))
                              (case ch
                                 (#\]  (list pc sp in))
                                 (#\[  (apply loop (skip pc sp in)))
                                 (else
                                    (loop pc sp in)))))))
               (step (lambda (PC SP IN)
                        (let loop ((pc PC) (sp SP) (in IN))
                           (let ((ch (string-ref program pc))
                                 (pc (+ pc 1)))
                              (case ch
                                 (#\]  (list (- PC 1) sp in)) ; the end
                                 (#\[  (if (eq? (ref stack sp) 0)
                                          (apply loop (skip pc sp in))
                                          (apply loop (step pc sp in))))
                                 (#\+  (set-ref! stack sp (mod (+ (ref stack sp) 257) 256))
                                       (loop pc sp in))
                                 (#\-  (set-ref! stack sp (mod (+ (ref stack sp) 255) 256))
                                       (loop pc sp in))
                                 (#\>  (loop pc (+ sp 1) in))
                                 (#\<  (loop pc (- sp 1) in))
                                 (#\.  (display (string (ref stack sp)))
                                       (loop pc sp in))
                                 (#\,  (let this ((in in))
                                          (cond
                                             ((pair? in)
                                                (set-ref! stack sp (car in))
                                                (loop pc sp (cdr in)))
                                             ((null? in)
                                                (set-ref! stack sp 0)
                                                (loop pc sp in))
                                             (else
                                                (this (force in))))))
                                 (else ; skip any invalid character
                                    (loop pc sp in))))))))
         (step 0 0 (port->bytestream stdin)))))
Output:
> (bf "++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." 30000) ; (print "Hello World!")
Hello World!

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

> (bf "----[---->+<]>+." 30000) ; another (display "@")
@

> (bf ">>++++[<++++[<++++>-]>-]<<.[-]++++++++++." 30000) ; this time (print "@")
@

; brainfuck interpreter in brainfuck (c) Daniel B Cristofani (cristofdathevanetdotcom)
; use stdin to input a brainfuck program and its input, separated by an exclamation point.
;
; provided program makes +2 to every character and print the line,
; ^D means pressing "Ctrl+D" (an 4, or EOT, or end-of-xmit ANSI control character).
> (bf ">>>+[[-]>>[-]++>+>+++++++[<++++>>++<-]++>>+>+>+++++[>++>++++++<<-]+>>>,<++[[>[
     ->>]<[>>]<<-]<[<]<+>>[>]>[<+>-[[<+>-]>]<[[[-]<]++<-[<+++++++++>[<->-]>>]>>]]<<
     ]<]<[[<]>[[>]>>[>>]+[<<]<[<]<+>>-]>[>]+[->>]<<<<[[<<]<[<]+<<[+>+<<-[>-->+<<-[>
     +<[>>+<<-]]]>[<+>-]<]++>>-->[>]>>[>>]]<<[>>+<[[<]<]>[[<<]<[<]+[-<+>>-[<<+>++>-
     [<->[<<+>>-]]]<[>+<-]>]>[>]>]>[>>]>>]<<[>>+>>+>>]<<[->>>>>>>>]<<[>.>>>>>>>]<<[
     >->>>>>]<<[>,>>>]<<[>+>]<<[+<<]<]" 30000)
>,[>,]<[+<]>[----.>]!Khoor#Eudlqixfn$^D
Hello Brainfuck!

PARI/GP

A case statement would have been really useful here...

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]
						)
					)
				)
			)
		)
	)
};

Pascal

program rcExceuteBrainF;

uses
     Crt;

Const
  DataSize= 1024;                           // Size of Data segment
  MaxNest=  1000;                           // Maximum nesting depth of []

procedure ExecuteBF(Source: string);
var
  Dp:       pByte;                          // Used as the Data Pointer
  DataSeg:  Pointer;                        // Start of the DataSegment (Cell 0)
  Ip:       pChar;                          // Used as instruction Pointer
  LastIp:   Pointer;                        // Last adr of code.
  JmpStack: array[0..MaxNest-1] of pChar;   // Stack to Keep track of active "[" locations
  JmpPnt:   Integer;                        // Stack pointer ^^
  JmpCnt:   Word;                           // Used to count brackets when skipping forward.


begin

  // Set up then data segment
  getmem(DataSeg,dataSize);
  dp:=DataSeg;
  fillbyte(dp^,dataSize,0);

  // Set up the JmpStack
  JmpPnt:=-1;

  // Set up Instruction Pointer
  Ip:=@Source[1];
  LastIp:=@Source[length(source)];
  if Ip=nil then exit;

  // Main Execution loop
  repeat { until Ip > LastIp }
    Case Ip^ of
      '<': dec(dp);
      '>': inc(dp);
      '+': inc(dp^);
      '-': dec(dp^);
      '.': write(stdout,chr(dp^));
      ',': dp^:=ord(readkey);
      '[': if dp^=0 then
           begin
             // skip forward until matching bracket;
             JmpCnt:=1;
             while (JmpCnt>0) and (ip<=lastip) do
             begin
               inc(ip);
               Case ip^ of
                 '[': inc(JmpCnt);
                 ']': dec(JmpCnt);
                 #0:  begin
                        Writeln(StdErr,'Error brackets don''t match');
                        halt;
                      end;
                end;
             end;
           end else begin
             // Add location to Jump stack
             inc(JmpPnt);
             JmpStack[jmpPnt]:=ip;
           end;
      ']': if dp^>0 then
             // Jump Back to matching [
             ip:=JmpStack[jmpPnt]
           else
             // Remove Jump from stack
             dec(jmpPnt);
    end;
    inc(ip);
  until Ip>lastIp;
  freemem(DataSeg,dataSize);
end;

Const
  HelloWorldWiki = '++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>'+
                   '---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.';

  pressESCtoCont = '>[-]+++++++[<++++++++++>-]<->>[-]+++++++[<+++++++++++'+
                   '+>-]<->>[-]++++[<++++++++>-]+>[-]++++++++++[<++++++++'+
                   '++>-]>[-]++++++++[<++++++++++++++>-]<.++.+<.>..<<.<<.'+
                   '-->.<.>>.>>+.-----.<<.[<<+>>-]<<.>>>>.-.++++++.<++++.'+
                   '+++++.>+.<<<<++.>+[>+<--]>++++...';
  waitForEsc     = '[-]>[-]++++[<+++++++>-]<->[-]>+[[-]<<[>+>+<<-]'+'>>[<'+
                   '<+>>-],<[->-<]>]';

begin
  // Execute "Hello World" example from Wikipedia
  ExecuteBF(HelloWorldWiki);

  // Print text "press ESC to continue....." and wait for ESC to be pressed
  ExecuteBF(pressESCtoCont+waitForEsc);
end.

Perl

Implementation in Perl.

Actually compile the Brain****

#!/usr/bin/perl

my %code = split ' ', <<'END';
  >  $ptr++
  <  $ptr--
  +  $memory[$ptr]++
  -  $memory[$ptr]--
  ,  $memory[$ptr]=ord(getc)
  .  print(chr($memory[$ptr]))
  [  while($memory[$ptr]){
  ]  }
END

my ($ptr, @memory) = 0;
eval join ';', map @code{ /./g }, <>;

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] = iff(platform()=JS?'?':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)
Output:
Phix Rocks!
Phix Sucks!

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

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.

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

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

Pike

string prog = "++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.";

void main() {
    array tape = allocate(30000);
    int p;
    int l = strlen(prog);
    for (int i = 0; i < l; i++) {
        switch (prog[i]) {
        case '>':
            p++;
            break;
        case '<':
            p--;
            break;
        case '+':
            tape[p]++;
            break;
        case '-':
            tape[p]--;
            break;
        case '.':
            write(sprintf("%c", tape[p])); // ascii only
            break;
        case ',':
            tape[p] = Stdio.stdin.getchar();
            break;
        case '[':
            if (!tape[p])
                for (int nest = 1; nest;)
                    prog[--i] == ']' ? nest-- : prog[i] == '[' ? nest++ : 0;
                        break;
        case ']':
            if (tape[p])
                for (int nest = 1; nest;)
                    prog[--i] == '[' ? nest-- : prog[i] == ']' ? nest++ : 0;
                        break;
        }
    }
}
Output:
Hello World!

PL/M

This program is written to run under CP/M. The BF program is read from the file given on the command line.

100H:

/* CP/M BDOS CALLS */
BDOS: PROCEDURE (FN, ARG) BYTE;
    DECLARE FN BYTE, ARG ADDRESS;
    GO TO 5;
END BDOS;

READ$CHAR: PROCEDURE BYTE; RETURN BDOS(1, 0); END READ$CHAR;
WRITE$CHAR: PROCEDURE (CHAR); DECLARE CHAR BYTE;
    CHAR = BDOS(2, CHAR); END WRITE$CHAR;
PRINT: PROCEDURE (STRING); DECLARE STRING ADDRESS;
    STRING = BDOS(9, STRING); END PRINT;
OPEN$FILE: PROCEDURE (FCB) BYTE; DECLARE FCB ADDRESS;
    RETURN BDOS(15, FCB); END OPEN$FILE;
READ$FILE: PROCEDURE (FCB, ADDR) BYTE; 
    DECLARE (FCB, ADDR) ADDRESS, FOO BYTE;
    FOO = BDOS(26, ADDR);
    RETURN BDOS(20, FCB); 
END READ$FILE;
EXIT: PROCEDURE; MEMORY(0) = BDOS(0,0); END EXIT;

/* TOP OF AVAILABLE MEMORY IN CP/M */
DECLARE MTPTR ADDRESS INITIAL (6), MEM$TOP BASED MTPTR ADDRESS;

/* FILE GIVEN ON COMMAND LINE */
DECLARE FCB1 LITERALLY '5CH';
    
/* PRINT ERROR AND EXIT */
ERROR: PROCEDURE (STRING);
    DECLARE STRING ADDRESS;
    CALL PRINT(STRING);
    CALL EXIT;
END ERROR;

/* OPEN FILE */
IF OPEN$FILE(FCB1) = 0FFH THEN
    CALL ERROR(.'CANNOT OPEN INPUT FILE$');

/* READ FILE BLOCK BY BLOCK */
DECLARE MP ADDRESS, M BASED MP BYTE;
MEMORY(0) = 26;
MP = .MEMORY + 1;
DO WHILE READ$FILE(FCB1, MP) <> 1;
    MP = MP + 128;
END;
M = 26; /* TERMINATE WITH EOF */
MP = MP + 1;

/* CLEAR THE REST OF MEMORY */
DECLARE X ADDRESS;
DO X = 0 TO MEM$TOP-MP-1;
    M(X) = 0;
END;

/* BRAINF*** I/O WITH CR/LF TRANSLATION */
BF$WRITE: PROCEDURE (CHAR);
    DECLARE CHAR BYTE;
    IF CHAR = 10 THEN CALL WRITE$CHAR(13);
    CALL WRITE$CHAR(CHAR);
END BF$WRITE;

BF$READ: PROCEDURE BYTE;
    DECLARE EOF$REACHED BYTE INITIAL (0), CH BYTE;
    IF EOF$REACHED THEN RETURN 0;
    CH = READ$CHAR;
    IF CH = 13 THEN RETURN 10;
    ELSE IF CH = 26 THEN DO;
        EOF$REACHED = 1;
        RETURN 0;
    END;
    ELSE RETURN CH;
END BF$READ;

/* EXECUTE COMMANDS */
DECLARE IP ADDRESS, I BASED IP BYTE;
DECLARE EOF$REACHED BYTE INITIAL (0), DEPTH ADDRESS;
DECLARE BRACKET$ERR DATA ('MISMATCHED BRACKETS$');
DECLARE B$OPEN LITERALLY '91', B$CLOSE LITERALLY '93';
IP = .MEMORY + 1;
DO WHILE I <> 26;
    IF      I = '+' THEN M = M + 1;
    ELSE IF I = '-' THEN M = M - 1;
    ELSE IF I = '>' THEN MP = MP + 1;
    ELSE IF I = '<' THEN MP = MP - 1;
    ELSE IF I = '.' THEN CALL BF$WRITE(M);
    ELSE IF I = ',' THEN M = BF$READ;
    ELSE IF I = B$OPEN AND M = 0 THEN DO;
        DEPTH = 1;
        DO WHILE DEPTH > 0;
            IP = IP + 1;
            IF I = B$OPEN THEN DEPTH = DEPTH + 1;
            ELSE IF I = B$CLOSE THEN DEPTH = DEPTH - 1;
            ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR); 
        END;
    END;
    ELSE IF I = B$CLOSE AND M <> 0 THEN DO;
        DEPTH = 1;
        DO WHILE DEPTH > 0;
            IP = IP - 1;
            IF I = B$OPEN THEN DEPTH = DEPTH - 1;
            ELSE IF I = B$CLOSE THEN DEPTH = DEPTH + 1;
            ELSE IF I = 26 THEN CALL ERROR(.BRACKET$ERR);
        END;
    END;
    IP = IP + 1;
END;

CALL EXIT;
EOF


Pointless

-- Code based on
-- https://github.com/allisio/pointless/blob/master/lib/examples/brainfuck.ptls

output =
  iterate(run, vm)
  |> takeUntil(isFinished)
  |> map(vm => vm.outVal)
  |> filter(notEq(None))
  |> map(char)
  |> printElems

----------------------------------------------------------

vm = VM {
  ip = 0
  dp = 0
  data = zeroArray(1000)
  inVals = map(ord, readLines)
  outVal = None
}

----------------------------------------------------------
-- "hello.bf" contains brainf*** hello world code

ops = toArray(readFile("hello.bf"))

----------------------------------------------------------

run(vm) = vm |> clearOutput |> eval |> advance 

advance(vm)     = vm with $.ip += 1
isFinished(vm)  = vm.ip >= length(ops)
clearOutput(vm) = vm with $.outVal = None

----------------------------------------------------------

jumps = getJumps(0, [], {})

getJumps(i, stack, jumps) = cond {
  case (i == length(ops)) jumps

  case (ops[i] == "[")
    getJumps(i + 1, [i] ++ stack, jumps)

  case (ops[i] == "]")
    getJumps(i + 1, tail(stack), jumps with {
      $[i] = head(stack)   
      $[head(stack)] = i
    })

  else getJumps(i + 1, stack, jumps)
}

----------------------------------------------------------

eval(vm) = cond {
  case (op == ">") vm with $.dp += 1
  case (op == "<") vm with $.dp -= 1
  case (op == "+") vm with $.data[vm.dp] += 1
  case (op == "-") vm with $.data[vm.dp] -= 1
  case (op == ".") vm with $.outVal = byte

  case (op == ",") vm with {
    $.data[vm.dp] = head(vm.inVals)
    $.inVals = tail(vm.inVals)
  }

  case (op == "[")
    if byte != 0 then vm
    else (vm with $.ip = jumps[vm.ip])

  case (op == "]")
    if byte == 0 then vm
    else (vm with $.ip = jumps[vm.ip])

  else vm

} where {
  op = ops[vm.ip]
  byte = vm.data[vm.dp]
}

Potion

This example is incorrect. Please fix the code and remove this message.

Details: Example fails this test due to incorrect loop implementation:

>++++++++[-<+++++++++>]<.>[][<-]>+>-[+]++>++>+++[>[->+++<<+++>]<<]>-----.
>->+++..+++.>-.<<+[>[+>+]>>]<--------------.>>.+++.------.--------.>+.>+.

Tape is infinite length to the right. Cells use default Potion integer type.

# Where `code` is a string.
bf = (code) :
   tape = (0)
   tape_pos = 0
   brackets = ()
   i = -1
   while (++i < code length) :
      if (code(i) == ">"): if (++tape_pos == tape length): tape append(0)..
      elsif (code(i) == "<"): tape_pos--.
      elsif (code(i) == "+"): tape(tape_pos) = tape(tape_pos) + 1.
      elsif (code(i) == "-"): tape(tape_pos) = tape(tape_pos) - 1.
      elsif (code(i) == "."): tape(tape_pos) chr print.
      elsif (code(i) == ","): tape(tape_pos) = read at(0) ord.
      elsif (code(i) == "["): brackets push(i).
      elsif (code(i) == "]") :
         if (tape(tape_pos) == 0): brackets pop.
         else: i = brackets(-1).
      .
   .
.

Prolog

Features: Ignores comments (non brainf*** characters), Can run as command, or from file, no limit on memory.

/******************************************
 Starting point, call with program in atom.
*******************************************/
brain(Program) :-
	atom_chars(Program, Instructions),
	process_bf_chars(Instructions).

brain_from_file(File) :- % or from file...
	read_file_to_codes(File, Codes, []),
	maplist(char_code, Instructions, Codes),
	process_bf_chars(Instructions).

process_bf_chars(Instructions)	:-
	phrase(bf_to_pl(Code), Instructions, []),
	Code = [C|_],
	instruction(C, Code, mem([], [0])), !.


/********************************************
 DCG to parse the bf program into prolog form
*********************************************/
bf_to_pl([]) --> [].
bf_to_pl([loop(Ins)|Next]) --> loop_start, bf_to_pl(Ins), loop_end, bf_to_pl(Next).
bf_to_pl([Ins|Next]) --> bf_code(Ins), bf_to_pl(Next).
bf_to_pl(Ins) --> [X], { \+ member(X, ['[',']',>,<,+,-,'.',',']) }, bf_to_pl(Ins). % skip non bf characters

loop_start --> ['['].
loop_end --> [']'].

bf_code(next_addr) --> ['>'].
bf_code(prev_addr) --> ['<'].
bf_code(inc_caddr) --> ['+'].
bf_code(dec_caddr) --> ['-'].
bf_code(out_caddr) --> ['.'].
bf_code(in_caddr)  --> [','].

/**********************
  Instruction Processor
***********************/
instruction([], _, _).
instruction(I, Code, Mem) :-
	mem_instruction(I, Mem, UpdatedMem),
	next_instruction(Code, NextI, NextCode),
	!, % cuts are to force tail recursion, so big programs will run
	instruction(NextI, NextCode, UpdatedMem).

% to loop, add the loop code to the start of the program then execute
% when the loop has finished it will reach itself again then can retest for zero
instruction(loop(LoopCode), Code, Mem) :-
	caddr(Mem, X),
	dif(X, 0),
	append(LoopCode, Code, [NextI|NextLoopCode]),
	!,
	instruction(NextI, [NextI|NextLoopCode], Mem).
instruction(loop(_), Code, Mem) :-
	caddr(Mem, 0),
	next_instruction(Code, NextI, NextCode),
	!,
	instruction(NextI, NextCode, Mem).

% memory is stored in two parts: 
%   1. a list with the current address and everything after it
%   2. a list with the previous memory in reverse order
mem_instruction(next_addr, mem(Mb, [Caddr]), mem([Caddr|Mb], [0])).
mem_instruction(next_addr, mem(Mb, [Caddr,NextAddr|Rest]), mem([Caddr|Mb], [NextAddr|Rest])).
mem_instruction(prev_addr, mem([PrevAddr|RestOfPrev], Caddrs), mem(RestOfPrev, [PrevAddr|Caddrs])).

% wrap instructions at the byte boundaries as this is what most programmers expect to happen
mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, 255), update_caddr(MemIn, 0, MemOut).
mem_instruction(inc_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(Val, IncVal), update_caddr(MemIn, IncVal, MemOut).
mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, 0), update_caddr(MemIn, 255, MemOut).
mem_instruction(dec_caddr, MemIn, MemOut) :- caddr(MemIn, Val), succ(DecVal, Val), update_caddr(MemIn, DecVal, MemOut).

% input and output
mem_instruction(out_caddr, Mem, Mem) :- caddr(Mem, Val), char_code(Char, Val), write(Char).
mem_instruction(in_caddr, MemIn, MemOut) :-
	get_single_char(Code),
	char_code(Char, Code),
	write(Char),
	map_input_code(Code,MappedCode),
	update_caddr(MemIn, MappedCode, MemOut).

% need to map the newline if it is not a proper newline character (system dependent).
map_input_code(13,10) :- nl.
map_input_code(C,C).

% The value at the current address
caddr(mem(_, [Caddr]), Caddr).
caddr(mem(_, [Caddr,_|_]), Caddr).

% The updated value at the current address
update_caddr(mem(BackMem, [_]), Caddr, mem(BackMem, [Caddr])).
update_caddr(mem(BackMem, [_,M|Mem]), Caddr, mem(BackMem, [Caddr,M|Mem])).

% The next instruction, and remaining code
next_instruction([_], [], []).
next_instruction([_,NextI|Rest], NextI, [NextI|Rest]).
Output:
?- brain('++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>.').
Hello World!
true

Python

Implementation in Python.

Quackery

  [ stack ]                                        is switch.arg (       --> [     )
 
  [ switch.arg put ]                               is switch     (     x -->       )

  [ switch.arg release ]                           is otherwise  (       -->       )

  [ switch.arg share != iff ]else[ done  
    otherwise  ]'[ do ]done[ ]                     is case       (     x -->       )

  [ dip tuck unrot poke swap ]                     is poketape   ( [ n n --> [ n   )

  [ 1+ over size over = if [ dip [ 0 join ] ] ]    is stepright  (   [ n --> [ n   )

  [ dup 0 = iff [ 0 rot join swap ] else [ 1 - ] ] is stepleft   (   [ n --> [ n   )

  [ 2dup peek 1 + poketape ]                       is increment  (   [ n --> [ n   )

  [ 2dup peek 1 - poketape ]                       is decrement  (   [ n --> [ n   )

  [ 2dup peek emit ]                               is print      (   [ n --> [ n   )

  [ temp take dup $ "" = iff 0 else behead
    swap temp put poketape ]                       is getchar    (   [ n --> [ n   )
  
  [ 2dup peek 0 = ]                                is zero       (   [ n --> [ n b )

  [ temp put $ "" swap witheach
      [ switch
        [ char > case [ $ "stepright "      join ]
          char < case [ $ "stepleft "       join ] 
          char + case [ $ "increment "      join ]
          char - case [ $ "decrement "      join ]
          char . case [ $ "print "          join ] 
          char , case [ $ "getchar "        join ]
          char [ case [ $ "[ zero if done " join ] 
          char ] case [ $ "zero until ] "   join ] 
          otherwise ( ignore ) ] ]
    0 nested 0 rot quackery temp release 2drop ]   is brainf***  (   $ $ -->       )
Output:

Testing brainf*** in Quackery shell with Brainf*** code from Reverse a string#Brainf***.

/O> $ "[-]>,[>,]<[.<]" $ "!sdrawkcab siht tnirP" brainf***
... 
Print this backwards!

R

Unfortunately doesn't support the "," operator.

bf <- function(code) {
  instructions <- strsplit(code, "")[[1]]
  tape <- c()
  visited <- c()

  pset <- function(n) {
    if (n %in% visited)
      p <<- n
    else {
      visited[length(visited)+1] <<- n
      tape[as.character(n)] <<- 0
      pset(n)
    }
  }

  bracket <- function(b1, b2, x) {
    nest <- 1
    j <- i + x
    while (nest != 0) {
      if (instructions[j] == b1)
        nest <- nest + 1
      if (instructions[j] == b2)
        nest <- nest - 1
      j <- j + x
    }
    i <<- j    
  }

  pset(0)
  i <- 1
  while (i <= length(instructions)) {
    p_ <- as.character(p)
    c <- instructions[i]
    switch(c,
           ">" = pset(p + 1),
           "<" = pset(p - 1),
           "+" = tape[p_] <- tape[p_] + 1,
           "-" = tape[p_] <- tape[p_] - 1,
           "." = cat(intToUtf8(tape[p_])),
           # TODO: IMPLEMENT ","
           "[" = if (tape[p_] == 0) {
                   bracket("[", "]", 1)
                   i <- i - 1 # off by one error
                 },
           "]" = bracket("]", "[", -1))
    i <- i + 1
  }
}

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

To run:

R -s --vanilla < bf.r

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 planet dyoo/bf
++++++[>++++++++++++<-]>.
>++++++++++[>++++++++++<-]>+.
+++++++..+++.>++++[>+++++++++++<-]>.
<+++[>----<-]>.<<<<<+++[>+++++<-]>.
>>.+++.------.--------.>>+.

Raku

(formerly Perl 6)

See Execute_Brain****/Raku.

Rebol

Works with Rebol3

REBOL [Title: "Brainfuck interpreter"]

tape: make object! [
    pos: 1
    data: [0]
    inc: does [
        data/:pos: data/:pos + 1
    ]
    dec: does [
        data/:pos: data/:pos - 1
    ]
    advance: does [
        pos: pos + 1
        if (length? data) <= pos [
            append data 0
        ]
    ]
    devance: does [
        if pos > 1 [
            pos: pos - 1
        ]
    ]
    get: does [
        data/:pos
    ]
]

brainfuck: make object! [
    data: string!
    code: ""
    init: func [instr] [
        self/data: instr
    ]
    bracket-map: func [text] [
        leftstack: []
        bm: make map! []
        pc: 1
        for i 1 (length? text) 1 [
            c: text/:i
            if not find "+-<>[].," c [
                continue
            ]
            if c == #"[" [
                append leftstack pc
            ]
            if c == #"]" & ((length? leftstack) > 0) [
                left: last leftstack
                take/last leftstack
                append bm reduce [left pc]
                append bm reduce [pc left]
            ]
            append code c
            pc: pc + 1
        ]
            return bm
    ]
    run: function [] [
        pc: 0
        tp: make tape []
        bm: bracket-map self/data
        while [pc <= (length? code)] [
            switch/default code/:pc [
                #"+" [tp/inc]
                #"-" [tp/dec]
                #">" [tp/advance]
                #"<" [tp/devance]
                #"[" [if tp/get == 0 [
                    pc: bm/:pc
                ]]
                #"]" [if tp/get != 0 [
                    pc: bm/:pc
                ]]
                #"." [prin to-string to-char tp/get]
                    ] []
                    pc: pc + 1
                ]
                print newline
    ]
]

bf: make brainfuck []
bf/init input
bf/run

Refal

$ENTRY Go {
    , <Arg 1>: e.File
    , <ReadFile 1 e.File>: e.Source
    , <ParseBF e.Source>: {
        F e.Error = <Prout e.Error>;
        T e.Prog = <RunProgram e.Prog>;
    };
};

ReadFile {
    s.Chan e.File = <Open 'r' s.Chan e.File>
                    <ReadFile (s.Chan)>;
    (s.Chan), <Get s.Chan>: {
        0 = <Close s.Chan>;
        e.Line = <SanitizeBF e.Line> <ReadFile (s.Chan)>
    };
}

SanitizeBF {
    = ;
    s.C e.X, '+-<>.,[]': e.L s.C e.R = s.C <SanitizeBF e.X>;
    s.C e.X = <SanitizeBF e.X>;
};

ParseBF {
    e.X, <CheckLoops e.X>: {
        T = T <ParseLoops () () e.X>;
        e.Err = e.Err;
    };
};

CheckLoops {
    (0) = T;
    (s.N) = F 'Mismatched [';
    (0) ']' e.X = F 'Mismatched ]';
    (s.N) '[' e.X = <CheckLoops (<+ s.N 1>) e.X>;
    (s.N) ']' e.X = <CheckLoops (<- s.N 1>) e.X>;
    (s.N) s.I e.X = <CheckLoops (s.N) e.X>;
    e.X = <CheckLoops (0) e.X>;
};

ParseLoops {
    (e.X) (e.C) = e.X e.C;
    (e.R) (e.Cur) '[' e.Prog = <ParseLoops (e.R (e.Cur)) () e.Prog>;
    (e.R (e.Last)) (e.Cur) ']' e.Prog = <ParseLoops (e.R) (e.Last (e.Cur)) e.Prog>;
    (e.R) (e.Cur) s.Instr e.Prog = <ParseLoops (e.R) (e.Cur s.Instr) e.Prog>;
}

RunProgram {
    e.Prog, (() 0 ()): t.Tape,
            (() ()): t.IObuf,
            (t.Tape t.IObuf): t.State,
            <RunBF t.State e.Prog>: (t.TapeOut t.IObufOut),
            t.IObufOut: ((e.In) (e.Out)),
            e.Out: {
                = ;
                e.X = <Prout e.X>;
    };
};

RunBF {
    t.State = t.State;
    t.State t.Step e.Prog = <RunBF <StepBF t.State t.Step> e.Prog>;
};

StepBF {
    (t.Tape t.IObuf) '+' = (<TapeF Inc t.Tape> t.IObuf);
    (t.Tape t.IObuf) '-' = (<TapeF Dec t.Tape> t.IObuf);
    (t.Tape t.IObuf) '<' = (<TapeLeft t.Tape> t.IObuf);
    (t.Tape t.IObuf) '>' = (<TapeRight t.Tape> t.IObuf);
    t.State          ',' = <BFIn t.State>;
    t.State          '.' = <BFOut t.State>;
    t.State (e.Loop), t.State: ((t.L 0 t.R) t.IObuf) = t.State;
    t.State (e.Loop), <RunBF t.State e.Loop>: t.Newstate = <StepBF t.Newstate (e.Loop)>;
};

TapeLeft {
    ((e.L s.N) s.C (e.R)) = ((e.L) s.N (s.C e.R));
    (() s.C (e.R)) = (() 0 (s.C e.R));
};

TapeRight {
    ((e.L) s.C (s.N e.R)) = ((e.L s.C) s.N (e.R));
    ((e.L) s.C ()) = ((e.L s.C) 0 ());
};

TapeF {
    s.F ((e.L) s.C (e.R)) = ((e.L) <Mu s.F s.C> (e.R));
};

BFIn {
    (t.Tape t.IObuf), t.Tape: (t.L s.C t.R),
                      t.IObuf: (t.In t.Out),
                      t.In: {
        (s.Char e.Rest), (t.L s.Char t.R): t.Newtape,
                         ((e.Rest) t.Out): t.NewIO
                       = (t.Newtape t.NewIO);
        (), <Card>: {
            0 = ((t.L 0 t.R) t.IObuf);
            e.Line = <BFIn (t.Tape ((<Ord e.Line> 10) t.Out))>;
        };
    };
};

BFOut {
    (t.Tape t.IObuf), t.Tape: (t.L s.C t.R),
                      t.IObuf: (t.In t.Out),
                      s.C: {
        10, t.Out: (e.Line) = <Prout <Chr e.Line>> (t.Tape (t.In ()));
        s.C, t.Out: (e.Line) = (t.Tape (t.In (e.Line s.C)));
    };
};

Inc { s.X = <Mod <+ 1 s.X> 256>; };
Dec { s.X = <Mod <+ 255 s.X > 256>; };
Output:
$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ refgo bf hello.bf
Hello World!

REXX

The REXX code is original, but the BRAINF░CK program was modified from the example given in Wikipedia:   [4]

/*REXX program implements the   Brainf*ck   (self─censored)  language.                  */
@.=0                                             /*initialize the infinite  "tape".     */
p =0                                             /*the  "tape"  cell  pointer.          */
! =0                                             /* !   is the instruction pointer (IP).*/
parse arg $                                      /*allow user to specify a BrainF*ck pgm*/
                                                 /* ┌──◄── No program? Then use default;*/
if $=''  then $=,                                /* ↓      it displays:  Hello, World!  */
  "++++++++++             initialize cell #0  to 10;   then loop:         ",
  "[   > +++++++              add  7 to cell #1;  final result:  70       ",
  "    > ++++++++++           add 10 to cell #2;  final result: 100       ",
  "    > +++                  add  3 to cell #3;  final result   30       ",
  "    > +                    add  1 to cell #4;  final result   10       ",
  "    <<<< -      ]      decrement  cell #0                              ",
  "> ++ .                 display 'H'    which is  ASCII  72 (decimal)    ",
  "> + .                  display 'e'    which is  ASCII 101 (decimal)    ",
  "+++++++ ..             display 'll'   which is  ASCII 108 (decimal) {2}",
  "+++ .                  display 'o'    which is  ASCII 111 (decimal)    ",
  "> ++ .                 display ' '    which is  ASCII  32 (decimal)    ",
  "<< +++++++++++++++ .   display 'W'    which is  ASCII  87 (decimal)    ",
  "> .                    display 'o'    which is  ASCII 111 (decimal)    ",
  "+++ .                  display 'r'    which is  ASCII 114 (decimal)    ",
  "------ .               display 'l'    which is  ASCII 108 (decimal)    ",
  "-------- .             display 'd'    which is  ASCII 100 (decimal)    ",
  "> + .                  display '!'    which is  ASCII  33 (decimal)    "
                                                 /* [↑]   note the  Brainf*ck  comments.*/
     do !=1  while  !\==0  &  !<=length($)       /*keep executing  BF  as long as IP ¬ 0*/
     parse var  $  =(!)  x  +1                   /*obtain a  Brainf*ck instruction  (x),*/
                                                 /*···it's the same as  x=substr($,!,1) */
       select                                    /*examine the current instruction.     */
       when x=='+'  then @.p=@.p + 1             /*increment the   "tape" cell    by  1 */
       when x=='-'  then @.p=@.p - 1             /*decrement  "       "     "      "  " */
       when x=='>'  then   p=  p + 1             /*increment  "  instruction ptr   "  " */
       when x=='<'  then   p=  p - 1             /*decrement  "       "       "    "  " */
       when x=='['  then != forward()            /*go  forward to   ]+1   if  @.P = 0.  */
       when x==']'  then !=backward()            /* " backward  "   [+1    "   "  ¬ "   */
       when x== .   then call charout , d2c(@.p) /*display a  "tape"  cell to terminal. */
       when x==','  then do;  say 'input a value:';  parse pull @.p;  end
       otherwise    iterate
       end   /*select*/
     end     /*forever*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
forward:  if @.p\==0  then return !;  c=1        /*C: ◄───  is the   [   nested counter.*/
                         do k=!+1  to length($);        ?=substr($, k, 1)
                         if ?=='['  then do; c=c+1;     iterate;                   end
                         if ?==']'  then do; c=c-1;     if c==0  then leave;       end
                         end   /*k*/
          return k
/*──────────────────────────────────────────────────────────────────────────────────────*/
backward: if @.p==0   then return !;  c=1        /*C: ◄───  is the   ]   nested counter.*/
                         do k=!-1  to 1  by -1;         ?=substr($, k, 1)
                         if ?==']'  then do; c=c+1;     iterate;                   end
                         if ?=='['  then do; c=c-1;     if c==0  then return k+1;  end
                         end   /*k*/
          return k

output   when using the default program as input:

Hello World!

RPL

« 3000 DUP { } + 0 CON 'Tape' STO "" 'StdOut' STO 1
 { « 1 + » 
   « 1 - »
   « 'Tape' OVER DUP2 GET 1 + PUT » 
   « 'Tape' OVER DUP2 GET 1 - PUT »
   « StdOut 'Tape' 3 PICK GET CHR + 'StdOut' STO »
   « 'Tape' OVER DO UNTIL KEY END PUT » 
   « IF 'Tape' OVER GET NOT THEN 
        1 CF 
        DO pgm pptr 1 + DUP 'pptr' STO DUP SUB 
           IF DUP "" == OVER "]" == OR THEN 1 SF END 
        UNTIL 1 FS? END END »
   « IF 'Tape' OVER GET THEN 
        1 CF 
        DO pgm pptr 1 - DUP 'pptr' STO DUP SUB 
           IF DUP "" == THEN 1 SF pgm SIZE 'pptr' STO END 
           IF "[" == THEN 1 SF END 
     UNTIL 1 FS? END END » 
 } 
 → pgm mmax pptr code 
 « 1 
   DO "><+-.,[]" pgm pptr DUP SUB POS 
      IF DUP THEN code SWAP GET EVAL ELSE DROP END 
      pptr 1 + 'pptr' STO 
   UNTIL DUP NOT OVER mmax > OR pptr pgm SIZE > OR END    
   DROP StdOut
   { 'Tape' 'StdOut'} PURGE
» » 'BRAIN' STO
"++++++++++[>+++++++>++++++++++>+++>+<<<<-]>++.>+.+++++++..+++.>++.<<+++++++++++++++.>.+++.------.--------.>+.>." BRAIN
Output:
1: "Hello world!"

Ruby

Implementation in Ruby.

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

Scala

import scala.annotation._

trait Func[T] {
    val zero: T
    def inc(t: T): T
    def dec(t: T): T
    def in: T
    def out(t: T): Unit
}

object ByteFunc extends Func[Byte] {
  override val zero: Byte = 0
  override def inc(t: Byte) = ((t + 1) & 0xFF).toByte
  override def dec(t: Byte) = ((t - 1) & 0xFF).toByte
  override def in: Byte = readByte
  override def out(t: Byte) { print(t.toChar) }
}

case class Tape[T](left: List[T], cell: T, right: List[T])(implicit func: Func[T]) {
  private def headOf(list:List[T]) = if (list.isEmpty) func.zero else list.head
  private def tailOf(list:List[T]) = if (list.isEmpty) Nil else list.tail
  def isZero = cell == func.zero
  def execute(ch: Char) = (ch: @switch) match {
   case '+' => copy(cell = func.inc(cell))
   case '-' => copy(cell = func.dec(cell))
   case '<' => Tape(tailOf(left), headOf(left), cell :: right)
   case '>' => Tape(cell :: left, headOf(right), tailOf(right))
   case '.' => func.out(cell); this
   case ',' => copy(cell = func.in)
   case '[' | ']' => this
   case _ => error("Unexpected token: " + ch)
  }
}

object Tape {
  def empty[T](func: Func[T]) = Tape(Nil, func.zero, Nil)(func)
}

class Brainfuck[T](func:Func[T]) {

  def execute(p: String) {
    val prog = p.replaceAll("[^\\+\\-\\[\\]\\.\\,\\>\\<]", "")

    @tailrec def braceMatcher(pos: Int, stack: List[Int], o2c: Map[Int, Int]): Map[Int,Int] =
      if(pos == prog.length) o2c else (prog(pos): @switch) match {
        case '[' => braceMatcher(pos + 1, pos :: stack, o2c)
        case ']' => braceMatcher(pos + 1, stack.tail, o2c + (stack.head -> pos))
        case _ => braceMatcher(pos + 1, stack, o2c)
      }

    val open2close = braceMatcher(0, Nil, Map())
    val close2open = open2close.map(_.swap)

    @tailrec def ex(pos:Int, tape:Tape[T]): Unit =
      if(pos < prog.length) ex((prog(pos): @switch) match {
          case '[' if tape.isZero => open2close(pos)
          case ']' if ! tape.isZero => close2open(pos)
          case _ => pos + 1
        }, tape.execute(prog(pos)))

    println("---running---")
    ex(0, Tape.empty(func))
    println("\n---done---")
  }
}

Scheme

See Execute_Brain****/Scheme.

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;
Output:
Hello World!

Original source [5].

SETL

program brainfuck;
    if command_line(1) = om then
        print("error: no program file given");
        stop;
    end if;
    
    if (f := open(command_line(1), "r")) = om then
        print("error: cannot open file");
        stop;
    end if;
    
    [pgm, loopmap] := read_program(f);
    close(f);
    
    mem_left := [];
    mem_right := [];
    mem_cur := 0;
    pc := 1;
    loop while pc <= #pgm do
        case pgm(pc) of
            ("+"): mem_cur +:= 1;
                   mem_cur mod:= 256;
            ("-"): mem_cur -:= 1;
                   mem_cur mod:= 256;
            (">"): mem_left with:= mem_cur;
                   mem_cur frome mem_right;
                   mem_cur ?:= 0;
            ("<"): mem_right with:= mem_cur;
                   mem_cur frome mem_left;
                   mem_cur ?:= 0;
            ("."): putchar(char mem_cur);
            (","): mem_cur := ichar (getchar ? '\x00');
            ("["): if mem_cur = 0 then pc := loopmap(pc); end if;
            ("]"): if mem_cur /= 0 then pc := loopmap(pc); end if;
        end case;
        pc +:= 1;
    end loop;
        
    proc read_program(f);
        pgm := [];
        loop doing ch := getc(f); while ch /= om do
            if ch in "+-<>.,[]" then 
                pgm with:= ch;
            end if;
        end loop;
    
        stack := [];
        loopmap := {};
        loop for i in [1..#pgm] do
            case pgm(i) of
                ("["): 
                    stack with:= i;
                ("]"): 
                    j frome stack;
                    if j=om then
                        print("mismatched brackets");
                        stop;
                    end if;
                    loopmap(i) := j;
                    loopmap(j) := i;
            end case;
        end loop;
        
        if stack /= [] then
            print("mismatched brackets");
            stop;
        end if;
        
        return [pgm, loopmap];
    end proc;
end program;
Output:
$ cat hello.bf
++++++++[>++++[>++>+++>+++>+<<<<-]>+>+>->>+[<]<-]>>.>---.+++++++..+++.>>.<-.<.+++.------.--------.>>+.>++.
$ setl brainfuck.setl hello.bf
Hello World!

Sidef

Translation of: Perl
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++;
}

Standard ML

Implementation in Standard ML.

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()
}

Tcl

Implementation in Tcl.


UNIX Shell

Works with: Bourne Again SHell
#!/usr/bin/env bash
# BrainF*** interpreter in bash
if (( ! $# )); then
  printf >&2 'Usage: %s program-file\n' "$0"
  exit 1
fi

# load the program
exec 3<"$1"
program=()
while IFS=  read -r line <&3; do
  mapfile -t instr < <(tr -cd '[]<>.,+-' <<<"$line" | sed $'s/./&\\\n/g')
  program+=("${instr[@]}")
done
exec 3<&-

# parse loops
loops=()
matches=()
for pc in "${!program[@]}"; do
  instr=${program[pc]}
  if [[ $instr == '[' ]]; then
    loops=("$pc" "${loops[@]}")
  elif [[ $instr == ']' ]]; then
    matches[$pc]=${loops[0]}
    matches[${loops[0]}]=$pc
    loops=(${loops[@]:1})
  fi
done

# execute program
memory=(0)
mp=0
pc=0
while (( pc < ${#program[@]} )); do
  instr=${program[pc]}
  (( pc+=1 ))
  mem=${memory[mp]}
  case "$instr" in 
    '[') if (( ! mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    ']') if (( mem )); then (( pc=${matches[pc-1]}+1 )); fi;;
    +) memory[mp]=$(( (mem + 1) % 256 ));;
    -) memory[mp]=</