<commit_before>! Copyright (C) 2007, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel words sequences generic math namespaces
quotations assocs combinators math.bitfields inference.backend
inference.dataflow inference.state tuples.private effects ;
IN: inference.transforms

: pop-literals ( n -- rstate seq )
    dup zero? [
        drop recursive-state get { }
    ] [
        dup ensure-values
        f swap [ 2drop pop-literal ] map reverse
    ] if ;

: transform-quot ( quot n -- newquot )
    [ pop-literals [ ] each ] curry
    swap
    [ swap infer-quot ] 3compose ;

: define-transform ( word quot n -- )
    transform-quot "infer" set-word-prop ;

! Combinators
\ cond [
    cond>quot
] 1 define-transform

\ case [
    dup empty? [
        drop [ no-case ]
    ] [
        dup peek quotation? [
            dup peek swap 1 head*
        ] [
            [ no-case ] swap
        ] if hash-case>quot
    ] if
] 1 define-transform

! Bitfields
GENERIC: (bitfield-quot) ( spec -- quot )

M: integer (bitfield-quot) ( spec -- quot )
    [ swapd shift bitor ] curry ;

M: pair (bitfield-quot) ( spec -- quot )
    first2 over word? [ >r swapd execute r> ] [ ] ?
    [ shift bitor ] append 2curry ;

: bitfield-quot ( spec -- quot )
    [ (bitfield-quot) ] map [ 0 ] add* concat ;

\ bitfield [ bitfield-quot ] 1 define-transform

! Tuple operations
: [get-slots] ( slots -- quot )
    [ [ 1quotation , \ keep , ] each \ drop , ] [ ] make ;

\ get-slots [ [get-slots] ] 1 define-transform

\ set-slots [ <reversed> [get-slots] ] 1 define-transform

\ construct-boa [
    dup +inlined+ depends-on
    dup tuple-size [ <tuple-boa> ] 2curry
] 1 define-transform

\ construct-empty [
    1 ensure-values
    peek-d value? [
        pop-literal
        dup +inlined+ depends-on
        dup tuple-size [ <tuple> ] 2curry
        swap infer-quot
    ] [
        \ construct-empty declared-infer
    ] if
] "infer" set-word-prop

\ construct-empty 1 1 <effect> "inferred-effect" set-word-prop<commit_msg>Fix construct-empty transform<commit_after>! Copyright (C) 2007, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: arrays kernel words sequences generic math namespaces
quotations assocs combinators math.bitfields inference.backend
inference.dataflow inference.state tuples.private effects ;
IN: inference.transforms

: pop-literals ( n -- rstate seq )
    dup zero? [
        drop recursive-state get { }
    ] [
        dup ensure-values
        f swap [ 2drop pop-literal ] map reverse
    ] if ;

: transform-quot ( quot n -- newquot )
    [ pop-literals [ ] each ] curry
    swap
    [ swap infer-quot ] 3compose ;

: define-transform ( word quot n -- )
    transform-quot "infer" set-word-prop ;

! Combinators
\ cond [
    cond>quot
] 1 define-transform

\ case [
    dup empty? [
        drop [ no-case ]
    ] [
        dup peek quotation? [
            dup peek swap 1 head*
        ] [
            [ no-case ] swap
        ] if hash-case>quot
    ] if
] 1 define-transform

! Bitfields
GENERIC: (bitfield-quot) ( spec -- quot )

M: integer (bitfield-quot) ( spec -- quot )
    [ swapd shift bitor ] curry ;

M: pair (bitfield-quot) ( spec -- quot )
    first2 over word? [ >r swapd execute r> ] [ ] ?
    [ shift bitor ] append 2curry ;

: bitfield-quot ( spec -- quot )
    [ (bitfield-quot) ] map [ 0 ] add* concat ;

\ bitfield [ bitfield-quot ] 1 define-transform

! Tuple operations
: [get-slots] ( slots -- quot )
    [ [ 1quotation , \ keep , ] each \ drop , ] [ ] make ;

\ get-slots [ [get-slots] ] 1 define-transform

\ set-slots [ <reversed> [get-slots] ] 1 define-transform

\ construct-boa [
    dup +inlined+ depends-on
    dup tuple-size [ <tuple-boa> ] 2curry
] 1 define-transform

\ construct-empty [
    1 ensure-values
    peek-d value? [
        pop-literal
        dup +inlined+ depends-on
        dup tuple-size [ <tuple> ] 2curry
        swap infer-quot
    ] [
        \ construct-empty 1 1 <effect> make-call-node
    ] if
] "infer" set-word-prop

\ construct-empty 1 1 <effect> "inferred-effect" set-word-prop
{'fraction_non_alphanumeric': 0.12290502793296089, 'fraction_numerical': 0.013116346854505708, 'mean_word_length': 2.283891547049442, 'pattern_counts': {'":': 0, '<': 14, '<?xml version=': 0, '>': 22, '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': '1550182', 'n_tokens_mistral': 1423, 'n_tokens_neox': 1345, 'n_words': 380}