<commit_before>! Copyright (C) 2007, 2010 <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs continuations init kernel make
namespaces sequences sets ;
FROM: namespaces => set ;
IN: destructors

SYMBOL: disposables

ERROR: already-unregistered disposable ;

SYMBOL: debug-leaks?

<PRIVATE

SLOT: continuation

: register-disposable ( obj -- )
    debug-leaks? get-global [ current-continuation >>continuation ] when
    disposables get conjoin ;

: unregister-disposable ( obj -- )
    disposables get 2dup key? [ delete-at ] [ drop already-unregistered ] if ;

PRIVATE>

TUPLE: disposable < identity-tuple
{ disposed boolean }
continuation ;

: new-disposable ( class -- disposable )
    new dup register-disposable ; inline

GENERIC: dispose* ( disposable -- )

ERROR: already-disposed disposable ;

: check-disposed ( disposable -- )
    dup disposed>> [ already-disposed ] [ drop ] if ; inline

GENERIC: dispose ( disposable -- )

: unless-disposed ( disposable quot -- )
    [ dup disposed>> [ drop ] ] dip if ; inline

M: object dispose [ t >>disposed dispose* ] unless-disposed ;

M: disposable dispose
    [
        [ unregister-disposable ]
        [ call-next-method ]
        bi
    ] unless-disposed ;

: dispose-each ( seq -- )
    [
        [ [ dispose ] curry [ , ] recover ] each
    ] { } make [ last rethrow ] unless-empty ;

: with-disposal ( object quot -- )
    over [ dispose ] curry [ ] cleanup ; inline

<PRIVATE

SYMBOL: always-destructors

SYMBOL: error-destructors

: do-always-destructors ( -- )
    always-destructors get <reversed> dispose-each ;

: do-error-destructors ( -- )
    error-destructors get <reversed> dispose-each ;

PRIVATE>

: &dispose ( disposable -- disposable )
    dup always-destructors get push ; inline

: |dispose ( disposable -- disposable )
    dup error-destructors get push ; inline

: with-destructors ( quot -- )
    [
        V{ } clone always-destructors set
        V{ } clone error-destructors set
        [ do-always-destructors ]
        [ do-error-destructors ]
        cleanup<commit_msg>destructors: adding dispose,.<commit_after>! Copyright (C) 2007, 2010 <NAME>, <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors assocs continuations init kernel make
namespaces sequences sets ;
FROM: namespaces => set ;
IN: destructors

SYMBOL: disposables

ERROR: already-unregistered disposable ;

SYMBOL: debug-leaks?

<PRIVATE

SLOT: continuation

: register-disposable ( obj -- )
    debug-leaks? get-global [ current-continuation >>continuation ] when
    disposables get conjoin ;

: unregister-disposable ( obj -- )
    disposables get 2dup key? [ delete-at ] [ drop already-unregistered ] if ;

PRIVATE>

TUPLE: disposable < identity-tuple
{ disposed boolean }
continuation ;

: new-disposable ( class -- disposable )
    new dup register-disposable ; inline

GENERIC: dispose* ( disposable -- )

ERROR: already-disposed disposable ;

: check-disposed ( disposable -- )
    dup disposed>> [ already-disposed ] [ drop ] if ; inline

GENERIC: dispose ( disposable -- )

: unless-disposed ( disposable quot -- )
    [ dup disposed>> [ drop ] ] dip if ; inline

M: object dispose [ t >>disposed dispose* ] unless-disposed ;

M: disposable dispose
    [
        [ unregister-disposable ]
        [ call-next-method ]
        bi
    ] unless-disposed ;

: dispose, ( obj -- )
    [ dispose ] curry [ , ] recover ; inline

: dispose-each ( seq -- )
    [ [ dispose, ] each ] { } make
    [ last rethrow ] unless-empty ;

: with-disposal ( object quot -- )
    over [ dispose ] curry [ ] cleanup ; inline

<PRIVATE

SYMBOL: always-destructors

SYMBOL: error-destructors

: do-always-destructors ( -- )
    always-destructors get <reversed> dispose-each ;

: do-error-destructors ( -- )
    error-destructors get <reversed> dispose-each ;

PRIVATE>

: &dispose ( disposable -- disposable )
    dup always-destructors get push ; inline

: |dispose ( disposable -- disposable )
    dup error-destructors get push ; inline

: with-destructors ( quot -- )
    [
        V{ } clone always-destructors set
        V{ } clone error-destructors set
        [ do-always-destructors ]
        [ do-error-destructors ]
        cleanup
{'fraction_non_alphanumeric': 0.11580925534413906, 'fraction_numerical': 0.004228329809725159, 'mean_word_length': 2.9136029411764706, 'pattern_counts': {'":': 0, '<': 17, '<?xml version=': 0, '>': 33, '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': '2745706', 'n_tokens_mistral': 1377, 'n_tokens_neox': 1258, 'n_words': 353}