Tiny Inflate for Rebol 2

tiny-inflate.r

Rebol [
    Title: "Tiny Inflate"
    Date: 10-Dec-2021
    Author: "Christopher Ross-Gill"
    Version: 1.0.3
    Type: 'module
    Name: 'rgchris.inflate
    Exports: [inflate]
    History: [
        10-Dec-2021 1.0.3 https://github.com/foliojs/tiny-inflate
        10-Dec-2021 1.0.3 "Original transcription from JavaScript"
    ] 
]

tinf: make object! [
    TINF_OK: 0
    TINF_DATA_ERROR: -3

    new-tree: func [] [
        reduce [
            'table array/initial 16 0  ; table of code length counts
            'trans array/initial 288 0  ; code -> symbol translation
        ]
    ]

    new-data: func [
        source
        target
    ][
        make object! compose [
            source: (source)
            index: 0
            tag: 0
            bitcount: 0

            target: (target)
            length: 0

            ltree: new-tree  ; dynamic length/symbol tree
            dtree: new-tree  ; dynamic distance tree
        ]
    ]


    ; -- uninitialized global data (static structures) --
    ; ---------------------------------------------------

    sltree: new-tree
    sdtree: new-tree

    ; extra bits and base tables for length codes
    ;
    length_bits: array/initial 30 0
    length_base: array/initial 30 0  ; Uint16Array

    ; extra bits and base tables for distance codes
    ;
    dist_bits: array/initial 30 0
    dist_base: array/initial 30 0  ; Uint16Array

    ; special ordering of code length codes */
    ;
    clcidx: [
        16 17 18 0 8 7 9 6
        10 5 11 4 12 3 13 2
        14 1 15
    ]

    ; used by tinf_decode_trees, avoids allocations every call
    ;
    code_tree: new-tree
    lengths: array/initial 288 + 32 0

    ; -- utility functions --
    ; -----------------------

    ; build extra bits and base tables
    ;
    tinf_build_bits_base: func [
        bits [block!]
        base
        delta [integer!]
        first
        /local sum
    ][
        sum: first

        ; build bits table
        ;
        change bits array/initial delta 0

        repeat i 30 - delta [
            poke bits i + delta to integer! any [
                attempt [(i - 1) / delta]
                0
            ]
        ]

        ; build base table
        ;
        repeat i 30 [
            poke base i sum
            sum: sum + shift/left 1 bits/:i
        ]

        ()
    ]

    ; build the fixed huffman trees
    ;
    tinf_build_fixed_trees: func [
        lt
        dt
    ][
        ; build fixed-length tree
        ;
        change lt/table [
            0 0 0 0 0 0 0 24 152 112
        ]

        repeat i 24 [
            poke lt/trans i 255 + i
        ]

        repeat i 144 [
            poke lt/trans 24 + i i - 1
        ]

        repeat i 8 [
            poke lt/trans 24 + 144 + i 279 + i
        ]

        repeat i 112 [
            poke lt/trans 24 + 144 + 8 + i 143 + i
        ]

        ; build fixed distance tree
        ;
        change dt/table [
            0 0 0 0 0 32
        ]

        repeat i 32 [
            poke dt/trans i i - 1
        ]

        ()
    ]

    ; given an array of code lengths, build a tree
    ;
    offs: array/initial 16 0

    tinf_build_tree: func [
        t
        lengths
        off
        num
        /local sum
    ][
        ; clear code length count table
        ;
        change t/table array/initial 16 0

        ; scan symbol lengths, and sum code length counts
        ;
        repeat i num [
            poke t/table 1 + lengths/(off + i) 1 + t/table/(1 + lengths/(off + i))
        ]

        change t/table 0

        ; compute offset table for distribution sort
        ;
        sum: 0

        repeat i 16 [
            poke offs i sum
            sum: sum + pick t/table i
        ]

        ; create code->symbol translation table (symbols sorted by code)
        ;
        repeat i num [
            if lengths/(off + i) > 0 [
                poke t/trans 1 + offs/(1 + lengths/(off + i)) i - 1
                poke offs 1 + lengths/(off + i) 1 + offs/(1 + lengths/(off + i))
            ]
        ]

        ()
    ]

    ; -- decode functions --
    ; ----------------------

    ; get one bit from source stream
    ;
    tinf_getbit: func [
        d
        /local bit
    ][
        ; check if tag is empty
        ;
        if zero? d/bitcount [
            ; load next tag
            ;
            d/tag: d/source/1
            d/bitcount: 8
            d/source: next d/source
        ]

        d/bitcount: d/bitcount - 1

        ; shift bit out of tag
        bit: d/tag and 1
        d/tag: shift/logical d/tag 1

        bit
    ]

    ; read a num bit value from a stream and add base
    ;
    tinf_read_bits: func [
        d
        num [integer!]
        base
        /local val
    ][
        either zero? num [
            base
        ][
            while [
                d/bitcount < 24
            ][
                d/tag: d/tag or shift/left any [d/source/1 0] d/bitcount
                d/source: next d/source
                d/bitcount: d/bitcount + 8
            ]

            val: d/tag and shift/logical 65535 16 - num
            d/tag: shift/logical d/tag num
            d/bitcount: d/bitcount - num

            val + base
        ]
    ]

    ; given a data stream and a tree, decode a symbol
    ;
    tinf_decode_symbol: func [
        d
        t
        /local sum cur len tag
    ][
        while [
            d/bitcount < 24
        ][
            d/tag: d/tag or shift/left any [d/source/1 0] d/bitcount
            d/source: next d/source
            d/bitcount: d/bitcount + 8
        ]

        sum: 0
        cur: 0
        len: 0
        tag: d/tag


        ; get more bits while code value is above sum
        ;
        until [
            cur: 2 * cur + (tag and 1)
            tag: shift/logical tag 1
            len: len + 1

            sum: sum + pick t/table len + 1
            cur: cur - pick t/table len + 1

            cur < 0
        ]

        d/tag: tag
        d/bitcount: d/bitcount - len

        pick t/trans sum + cur + 1
    ]

    ; given a data stream, decode dynamic trees from it
    ;
    tinf_decode_trees: func [
        d
        lt
        dt
        /local
        hlit hdist hclen
        num length
        clen sym prev
    ][
        ; get 5 bits HLIT (257-286)
        ;
        hlit: tinf_read_bits d 5 257

        ; get 5 bits HDIST (1-32)
        ;
        hdist: tinf_read_bits d 5 1

        ; get 4 bits HCLEN (4-19)
        ;
        hclen: tinf_read_bits d 4 4

        change lengths array/initial 19 0

        ; read code lengths for code length alphabet
        ;
        repeat i hclen [
            ; get 3 bits code length (0-7)
            ;
            clen: tinf_read_bits d 3 0
            poke lengths clcidx/:i + 1 clen
        ]

        ; build code length tree
        tinf_build_tree code_tree lengths 0 19

        ; decode code lengths for the dynamic trees
        num: 1

        while [num < (hlit + hdist + 1)] [
            sym: tinf_decode_symbol d code_tree

            switch/default sym [
                16 [
                    ; copy previous code length 3-6 times (read 2 bits)
                    ;
                    prev: pick lengths num - 1
                    length: tinf_read_bits d 2 3

                    while [length > 0] [
                        poke lengths num prev

                        num: num + 1
                        length: length - 1
                    ]
                ]

                17 [
                    ; repeat code length 0 for 3-10 times (read 3 bits)
                    ;
                    length: tinf_read_bits d 3 3

                    while [length > 0] [
                        poke lengths num 0

                        num: num + 1
                        length: length - 1
                    ]
                ]

                18 [
                    ; repeat code length 0 for 11-138 times (read 7 bits)
                    ;
                    length: tinf_read_bits d 7 11

                    while [length > 0] [
                        ; probe num

                        poke lengths num 0

                        num: num + 1
                        length: length - 1
                    ]
                ]
            ][
                ; values 0-15 represent the actual code lengths
                poke lengths num sym
                num: num + 1
            ]
        ]

        ; build dynamic trees
        ;
        tinf_build_tree lt lengths 0 hlit
        tinf_build_tree dt lengths hlit hdist

        ()
    ]

    ; -- block inflate functions --
    ; -----------------------------

    ; given a stream and two trees, inflate a block of data
    ;
    tinf_inflate_block_data: func [
        d lt dt
        /local sym length dist offs
    ][
        until [
            sym: tinf_decode_symbol d lt

            case [
                sym == 256 [
                    TINF_OK
                ]
                
                sym < 256 [
                    append d/target to char! sym
                    false
                ]

                <else> [
                    sym: sym - 257

                    ; possibly get more bits from length code
                    ;
                    length: tinf_read_bits d length_bits/(sym + 1) length_base/(sym + 1)

                    dist: tinf_decode_symbol d dt

                    ; possibly get more bits from distance code
                    ;
                    offs: (length? d/target) - tinf_read_bits d dist_bits/(dist + 1) dist_base/(dist + 1)

                    ; copy match
                    ;
                    repeat i length [
                        append d/target to char! pick d/target i + offs
                    ]

                    false
                ]
            ]
        ]
    ]

    ; inflate an uncompressed block of data
    ;
    tinf_inflate_uncompressed_block: func [
        d
        /local length invlength
    ][
        ; unread from bitbuffer
        ;
        while [d.bitcount > 8] [
            d/source: back d/source
            d/bitcount: d/bitcount - 8
        ]

        ; get length
        ;
        length: 256 * d/source/2 + d/source/1

        ; get one's complement of length
        ;
        invlength = 256 * d/source/4 + d/source/3

        ; check length
        ;
        either length <> (65535 and complement invlength) [
            TINF_DATA_ERROR
        ][
            d/source: skip d/source 4

            ; copy block
            ;
            repeat i length [
                append d/target to char! d/source/1
                d/source: next d/source
            ]

            ; make sure we start next block on a byte boundary
            d/bitcount: 0

            TINF_OK
        ]
    ]

    ; inflate stream from source to dest
    ;
    tinf_uncompress: func [
        source dest
        /local d bfinal btype res
    ][
        d: new-data source dest

        until [
            ; read final block flag
            ;
            bfinal: tinf_getbit d

            ; read block type (2 bits)
            ;
            btype: tinf_read_bits d 2 0

            ; decompress block
            ;
            switch/default btype [
                0 [
                    ; decompress uncompressed block
                    ;
                    res: tinf_inflate_uncompressed_block d
                ]

                1 [
                    ; decompress block with fixed huffman trees
                    ;
                    res: tinf_inflate_block_data d sltree sdtree
                ]

                2 [
                    ; decompress block with dynamic huffman trees
                    ;
                    tinf_decode_trees d d/ltree d/dtree

                    res: tinf_inflate_block_data d d/ltree d/dtree
                ]
            ][
                res: TINF_DATA_ERROR  ;
            ]

            if res <> TINF_OK [
                make error! "Data Error"
            ]

            bfinal
        ]

        d/target
    ]

    ; -- initialization --
    ; --------------------

    ; build fixed huffman trees
    ;
    tinf_build_fixed_trees sltree sdtree

    ; build extra bits and base tables
    ;
    tinf_build_bits_base length_bits length_base 4 3
    tinf_build_bits_base dist_bits dist_base 2 1

    ; fix a special case
    length_bits/29: 0
    length_base/29: 258
]

inflate: get in tinf 'tinf_uncompress

~readme.md

Workable, not perfect. Needs some polish and splicing was inadvertantly removed along the way 🤷‍♂️