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 sets combinators ;
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 ;

ERROR: bad-vocab-name name ;

: check-vocab-name ( name -- name )
    dup string? [ bad-vocab-name ] unless
    dup ":/\\ " intersects? [ bad-vocab-name ] when ;

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: object vocab-name check-vocab-name ;

GENERIC: lookup-vocab ( vocab-spec -- vocab )

M: vocab lookup-vocab ;

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

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

M: vocab vocab-words words>> ;

M: object vocab-words lookup-vocab vocab-words ;

M: f vocab-words ;

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

M: vocab vocab-help help>> ;

M: object vocab-help lookup-vocab vocab-help ;

M: f vocab-help ;

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

M: vocab vocab-main main>> ;

M: object vocab-main lookup-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 remove-eq! drop ;

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

: create-vocab ( name -- vocab )
    check-vocab-name
    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: object >vocab-link dup lookup-vocab [ ] [ <vocab-link> ] ?if ;

: forget-vocab ( vocab -- )
    [ words forget-all ]
    [ vocab-name dictionary get delete-at ] bi
    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`
Attempting to make require-when work with multiple vocabs 2010-04-17 18:19:37 -04:00			`sequences definitions sets combinators ;`
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
Cleanup vocab name validation. Vocab names and vocab prefixes are the same concept, and by disallowing slashes, spaces, and colon, we automatically check for absolute paths. Unit test this. 2011-10-29 02:39:40 -04:00			`ERROR: bad-vocab-name name ;`

			`: check-vocab-name ( name -- name )`
			`dup string? [ bad-vocab-name ] unless`
			`dup ":/\\ " intersects? [ bad-vocab-name ] when ;`

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

Cleanup vocab name validation. Vocab names and vocab prefixes are the same concept, and by disallowing slashes, spaces, and colon, we automatically check for absolute paths. Unit test this. 2011-10-29 02:39:40 -04:00			`M: object vocab-name check-vocab-name ;`
Initial import 2007-09-20 18:09:08 -04:00
Rename vocab to lookup-vocab 2011-10-24 06:37:47 -04:00			`GENERIC: lookup-vocab ( vocab-spec -- vocab )`
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00
Rename vocab to lookup-vocab 2011-10-24 06:37:47 -04:00			`M: vocab lookup-vocab ;`
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00
Rename vocab to lookup-vocab 2011-10-24 06:37:47 -04:00			`M: object lookup-vocab ( name -- vocab ) vocab-name dictionary get at ;`
Add vocab: for vocab-relative paths 2009-02-15 20:53:21 -05:00
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>> ;`

Rename vocab to lookup-vocab 2011-10-24 06:37:47 -04:00			`M: object vocab-words lookup-vocab vocab-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			`M: f vocab-words ;`

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

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

Rename vocab to lookup-vocab 2011-10-24 06:37:47 -04:00			`M: object vocab-help lookup-vocab vocab-help ;`
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: f vocab-help ;`

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

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

Rename vocab to lookup-vocab 2011-10-24 06:37:47 -04:00			`M: object vocab-main lookup-vocab vocab-main ;`
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: 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 -- )`
remq -> remove-eq, delq -> remove-eq! 2009-10-28 01:23:08 -04:00			`vocab-observers get remove-eq! drop ;`
Adding and removing vocabs now updates all-vocabs-seq 2009-05-01 08:21:56 -04:00
			`: notify-vocab-observers ( -- )`
			`vocab-observers get [ vocabs-changed ] each ;`

Initial import 2007-09-20 18:09:08 -04:00			`: create-vocab ( name -- vocab )`
Implement stricter vocab search path semantics, with a new API for vocabs.parser. Add map-find-last to sequences vocab 2009-05-14 23:31:29 -04:00			`check-vocab-name`
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
Cleanup vocab name validation. Vocab names and vocab prefixes are the same concept, and by disallowing slashes, spaces, and colon, we automatically check for absolute paths. Unit test this. 2011-10-29 02:39:40 -04:00			`M: object >vocab-link dup lookup-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 -- )`
require-if loads vocabs conditionally, now or later 2010-03-18 00:00:32 -04:00			`[ words forget-all ]`
Fixing require-when 2010-04-18 15:08:21 -04:00			`[ vocab-name dictionary get delete-at ] bi`
Adding and removing vocabs now updates all-vocabs-seq 2009-05-01 08:21:56 -04:00			`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 ;`

remq -> remove-eq, delq -> remove-eq! 2009-10-28 01:23:08 -04:00			`INSTANCE: vocab-spec definition`