factor/core/vocabs/vocabs.factor

! Copyright (C) 2007, 2008 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 two
SYMBOL: +parsing+
SYMBOL: +running+
SYMBOL: +done+

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

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

GENERIC: vocab ( vocab-spec -- vocab )

M: vocab vocab ;

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

M: vocab vocab-name name>> ;

M: string vocab-name ;

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 ;

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

ERROR: no-vocab name ;

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

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

: 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 ;

TUPLE: vocab-link name ;

: <vocab-link> ( name -- vocab-link )
    vocab-link boa ;

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

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

UNION: vocab-spec vocab vocab-link ;

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 ;

M: vocab-spec forget* forget-vocab ;
Another fix 2008-02-17 18:08:52 -05:00			`! Copyright (C) 2007, 2008 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`
			`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? ;`

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			`! sources-loaded? slot is one of these two`
			`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
Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`GENERIC: vocab-name ( vocab-spec -- name )`

Initial import 2007-09-20 18:09:08 -04: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			`M: vocab vocab-name name>> ;`

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

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 ;`

Initial import 2007-09-20 18:09:08 -04:00			`: create-vocab ( name -- vocab )`
Removing USE-IF:, add with-interactive-vocabs, other fixes 2007-12-28 21:45:16 -05:00			`dictionary get [ <vocab> ] cache ;`
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
			`SYMBOL: load-vocab-hook ! ( name -- )`
Initial import 2007-09-20 18:09:08 -04:00
Refactor vocab loader 2008-03-18 21:27:09 -04:00			`: load-vocab ( name -- vocab )`
Fix loader regression 2008-03-20 18:58:35 -04:00			`dup load-vocab-hook get call vocab ;`
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			`TUPLE: vocab-link name ;`
Initial import 2007-09-20 18:09:08 -04:00
Simplify vocab.loader even further 2008-03-19 15:39:08 -04:00			`: <vocab-link> ( name -- vocab-link )`
construct-boa -> boa construct-empty -> new 2008-04-13 16:06:09 -04:00			`vocab-link boa ;`
Loading a vocab updates the browser if appropriate 2008-01-09 13:41:58 -05:00
Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`M: vocab-link hashcode* name>> hashcode* ;`
Loading a vocab updates the browser if appropriate 2008-01-09 13:41:58 -05:00
Removing old accessor usages from core and basis 2008-08-31 08:45:33 -04:00			`M: vocab-link vocab-name name>> ;`
Initial import 2007-09-20 18:09:08 -04:00
Simplify vocab.loader even further 2008-03-19 15:39:08 -04:00			`UNION: vocab-spec vocab vocab-link ;`
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			`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`
Unit test fixes 2007-12-24 19:40:09 -05:00			`vocab-name dictionary get delete-at ;`

Notify definition-observers when words are forgotten 2008-01-09 16:51:55 -05:00			`M: vocab-spec forget* forget-vocab ;`