File:  [gforth] / gforth / search.fs
Revision 1.3: download - view: text, annotated - select for diffs
Sat Oct 4 18:26:52 1997 UTC (26 years, 6 months ago) by anton
Branches: MAIN
CVS tags: HEAD
fixed ONLY bug

    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  1 vp! Root also ;
  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>