# Pastebin 3tk24FaU
(defun shorten (pathname n)
  (destructuring-bind (key &rest rest) (pathname-directory pathname)
    (let ((truncated
           (if (< n (length rest))
               (subseq rest 0 n) rest)))
      (make-pathname :defaults pathname
                     :directory (cons key truncated)))))