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

serialization of byte arrays

chris.double 2006-09-05 23:36:46 +00:00
parent 2a6cd307de
commit 89435bd1b8
2 changed files with 26 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
contrib/serialize/serialize.factor
View File

@ -7,7 +7,7 @@
! See http://factorcode.org/license.txt for BSD license.
!
IN: serialize
USING: kernel kernel-internals math hashtables namespaces io strings sequences generic words errors arrays vectors ;
USING: kernel kernel-internals math hashtables namespaces io strings sequences generic words errors arrays vectors alien ;
! Variable holding a sequence of objects already serialized
SYMBOL: serialized
@ -117,6 +117,16 @@ M: wrapper serialize ( obj -- )
"W" write
wrapped serialize ;
M: byte-array serialize ( obj -- )
[
"A" write
dup add-object serialize
dup length cells dup serialize
[
2dup alien-unsigned-1 serialize
] repeat
] serialize-shared drop ;
DEFER: deserialize ( -- obj )
: intern-object ( id obj -- )
@ -186,6 +196,14 @@ DEFER: deserialize ( -- obj )
deserialize array>tuple
[ intern-object ] keep ;
: deserialize-byte-array ( -- byte-array )
deserialize
deserialize dup <byte-array> swap
[
deserialize pick pick set-alien-unsigned-1
] repeat
[ intern-object ] keep ;
: deserialize-unknown ( -- object )
deserialize serialized get nth ;
@ -206,6 +224,7 @@ DEFER: deserialize ( -- obj )
{ "h" deserialize-hashtable }
{ "T" deserialize-tuple }
{ "z" deserialize-zero }
{ "A" deserialize-byte-array }
{ "o" deserialize-unknown }
}
hash dup [ "Unknown typecode" throw ] unless nip execute ;

8
contrib/serialize/tests.factor
View File

@ -1,7 +1,7 @@
! Copyright (C) 2006 Chris Double.
! See http://factorcode.org/license.txt for BSD license.
!
USING: test kernel serialize io math ;
USING: test kernel serialize io math alien arrays ;
IN: temporary
[ f ] [
@ -151,4 +151,8 @@ TUPLE: serialize-test a b ;
[ [ deserialize deserialize ] with-serialized ] string-in eq?
] unit-test
[ 50 ] [
[ [ 5 <byte-array> 50 over 0 set-alien-unsigned-1 serialize ] with-serialized ] string-out
[ [ deserialize ] with-serialized ] string-in
0 alien-unsigned-1
] unit-test