]> gitweb.factorcode.org Git - factor.git/blobdiff - basis/compression/huffman/huffman.factor
core, basis, extra: Remove DOS line endings from files.
[factor.git] / basis / compression / huffman / huffman.factor
index 7b5582a0b6fd770d853f7b293f9aa80956e004b5..03927e5a48ab78d437638e074a34a8571622d593 100644 (file)
@@ -1,75 +1,75 @@
-! Copyright (C) 2009 Marc Fauconneau.\r
-! See http://factorcode.org/license.txt for BSD license.\r
-USING: accessors arrays assocs fry\r
-hashtables io kernel locals math math.order math.parser\r
-math.ranges multiline sequences bitstreams bit-arrays ;\r
-IN: compression.huffman\r
-\r
-QUALIFIED-WITH: bitstreams bs\r
-\r
-<PRIVATE\r
-\r
-TUPLE: huffman-code\r
-    { value fixnum }\r
-    { size fixnum }\r
-    { code fixnum } ;\r
-\r
-: <huffman-code> ( -- huffman-code )\r
-    0 0 0 huffman-code boa ; inline\r
-\r
-: next-size ( huffman-code -- )\r
-    [ 1 + ] change-size\r
-    [ 2 * ] change-code drop ; inline\r
-\r
-: next-code ( huffman-code -- )\r
-    [ 1 + ] change-code drop ; inline\r
-\r
-:: all-patterns ( huffman-code n -- seq )\r
-    n log2 huffman-code size>> - :> free-bits\r
-    free-bits 0 >\r
-    [ free-bits 2^ iota [ huffman-code code>> free-bits 2^ * + ] map ]\r
-    [ huffman-code code>> free-bits neg 2^ /i 1array ] if ;\r
-\r
-:: huffman-each ( ... tdesc quot: ( ... huffman-code -- ... ) -- ... )\r
-    <huffman-code> :> code\r
-    tdesc\r
-    [\r
-        code next-size\r
-        [ code value<< code clone quot call code next-code ] each\r
-    ] each ; inline\r
-\r
-: update-reverse-table ( huffman-code n table -- )\r
-    [ drop all-patterns ]\r
-    [ nip '[ _ swap _ set-at ] each ] 3bi ;\r
-\r
-:: reverse-table ( tdesc n -- rtable )\r
-   n f <array> <enum> :> table\r
-   tdesc [ n table update-reverse-table ] huffman-each\r
-   table seq>> ;\r
-\r
-PRIVATE>\r
-\r
-TUPLE: huffman-decoder\r
-    { bs bit-reader }\r
-    { tdesc array }\r
-    { rtable array }\r
-    { bits/level fixnum } ;\r
-\r
-: <huffman-decoder> ( bs tdesc -- huffman-decoder )\r
-    huffman-decoder new\r
-        swap >>tdesc\r
-        swap >>bs\r
-        16 >>bits/level\r
-        dup [ tdesc>> ] [ bits/level>> 2^ ] bi reverse-table >>rtable ; inline\r
-\r
-: read1-huff ( huffman-decoder -- elt )\r
-    16 over [ bs>> bs:peek ] [ rtable>> nth ] bi\r
-    [ size>> swap bs>> bs:seek ] [ value>> ] bi ; inline\r
-\r
-: reverse-bits ( value bits -- value' )\r
-    [ integer>bit-array ] dip\r
-    f pad-tail reverse bit-array>integer ; inline\r
-\r
-: read1-huff2 ( huffman-decoder -- elt )\r
-    16 over [ bs>> bs:peek 16 reverse-bits ] [ rtable>> nth ] bi\r
-    [ size>> swap bs>> bs:seek ] [ value>> ] bi ; inline\r
+! Copyright (C) 2009 Marc Fauconneau.
+! See http://factorcode.org/license.txt for BSD license.
+USING: accessors arrays assocs fry
+hashtables io kernel locals math math.order math.parser
+math.ranges multiline sequences bitstreams bit-arrays ;
+IN: compression.huffman
+
+QUALIFIED-WITH: bitstreams bs
+
+<PRIVATE
+
+TUPLE: huffman-code
+    { value fixnum }
+    { size fixnum }
+    { code fixnum } ;
+
+: <huffman-code> ( -- huffman-code )
+    0 0 0 huffman-code boa ; inline
+
+: next-size ( huffman-code -- )
+    [ 1 + ] change-size
+    [ 2 * ] change-code drop ; inline
+
+: next-code ( huffman-code -- )
+    [ 1 + ] change-code drop ; inline
+
+:: all-patterns ( huffman-code n -- seq )
+    n log2 huffman-code size>> - :> free-bits
+    free-bits 0 >
+    [ free-bits 2^ iota [ huffman-code code>> free-bits 2^ * + ] map ]
+    [ huffman-code code>> free-bits neg 2^ /i 1array ] if ;
+
+:: huffman-each ( ... tdesc quot: ( ... huffman-code -- ... ) -- ... )
+    <huffman-code> :> code
+    tdesc
+    [
+        code next-size
+        [ code value<< code clone quot call code next-code ] each
+    ] each ; inline
+
+: update-reverse-table ( huffman-code n table -- )
+    [ drop all-patterns ]
+    [ nip '[ _ swap _ set-at ] each ] 3bi ;
+
+:: reverse-table ( tdesc n -- rtable )
+   n f <array> <enum> :> table
+   tdesc [ n table update-reverse-table ] huffman-each
+   table seq>> ;
+
+PRIVATE>
+
+TUPLE: huffman-decoder
+    { bs bit-reader }
+    { tdesc array }
+    { rtable array }
+    { bits/level fixnum } ;
+
+: <huffman-decoder> ( bs tdesc -- huffman-decoder )
+    huffman-decoder new
+        swap >>tdesc
+        swap >>bs
+        16 >>bits/level
+        dup [ tdesc>> ] [ bits/level>> 2^ ] bi reverse-table >>rtable ; inline
+
+: read1-huff ( huffman-decoder -- elt )
+    16 over [ bs>> bs:peek ] [ rtable>> nth ] bi
+    [ size>> swap bs>> bs:seek ] [ value>> ] bi ; inline
+
+: reverse-bits ( value bits -- value' )
+    [ integer>bit-array ] dip
+    f pad-tail reverse bit-array>integer ; inline
+
+: read1-huff2 ( huffman-decoder -- elt )
+    16 over [ bs>> bs:peek 16 reverse-bits ] [ rtable>> nth ] bi
+    [ size>> swap bs>> bs:seek ] [ value>> ] bi ; inline