core/vocabs/vocabs.factor

   1 ! Copyright (C) 2007 Eduardo Cavazos, Slava Pestov.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: assocs strings kernel sorting namespaces sequences
   4 definitions ;
   5 IN: vocabs
   6
   7 SYMBOL: dictionary
   8
   9 TUPLE: vocab
  10 name root
  11 words
  12 main help
  13 source-loaded? docs-loaded? ;
  14
  15 : <vocab> ( name -- vocab )
  16     H{ } clone
  17     { set-vocab-name set-vocab-words }
  18     \ vocab construct ;
  19
  20 GENERIC: vocab ( vocab-spec -- vocab )
  21
  22 M: vocab vocab ;
  23
  24 M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
  25
  26 M: string vocab-name ;
  27
  28 M: object vocab-words vocab vocab-words ;
  29
  30 M: object vocab-help vocab vocab-help ;
  31
  32 M: object vocab-main vocab vocab-main ;
  33
  34 M: object vocab-source-loaded?
  35     vocab vocab-source-loaded? ;
  36
  37 M: object set-vocab-source-loaded?
  38     vocab set-vocab-source-loaded? ;
  39
  40 M: object vocab-docs-loaded?
  41     vocab vocab-docs-loaded? ;
  42
  43 M: object set-vocab-docs-loaded?
  44     vocab set-vocab-docs-loaded? ;
  45
  46 M: f vocab-words ;
  47
  48 M: f vocab-source-loaded? ;
  49
  50 M: f set-vocab-source-loaded? 2drop ;
  51
  52 M: f vocab-docs-loaded? ;
  53
  54 M: f set-vocab-docs-loaded? 2drop ;
  55
  56 : create-vocab ( name -- vocab )
  57     dictionary get [ <vocab> ] cache
  58     t over set-vocab-source-loaded? ;
  59
  60 SYMBOL: load-vocab-hook
  61
  62 : load-vocab ( name -- vocab ) load-vocab-hook get call ;
  63
  64 : vocabs ( -- seq )
  65     dictionary get keys natural-sort ;
  66
  67 : words ( vocab -- seq )
  68     vocab-words values ;
  69
  70 : all-words ( -- seq )
  71     dictionary get values [ words ] map concat ;
  72
  73 : words-named ( str -- seq )
  74     dictionary get values
  75     [ vocab-words at ] curry* map
  76     [ ] subset ;
  77
  78 : forget-vocab ( vocab -- )
  79     dup vocab-words [ nip forget ] assoc-each
  80     vocab-name dictionary get delete-at ;
  81
  82 : child-vocab? ( prefix name -- ? )
  83     2dup = pick empty? or
  84     [ 2drop t ] [ swap CHAR: . add head? ] if ;
  85
  86 : child-vocabs ( vocab -- seq )
  87     vocab-name vocabs [ child-vocab? ] curry* subset ;
  88
  89 TUPLE: vocab-link name root ;
  90
  91 M: vocab-link vocab-name vocab-link-name ;
  92
  93 : >vocab-link ( name root -- vocab )
  94     over vocab dup
  95     [ 2nip ] [ drop \ vocab-link construct-boa ] if ;
  96
  97 UNION: vocab-spec vocab vocab-link ;
  98
  99 M: vocab-spec forget vocab-name forget-vocab ;