diff --git a/basis/compiler/cfg/builder/builder.factor b/basis/compiler/cfg/builder/builder.factor index 5b9f2e068b..93daa601fe 100755 --- a/basis/compiler/cfg/builder/builder.factor +++ b/basis/compiler/cfg/builder/builder.factor @@ -156,19 +156,30 @@ M: #if emit-node } cond iterate-next ; ! #dispatch +: trivial-dispatch-branch? ( nodes -- ? ) + dup length 1 = [ + first dup #call? [ + word>> "intrinsic" word-prop not + ] [ drop f ] if + ] [ drop f ] if ; + : dispatch-branch ( nodes word -- label ) - gensym [ - [ - V{ } clone node-stack set - ##prologue - emit-nodes - basic-block get [ - ##epilogue - ##return - end-basic-block - ] when - ] with-cfg-builder - ] keep ; + over trivial-dispatch-branch? [ + drop first word>> + ] [ + gensym [ + [ + V{ } clone node-stack set + ##prologue + emit-nodes + basic-block get [ + ##epilogue + ##return + end-basic-block + ] when + ] with-cfg-builder + ] keep + ] if ; : dispatch-branches ( node -- ) children>> [ diff --git a/basis/io/ports/ports.factor b/basis/io/ports/ports.factor index 6ee982fcda..9fb9755d4b 100644 --- a/basis/io/ports/ports.factor +++ b/basis/io/ports/ports.factor @@ -39,7 +39,7 @@ HOOK: (wait-to-read) io-backend ( port -- ) M: input-port stream-read1 dup check-disposed - dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; + dup wait-to-read [ drop f ] [ buffer>> buffer-pop ] if ; inline : read-step ( count port -- byte-array/f ) dup wait-to-read [ 2drop f ] [ buffer>> buffer-read ] if ; @@ -105,7 +105,7 @@ TUPLE: output-port < buffered-port ; M: output-port stream-write1 dup check-disposed 1 over wait-to-write - buffer>> byte>buffer ; + buffer>> byte>buffer ; inline M: output-port stream-write dup check-disposed diff --git a/basis/math/intervals/intervals-tests.factor b/basis/math/intervals/intervals-tests.factor index ad2fb53dc4..0fdcb51291 100644 --- a/basis/math/intervals/intervals-tests.factor +++ b/basis/math/intervals/intervals-tests.factor @@ -83,8 +83,6 @@ IN: math.intervals.tests 0 1 (a,b) 1 2 [a,b] interval-union 0 2 (a,b] = ] unit-test -[ f ] [ 0 1 (a,b) f interval-union ] unit-test - [ t ] [ 0 1 (a,b) 0 1 [a,b] interval-intersect 0 1 (a,b) = ] unit-test diff --git a/basis/math/intervals/intervals.factor b/basis/math/intervals/intervals.factor index 213bfce354..33430e83c3 100644 --- a/basis/math/intervals/intervals.factor +++ b/basis/math/intervals/intervals.factor @@ -115,14 +115,10 @@ TUPLE: interval { from read-only } { to read-only } ; { [ dup empty-interval eq? ] [ nip ] } { [ over empty-interval eq? ] [ drop ] } [ - 2dup and [ - [ interval>points ] bi@ swapd - [ [ swap endpoint< ] most ] - [ [ swap endpoint> ] most ] 2bi* - - ] [ - or - ] if + [ interval>points ] bi@ swapd + [ [ swap endpoint< ] most ] + [ [ swap endpoint> ] most ] 2bi* + ] } cond ; @@ -133,13 +129,7 @@ TUPLE: interval { from read-only } { to read-only } ; { { [ dup empty-interval eq? ] [ drop ] } { [ over empty-interval eq? ] [ nip ] } - [ - 2dup and [ - [ interval>points 2array ] bi@ append points>interval - ] [ - 2drop f - ] if - ] + [ [ interval>points 2array ] bi@ append points>interval ] } cond ; : interval-subset? ( i1 i2 -- ? ) @@ -183,7 +173,6 @@ TUPLE: interval { from read-only } { to read-only } ; : interval-length ( int -- n ) { { [ dup empty-interval eq? ] [ drop 0 ] } - { [ dup not ] [ drop 0 ] } [ interval>points [ first ] bi@ swap - ] } cond ; diff --git a/core/generic/parser/parser.factor b/core/generic/parser/parser.factor index 70f57f85e3..7380399b5c 100644 --- a/core/generic/parser/parser.factor +++ b/core/generic/parser/parser.factor @@ -8,7 +8,7 @@ ERROR: not-in-a-method-error ; : CREATE-GENERIC ( -- word ) CREATE dup reset-word ; : create-method-in ( class generic -- method ) - create-method f set-word dup save-location ; + create-method dup set-word dup save-location ; : CREATE-METHOD ( -- method ) scan-word bootstrap-word scan-word create-method-in ; @@ -18,11 +18,11 @@ SYMBOL: current-generic : with-method-definition ( quot -- parsed ) [ - >r - [ "method-class" word-prop current-class set ] - [ "method-generic" word-prop current-generic set ] - [ ] tri - r> call + [ + [ "method-class" word-prop current-class set ] + [ "method-generic" word-prop current-generic set ] + [ ] tri + ] dip call ] with-scope ; inline : (M:) ( method def -- ) diff --git a/core/words/words.factor b/core/words/words.factor index ce1fdf194b..8a4f7e7bd2 100644 --- a/core/words/words.factor +++ b/core/words/words.factor @@ -262,7 +262,7 @@ M: word forget* ] if ; M: word hashcode* - nip 1 slot { fixnum } declare ; + nip 1 slot { fixnum } declare ; foldable M: word literalize ; diff --git a/extra/benchmark/benchmark.factor b/extra/benchmark/benchmark.factor index c00087fc9f..5a8e7595b5 100755 --- a/extra/benchmark/benchmark.factor +++ b/extra/benchmark/benchmark.factor @@ -6,12 +6,12 @@ continuations debugger ; IN: benchmark : run-benchmark ( vocab -- result ) - [ [ require ] [ [ run ] benchmark ] bi ] curry - [ error. f ] recover ; + [ [ require ] [ [ run ] benchmark ] bi ] curry + [ error. f ] recover ; : run-benchmarks ( -- assoc ) - "benchmark" all-child-vocabs-seq - [ dup run-benchmark ] { } map>assoc ; + "benchmark" all-child-vocabs-seq + [ dup run-benchmark ] { } map>assoc ; : benchmarks. ( assoc -- ) standard-table-style [