Posted to tcl by dbohdan at Fri Jan 27 22:50:24 GMT 2017view raw
- 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