<commit_before>! Copyright (C) 2004, 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private namespaces sequences sequences.private
strings arrays combinators splitting math assocs byte-arrays make ;
IN: math.parser

: digit> ( ch -- n )
    127 bitand {
        { [ dup CHAR: 9 <= ] [ CHAR: 0 - ] }
        { [ dup CHAR: a <  ] [ CHAR: A 10 - - ] }
        [ CHAR: a 10 - - ]
    } cond
    dup 0 < [ drop 255 ] [ dup 16 >= [ drop 255 ] when ] if ; inline

: string>digits ( str -- digits )
    [ digit> ] B{ } map-as ; inline

: (digits>integer) ( valid? accum digit radix -- valid? accum )
    2dup < [ swapd * + ] [ 2drop 2drop f 0 ] if ; inline

: each-digit ( seq radix quot -- n/f )
    [ t 0 ] 3dip curry each swap [ drop f ] unless ; inline

: digits>integer ( seq radix -- n/f )
    [ (digits>integer) ] each-digit ; inline

DEFER: base>

<PRIVATE

SYMBOL: radix
SYMBOL: negative?

: string>natural ( seq radix -- n/f )
    over empty? [ 2drop f ] [
        [ over CHAR: , eq? [ 2drop ] [ [ digit> ] dip (digits>integer) ] if ] each-digit
    ] if ;

: sign ( -- str ) negative? get "-" "+" ? ;

: with-radix ( radix quot -- )
    radix swap with-variable ; inline

: (base>) ( str -- n ) radix get base> ;

: whole-part ( str -- m n )
    sign split1 [ (base>) ] dip
    dup [ (base>) ] [ drop 0 swap ] if ;

: string>ratio ( str radix -- a/b )
    [
        "-" ?head dup negative? set swap
        "/" split1 (base>) [ whole-part ] dip
        3dup and and [ / + swap [ neg ] when ] [ 2drop 2drop f ] if
    ] with-radix ;

: string>integer ( str radix -- n/f )
    over first-unsafe CHAR: - = [
        [ rest-slice ] dip string>natural dup [ neg ] when
    ] [
        string>natural
    ] if ; inline

: dec>float ( str -- n/f )
    [ CHAR: , eq? not ] BV{ } filter-as
    0 over push B{ } like (string>float) ;

: hex>float-parts ( str -- neg? mantissa-str expt )
    "-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ; inline

: make-mantissa ( str -- bits )
    16 base> dup log2 52 swap - shift ; inline

: combine-hex-float-parts ( neg? mantissa expt -- float )
    dup 2046 > [ 2drop -1/0. 1/0. ? ] [
        dup 0 <= [ 1 - shift 0 ] when
        [ HEX: 8000,0000,0000,0000 0 ? ]
        [ 52 2^ 1 - bitand ]
        [ 52 shift ] tri* bitor bitor
        bits>double 
    ] if ; inline

: hex>float ( str -- n/f )
    hex>float-parts
    [ "." split1 [ append make-mantissa ] [ drop 16 base> log2 ] 2bi ]
    [ + 1023 + ] bi*
    combine-hex-float-parts ;

: base>float ( str base -- n/f )
    {
        { 16 [ hex>float ] }
        [ drop dec>float ]
    } case ; inline

: number-char? ( char -- ? )
    "0123456789ABCDEFabcdef." member? ; inline

: last-unsafe ( seq -- elt )
    [ length 1 - ] [ nth-unsafe ] bi ; inline

: numeric-looking? ( str -- ? )
    dup empty? [ drop f ] [
        dup first-unsafe number-char? [
            last-unsafe number-char?
        ] [
            dup first-unsafe CHAR: - eq? [
                dup length 1 eq? [ drop f ] [
                    1 over nth-unsafe number-char? [
                        last-unsafe number-char?
                    ] [ drop f ] if
                ] if
            ] [ drop f ] if
        ] if
    ] if ; inline

PRIVATE>

: string>float ( str -- n/f )
    10 base>float ; inline

: base> ( str radix -- n/f )
    over numeric-looking? [
        over [ "/." member? ] find nip {
            { CHAR: / [ string>ratio ] }
            { CHAR: . [ base>float ] }
            [ drop string>integer ]
        } case
    ] [ 2drop f ] if ;

: string>number ( str -- n/f ) 10 base> ; inline
: bin> ( str -- n/f ) 2 base> ; inline
: oct> ( str -- n/f ) 8 base> ; inline
: hex> ( str -- n/f ) 16 base> ; inline

: >digit ( n -- ch )
    dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ; inline

: positive>base ( num radix -- str )
    dup 1 <= [ "Invalid radix" throw ] when
    [ dup 0 > ] swap [ /mod >digit ] curry "" produce-as nip
    reverse! ; inline

PRIVATE>

GENERIC# >base 1 ( n radix -- str )

<PRIVATE

: (>base) ( n -- str ) radix get positive>base ;

PRIVATE>

M: integer >base
    over 0 = [
        2drop "0"
    ] [
        over 0 > [
            positive>base
        ] [
            [ neg ] dip positive>base CHAR: - prefix
        ] if
    ] if ;

