git.gag.com Git - debian/pforth/blob - fth/wordslik.fth

   1 \ @(#) wordslik.fth 98/01/26 1.2
   2 \
   3 \ WORDS.LIKE  ( <string> -- , search for words that contain string )
   4 \
   5 \ Enter:   WORDS.LIKE +
   6 \ Enter:   WORDS.LIKE EMIT
   7 \
   8 \ Author: Phil Burk
   9 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, David Rosenboom
  10 \
  11 \ Permission to use, copy, modify, and/or distribute this
  12 \ software for any purpose with or without fee is hereby granted.
  13 \
  14 \ THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL
  15 \ WARRANTIES WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED
  16 \ WARRANTIES OF MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL
  17 \ THE AUTHOR BE LIABLE FOR ANY SPECIAL, DIRECT, INDIRECT, OR
  18 \ CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING
  19 \ FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF
  20 \ CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
  21 \ OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
  22
  23 anew task-wordslik.fth
  24 decimal
  25
  26
  27 : PARTIAL.MATCH.NAME  ( $str1 nfa  -- flag , is $str1 in nfa ??? )
  28     count $ 1F and
  29     rot count
  30     search
  31     >r 2drop r>
  32 ;
  33
  34 : WORDS.LIKE  ( <name> -- , print all words containing substring )
  35     BL word latest
  36     >newline
  37     BEGIN
  38         prevname dup 0<> \ get previous name in dictionary
  39     WHILE
  40         2dup partial.match.name
  41         IF
  42             dup id. tab
  43             cr?
  44         THEN
  45     REPEAT 2drop
  46     >newline
  47 ;