factor/core/vocabs/vocabs.factor

! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs strings kernel sorting namespaces
sequences definitions ;
IN: vocabs

SYMBOL: dictionary

TUPLE: vocab < identity-tuple
name words
main help
source-loaded? docs-loaded? ;

! sources-loaded? slot is one of these three
SYMBOL: +parsing+
SYMBOL: +running+
SYMBOL: +done+

: <vocab> ( name -- vocab )
    \ vocab new
        swap >>name
        H{ } clone >>words ;

TUPLE: vocab-link name ;

C: <vocab-link> vocab-link

UNION: vocab-spec vocab vocab-link ;

GENERIC: vocab-name ( vocab-spec -- name )

M: vocab vocab-name name>> ;

M: vocab-link vocab-name name>> ;

M: string vocab-name ;

GENERIC: vocab ( vocab-spec -- vocab )

M: vocab vocab ;

M: object vocab ( name -- vocab ) vocab-name dictionary get at ;

GENERIC: vocab-words ( vocab-spec -- words )

M: vocab vocab-words words>> ;

M: object vocab-words vocab vocab-words ;

M: f vocab-words ;

GENERIC: vocab-help ( vocab-spec -- help )

M: vocab vocab-help help>> ;

M: object vocab-help vocab vocab-help ;

M: f vocab-help ;

GENERIC: vocab-main ( vocab-spec -- main )

M: vocab vocab-main main>> ;

M: object vocab-main vocab vocab-main ;

M: f vocab-main ;

SYMBOL: vocab-observers

GENERIC: vocabs-changed ( obj -- )

: add-vocab-observer ( obj -- )
    vocab-observers get push ;

: remove-vocab-observer ( obj -- )
    vocab-observers get delq ;

: notify-vocab-observers ( -- )
    vocab-observers get [ vocabs-changed ] each ;

: create-vocab ( name -- vocab )
    dictionary get [ <vocab> ] cache
    notify-vocab-observers ;

ERROR: no-vocab name ;

: vocabs ( -- seq )
    dictionary get keys natural-sort ;

: words ( vocab -- seq )
    vocab-words values ;

: all-words ( -- seq )
    dictionary get values [ words ] map concat ;

: words-named ( str -- seq )
    dictionary get values
    [ vocab-words at ] with map
    sift ;

: child-vocab? ( prefix name -- ? )
    2dup = pick empty? or
    [ 2drop t ] [ swap CHAR: . suffix head? ] if ;

: child-vocabs ( vocab -- seq )
    vocab-name vocabs [ child-vocab? ] with filter ;

GENERIC: >vocab-link ( name -- vocab )

M: vocab-spec >vocab-link ;

M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;

: forget-vocab ( vocab -- )
    dup words forget-all
    vocab-name dictionary get delete-at
    notify-vocab-observers ;

M: vocab-spec forget* forget-vocab ;

SYMBOL: load-vocab-hook ! ( name -- vocab )

: load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ;

PREDICATE: runnable-vocab < vocab
    vocab-main >boolean ;

INSTANCE: vocab-spec definition
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`! Copyright (C) 2007, 2009 Eduardo Cavazos, Slava Pestov.`
Initial import 2007-09-20 18:09:08 -04:00			`! See http://factorcode.org/license.txt for BSD license.`
Remove some usages of deprecated features 2008-06-30 06:22:05 -04:00			`USING: accessors assocs strings kernel sorting namespaces`
Oops 2009-05-01 09:21:31 -04:00			`sequences definitions ;`
Initial import 2007-09-20 18:09:08 -04:00			`IN: vocabs`

			`SYMBOL: dictionary`

Working on call-next-method, and identity-tuple 2008-04-02 22:27:49 -04:00			`TUPLE: vocab < identity-tuple`
New slots are now in the core 2008-03-20 16:30:59 -04:00			`name words`
Initial import 2007-09-20 18:09:08 -04:00			`main help`
			`source-loaded? docs-loaded? ;`

Fix two small typos 2009-01-27 06:05:46 -05:00			`! sources-loaded? slot is one of these three`
Circularity between vocabularies no longer causes an infinite loop; loading a vocabulary like json or furnace no longer loads certain files twice 2008-11-23 01:04:18 -05:00			`SYMBOL: +parsing+`
			`SYMBOL: +running+`
			`SYMBOL: +done+`

Initial import 2007-09-20 18:09:08 -04:00			`: <vocab> ( name -- vocab )`
Remove some usages of deprecated features 2008-06-30 06:22:05 -04:00			`\ vocab new`
			`swap >>name`
			`H{ } clone >>words ;`
Initial import 2007-09-20 18:09:08 -04:00
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`TUPLE: vocab-link name ;`
Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`C: <vocab-link> vocab-link`
Initial import 2007-09-20 18:09:08 -04:00
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`UNION: vocab-spec vocab vocab-link ;`
Initial import 2007-09-20 18:09:08 -04:00
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`GENERIC: vocab-name ( vocab-spec -- name )`
Initial import 2007-09-20 18:09:08 -04:00
Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`M: vocab vocab-name name>> ;`

Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`M: vocab-link vocab-name name>> ;`

Initial import 2007-09-20 18:09:08 -04:00			`M: string vocab-name ;`

Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00			`GENERIC: vocab ( vocab-spec -- vocab )`

			`M: vocab vocab ;`

			`M: object vocab ( name -- vocab ) vocab-name dictionary get at ;`

Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`GENERIC: vocab-words ( vocab-spec -- words )`

			`M: vocab vocab-words words>> ;`

Initial import 2007-09-20 18:09:08 -04:00			`M: object vocab-words vocab vocab-words ;`

Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`M: f vocab-words ;`

			`GENERIC: vocab-help ( vocab-spec -- help )`

			`M: vocab vocab-help help>> ;`

Initial import 2007-09-20 18:09:08 -04:00			`M: object vocab-help vocab vocab-help ;`

Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`M: f vocab-help ;`

			`GENERIC: vocab-main ( vocab-spec -- main )`

			`M: vocab vocab-main main>> ;`

Initial import 2007-09-20 18:09:08 -04:00			`M: object vocab-main vocab vocab-main ;`

Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`M: f vocab-main ;`

Adding and removing vocabs now updates all-vocabs-seq 2009-05-01 08:21:56 -04:00			`SYMBOL: vocab-observers`

			`GENERIC: vocabs-changed ( obj -- )`

			`: add-vocab-observer ( obj -- )`
			`vocab-observers get push ;`

			`: remove-vocab-observer ( obj -- )`
			`vocab-observers get delq ;`

			`: notify-vocab-observers ( -- )`
			`vocab-observers get [ vocabs-changed ] each ;`

Initial import 2007-09-20 18:09:08 -04:00			`: create-vocab ( name -- vocab )`
Adding and removing vocabs now updates all-vocabs-seq 2009-05-01 08:21:56 -04:00			`dictionary get [ <vocab> ] cache`
			`notify-vocab-observers ;`
Initial import 2007-09-20 18:09:08 -04:00
update core/ to use ERROR: 2008-03-20 16:00:49 -04:00			`ERROR: no-vocab name ;`
Refactor vocab loader 2008-03-18 21:27:09 -04:00
Initial import 2007-09-20 18:09:08 -04:00			`: vocabs ( -- seq )`
			`dictionary get keys natural-sort ;`

			`: words ( vocab -- seq )`
			`vocab-words values ;`

			`: all-words ( -- seq )`
			`dictionary get values [ words ] map concat ;`

			`: words-named ( str -- seq )`
			`dictionary get values`
Rename curry* to with 2008-01-09 17:36:30 -05:00			`[ vocab-words at ] with map`
sift and harvest words added 2008-05-14 00:36:55 -04:00			`sift ;`
Initial import 2007-09-20 18:09:08 -04:00
			`: child-vocab? ( prefix name -- ? )`
			`2dup = pick empty? or`
replace add* and add with prefix and suffix 2008-03-31 20:18:05 -04:00			`[ 2drop t ] [ swap CHAR: . suffix head? ] if ;`
Initial import 2007-09-20 18:09:08 -04:00
			`: child-vocabs ( vocab -- seq )`
core changes: index* -> index-from last-index* -> last-index-from 1 tail -> rest 1 tail-slice -> rest-slice subset -> filter prepose find* -> find-from find-last* -> find-last-from before, after generic, < for integers make between? work for timestamps 2008-04-26 00:12:44 -04:00			`vocab-name vocabs [ child-vocab? ] with filter ;`
Initial import 2007-09-20 18:09:08 -04:00
Simplify vocab.loader even further 2008-03-19 15:39:08 -04:00			`GENERIC: >vocab-link ( name -- vocab )`
Clean up vocabs.loader and add littledan's unit test feature 2008-02-11 00:03:54 -05:00
Simplify vocab.loader even further 2008-03-19 15:39:08 -04:00			`M: vocab-spec >vocab-link ;`
Initial import 2007-09-20 18:09:08 -04:00
Simplify vocab.loader even further 2008-03-19 15:39:08 -04:00			`M: string >vocab-link dup vocab [ ] [ <vocab-link> ] ?if ;`
Initial import 2007-09-20 18:09:08 -04:00
definition observers; move with-compilation-unit and related support to compiler.units 2008-01-09 04:52:08 -05:00			`: forget-vocab ( vocab -- )`
more lint cleanups 2008-01-13 13:29:04 -05:00			`dup words forget-all`
Adding and removing vocabs now updates all-vocabs-seq 2009-05-01 08:21:56 -04:00			`vocab-name dictionary get delete-at`
			`notify-vocab-observers ;`
Unit test fixes 2007-12-24 19:40:09 -05:00
Notify definition-observers when words are forgotten 2008-01-09 16:51:55 -05:00			`M: vocab-spec forget* forget-vocab ;`
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00
			`SYMBOL: load-vocab-hook ! ( name -- vocab )`

- definitions.icons now has a reference article - move about to help.vocabs; it now opens the vocab browser instead - help.vocabs is in default use list - add runnable-vocab predicate class 2009-03-24 10:11:45 -04:00			`: load-vocab ( name -- vocab ) load-vocab-hook get call( name -- vocab ) ;`

			`PREDICATE: runnable-vocab < vocab`
Add definition mixin in definitions vocab to replace hard-coded union in ui.tools.operations; add ?execute to kernel to replace dup word? [ execute ] when calls in unicode.breaks and opengl 2009-03-26 22:27:45 -04:00			`vocab-main >boolean ;`

			`INSTANCE: vocab-spec definition`