\ 28-12-2006
\ заменяем неудобный SFIND на более логичный
\ порядок следования параметров теперь будет следующим:
\ ( asc # --> asc # false | wid imm true )
\ то есть всегда возвращаем три числа!
\ либо возвращаем начальную строку с признаком false
\ либо - адрес флаг_immediate true

S" .\util\ext\tools.f" INCLUDED

\ в СПФ4 - это слово работает не очень верно - переопределил
: ?IMMEDIATE ( NFA -> F ) NAME>F C@ &IMMEDIATE AND 0<> ;

\ удалить с вершины стека указанное число параметров
: nDROP ( [ .. ] n --> ) 1+ CELLS SP@ + SP! ;

\ выдать адрес и длинну идентификатора имени
: id>asc ( NFA --> asc # ) DUP 1+ SWAP C@ ;

\ сравнить полученную лексему с именем слова
\ так проще менять код, если изменится формат словарной статьи
: identify ( asc # nameid --> flag )
           id>asc 2SWAP COMPARE ;

\ заглушка на случай хешированных словарей
\ используя лексему и id словаря найти адрес начала цепочки слов, в которой
\ необходимо искать слова.
: hashname ( asc # wid --> asc # link ) @ ;

\ найти слово в указанном словаре
\ тоже меняем порядок параметров.
: search-wordlist  ( asc # voc-id -- asc # false | xt imm_flag true )
                   hashname
                   BEGIN DUP WHILE
                         >R 2DUP R@ identify WHILE
                         R> CDR
                   REPEAT
                     2DROP R@ NAME>C @
                           R> ?IMMEDIATE TRUE
                   THEN ;

\ на входе список словарей, в которых нужно вести поиск и их кол-во
\          и строка - идентификатор имени
\ на выходе в случае неуспеха строка и false
\           в случае успеха исполнимый адрес слова и два флага
\           immediate и true
: sfindin ( widn ... widb wida # asc # --> asc # false | xt imm_flag true )
          ROT BEGIN DUP WHILE 1- >R  \ кол-во словарей для просмотра на R
                    ROT search-wordlist 0= WHILE \ лучше бы WHILENOT
                    R>
               REPEAT
                 R> -ROT 2>R nDROP 2R> TRUE \ немного чудес на стеках 8)
              THEN ;

\ найти слово в контексте
: sfind ( addr u -- addr u 0 | xt imm true )
        2>R GET-ORDER 2R> sfindin ;

\ найти адрес слова, представленного строкой в тексте
\ после ' в текущем контексте.
\ Возвращает адрес, в случае ненахождения слова возникает исключение
: ' ( "<spaces>name" -- xt )
    NextWord sfind
    IF DROP           \ признак immediate нам не нужен
     ELSE -321 THROW
    THEN ;

\ найти слово, если операция успешна скомпилировать его адрес в текущее
\ собираемое определение.
: ['] ( | name --> )
      ?COMP ' LIT,
      ; IMMEDIATE