<commit_before>! Copyright (C) 2008, 2010 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays byte-vectors classes
combinators definitions fry generic generic.single
generic.standard hashtables kernel kernel.private math
math.parser parser sbufs sequences sequences.private splitting
strings vectors words ;
IN: hints

GENERIC: specializer-predicate ( spec -- quot )

M: class specializer-predicate '[ _ instance? ] ;

M: object specializer-predicate '[ _ eq? ] ;

GENERIC: specializer-declaration ( spec -- class )

M: class specializer-declaration ;

M: object specializer-declaration class-of ;

: specializer ( word -- specializer )
    "specializer" word-prop ;

: make-specializer ( specs -- quot )
    dup length <iota> <reversed>
    [ (picker) 2array ] 2map
    [ drop object eq? ] assoc-reject
    [ [ t ] ] [
        [ swap specializer-predicate append ] { } assoc>map
        [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
    ] if-empty ;

: specializer-cases ( quot specializer -- alist )
    dup [ array? ] all? [ 1array ] unless [
        [ nip make-specializer ]
        [ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi
    ] with { } map>assoc ;

: specialize-quot ( quot specializer -- quot' )
    [ drop ] [ specializer-cases ] 2bi alist>quot ;

: method-declaration ( method -- quot )
    [ "method-generic" word-prop dispatch# object <array> ]
    [ "method-class" word-prop ]
    bi prefix [ declare ] curry [ ] like ;

: specialize-method ( quot method -- quot' )
    [ method-declaration prepend ]
    [ "method-generic" word-prop ] bi
    specializer [ specialize-quot ] when* ;

: standard-method? ( method -- ? )
    dup method? [
        "method-generic" word-prop standard-generic?
    ] [ drop f ] if ;

: specialized-def ( word -- quot )
    [ def>> ] keep
    dup generic? [ drop ] [
        [ dup standard-method? [ specialize-method ] [ drop ] if ]
        [ specializer [ specialize-quot ] when* ]
        bi
    ] if ;

: specialized-length ( specializer -- n )
    dup [ array? ] all? [ first ] when length ;

ERROR: cannot-specialize word specializer ;

: set-specializer ( word specializer -- )
    over inline-recursive? [ cannot-specialize ] when
    "specializer" set-word-prop ;

SYNTAX: HINTS:
    scan-object dup wrapper? [ wrapped>> ] when
    [ changed-definition ]
    [ subwords [ changed-definition ] each ]
    [ parse-definition { } like set-specializer ] tri ;

! Default specializers
{ pop* pop push last } [
    { vector } set-specializer
] each

\ set-last { { object vector } } set-specializer

\ push-all
{ { string sbuf } { array vector } { byte-array byte-vector } }
set-specializer

{ append prepend } [
    { { string string } { array array } }
    set-specializer
] each

{ subseq subseq-unsafe } [
    { { fixnum fixnum string } { fixnum fixnum array } }
    set-specializer
] each

\ reverse!
{ { string } { array } }
set-specializer

\ mismatch
{ string string }
set-specializer

\ >string { sbuf } set-specializer

\ >array { { vector } } set-specializer

\ >vector { { array } { vector } } set-specializer

\ >sbuf { string } set-specializer

\ split { string string } set-specializer

\ member? { { array } { string } } set-specializer

\ member-eq? { { array } { string } } set-specializer
<commit_msg>hints: adding suffix/prefix to match append/prepend<commit_after>! Copyright (C) 2008, 2010 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays assocs byte-arrays byte-vectors classes
combinators definitions fry generic generic.single
generic.standard hashtables kernel kernel.private math
math.parser parser sbufs sequences sequences.private splitting
strings vectors words ;
IN: hints

GENERIC: specializer-predicate ( spec -- quot )

M: class specializer-predicate '[ _ instance? ] ;

M: object specializer-predicate '[ _ eq? ] ;

GENERIC: specializer-declaration ( spec -- class )

M: class specializer-declaration ;

M: object specializer-declaration class-of ;

: specializer ( word -- specializer )
    "specializer" word-prop ;

: make-specializer ( specs -- quot )
    dup length <iota> <reversed>
    [ (picker) 2array ] 2map
    [ drop object eq? ] assoc-reject
    [ [ t ] ] [
        [ swap specializer-predicate append ] { } assoc>map
        [ ] [ swap [ f ] \ if 3array append [ ] like ] map-reduce
    ] if-empty ;

: specializer-cases ( quot specializer -- alist )
    dup [ array? ] all? [ 1array ] unless [
        [ nip make-specializer ]
        [ [ specializer-declaration ] map swap '[ _ declare @ ] ] 2bi
    ] with { } map>assoc ;

: specialize-quot ( quot specializer -- quot' )
    [ drop ] [ specializer-cases ] 2bi alist>quot ;

: method-declaration ( method -- quot )
    [ "method-generic" word-prop dispatch# object <array> ]
    [ "method-class" word-prop ]
    bi prefix [ declare ] curry [ ] like ;

: specialize-method ( quot method -- quot' )
    [ method-declaration prepend ]
    [ "method-generic" word-prop ] bi
    specializer [ specialize-quot ] when* ;

: standard-method? ( method -- ? )
    dup method? [
        "method-generic" word-prop standard-generic?
    ] [ drop f ] if ;

: specialized-def ( word -- quot )
    [ def>> ] keep
    dup generic? [ drop ] [
        [ dup standard-method? [ specialize-method ] [ drop ] if ]
        [ specializer [ specialize-quot ] when* ]
        bi
    ] if ;

: specialized-length ( specializer -- n )
    dup [ array? ] all? [ first ] when length ;

ERROR: cannot-specialize word specializer ;

: set-specializer ( word specializer -- )
    over inline-recursive? [ cannot-specialize ] when
    "specializer" set-word-prop ;

SYNTAX: HINTS:
    scan-object dup wrapper? [ wrapped>> ] when
    [ changed-definition ]
    [ subwords [ changed-definition ] each ]
    [ parse-definition { } like set-specializer ] tri ;

! Default specializers
{ pop* pop push last } [
    { vector } set-specializer
] each

\ set-last { { object vector } } set-specializer

\ push-all
{ { string sbuf } { array vector } { byte-array byte-vector } }
set-specializer

{ append prepend } [
    { { string string } { array array } }
    set-specializer
] each

{ suffix prefix } [
    { { string object } { array object } }
    set-specializer
] each

\ subseq
{ { fixnum fixnum string } { fixnum fixnum array } }
set-specializer

\ reverse!
{ { string } { array } }
set-specializer

\ mismatch
{ string string }
set-specializer

\ >string { sbuf } set-specializer

\ >array { { vector } } set-specializer

\ >vector { { array } { vector } } set-specializer

\ >sbuf { string } set-specializer

\ split { string string } set-specializer

\ member? { { array } { string } } set-specializer

\ member-eq? { { array } { string } } set-specializer

{'fraction_non_alphanumeric': 0.12584533960599822, 'fraction_numerical': 0.004116436342252279, 'mean_word_length': 2.8154795288839036, 'pattern_counts': {'":': 0, '<': 11, '<?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': '4086331', 'n_tokens_mistral': 2157, 'n_tokens_neox': 2099, 'n_words': 579}