\ a very simplified version of a Forth text interpreter

\   Input: A sequence of the following:
  
\   1) '\n' (line feed) followed by a character identifying a wordlist
\      followed by a name: define the name in the wordlist
\   2) '\t' (tab) followed by a sequence of characters:
\      set the search order; the bottom of the search order is first,
\      the top last
\   3) ' ' (space) followed by a name:
\      look up the name in the search order; there may be names that are
\       not in the search order.

\   Names do not contain characters <= ' ', and these characters are
\   also not used for identifying wordlists.

\   To verify that these things work, every defined word gets a serial
\   number (starting with 1) and a hash is computed across all found
\   words

$b64d532aaaaaaad5 constant k0
' count alias c@+

: gen-wordlists ( c-addr u -- )
    0 ?do
        \ wordlist over ! cell+
        table over ! cell+
    loop drop ;

256 constant #wordlists
create wordlists #wordlists cells allot
wordlists #wordlists gen-wordlists
variable serial# 1 serial# !

: xdef ( c-addr u -- )
    over c@ cells wordlists + @ set-current
    1 /string nextname serial# @ constant
    1 serial# +! ;

: xset-order ( c-addr u -- )
    dup >r bounds ?do
        wordlists i c@ th @
    loop
    r> set-order ;

: xfind ( c-addr u -- u2 )
    find-name dup if
        name>int >body @
    then ;

: reset-order
    only forth also definitions ;

: xparse-name ( c-addr-end c-addr1 -- c-addr-end c-addr2 c-addr1 u )
    dup >r swap >r begin ( c-addr )
        dup r@ u< while
            dup c@ bl > while
                1+ repeat then
    ( c-addr2 ) r> swap r> 2dup - ;

: process ( c-addr u -- u2 )
    0 >r bounds begin ( c-addr-end c-addr1 r: hash1 )
        2dup = if
            2drop r> reset-order exit then
        count case 
            bl of
                xparse-name xfind ?dup-if ( c-addr-end c-addr1 u r: hash1 )
                    r> xor k0 * dup 41 rshift xor >r
                then
            endof
            #lf of xparse-name xdef endof
            #tab of xparse-name xset-order endof
            true abort" invalid input"
        endcase
    again ;

warnings off
s" cross.input" slurp-file process hex. cr bye