Change equality semantics

basis/cocoa/cocoa-tests.factor

@@ -20,10 +20,10 @@ CLASS: {
 
 test-foo
 
-[ 1 ] [ "x" get NSRect-x ] unit-test
-[ 2 ] [ "x" get NSRect-y ] unit-test
-[ 101 ] [ "x" get NSRect-w ] unit-test
-[ 102 ] [ "x" get NSRect-h ] unit-test
+[ 1.0 ] [ "x" get NSRect-x ] unit-test
+[ 2.0 ] [ "x" get NSRect-y ] unit-test
+[ 101.0 ] [ "x" get NSRect-w ] unit-test
+[ 102.0 ] [ "x" get NSRect-h ] unit-test
 
 CLASS: {
     { +superclass+ "NSObject" }

basis/compiler/tree/cleanup/cleanup-tests.factor

@@ -229,10 +229,6 @@ M: float detect-float ;
     \ detect-float inlined?
 ] unit-test
 
-[ t ] [
-    [ 3 + = ] \ equal? inlined?
-] unit-test
-
 [ f ] [
     [ { fixnum fixnum } declare 7 bitand neg shift ]
     \ fixnum-shift-fast inlined?

basis/compiler/tree/finalization/finalization.factor

@@ -1,7 +1,15 @@
 ! Copyright (C) 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: kernel accessors sequences
-compiler.tree compiler.tree.combinators ;
+USING: kernel accessors sequences words namespaces
+classes.builtin
+compiler.tree
+compiler.tree.builder
+compiler.tree.normalization
+compiler.tree.propagation
+compiler.tree.cleanup
+compiler.tree.def-use
+compiler.tree.dead-code
+compiler.tree.combinators ;
 IN: compiler.tree.finalization
 
 GENERIC: finalize* ( node -- nodes )
@@ -13,6 +21,25 @@ M: #shuffle finalize*
     [ in>> ] [ out>> ] bi sequence=
     [ drop f ] when ;
 
+: builtin-predicate? ( word -- ? )
+    "predicating" word-prop builtin-class? ;
+
+: splice-quot ( quot -- nodes )
+    [
+        build-tree
+        normalize
+        propagate
+        cleanup
+        compute-def-use
+        remove-dead-code
+        but-last
+    ] with-scope ;
+
+M: #call finalize*
+    dup word>> builtin-predicate? [
+        word>> def>> splice-quot
+    ] when ;
+
 M: node finalize* ;
 
 : finalize ( nodes -- nodes' ) [ finalize* ] map-nodes ;

basis/compiler/tree/propagation/known-words/known-words.factor

@@ -211,7 +211,7 @@ generic-comparison-ops [
 \ eq? [
     [ info-intervals-intersect? ]
     [ info-classes-intersect? ]
-    2bi or maybe-or-never
+    2bi and maybe-or-never
 ] "outputs" set-word-prop
 
 {

basis/compiler/tree/propagation/propagation-tests.factor

@@ -589,6 +589,10 @@ MIXIN: empty-mixin
     ] final-classes
 ] unit-test
 
+[ V{ POSTPONE: f } ] [
+    [ { float } declare 0 eq? ] final-classes
+] unit-test
+
 ! [ V{ string } ] [
 !     [ dup string? t xor [ "A" throw ] [ ] if ] final-classes
 ! ] unit-test

basis/math/complex/complex-docs.factor

@@ -2,18 +2,24 @@ USING: help.markup help.syntax math math.private math.functions
 math.complex.private ;
 IN: math.complex
 
+ARTICLE: "complex-numbers-zero" "Embedding of real numbers in complex numbers"
+"Constructing a complex number with an imaginary component equal to an integer zero simply returns the real number corresponding to the real component:"
+{ $example "USING: math prettyprint ;" "C{ 1 2 } C{ 3 -2 } + ." "4" }
+"Constructing a complex number with an imaginary component equal to floating point zero will still output a new complex number, however:"
+{ $example "USING: math prettyprint ;" "C{ 0.0 2.0 } C{ 0.0 1.0 } * ." "C{ 2.0 0.0 }" }
+"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero." ;
+
 ARTICLE: "complex-numbers" "Complex numbers"
 { $subsection complex }
 "Complex numbers arise as solutions to quadratic equations whose graph does not intersect the " { $emphasis "x" } " axis. Their literal syntax is covered in " { $link "syntax-complex-numbers" } "."
 $nl
-"Unlike math, where all real numbers are also complex numbers, Factor only considers a number to be a complex number if its imaginary part is non-zero. However, complex number operations are fully supported for real numbers; they are treated as having an imaginary part of zero."
-$nl
 "Complex numbers can be taken apart:"
 { $subsection real-part }
 { $subsection imaginary-part }
 { $subsection >rect }
 "Complex numbers can be constructed from real numbers:"
 { $subsection rect> }
+{ $subsection "complex-numbers-zero" }
 { $see-also "syntax-complex-numbers" } ;
 HELP: complex
 { $class-description "The class of complex numbers with non-zero imaginary part." } ;

basis/math/complex/complex-tests.factor

@@ -6,8 +6,13 @@ IN: math.complex.tests
 [ C{ 0 1 } 1 rect> ] must-fail
 
 [ f ] [ C{ 5 12.5 } 5 = ] unit-test
-[ t ] [ C{ 1.0 2.0 } C{ 1 2 }  = ] unit-test
+[ f ] [ C{ 5 12.5 } 5 number= ] unit-test
+
+[ f ] [ C{ 1.0 2.0 } C{ 1 2 } = ] unit-test
+[ t ] [ C{ 1.0 2.0 } C{ 1 2 } number= ] unit-test
+
 [ f ] [ C{ 1.0 2.3 } C{ 1 2 } = ] unit-test
+[ f ] [ C{ 1.0 2.3 } C{ 1 2 } number= ] unit-test
 
 [ C{ 2 5 } ] [ 2 5  rect> ] unit-test
 [ 2 5 ] [ C{ 2 5 }  >rect ] unit-test
@@ -30,7 +35,7 @@ IN: math.complex.tests
 
 [ C{ 0 1 } ] [ C{ 0 1 } 1  * ] unit-test
 [ C{ 0 1 } ] [ 1 C{ 0 1 }  * ] unit-test
-[ C{ 0 1.0 } ] [ 1.0 C{ 0 1 }  * ] unit-test
+[ C{ 0.0 1.0 } ] [ 1.0 C{ 0 1 }  * ] unit-test
 [ -1 ] [ C{ 0 1 } C{ 0 1 }  * ] unit-test
 [ C{ 0 1 } ] [ 1 C{ 0 1 }  * ] unit-test
 [ C{ 0 1 } ] [ C{ 0 1 } 1  * ] unit-test
@@ -45,18 +50,18 @@ IN: math.complex.tests
 
 [ C{ -3 4 } ] [ C{ 3 -4 }  neg ] unit-test
 
-[ 5 ] [ C{ 3 4 } abs ] unit-test
-[ 5 ] [ -5.0 abs ] unit-test
+[ 5.0 ] [ C{ 3 4 } abs ] unit-test
+[ 5.0 ] [ -5.0 abs ] unit-test
 
 ! Make sure arguments are sane
-[ 0 ] [ 0 arg ] unit-test
-[ 0 ] [ 1 arg ] unit-test
+[ 0.0 ] [ 0 arg ] unit-test
+[ 0.0 ] [ 1 arg ] unit-test
 [ t ] [ -1 arg 3.14 3.15 between? ] unit-test
 [ t ] [ C{ 0 1 } arg 1.57 1.58 between? ] unit-test
 [ t ] [ C{ 0 -1 } arg -1.58 -1.57 between? ] unit-test
 
-[ 1 0 ] [ 1 >polar ] unit-test
-[ 1 ] [ -1 >polar drop ] unit-test
+[ 1.0 0.0 ] [ 1 >polar ] unit-test
+[ 1.0 ] [ -1 >polar drop ] unit-test
 [ t ] [ -1 >polar nip 3.14 3.15 between? ] unit-test
 
 ! I broke something

basis/math/complex/complex.factor

@@ -17,6 +17,14 @@ M: complex absq >rect [ sq ] bi@ + ;
     [ [ real-part ] bi@ ] 2keep
     [ imaginary-part ] bi@ ; inline
 
+M: complex hashcode*
+    nip >rect [ hashcode ] bi@ bitxor ;
+
+M: complex equal?
+    over complex? [
+        2>rect = [ = ] [ 2drop f ] if
+    ] [ 2drop f ] if ;
+
 M: complex number=
     2>rect number= [ number= ] [ 2drop f ] if ;
 
@@ -36,8 +44,6 @@ M: complex abs absq >float fsqrt ;
 
 M: complex sqrt >polar swap fsqrt swap 2.0 / polar> ;
 
-M: complex hashcode* nip >rect >fixnum swap >fixnum bitxor ;
-
 IN: syntax
 
 : C{ \ } [ first2 rect> ] parse-literal ; parsing

basis/math/functions/functions-docs.factor

@@ -106,7 +106,7 @@ HELP: (rect>)
 
 HELP: rect>
 { $values { "x" real } { "y" real } { "z" number } }
-{ $description "Creates a complex number from real and imaginary components." } ;
+{ $description "Creates a complex number from real and imaginary components. If " { $snippet "z" } " is an integer zero, this will simply output " { $snippet "x" } "." } ;
 
 HELP: >rect
 { $values { "z" number } { "x" real } { "y" real } }

basis/math/functions/functions-tests.factor

@@ -12,10 +12,11 @@ IN: math.functions.tests
 [ 0.25 ] [ 2.0 -2.0 fpow ] unit-test
 
 [ 4.0 ] [ 16 sqrt ] unit-test
-[ C{ 0 4.0 } ] [ -16 sqrt ] unit-test
+[ 2.0 ] [ 4.0 0.5 ^ ] unit-test
+[ C{ 0.0 4.0 } ] [ -16 sqrt ] unit-test
 
-[ 4.0 ] [ 2 2 ^ ] unit-test
-[ 0.25 ] [ 2 -2 ^ ] unit-test
+[ 4 ] [ 2 2 ^ ] unit-test
+[ 1/4 ] [ 2 -2 ^ ] unit-test
 [ t ] [ 2 0.5 ^ 2 ^ 2 2.00001 between? ] unit-test
 [ t ] [ e pi i* ^ real-part -1.0 = ] unit-test
 [ t ] [ e pi i* ^ imaginary-part -0.00001 0.00001 between? ] unit-test
@@ -27,6 +28,8 @@ IN: math.functions.tests
 [ 0 ] [ 0 3.0 ^ ] unit-test
 [ 0 ] [ 0 3 ^ ] unit-test
 
+[ 0.0 ] [ 1 log ] unit-test
+
 [ 1.0 ] [ 0 cosh ] unit-test
 [ 0.0 ] [ 1 acosh ] unit-test
             

basis/math/functions/functions.factor

@@ -7,7 +7,7 @@ IN: math.functions
 <PRIVATE
 
 : (rect>) ( x y -- z )
-    dup zero? [ drop ] [ <complex> ] if ; inline
+    dup 0 = [ drop ] [ <complex> ] if ; inline
 
 PRIVATE>
 
@@ -24,29 +24,57 @@ M: real sqrt
     >float dup 0.0 < [ neg fsqrt 0.0 swap rect> ] [ fsqrt ] if ;
 
 : each-bit ( n quot: ( ? -- ) -- )
-    over 0 number= pick -1 number= or [
+    over 0 = pick -1 = or [
         2drop
     ] [
         2dup >r >r >r odd? r> call r> 2/ r> each-bit
     ] if ; inline recursive
 
-GENERIC: (^) ( x y -- z ) foldable
-
 : ^n ( z w -- z^w )
     1 swap [
         [ dupd * ] when >r sq r>
     ] each-bit nip ; inline
 
-M: integer (^)
-    dup 0 < [ neg ^n recip ] [ ^n ] if ;
+: integer^ ( x y -- z )
+    dup 0 > [ ^n ] [ neg ^n recip ] if ; inline
+
+: >rect ( z -- x y )
+    [ real-part ] [ imaginary-part ] bi ; inline
+
+: >float-rect ( z -- x y )
+    >rect [ >float ] bi@ ; inline
+
+: >polar ( z -- abs arg )
+    >float-rect [ [ sq ] bi@ + fsqrt ] [ swap fatan2 ] 2bi ;
+    inline
+
+: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
+
+: polar> ( abs arg -- z ) cis * ; inline
+
+: ^mag ( w abs arg -- magnitude )
+    >r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
+    inline
+
+: ^theta ( w abs arg -- theta )
+    >r >r >float-rect r> flog * swap r> * + ; inline
+
+: ^complex ( x y -- z )
+    swap >polar [ ^mag ] [ ^theta ] 3bi polar> ; inline
+
+: real^? ( x y -- ? )
+    2dup [ real? ] both? [ drop 0 >= ] [ 2drop f ] if ; inline
+
+: 0^ ( x -- z )
+    dup zero? [ drop 0./0. ] [ 0 < 1./0. 0 ? ] if ; inline
 
 : ^ ( x y -- z )
-    over zero? [
-        dup zero?
-        [ 2drop 0.0 0.0 / ] [ 0 < [ drop 1.0 0.0 / ] when ] if
-    ] [
-        (^)
-    ] if ; inline
+    {
+        { [ over zero? ] [ nip 0^ ] }
+        { [ dup integer? ] [ integer^ ] }
+        { [ 2dup real^? ] [ fpow ] }
+        [ ^complex ]
+    } cond ;
 
 : (^mod) ( n x y -- z )
     1 swap [
@@ -98,42 +126,27 @@ M: real absq sq ;
         [ ~abs ]
     } cond ;
 
-: >rect ( z -- x y ) dup real-part swap imaginary-part ; inline
-
 : conjugate ( z -- z* ) >rect neg rect> ; inline
 
-: >float-rect ( z -- x y )
-    >rect swap >float swap >float ; inline
-
 : arg ( z -- arg ) >float-rect swap fatan2 ; inline
 
-: >polar ( z -- abs arg )
-    >float-rect [ [ sq ] bi@ + fsqrt ] 2keep swap fatan2 ;
-    inline
-
-: cis ( arg -- z ) dup fcos swap fsin rect> ; inline
-
-: polar> ( abs arg -- z ) cis * ; inline
-
-: ^mag ( w abs arg -- magnitude )
-    >r >r >float-rect swap r> swap fpow r> rot * fexp /f ;
-    inline
-
-: ^theta ( w abs arg -- theta )
-    >r >r >float-rect r> flog * swap r> * + ; inline
-
-M: number (^)
-    swap >polar 3dup ^theta >r ^mag r> polar> ;
-
 : [-1,1]? ( x -- ? )
     dup complex? [ drop f ] [ abs 1 <= ] if ; inline
 
 : >=1? ( x -- ? )
     dup complex? [ drop f ] [ 1 >= ] if ; inline
 
-: exp ( x -- y ) >rect swap fexp swap polar> ; inline
+GENERIC: exp ( x -- y )
 
-: log ( x -- y ) >polar swap flog swap rect> ; inline
+M: real exp fexp ;
+
+M: complex exp >rect swap fexp swap polar> ;
+
+GENERIC: log ( x -- y )
+
+M: real log dup 0.0 >= [ flog ] [ 0.0 rect> log ] if ;
+
+M: complex log >polar swap flog swap rect> ;
 
 : cos ( x -- y )
     dup complex? [

basis/math/intervals/intervals-tests.factor

@@ -60,11 +60,11 @@ IN: math.intervals.tests
 ] unit-test
 
 [ t ] [
-    1 2 [a,b] -0.5 0.5 [a,b] interval* -1 1 [a,b] =
+    1 2 [a,b] -0.5 0.5 [a,b] interval* -1.0 1.0 [a,b] =
 ] unit-test
 
 [ t ] [
-    1 2 [a,b] -0.5 0.5 (a,b] interval* -1 1 (a,b] =
+    1 2 [a,b] -0.5 0.5 (a,b] interval* -1.0 1.0 (a,b] =
 ] unit-test
 
 [ t ] [
@@ -131,7 +131,7 @@ IN: math.intervals.tests
 
 "math.ratios.private" vocab [
     [ t ] [
-        -1 1 (a,b) 0.5 1 (a,b) interval/ -2 2 (a,b) =
+        -1 1 (a,b) 0.5 1 (a,b) interval/ -2.0 2.0 (a,b) =
     ] unit-test
 ] when
 

basis/math/ratios/ratios-tests.factor

@@ -81,8 +81,8 @@ unit-test
 [ -1/2 ] [ 1/2 1- ] unit-test
 [ 3/2 ] [ 1/2 1+ ] unit-test
 
-[ 1 ] [ 0.5 1/2 + ] unit-test
-[ 1 ] [ 1/2 0.5 + ] unit-test
+[ 1.0 ] [ 0.5 1/2 + ] unit-test
+[ 1.0 ] [ 1/2 0.5 + ] unit-test
 
 [ 1/268435456 ] [ -1 -268435456 >fixnum / ] unit-test
 [ 268435456 ] [ -268435456 >fixnum -1 / ] unit-test

basis/math/ratios/ratios.factor

@@ -30,6 +30,14 @@ M: integer /
         2dup gcd nip tuck /i >r /i r> fraction>
     ] if ;
 
+M: ratio hashcode*
+    nip >fraction [ hashcode ] bi@ bitxor ;
+
+M: ratio equal?
+    over ratio? [
+        2>fraction = [ = ] [ 2drop f ] if
+    ] [ 2drop f ] if ;
+
 M: ratio number=
     2>fraction number= [ number= ] [ 2drop f ] if ;
 

core/classes/tuple/tuple-tests.factor

@@ -701,3 +701,11 @@ DEFER: error-y
 [ ] [
     "IN: sequences TUPLE: reversed { seq read-only } ;" eval
 ] unit-test
+
+TUPLE: bogus-hashcode-1 x ;
+
+TUPLE: bogus-hashcode-2 x ;
+
+M: bogus-hashcode-1 hashcode* 2drop 0 >bignum ;
+
+[ ] [ T{ bogus-hashcode-2 T{ bogus-hashcode-1 } } hashcode drop ] unit-test

core/generic/standard/standard-tests.factor

@@ -81,7 +81,7 @@ M: parallelogram perimiter
 M: circle perimiter 2 * pi * ;
 
 [ 14 ] [ 4 3 <rectangle> perimiter ] unit-test
-[ 30 ] [ 10 4 3 <parallelogram> perimiter ] unit-test
+[ 30.0 ] [ 10 4 3 <parallelogram> perimiter ] unit-test
 
 GENERIC: big-mix-test ( obj -- obj' )
 

core/hashtables/hashtables-tests.factor

@@ -28,7 +28,6 @@ unit-test
 
 [ t ] [ 12 hashcode 12 hashcode = ] unit-test
 [ t ] [ 12 >bignum hashcode 12 hashcode = ] unit-test
-[ t ] [ 12.0 hashcode 12 >bignum hashcode = ] unit-test
 
 ! Test various odd keys to see if they work.
 

core/kernel/kernel-docs.factor

@@ -251,13 +251,15 @@ ARTICLE: "conditionals" "Conditionals and logic"
 { $see-also "booleans" "bitwise-arithmetic" both? either? } ;
 
 ARTICLE: "equality" "Equality"
-"There are two distinct notions of ``sameness'' when it comes to objects. You can test if two references point to the same object (" { $emphasis "identity comparison" } "), or you can test if two objects are equal in a domain-specific sense, usually by being instances of the same class, and having equal slot values (" { $emphasis "value comparison" } "). Both notions of equality are equality relations in the mathematical sense."
+"There are two distinct notions of ``sameness'' when it comes to objects."
 $nl
-"Identity comparison:"
+"You can test if two references point to the same object (" { $emphasis "identity comparison" } "). This is rarely used; it is mostly useful with large, mutable objects where the object identity matters but the value is transient:"
 { $subsection eq? }
-"Value comparison:"
+"You can test if two objects are equal in a domain-specific sense, usually by being instances of the same class, and having equal slot values (" { $emphasis "value comparison" } "):"
 { $subsection = }
-"Custom value comparison methods:"
+"A third form of equality is provided by " { $link number= } ". It compares numeric value while disregarding types."
+$nl
+"Custom value comparison methods for use with " { $link = } " can be defined on a generic word:"
 { $subsection equal? }
 "Utility class:"
 { $subsection identity-tuple }
@@ -367,6 +369,13 @@ HELP: =
 { $values { "obj1" object } { "obj2" object } { "?" "a boolean" } }
 { $description
     "Tests if two objects are equal. If " { $snippet "obj1" } " and " { $snippet "obj2" } " point to the same object, outputs " { $link t } ". Otherwise, calls the " { $link equal? } " generic word."
+}
+{ $examples
+    { $example "USING: kernel prettyprint ;" "5 5 = ." "t" }
+    { $example "USING: kernel prettyprint ;" "5 005 = ." "t" }
+    { $example "USING: kernel prettyprint ;" "5 5.0 = ." "f" }
+    { $example "USING: arrays kernel prettyprint ;" "{ \"a\" \"b\" } \"a\" \"b\" 2array = ." "t" }
+    { $example "USING: arrays kernel prettyprint ;" "{ \"a\" \"b\" } [ \"a\" \"b\" ] = ." "f" }
 } ;
 
 HELP: equal?
@@ -381,8 +390,13 @@ HELP: equal?
         { { $snippet "a = b" } " implies " { $snippet "b = a" } }
         { { $snippet "a = b" } " and " { $snippet "b = c" } " implies " { $snippet "a = c" } }
     }
-    $nl
     "If a class defines a custom equality comparison test, it should also define a compatible method for the " { $link hashcode* } " generic word."
+}
+{ $examples
+    "An example demonstrating why this word should only be used to define methods on, and never called directly:"
+    { $example "USING: kernel prettyprint ;" "5 5 equal? ." "f" }
+    "Using " { $link = } " gives the expected behavior:"
+    { $example "USING: kernel prettyprint ;" "5 5 = ." "t" }
 } ;
 
 HELP: identity-tuple

core/math/floats/floats-tests.factor

@@ -5,10 +5,17 @@ IN: math.floats.tests
 [ t ] [ 3.1415 number? ] unit-test
 [ f ] [ 12 float? ] unit-test
 
-[ t ] [ 1 1.0 = ] unit-test
-[ t ] [ 1 >bignum 1.0 = ] unit-test
-[ t ] [ 1.0 1 = ] unit-test
-[ t ] [ 1.0 1 >bignum = ] unit-test
+[ f ] [ 1 1.0 = ] unit-test
+[ t ] [ 1 1.0 number= ] unit-test
+
+[ f ] [ 1 >bignum 1.0 = ] unit-test
+[ t ] [ 1 >bignum 1.0 number= ] unit-test
+
+[ f ] [ 1.0 1 = ] unit-test
+[ t ] [ 1.0 1 number= ] unit-test
+
+[ f ] [ 1.0 1 >bignum = ] unit-test
+[ t ] [ 1.0 1 >bignum number= ] unit-test
 
 [ f ] [ 1 1.3 = ] unit-test
 [ f ] [ 1 >bignum 1.3 = ] unit-test
@@ -45,13 +52,10 @@ unit-test
 [ 2.0 ] [ 1.0 1+ ] unit-test
 [ 0.0 ] [ 1.0 1- ] unit-test
 
-! [ t ] [ -0.0 -0.0 = ] unit-test
-! [ f ] [ 0.0 -0.0 = ] unit-test
-
 [ t ] [ 0.0 zero? ] unit-test
 [ t ] [ -0.0 zero? ] unit-test
 
-! [ t ] [ 0.0/0.0 0.0/0.0 = ] unit-test
+! [ f ] [ 0.0/0.0 0.0/0.0 number= ] unit-test
 
 [ 0 ] [ 1/0. >bignum ] unit-test
 

core/math/floats/floats.factor

@@ -10,11 +10,14 @@ M: float >fixnum float>fixnum ;
 M: float >bignum float>bignum ;
 M: float >float ;
 
+M: float hashcode* nip float>bits ;
+M: float equal? over float? [ float= ] [ 2drop f ] if ;
+M: float number= float= ;
+
 M: float < float< ;
 M: float <= float<= ;
 M: float > float> ;
 M: float >= float>= ;
-M: float number= float= ;
 
 M: float + float+ ;
 M: float - float- ;

core/math/integers/integers.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2004, 2007 Slava Pestov.
+! Copyright (C) 2004, 2008 Slava Pestov.
 ! Copyright (C) 2008, Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel kernel.private sequences
@@ -12,6 +12,8 @@ M: fixnum >fixnum ;
 M: fixnum >bignum fixnum>bignum ;
 M: fixnum >integer ;
 
+M: fixnum hashcode* nip ;
+M: fixnum equal? over bignum? [ >bignum bignum= ] [ 2drop f ] if ;
 M: fixnum number= eq? ;
 
 M: fixnum < fixnum< ;
@@ -47,7 +49,15 @@ M: fixnum (log2) 0 swap (fixnum-log2) ;
 M: bignum >fixnum bignum>fixnum ;
 M: bignum >bignum ;
 
+M: bignum hashcode* nip >fixnum ;
+
+M: bignum equal?
+    over bignum? [ bignum= ] [
+        swap dup fixnum? [ >bignum bignum= ] [ 2drop f ] if
+    ] if ;
+
 M: bignum number= bignum= ;
+
 M: bignum < bignum< ;
 M: bignum <= bignum<= ;
 M: bignum > bignum> ;

core/math/math-docs.factor

@@ -26,7 +26,9 @@ $nl
 { $subsection < }
 { $subsection <= }
 { $subsection > }
-{ $subsection >= } ;
+{ $subsection >= }
+"Numbers can be compared for equality using " { $link = } ", or a less precise test which disregards types:"
+{ $subsection number= } ;
 
 ARTICLE: "modular-arithmetic" "Modular arithmetic"
 { $subsection mod }
@@ -60,8 +62,12 @@ ABOUT: "arithmetic"
 
 HELP: number=
 { $values { "x" number } { "y" number } { "?" "a boolean" } }
-{ $description "Tests if two numbers have the same numerical value. If either input is not a number, outputs " { $link f } "." }
-{ $notes "Do not call this word directly. Calling " { $link = } " has the same effect and is more concise." } ;
+{ $description "Tests if two numbers have the same numeric value." }
+{ $notes "This word differs from " { $link = } " in that it disregards differences in type when comparing numbers." }
+{ $examples
+    { $example "USING: math prettyprint ;" "3.0 3 number= ." "t" }
+    { $example "USING: math prettyprint ;" "3.0 3 = ." "f" }
+} ;
 
 HELP: <
 { $values { "x" real } { "y" real } { "?" "a boolean" } }
@@ -286,7 +292,10 @@ HELP: zero?
 HELP: times
 { $values { "n" integer } { "quot" quotation } }
 { $description "Calls the quotation " { $snippet "n" } " times." }
-{ $notes "If you need to pass the current index to the quotation, use " { $link each } "." } ;
+{ $notes "If you need to pass the current index to the quotation, use " { $link each } "." }
+{ $examples
+    { $example "USING: io math ;" "3 [ \"Hi\" print ] times" "Hi\nHi\nHi\n" }
+} ;
 
 HELP: fp-nan?
 { $values { "x" real } { "?" "a boolean" } }
@@ -294,11 +303,16 @@ HELP: fp-nan?
 
 HELP: real-part
 { $values { "z" number } { "x" real } }
-{ $description "Outputs the real part of a complex number. This acts as the identity on real numbers." } ;
+{ $description "Outputs the real part of a complex number. This acts as the identity on real numbers." }
+{ $examples { $example "C{ 1 2 } real-part ." "1" } } ;
 
 HELP: imaginary-part
 { $values { "z" number } { "y" real } }
-{ $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." } ;
+{ $description "Outputs the imaginary part of a complex number. This outputs zero for real numbers." }
+{ $examples
+    { $example "C{ 1 2 } imaginary-part ." "2" }
+    { $example "3 imaginary-part ." "0" }
+} ;
 
 HELP: real
 { $class-description "The class of real numbers, which is a disjoint union of rationals and floats." } ;

core/math/math.factor

@@ -1,4 +1,4 @@
-! Copyright (C) 2003, 2007 Slava Pestov.
+! Copyright (C) 2003, 2008 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: kernel math.private ;
 IN: math
@@ -82,10 +82,6 @@ UNION: real rational float ;
 
 UNION: number real complex ;
 
-M: number equal? number= ;
-
-M: real hashcode* nip >fixnum ;
-
 GENERIC: fp-nan? ( x -- ? )
 
 M: object fp-nan?

core/sequences/sequences-tests.factor

@@ -69,7 +69,7 @@ unit-test
 [ f ] [ [ { 2 } { } { } ] all-equal? ] unit-test
 [ t ] [ [ ] all-equal? ] unit-test
 [ t ] [ [ 1234 ] all-equal? ] unit-test
-[ t ] [ [ 1.0 1 1 ] all-equal? ] unit-test
+[ f ] [ [ 1.0 1 1 ] all-equal? ] unit-test
 [ t ] [ { 1 2 3 4 } [ < ] monotonic? ] unit-test
 [ f ] [ { 1 2 3 4 } [ > ] monotonic? ] unit-test
 [ [ 2 3 4 ] ] [ [ 1 2 3 ] 1 [ + ] curry map ] unit-test
@@ -251,3 +251,9 @@ unit-test
 [ { "a" "b" "c" "d" } ] [ { "a" "b" "c" "d" } { 0 1 2 3 } nths ] unit-test
 [ { "d" "c" "b" "a" } ] [ { "a" "b" "c" "d" } { 3 2 1 0 } nths ] unit-test
 [ { "d" "a" "b" "c" } ] [ { "a" "b" "c" "d" } { 3 0 1 2 } nths ] unit-test
+
+TUPLE: bogus-hashcode ;
+
+M: bogus-hashcode hashcode* 2drop 0 >bignum ;
+
+[ 0 ] [ { T{ bogus-hashcode } } hashcode ] unit-test

core/sequences/sequences.factor

@@ -499,15 +499,13 @@ M: sequence <=>
     [ mismatch not ] [ 2drop f ] if ; inline
 
 : sequence-hashcode-step ( oldhash newpart -- newhash )
-    swap [
+    >fixnum swap [
         dup -2 fixnum-shift-fast swap 5 fixnum-shift-fast
         fixnum+fast fixnum+fast
     ] keep fixnum-bitxor ; inline
 
 : sequence-hashcode ( n seq -- x )
-    0 -rot [
-        hashcode* >fixnum sequence-hashcode-step
-    ] with each ; inline
+    0 -rot [ hashcode* sequence-hashcode-step ] with each ; inline
 
 M: reversed equal? over reversed? [ sequence= ] [ 2drop f ] if ;