Skip to content

Instantly share code, notes, and snippets.

@tail-call
Created June 14, 2023 15:12
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save tail-call/42d3ce058d4b1e1434030f1b075860ba to your computer and use it in GitHub Desktop.
Save tail-call/42d3ce058d4b1e1434030f1b075860ba to your computer and use it in GitHub Desktop.
Who are you running from?
(defun make-stack ()
(make-array 0 :fill-pointer 0 :initial-element nil))
(defun stack-push! (stack item)
(vector-push-extend item stack))
(defun run-length-encode (string)
(declare (type string string))
(let ((octets (string-to-octets string))
(stack (make-stack))
(state (list :length 0 :octet nil)))
(labels ((set-state! (&key length octet)
(setf state (list :length length :octet octet)))
(write-record! ()
(stack-push! stack (getf state :length))
(stack-push! stack (getf state :octet)))
(has-dangling-record? ()
(not (eq (getf state :octet) nil)))
(add-octet! (octet)
(when (eq (getf state :octet) nil)
(setf (getf state :octet) octet))
(when (/= octet (getf state :octet))
(write-record!)
(set-state! :length 0 :octet octet))
(incf (getf state :length))))
(map nil #'add-octet! octets)
(when (has-dangling-record?)
(write-record!))
stack)))
(mapcar (lambda (x)
(cons x (run-length-encode x)))
'("a" "ab" "abc" "aabbcc"))
(run-length-encode "AABBCCDDDDDDDDDDDDDDDDDD")
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment