src/lib_7_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 @ LATEST !      ( 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 >= OVER 127 <= AND 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
  51 \ Create new vocabulary
  52 : VOCABULARY
  53         create 0 ,
  54 does>
  55         body> context #context @ 1- + !
  56 ;
  57
  58 : DEFINITIONS
  59         context #context @ 1- + @ current !
  60 ;
  61
  62 \ Define root vocabulary (always available)
  63 vocabulary ROOT
  64
  65 : ONLY
  66         1 #context !
  67         root
  68         2 #context !
  69         root
  70 ;
  71
  72 : PREVIOUS
  73         #context @ 1 > if
  74                 1 #context -!
  75         else
  76                 CR ." Cannot empty search order stack!"
  77         then
  78 ;
  79
  80 : ALSO
  81         context #context @ + dup 1- @ swap !
  82         1 #context +!
  83 ;
  84
  85 also root definitions
  86
  87     : FORTH forth ;
  88
  89     \ Display search order and compilation dictionary
  90     : ORDER
  91
  92             \ Search order
  93             context #context @ 1- + context swap
  94             do
  95                 i @ >name .name space
  96             -1 +loop
  97
  98             \ Current (definitions)
  99             5 spaces
 100             current @ >name .name
 101     ;
 102
 103     \ Display transient vocabulary contents
 104     : WORDS
 105             cr
 106             context #context @ 1- + @
 107             1+ @
 108             BEGIN
 109                     ?DUP            ( while link pointer is not 0 )
 110             WHILE
 111                     DUP ?HIDDEN NOT IF      ( ignore hidden words )
 112                             DUP 1+ .NAME         ( but if not hidden, print the word )
 113                             SPACE
 114                     THEN
 115                     @               ( dereference the link pointer - go to previous word )
 116             REPEAT
 117             CR
 118     ;
 119
 120 only forth also definitions