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

   1 \ @(#) wordslik.fth 98/01/26 1.2\r
   2 \\r
   3 \ WORDS.LIKE  ( <string> -- , search for words that contain string )\r
   4 \\r
   5 \ Enter:   WORDS.LIKE +\r
   6 \ Enter:   WORDS.LIKE EMIT\r
   7 \\r
   8 \ Author: Phil Burk\r
   9 \ Copyright 1994 3DO, Phil Burk, Larry Polansky, Devid Rosenboom\r
  10 \\r
  11 \ The pForth software code is dedicated to the public domain,\r
  12 \ and any third party may reproduce, distribute and modify\r
  13 \ the pForth software code or any derivative works thereof\r
  14 \ without any compensation or license.  The pForth software\r
  15 \ code is provided on an "as is" basis without any warranty\r
  16 \ of any kind, including, without limitation, the implied\r
  17 \ warranties of merchantability and fitness for a particular\r
  18 \ purpose and their equivalents under the laws of any jurisdiction.\r
  19 \r
  20 anew task-wordslik.fth\r
  21 decimal\r
  22 \r
  23 \r
  24 : PARTIAL.MATCH.NAME  ( $str1 nfa  -- flag , is $str1 in nfa ??? )\r
  25         count $ 1F and\r
  26         rot count\r
  27         search\r
  28         >r 2drop r>\r
  29 ;\r
  30 \r
  31 : WORDS.LIKE  ( <name> -- , print all words containing substring )\r
  32         BL word latest\r
  33         >newline\r
  34         BEGIN\r
  35                 prevname dup 0<> \ get previous name in dictionary\r
  36         WHILE\r
  37                 2dup partial.match.name\r
  38                 IF\r
  39                         dup id. tab\r
  40                         cr?\r
  41                 THEN\r
  42         REPEAT 2drop\r
  43         >newline\r
  44 ;\r