factor: trim using lists

[factor.git] / basis / compression / inflate / inflate.factor

diff --git a/basis/compression/inflate/inflate.factor b/basis/compression/inflate/inflate.factor
index ab27c70ac0e6aa9bbbe75068b5d31eb015711964..65e132eeacfc26036cc5d9e3fb2c5aec7efa13b9 100644 (file)
--- a/basis/compression/inflate/inflate.factor
+++ b/basis/compression/inflate/inflate.factor
@@ -1,18 +1,18 @@
-! Copyright (C) 2009 Marc Fauconneau.
+! Copyright (C) 2009, 2020 Marc Fauconneau, Abtin Molavi, Jacob Fischer.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: accessors arrays assocs byte-vectors combinators
-combinators.smart compression.huffman fry hashtables io.binary
-kernel literals locals math math.bitwise math.order math.ranges
-sequences sorting memoize combinators.short-circuit ;
+USING: accessors arrays assocs bitstreams byte-arrays
+byte-vectors combinators combinators.short-circuit
+combinators.smart compression.huffman endian kernel math
+math.bitwise ranges sequences sorting ;
 QUALIFIED-WITH: bitstreams bs
 IN: compression.inflate
 
 <PRIVATE
 
-ERROR: zlib-unimplemented ;
 ERROR: bad-zlib-data ;
 ERROR: bad-zlib-header ;
 
+
 :: check-zlib-header ( data -- )
     16 data bs:peek 2 >le be> 31 mod    ! checksum
     0 assert=
@@ -24,19 +24,39 @@ ERROR: bad-zlib-header ;
     2 data bs:seek                      ! compression level; ignore
     ;
 
+
+: read-until-terminated ( data -- data ) 
+   [ dup 8 swap bs:read 0 =  ] [  ]  until ;
+
+:: interpret-flag ( flg data  -- )
+   27 data bs:seek 
+   flg first 1 = [ 8 data bs:read data bs:seek  ] when
+   flg second 1 = [ data read-until-terminated drop ] when
+   flg fourth 1 = [ data read-until-terminated drop ] when
+   flg second 1 = [ 1 data bs:read drop  ] when ;
+
+:: check-gzip-header ( data -- )
+    8 data bs:read 31 assert=   ! ID 1
+    8 data bs:read 139 assert=  ! ID 2 
+    8 data bs:read 8 assert=    ! compression method: deflate
+    1 data bs:seek ! ignore textbit
+    1 data bs:read 1 data bs:read 1 data bs:read 1 data bs:read 4array data interpret-flag
+    ;
+
+
 CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
 
 : get-table ( values size -- table )
-    16 f <array> <enum>
+    16 f <array> <enumerated>
     [ '[ _ push-at ] 2each ] keep
     seq>> rest-slice [ natural-sort ] map ; inline
 
 :: decode-huffman-tables ( bitstream -- tables )
     5 bitstream bs:read 257 +
     5 bitstream bs:read 1 +
-    4 bitstream bs:read 4 + clen-shuffle swap head 
+    4 bitstream bs:read 4 + clen-shuffle swap head
 
-    dup length iota [ 3 bitstream bs:read ] replicate
+    dup length [ 3 bitstream bs:read ] replicate
     get-table
     bitstream swap <huffman-decoder>
     [ 2dup + ] dip swap :> k!
@@ -60,17 +80,17 @@ CONSTANT: clen-shuffle { 16 17 18 0 8 7 9 6 10 5 11 4 12 3 13 2 14 1 15 }
     ] reduce
     [ dup array? [ second 0 <repetition> ] [ 1array ] if ] map concat
     nip swap cut 2array
-    [ [ length>> iota ] [ ] bi get-table ] map ;
+    [ [ length>> <iota> ] [ ] bi get-table ] map ;
 
 MEMO: static-huffman-tables ( -- obj )
     [
-        0 143 [a,b] [ 8 ] replicate
-        144 255 [a,b] [ 9 ] replicate append
-        256 279 [a,b] [ 7 ] replicate append
-        280 287 [a,b] [ 8 ] replicate append
+          0 143 [a..b] length [ 8 ] replicate
+        144 255 [a..b] length [ 9 ] replicate append
+        256 279 [a..b] length [ 7 ] replicate append
+        280 287 [a..b] length [ 8 ] replicate append
     ] append-outputs
-    0 31 [a,b] [ 5 ] replicate 2array
-    [ [ length>> [0,b) ] [ ] bi get-table ] map ;
+    0 31 [a..b] length [ 5 ] replicate 2array
+    [ [ length>> <iota> ] [ ] bi get-table ] map ;
 
 CONSTANT: length-table
     {
@@ -88,14 +108,14 @@ CONSTANT: dist-table
 : nth* ( n seq -- elt )
     [ length 1 - swap - ] [ nth ] bi ; inline
 
-:: inflate-lz77 ( seq -- bytes )
+:: inflate-lz77 ( seq -- byte-array )
     1000 <byte-vector> :> bytes
     seq [
         dup array?
         [ first2 '[ _ 1 - bytes nth* bytes push ] times ]
         [ bytes push ] if
     ] each
-    bytes ;
+    bytes >byte-array ;
 
 :: inflate-huffman ( bitstream tables -- bytes )
     bitstream tables [ <huffman-decoder> ] with map :> tables
@@ -168,3 +188,8 @@ PRIVATE>
     bs:<lsb0-bit-reader>
     [ check-zlib-header ] [ inflate-loop ] bi
     inflate-lz77 ;
+
+: gzip-inflate ( bytes -- bytes )
+    bs:<lsb0-bit-reader>
+    [ check-gzip-header ] [ inflate-loop ] bi
+    inflate-lz77 ;