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

basis/compiler/cfg/builder/builder.factor

@@ -156,7 +156,17 @@ 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 )
+    over trivial-dispatch-branch? [
+        drop first word>>
+    ] [
         gensym [
             [
                 V{ } clone node-stack set
@@ -168,7 +178,8 @@ M: #if emit-node
                     end-basic-block
                 ] when
             ] with-cfg-builder
-    ] keep ;
+        ] 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
         ]
     } cond ;
 
@@ -133,13 +129,7 @@ TUPLE: interval { from read-only } { to read-only } ;
     {
         { [ dup empty-interval eq? ] [ drop ] }
         { [ over empty-interval eq? ] [ nip ] }
-        [
+        [ [ interval>points 2array ] bi@ append points>interval ]
-            2dup and [
-                [ interval>points 2array ] bi@ append points>interval
-            ] [
-                2drop f
-            ] if
-        ]
     } 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
+        ] 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> ;