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

fix integer serialization

chris.double 2006-09-05 00:12:51 +00:00
parent f95176f766
commit 035a64ad8b
2 changed files with 44 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

45
contrib/serialize/serialize.factor
View File

@ -32,18 +32,17 @@ GENERIC: serialize ( obj -- )
M: f serialize ( obj -- ) M: f serialize ( obj -- )
drop "n" write ; drop "n" write ;
M: fixnum serialize ( obj -- ) : bytes-needed ( number -- int )
! Factor may use 64 bit fixnums on such systems log2 8 + 8 /i ;
"f" write
4 >be write ;
: bytes-needed ( bignum -- int ) M: integer serialize ( obj -- )
log2 8 + 8 / floor ; dup 0 = [
drop "z" write
M: bignum serialize ( obj -- ) ] [
"b" write dup 0 < [ neg "m" ] [ "p" ] if write
dup bytes-needed serialize dup bytes-needed dup 4 >be write
dup bytes-needed >be write ; >be write
] if ;
M: float serialize ( obj -- ) M: float serialize ( obj -- )
"F" write "F" write
@ -88,7 +87,7 @@ M: sbuf serialize ( obj -- )
M: tuple serialize ( obj -- ) M: tuple serialize ( obj -- )
[ [
"t" write "T" write
dup add-object serialize dup add-object serialize
tuple>array serialize tuple>array serialize
] serialize-shared ; ] serialize-shared ;
@ -126,9 +125,6 @@ DEFER: deserialize ( -- obj )
: deserialize-false ( -- f ) : deserialize-false ( -- f )
f ; f ;
: deserialize-fixnum ( -- fixnum )
4 read be> ;
: deserialize-string ( -- string ) : deserialize-string ( -- string )
deserialize deserialize read [ intern-object ] keep ; deserialize deserialize read [ intern-object ] keep ;
@ -138,8 +134,14 @@ DEFER: deserialize ( -- obj )
: deserialize-complex ( -- complex ) : deserialize-complex ( -- complex )
deserialize deserialize deserialize rect> [ intern-object ] keep ; deserialize deserialize deserialize rect> [ intern-object ] keep ;
: deserialize-bignum ( -- bignum ) : deserialize-negative-integer ( -- number )
deserialize read be> ; 4 read be> read be> neg ;
: deserialize-positive-integer ( -- number )
4 read be> read be> ;
: deserialize-zero ( -- number )
0 ;
: deserialize-float ( -- float ) : deserialize-float ( -- float )
deserialize bits>float ; deserialize bits>float ;
@ -189,11 +191,11 @@ DEFER: deserialize ( -- obj )
: deserialize ( -- object ) : deserialize ( -- object )
read1 ch>string dup read1 ch>string dup
H{ { "f" deserialize-fixnum } H{ { "s" deserialize-string }
{ "s" deserialize-string }
{ "r" deserialize-ratio } { "r" deserialize-ratio }
{ "c" deserialize-complex } { "c" deserialize-complex }
{ "b" deserialize-bignum } { "p" deserialize-positive-integer }
{ "m" deserialize-negative-integer }
{ "F" deserialize-float } { "F" deserialize-float }
{ "w" deserialize-word } { "w" deserialize-word }
{ "W" deserialize-wrapper } { "W" deserialize-wrapper }
@ -202,7 +204,8 @@ DEFER: deserialize ( -- obj )
{ "v" deserialize-vector } { "v" deserialize-vector }
{ "q" deserialize-quotation } { "q" deserialize-quotation }
{ "h" deserialize-hashtable } { "h" deserialize-hashtable }
{ "t" deserialize-tuple } { "T" deserialize-tuple }
{ "z" deserialize-zero }
{ "o" deserialize-unknown } { "o" deserialize-unknown }
} }
hash dup [ "Unknown typecode" throw ] unless nip execute ; hash dup [ "Unknown typecode" throw ] unless nip execute ;

20
contrib/serialize/tests.factor
View File

@ -14,6 +14,16 @@ IN: temporary
[ [ deserialize ] with-serialized ] string-in [ [ deserialize ] with-serialized ] string-in
] unit-test ] unit-test
[ 0 ] [
[ [ 0 serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in
] unit-test
[ -50 ] [
[ [ -50 serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in
] unit-test
[ 20 ] [ [ 20 ] [
[ [ 20 serialize ] with-serialized ] string-out [ [ 20 serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in [ [ deserialize ] with-serialized ] string-in
@ -24,11 +34,21 @@ IN: temporary
[ [ deserialize ] with-serialized ] string-in 5 5 5 ^ ^ = [ [ deserialize ] with-serialized ] string-in 5 5 5 ^ ^ =
] unit-test ] unit-test
[ t ] [
[ [ 5 5 5 ^ ^ neg serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in 5 5 5 ^ ^ neg =
] unit-test
[ 5.25 ] [ [ 5.25 ] [
[ [ 5.25 serialize ] with-serialized ] string-out [ [ 5.25 serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in [ [ deserialize ] with-serialized ] string-in
] unit-test ] unit-test
[ -5.25 ] [
[ [ -5.25 serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in
] unit-test
[ C{ 1 2 } ] [ [ C{ 1 2 } ] [
[ [ C{ 1 2 } serialize ] with-serialized ] string-out [ [ C{ 1 2 } serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in [ [ deserialize ] with-serialized ] string-in