Example Forth Code

Example code in the ForthLanguage.

Larger Forth programs are on EightQueensInManyProgrammingLanguages and WardNumberInManyProgrammingLanguages. The other in-many-programming-languages pages have smaller examples.

The ForthScientificLibrary is another large body of reviewed, tested code.

The washing machine example is another classic which shows clearly written Forth at its best. See http://www.forth.com/forth/fph-1-5.html. It begins "Suppose we are designing a washing machine. The overall, highest-level definition might be:"

    : WASHER WASH SPIN RINSE SPIN ;

That is the actual code to define the word (function) WASHER, not PseudoCode.

Standard Forth Example:

\ Note 1: Text after a backslash is a comment until end-of-line. \ Note 2: Text within parentheses like "( n -- )" is also a comment. \ Note 3: To be strictly ANSI compliant, the code below is in UPPERCASE. \ Most PC Forth implementations are (optionally) case insensitive.

: STAR ( -- ) \ Print a single star 42 EMIT ; \ 42 is the ASCII code for *

: STARS( n -- ) \ Print n stars 0 DO STAR LOOP ; \ Loop n times (0 up to n-1) and execute STAR

: SQUARE( n -- ) \ Print an n-line square of stars DUP 0 DO \ Loop n times, keeping (DUP-licating) n on the stack DUP STARS CR \ Each time, print n stars then print CR LOOP DROP ; \ After loop is done, drop the n from the stack

: TRIANGLE( n -- ) \ Print an n-line triangle 1 + 1 DO \ Loop n times from 1 to n (instead of 0 to n-1) I STARS CR \ This time use the inner loop index I LOOP ;

: TOWER( n -- ) \ Print a "tower" with an base of size n DUP \ DUP-licate n (since it is used twice below) 1 - TRIANGLE \ Print a triangle 1 size smaller than n SQUARE ; \ Print a square base of size n

\ Sample test session: CR 7 STARS\ user types this line, output follows ******* ok CR 3 TRIANGLE \ user types this line, output follows * ** *** ok CR 6 TOWER\ user types this line, output follows * ** *** **** ***** ****** ****** ****** ****** ****** ****** ok \ End of sample code and test session.

The definition

 : STAR ( -- ) [CHAR] * EMIT ;

may be preferable to the ASCII-impaired reader.

 [CHAR]

(bracket-char) is a compile-only word (a word with undefined interpretation semantics). Its compile-time semantics is to parse a space-delimited word (here the single asterisk) and to append semantics to the current colon-definition that will at run-time place the value of the first character of the parsed word on the stack. I.e. it inlines the ASCII value of the asterisk into the definition.

Here's an incredibly simplistic example to demonstrate what's meant by "postfix notation." It adds two numbers and prints the result:

   123 456 + .

Putting a number, like "123", pushes the value on the stack. The operator "+" pops the top two integer values from the stack, adds them, and pushes the result back onto the stack. The operator "." (called "dot") pops a number from the top of the stack and prints it.

The above example code is actually considered very poor practice in the Forth community. Forth, as with Extreme Programming, intends its software to be read like a book to humans. The above code is more "properly" written as follows:

 : STAR            [CHAR] * EMIT ;
 : STARS    0 DO STAR LOOP CR ;
 : SQUARE    DUP 0 DO DUP STARS LOOP DROP ;
 : TRIANGLE    1 DO I STARS LOOP ;
 : TOWER ( n -- )   DUP TRIANGLE SQUARE ;

A couple of observations:

Note that I moved CR into STARS, and out of the other words. This refactoring makes reading the source that much easier and, if you look at it, it's clear that STARS is never used without a CR.
STAR is defined using [CHAR] * instead of 42. True, this is an AnsForth-ism, but most Forths usually have some similar mechanism. Perhaps Chuck's Forths don't, I don't know about his. But if your Forth supports that kind of feature, use it.
If your Forth environment doesn't support that feature, then you can make it support it by extending the compiler itself:

\ Assumes ANSI Forth vocabulary; all other Forths, \ including Chuck's, have similar mechanisms to extend \ the compiler.

: [CHAR]BL WORD COUNT DROP C@ POSTPONE LITERAL ; IMMEDIATE

The bulk of the comments are gone. Only the highest-level word has its stack effect documented, since that's intended to be the entry point of the program. The remainder of the words are internal to the program, and their inputs and outputs can be ascertained from context. For example, since SQUARE starts off with a DUP 0 DO construct, you know it takes a loop count on the top of the stack.
The 1 - 1 + sequence when calling TRIANGLE is removed. It does nothing, so no point in putting it in there.
One word, one line. At worst, a definition should take up no more than two lines of text. When programming Forth using an older style of source editing called ForthBlocks or screens, you pretty much had no choice in the matter. However, the practice of using one word per line is just as useful in free-form text files as it is in blocks. It keeps the source code concise, easy to read and navigate, and free from any syntactical distractions. It also highly encourages people to factor their code better.

