<commit_before>! Copyright (C) 2007, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors alien arrays assocs classes.tuple.private
combinators.short-circuit fry hashtables io kernel
locals.backend make math namespaces prettyprint quotations
sequences sequences.deep shuffle slots.private vectors vocabs
words xml.data words.alias ;
IN: lint

<PRIVATE

CONSTANT: manual-substitutions
    H{
        { -rot [ swap [ swap ] dip ] }
        { -rot [ swap swapd ] }
        { rot [ [ swap ] dip swap ] }
        { rot [ swapd swap ] }
        { over [ dup swap ] }
        { tuck [ dup -rot ] }
        { swapd [ [ swap ] dip ] }
        { 2nip [ nip nip ] }
        { 2drop [ drop drop ] }
        { 3drop [ drop drop drop ] }
        { pop* [ pop drop ] }
        { when [ [ ] if ] }
        { >boolean [ f = not ] }
    }

CONSTANT: trivial-defs
    {
        [ drop t ] [ drop f ]
        [ 2drop t ] [ 2drop f ]
        [ 3drop t ] [ 3drop f ]
        [ ">" write ] [ "/>" write ]
        [ length 1 - ] [ length 1 = ] [ length 1 > ]
        [ drop f f ] [ 2drop f f ]
        [ drop f f f ]
        [ nip f f ]
        [ 0 or + ]
        [ dup 0 > ] [ dup 0 <= ]
        [ dup length iota ]
        [ 0 swap copy ]
        [ dup 1 + ]
    }

: lintable-word? ( word -- ? )
    {
        [ vocabulary>> "specialized-" head? ]
        [ vocabulary>> "windows-messages" = ]
        [ alias? ]
    } 1|| not ;

: lintable-words ( -- words )
    all-words [ lintable-word? ] filter ;

: ignore-def? ( def -- ? )
    {
        ! Remove small defs
        [ length 2 <= ]

        ! Remove trivial defs
        [ trivial-defs member? ]

        ! Remove curry only defs
        [ [ \ curry = ] all? ]

        ! Remove words with locals
        [ [ \ load-locals = ] any? ]

        ! Remove numbers/t/f only defs
        [
            [ { [ number? ] [ t? ] [ f eq? ] } 1|| ] all?
        ]

        ! Remove tag defs
        [
            {
                [ length 3 = ]
                [ first \ tag = ] [ second number? ] [ third \ eq? = ]
            } 1&&
        ]

        ! Remove [ m n shift ]
        [
            {
                [ length 3 = ]
                [ first2 [ number? ] both? ] [ third \ shift = ]
            } 1&&
        ]

        ! Remove [ layout-of n slot ]
        [
            {
                [ length 3 = ]
                [ first \ layout-of = ]
                [ second number? ]
                [ third \ slot = ]
            } 1&&
        ]
    } 1|| ;

: all-callables ( def -- seq )
    [ callable? ] deep-filter ;

: (load-definitions) ( word def hash -- )
    [ all-callables ] dip '[ _ push-at ] with each ;

