core/vocabs/vocabs.factor

   1 ! Copyright (C) 2007, 2008 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 GENERIC: vocab-name ( vocab-spec -- name )
  25
  26 GENERIC: vocab ( vocab-spec -- vocab )
  27
  28 M: vocab vocab ;
  29
  30 M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
  31
  32 M: vocab vocab-name name>> ;
  33
  34 M: string vocab-name ;
  35
  36 GENERIC: vocab-words ( vocab-spec -- words )
  37
  38 M: vocab vocab-words words>> ;
  39
  40 M: object vocab-words vocab vocab-words ;
  41
  42 M: f vocab-words ;
  43
  44 GENERIC: vocab-help ( vocab-spec -- help )
  45
  46 M: vocab vocab-help help>> ;
  47
  48 M: object vocab-help vocab vocab-help ;
  49
  50 M: f vocab-help ;
  51
  52 GENERIC: vocab-main ( vocab-spec -- main )
  53
  54 M: vocab vocab-main main>> ;
  55
  56 M: object vocab-main vocab vocab-main ;
  57
  58 M: f vocab-main ;
  59
  60 : create-vocab ( name -- vocab )
  61     dictionary get [ <vocab> ] cache ;
  62
  63 ERROR: no-vocab name ;
  64
  65 SYMBOL: load-vocab-hook ! ( name -- )
  66
  67 : load-vocab ( name -- vocab )
  68     dup load-vocab-hook get call vocab ;
  69
  70 : vocabs ( -- seq )
  71     dictionary get keys natural-sort ;
  72
  73 : words ( vocab -- seq )
  74     vocab-words values ;
  75
  76 : all-words ( -- seq )
  77     dictionary get values [ words ] map concat ;
  78
  79 : words-named ( str -- seq )
  80     dictionary get values
  81     [ vocab-words at ] with map
  82     sift ;
  83
  84 : child-vocab? ( prefix name -- ? )
  85     2dup = pick empty? or
  86     [ 2drop t ] [ swap CHAR: . suffix head? ] if ;
  87
  88 : child-vocabs ( vocab -- seq )
  89     vocab-name vocabs [ child-vocab? ] with filter ;
  90
  91 TUPLE: vocab-link name ;
  92
  93 : <vocab-link> ( name -- vocab-link )
  94     vocab-link boa ;
  95
  96 M: vocab-link hashcode* name>> hashcode* ;
  97
  98 M: vocab-link vocab-name name>> ;
  99
 100 UNION: vocab-spec vocab vocab-link ;
 101
 102 GENERIC: >vocab-link ( name -- vocab )
 103
 104 M: vocab-spec >vocab-link ;
 105
 106 M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
 107
 108 : forget-vocab ( vocab -- )
 109     dup words forget-all
 110     vocab-name dictionary get delete-at ;
 111
 112 M: vocab-spec forget* forget-vocab ;