extra/qualified/qualified.factor

   1 USING: kernel sequences assocs hashtables parser vocabs words namespaces
   2 vocabs.loader debugger sets ;
   3 IN: qualified
   4
   5 : define-qualified ( vocab-name prefix-name -- )
   6     [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
   7     [ -rot >r append r> ] curry assoc-map
   8     use get push ;
   9
  10 : QUALIFIED:
  11     #! Syntax: QUALIFIED: vocab
  12     scan dup define-qualified ; parsing
  13
  14 : QUALIFIED-WITH:
  15     #! Syntax: QUALIFIED-WITH: vocab prefix
  16     scan scan define-qualified ; parsing
  17
  18 : expect=> scan "=>" assert= ;
  19
  20 : partial-vocab ( words name -- assoc )
  21     dupd [
  22         lookup [ "No such word: " swap append throw ] unless*
  23     ] curry map zip ;
  24
  25 : partial-vocab-ignoring ( words name -- assoc )
  26     [ load-vocab vocab-words keys swap diff ] keep partial-vocab ;
  27
  28 : EXCLUDE:
  29     #! Syntax: EXCLUDE: vocab => words ... ;
  30     scan expect=>
  31     ";" parse-tokens swap partial-vocab-ignoring use get push ; parsing
  32
  33 : FROM:
  34     #! Syntax: FROM: vocab => words... ;
  35     scan dup load-vocab drop expect=>
  36     ";" parse-tokens swap partial-vocab use get push ; parsing
  37
  38 : RENAME:
  39     #! Syntax: RENAME: word vocab => newname
  40     scan scan dup load-vocab drop lookup [ "No such word" throw ] unless*
  41     expect=>
  42     scan associate use get push ; parsing
  43