extra/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 debugger sets ;
   5 IN: qualified
   6
   7 : define-qualified ( vocab-name prefix-name -- )
   8     [ load-vocab vocab-words ] [ CHAR: : suffix ] bi*
   9     [ -rot >r append r> ] curry 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 : expect=> ( -- ) scan "=>" assert= ;
  21
  22 : partial-vocab ( words name -- assoc )
  23     dupd [
  24         lookup [ "No such word: " swap append throw ] unless*
  25     ] curry map zip ;
  26
  27 : partial-vocab-ignoring ( words name -- assoc )
  28     [ load-vocab vocab-words keys swap diff ] keep partial-vocab ;
  29
  30 : EXCLUDE:
  31     #! Syntax: EXCLUDE: vocab => words ... ;
  32     scan expect=>
  33     ";" parse-tokens swap partial-vocab-ignoring use get push ; parsing
  34
  35 : FROM:
  36     #! Syntax: FROM: vocab => words... ;
  37     scan dup load-vocab drop expect=>
  38     ";" parse-tokens swap partial-vocab use get push ; parsing
  39
  40 : RENAME:
  41     #! Syntax: RENAME: word vocab => newname
  42     scan scan dup load-vocab drop lookup [ "No such word" throw ] unless*
  43     expect=>
  44     scan associate use get push ; parsing
  45