Parsing diff-like annotations

Question

I am working with annotated text that has data describing changes on it. Changes are represented by lines consisting of groups of "+++" and "---", each referring to the characters in line above. Following is a small example of data:

[{
"in": {
  "fileLineNo": 58,
  "text": "(foo\n  {:a 1\n--\n   :b 2})"
}}, {
"in": {
  "fileLineNo": 71,
  "text": "(foo)\n  {:a 1\n++\n:b 2}"
}}]

Here is the code i am using:

(defun make-parse-error (line-no message)
  (format "test parse error at line %d: %s" line-no message))

(defun parse-cursor-from-line (options input-line-no output-line-no line)
  "Extracts cursor from LINE, returning cleaned line. Expects nonempty alist in OPTIONS. Signals error if cursor is already present"
  (save-match-data
    (let* ((cursor-x (string-match "|" line))
           (clean (replace-regexp-in-string "|" "" line)))
      (when cursor-x
        (when (alist-get :cursor-x options)
          (throw 'parinferlib-error (make-parse-error input-line-no
                                                      (format "cursor already found at line %d" (alist-get :cursor-line options)))))
        (when (string-match "|" line (1+ cursor-x))
          (throw 'parinferlib-error (make-parse-error input-line-no
                                                      "only one cursor allowed")))
        (setf (alist-get :cursor-x options) cursor-x
              (alist-get :cursor-line options) output-line-no))
      clean)))

(defconst parinferlib--LOOSE_DIFF_MATCH
  "^[[:blank:]]*[-+]+[-+[:blank:]]*$")

(defconst parinferlib--DIFF_MATCH
  "^\\\(\\\([[:blank:]]*\\\)\\\(-*\\\)\\\(+*\\\)\\\)[[:blank:]]*$")

(defun make-change-struct ()
  (mapcar 'list '(:line-no :x :old-text :new-text)))

(defun make-diff-struct ()
  (mapcar 'list '(:end-line-char :start-line-char :code-line-no :input-line-no :code)))

(defun parse-diff-line (options input-line-no output-line-no line prev-line diff)
  "Test if LINE is a diff line and if so return changed version of PREV-LINE. OPTIONS is updated to preserve cursor data and cullect changes; DIFF is filled if needed"
  (save-match-data
    (when (string-match parinferlib--LOOSE_DIFF_MATCH line)
      (unless prev-line
        (throw 'parinferlib-error (make-parse-error input-line-no "Diff line must have preceding line")))
      (unless (string-match parinferlib--DIFF_MATCH line)
        (throw 'parinferlib-error (make-parse-error input-line-no "Diff chars must be adjancent with '-'s before '+'s")))
      (let* ((total (length (match-string 1 line)))
             (x (length (match-string 2 line)))
             (old-len (length (match-string 3 line)))
             (new-len (length (match-string 4 line)))
             (new-x (+ x old-len))
             (len (+ old-len new-len))
             (x-end (1- (+ x len)))
             (cursor-x (alist-get :cursor-x options))
             (change (make-change-struct))
             (end-line-char (when (= (length prev-line) x-end)
                              (aref line x-end))))
        (when (> total (1+ (length prev-line)))
          (throw 'parinferlib-error (make-parse-error input-line-no "Diff line longer then previous line with account of newline character")))
        (when (equal (alist-get :cursor-line options)
                     (1- output-line-no))
          (when (>= x-end cursor-x x)
            (throw 'parinferlib-error (make-parse-error input-line-no "Cursor cannot be over diff annotation")))
          (if (> x cursor-x)
              (setf x (1- x) new-x (1- new-x) x-end (1- x-end))
            (setf (alist-get :cursor-x options) (- cursor-x old-len))))
;; set diff fields
        (setf (alist-get :start-line-char diff) (aref line 0)
              (alist-get :end-line-char diff) end-line-char
              (alist-get :code-line-no diff) (1- output-line-no)
              (alist-get :input-line-no diff) input-line-no
              (alist-get :code diff)
              (concat (substring prev-line 0 x)
                      (substring prev-line new-x))
              (alist-get :line-no change) (1- output-line-no)
              (alist-get :x change) x
              (alist-get :old-text change)
              (concat (substring prev-line x (+ x old-len))
                      (when (equal end-line-char ?-) "\n"))
              (alist-get :new-text change)
              (concat (substring prev-line new-x (+ new-x new-len))
                      (when (equal end-line-char ?+) "\n")))
        (push change (alist-get :changes options))
        (alist-get :code diff)))))

(defun postprocess-diffs (options output-lines input-line-no output-line-no diff prev-diff)
  "Merge changes, lines and diffs as necessary. OUTPUT-LINES is a stack which top is last processed line. Return number of last output line"
  ;; check diffs
  (let ((prev-diff-line (alist-get :input-line-no prev-diff))
        (prev-diffed-line (alist-get :code-line-no prev-diff))
        (cur-diff-line (alist-get :code-line-no diff))
        (cur-diffed-line (alist-get :input-line-no diff))
        (prev-last-char (alist-get :end-line-char prev-diff))
        (cur-first-char (alist-get :start-line-char diff))
        (result output-line-no))
    (if (and prev-diffed-line cur-diffed-line)
        (if (> 2 (- cur-diffed-line prev-diffed-line))
            (throw 'parinferlib-error (make-parse-error cur-diffed-line "diff lines must be directly below a code line"))))
          ;; check if there is conflict
    (when (equal prev-last-char ?+)
        (if (equal cur-first-char ?-)
            (throw 'parinferlib-error (make-parse-error cur-diffed-line "diff line starts with '-', which cannot come after '+' which previous diff line ends with"))))
            ;; now chack for merge
    (when (and (equal prev-last-char ?-))
      (if (and cur-diff-line (= 2 (- cur-diff-line pref-diff-line)))
        (progn
          (setcar output-lines (concat (pop (cdr output-lines))
                                       (car output-lines)))
          (decf result)
          (if cur-first-char
             (let ((cur-change (pop (alist-get :changes options)))
                   (prev-change (pop (alist-get :changes options))))
               (setf (alist-get :old-text prev-change)
                     (concat (alist-get :old-text prev-change)
                             (alist-get :old-text cur-change))
                     (alist-get :new-text prev-change)
                     (concat (alist-get :new-text prev-change)
                             (alist-get :new-text cur-change)))
               (push prev-change (alist-get :changes options)))
           (let ((change (pop (alist-get :changes options))))
             (setf (alist-get :x change)
                   (+ (length (alist-get :code prev-diff))
                      (alist-get :x change))
                   (alist-get :line-no change) prev-diffed-line)
             (push change (alist-get :changes options)))))
        (when (= 2 (- input-line-no pref-diff-line))
          (let ((joined-line (pop (cdr output-lines))))
            (setcar (cdr output-lines)
                    (concat (cadr output-lines) joined-line))
            (decf result))))
      (unless (= result output-line-no)
        (when (equal (1+ prev-diffed-line) (alist-get :cursor-line options))
          (setf (alist-get :cursor-line options) prev-diffed-line
                (alist-get :cursor-x options)
                (+ (alist-get :cursor-x options) (length (alist-get :code prev-diff)))))))
    result))

(defun prepare-in (in)
  "Process IN, extracting all interesting data from text"
  (let* ((line-no (plist-get in :fileLineNo))
         (text (plist-get in :text))
         (in-lines (save-match-data
                     (split-string text parinferlib--LINE_ENDING_REGEX)))
         (options '((:cursor-x) (:cursor-dx) (:cursor-line) (:changes)))
         (out-lines '()))
    (loop for prev-line = nil then cur-line
          for cur-line in in-lines
          for i = 0 then (1+ i)
          with j = 0
          with out-line = nil
          with prev-diff = (make-diff-struct)
          for diff = (make-diff-struct) then (make-diff-struct)
          do
          (progn
            (setq cur-line (parse-cursor-from-line options i j cur-line))
            (setq out-line (parse-diff-line options i j cur-line prev-line diff))
            (if out-line
                (setf (car out-lines) out-line)
              (push cur-line out-lines)
              (incf j))
            (setq j (postprocess-diffs options out-lines i j diff prev-diff))
            (when (or (alist-get :input-line-no diff)
                      (not (alist-get :input-line-no prev-diff))
                      (> 1 (- i (alist-get :input-line-no prev-diff))))
              (setq prev-diff diff)))
          finally
          (postprocess-diffs options out-lines (+ i 2) j nil prev-diff))
    (list :options options :lines (reverse out-lines))))