<commit_before>! Copyright (C) 2004, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors arrays byte-arrays
classes sequences.private continuations.private effects generic
hashtables hashtables.private io io.backend io.files
io.files.private io.streams.c kernel kernel.private math
math.private memory namespaces namespaces.private parser
prettyprint quotations quotations.private sbufs sbufs.private
sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
words.private assocs summary compiler.units system.private
combinators locals locals.backend locals.private words.private
quotations.private stack-checker.values
stack-checker.alien
stack-checker.state
stack-checker.errors
stack-checker.visitor
stack-checker.backend
stack-checker.branches
stack-checker.transforms
stack-checker.recursive-state ;
IN: stack-checker.known-words

: infer-primitive ( word -- )
    dup
    [ "input-classes" word-prop ]
    [ "default-output-classes" word-prop ] bi <effect>
    apply-word/effect ;

{
    { drop  (( x     --             )) }
    { 2drop (( x y   --             )) }
    { 3drop (( x y z --             )) }
    { dup   (( x     -- x x         )) }
    { 2dup  (( x y   -- x y x y     )) }
    { 3dup  (( x y z -- x y z x y z )) }
    { rot   (( x y z -- y z x       )) }
    { -rot  (( x y z -- z x y       )) }
    { dupd  (( x y   -- x x y       )) }
    { swapd (( x y z -- y x z       )) }
    { nip   (( x y   -- y           )) }
    { 2nip  (( x y z -- z           )) }
    { tuck  (( x y   -- y x y       )) }
    { over  (( x y   -- x y x       )) }
    { pick  (( x y z -- x y z x     )) }
    { swap  (( x y   -- y x         )) }
} [ "shuffle" set-word-prop ] assoc-each

