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 : <vocab> ( name -- vocab )
  15     \ vocab new
  16         swap >>name
  17         H{ } clone >>words ;
  18
  19 GENERIC: vocab-name ( vocab-spec -- name )
  20
  21 GENERIC: vocab ( vocab-spec -- vocab )
  22
  23 M: vocab vocab ;
  24
  25 M: object vocab ( name -- vocab ) vocab-name dictionary get at ;
  26
  27 M: vocab vocab-name name>> ;
  28
  29 M: string vocab-name ;
  30
  31 GENERIC: vocab-words ( vocab-spec -- words )
  32
  33 M: vocab vocab-words words>> ;
  34
  35 M: object vocab-words vocab vocab-words ;
  36
  37 M: f vocab-words ;
  38
  39 GENERIC: vocab-help ( vocab-spec -- help )
  40
  41 M: vocab vocab-help help>> ;
  42
  43 M: object vocab-help vocab vocab-help ;
  44
  45 M: f vocab-help ;
  46
  47 GENERIC: vocab-main ( vocab-spec -- main )
  48
  49 M: vocab vocab-main main>> ;
  50
  51 M: object vocab-main vocab vocab-main ;
  52
  53 M: f vocab-main ;
  54
  55 GENERIC: vocab-source-loaded? ( vocab-spec -- ? )
  56
  57 M: vocab vocab-source-loaded? source-loaded?>> ;
  58
  59 M: object vocab-source-loaded?
  60     vocab vocab-source-loaded? ;
  61
  62 M: f vocab-source-loaded? ;
  63
  64 GENERIC: set-vocab-source-loaded? ( ? vocab-spec -- )
  65
  66 M: vocab set-vocab-source-loaded? (>>source-loaded?) ;
  67
  68 M: object set-vocab-source-loaded?
  69     vocab set-vocab-source-loaded? ;
  70
  71 M: f set-vocab-source-loaded? 2drop ;
  72
  73 GENERIC: vocab-docs-loaded? ( vocab-spec -- ? )
  74
  75 M: vocab vocab-docs-loaded? docs-loaded?>> ;
  76
  77 M: object vocab-docs-loaded?
  78     vocab vocab-docs-loaded? ;
  79
  80 M: f vocab-docs-loaded? ;
  81
  82 GENERIC: set-vocab-docs-loaded? ( ? vocab-spec -- )
  83
  84 M: vocab set-vocab-docs-loaded? (>>docs-loaded?) ;
  85
  86 M: object set-vocab-docs-loaded?
  87     vocab set-vocab-docs-loaded? ;
  88
  89 M: f set-vocab-docs-loaded? 2drop ;
  90
  91 : create-vocab ( name -- vocab )
  92     dictionary get [ <vocab> ] cache ;
  93
  94 ERROR: no-vocab name ;
  95
  96 SYMBOL: load-vocab-hook ! ( name -- )
  97
  98 : load-vocab ( name -- vocab )
  99     dup load-vocab-hook get call vocab ;
 100
 101 : vocabs ( -- seq )
 102     dictionary get keys natural-sort ;
 103
 104 : words ( vocab -- seq )
 105     vocab-words values ;
 106
 107 : all-words ( -- seq )
 108     dictionary get values [ words ] map concat ;
 109
 110 : words-named ( str -- seq )
 111     dictionary get values
 112     [ vocab-words at ] with map
 113     sift ;
 114
 115 : child-vocab? ( prefix name -- ? )
 116     2dup = pick empty? or
 117     [ 2drop t ] [ swap CHAR: . suffix head? ] if ;
 118
 119 : child-vocabs ( vocab -- seq )
 120     vocab-name vocabs [ child-vocab? ] with filter ;
 121
 122 TUPLE: vocab-link name ;
 123
 124 : <vocab-link> ( name -- vocab-link )
 125     vocab-link boa ;
 126
 127 M: vocab-link hashcode* name>> hashcode* ;
 128
 129 M: vocab-link vocab-name name>> ;
 130
 131 UNION: vocab-spec vocab vocab-link ;
 132
 133 GENERIC: >vocab-link ( name -- vocab )
 134
 135 M: vocab-spec >vocab-link ;
 136
 137 M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;
 138
 139 : forget-vocab ( vocab -- )
 140     dup words forget-all
 141     vocab-name dictionary get delete-at ;
 142
 143 M: vocab-spec forget* forget-vocab ;