bf_ns.tcl

package require Tcl 8.6

namespace eval bf {}
namespace eval bf::tape {
    variable data
    variable pos

    proc current {} {
        variable data
        variable pos

        return [lindex $data $pos]
    }

    proc inc x {
        variable data
        variable pos

        lset data $pos [expr {[current] + $x}]
    }

    proc move x {
        variable data
        variable pos
        
        incr pos $x
        while {$pos >= [llength $data]} {
            lappend data 0
        }
    }
}

namespace eval bf {
    proc parse source {
        set res {}
        while 1 {
            set c [lindex $source 0]
            if {$c eq {}} break
            set source [lrange $source 1 end]
            switch -exact -- $c {
                + { lappend res [list INC 1] }
                - { lappend res [list INC -1] }
                > { lappend res [list MOVE 1] }
                < { lappend res [list MOVE -1] }
                . { lappend res [list PRINT {}] }
                \[ {
                    lassign [parse $source] loop_code source
                    lappend res [list LOOP $loop_code]
                }
                \] { break }
                default {}
            }
        }
        return [list $res $source]
    }

    proc run program {
        foreach x $program {
            lassign $x op val
            switch -exact -- $op {
                INC {
                    tape::inc $val
                }
                MOVE {
                    tape::move $val
                }
                PRINT {
                    puts -nonewline [format %c [tape::current]]
                    flush stdout
                }
                LOOP {
                    while {[tape::current] > 0} {
                        run $val
                    }
                }
            }
        }
        return
    }
}   

proc main argv {
    lassign $argv filename
    set f [open $filename]
    lassign [::bf::parse [split [read $f] {}]] program
    close $f
    set ::bf::tape::data 0
    set ::bf::tape::pos 0
    ::bf::run $program
}

main $argv