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

compression.zlib: Guess at the length and take a byte-array as uncompress argument instead of a silly compressed tuple.

db4
Doug Coleman 2015-05-01 23:43:58 -07:00
parent 10d6fc654c
commit 8a4c80371e
1 changed files with 18 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

22
basis/compression/zlib/zlib.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2009 Doug Coleman. ! Copyright (C) 2009 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: alien alien.c-types alien.data alien.syntax byte-vectors USING: accessors alien alien.c-types alien.data alien.syntax
combinators kernel math math.functions sequences system byte-arrays byte-vectors combinators continuations destructors
accessors libc ; fry kernel libc math math.functions math.ranges sequences system ;
QUALIFIED: compression.zlib.ffi QUALIFIED: compression.zlib.ffi
IN: compression.zlib IN: compression.zlib
@ -44,7 +44,9 @@ ERROR: zlib-failed n string ;
] 2keep drop ulong deref >>length B{ } like ] 2keep drop ulong deref >>length B{ } like
] keep length <compressed> ; ] keep length <compressed> ;
: uncompress ( compressed -- byte-array ) GENERIC: uncompress ( obj -- byte-array )
M: compressed uncompress ( compressed -- byte-array )
[ [
length>> [ <byte-vector> dup underlying>> ] keep length>> [ <byte-vector> dup underlying>> ] keep
ulong <ref> ulong <ref>
@ -52,3 +54,15 @@ ERROR: zlib-failed n string ;
data>> dup length pick data>> dup length pick
[ compression.zlib.ffi:uncompress zlib-error ] dip [ compression.zlib.ffi:uncompress zlib-error ] dip
] bi ulong deref >>length B{ } like ; ] bi ulong deref >>length B{ } like ;
: (uncompress) ( length byte-array -- byte-array )
[
[ drop [ malloc &free ] [ ulong <ref> ] bi ]
[ nip dup length ] 2bi
[ compression.zlib.ffi:uncompress zlib-error ] 4keep
2drop ulong deref memory>byte-array
] with-destructors ;
M: byte-array uncompress ( byte-array -- byte-array )
[ length 5 [0,b) [ 2^ * ] with map ] keep
'[ _ (uncompress) ] attempt-all ;