M: ratio >base
    [<commit_msg>remove dangling PRIVATE> from math.parser<commit_after>! Copyright (C) 2004, 2009 <NAME>.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel math.private namespaces sequences sequences.private
strings arrays combinators splitting math assocs byte-arrays make ;
IN: math.parser

: digit> ( ch -- n )
    127 bitand {
        { [ dup CHAR: 9 <= ] [ CHAR: 0 - ] }
        { [ dup CHAR: a <  ] [ CHAR: A 10 - - ] }
        [ CHAR: a 10 - - ]
    } cond
    dup 0 < [ drop 255 ] [ dup 16 >= [ drop 255 ] when ] if ; inline

: string>digits ( str -- digits )
    [ digit> ] B{ } map-as ; inline

: (digits>integer) ( valid? accum digit radix -- valid? accum )
    2dup < [ swapd * + ] [ 2drop 2drop f 0 ] if ; inline

: each-digit ( seq radix quot -- n/f )
    [ t 0 ] 3dip curry each swap [ drop f ] unless ; inline

: digits>integer ( seq radix -- n/f )
    [ (digits>integer) ] each-digit ; inline

DEFER: base>

<PRIVATE

SYMBOL: radix
SYMBOL: negative?

: string>natural ( seq radix -- n/f )
    over empty? [ 2drop f ] [
        [ over CHAR: , eq? [ 2drop ] [ [ digit> ] dip (digits>integer) ] if ] each-digit
    ] if ;

: sign ( -- str ) negative? get "-" "+" ? ;

: with-radix ( radix quot -- )
    radix swap with-variable ; inline

: (base>) ( str -- n ) radix get base> ;

: whole-part ( str -- m n )
    sign split1 [ (base>) ] dip
    dup [ (base>) ] [ drop 0 swap ] if ;

: string>ratio ( str radix -- a/b )
    [
        "-" ?head dup negative? set swap
        "/" split1 (base>) [ whole-part ] dip
        3dup and and [ / + swap [ neg ] when ] [ 2drop 2drop f ] if
    ] with-radix ;

: string>integer ( str radix -- n/f )
    over first-unsafe CHAR: - = [
        [ rest-slice ] dip string>natural dup [ neg ] when
    ] [
        string>natural
    ] if ; inline

: dec>float ( str -- n/f )
    [ CHAR: , eq? not ] BV{ } filter-as
    0 over push B{ } like (string>float) ;

: hex>float-parts ( str -- neg? mantissa-str expt )
    "-" ?head swap "p" split1 [ 10 base> ] [ 0 ] if* ; inline

: make-mantissa ( str -- bits )
    16 base> dup log2 52 swap - shift ; inline

: combine-hex-float-parts ( neg? mantissa expt -- float )
    dup 2046 > [ 2drop -1/0. 1/0. ? ] [
        dup 0 <= [ 1 - shift 0 ] when
        [ HEX: 8000,0000,0000,0000 0 ? ]
        [ 52 2^ 1 - bitand ]
        [ 52 shift ] tri* bitor bitor
        bits>double 
    ] if ; inline

: hex>float ( str -- n/f )
    hex>float-parts
    [ "." split1 [ append make-mantissa ] [ drop 16 base> log2 ] 2bi ]
    [ + 1023 + ] bi*
    combine-hex-float-parts ;

: base>float ( str base -- n/f )
    {
        { 16 [ hex>float ] }
        [ drop dec>float ]
    } case ; inline

: number-char? ( char -- ? )
    "0123456789ABCDEFabcdef." member? ; inline

: last-unsafe ( seq -- elt )
    [ length 1 - ] [ nth-unsafe ] bi ; inline

: numeric-looking? ( str -- ? )
    dup empty? [ drop f ] [
        dup first-unsafe number-char? [
            last-unsafe number-char?
        ] [
            dup first-unsafe CHAR: - eq? [
                dup length 1 eq? [ drop f ] [
                    1 over nth-unsafe number-char? [
                        last-unsafe number-char?
                    ] [ drop f ] if
                ] if
            ] [ drop f ] if
        ] if
    ] if ; inline

PRIVATE>

: string>float ( str -- n/f )
    10 base>float ; inline

: base> ( str radix -- n/f )
    over numeric-looking? [
        over [ "/." member? ] find nip {
            { CHAR: / [ string>ratio ] }
            { CHAR: . [ base>float ] }
            [ drop string>integer ]
        } case
    ] [ 2drop f ] if ;

: string>number ( str -- n/f ) 10 base> ; inline
: bin> ( str -- n/f ) 2 base> ; inline
: oct> ( str -- n/f ) 8 base> ; inline
: hex> ( str -- n/f ) 16 base> ; inline

: >digit ( n -- ch )
    dup 10 < [ CHAR: 0 + ] [ 10 - CHAR: a + ] if ; inline

: positive>base ( num radix -- str )
    dup 1 <= [ "Invalid radix" throw ] when
    [ dup 0 > ] swap [ /mod >digit ] curry "" produce-as nip
    reverse! ; inline

GENERIC# >base 1 ( n radix -- str )

<PRIVATE

: (>base) ( n -- str ) radix get positive>base ;

PRIVATE>

M: integer >base
    over 0 = [
        2drop "0"
    ] [
        over 0 > [
            positive>base
        ] [
            [ neg ] dip positive>base CHAR: - prefix
        ] if
    ] if ;

M: ratio >base
    [
{'fraction_non_alphanumeric': 0.15069284064665128, 'fraction_numerical': 0.03002309468822171, 'mean_word_length': 1.7048719550281075, 'pattern_counts': {'":': 0, '<': 23, '<?xml version=': 0, '>': 129, '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': '2860944', 'n_tokens_mistral': 3275, 'n_tokens_neox': 2970, 'n_words': 925}