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)
while c
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 1)
)
)))
(stream-drain-bitstream outstream bit-stream 8))
(stream-drain-bitstream outstream bit-stream 1)))))
(defun decode (instream outstream)
(let ((canon (stream2canon instream))
@ -171,19 +169,14 @@
do (setf (gethash (cdr pair) decoding-map) (car pair)))
(let ((len (read-number instream)) (source (cons 0 0)) (sink (cons 0 0)))
(loop for i from 1 to len
do
(loop until (gethash sink decoding-map)
do (progn
(when (= (cdr source) 0)
(setq source (cons (read-byte instream) 8)))
(multiple-value-bind (new-source popped) (bitstream-pop1 source)
(setq source new-source)
(setq sink (bitstream-push sink (cons popped 1)))))
do (loop until (gethash sink decoding-map)
do (when (= (cdr source) 0)
(setq source (cons (read-byte instream) 8)))
(multiple-value-bind (new-source popped) (bitstream-pop1 source)
(setq source new-source)
(setq sink (bitstream-push sink (cons popped 1))))
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)
`(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 "_" "d" "test-output.txt.hf" "test-output.txt"))
;; (setq uiop:*image-entry-point* #'main)
;; (uiop:dump-image "build/huffman" :executable t)
(setq uiop:*image-entry-point* #'main)
(uiop:dump-image "build/huffman" :executable t)