File:  [gforth] / gforth / search.fs
Revision 1.1: download - view: text, annotated - select for diffs
Wed May 21 20:39:38 1997 UTC (24 years, 6 months ago) by anton
Branches: MAIN
CVS tags: HEAD
jwilke's changes:
Moved many files to other directories
renamed many files
other changes unknown to me.

    1: \ search order wordset                                 14may93py
    2: 
    3: \ Copyright (C) 1995 Free Software Foundation, Inc.
    4: 
    5: \ This file is part of Gforth.
    6: 
    7: \ Gforth is free software; you can redistribute it and/or
    8: \ modify it under the terms of the GNU General Public License
    9: \ as published by the Free Software Foundation; either version 2
   10: \ of the License, or (at your option) any later version.
   11: 
   12: \ This program is distributed in the hope that it will be useful,
   13: \ but WITHOUT ANY WARRANTY; without even the implied warranty of
   14: \ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   15: \ GNU General Public License for more details.
   16: 
   17: \ You should have received a copy of the GNU General Public License
   18: \ along with this program; if not, write to the Free Software
   19: \ Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
   20: 
   21: $10 constant maxvp
   22: Variable vp
   23:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
   24:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
   25: 
   26: : get-current  ( -- wid )  current @ ;
   27: : set-current  ( wid -- )  current ! ;
   28: 
   29: : context ( -- addr )  vp dup @ cells + ;
   30: : definitions  ( -- )  context @ current ! ;
   31: 
   32: \ wordlist Vocabulary also previous                    14may93py
   33: 
   34: AVariable voclink
   35: 
   36: Defer 'initvoc
   37: ' drop ' 'initvoc >body !
   38: 
   39: Variable slowvoc   slowvoc off
   40: 
   41: Forth-wordlist AConstant Forth-wordlist
   42: 
   43: : wordlist  ( -- wid )
   44:   here  0 A,
   45:   slowvoc @
   46:   IF    [ Forth-wordlist wordlist-map @ ] ALiteral
   47:   ELSE  Forth-wordlist wordlist-map @   THEN
   48:   A, voclink @ A, slowvoc @ A,
   49:   dup wordlist-link dup voclink ! 'initvoc ;
   50: 
   51: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
   52: 
   53: : also  ( -- )
   54:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
   55:   vp ! context ! ;
   56: 
   57: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
   58: 
   59: \ vocabulary find                                      14may93py
   60: 
   61: : (vocfind)  ( addr count wid -- nfa|false )
   62:     \ !! generalize this to be independent of vp
   63:     drop vp dup @ 1- cells over +
   64:     DO  2dup I 2@ over <>
   65:         IF  (search-wordlist) dup
   66: 	    IF  nip nip  UNLOOP EXIT
   67: 	    THEN  drop
   68:         ELSE  drop 2drop  THEN
   69:     [ -1 cells ] Literal +LOOP
   70:     2drop false ;
   71: 
   72: 0 value locals-wordlist
   73: 
   74: : (localsvocfind)  ( addr count wid -- nfa|false )
   75:     \ !! use generalized (vocfind)
   76:     drop locals-wordlist
   77:     IF 2dup locals-wordlist (search-wordlist) dup
   78: 	IF nip nip
   79: 	    EXIT
   80: 	THEN drop
   81:     THEN
   82:     0 (vocfind) ;
   83: 
   84: \ In the kernel the dictionary search works on only one wordlist.
   85: \ The following stuff builds a thing that looks to the kernel like one
   86: \ wordlist, but when searched it searches the whole search order
   87: \  (including locals)
   88: 
   89: \ this is the wordlist-map of the dictionary
   90: Create vocsearch ( -- wordlist-map )
   91: ' (localsvocfind) A, ' (reveal) A,  ' drop A,
   92: 
   93: \ Only root                                            14may93py
   94: 
   95: wordlist \ the wordlist structure
   96: vocsearch over wordlist-map ! \ patch the map into it
   97: 
   98: Vocabulary Forth
   99: Vocabulary Root
  100: 
  101: : Only  vp off  also Root also definitions ;
  102: 
  103: \ set initial search order                             14may93py
  104: 
  105: Forth-wordlist @ ' Forth >body !
  106: 
  107: vp off  also Root also definitions
  108: Only Forth also definitions
  109: 
  110: lookup ! \ our dictionary search order becomes the law
  111: 
  112: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
  113: 
  114: 
  115: \ get-order set-order                                  14may93py
  116: 
  117: : get-order  ( -- wid1 .. widn n )
  118:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
  119: 
  120: : set-order  ( wid1 .. widn n / -1 -- )
  121:   dup -1 = IF  drop Only exit  THEN  dup vp !
  122:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
  123: 
  124: : seal ( -- )  context @ 1 set-order ;
  125: 
  126: \ words visible in roots                               14may93py
  127: 
  128: : .name ( name -- ) \ gforth	dot-name
  129:     name>string type space ;
  130: 
  131: require termsize.fs
  132: 
  133: : words ( -- ) \ tools
  134:     cr 0 context @
  135:     BEGIN
  136: 	@ dup
  137:     WHILE
  138: 	2dup name>string nip 2 + dup >r +
  139: 	cols >=
  140: 	IF
  141: 	    cr nip 0 swap
  142: 	THEN
  143: 	dup .name space r> rot + swap
  144:     REPEAT
  145:     2drop ;
  146: 
  147: ' words alias vlist ( -- ) \ gforth
  148: \g Old (pre-Forth-83) name for @code{WORDS}.
  149: 
  150: : body> ( data -- cfa )  0 >body - ;
  151: 
  152: : .voc
  153:     body> >name .name ;
  154: : order ( -- )  \  search-ext
  155:     \g prints the search order and the @code{current} wordlist.  The
  156:     \g standard requires that the wordlists are printed in the order
  157:     \g in which they are searched. Therefore, the output is reversed
  158:     \g with respect to the conventional way of displaying stacks. The
  159:     \g @code{current} wordlist is displayed last.
  160:     get-order 0
  161:     ?DO
  162: 	.voc
  163:     LOOP
  164:     4 spaces get-current .voc ;
  165: : vocs ( -- ) \ gforth
  166:     \g prints vocabularies and wordlists defined in the system.
  167:     voclink
  168:     BEGIN
  169: 	@ dup @
  170:     WHILE
  171: 	dup 0 wordlist-link - .voc
  172:     REPEAT
  173:     drop ;
  174: 
  175: Root definitions
  176: 
  177: ' words Alias words
  178: ' Forth Alias Forth
  179: ' forth-wordlist alias forth-wordlist
  180: ' set-order alias set-order
  181: ' order alias order
  182: 
  183: Forth definitions
  184: 
  185: include hash.fs
  186: 
  187: \ table (case-sensitive wordlist)
  188: 
  189: : table-find ( addr len wordlist -- nfa / false )
  190:     >r 2dup r> bucket @ (tablefind) ;
  191: 
  192: Create tablesearch-map ( -- wordlist-map )
  193:     ' table-find A, ' hash-reveal A, ' (rehash) A,
  194: 
  195: : table ( -- wid )
  196:     \g create a case-sensitive wordlist
  197:     wordlist
  198:     tablesearch-map over wordlist-map ! ;
  199: 
  200: \ marker                                               18dec94py
  201: 
  202: \ Marker creates a mark that is removed (including everything 
  203: \ defined afterwards) when executing the mark.
  204: 
  205: : marker, ( -- mark )  here dup A,
  206:   voclink @ A, voclink
  207:   BEGIN  @ dup @  WHILE  dup 0 wordlist-link - @ A,  REPEAT  drop
  208:   udp @ , ;
  209: 
  210: : marker! ( mark -- )
  211:     dup @ swap cell+
  212:     dup @ voclink ! cell+
  213:     voclink
  214:     BEGIN
  215: 	@ dup @ 
  216:     WHILE
  217: 	over @ over 0 wordlist-link - !
  218: 	swap cell+ swap
  219:     REPEAT
  220:     drop  voclink
  221:     BEGIN
  222: 	@ dup @
  223:     WHILE
  224: 	dup 0 wordlist-link - rehash
  225:     REPEAT
  226:     drop
  227:     @ udp !  dp ! ;
  228: 
  229: : marker ( "mark" -- )
  230:     marker, Create A,
  231: DOES> ( -- )
  232:     @ marker! ;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>