Bootstrap fix

core/alien/compiler/compiler.factor

@@ -270,7 +270,7 @@ M: no-such-symbol compiler-error-type
     pop-literal nip >>library
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot f infer-quot
+    dup param-prep-quot recursive-state get infer-quot
     ! Set ABI
     dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
     ! Add node to IR
@@ -278,7 +278,7 @@ M: no-such-symbol compiler-error-type
     ! Magic #: consume exactly the number of inputs
     dup 0 alien-invoke-stack
     ! Quotation which coerces return value to required type
-    return-prep-quot f infer-quot
+    return-prep-quot recursive-state get infer-quot
 ] "infer" set-word-prop
 
 M: #alien-invoke generate-node
@@ -306,13 +306,13 @@ M: alien-indirect-error summary
     pop-parameters >>parameters
     pop-literal nip >>return
     ! Quotation which coerces parameters to required types
-    dup param-prep-quot [ dip ] curry f infer-quot
+    dup param-prep-quot [ dip ] curry recursive-state get infer-quot
     ! Add node to IR
     dup node,
     ! Magic #: consume the function pointer, too
     dup 1 alien-invoke-stack
     ! Quotation which coerces return value to required type
-    return-prep-quot f infer-quot
+    return-prep-quot recursive-state get infer-quot
 ] "infer" set-word-prop
 
 M: #alien-indirect generate-node
@@ -345,7 +345,7 @@ M: alien-callback-error summary
 
 : callback-bottom ( node -- )
     xt>> [ word-xt drop <alien> ] curry
-    f infer-quot ;
+    recursive-state get infer-quot ;
 
 \ alien-callback [
     4 ensure-values

core/bootstrap/image/image-tests.factor

@@ -1,5 +1,22 @@
 IN: bootstrap.image.tests
-USING: bootstrap.image bootstrap.image.private tools.test ;
+USING: bootstrap.image bootstrap.image.private tools.test
+kernel math ;
 
 \ ' must-infer
 \ write-image must-infer
+
+[ f ] [ { 1 2 3 } [ 1 2 3 ] eql? ] unit-test
+
+[ t ] [ [ 1 2 3 ] [ 1 2 3 ] eql? ] unit-test
+
+[ f ] [ [ 2drop 0 ] [ 2drop 0.0 ] eql? ] unit-test
+
+[ t ] [ [ 2drop 0 ] [ 2drop 0 ] eql? ] unit-test
+
+[ f ] [ \ + [ 2drop 0 ] eql? ] unit-test
+
+[ f ] [ 3 [ 0 1 2 ] eql? ] unit-test
+
+[ f ] [ 3 3.0 eql? ] unit-test
+
+[ t ] [ 4.0 4.0 eql? ] unit-test

core/bootstrap/image/image.factor

@@ -39,19 +39,23 @@ C: <id> id
 
 M: id hashcode* obj>> hashcode* ;
 
+GENERIC: (eql?) ( obj1 obj2 -- ? )
+
+: eql? ( obj1 obj2 -- ? )
+    [ (eql?) ] [ [ class ] bi@ = ] 2bi and ;
+
+M: integer (eql?) = ;
+
+M: sequence (eql?)
+    over sequence? [
+        2dup [ length ] bi@ =
+        [ [ eql? ] 2all? ] [ 2drop f ] if
+    ] [ 2drop f ] if ;
+
+M: object (eql?) = ;
+
 M: id equal?
-    over id? [
-        [ obj>> ] bi@
-        [ = ] [
-            dup number? [
-                [ class ] bi@ =
-            ] [
-                2drop t
-            ] if
-        ] 2bi and
-    ] [
-        2drop f
-    ] if ;
+    over id? [ [ obj>> ] bi@ eql? ] [ 2drop f ] if ;
 
 SYMBOL: objects
 

core/math/integers/integers.factor

@@ -110,10 +110,10 @@ M: bignum (log2) bignum-log2 ;
 ! Main word
 : /f-abs ( m n -- f )
     over zero? [
-        2drop 0 >float
+        2drop 0.0
     ] [
         dup zero? [
-            2drop 1 >float 0 >float /
+            2drop 1.0/0.0
         ] [
             pre-scale
             /f-loop over odd?