Return to search-order.fs CVS log

Up to [gforth] / gforth

local variables
rewrote primitives2c.el in Forth (prims2x.el)
various small changes
Added Files:
 	from-cut-here gforth.el gforth.texi glocals.fs gray.fs
 	locals-test.fs prims2x.fs

    1: \ search order wordset                                 14may93py
    2: 
    3: $10 constant maxvp
    4: Variable vp
    5:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
    6:   0 A, 0 A,  0 A, 0 A,   0 A, 0 A,   0 A, 0 A, 
    7: 
    8: : get-current  ( -- wid )  current @ ;
    9: : set-current  ( wid -- )  current ! ;
   10: 
   11: : context ( -- addr )  vp dup @ cells + ;
   12: : definitions  ( -- )  context @ current ! ;
   13: 
   14: \ wordlist Vocabulary also previous                    14may93py
   15: 
   16: AVariable voclink
   17: 
   18: : wordlist  ( -- wid )
   19:   here  0 A, Forth-wordlist cell+ @ A, voclink @ A, 0 A,
   20:   dup 2 cells + voclink ! ;
   21: 
   22: : Vocabulary ( -- ) Create wordlist drop  DOES> context ! ;
   23: 
   24: : also  ( -- )
   25:   context @ vp @ 1+ dup maxvp > abort" Vocstack full"
   26:   vp ! context ! ;
   27: 
   28: : previous ( -- )  vp @ 1- dup 0= abort" Vocstack empty" vp ! ;
   29: 
   30: \ vocabulary find                                      14may93py
   31: 
   32: : (vocfind)  ( addr count nfa1 -- nfa2|false )
   33:     \ !! generalize this to be independent of vp
   34:     drop 1 vp @
   35:     DO  2dup vp I cells + @ (search-wordlist) dup
   36: 	IF  nip nip
   37: 	    UNLOOP EXIT
   38: 	THEN  drop
   39:     -1 +LOOP
   40:     2drop false ;
   41: 
   42: 0 value locals-wordlist
   43: 
   44: : (localsvocfind)  ( addr count nfa1 -- nfa2|false )
   45:     \ !! use generalized (vocfind)
   46:     drop locals-wordlist
   47:     IF 2dup locals-wordlist (search-wordlist) dup
   48: 	IF nip nip
   49: 	    EXIT
   50: 	THEN drop
   51:     THEN
   52:     0 (vocfind) ;
   53: 
   54: \ In the kernal the dictionary search works on only one wordlist.
   55: \ The following stuff builds a thing that looks to the kernal like one
   56: \ wordlist, but when searched it searches the whole search order
   57: \  (including locals)
   58: 
   59: \ this is the wordlist-map of the dictionary
   60: Create vocsearch       ' (localsvocfind) A, ' (reveal) A,
   61: 
   62: \ Only root                                            14may93py
   63: 
   64: wordlist \ the wordlist structure
   65: vocsearch over cell+ A! \ patch the map into it
   66: 
   67: Vocabulary Forth
   68: Vocabulary Root
   69: 
   70: : Only  vp off  also Root also definitions ;
   71: 
   72: \ set initial search order                             14may93py
   73: 
   74: Forth-wordlist @ ' Forth >body A!
   75: 
   76: Only Forth also definitions
   77: 
   78: search A! \ our dictionary search order becomes the law
   79: 
   80: \ get-order set-order                                  14may93py
   81: 
   82: : get-order  ( -- wid1 .. widn n )
   83:   vp @ 0 ?DO  vp cell+ I cells + @  LOOP  vp @ ;
   84: 
   85: : set-order  ( wid1 .. widn n / -1 -- )
   86:   dup -1 = IF  drop Only exit  THEN  dup vp !
   87:   ?dup IF  1- FOR  vp cell+ I cells + !  NEXT  THEN ;
   88: 
   89: : seal ( -- )  context @ 1 set-order ;
   90: 
   91: \ words visible in roots                               14may93py
   92: 
   93: : .name ( name -- ) name>string type space ;
   94: : words  cr 0 context @
   95:   BEGIN  @ dup  WHILE  2dup cell+ c@ $1F and 2 + dup >r +
   96:          &79 >  IF  cr nip 0 swap  THEN
   97:          dup .name space r> rot + swap  REPEAT 2drop ;
   98: 
   99: : body> ( data -- cfa )  0 >body - ;
  100: 
  101: : .voc  body> >name .name ;
  102: : order  1 vp @  DO  vp I cells + @ .voc  -1 +LOOP  2 spaces
  103:   current @ .voc ;
  104: : vocs   voclink  BEGIN  @ dup @  WHILE  dup 2 cells - .voc  REPEAT  drop ;
  105: 
  106: Root definitions
  107: 
  108: ' words Alias words
  109: ' Forth Alias Forth
  110: 
  111: Forth definitions