(in-package #:lempel)

(declaim (ftype (function ((array (unsigned-byte 8)) (unsigned-byte 8)) (array (unsigned-byte 8))) prefix-decode))
(defun prefix-decode (data prefix)
  (let ((result (queue:new)))
    (dotimes (i (length data))
      (cond ((= (elt data i) prefix)
             (let ((point (byte-pair->point data i)))
               (if (= (point-size point) 0)
                 (progn
                   (queue:push prefix result)
                   (incf i))
                 (progn
                   (queue:push point result)
                   (incf i 2)))))
            (t (queue:push (elt data i) result))))
    (decompress (queue:to-list result))))

(declaim (ftype (function (list) (array (unsigned-byte 8))) decompress))
(defun decompress (data)
  (declare (optimize (debug 3)))
  (let ((result (make-array (get-uncompressed-size data) :element-type '(unsigned-byte 8)))
        (fill-count 0))
    (dolist (point data)
      (cond ((point-p point)
             (let ((start (- fill-count (point-offset point))))
               (dotimes (j (point-size point))
                 (setf (elt result (+ fill-count j)) (elt result (+ start j))))
               (incf fill-count (point-size point))))
            ((typep point '(unsigned-byte 8))
             (setf (elt result fill-count) point)
             (incf fill-count))
            (t (error (format nil "cannot handle type ~a" (type-of point))))))
    (assert (= fill-count (length result)))
    result))

(declaim (ftype (function ((array (unsigned-byte 8)) fixnum) point) byte-pair->point))
(defun byte-pair->point (bytes index)
  (let ((offset (elt bytes (+ (if reversed-byte-order 2 1) index)))
        (size (elt bytes (+ (if reversed-byte-order 1 2) index)))
        (max-word-length (1- (ash 1 (- 16 window-bits)))))
    (make-point :offset (logior offset
                                (ash (logand size (logxor #xff max-word-length))
                                     (- window-bits 8)))
                :size (logand size max-word-length))))

(declaim (ftype (function (list) fixnum) get-uncompressed-size))
(defun get-uncompressed-size (data)
  (let ((size 0))
    (dolist (point data)
      (cond ((point-p point)
             (incf size (point-size point)))
            (t
              (incf size))))
    size))