aland/huffman.lisp
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

cleanup

Browse source
This commit is contained in:
Alan Daniels 2026-01-27 20:49:20 +11:00
parent 670d584204
commit 2e803fe746
1 changed files with 11 additions and 18 deletions
Download patch file Download diff file Expand all files Collapse all files

29
huffman.lisp
View file

@ -159,10 +159,8 @@
(loop for c = (read-byte instream nil nil) (loop for c = (read-byte instream nil nil)
while c while c
do (setq bit-stream (bitstream-push bit-stream (gethash c encoding-map))) do (setq bit-stream (bitstream-push bit-stream (gethash c encoding-map)))
do (stream-drain-bitstream outstream bit-stream 8)) (stream-drain-bitstream outstream bit-stream 8))
(stream-drain-bitstream outstream bit-stream 1) (stream-drain-bitstream outstream bit-stream 1)))))
)
)))
(defun decode (instream outstream) (defun decode (instream outstream)
(let ((canon (stream2canon instream)) (let ((canon (stream2canon instream))
@ -171,19 +169,14 @@
do (setf (gethash (cdr pair) decoding-map) (car pair))) do (setf (gethash (cdr pair) decoding-map) (car pair)))
(let ((len (read-number instream)) (source (cons 0 0)) (sink (cons 0 0))) (let ((len (read-number instream)) (source (cons 0 0)) (sink (cons 0 0)))
(loop for i from 1 to len (loop for i from 1 to len
do do (loop until (gethash sink decoding-map)
(loop until (gethash sink decoding-map) do (when (= (cdr source) 0)
do (progn (setq source (cons (read-byte instream) 8)))
(when (= (cdr source) 0) (multiple-value-bind (new-source popped) (bitstream-pop1 source)
(setq source (cons (read-byte instream) 8))) (setq source new-source)
(multiple-value-bind (new-source popped) (bitstream-pop1 source) (setq sink (bitstream-push sink (cons popped 1))))
(setq source new-source)
(setq sink (bitstream-push sink (cons popped 1)))))
finally (write-byte (gethash sink decoding-map) outstream) finally (write-byte (gethash sink decoding-map) outstream)
(setq sink (cons 0 0))) (setq sink (cons 0 0)))))))
)
)
))
(defmacro with-stream-translate (in-filename out-filename &body body) (defmacro with-stream-translate (in-filename out-filename &body body)
`(with-open-file (instream ,in-filename :element-type '(unsigned-byte 8) :direction :input) `(with-open-file (instream ,in-filename :element-type '(unsigned-byte 8) :direction :input)
@ -199,5 +192,5 @@
;(main (list "_" "e" "test-input.txt" "test-output.txt.hf")) ;(main (list "_" "e" "test-input.txt" "test-output.txt.hf"))
;(main (list "_" "d" "test-output.txt.hf" "test-output.txt")) ;(main (list "_" "d" "test-output.txt.hf" "test-output.txt"))
;; (setq uiop:*image-entry-point* #'main) (setq uiop:*image-entry-point* #'main)
;; (uiop:dump-image "build/huffman" :executable t) (uiop:dump-image "build/huffman" :executable t)