steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

slots: Don't coerce flots to integers in tuple slots. Add an initial value for bignums so they can be used as tuple slot types. Fixes #593.

db4
Doug Coleman 2012-07-30 18:16:44 -07:00
parent ffe1c510ae
commit 78db66a924
2 changed files with 2 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
core/bootstrap/primitives.factor
View File

@ -197,7 +197,7 @@ bi
"null?" "kernel" vocab-words delete-at "null?" "kernel" vocab-words delete-at
"fixnum" "math" create { } define-builtin "fixnum" "math" create { } define-builtin
"fixnum" "math" create ">fixnum" "math" create 1quotation "coercer" set-word-prop "fixnum" "math" create "integer>fixnum" "math" create 1quotation "coercer" set-word-prop
"bignum" "math" create { } define-builtin "bignum" "math" create { } define-builtin
"bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop "bignum" "math" create ">bignum" "math" create 1quotation "coercer" set-word-prop

2
core/slots/slots.factor
View File

@ -71,7 +71,6 @@ M: class instance-check-quot ( class -- quot )
{ {
{ [ dup object bootstrap-word eq? ] [ drop [ ] ] } { [ dup object bootstrap-word eq? ] [ drop [ ] ] }
{ [ dup "coercer" word-prop ] [ "coercer" word-prop ] } { [ dup "coercer" word-prop ] [ "coercer" word-prop ] }
{ [ dup integer bootstrap-word eq? ] [ drop [ >integer ] ] }
[ call-next-method ] [ call-next-method ]
} cond ; } cond ;
@ -200,6 +199,7 @@ M: anonymous-intersection initial-value*
{ [ dup "initial-value" word-prop ] [ dup "initial-value" word-prop t ] } { [ dup "initial-value" word-prop ] [ dup "initial-value" word-prop t ] }
{ [ \ f bootstrap-word over class<= ] [ f t ] } { [ \ f bootstrap-word over class<= ] [ f t ] }
{ [ \ array-capacity bootstrap-word over class<= ] [ 0 t ] } { [ \ array-capacity bootstrap-word over class<= ] [ 0 t ] }
{ [ bignum bootstrap-word over class<= ] [ 0 >bignum t ] }
{ [ float bootstrap-word over class<= ] [ 0.0 t ] } { [ float bootstrap-word over class<= ] [ 0.0 t ] }
{ [ string bootstrap-word over class<= ] [ "" t ] } { [ string bootstrap-word over class<= ] [ "" t ] }
{ [ array bootstrap-word over class<= ] [ { } t ] } { [ array bootstrap-word over class<= ] [ { } t ] }