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: 1. 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. 1. 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. 1. 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 1. 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. 1. The 1 - 1 + sequence when calling TRIANGLE is removed. It does nothing, so no point in putting it in there. 1. 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 -- baseaddr prevdummy) create here 0 , swap , 0 does> ( n addr) dup @ ( n addr last ) swap fn@ (table) ; : extend: ( -- 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