Some references:
Although there are already some Forth emulations in Tcl, this one has - of course - a distinct focus: it is an intent, to integrate Forth and Tcl as harmonically as possible.
f4t extends the Tcl interpreter with a data stack and natural RPN operations. Just like A different FORTH it makes use of the unknown function, however only numbers (integer and float) are pushed on the stack.
There is a wealth of possibilities to implement different aspects of a Forth System in Tcl. f4t strives to be be most simple and understandable in implementation, and to implement a subset of the ANS Forth wordsets, i.e., names and semantics are cloned from there. f4t can be used for simple scripts, but is not intended to be of production use or for big programs.
As of now, f4t is incomplete, just stack operations, some math, the colon compile and IF,ELSE,THEN are implemented. The following is not the whole thing, but rather a tutorial introduction to the building concepts.
# The Tcl syntax (man tcl) is expanded in the following way: # # 1. Each line is Tcl-interpreted as usual # 2. If the first word is unknown, the line is forth-interpreted, # which removes the word itself, and maybe some more text from # the line. # 3. The rest of the line is Tcl-interpreted # # Since Tcl already interprets the characters [ ] ; # which are essential to forth, we cannot - and need not - make use # of them. Compilation always stops at the end of line or ; # whichever comes first. You can use line continuation to create # forth words longer then one line. # # Traditionally forth uses uppercase letters, this stems from times # where teletypes did not have a shift key. We take advantage from # this and write all forth words in UPPERCASE. Thus you can switch # to and fro "forth context" with CAPS LOCK when writing TF Tcl # scripts, and when you read TF Tcl scripts you can switch mentally # to the stack model whenever you see an uppercase WORD.
... Here comes the interpreter, we use the array "FORTH" as dictionary. FORTH(DUP) contains a Tcl script, which implements the semantic of DUP.
namespace eval forth {
array set FORTH {}
variable STATE 0 HERE {}
proc defined {word} {# find word
variable FORTH
info exists FORTH($word)}
proc ' word {#return code of word
variable FORTH
set FORTH($word)}
namespace export '
# Note: we use the functions compile LITERAL and reveal, which
# are safely defined later. While we have no compiler we never
# need them.
proc interpret {word} {
variable STATE
if $STATE {compile $word} else [' $word]}
proc number word {
variable STATE
if [catch {expr $word+0}] {error "$word ?"}
if $STATE {LITERAL $word} else {PUSH $word}}
proc evaluate {word args} {# forth interpret word
variable S
variable STATE
if [defined $word] {interpret $word} \
else {number $word}
if [llength $args] {namespace eval :: $args} \
else {
if $STATE {reveal} else {return [tos S]}}}
}... and here is the compiler:
namespace eval forth {
proc (nest) args {# recurse the forth interpreter
variable R
upvar \#3 args line
push R $line
eval $args
eval [pop R]}
proc (lit) {number args} {# push number on stack
PUSH $number
if [llength $args] {evaluate $args}}
proc word {name body} {# craft a forth primitive
# forth primitives don't have arguments, they operate on the
# stacks only
variable FORTH
set FORTH($name) $name
proc $name {} $body}
proc compile word {# insert word in the current definition
variable FORTH; variable HERE
append FORTH($HERE) $word " "}
proc LITERAL number {
compile (lit); compile $number}
proc HEADER name {
variable FORTH; variable HERE $name
set FORTH($HERE) {}}
proc reveal {} {# end compilation
variable STATE 0; variable HERE {}}
}... Forth "primitives" are Tcl procedures, defined in the ::forth namespace. The wordlist FORTH(DUP) just contains the name of the procedure to execute. These are found by the interpreter when executing 'evaluate' as the unknown function.
Forth colon definitions however are lists of the names of Forth words, preceded by the (nest) function. When (nest) is executed, it pushes the currently executed line (the rest of it) to R and starts to (Tcl) eval the list of (Forth) commands stored in the callee's FORTH(...) definition.
So let's start building those primitives:
# STACKS: are implemented as arrays. This might seem odd, since Tcl # normally implements stacks as lists. However it allows as to # encapsulate stacks as a data type and to access all of its members # quickly, intuitively and consistently. Last not least: i like Tcl # arrays.
...
A handful of stack manipulation primitives are defined in a proper namespace; see Implementing Stacks with Arrays. These are used to define the Forth stack manipulation words, both for data and return stack. The f4t Forth words are defined in their own namespace 'forth', as we do not want them to be found by the Tcl interpreter loop:
namespace eval forth {
# Create the data and return stack of the forth engine
namespace import ::stack::*
init S
init R
word >R {# ( n -- ) (R: -- n )
variable S; variable R
push R [pop S]}
word R> {# ( -- n ) (R: n -- )
variable S; variable R
push S [pop R]}
word R@ {# ( -- n ) (R: n -- n )
variable S; variable R
push S [tos R]}
word PICK {# ( ni .. n i -- .. n ni )
variable S; push S [index S [pop S]]}
word DUP {# ( n -- n n )
0 PICK}
word OVER {# ( n1 n2 -- n1 n2 n1 )
1 PICK}... and so on.
Most math functions work in a similar way, so we generate them 'automatically':
# Math primitives, Logical and bitwise operations
namespace eval forth {
proc op1 op {# apply an unary operator to tos
variable S
push S [expr $op [pop S]]}
foreach {word operator} {
INVERT ~ LSHIFT << RSHIFT >>
NEGATE - 0= !
} {word $word "op1 $operator"}
proc op2 op {# apply a two argument operator to the stack
variable S
push S [expr [pop S] $op [pop S]]}
foreach {word operator} {
+ + - - * * / / MOD % < < > > = ==
AND & OR | XOR ^
} {word $word "op2 $operator"}...
And here comes the flow control. We have two elements, the (if) procedure which is compiled into the definition of a colon word, and IF ELSE THEN, which do the compiling and manipulate the Forth code in such a way, that (if) 'sees' one or two { lists } of Forth code, which it executes conditionally on behalf of the top of stack.
IF ELSE THEN are so called "immediate" words, they are executed during compilation of a word. We do not need to implement an "IMMEDIATE" flag, we just define or export the procedure to the global namespace, so the procedure is always found before the Forth extension to unknown is invoked.
namespace eval forth {
proc (if) {t {e {}} args} {
variable S
eval [expr [list [pop S] ? $t : $e]]}
proc IF args {
variable FORTH; variable HERE
compile (if); compile \{
eval $args}
proc THEN args {
compile \}
eval $args}
proc ELSE args {
compile \}; compile \{
eval $args}
namespace export IF THEN ELSE
}Finally we have two commands to start/stop the f4t extensions: proc f4t {} {# set up Forth for Tcl
namespace import ::forth::*
if ![catch {info args unknown}] {rename unknown TFuk}
interp alias {} unknown {} ::forth::evaluate
puts "Forth 4 Tcl"}proc BYE {} {
rename unknown {}
if ![catch {info args TFuk}] {rename TFuk unknown}}
after invoking "4ft" from the tclsh, you can do fancy stuff like:
set result [3 4 +]; 3 OVER *
and you will get 21 as the result of this line
Oh: want to inspect the stack?!
# Stack utility and Tcl glue functions
namespace eval forth {
proc . {} {# ( n -- )
variable S
puts -nonewline [pop S]
flush stdout}
proc .s {{i 0}} {#print the stack, withouth altering it
variable S
if $i {
incr i -1
puts -nonewline " [index S $i]"
.s $i
return}}
proc .S {} {
variable S; .s [top S]; flush stdout}
proc PUSH value {# push a value to the forth stack
variable S; push S $value}
proc EMPTY {} {# empty the data stack
variable S; init S}
proc >S args {# push result of script args to data stack
# useful as in: .. >S tcl script; FORTH WORDS ..
PUSH [eval $args]}
namespace export .S PUSH EMPTY >S .
}