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
  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 @
  74         1 <= abort" Cannot empty search order stack!"
  75
  76         1 #context -!
  77 ;
  78
  79 : ALSO
  80         context #context @ + dup 1- @ swap !
  81         1 #context +!
  82 ;
  83
  84 also root definitions
  85
  86     : FORTH forth ;
  87
  88     \ Display search order and compilation dictionary
  89     : ORDER
  90
  91             \ Search order
  92             context #context @ 1- + context swap
  93             do
  94                 i @ >name .name space
  95             -1 +loop
  96
  97             \ Current (definitions)
  98             5 spaces
  99             current @ >name .name
 100     ;
 101
 102     \ Display transient vocabulary contents
 103     : WORDS
 104             cr
 105             context #context @ 1- + @
 106             1+ @
 107             BEGIN
 108                     ?DUP            ( while link pointer is not 0 )
 109             WHILE
 110                     DUP ?HIDDEN NOT IF      ( ignore hidden words )
 111                             DUP 1+ .NAME         ( but if not hidden, print the word )
 112                             SPACE
 113                     THEN
 114                     @               ( dereference the link pointer - go to previous word )
 115             REPEAT
 116             CR
 117     ;
 118
 119 only forth also definitions