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 sets combinators ;
   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: lookup-vocab ( vocab-spec -- vocab )
  39
  40 M: vocab lookup-vocab ;
  41
  42 M: object lookup-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 lookup-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 lookup-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 lookup-vocab vocab-main ;
  65
  66 M: f vocab-main ;
  67
  68 SYMBOL: vocab-observers
  69
  70 GENERIC: vocabs-changed ( obj -- )
  71
  72 : add-vocab-observer ( obj -- )
  73     vocab-observers get push ;
  74
  75 : remove-vocab-observer ( obj -- )
  76     vocab-observers get remove-eq! drop ;
  77
  78 : notify-vocab-observers ( -- )
  79     vocab-observers get [ vocabs-changed ] each ;
  80
  81 ERROR: bad-vocab-name name ;
  82
  83 : check-vocab-name ( name -- name )
  84     dup string? [ bad-vocab-name ] unless ;
  85
  86 : create-vocab ( name -- vocab )
  87     check-vocab-name
  88     dictionary get [ <vocab> ] cache
  89     notify-vocab-observers ;
  90
  91 ERROR: no-vocab name ;
  92
  93 : vocabs ( -- seq )
  94     dictionary get keys natural-sort ;
  95
  96 : words ( vocab -- seq )
  97     vocab-words values ;
  98
  99 : all-words ( -- seq )
 100     dictionary get values [ words ] map concat ;
 101
 102 : words-named ( str -- seq )
 103     dictionary get values
 104     [ vocab-words at ] with map
 105     sift ;
 106
 107 : child-vocab? ( prefix name -- ? )
 108     2dup = pick empty? or
 109     [ 2drop t ] [ swap CHAR: . suffix head? ] if ;
 110
 111 : child-vocabs ( vocab -- seq )
 112     vocab-name vocabs [ child-vocab? ] with filter ;
 113
 114 GENERIC: >vocab-link ( name -- vocab )
 115
 116 M: vocab-spec >vocab-link ;
 117
 118 M: string >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;
 119
 120 : forget-vocab ( vocab -- )
 121     [ words forget-all ]
 122     [ vocab-name dictionary get delete-at ] bi
 123     notify-vocab-observers ;
 124
 125 M: vocab-spec forget* forget-vocab ;
 126
 127 SYMBOL: load-vocab-hook ! ( name -- vocab )
 128
 129 : load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ;
 130
 131 PREDICATE: runnable-vocab < vocab
 132     vocab-main >boolean ;
 133
 134 INSTANCE: vocab-spec definition