diff --git a/core/alien/c-types/c-types-tests.factor b/core/alien/c-types/c-types-tests.factor index 5f57068bab..276dd581c5 100755 --- a/core/alien/c-types/c-types-tests.factor +++ b/core/alien/c-types/c-types-tests.factor @@ -48,3 +48,5 @@ TYPEDEF: uchar* MyLPBYTE [ 0 B{ 1 2 3 4 } ] must-fail + +[ t ] [ { t f t } >c-bool-array { 1 0 1 } >c-int-array = ] unit-test diff --git a/core/alien/c-types/c-types.factor b/core/alien/c-types/c-types.factor index 602b22881f..e576b87f52 100755 --- a/core/alien/c-types/c-types.factor +++ b/core/alien/c-types/c-types.factor @@ -348,7 +348,7 @@ M: long-long-type box-return ( type -- ) [ alien-unsigned-4 zero? not ] >>getter - [ 1 0 ? set-alien-unsigned-4 ] >>setter + [ [ 1 0 ? ] 2dip set-alien-unsigned-4 ] >>setter 4 >>size 4 >>align "box_boolean" >>boxer @@ -357,7 +357,7 @@ M: long-long-type box-return ( type -- ) [ alien-float ] >>getter - [ >r >r >float r> r> set-alien-float ] >>setter + [ [ >float ] 2dip set-alien-float ] >>setter 4 >>size 4 >>align "box_float" >>boxer @@ -368,7 +368,7 @@ M: long-long-type box-return ( type -- ) [ alien-double ] >>getter - [ >r >r >float r> r> set-alien-double ] >>setter + [ [ >float ] 2dip set-alien-double ] >>setter 8 >>size 8 >>align "box_double" >>boxer diff --git a/core/classes/algebra/algebra-tests.factor b/core/classes/algebra/algebra-tests.factor index 444cf50e58..665fc86ebb 100755 --- a/core/classes/algebra/algebra-tests.factor +++ b/core/classes/algebra/algebra-tests.factor @@ -306,3 +306,9 @@ INTERSECTION: empty-intersection ; [ t ] [ object \ f class-not \ f class-or class<= ] unit-test [ ] [ object flatten-builtin-class drop ] unit-test + +SINGLETON: sa +SINGLETON: sb +SINGLETON: sc + +[ sa ] [ sa { sa sb sc } min-class ] unit-test diff --git a/core/classes/singleton/singleton.factor b/core/classes/singleton/singleton.factor index a72c9f1333..1d370c1859 100755 --- a/core/classes/singleton/singleton.factor +++ b/core/classes/singleton/singleton.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2008 Doug Coleman. ! See http://factorcode.org/license.txt for BSD license. -USING: classes classes.predicate kernel sequences words ; +USING: classes classes.algebra classes.predicate kernel +sequences words ; IN: classes.singleton PREDICATE: singleton-class < predicate-class @@ -11,3 +12,6 @@ PREDICATE: singleton-class < predicate-class \ word over [ eq? ] curry define-predicate-class ; M: singleton-class instance? eq? ; + +M: singleton-class (classes-intersect?) + over singleton-class? [ eq? ] [ call-next-method ] if ; diff --git a/core/classes/tuple/tuple.factor b/core/classes/tuple/tuple.factor index 6cf6a9897a..71c5f3efe6 100755 --- a/core/classes/tuple/tuple.factor +++ b/core/classes/tuple/tuple.factor @@ -336,6 +336,8 @@ M: tuple-class boa [ tuple-layout ] bi ; +M: tuple-class initial-value* new ; + ! Deprecated M: object get-slots ( obj slots -- ... ) [ execute ] with each ; diff --git a/core/growable/growable.factor b/core/growable/growable.factor index 57919671c8..336f1da91a 100644 --- a/core/growable/growable.factor +++ b/core/growable/growable.factor @@ -59,4 +59,11 @@ M: growable lengthen ( n seq -- ) 2dup (>>length) ] when 2drop ; +M: growable shorten ( n seq -- ) + growable-check + 2dup length < [ + 2dup contract + 2dup (>>length) + ] when 2drop ; + INSTANCE: growable sequence diff --git a/core/inference/class/class-tests.factor b/core/inference/class/class-tests.factor index 591baf1287..7be70f1ad4 100755 --- a/core/inference/class/class-tests.factor +++ b/core/inference/class/class-tests.factor @@ -5,8 +5,9 @@ sequences words inference.class quotations alien alien.c-types strings sbufs sequences.private slots.private combinators definitions compiler.units system layouts vectors optimizer.math.partial -optimizer.inlining optimizer.backend math.order -accessors hashtables classes assocs ; +optimizer.inlining optimizer.backend math.order math.functions +accessors hashtables classes assocs io.encodings.utf8 +io.encodings.ascii io.encodings ; [ t ] [ T{ literal-constraint f 1 2 } T{ literal-constraint f 1 2 } equal? ] unit-test @@ -193,19 +194,15 @@ M: fixnum detect-fx ; [ t ] [ - [ { string sbuf } declare push-all ] \ push-all inlined? + [ { string sbuf } declare ] \ push-all def>> append \ + inlined? ] unit-test [ t ] [ - [ { string sbuf } declare push-all ] \ + inlined? + [ { string sbuf } declare ] \ push-all def>> append \ fixnum+ inlined? ] unit-test [ t ] [ - [ { string sbuf } declare push-all ] \ fixnum+ inlined? -] unit-test - -[ t ] [ - [ { string sbuf } declare push-all ] \ >fixnum inlined? + [ { string sbuf } declare ] \ push-all def>> append \ >fixnum inlined? ] unit-test [ t ] [ @@ -600,6 +597,29 @@ TUPLE: declared-fixnum { x fixnum } ; { slot } inlined? ] unit-test +[ t ] [ + [ + { array } declare length + 1 + dup 100 fixnum> [ 1 fixnum+ ] when + ] \ fixnum+ inlined? +] unit-test + +[ t ] [ + [ [ resize-array ] keep length ] \ length inlined? +] unit-test + +[ t ] [ + [ dup 0 > [ sqrt ] when ] \ sqrt inlined? +] unit-test + +[ t ] [ + [ { utf8 } declare decode-char ] \ decode-char inlined? +] unit-test + +[ t ] [ + [ { ascii } declare decode-char ] \ decode-char inlined? +] unit-test + ! Later ! [ t ] [ diff --git a/core/inference/class/class.factor b/core/inference/class/class.factor index 2f7058ba96..7cd0c1d540 100755 --- a/core/inference/class/class.factor +++ b/core/inference/class/class.factor @@ -129,8 +129,12 @@ GENERIC: infer-classes-before ( node -- ) GENERIC: infer-classes-around ( node -- ) +GENERIC: infer-classes-after ( node -- ) + M: node infer-classes-before drop ; +M: node infer-classes-after drop ; + M: node child-constraints children>> length dup zero? [ drop f ] [ f ] if ; @@ -203,11 +207,19 @@ M: pair constraint-satisfied? [ ] [ param>> "default-output-classes" word-prop ] ?if r> ; -M: #call infer-classes-before - [ compute-constraints ] keep - [ output-classes ] [ out-d>> ] bi +: intersect-values ( classes intervals values -- ) tuck [ intersect-classes ] [ intersect-intervals ] 2bi* ; +M: #call infer-classes-before + [ compute-constraints ] + [ [ output-classes ] [ out-d>> ] bi intersect-values ] bi ; + +: input-classes ( #call -- classes ) + param>> "input-classes" word-prop ; + +M: #call infer-classes-after + [ input-classes ] [ in-d>> ] bi intersect-classes ; + M: #push infer-classes-before out-d>> [ [ value-literal ] keep set-value-literal* ] each ; @@ -340,6 +352,7 @@ M: object infer-classes-around { [ infer-classes-before ] [ annotate-node ] + [ infer-classes-after ] [ infer-children ] [ merge-children ] } cleave ; diff --git a/core/inference/known-words/known-words.factor b/core/inference/known-words/known-words.factor index 6f5277bc35..1c9138fe0b 100755 --- a/core/inference/known-words/known-words.factor +++ b/core/inference/known-words/known-words.factor @@ -153,8 +153,10 @@ M: object infer-call ] "infer" set-word-prop : set-primitive-effect ( word effect -- ) - 2dup effect-out "default-output-classes" set-word-prop - dupd [ make-call-node ] 2curry "infer" set-word-prop ; + [ in>> "input-classes" set-word-prop ] + [ out>> "default-output-classes" set-word-prop ] + [ dupd [ make-call-node ] 2curry "infer" set-word-prop ] + 2tri ; ! Stack effects for all primitives \ fixnum< { fixnum fixnum } { object } set-primitive-effect diff --git a/core/io/encodings/encodings.factor b/core/io/encodings/encodings.factor index 942476616f..0181f80af4 100755 --- a/core/io/encodings/encodings.factor +++ b/core/io/encodings/encodings.factor @@ -99,14 +99,20 @@ M: decoder stream-read-partial stream-read ; [ >r drop "" like r> ] [ pick push ((read-until)) ] if ; inline -: (read-until) ( seps stream -- string/f sep/f ) - SBUF" " clone -rot >decoder< +: (read-until) ( quot -- string/f sep/f ) + 100 swap ((read-until)) ; inline + +: decoder-read-until ( seps stream encoding -- string/f sep/f ) [ decode-char dup [ dup rot member? ] [ 2drop f t ] if ] 3curry - ((read-until)) ; inline + (read-until) ; -M: decoder stream-read-until (read-until) ; +M: decoder stream-read-until >decoder< decoder-read-until ; -M: decoder stream-readln "\r\n" over (read-until) handle-readln ; +: decoder-readln ( stream encoding -- string/f sep/f ) + [ decode-char dup [ dup "\r\n" member? ] [ drop f t ] if ] 2curry + (read-until) ; + +M: decoder stream-readln dup >decoder< decoder-readln handle-readln ; M: decoder dispose stream>> dispose ; @@ -119,8 +125,11 @@ M: object encoder boa ; M: encoder stream-write1 >encoder< encode-char ; +: decoder-write ( string stream encoding -- ) + [ encode-char ] 2curry each ; + M: encoder stream-write - >encoder< [ encode-char ] 2curry each ; + >encoder< decoder-write ; M: encoder dispose encoder-stream dispose ; diff --git a/core/io/encodings/utf8/utf8.factor b/core/io/encodings/utf8/utf8.factor index 09524802e0..ae8a455c71 100755 --- a/core/io/encodings/utf8/utf8.factor +++ b/core/io/encodings/utf8/utf8.factor @@ -11,21 +11,21 @@ SINGLETON: utf8 >length) method should-inline? ] unit-test diff --git a/core/optimizer/inlining/inlining.factor b/core/optimizer/inlining/inlining.factor index 618a2c746d..30acdb1b48 100755 --- a/core/optimizer/inlining/inlining.factor +++ b/core/optimizer/inlining/inlining.factor @@ -2,12 +2,13 @@ ! See http://factorcode.org/license.txt for BSD license. USING: accessors arrays generic assocs inference inference.class inference.dataflow inference.backend inference.state io kernel -math namespaces sequences vectors words quotations hashtables -combinators classes classes.algebra generic.math -optimizer.math.partial continuations optimizer.def-use -optimizer.backend generic.standard optimizer.specializers -optimizer.def-use optimizer.pattern-match generic.standard -optimizer.control kernel.private definitions sets ; +math math.order namespaces sequences vectors words quotations +hashtables combinators effects classes classes.union +classes.algebra generic.math optimizer.math.partial +continuations optimizer.def-use optimizer.backend +generic.standard optimizer.specializers optimizer.def-use +optimizer.pattern-match generic.standard optimizer.control +kernel.private definitions sets summary ; IN: optimizer.inlining : remember-inlining ( node history -- ) @@ -31,9 +32,9 @@ DEFER: (flat-length) : word-flat-length ( word -- n ) { ! not inline - { [ dup inline? not ] [ drop 0 ] } + { [ dup inline? not ] [ drop 1 ] } ! recursive and inline - { [ dup recursive-calls get key? ] [ drop 4 ] } + { [ dup recursive-calls get key? ] [ drop 10 ] } ! inline [ [ recursive-calls get conjoin ] [ def>> (flat-length) ] bi ] } cond ; @@ -41,7 +42,7 @@ DEFER: (flat-length) : (flat-length) ( seq -- n ) [ { - { [ dup quotation? ] [ (flat-length) 1+ ] } + { [ dup quotation? ] [ (flat-length) 2 + ] } { [ dup array? ] [ (flat-length) ] } { [ dup word? ] [ word-flat-length ] } [ drop 0 ] @@ -51,7 +52,7 @@ DEFER: (flat-length) : flat-length ( word -- n ) H{ } clone recursive-calls [ [ recursive-calls get conjoin ] - [ def>> (flat-length) ] + [ def>> (flat-length) 5 /i ] bi ] with-variable ; @@ -102,7 +103,7 @@ DEFER: (flat-length) [ f splice-quot ] [ 2drop t ] if ; : inline-method ( #call -- node ) - dup node-param { + dup param>> { { [ dup standard-generic? ] [ inline-standard-method ] } { [ dup math-generic? ] [ inline-math-method ] } { [ dup math-partial? ] [ inline-math-partial ] } @@ -155,15 +156,35 @@ DEFER: (flat-length) (optimize-predicate) optimize-check ; : flush-eval? ( #call -- ? ) - dup node-param "flushable" word-prop [ - node-out-d [ unused? ] all? - ] [ - drop f - ] if ; + dup node-param "flushable" word-prop + [ node-out-d [ unused? ] all? ] [ drop f ] if ; + +ERROR: flushed-eval-error word ; + +M: flushed-eval-error summary + drop "Flushed evaluation of word would have thrown an error" ; + +: flushed-eval-quot ( #call -- quot ) + #! A quotation to replace flushed evaluations with. We can't + #! just remove the code altogether, because if the optimizer + #! knows the input types of a word, it assumes the inputs are + #! of this type after the word returns, since presumably + #! the word would have checked input types itself. However, + #! if the word gets flushed, then it won't do this checking; + #! so we have to do it here. + [ + dup param>> "input-classes" word-prop [ + make-specializer % + [ dup param>> literalize , \ flushed-eval-error , ] [ ] make , + \ unless , + ] when* + dup in-d>> length [ \ drop , ] times + out-d>> length [ f , ] times + ] [ ] make ; : flush-eval ( #call -- node ) - dup node-param +inlined+ depends-on - dup node-out-d length f inline-literals ; + dup param>> +inlined+ depends-on + dup flushed-eval-quot f splice-quot ; : partial-eval? ( #call -- ? ) dup node-param "foldable" word-prop [ @@ -195,13 +216,28 @@ DEFER: (flat-length) [ drop +inlined+ depends-on ] [ swap 1array ] 2bi splice-quot ; +: classes-known? ( #call -- ? ) + node-input-classes [ + [ class-types length 1 = ] + [ union-class? not ] + bi and + ] contains? ; + +: inlining-rank ( #call -- n ) + { + [ param>> flat-length 24 swap [-] 4 /i ] + [ param>> "default" word-prop -4 0 ? ] + [ param>> "specializer" word-prop 1 0 ? ] + [ param>> method-body? 1 0 ? ] + [ classes-known? 2 0 ? ] + } cleave + + + + ; + +: should-inline? ( #call -- ? ) + inlining-rank 5 >= ; + : optimistic-inline? ( #call -- ? ) - dup node-param "specializer" word-prop dup [ - >r node-input-classes r> specialized-length tail* - [ class-types length 1 = ] all? - ] [ - 2drop f - ] if ; + dup param>> "specializer" word-prop + [ should-inline? ] [ drop f ] if ; : already-inlined? ( #call -- ? ) [ param>> ] [ history>> ] bi memq? ; @@ -211,11 +247,8 @@ DEFER: (flat-length) dup param>> dup def>> splice-word-def ] if ; -: should-inline? ( word -- ? ) - flat-length 11 <= ; - : method-body-inline? ( #call -- ? ) - param>> dup [ method-body? ] [ "default" word-prop not ] bi and + dup param>> method-body? [ should-inline? ] [ drop f ] if ; M: #call optimize-node* diff --git a/core/optimizer/math/math.factor b/core/optimizer/math/math.factor index 27ef4042e2..799f4d80cf 100755 --- a/core/optimizer/math/math.factor +++ b/core/optimizer/math/math.factor @@ -1,14 +1,15 @@ ! Copyright (C) 2005, 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. +USING: effects alien alien.accessors arrays generic hashtables +kernel assocs math math.libm math.private kernel.private +sequences words parser inference.class inference.dataflow +vectors strings sbufs io namespaces assocs quotations +math.intervals sequences.private combinators splitting layouts +math.parser classes classes.algebra generic.math +optimizer.pattern-match optimizer.backend optimizer.def-use +optimizer.inlining optimizer.math.partial generic.standard +system accessors ; IN: optimizer.math -USING: alien alien.accessors arrays generic hashtables kernel -assocs math math.private kernel.private sequences words parser -inference.class inference.dataflow vectors strings sbufs io -namespaces assocs quotations math.intervals sequences.private -combinators splitting layouts math.parser classes -classes.algebra generic.math optimizer.pattern-match -optimizer.backend optimizer.def-use optimizer.inlining -optimizer.math.partial generic.standard system accessors ; : define-math-identities ( word identities -- ) >r all-derived-ops r> define-identities ; @@ -169,6 +170,22 @@ optimizer.math.partial generic.standard system accessors ; ] 2curry each-derived-op ] each +: math-output-class/interval-2-fast ( node word -- classes intervals ) + math-output-interval-2 fixnum [ 1array ] bi@ swap ; inline + +[ + { + interval+ } + { - interval- } + { * interval* } + { shift interval-shift-safe } +] [ + first2 [ + [ + math-output-class/interval-2-fast + ] curry "output-classes" set-word-prop + ] curry each-fast-derived-op +] each + : real-value? ( value -- n ? ) dup value? [ value-literal dup real? ] [ drop f f ] if ; @@ -420,3 +437,37 @@ most-negative-fixnum most-positive-fixnum [a,b] [ fixnumify-bitand ] } } define-optimizers + +{ + - * / } +[ { number number } "input-classes" set-word-prop ] each + +{ /f < > <= >= } +[ { real real } "input-classes" set-word-prop ] each + +{ /i bitand bitor bitxor bitnot shift } +[ { integer integer } "input-classes" set-word-prop ] each + +{ + fcosh + flog + fsinh + fexp + fasin + facosh + fasinh + ftanh + fatanh + facos + fpow + fatan + fatan2 + fcos + ftan + fsin + fsqrt +} [ + dup stack-effect + [ in>> length real "input-classes" set-word-prop ] + [ out>> length float "default-output-classes" set-word-prop ] + 2bi +] each diff --git a/core/optimizer/math/partial/partial.factor b/core/optimizer/math/partial/partial.factor index 4f9bfaef12..ad9feeed4a 100644 --- a/core/optimizer/math/partial/partial.factor +++ b/core/optimizer/math/partial/partial.factor @@ -170,3 +170,6 @@ SYMBOL: fast-math-ops : each-derived-op ( word quot -- ) >r derived-ops r> each ; inline + +: each-fast-derived-op ( word quot -- ) + >r fast-derived-ops r> each ; inline diff --git a/core/optimizer/optimizer-tests.factor b/core/optimizer/optimizer-tests.factor index 655b54ea96..0a3439c65c 100755 --- a/core/optimizer/optimizer-tests.factor +++ b/core/optimizer/optimizer-tests.factor @@ -375,3 +375,12 @@ PREDICATE: list < improper-list [ 2 3 ] [ 2 interval-inference-bug ] unit-test [ 1 4 ] [ 1 interval-inference-bug ] unit-test [ 0 5 ] [ 0 interval-inference-bug ] unit-test + +: aggressive-flush-regression ( a -- b ) + f over >r drop r> 1 + ; + +[ 1.0 aggressive-flush-regression drop ] must-fail + +[ 1 [ "hi" + drop ] compile-call ] must-fail + +[ "hi" f [ drop ] compile-call ] must-fail diff --git a/core/sequences/sequences.factor b/core/sequences/sequences.factor index bc92055338..c433ce4426 100755 --- a/core/sequences/sequences.factor +++ b/core/sequences/sequences.factor @@ -21,9 +21,12 @@ GENERIC: clone-like ( seq exemplar -- newseq ) flushable M: sequence like drop ; GENERIC: lengthen ( n seq -- ) +GENERIC: shorten ( n seq -- ) M: sequence lengthen 2dup length > [ set-length ] [ 2drop ] if ; +M: sequence shorten 2dup length < [ set-length ] [ 2drop ] if ; + : empty? ( seq -- ? ) length zero? ; inline : delete-all ( seq -- ) 0 swap set-length ; @@ -530,7 +533,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; : peek ( seq -- elt ) [ length 1- ] [ nth ] bi ; -: pop* ( seq -- ) [ length 1- ] [ set-length ] bi ; +: pop* ( seq -- ) [ length 1- ] [ shorten ] bi ; : move-backward ( shift from to seq -- ) 2over number= [ @@ -575,7 +578,7 @@ M: slice equal? over slice? [ sequence= ] [ 2drop f ] if ; copy ; : pop ( seq -- elt ) - [ length 1- ] [ [ nth ] [ set-length ] 2bi ] bi ; + [ length 1- ] [ [ nth ] [ shorten ] 2bi ] bi ; : all-equal? ( seq -- ? ) [ = ] monotonic? ; diff --git a/core/slots/slots.factor b/core/slots/slots.factor index 1453393a27..a5b2e4b3d8 100755 --- a/core/slots/slots.factor +++ b/core/slots/slots.factor @@ -125,6 +125,10 @@ ERROR: bad-slot-value value class ; ERROR: no-initial-value class ; +GENERIC: initial-value* ( class -- object ) + +M: class initial-value* no-initial-value ; + : initial-value ( class -- object ) { { [ \ f bootstrap-word over class<= ] [ f ] } @@ -134,7 +138,7 @@ ERROR: no-initial-value class ; { [ array bootstrap-word over class<= ] [ { } ] } { [ byte-array bootstrap-word over class<= ] [ B{ } ] } { [ simple-alien bootstrap-word over class<= ] [ ] } - [ no-initial-value ] + [ dup initial-value* ] } cond nip ; GENERIC: make-slot ( desc -- slot-spec ) diff --git a/extra/benchmark/stack/stack.factor b/extra/benchmark/stack/stack.factor new file mode 100644 index 0000000000..d4dc18e80f --- /dev/null +++ b/extra/benchmark/stack/stack.factor @@ -0,0 +1,19 @@ +USING: kernel sequences math math.functions vectors ; +IN: benchmark.stack + +: stack-loop ( vec -- ) + 1000 [ + 10000 [ + dup pop dup ! dup 10 > [ sqrt dup 1 + ] [ dup 2 * ] if + pick push + over push + ] times + 10000 [ dup pop* ] times + ] times + drop ; + +: stack-benchmark ( -- ) + V{ 123456 } clone stack-loop + 20000 123456 over set-first stack-loop ; + +MAIN: stack-benchmark diff --git a/extra/float-arrays/float-arrays.factor b/extra/float-arrays/float-arrays.factor index 025a580633..668bb7de41 100755 --- a/extra/float-arrays/float-arrays.factor +++ b/extra/float-arrays/float-arrays.factor @@ -72,3 +72,20 @@ INSTANCE: float-array sequence M: float-array pprint-delims drop \ F{ \ } ; M: float-array >pprint-sequence ; + +USING: hints math.vectors arrays ; + +HINTS: vneg { float-array } { array } ; +HINTS: v*n { float-array object } { array object } ; +HINTS: v/n { float-array object } { array object } ; +HINTS: n/v { object float-array } { object array } ; +HINTS: v+ { float-array float-array } { array array } ; +HINTS: v- { float-array float-array } { array array } ; +HINTS: v* { float-array float-array } { array array } ; +HINTS: v/ { float-array float-array } { array array } ; +HINTS: vmax { float-array float-array } { array array } ; +HINTS: vmin { float-array float-array } { array array } ; +HINTS: v. { float-array float-array } { array array } ; +HINTS: norm-sq { float-array } { array } ; +HINTS: norm { float-array } { array } ; +HINTS: normalize { float-array } { array } ; diff --git a/extra/hints/hints.factor b/extra/hints/hints.factor index 266e635867..82941a69de 100644 --- a/extra/hints/hints.factor +++ b/extra/hints/hints.factor @@ -1,6 +1,10 @@ +! Copyright (C) 2008 Slava Pestov. +! See http://factorcode.org/license.txt for BSD license. +USING: parser words definitions kernel ; IN: hints -USING: parser words ; -: HINTS: - scan-word parse-definition "specializer" set-word-prop ; +: HINTS: + scan-word + [ +inlined+ changed-definition ] + [ parse-definition "specializer" set-word-prop ] bi ; parsing diff --git a/extra/io/buffers/buffers.factor b/extra/io/buffers/buffers.factor index f08082c4ee..e6a0070ee0 100755 --- a/extra/io/buffers/buffers.factor +++ b/extra/io/buffers/buffers.factor @@ -25,7 +25,7 @@ M: buffer dispose* ptr>> free ; [ size>> ] [ fill>> ] bi - ; inline : buffer-empty? ( buffer -- ? ) - fill>> zero? ; + fill>> zero? ; inline : buffer-consume ( n buffer -- ) [ + ] change-pos diff --git a/extra/io/ports/ports.factor b/extra/io/ports/ports.factor index 77e984e6e5..26b06dba8b 100755 --- a/extra/io/ports/ports.factor +++ b/extra/io/ports/ports.factor @@ -19,7 +19,7 @@ M: port set-timeout (>>timeout) ; : ( handle class -- port ) new swap >>handle ; inline -TUPLE: buffered-port < port buffer ; +TUPLE: buffered-port < port { buffer buffer } ; : ( handle class -- port ) @@ -35,7 +35,7 @@ HOOK: (wait-to-read) io-backend ( port -- ) : wait-to-read ( port -- eof? ) dup buffer>> buffer-empty? [ dup (wait-to-read) buffer>> buffer-empty? - ] [ drop f ] if ; + ] [ drop f ] if ; inline M: input-port stream-read1 dup check-disposed @@ -140,9 +140,7 @@ M: output-port dispose* ] with-destructors ; M: buffered-port dispose* - [ call-next-method ] - [ [ [ dispose ] when* f ] change-buffer drop ] - bi ; + [ call-next-method ] [ buffer>> dispose ] bi ; M: port cancel-operation handle>> cancel-operation ; @@ -152,3 +150,13 @@ M: port dispose* [ handle>> shutdown ] bi ] with-destructors ; + +! Fast-path optimization +USING: hints strings io.encodings.utf8 io.encodings.ascii +io.encodings.private ; + +HINTS: decoder-read-until { string input-port utf8 } { string input-port ascii } ; + +HINTS: decoder-readln { input-port utf8 } { input-port ascii } ; + +HINTS: decoder-write { string output-port utf8 } { string output-port ascii } ; diff --git a/extra/tools/deploy/shaker/shaker.factor b/extra/tools/deploy/shaker/shaker.factor index 2dd334d024..0e20384839 100755 --- a/extra/tools/deploy/shaker/shaker.factor +++ b/extra/tools/deploy/shaker/shaker.factor @@ -101,6 +101,7 @@ IN: tools.deploy.shaker "if-intrinsics" "infer" "inferred-effect" + "input-classes" "interval" "intrinsics" "loc"