: load-definitions ( words -- hash )
    H{ } clone [ '[ dup def>> _ (load-definitions) ] each ] keep ;

SYMBOL: lint-definitions
SYMBOL: lint-definitions-keys

: reload-definitions ( -- )
    ! Load lintable and non-ignored definitions
    lintable-words load-definitions
    [ drop ignore-def? not ] assoc-filter

    ! Remove words that are their own definition
    [ [ [ def>> ] [ 1quotation ] bi = not ] filter ] assoc-map

    ! Add manual definitions
    manual-substitutions over '[ _ push-at ] assoc-each

    ! Set globals to new values<commit_msg>lint: filter a bit better.<commit_after>! Copyright (C) 2007, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.

USING: accessors alien arrays assocs classes
classes.tuple.private combinators.short-circuit fry hashtables
io kernel kernel.private locals.backend make math namespaces
prettyprint quotations sequences sequences.deep shuffle
slots.private vectors vocabs words words.alias ;

IN: lint

<PRIVATE

CONSTANT: manual-substitutions
    H{
        { -rot [ swap [ swap ] dip ] }
        { -rot [ swap swapd ] }
        { rot [ [ swap ] dip swap ] }
        { rot [ swapd swap ] }
        { over [ dup swap ] }
        { tuck [ dup -rot ] }
        { swapd [ [ swap ] dip ] }
        { 2nip [ nip nip ] }
        { 2drop [ drop drop ] }
        { 3drop [ drop drop drop ] }
        { pop* [ pop drop ] }
        { when [ [ ] if ] }
        { >boolean [ f = not ] }
    }

CONSTANT: trivial-defs
    {
        [ drop t ] [ drop f ]
        [ 2drop t ] [ 2drop f ]
        [ 3drop t ] [ 3drop f ]
        [ ">" write ] [ "/>" write ]
        [ length 1 - ] [ length 1 = ] [ length 1 > ]
        [ drop f f ] [ drop f t ] [ drop t f ] [ drop t t ]
        [ 2drop f f ] [ 2drop f t ] [ 2drop t f ] [ 2drop t t ]
        [ drop f f f ]
        [ nip f f ]
        [ 0 or + ]
        [ dup 0 > ] [ dup 0 <= ] [ dup 0 < ]
        [ over 0 > ] [ over 0 <= ] [ over 0 < ]
        [ dup length iota ]
        [ 0 swap copy ]
        [ dup 1 + ] [ drop 1 + ]
    }

: lintable-word? ( word -- ? )
    {
        [ vocabulary>> "specialized-" head? ]
        [ vocabulary>> "windows-messages" = ]
        [ alias? ]
    } 1|| not ;

: lintable-words ( -- words )
    all-words [ lintable-word? ] filter ;

: ignore-def? ( def -- ? )
    {
        ! Remove small defs
        [ length 2 <= ]

        ! Remove trivial defs
        [ trivial-defs member? ]

        ! Remove curry only defs
        [ [ \ curry = ] all? ]

        ! Remove words with locals
        [ [ \ load-locals = ] any? ]

        ! Remove numbers/t/f only defs
        [
            [ { [ number? ] [ t? ] [ f eq? ] } 1|| ] all?
        ]

        ! Remove [ tag n eq? ]
        [
            {
                [ length 3 = ]
                [ first \ tag = ] [ second number? ] [ third \ eq? = ]
            } 1&&
        ]

        ! Remove [ { foo } declare class ]
        [
            {
                [ length 3 = ]
                [ first { [ array? ] [ length 1 = ] } 1&& ]
                [ second \ declare = ]
                [ third \ class = ]
            } 1&&
        ]

        ! Remove [ m n shift ]
        [
            {
                [ length 3 = ]
                [ first2 [ number? ] both? ] [ third \ shift = ]
            } 1&&
        ]

        ! Remove [ layout-of n slot ]
        [
            {
                [ length 3 = ]
                [ first \ layout-of = ]
                [ second number? ]
                [ third \ slot = ]
            } 1&&
        ]

        ! Remove [ ... \ cdecl ]
        [
            { [ length 3 = ] [ last \ cdecl = ] } 1&&
        ]
    } 1|| ;

: all-callables ( def -- seq )
    [ { [ callable? ] [ ignore-def? not ] } 1&& ] deep-filter ;

: (load-definitions) ( word def hash -- )
    [ all-callables ] dip '[ _ push-at ] with each ;

: load-definitions ( words -- hash )
    H{ } clone [ '[ dup def>> _ (load-definitions) ] each ] keep ;

SYMBOL: lint-definitions
SYMBOL: lint-definitions-keys

: reload-definitions ( -- )
    ! Load lintable and non-ignored definitions
    lintable-words load-definitions

    ! Remove words that are their own definition
    [ [ [ def>> ] [ 1quotation ] bi = not ] filter ] assoc-map

    ! Add manual definitions
    manual-substitutions over '[ _ push-at ] assoc-each

    ! Set globals to new values
{'fraction_non_alphanumeric': 0.13312517740562022, 'fraction_numerical': 0.012347431166619358, 'mean_word_length': 1.3396414342629481, 'pattern_counts': {'":': 0, '<': 14, '<?xml version=': 0, '>': 32, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 1}, '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': '3911624', 'n_tokens_mistral': 2344, 'n_tokens_neox': 2181, 'n_words': 625}