xref: /titanic_51/usr/src/common/ficl/test/vocab.fr (revision a1bf3f785ae05c419b339c3a2061f2b18c024f61)
1\ Here is an implementation of ALSO/ONLY in terms of the
2\ primitive search-order word set.
3\
4WORDLIST 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
16CREATE 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 ;
33