Bootstrap fix
parent
9c1f6f73ac
commit
5901107f66
|
@ -270,7 +270,7 @@ M: no-such-symbol compiler-error-type
|
||||||
pop-literal nip >>library
|
pop-literal nip >>library
|
||||||
pop-literal nip >>return
|
pop-literal nip >>return
|
||||||
! Quotation which coerces parameters to required types
|
! 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
|
! Set ABI
|
||||||
dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
|
dup library>> library [ abi>> ] [ "cdecl" ] if* >>abi
|
||||||
! Add node to IR
|
! Add node to IR
|
||||||
|
@ -278,7 +278,7 @@ M: no-such-symbol compiler-error-type
|
||||||
! Magic #: consume exactly the number of inputs
|
! Magic #: consume exactly the number of inputs
|
||||||
dup 0 alien-invoke-stack
|
dup 0 alien-invoke-stack
|
||||||
! Quotation which coerces return value to required type
|
! 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
|
] "infer" set-word-prop
|
||||||
|
|
||||||
M: #alien-invoke generate-node
|
M: #alien-invoke generate-node
|
||||||
|
@ -306,13 +306,13 @@ M: alien-indirect-error summary
|
||||||
pop-parameters >>parameters
|
pop-parameters >>parameters
|
||||||
pop-literal nip >>return
|
pop-literal nip >>return
|
||||||
! Quotation which coerces parameters to required types
|
! 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
|
! Add node to IR
|
||||||
dup node,
|
dup node,
|
||||||
! Magic #: consume the function pointer, too
|
! Magic #: consume the function pointer, too
|
||||||
dup 1 alien-invoke-stack
|
dup 1 alien-invoke-stack
|
||||||
! Quotation which coerces return value to required type
|
! 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
|
] "infer" set-word-prop
|
||||||
|
|
||||||
M: #alien-indirect generate-node
|
M: #alien-indirect generate-node
|
||||||
|
@ -345,7 +345,7 @@ M: alien-callback-error summary
|
||||||
|
|
||||||
: callback-bottom ( node -- )
|
: callback-bottom ( node -- )
|
||||||
xt>> [ word-xt drop <alien> ] curry
|
xt>> [ word-xt drop <alien> ] curry
|
||||||
f infer-quot ;
|
recursive-state get infer-quot ;
|
||||||
|
|
||||||
\ alien-callback [
|
\ alien-callback [
|
||||||
4 ensure-values
|
4 ensure-values
|
||||||
|
|
|
@ -1,5 +1,22 @@
|
||||||
IN: bootstrap.image.tests
|
IN: bootstrap.image.tests
|
||||||
USING: bootstrap.image bootstrap.image.private tools.test ;
|
USING: bootstrap.image bootstrap.image.private tools.test
|
||||||
|
kernel math ;
|
||||||
|
|
||||||
\ ' must-infer
|
\ ' must-infer
|
||||||
\ write-image 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
|
||||||
|
|
|
@ -39,19 +39,23 @@ C: <id> id
|
||||||
|
|
||||||
M: id hashcode* obj>> hashcode* ;
|
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?
|
M: id equal?
|
||||||
over id? [
|
over id? [ [ obj>> ] bi@ eql? ] [ 2drop f ] if ;
|
||||||
[ obj>> ] bi@
|
|
||||||
[ = ] [
|
|
||||||
dup number? [
|
|
||||||
[ class ] bi@ =
|
|
||||||
] [
|
|
||||||
2drop t
|
|
||||||
] if
|
|
||||||
] 2bi and
|
|
||||||
] [
|
|
||||||
2drop f
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
SYMBOL: objects
|
SYMBOL: objects
|
||||||
|
|
||||||
|
|
|
@ -110,10 +110,10 @@ M: bignum (log2) bignum-log2 ;
|
||||||
! Main word
|
! Main word
|
||||||
: /f-abs ( m n -- f )
|
: /f-abs ( m n -- f )
|
||||||
over zero? [
|
over zero? [
|
||||||
2drop 0 >float
|
2drop 0.0
|
||||||
] [
|
] [
|
||||||
dup zero? [
|
dup zero? [
|
||||||
2drop 1 >float 0 >float /
|
2drop 1.0/0.0
|
||||||
] [
|
] [
|
||||||
pre-scale
|
pre-scale
|
||||||
/f-loop over odd?
|
/f-loop over odd?
|
||||||
|
|
Loading…
Reference in New Issue