Random Things

One of my favorite pieces of Forth code:

\ BNF Parser                                (c) 1988 B. J. Rodriguez
0 VARIABLE SUCCESS
:  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  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)     ( a)  C@ =TOKEN ;

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  

BNF:       '0'  | '1' | '2' |  '3' | '4' | '5' | '6' | '7'
    |  '8' | '9' ;BNF
BNF:          |      ;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:        '(' [HERE]  ')'  |     ;BNF
BNF:        '-'     |    ;BNF
BNF:        '^'  |  ;BNF
BNF:        '*'   | '/'   ;BNF
BNF:         ;BNF
BNF:        '+'   | '-'      ;BNF
BNF:          ;BNF
'  CFA SWAP !      \ fix the recursion in 

: PARSE     1 SUCCESS !      
   CR SUCCESS @ IF  ." Successful " ELSE ." Failed " THEN ;