<commit_before>! Copyright (C) 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences fry words math
math.partial-dispatch combinators arrays hashtables
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.info ;
IN: compiler.tree.identities

: define-identities ( word identities -- )
    [ integer-derived-ops ] dip
    '[ _ "identities" set-word-prop ] each ;

SYMBOL: X

\ + {
    { { X 0 } drop }
    { { 0 X } nip }
} define-identities

\ - {
    { { X 0 } drop }
} define-identities

\ * {
    { { X 1 } drop }
    { { 1 X } nip }
    { { X 0 } nip }
    { { 0 X } drop }
} define-identities

\ / {
    { { X 1 } drop }
} define-identities

\ mod {
    { { X 1 } 0 }
} define-identities

\ rem {
    { { X 1 } 0 }
} define-identities

\ bitand {
    { { X -1 } drop }
    { { -1 X } nip }
    { { X 0 } nip }
    { { 0 X } drop }
} define-identities

\ bitor {
    { { X 0 } drop }
    { { 0 X } nip }
    { { X -1 } nip }
    { { -1 X } drop }
} define-identities

\ bitxor {
    { { X 0 } drop }
    { { 0 X } nip }
} define-identities

\ shift {
    { { 0 X } drop }
    { { X 0 } drop }
} define-identities

: matches? ( pattern infos -- ? )
    [ over X eq? [ 2drop t ] [ literal>> = ] if ] 2all? ;

: find-identity ( patterns infos -- result )
    '[ first _ matches? ] find swap [ second ] when ;

GENERIC: apply-identities* ( node -- node )

: simplify-to-constant ( #call constant -- nodes )
    [ [ in-d>> #drop ] [ out-d>> first ] bi ] dip swap #push
    2array ;

: select-input ( node n -- #shuffle )
    [ [ in-d>> ] [ out-d>> ] bi ] dip
    pick nth over first associate #data-shuffle ;

M: #call apply-identities*
    dup word>> "identities" word-prop [
        over node-input-infos find-identity [
            {
                { \ drop [ 0 select-input ] }
                { \ nip [ 1 select-input ] }
                [ simplify-to-constant ]
            } case
        ] when*
    ] when* ;

M: node apply-identities* ;

: apply-identities ( nodes -- nodes' )
    [ apply-identities* ] map-nodes ;
<commit_msg>Remove identities on / and rem, which were no-ops because integer-derived-ops would return an empty array<commit_after>! Copyright (C) 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors kernel sequences fry words math
math.partial-dispatch combinators arrays hashtables
compiler.tree
compiler.tree.combinators
compiler.tree.propagation.info ;
IN: compiler.tree.identities

: define-identities ( word identities -- )
    [ integer-derived-ops dup empty? f assert= ] dip
    '[ _ "identities" set-word-prop ] each ;

SYMBOL: X

\ + {
    { { X 0 } drop }
    { { 0 X } nip }
} define-identities

\ - {
    { { X 0 } drop }
} define-identities

\ * {
    { { X 1 } drop }
    { { 1 X } nip }
    { { X 0 } nip }
    { { 0 X } drop }
} define-identities

\ mod {
    { { X 1 } 0 }
} define-identities

\ bitand {
    { { X -1 } drop }
    { { -1 X } nip }
    { { X 0 } nip }
    { { 0 X } drop }
} define-identities

\ bitor {
    { { X 0 } drop }
    { { 0 X } nip }
    { { X -1 } nip }
    { { -1 X } drop }
} define-identities

\ bitxor {
    { { X 0 } drop }
    { { 0 X } nip }
} define-identities

\ shift {
    { { 0 X } drop }
    { { X 0 } drop }
} define-identities

: matches? ( pattern infos -- ? )
    [ over X eq? [ 2drop t ] [ literal>> = ] if ] 2all? ;

: find-identity ( patterns infos -- result )
    '[ first _ matches? ] find swap [ second ] when ;

GENERIC: apply-identities* ( node -- node )

: simplify-to-constant ( #call constant -- nodes )
    [ [ in-d>> #drop ] [ out-d>> first ] bi ] dip swap #push
    2array ;

: select-input ( node n -- #shuffle )
    [ [ in-d>> ] [ out-d>> ] bi ] dip
    pick nth over first associate #data-shuffle ;

M: #call apply-identities*
    dup word>> "identities" word-prop [
        over node-input-infos find-identity [
            {
                { \ drop [ 0 select-input ] }
                { \ nip [ 1 select-input ] }
                [ simplify-to-constant ]
            } case
        ] when*
    ] when* ;

M: node apply-identities* ;

: apply-identities ( nodes -- nodes' )
    [ apply-identities* ] map-nodes ;

{'fraction_non_alphanumeric': 0.150853889943074, 'fraction_numerical': 0.014943074003795066, 'mean_word_length': 1.9022711631108051, 'pattern_counts': {'":': 0, '<': 5, '<?xml version=': 0, '>': 29, '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': '4325329', 'n_tokens_mistral': 1562, 'n_tokens_neox': 1488, 'n_words': 405}