I wrote this about a year ago and am prompted to post it now by [JCW]'s [Trying FORTH in Tcl] -- [JBR] 12/11/2002

Here FORTH is not nearly as faithfully reproduced as JCW's.  Missing are the ability 
to get at the input stream with token (word in FORTH?) and I have no return stack.
But code is eval'ed as a list and it makes the inner interpreter very fast.  unknown
is used there to push values onto the stack.

After [RS] made his comment about the code's brevity I actually looked at my code in the light of
what I have learned from RS and the rest of the active Wiki authors and I've given it the once over.

Now I'd say its brief.  I'm still stumped about a way to make pop a one liner.

 # Stack Primitives
 #
 proc Si { } { expr { [llength $::S] - 2 } }    ;# Index of second

 proc T  { } { lindex $::S end  }               ;# Top value
 proc S  { } { lindex $::S [Si] }               ;# Second value

 # Stack Ops
 #
 proc psh { x } { lappend ::S $x }              ;# Push value stack
 proc pop { } {                                 ;# Pop  value stack
        set T [T]
        set ::S [lrange $::S 0 [Si]]
        return $T
 }

 proc ! { } { set ::[pop] [pop] }               ;# Set named reference top to value
 proc @ { } { psh [set ::[pop]] }               ;# Get named reference top

 proc .    { } { puts [pop] }                   ;# Print top
 proc drop { } { pop }                          ;# Drop  top

 proc unknown { args } { psh $args }            ;# Push anything thats not a proc (values)


 # Construct a set of useful binary operators
 #
 proc stkops { args } {
     foreach op $args {
         proc $op { }  "set ::S \[lreplace \$::S \[Si] end \[expr \[T] $op \[S]]]"
     }
 }
 stkops  + - * / % | & ^ || == <= >=

 proc : { name list } {
     proc $name { } [list eval [join $list "\n"]]
 }

 : Two    2
 : setX { X ! }
 : dotX { X @ . }

 : Test {
     Two 4 *
     45 +
     setX dotX
 }

 Test   ;# --> 53



----
[RS]: I really like this code for its brevity - and the [unknown] redirection ;-) My own attempts in that direction, also a little old, are at [RPN in Tcl].