: infer-shuffle ( shuffle -- )
    [ in>> length consume-d ] keep ! inputs shuffle
    [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
    [ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
    #shuffle, ;

: infer-shuffle-word ( word -- )
    "shuffle" word-prop infer-shuffle ;

: infer-declare ( -- )
    pop-literal nip
    [ length ensure-d ] keep zip
    #declare, ;

GENERIC: infer-call* ( value known -- )

: infer-call ( value -- ) dup known infer-call* ;

M: literal infer-call*
    [ 1array #drop, ] [ infer-literal-quot ] bi* ;

M: curried infer-call*
    swap push-d
    [ uncurry ] infer-quot-here
    [ quot>> known pop-d [ set-known ] keep ]
    [ obj>> known pop-d [ set-known ] keep ] bi
    push-d infer-call ;

M: composed infer-call*
    swap push-d
    [ uncompose ] infer-quot-here
    [ quot2>> known pop-d [ set-known ] keep ]
    [ quot1>> known pop-d [ set-known ] keep ] bi
    push-d push-d
    1 infer->r pop-d infer-call
    terminated? get [ 1 infer-r> pop-d infer-call ] unless ;

M: object infer-call*
    \ literal-expected inference-warning ;

: infer-curry ( -- )
    2 consume-d
    dup first2 <curried> make-known
    [ push-d ] [ 1array ] bi
    \ curry #call, ;

: infer-compose ( -- )
    2 consume-d
    dup first2 <composed> make-known
    [ push-d ] [ 1array ] bi
    \ compose #call, ;

: infer-execute ( -- )
    pop-literal nip
    dup word? [
        apply-object
    ] [
        drop
        "execute must be given a word" time-bomb
    ] if ;

: infer-<tuple-boa> ( -- )
    \ <tuple-boa>
    peek-d literal value>> second 1+ { tuple } <effect>
    apply-word/effect ;

: infer-(throw) ( -- )
    \ (throw)
    peek-d literal value>> 2 + f <effect> t >>terminated?
    apply-word/effect ;

: infer-exit ( -- )
    \ exit
    { integer } { } t >>terminated? <effect>
    apply-word/effect ;

: infer-load-locals ( -- )
    pop-literal nip
    consume-d dup reverse copy-values dup output-r
    [ [ f f ] dip ] [ reverse swap zip ] 2bi #shuffle, ;

: infer-get-local ( -- )
    [let* | n [ pop-literal nip ]
            in-r [ n consume-r ]
            out-d [ in-r first copy-value 1array ]
            out-r [ in-r copy-values ] |
         out-d output-d
         out-r output-r
         f out-d in-r out-r
         out-r in-r zip out-d first in-r first 2array suffix
         #shuffle,
    ] ;

: infer-drop-locals ( -- )
    f f pop-literal nip consume-r f f #shuffle, ;

: infer-special ( word -- )
    {
        { \ >r [ 1 infer->r ] }
        { \ r> [ 1 infer-r> ] }
        { \ declare [ infer-declare ] }
        { \ call [ pop-d infer-call ] }
        { \ (call) [ pop-d infer-call ] }
        { \ curry [ infer-curry ] }
        { \ compose [ infer-compose ] }
        { \ execute [ infer-execute ] }
        { \ (execute) [ infer-execute ] }
        { \ if [ infer-if ] }
        { \ dispatch [ infer-dispatch ] }
        { \ <tuple-boa> [ infer-<tuple-boa> ] }
        { \ (throw) [ infer-(throw) ] }
        { \ exit [ infer-exit ] }
        { \ load-locals [ infer-load-locals ] }
        { \ get-local [ infer-get-local ] }
        { \ drop-locals [ infer-drop-locals ] }
        { \ do-primitive [ unknown-primitive-error inference-error ] }
        { \ alien-invoke [ infer-alien-invoke ] }
        { \ alien-indirect [ infer-alien-indirect ] }
        { \ alien-callback [ infer-alien-callback ] }
    } case ;

: infer-local-reader ( word -- )
    (( -- value )) apply-word/effect ;

: infer-local-writer ( word -- )<commit_msg>Inferring set-datastack is just a warning not an error<commit_after>! Copyright (C) 2004, 2008 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: fry accessors alien alien.accessors arrays byte-arrays
classes sequences.private continuations.private effects generic
hashtables hashtables.private io io.backend io.files
io.files.private io.streams.c kernel kernel.private math
math.private memory namespaces namespaces.private parser
prettyprint quotations quotations.private sbufs sbufs.private
sequences sequences.private slots.private strings
strings.private system threads.private classes.tuple
classes.tuple.private vectors vectors.private words definitions
words.private assocs summary compiler.units system.private
combinators locals locals.backend locals.private words.private
quotations.private stack-checker.values
stack-checker.alien
stack-checker.state
stack-checker.errors
stack-checker.visitor
stack-checker.backend
stack-checker.branches
stack-checker.transforms
stack-checker.recursive-state ;
IN: stack-checker.known-words

: infer-primitive ( word -- )
    dup
    [ "input-classes" word-prop ]
    [ "default-output-classes" word-prop ] bi <effect>
    apply-word/effect ;

{
    { drop  (( x     --             )) }
    { 2drop (( x y   --             )) }
    { 3drop (( x y z --             )) }
    { dup   (( x     -- x x         )) }
    { 2dup  (( x y   -- x y x y     )) }
    { 3dup  (( x y z -- x y z x y z )) }
    { rot   (( x y z -- y z x       )) }
    { -rot  (( x y z -- z x y       )) }
    { dupd  (( x y   -- x x y       )) }
    { swapd (( x y z -- y x z       )) }
    { nip   (( x y   -- y           )) }
    { 2nip  (( x y z -- z           )) }
    { tuck  (( x y   -- y x y       )) }
    { over  (( x y   -- x y x       )) }
    { pick  (( x y z -- x y z x     )) }
    { swap  (( x y   -- y x         )) }
} [ "shuffle" set-word-prop ] assoc-each

: infer-shuffle ( shuffle -- )
    [ in>> length consume-d ] keep ! inputs shuffle
    [ drop ] [ shuffle dup copy-values dup output-d ] 2bi ! inputs outputs copies
    [ nip f f ] [ swap zip ] 2bi ! in-d out-d in-r out-r mapping
    #shuffle, ;

: infer-shuffle-word ( word -- )
    "shuffle" word-prop infer-shuffle ;

: infer-declare ( -- )
    pop-literal nip
    [ length ensure-d ] keep zip
    #declare, ;

GENERIC: infer-call* ( value known -- )

: infer-call ( value -- ) dup known infer-call* ;

M: literal infer-call*
    [ 1array #drop, ] [ infer-literal-quot ] bi* ;

M: curried infer-call*
    swap push-d
    [ uncurry ] infer-quot-here
    [ quot>> known pop-d [ set-known ] keep ]
    [ obj>> known pop-d [ set-known ] keep ] bi
    push-d infer-call ;

M: composed infer-call*
    swap push-d
    [ uncompose ] infer-quot-here
    [ quot2>> known pop-d [ set-known ] keep ]
    [ quot1>> known pop-d [ set-known ] keep ] bi
    push-d push-d
    1 infer->r pop-d infer-call
    terminated? get [ 1 infer-r> pop-d infer-call ] unless ;

M: object infer-call*
    \ literal-expected inference-warning ;

: infer-curry ( -- )
    2 consume-d
    dup first2 <curried> make-known
    [ push-d ] [ 1array ] bi
    \ curry #call, ;

: infer-compose ( -- )
    2 consume-d
    dup first2 <composed> make-known
    [ push-d ] [ 1array ] bi
    \ compose #call, ;

: infer-execute ( -- )
    pop-literal nip
    dup word? [
        apply-object
    ] [
        drop
        "execute must be given a word" time-bomb
    ] if ;

: infer-<tuple-boa> ( -- )
    \ <tuple-boa>
    peek-d literal value>> second 1+ { tuple } <effect>
    apply-word/effect ;

: infer-(throw) ( -- )
    \ (throw)
    peek-d literal value>> 2 + f <effect> t >>terminated?
    apply-word/effect ;

: infer-exit ( -- )
    \ exit
    { integer } { } t >>terminated? <effect>
    apply-word/effect ;

: infer-load-locals ( -- )
    pop-literal nip
    consume-d dup reverse copy-values dup output-r
    [ [ f f ] dip ] [ reverse swap zip ] 2bi #shuffle, ;

: infer-get-local ( -- )
    [let* | n [ pop-literal nip ]
            in-r [ n consume-r ]
            out-d [ in-r first copy-value 1array ]
            out-r [ in-r copy-values ] |
         out-d output-d
         out-r output-r
         f out-d in-r out-r
         out-r in-r zip out-d first in-r first 2array suffix
         #shuffle,
    ] ;

: infer-drop-locals ( -- )
    f f pop-literal nip consume-r f f #shuffle, ;

: infer-special ( word -- )
    {
        { \ >r [ 1 infer->r ] }
        { \ r> [ 1 infer-r> ] }
        { \ declare [ infer-declare ] }
        { \ call [ pop-d infer-call ] }
        { \ (call) [ pop-d infer-call ] }
        { \ curry [ infer-curry ] }
        { \ compose [ infer-compose ] }
        { \ execute [ infer-execute ] }
        { \ (execute) [ infer-execute ] }
        { \ if [ infer-if ] }
        { \ dispatch [ infer-dispatch ] }
        { \ <tuple-boa> [ infer-<tuple-boa> ] }
        { \ (throw) [ infer-(throw) ] }
        { \ exit [ infer-exit ] }
        { \ load-locals [ infer-load-locals ] }
        { \ get-local [ infer-get-local ] }
        { \ drop-locals [ infer-drop-locals ] }
        { \ do-primitive [ unknown-primitive-error inference-warning ] }
        { \ alien-invoke [ infer-alien-invoke ] }
        { \ alien-indirect [ infer-alien-indirect ] }
        { \ alien-callback [ infer-alien-callback ] }
    } case ;

: infer-local-reader ( word -- )
    (( -- value )) apply-word/effect ;

: infer-local-writer ( word -- )
{'fraction_non_alphanumeric': 0.14443931702814952, 'fraction_numerical': 0.006091370558375634, 'mean_word_length': 1.8233454924439811, 'pattern_counts': {'":': 0, '<': 25, '<?xml version=': 0, '>': 73, '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': '820074', 'n_tokens_mistral': 3761, 'n_tokens_neox': 3664, 'n_words': 968}