forth -> TAS translator

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]]