Posted to tcl by evilotto at Wed Nov 27 22:31:57 GMT 2013view raw
- proc shift {lv} {
- upvar #1 $lv l
- set rv [lindex $l 0]
- set l [lrange $l 1 end]
- return $rv
- }
- set fdefs [dict create]
- proc fdef {w} {
- if {[dict exists $::fdefs $w]} {
- return [dict get $::fdefs $w inst]
- } else {
- return ""
- }
- }
- proc farg {w} {
- if {[dict exists $::fdefs $w]} {
- return [dict get $::fdefs $w ac]
- } else {
- return 0
- }
- }
- proc fdefine {w inst {ac 0}} {
- dict set ::fdefs $w inst $inst
- dict set ::fdefs $w ac $ac
- }
- proc fasm {fsc} {
- set wl [split $fsc]
- set rs ""
- while {[llength $wl] > 0} {
- set w [shift wl]
- if {[string is entier $w]} {
- append rs "push $w;\n"
- } elseif {[fdef $w] ne ""} {
- append rs "[fdef $w] "
- for {set a 0} {$a < [farg $w]} {incr a} {
- append rs "[shift wl] "
- }
- append rs ";\n"
- } else {
- error "undefined word $w"
- }
- }
- return $rs
- }
- fdefine + add
- set fcode {1 2 +}
- puts [fasm $fcode]
- puts [::tcl::unsupported::assemble [fasm $fcode]]