Forth is said to be a compact language. Historically, the measurement unit of Forth source was the "screen", a 1K long buffer consisting of 16 lines, 64 chars each. Forthers are often offended with estimations like "xxxxxx lines in C or one screen in Forth". This collection is to prove these offences, by collecting concepts or programs that are supposed to take a serious number of lines in any serious programming language, but only a screenful of Forth (thereby proofing that Forth is not a serious programming language).
To get into this collection, you must have written something that is typically considered complicated. Even worse, it must fit into one screen of Forth. I'm ultra-hard, and I even request that every definition starts at a new line, and every colon-definition has a stack comment (the DOES> part, too!). The source should compile and run on a traditional (threaded code, not segmented) implementation of a ANS standard Forth. I test it on Gforth. I'll usually massage the source, both to fit a common style guide, and to run it with Gforth.
This collection will only contain the screen itself, and provide a link to description and examples.
\ Mini-OOF 12apr98py : method ( m v -- m' v ) Create over , swap cell+ swap DOES> ( ... o -- ... ) @ over @ + @ execute ; : var ( m v size -- m v' ) Create over , + DOES> ( o -- addr ) @ + ; : class ( class -- class methods vars ) dup 2@ ; : end-class ( class methods vars -- ) Create here >r , dup , 2 cells ?DO ['] noop , 1 cells +LOOP cell+ dup cell+ r> rot @ 2 cells /string move ; : defines ( xt class -- ) ' >body @ + ! ; : new ( class -- o ) here over @ allot swap over ! ; : :: ( class "name" -- ) ' >body @ + @ compile, ; Create object 1 cells , 2 cells ,Detailed Description
\ BNF Parser (c) 1988 B. J. Rodriguez Variable success : <bnf ( -- ) success @ IF r> >in @ >r dp @ >r >r ELSE r> drop THEN ; : bnf> ( -- ) success @ IF r> r> r> 2drop >r ELSE r> r> dp ! r> >in ! >r THEN ; : | ( -- ) success @ IF r> r> r> 2drop drop ELSE r> r> r> 2dup >r >r >in ! dp ! 1 success ! >r THEN ; : bnf: ( -- sys ) : postpone recursive postpone <bnf ; immediate : ;bnf ( sys -- ) postpone bnf> postpone ; ; immediate : @token ( -- n ) source >in @ /string drop c@ ; : +token ( f -- ) IF 1 >in +! THEN ; : =token ( n -- ) success @ IF @token = dup success ! +token ELSE drop THEN ; : token ( n -- ) Create c, DOES> ( a -- ) c@ =token ;Detailed Description
A small example:
\ BNF example include bnf.fs : 0bnf ( -- ) true success ! ; : /bnf ( -- ) source nip >in ! ; : tkn create dup c, bounds ?do I c@ c, loop does> count bounds ?do I C@ =token loop ; S" cat" tknS" ball" tkn bnf: | | ; S" the" tkn S" your" tkn bnf: | | ;bnf : source nip >in @ = success ! ; bl token bnf: ;bnf : parsex 0bnf /bnf cr success @ if ." matched " CR else ." failed " CR then ; parsex your cat parsex the ball
0 VALUE indents 0 VALUE tracing CREATE BLIST 15 CELLS ALLOT : BLIST[] indents CELLS BLIST + ; : TRACE TRUE TO tracing 0 TO indents ; : UNTRACE FALSE TO tracing ; : >indents ( --) 0 indents MAX 12 MIN SPACES ; : .stack ( --) ." [ " DEPTH ?DUP IF 1 SWAP DO I 1- PICK . -1 +LOOP ." ]" ELSE ." empty ]" THEN CR ; : .name ( CFA--) >LINK 2+ DUP @ 15 AND SWAP 2+ SWAP TYPE ; : (:) R@ 4 - BLIST[] ! tracing IF >indents BLIST[] @ .name 58 EMIT .stack THEN 1 +TO indents ; : (;) tracing IF >indents ." Exit:" .stack THEN -1 +TO indents ; : : : COMPILE (:) ; : ; COMPILE (;) [COMPILE] ; ; IMMEDIATE : BREAK CR ." **BREAK**" CR .stack 0 indents 2- DO ." in " I CELLS BLIST + @ .name SPACE -1 +LOOP 0 TO indents CR QUIT ; -->
Example:
PAGE .( TRACE loaded. Use TRACE to switch on, use UNTRACE to switch o ff.) .( Use BREAK in a definition to force a break-point and dump the ) .( stack to the screen.) .( E.g. : TEST IF BREAK ELSE .... THEN ;) ( test code. This can be deleted.) : HARRY 4 BREAK ; : DICK 3 HARRY ; : TOM 2 DICK ; : TEST 1 TOM ; .( Type TEST now to see how it works.)