Random Things

One of my favorite pieces of Forth code:

\ BNF Parser                                (c) 1988 B. J. Rodriguez
0 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:   [COMPILE] : SMUDGE COMPILE <BNF ; IMMEDIATE
: ;BNF   COMPILE BNF> SMUDGE [COMPILE] ; ; IMMEDIATE

: @TOKEN ( - n)   IN @ TIB @ + C@ ;
: +TOKEN ( f)    IF 1 IN +! THEN ;
: =TOKEN ( n)    SUCCESS @ IF @TOKEN =  DUP SUCCESS ! +TOKEN
   ELSE DROP THEN ;
: TOKEN ( n)    <BUILDS C, DOES> ( a)  C@ =TOKEN ;

Its origin: A BNF PARSER IN FORTH, by Bradford J. Rodriguez

And an example of its use:

                                                           Scr#        7
\  BNF Parser Example    #2  - infix notation        18 9 88 bjr 14:54
HEX    2B TOKEN   '+'    2D  TOKEN '-'     2A  TOKEN  '*'     2F TOKEN '/'
       28 TOKEN   '('    29  TOKEN ')'     5E  TOKEN  '^'
       30 TOKEN   '0'    31  TOKEN '1'     32  TOKEN  '2'     33 TOKEN '3'
       34 TOKEN   '4'    35  TOKEN '5'     36  TOKEN  '6'     37 TOKEN '7'
       38 TOKEN   '8'    39  TOKEN '9'       0 TOKEN  <EOL>

BNF: <DIGIT>      '0'  | '1' | '2' |  '3' | '4' | '5' | '6' | '7'
    |  '8' | '9' ;BNF
BNF: <NUMBER>    <DIGIT> <NUMBER>    |     <DIGIT> ;BNF

                                                           Scr#        8
\ BNF Parser Example     #2 - infix notation         18 9 88 bjr 15:30
\ from Aho & Ullman,     Principles of Compiler Design, pp.135,178
: [HERE]     HERE 0 ,   -2 CSP +!  ;    IMMEDIATE

BNF:   <ELEMENT>     '(' [HERE]  ')'  |    <NUMBER> ;BNF
BNF:   <PRIMARY>     '-' <PRIMARY>    |   <ELEMENT> ;BNF
BNF:   <FACTOR>    <PRIMARY> '^' <FACTOR> | <PRIMARY> ;BNF
BNF:   <T'>     '*' <FACTOR> <T'> | '/' <FACTOR> <T'> ;BNF
BNF:   <TERM>    <FACTOR> <T'> ;BNF
BNF:   <E'>     '+' <TERM> <E'> | '-' <TERM> <E'>    ;BNF
BNF:  <EXPRESSION>      <TERM> <E'> ;BNF
' <EXPRESSION> CFA SWAP !      \ fix the recursion in <ELEMENT>

: PARSE     1 SUCCESS !     <EXPRESSION> <EOL>
   CR SUCCESS @ IF  ." Successful " ELSE ." Failed " THEN ;