Merge branch 'master' of git://factorcode.org/git/factor

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>> [

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

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

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*
-                <interval>
-            ] [
-                or
-            ] if
+            [ interval>points ] bi@ swapd
+            [ [ swap endpoint< ] most ]
+            [ [ swap endpoint> ] most ] 2bi*
+            <interval>
         ]
     } 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 ;
 

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 -- )

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 <wrapper> ;
 

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 [