simple lisp vcs

vcs.lisp

;;; A simple VCS

;; Operation creation functions

(defmacro make-operation (position operation &rest rest)
  `(list :operation ,operation :pos ,position ,@rest))

(defun insert (string position)
  (make-operation position :insert :string string))

(defun strike (count position)
  (make-operation position :delete :count count))

;; Print functions

(defun print-operation (op)
  (case (getf op :operation)
    (:insert
     (format t "insert ~s at ~a~%" (getf op :string) (getf op :pos)))
    (:delete
     (format t "strike ~a chars at position ~a~%"
	     (getf op :count) (getf op :pos)))
    (otherwise (print "Unknown operation."))))

(defun print-changeset (changeset)
  (dolist (op changeset) (print-operation op)))

;; Apply functions

(defun apply-insert (string op)
  (let ((start (getf op :pos))
	(insertion (getf op :string)))
    (concatenate 'string
		 (subseq string 0 start)
		 insertion
		 (subseq string start))))

(defun apply-strike (string op)
  (let ((start (getf op :pos))
	(count (getf op :count)))
    (concatenate 'string (subseq string 0 start)
		 (subseq string (+ start count)))))

(defun apply-operation (op string)
  (case (getf op :operation)
    (:insert (apply-insert string op))
    (:delete (apply-strike string op))))

(defun apply-changeset (string changeset)
  (reduce #'apply-operation changeset :from-end t :initial-value string))

(defun examples ()
  (print (apply-changeset "abc123" (list (insert "DEF" 1) (strike 3 2)))) ; => "aDEFb3"
  (print (apply-changeset "this is a super long string"
			  (list (strike 2 1) (insert "banana" 3)
				(strike 3 1) (strike 1 2)
				(insert "boop" 0))))) ; => "bbananas is a super long string"