It is interesting to point out that loops are highly discouraged in Forth; they should be used only when absolutely necessary. For example, if you know, ahead of time, that you'll be needing the equivalent of 7 TOWER and 12 TOWER above, you would just code it explicitly, like this:

 : .*           [CHAR] * EMIT ;
 : 1*           .* CR ;
 : 2*           .* .* CR ;
 : 3*           .* .* .* CR ;
 : 4*           .* .* .* .* CR ;
 : 5*           .* .* .* .* .* CR ;
 : 6*           .* .* .* .* .* .* CR ;
 : 7*           .* .* .* .* .* .* .* CR ;

 : 7TRIANGLE    1* 2* 3* 4* 5* 6* 7* ;
 : 3x7*         7* 7* 7* ;
 : 4x7*         7* 7* 7* 7* ;
 : 7SQUARE      4x7* 3x7* ;
 : 7TOWER       7TRIANGLE 7SQUARE ;

 : 8*           .* .* .* .* 4* ;
 : 9*           .* .* .* .* .* 4* ;
 : 10*          .* .* .* .* .* 5* ;
 : 11*          .* .* .* .* .* .* 5* ;
 : 12*          .* .* .* .* .* .* 6* ;
 : 12TRIANGLE   7TRIANGLE 8* 9* 10* 11* ;
 : 3x12*        12* 12* 12* ;
 : 12SQUARE     3x12* 3x12* 3x12* 3x12* ;
 : 12TOWER      12TRIANGLE 12SQUARE ;

Coding in this manner actually produces a faster program (it's literally equivalent to loop unrolling), and works very well for small to medium-numbered loop iterations. In languages like C or Lisp, this is somewhat inconvenient to do; in Forth, because of its program structure and total lack of syntax, it's trivial. One other reason to implement definite loops this way is that it eliminates a loop counter; when manipulating items on the stack for computation purposes, that's one less thing you need to worry about.

Of course, unrolling works only for definite loops. When indefinite looping criteria need to be checked, it's recommended you use BEGIN and UNTIL, with a close second of BEGIN/WHILE/REPEAT. The use of DO/LOOP and its later cousin FOR/NEXT are discouraged. The code they produce cannot be easily understood upon reading the source without additional context.

This is an extreme example of ChuckMoore's (and my) philosophy of "Make each word so simple that it has to work." In other words, there is absolutely zero room for errors in the code above. If it doesn't work, the bug is either in the compiler itself or in the programmer. The sheer simplicity of the Forth compiler (see ForthSimplicity for a six-line implementation) suggests the problem is with the programmer's logic.

Moved from OpenFirmware

 ok 
 : square dup * . ; 
 ok 
 4 square 
 10 
 ok 
 decimal 
 4 square 
 16 
 ok

That's better (In other words, the default base for OpenFirmware is hexadecimal.)

WARNING: deliberately obfuscated ForthGolf follows. Please watch your step.

Now, for a little more complex example... guess what it is?

 ok
 hex 4666 dup negate do i 4000 dup 2* negate do " *" 0 dup 2dup 1e 0 do
 2swap * e >>a 2* 5 pick + -rot - j + dup dup * e >>a rot dup dup * e >>a 
 rot swap 2dup + 10000 > if 3drop 3drop "  " 0 dup 2dup leave then loop 
 2drop 2drop type 268 +loop cr drop 5de +loop
 ok

this even fits in a signature ;-)

I'm guessing this nugget of obfuscated Forth draws an 80*24 MandelbrotSet in asterisks on the console using fixed point math. (No, I didn't run it, just reformatted it.) Here, let me trim some of the fat off it:

 hex : f* * e >>a ; : sq over dup f* ; 4666 dup negate do 4000 dup 2* negate
 do bl a + i j 1e 0 do sq sq 2dup + 10000 > if 2drop 3drop bl 0. leave then
 - j + -rot f* 2* k + loop 2drop emit 268 +loop cr 5de +loop

or with the little known begin..while..while..repeat..else..then structured(?!) loop: (see the AnsForth standard, section A.3.2.3.2)

 hex : f* * e >>a ; : sq over dup f* ; 4666 dup negate do 4000 dup 2* negate do
 i j 1e begin 1- ?dup while -rot sq sq 2dup + 10000 < while - i + -rot f* 2* j +
 rot repeat 2drop drop bl else bl a + then emit 2drop 268 +loop cr 5de +loop

