File:  [gforth] / gforth / search.fs
Revision 1.2: download - view: text, annotated - select for diffs
Sun Jul 6 15:55:25 1997 UTC (24 years, 2 months ago) by jwilke
Branches: MAIN
CVS tags: HEAD
Major change!
hash and search does not rely on each other.
context and voclink are now present in kernel.
words and marker can now defined without loading hash or search
marker went to extend.fs
word went to kernel/tools.fs
table goes to seperate file (at the moment)
glocals.fs and kernel/toolsext.fs are changed because of the change in the
wordlist-map-struct...
Attention: You can't recompile the code without new kernel-files!!!
jens

    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: : vp! dup vp ! cells vp + to context ;
   31: : definitions  ( -- )  context @ current ! ;
   32: 
   33: \ wordlist Vocabulary also previous                    14may93py
   34: 
   35: Variable slowvoc   0 slowvoc !
   36: 
   37: \ Forth-wordlist AConstant Forth-wordlist
   38: 
   39: : mappedwordlist ( map-struct -- wid )	\ gforth
   40: \G creates a wordlist with a special map-structure
   41:   here 0 A, swap A, voclink @ A, 0 A,
   42:   dup wordlist-link voclink !
   43:   dup initvoc ;
   44: 
   45: : wordlist  ( -- wid )
   46:   slowvoc @
   47:   IF    \ this is now f83search because hashing may be loaded already
   48: 	\ jaw
   49: 	f83search 
   50:   ELSE  Forth-wordlist wordlist-map @   THEN
   51:   mappedwordlist ;
   52: 
   53: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
   54: 
   55: : also  ( -- )
   56:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
   57:   vp! context ! ;
   58: 
   59: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp! ;
   60: 
   61: \ vocabulary find                                      14may93py
   62: 
   63: : (vocfind)  ( addr count wid -- nfa|false )
   64:     \ !! generalize this to be independent of vp
   65:     drop vp dup @ 1- cells over +
   66:     DO  2dup I 2@ over <>
   67:         IF  (search-wordlist) dup
   68: 	    IF  nip nip  UNLOOP EXIT
   69: 	    THEN  drop
   70:         ELSE  drop 2drop  THEN
   71:     [ -1 cells ] Literal +LOOP
   72:     2drop false ;
   73: 
   74: 0 value locals-wordlist
   75: 
   76: : (localsvocfind)  ( addr count wid -- nfa|false )
   77:     \ !! use generalized (vocfind)
   78:     drop locals-wordlist
   79:     IF 2dup locals-wordlist (search-wordlist) dup
   80: 	IF nip nip
   81: 	    EXIT
   82: 	THEN drop
   83:     THEN
   84:     0 (vocfind) ;
   85: 
   86: \ In the kernel the dictionary search works on only one wordlist.
   87: \ The following stuff builds a thing that looks to the kernel like one
   88: \ wordlist, but when searched it searches the whole search order
   89: \  (including locals)
   90: 
   91: \ this is the wordlist-map of the dictionary
   92: Create vocsearch ( -- wordlist-map )
   93: ' (localsvocfind) A, ' (reveal) A,  ' drop A, ' drop A,
   94: 
   95: \ create dummy wordlist for kernel
   96: slowvoc on
   97: vocsearch mappedwordlist \ the wordlist structure ( -- wid )
   98: 
   99: \ we don't want the dummy wordlist in our linked list
  100: 0 Voclink !
  101: slowvoc off
  102: 
  103: \ Only root                                            14may93py
  104: 
  105: Vocabulary Forth
  106: Vocabulary Root
  107: 
  108: : Only  0 vp! also Root also definitions ;
  109: 
  110: \ set initial search order                             14may93py
  111: 
  112: Forth-wordlist @ ' Forth >body !
  113: 
  114: 0 vp! also Root also definitions
  115: Only Forth also definitions
  116: lookup ! \ our dictionary search order becomes the law ( -- )
  117: 
  118: ' Forth >body to Forth-wordlist \ "forth definitions get-current" and "forth-wordlist" should produce the same wid
  119: 
  120: 
  121: \ get-order set-order                                  14may93py
  122: 
  123: : get-order  ( -- wid1 .. widn n )
  124:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
  125: 
  126: : set-order  ( wid1 .. widn n / -1 -- )
  127:   dup -1 = IF  drop Only exit  THEN  dup vp!
  128:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
  129: 
  130: : seal ( -- )  context @ 1 set-order ;
  131: 
  132: : .voc
  133:     body> >head head>string type space ;
  134: 
  135: : order ( -- )  \  search-ext
  136:     \g prints the search order and the @code{current} wordlist.  The
  137:     \g standard requires that the wordlists are printed in the order
  138:     \g in which they are searched. Therefore, the output is reversed
  139:     \g with respect to the conventional way of displaying stacks. The
  140:     \g @code{current} wordlist is displayed last.
  141:     get-order 0
  142:     ?DO
  143: 	.voc
  144:     LOOP
  145:     4 spaces get-current .voc ;
  146: 
  147: : vocs ( -- ) \ gforth
  148:     \g prints vocabularies and wordlists defined in the system.
  149:     voclink
  150:     BEGIN
  151: 	@ dup
  152:     WHILE
  153: 	dup 0 wordlist-link - .voc
  154:     REPEAT
  155:     drop ;
  156: 
  157: Root definitions
  158: 
  159: ' words Alias words
  160: ' Forth Alias Forth
  161: ' forth-wordlist alias forth-wordlist
  162: ' set-order alias set-order
  163: ' order alias order
  164: 
  165: Forth definitions
  166: 

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