<commit_before>! Copyright (C) 2007, 2010 <NAME>, <NAME>,
! <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators compiler.units
continuations hash-sets hashtables kernel math namespaces
parser.notes sequences sets sorting splitting vectors vocabs
words ;
IN: vocabs.parser

ERROR: no-word-error name ;

: word-restarts ( possibilities -- restarts )
    natural-sort
    [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc ;

: word-restarts-with-defer ( name possibilities -- restarts )
    word-restarts
    swap "Defer word in current vocabulary" swap 2array
    suffix ;

: <no-word-error> ( name possibilities -- error restarts )
    [ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;

TUPLE: manifest
current-vocab
{ search-vocab-names hash-set }
{ search-vocabs vector }
{ qualified-vocabs vector }
{ auto-used vector } ;

: <manifest> ( -- manifest )
    manifest new
        HS{ } clone >>search-vocab-names
        V{ } clone >>search-vocabs
        V{ } clone >>qualified-vocabs
        V{ } clone >>auto-used ;

M: manifest clone
    call-next-method
        [ clone ] change-search-vocab-names
        [ clone ] change-search-vocabs
        [ clone ] change-qualified-vocabs
        [ clone ] change-auto-used ;

TUPLE: extra-words words ;

M: extra-words equal?
    over extra-words? [ [ words>> ] bi@ eq? ] [ 2drop f ] if ;

C: <extra-words> extra-words

ERROR: no-word-in-vocab word vocab ;

<PRIVATE

: (from) ( vocab words -- vocab words words' vocab )
    2dup swap load-vocab ;

: extract-words ( seq vocab -- assoc )
    [ words>> extract-keys dup ] [ name>> ] bi
    [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ;

: excluding-words ( seq vocab -- assoc )
    [ nip words>> ] [ extract-words ] 2bi assoc-diff ;

: qualified-words ( prefix vocab -- assoc )
    words>> swap [ swap [ swap ":" glue ] dip ] curry assoc-map ;

: (lookup) ( name assoc -- word/f )
    at* [ dup forward-reference? [ drop f ] when ] when ;

PRIVATE>

: qualified-vocabs ( -- qualified-vocabs )
    manifest get qualified-vocabs>> ;

: set-current-vocab ( name -- )
    create-vocab
    [ manifest get current-vocab<< ]
    [ qualified-vocabs push ] bi ;

: with-current-vocab ( name quot -- )
    manifest get clone manifest [
        [ set-current-vocab ] dip call
    ] with-variable ; inline

TUPLE: no-current-vocab-error ;

: no-current-vocab ( -- vocab )
    no-current-vocab-error boa
    { { "Define words in scratchpad vocabulary" "scratchpad" } }
    throw-restarts dup set-current-vocab ;

: current-vocab ( -- vocab )
    manifest get current-vocab>> [ no-current-vocab ] unless* ;

: begin-private ( -- )
    current-vocab name>> ".private" ?tail
    [ drop ] [ ".private" append set-current-vocab ] if ;

: end-private ( -- )
    current-vocab name>> ".private" ?tail
    [ set-current-vocab ] [ drop ] if ;

: using-vocab? ( vocab -- ? )
    vocab-name manifest get search-vocab-names>> in? ;

: use-vocab ( vocab -- )
    dup using-vocab?
    [ vocab-name "Already using ``" "'' vocabulary" surround note. ] [
        manifest get
        [ [ load-vocab ] dip search-vocabs>> push ]
        [ [ vocab-name ] dip search-vocab-names>> adjoin ]
        2bi
    ] if ;

: auto-use-vocab ( vocab -- )
    [ use-vocab ] [ manifest get auto-used>> push ] bi ;

: auto-used? ( -- ? )
    manifest get auto-used>> length 0 > ;

: unuse-vocab ( vocab -- )
    dup using-vocab? [
        manifest get<commit_msg>vocabs.parser: error on unbalanced private declarations.<commit_after>! Copyright (C) 2007, 2010 <NAME>, <NAME>,
! <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs combinators compiler.units
continuations hash-sets hashtables kernel math namespaces
parser.notes sequences sets sorting splitting vectors vocabs
words ;
IN: vocabs.parser

ERROR: no-word-error name ;

: word-restarts ( possibilities -- restarts )
    natural-sort
    [ [ vocabulary>> "Use the " " vocabulary" surround ] keep ] { } map>assoc ;

: word-restarts-with-defer ( name possibilities -- restarts )
    word-restarts
    swap "Defer word in current vocabulary" swap 2array
    suffix ;

: <no-word-error> ( name possibilities -- error restarts )
    [ drop \ no-word-error boa ] [ word-restarts-with-defer ] 2bi ;

TUPLE: manifest
current-vocab
{ search-vocab-names hash-set }
{ search-vocabs vector }
{ qualified-vocabs vector }
{ auto-used vector } ;

: <manifest> ( -- manifest )
    manifest new
        HS{ } clone >>search-vocab-names
        V{ } clone >>search-vocabs
        V{ } clone >>qualified-vocabs
        V{ } clone >>auto-used ;

M: manifest clone
    call-next-method
        [ clone ] change-search-vocab-names
        [ clone ] change-search-vocabs
        [ clone ] change-qualified-vocabs
        [ clone ] change-auto-used ;

TUPLE: extra-words words ;

M: extra-words equal?
    over extra-words? [ [ words>> ] bi@ eq? ] [ 2drop f ] if ;

C: <extra-words> extra-words

ERROR: no-word-in-vocab word vocab ;

<PRIVATE

: (from) ( vocab words -- vocab words words' vocab )
    2dup swap load-vocab ;

: extract-words ( seq vocab -- assoc )
    [ words>> extract-keys dup ] [ name>> ] bi
    [ swap [ 2drop ] [ no-word-in-vocab ] if ] curry assoc-each ;

: excluding-words ( seq vocab -- assoc )
    [ nip words>> ] [ extract-words ] 2bi assoc-diff ;

: qualified-words ( prefix vocab -- assoc )
    words>> swap [ swap [ swap ":" glue ] dip ] curry assoc-map ;

: (lookup) ( name assoc -- word/f )
    at* [ dup forward-reference? [ drop f ] when ] when ;

PRIVATE>

: qualified-vocabs ( -- qualified-vocabs )
    manifest get qualified-vocabs>> ;

: set-current-vocab ( name -- )
    create-vocab
    [ manifest get current-vocab<< ]
    [ qualified-vocabs push ] bi ;

: with-current-vocab ( name quot -- )
    manifest get clone manifest [
        [ set-current-vocab ] dip call
    ] with-variable ; inline

TUPLE: no-current-vocab-error ;

: no-current-vocab ( -- vocab )
    no-current-vocab-error boa
    { { "Define words in scratchpad vocabulary" "scratchpad" } }
    throw-restarts dup set-current-vocab ;

: current-vocab ( -- vocab )
    manifest get current-vocab>> [ no-current-vocab ] unless* ;

ERROR: unbalanced-private-declaration vocab ;

: begin-private ( -- )
    current-vocab name>> ".private" ?tail
    [ unbalanced-private-declaration ]
    [ ".private" append set-current-vocab ] if ;

: end-private ( -- )
    current-vocab name>> ".private" ?tail
    [ set-current-vocab ]
    [ unbalanced-private-declaration ] if ;

: using-vocab? ( vocab -- ? )
    vocab-name manifest get search-vocab-names>> in? ;

: use-vocab ( vocab -- )
    dup using-vocab?
    [ vocab-name "Already using ``" "'' vocabulary" surround note. ] [
        manifest get
        [ [ load-vocab ] dip search-vocabs>> push ]
        [ [ vocab-name ] dip search-vocab-names>> adjoin ]
        2bi
    ] if ;

: auto-use-vocab ( vocab -- )
    [ use-vocab ] [ manifest get auto-used>> push ] bi ;

: auto-used? ( -- ? )
    manifest get auto-used>> length 0 > ;

: unuse-vocab ( vocab -- )
    dup using-vocab? [
        manifest get
{'fraction_non_alphanumeric': 0.1383866481223922, 'fraction_numerical': 0.004450625869262865, 'mean_word_length': 2.5937031484257873, 'pattern_counts': {'":': 2, '<': 21, '<?xml version=': 0, '>': 97, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6063781', 'n_tokens_mistral': 2531, 'n_tokens_neox': 2453, 'n_words': 621}