Note the helpful mnemonic for the '*' character: "bl a +" or blat. Who said Forth isn't readable? ;-) -- IanOsgood

I see most of the page focused on a stultifyingly trivial graphics exercise that won't hold a child's interest, followed by obfuscated code drawing mandelbrots. Can someone post examples of readable forth doing something useful? Check the various ProgrammingChrestomathy pages, such as the ones at the top of this page, for examples with varying degrees of usefulness.

Indeed, check ProgrammingChrestomathy for various xyzInVariousProgrammingLanguages links, wherein a number of them have ForthLanguage examples.

Tail recursive factorial function for a slightly less trivial example:

 : fac-rec ( acc n -- n! ) recursive
 dup dup 1 = swap 0 = or
 if
 drop ( drop 1 or 0, leaving the accumulator )
 else
 dup 1 - rot rot * swap fac-rec ( recurse )
 endif
 ;

 : fac ( n -- n! )
 1 swap fac-rec ;

I've been learning Forth and I find it incredible charming if truly bizarre. --VincentToups

Unfortunately, almost no Forth implementations support TailCallOptimization, so the explicit loop is better:

 : fac ( n -- n! )   1 swap  1 max  1+ 2 ?do i * loop ;

It reads better too, and even if your system does support tail-calls the second version will still be more efficient. Unless one happens to have a plain BEGIN/AGAIN loop, which is rare, the actual looping constructs in Forth are usually more readable, efficient, and maintainable than their recursive counterparts. Especially for definite loops.

Here's some code that builds and uses a couple of different tables. The central idea is that we build a linked list of entries which store both an integer and a function to be executed when the table matches the integer. The function for matching that integer to the value being looked up (in fact, the function is a rejector and returns true if no match) is stored in the table itself.

So, in essence, we are defining words which define classes of tables distinguished by their testing function. We then use those to define instances of those tables. The two examples at the end are a "dtable" which is intended to look up a random result from a die (hence "d") and take action based on whether the die roll fell into a range, and a simple lookup type where the match has to be exact.

Defining an item consists of passing the matching int to "i:" followed by the code to be executed on success, terminated by ";i". This code will be executed "late" and so the table can be embedded into other code like any other forth word.

All the tables can be extended later using "extend:".

 \ A table is:  #lastentry test-xt
 \ An entry is: matcher previous xt

 : >xt [ 2 cells ] literal + ;
 : >link cell+ ;

 \ search the links for n as long as xt returns true.
 : (table) ( n nextlink test-xt)
   >r
   begin
 ?dup -if  r> drop s" Not found " type -1 throw then
 2dup @ r@ execute while
 >link @
   repeat
   r> drop
   nip
   >xt @ execute
 ;

 : fn@ cell+ @ ;

 : table: ( xt <name> -- baseaddr prevdummy)
   create here  0 ,
   swap ,
   0
 does> ( n addr)
   dup
   @  ( n addr last )
   swap
   fn@
   (table)
 ;

 : extend: ( <tableName> -- baseaddr prev)
   ' >pf @  ( baseaddr)
   dup @
 ;

\ "i" for "item"

 : i: ( previous match -- previous xt/colon-sys)
   here >r
   , , 0 ,
   r>
   :noname
 ;

 : ;i  ( previous xt/colon-sys -- )
   postpone ;  ( previous xt )
   over >xt !
 ; immediate


 : ;table ( baseaddr last )
   swap !
 ;

 : dtable:  [ ' < ] literal table: ;

 : lookup: [ ' <> ] literal table: ;

 \ some examples
 dtable: classify
 1   i: s" Rubbish " type ;i
 5   i: s" OK " type ;i
 100 i: s" Jackpot! " type ;i
 ;table

 3 classify \ prints "Rubbish"
 10 classify \ print " OK"
 100 classify \ prints "Jackpot!"
 1000 classify \ prints "Jackpot!"
 0 classify \ prints "Not found" and throws an error

 lookup: .square
 1 i: 1 . ;i
 2 i: 4 . ;i
 3 i: 9 . ;i
 20 i: 400 . ;i
 ;table

 2 .square \ prints 4
 4 .square \ prints "Not found" and throws an error

\ Extending and overriding:

 extend: .square
 4 i: 16 . ;i
 2 i: 999 . ;i
 ;table

 4 .square \ now prints 16
 2 .square \ now prints 999

This lookup and extend mechanism is of course the core of a class-based v-table with (+ a little work) inheritance, with the items in the table becoming methods which respond to a message id.

CategoryForth