<commit_before>! Copyright (C) 2008 <NAME>
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences symbols fry words assocs tools.annotations coroutines ;
IN: advice

! TODO: What should be the order in which the advice is called?

SYMBOLS: before after around advised ;

<PRIVATE
: advise ( quot name word loc --  )
    word-prop set-at ;
PRIVATE>
    
: advise-before ( quot name word --  )
    before advise ;
    
: advise-after ( quot name word --  )
    after advise ;

: advise-around ( quot name word --  )
    [ \ coreset suffix cocreate ] 2dip
    around advise ;

: get-advice ( word type -- seq )
    word-prop values ;

: call-before ( word --  )
    before get-advice [ call ] each ;

: call-after ( word --  )
    after get-advice [ call ] each ;

: call-around ( main word --  )
    around get-advice tuck 
    [ [ coresume ] each ] [ call ] [ reverse [ coresume ] each ] tri* ;

: remove-advice ( name word loc --  )
    word-prop delete-at ;

: ad-do-it ( input -- result )
    coyield ;

: advised? ( word -- ? )
    advised word-prop ;
    
: make-advised ( word -- )
    [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
    [ { before after around } [ H{ } clone swap set-word-prop ] with each ] 
    [ t advised set-word-prop ] tri ;

: unadvise ( word --  )
    [ reset ] [ { before after around advised } [ f swap set-word-prop ] with each ] bi ;<commit_msg>More work on advice, cleaning it up (TESTS FAIL)<commit_after>! Copyright (C) 2008 <NAME>
! See http://factorcode.org/license.txt for BSD license.
USING: kernel sequences symbols fry words assocs linked-assocs tools.annotations
coroutines lexer parser quotations arrays namespaces continuations ;
IN: advice

SYMBOLS: before after around advised in-advice? ;

: advised? ( word -- ? )
    advised word-prop ;

DEFER: make-advised

<PRIVATE
: init-around-co ( quot -- coroutine )
    \ coreset suffix cocreate ;
PRIVATE>

: advise ( quot name word loc --  )
    dup around eq? [ [ init-around-co ] 3dip ] when
    over advised? [ over make-advised ] unless
    word-prop set-at ;
    
: advise-before ( quot name word --  ) before advise ;
    
: advise-after ( quot name word --  ) after advise ;

: advise-around ( quot name word --  ) around advise ;

: get-advice ( word type -- seq )
    word-prop values ;

: call-before ( word --  )
    before get-advice [ call ] each ;

: call-after ( word --  )
    after get-advice [ call ] each ;

: call-around ( main word --  )
    t in-advice? [
        around get-advice tuck 
        [ [ coresume ] each ] [ call ] [ <reversed> [ coresume ] each ] tri*
    ] with-variable ;

: remove-advice ( name word loc --  )
    word-prop delete-at ;

: ad-do-it ( input -- result )
    in-advice? get [ "ad-do-it should only be called inside 'around' advice" throw ] unless coyield ;
    
: make-advised ( word -- )
    [ dup [ over dup '[ _ call-before _ _ call-around _ call-after ] ] annotate ]
    [ { before after around } [ <linked-hash> swap set-word-prop ] with each ] 
    [ t advised set-word-prop ] tri ;

: unadvise ( word --  )
    [ reset ] [ { before after around advised } [ f swap set-word-prop ] with each ] bi ;

: ADVISE: ! word adname location => word adname quot loc
    scan-word scan scan-word parse-definition swap [ spin ] dip advise ; parsing
    
: UNADVISE:    
    scan-word parsed \ unadvise parsed ; parsing
{'fraction_non_alphanumeric': 0.12126537785588752, 'fraction_numerical': 0.0029291154071470417, 'mean_word_length': 2.4460141271442986, 'pattern_counts': {'":': 0, '<': 9, '<?xml version=': 0, '>': 10, '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': '5907471', 'n_tokens_mistral': 1115, 'n_tokens_neox': 1086, 'n_words': 354}