src/lib_8_vocab.4th

   1 \ Vocabulary management
   2
   3 \ Forget word and everything defined after it in compilation dict
   4 : FORGET
   5         BL WORD CURRENT @ FINDVOCAB ( find the word, gets the dictionary entry address )
   6
   7         0= if
   8                 drop exit
   9         then
  10
  11         >link
  12
  13         dup @ current @ 1+ !      ( set LATEST to point to the previous word )
  14 ;
  15
  16 \ Mark word as hidden
  17 : HIDE ( -- )
  18         BL WORD FIND DROP >NAME
  19         DUP @ F_HIDDEN OR SWAP !
  20 ;
  21
  22 : ?HIDDEN
  23         1+              ( skip over the link pointer )
  24         @               ( get the flags/length byte )
  25         F_HIDDEN AND    ( mask the F_HIDDEN flag and return it (as a truth value) )
  26 ;
  27
  28 \ Display name of word
  29 : .NAME ( cfa -- )
  30         DUP @           ( get the flags/length byte )
  31         F_LENMASK AND   ( mask out the flags - just want the length )
  32
  33         BEGIN
  34                 DUP 0>          ( length > 0? )
  35         WHILE
  36                 SWAP 1+         ( addr len -- len addr+1 )
  37                 DUP @           ( len addr -- len addr char | get the next character)
  38                 DUP 32 >= IF
  39                         EMIT    ( len addr char -- len addr | and print it)
  40                 ELSE
  41                         BASE @ SWAP HEX
  42                         ." \x" 0 .R
  43                         BASE !
  44                 THEN
  45                 SWAP 1-         ( len addr -- addr len-1    | subtract one from length )
  46         REPEAT
  47         2DROP           ( len addr -- )
  48 ;
  49
  50 \ Create new vocabulary
  51 : VOCABULARY
  52         create 0 ,
  53 does>
  54         body> context #context @ 1- + !
  55 ;
  56
  57 : DEFINITIONS
  58         context #context @ 1- + @ current !
  59 ;
  60
  61 \ Define root vocabulary (always available)
  62 vocabulary ROOT
  63
  64 : ONLY
  65         1 #context !
  66         root
  67         2 #context !
  68         root
  69 ;
  70
  71 : PREVIOUS
  72         #context @
  73         1 <= abort" Cannot empty search order stack!"
  74
  75         1 #context -!
  76 ;
  77
  78 : ALSO
  79         context #context @ + dup 1- @ swap !
  80         1 #context +!
  81 ;
  82
  83 also root definitions
  84
  85     : FORTH forth ;
  86
  87     \ Display search order and compilation dictionary
  88     : ORDER
  89
  90             \ Search order
  91             context #context @ 1- + context swap
  92             do
  93                 i @ >name .name space
  94             -1 +loop
  95
  96             \ Current (definitions)
  97             5 spaces
  98             current @ >name .name
  99     ;
 100
 101     \ Display transient vocabulary contents
 102     : WORDS
 103             cr
 104             context #context @ 1- + @
 105             1+ @
 106             BEGIN
 107                     ?DUP            ( while link pointer is not 0 )
 108             WHILE
 109                     DUP ?HIDDEN NOT IF      ( ignore hidden words )
 110                             DUP 1+ .NAME         ( but if not hidden, print the word )
 111                             SPACE
 112                     THEN
 113                     @               ( dereference the link pointer - go to previous word )
 114             REPEAT
 115             CR
 116     ;
 117
 118 only forth also definitions