From 4e55cd973bbcc08154c6e6d6ccd2ae2d4d4199ff Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Nov 2008 11:48:55 -0600 Subject: [PATCH 1/4] If a #dispatch branch is a call to another word which is not an intrinsic, we avoid generating the dispatch branch and just jump to the word directly --- basis/compiler/cfg/builder/builder.factor | 35 +++++++++++++++-------- 1 file changed, 23 insertions(+), 12 deletions(-) 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>> [ From 751426f28358252e537691a7893b0d9debb3cf0f Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Nov 2008 11:57:31 -0600 Subject: [PATCH 2/4] Remove dead code from math.intervals; we no longer need the operations to support f anymore --- basis/math/intervals/intervals-tests.factor | 2 -- basis/math/intervals/intervals.factor | 21 +++++---------------- 2 files changed, 5 insertions(+), 18 deletions(-) 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 ; From 63a9975a0eb3064177de6b1496be36e32cadc329 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Nov 2008 13:13:37 -0600 Subject: [PATCH 3/4] Support inline, foldable, flushable on methods; add declarations in a couple of places for ricing purposes --- basis/io/ports/ports.factor | 4 ++-- core/generic/parser/parser.factor | 12 ++++++------ core/words/words.factor | 2 +- 3 files changed, 9 insertions(+), 9 deletions(-) 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/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 ; From 55902df52916ae14a6b84b543d9727b8ff900289 Mon Sep 17 00:00:00 2001 From: Slava Pestov Date: Thu, 6 Nov 2008 13:13:47 -0600 Subject: [PATCH 4/4] Fix indentation --- extra/benchmark/benchmark.factor | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) 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 [