! this is a (likely) buggy implementation of quotations with words scoped to their boundaries
! this is not a full vocabulary, just some code written and tested in the listener as a proof of concept

TUPLE: scoped words quot ;
! callable is a union, so it can't be extended. I'm not sure if scoped not being in callable will cause any problems. Maybe you can use the delegate vocab to fix some of these
M: scoped call [ words>> ] [ quot>> ] bi with-words ; inline
CONSULT: sequence-protocol scoped quot>> ;
M: scoped like drop [ ] like H{ } clone swap scoped boa ;

DEFER: [:
: :] ( -- ) ; delimiter
M: scoped pprint-delims drop \ [: \ :] ;
M: scoped >pprint-sequence ;
M: scoped pprint* pprint-object ;

! a vector of hashtables, containing the words defined at each "level" of the scope
INITIALIZED-SYMBOL: scope [ V{ } clone ]

! doesn't care if a word doesn't exist
: safe-parse-datum ( string -- word/number )
    [ search ] [ [ dec> ] [ <uninterned-word> ] ?unless ]
    ?unless ;
: safe-?scan-datum ( -- word/number/f )
    ?scan-token [ safe-parse-datum ] ?call ;
: safe-(parse-until) ( accum end -- accum )
    [
        safe-?scan-datum {
            { [ 2dup eq? ] [ 2drop f ] }
            { [ dup not ] [ drop throw-unexpected-eof ] }
            { [ dup delimiter? ] [ unexpected ] }
            { [ dup parsing-word? ] [ nip execute-parsing t ] }
            [ pick push drop t ]
        } cond
    ] curry loop ;
: safe-parse-until ( end -- vec ) [ 100 <vector> ] dip safe-(parse-until) ;

: flatten-assoc-seq ( seq -- assoc )
    H{ } clone [ assoc-union ] reduce ;
: search-scoped-words ( word -- word/f )
    [ name>> scope get-global flatten-assoc-seq at ] transmute ;
: check-scoped ( scoped -- scoped )
    [ [ dup word? [ search-scoped-words ] when ] deep-map ] change-quot ;
: parse-scoped ( -- scoped )
    scope get-global H{ } clone [ suffix! drop ] keep
    \ :] safe-parse-until >quotation scoped boa
    check-scoped scope get-global pop drop ;
SYNTAX: [: parse-scoped suffix! ;

! this should be in the core vocabs. It just deletes a word
: delete-word ( word -- )
    [
        [ name>> ] [ vocabulary>> ] bi
        vocab-words-assoc delete-at
    ] keep [ name>> ] keep associate unuse-words ;

! localword is an annotation on words (similar to inline) that confines words to the local scope. It can only be used within a scope, and throws an error if not
! it removes the last defined word from the current vocabulary, and puts it in the last assoc in the 'scope' variable
ERROR: localword-used-outside-scope ;
SYNTAX: localword
    last-word dup name>> scope get-global dup length 0 > [
        [
            [
                <uninterned-word> over
                [ definition ] [ stack-effect ] [ props>> ] tri
                [ [ define-declared ] keepdd ] dip >>props
            ] keep
        ] dip last set-at delete-word
    ] [ localword-used-outside-scope ] if ;