dbohdan 2016-02-11: The following module leverages the Tcl interpreter itself to interpret
Brainfuck. It was originally developed to compete in a cross-language microbenchmark. I measured its performance when run with Tcl 8.6.4 on x86_64 Linux.
The
translate command translates Brainfuck instructions into Tcl code, which is then run with
apply (to ensure bytecode compilation). This is up to several times faster than interpreting the code directly, e.g., when running
mandel.b
, and I find it more idiomatic. Storing the tape data in dictionaries resulted in better performance than arrays, lists or dynamically named variables. Compressing repeated
+ and
- into
dict incr tape $pos ±N where N is the number of times the instruction is repeated noticeably improved the performance. Compressing
< and
>, which change a value not stored in a dictionary, had minimal impact.
namespace eval ::brainfuck {
variable verson 0.2.1
variable debug 0
proc emit code {
upvar 1 transl transl
foreach line [split [string trim $code] \n] {
append transl [string trimleft $line]\n
}
}
proc translate source {
set transl {}
emit {
if {![info exists tape] || ($tape eq {})} {
for {set i 0} {$i < 30000} {incr i} {
dict set tape $i 0
}
}
if {![info exists pos] || ($pos eq {})} {
set pos 0
}
}
set commands [split $source {}]
for {set i 0} {$i < [llength $commands]} {incr i} {
switch -exact -- [lindex $commands $i] {
[ {
emit [format %s\{ {if {[dict get $tape $pos] != 0} }]
emit "while 1 \{"
}
] {
emit {if {[dict get $tape $pos] == 0} {break}}
emit \}
emit \}
}
> -
< {
# Compress repeated Brainfuck instructions into a single Tcl
# command.
if {[lindex $commands $i] eq {<}} {
set op <
set sign -
} else {
set op >
set sign +
}
set count 0
while {[lindex $commands $i] eq $op} {
incr count
incr i
}
incr i -1
emit [format {incr pos %s%d} $sign $count]
}
+ -
- {
if {[lindex $commands $i] eq {+}} {
set op +
} else {
set op -
}
set count 0
while {[lindex $commands $i] eq $op} {
incr count
incr i
}
incr i -1
emit [format {dict incr tape $pos %s%d} $op $count]
}
. {
emit {
puts -nonewline [format %c [dict get $tape $pos]]
}
}
, {
# Noncompliant implementation.
emit {
set input [read stdin 1]
dict set tape $pos [scan $input %c]
}
}
default {
# Ignore.
}
}
}
emit {
return [list $tape $pos]
}
return $transl
}
proc interpret source {
variable debug
set translated [translate $source]
if {$debug} {
puts $translated
}
set result [apply [list {{tape {}} {pos {}}} $translated]]
return $result
}
}
proc main filename {
set ch [open $filename r]
set source [read $ch]
close $ch
fconfigure stdout -buffering none
::brainfuck::interpret $source
}
main [lindex $argv 0]
