diff --git a/contrib/serialize/serialize.factor b/contrib/serialize/serialize.factor index 8474451823..59a4ddfc47 100644 --- a/contrib/serialize/serialize.factor +++ b/contrib/serialize/serialize.factor @@ -32,18 +32,17 @@ GENERIC: serialize ( obj -- ) M: f serialize ( obj -- ) drop "n" write ; -M: fixnum serialize ( obj -- ) - ! Factor may use 64 bit fixnums on such systems - "f" write - 4 >be write ; +: bytes-needed ( number -- int ) + log2 8 + 8 /i ; -: bytes-needed ( bignum -- int ) - log2 8 + 8 / floor ; - -M: bignum serialize ( obj -- ) - "b" write - dup bytes-needed serialize - dup bytes-needed >be write ; +M: integer serialize ( obj -- ) + dup 0 = [ + drop "z" write + ] [ + dup 0 < [ neg "m" ] [ "p" ] if write + dup bytes-needed dup 4 >be write + >be write + ] if ; M: float serialize ( obj -- ) "F" write @@ -88,7 +87,7 @@ M: sbuf serialize ( obj -- ) M: tuple serialize ( obj -- ) [ - "t" write + "T" write dup add-object serialize tuple>array serialize ] serialize-shared ; @@ -126,9 +125,6 @@ DEFER: deserialize ( -- obj ) : deserialize-false ( -- f ) f ; -: deserialize-fixnum ( -- fixnum ) - 4 read be> ; - : deserialize-string ( -- string ) deserialize deserialize read [ intern-object ] keep ; @@ -138,8 +134,14 @@ DEFER: deserialize ( -- obj ) : deserialize-complex ( -- complex ) deserialize deserialize deserialize rect> [ intern-object ] keep ; -: deserialize-bignum ( -- bignum ) - deserialize read be> ; +: deserialize-negative-integer ( -- number ) + 4 read be> read be> neg ; + +: deserialize-positive-integer ( -- number ) + 4 read be> read be> ; + +: deserialize-zero ( -- number ) + 0 ; : deserialize-float ( -- float ) deserialize bits>float ; @@ -189,11 +191,11 @@ DEFER: deserialize ( -- obj ) : deserialize ( -- object ) read1 ch>string dup - H{ { "f" deserialize-fixnum } - { "s" deserialize-string } + H{ { "s" deserialize-string } { "r" deserialize-ratio } { "c" deserialize-complex } - { "b" deserialize-bignum } + { "p" deserialize-positive-integer } + { "m" deserialize-negative-integer } { "F" deserialize-float } { "w" deserialize-word } { "W" deserialize-wrapper } @@ -202,7 +204,8 @@ DEFER: deserialize ( -- obj ) { "v" deserialize-vector } { "q" deserialize-quotation } { "h" deserialize-hashtable } - { "t" deserialize-tuple } + { "T" deserialize-tuple } + { "z" deserialize-zero } { "o" deserialize-unknown } } hash dup [ "Unknown typecode" throw ] unless nip execute ; diff --git a/contrib/serialize/tests.factor b/contrib/serialize/tests.factor index 24534c177c..8e668bd5e7 100644 --- a/contrib/serialize/tests.factor +++ b/contrib/serialize/tests.factor @@ -14,6 +14,16 @@ IN: temporary [ [ deserialize ] with-serialized ] string-in ] 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 serialize ] with-serialized ] string-out [ [ deserialize ] with-serialized ] string-in @@ -24,11 +34,21 @@ IN: temporary [ [ deserialize ] with-serialized ] string-in 5 5 5 ^ ^ = ] 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 serialize ] with-serialized ] string-out [ [ deserialize ] with-serialized ] string-in ] unit-test +[ -5.25 ] [ + [ [ -5.25 serialize ] with-serialized ] string-out + [ [ deserialize ] with-serialized ] string-in +] unit-test + [ C{ 1 2 } ] [ [ [ C{ 1 2 } serialize ] with-serialized ] string-out [ [ deserialize ] with-serialized ] string-in