basis/compression/zlib/zlib.factor

   1 ! Copyright (C) 2009 Doug Coleman.
   2 ! See http://factorcode.org/license.txt for BSD license.
   3 USING: accessors alien alien.c-types alien.data alien.syntax
   4 byte-arrays byte-vectors combinators continuations destructors
   5 fry kernel libc math math.functions math.ranges sequences system ;
   6 QUALIFIED: compression.zlib.ffi
   7 IN: compression.zlib
   8
   9 ERROR: zlib-failed n string ;
  10
  11 : zlib-error-message ( n -- * )
  12     dup compression.zlib.ffi:Z_ERRNO = [
  13         drop errno "native libc error"
  14     ] [
  15         dup
  16         neg ! zlib error codes are negative
  17         {
  18             "no error" "libc_error"
  19             "stream error" "data error"
  20             "memory error" "buffer error" "zlib version error"
  21         } ?nth
  22     ] if zlib-failed ;
  23
  24 : zlib-error ( n -- )
  25     dup compression.zlib.ffi:Z_OK = [ drop ] [ dup zlib-error-message zlib-failed ] if ;
  26
  27 : compressed-size ( byte-array -- n )
  28     length 1001/1000 * ceiling 12 + ;
  29
  30 : compress ( byte-array -- byte-array' )
  31     [
  32         compressed-size
  33         [ <byte-vector> dup underlying>> ] keep ulong <ref>
  34     ] keep [
  35         dup length compression.zlib.ffi:compress zlib-error
  36     ] 2keep drop ulong deref >>length B{ } like ;
  37
  38 : (uncompress) ( length byte-array -- byte-array )
  39     [
  40         [ drop [ malloc &free ] [ ulong <ref> ] bi ]
  41         [ nip dup length ] 2bi
  42         [ compression.zlib.ffi:uncompress zlib-error ] 4keep
  43         2drop ulong deref memory>byte-array
  44     ] with-destructors ;
  45
  46 : uncompress ( byte-array -- byte-array' )
  47     [ length 5 [0,b) [ 2^ * ] with map ] keep
  48     '[ _ (uncompress) ] attempt-all ;