basis/qualified/qualified.factor

   1 ! Copyright (C) 2007, 2008 Daniel Ehrenberg.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: kernel sequences assocs hashtables parser lexer
   4 vocabs words namespaces vocabs.loader sets fry ;
   5 IN: qualified
   6
   7 : define-qualified ( vocab-name prefix-name -- )
   8     [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
   9     '[ [ [ _ ] dip append ] dip ] assoc-map
  10     use get push ;
  11
  12 : QUALIFIED:
  13     #! Syntax: QUALIFIED: vocab
  14     scan dup define-qualified ; parsing
  15
  16 : QUALIFIED-WITH:
  17     #! Syntax: QUALIFIED-WITH: vocab prefix
  18     scan scan define-qualified ; parsing
  19
  20 : partial-vocab ( words vocab -- assoc )
  21     '[ dup _ lookup [ no-word-error ] unless* ]
  22     { } map>assoc ;
  23
  24 : FROM:
  25     #! Syntax: FROM: vocab => words... ;
  26     scan dup load-vocab drop "=>" expect
  27     ";" parse-tokens swap partial-vocab use get push ; parsing
  28
  29 : partial-vocab-excluding ( words vocab -- assoc )
  30     [ load-vocab vocab-words keys swap diff ] keep partial-vocab ;
  31
  32 : EXCLUDE:
  33     #! Syntax: EXCLUDE: vocab => words ... ;
  34     scan "=>" expect
  35     ";" parse-tokens swap partial-vocab-excluding use get push ; parsing
  36
  37 : RENAME:
  38     #! Syntax: RENAME: word vocab => newname
  39     scan scan dup load-vocab drop
  40     dupd lookup [ ] [ no-word-error ] ?if
  41     "=>" expect
  42     scan associate use get push ; parsing
  43