core/vocabs/vocabs.factor

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