usr/src/common/ficl/test/vocab.fr

   1 \ Here is an implementation of ALSO/ONLY in terms of the
   2 \ primitive search-order word set.
   3 \
   4 WORDLIST CONSTANT ROOT   ROOT SET-CURRENT
   5
   6 : DO-VOCABULARY  ( -- ) \ Implementation factor
   7     DOES>  @ >R           (  ) ( R: widnew )
   8      GET-ORDER  SWAP DROP ( wid1 ... widn-1 n )
   9      R> SWAP SET-ORDER
  10 ;
  11
  12 : DISCARD  ( x1 .. xu u - ) \ Implementation factor
  13    0 ?DO DROP LOOP          \ DROP u+1 stack items
  14 ;
  15
  16 CREATE FORTH  FORTH-WORDLIST , DO-VOCABULARY
  17
  18 : VOCABULARY  ( name -- )  WORDLIST CREATE ,  DO-VOCABULARY ;
  19
  20 : ALSO  ( -- )  GET-ORDER  OVER SWAP 1+ SET-ORDER ;
  21
  22 : PREVIOUS  ( --  )  GET-ORDER  SWAP DROP 1- SET-ORDER ;
  23
  24 : DEFINITIONS  ( -- )  GET-ORDER  OVER SET-CURRENT DISCARD ;
  25
  26 : ONLY ( -- )  ROOT ROOT  2 SET-ORDER ;
  27
  28 \ Forth-83 version; just removes ONLY
  29 : SEAL  ( -- )  GET-ORDER 1- SET-ORDER DROP ;
  30
  31 \ F83 and F-PC version; leaves only CONTEXT
  32 : SEAL  ( -- )  GET-ORDER OVER 1 SET-ORDER DISCARD ;