;; -*- lexical-binding: t; -*- (defvar llm-tools--hl-bigrams (list "aa" "ab" "ac" "ad" "ae" "af" "ag" "ah" "ai" "aj" "ak" "al" "am" "an" "ao" "ap" "aq" "ar" "as" "at" "au" "av" "aw" "ax" "ay" "az" "ba" "bb" "bc" "bd" "be" "bf" "bg" "bh" "bi" "bj" "bk" "bl" "bm" "bn" "bo" "bp" "br" "bs" "bt" "bu" "bv" "bw" "bx" "by" "bz" "ca" "cb" "cc" "cd" "ce" "cf" "cg" "ch" "ci" "cj" "ck" "cl" "cm" "cn" "co" "cp" "cq" "cr" "cs" "ct" "cu" "cv" "cw" "cx" "cy" "cz" "da" "db" "dc" "dd" "de" "df" "dg" "dh" "di" "dj" "dk" "dl" "dm" "dn" "do" "dp" "dq" "dr" "ds" "dt" "du" "dv" "dw" "dx" "dy" "dz" "ea" "eb" "ec" "ed" "ee" "ef" "eg" "eh" "ei" "ej" "ek" "el" "em" "en" "eo" "ep" "eq" "er" "es" "et" "eu" "ev" "ew" "ex" "ey" "ez" "fa" "fb" "fc" "fd" "fe" "ff" "fg" "fh" "fi" "fj" "fk" "fl" "fm" "fn" "fo" "fp" "fq" "fr" "fs" "ft" "fu" "fv" "fw" "fx" "fy" "fz" "ga" "gb" "gc" "gd" "ge" "gf" "gg" "gh" "gi" "gj" "gl" "gm" "gn" "go" "gp" "gr" "gs" "gt" "gu" "gv" "gw" "gx" "gy" "gz" "ha" "hb" "hc" "hd" "he" "hf" "hg" "hh" "hi" "hj" "hk" "hl" "hm" "hn" "ho" "hp" "hq" "hr" "hs" "ht" "hu" "hv" "hw" "hx" "hy" "hz" "ia" "ib" "ic" "id" "ie" "if" "ig" "ih" "ii" "ij" "ik" "il" "im" "in" "io" "ip" "iq" "ir" "is" "it" "iu" "iv" "iw" "ix" "iy" "iz" "ja" "jb" "jc" "jd" "je" "jf" "jg" "jh" "ji" "jj" "jk" "jl" "jm" "jn" "jo" "jp" "jq" "jr" "js" "jt" "ju" "jw" "jx" "jy" "ka" "kb" "kc" "kd" "ke" "kf" "kg" "kh" "ki" "kj" "kk" "kl" "km" "kn" "ko" "kp" "kr" "ks" "kt" "ku" "kv" "kw" "kx" "ky" "la" "lb" "lc" "ld" "le" "lf" "lg" "lh" "li" "lj" "lk" "ll" "lm" "ln" "lo" "lp" "lr" "ls" "lt" "lu" "lv" "lw" "lx" "ly" "lz" "ma" "mb" "mc" "md" "me" "mf" "mg" "mh" "mi" "mj" "mk" "ml" "mm" "mn" "mo" "mp" "mq" "mr" "ms" "mt" "mu" "mv" "mw" "mx" "my" "mz" "na" "nb" "nc" "nd" "ne" "nf" "ng" "nh" "ni" "nj" "nk" "nl" "nm" "nn" "no" "np" "nr" "ns" "nt" "nu" "nv" "nw" "nx" "ny" "nz" "oa" "ob" "oc" "od" "oe" "of" "og" "oh" "oi" "oj" "ok" "ol" "om" "on" "oo" "op" "oq" "or" "os" "ot" "ou" "ov" "ow" "ox" "oy" "oz" "pa" "pb" "pc" "pd" "pe" "pf" "pg" "ph" "pi" "pj" "pk" "pl" "pm" "pn" "po" "pp" "pq" "pr" "ps" "pt" "pu" "pv" "pw" "px" "py" "pz" "qa" "qb" "qc" "qd" "qe" "qh" "qi" "ql" "qm" "qn" "qo" "qp" "qq" "qr" "qs" "qt" "qu" "qw" "qx" "qy" "ra" "rb" "rc" "rd" "re" "rf" "rg" "rh" "ri" "rk" "rl" "rm" "rn" "ro" "rp" "rq" "rr" "rs" "rt" "ru" "rv" "rw" "rx" "ry" "rz" "sa" "sb" "sc" "sd" "se" "sf" "sg" "sh" "si" "sj" "sk" "sl" "sm" "sn" "so" "sp" "sq" "sr" "ss" "st" "su" "sv" "sw" "sx" "sy" "sz" "ta" "tb" "tc" "td" "te" "tf" "tg" "th" "ti" "tj" "tk" "tl" "tm" "tn" "to" "tp" "tr" "ts" "tt" "tu" "tv" "tw" "tx" "ty" "tz" "ua" "ub" "uc" "ud" "ue" "uf" "ug" "uh" "ui" "uj" "uk" "ul" "um" "un" "uo" "up" "uq" "ur" "us" "ut" "uu" "uv" "uw" "ux" "uy" "uz" "va" "vb" "vc" "vd" "ve" "vf" "vg" "vh" "vi" "vj" "vk" "vl" "vm" "vn" "vo" "vp" "vq" "vr" "vs" "vt" "vu" "vv" "vw" "vx" "vy" "vz" "wa" "wb" "wc" "wd" "we" "wf" "wg" "wh" "wi" "wj" "wk" "wl" "wm" "wn" "wo" "wp" "wr" "ws" "wt" "wu" "wv" "ww" "wx" "wy" "xa" "xb" "xc" "xd" "xe" "xf" "xh" "xi" "xl" "xm" "xn" "xo" "xp" "xr" "xs" "xt" "xu" "xx" "xy" "xz" "ya" "yb" "yc" "yd" "ye" "yf" "yg" "yh" "yi" "yj" "yk" "yl" "ym" "yn" "yo" "yp" "yr" "ys" "yt" "yu" "yv" "yw" "yx" "yy" "yz" "za" "zb" "zc" "zd" "ze" "zf" "zg" "zh" "zi" "zk" "zl" "zm" "zn" "zo" "zp" "zr" "zs" "zt" "zu" "zw" "zx" "zy" "zz") "List of bigrams for use with hashline reads/writes. Each of the bigrams resolve to a single token in standard LLM vocabulary, unlike a hash's hex digits. Taken from https://github.com/can1357/oh-my-pi. Precisely: https://raw.githubusercontent.com/can1357/oh-my-pi/85003ca/packages/coding-agent/src/hashline/bigrams.json") (defun llm-tools--hl-hash (line) ;; logand is to force unsigned number (elt llm-tools--hl-bigrams (% (logand (sxhash line) #xffffffff) 647))) (defun llm-tools--hl-file-lines (file &optional beg end) "Return FILE contents as a list of strings. With optional BEG and END (inclusive, 1-based), return the lines between that range." (with-temp-buffer (insert-file-contents-literally file) (let ((lines (string-lines (buffer-string)))) (if beg (cl-subseq lines (1- beg) end) lines)))) (defun llm-tools--hl-format-lines (lines &optional start only-anchors?) "Format LINES in hashline format. START is 1-based (default 1). If ONLY-ANCHORS? is non-nil, do not append `|CONTENT' after each anchor." (string-join (cl-mapcar (lambda (line i) (if only-anchors? (format "%d%2s" i (llm-tools--hl-hash line)) (format "%d%2s|%s" i (llm-tools--hl-hash line) line))) lines (number-sequence (or start 1) (+ (or start 1) (1- (length lines))))) "\n")) (defun llm-tools--hl-file-read (file &optional beg end only-anchors? as-list?) "Return FILE contents in hashline format. With optional BEG and END (inclusive, 1-based), return lines BEG to END. If ONLY-ANCHORS? is non-nil, do not append `|CONTENT' after each anchor. If AS-LIST? is non-nil, return a list of hashline strings instead of a single string." (let* ((lines (llm-tools--hl-file-lines file beg end)) (formatted (llm-tools--hl-format-lines lines (or beg 1) only-anchors?))) (if as-list? (string-lines formatted) formatted))) (defun llm-tools--hl-file-line-hash (file n) "Return the hash of the Nth line in FILE." (let* ((lines (llm-tools--hl-file-lines file)) (bigram (llm-tools--hl-hash (elt lines (1- n))))) (format "%d%s" n bigram))) ;;;; Diff Validation ;; TODO this should also validate the operators (e.g. any invalid ;; op-chars, payload given before all other operations, no payload ;; after +/< or payload given to -, or anchors without line ;; number). it should return a string saying it's a malformed patch ;; and what went wrong. (cl-defstruct hl-verify-op (type nil) ; 'insert-after 'insert-before 'delete 'replace (anchor nil) ; string like "4ei" or "EOF" for +/-/< (payload nil) ; list of strings (nil is no payload) (raw nil)) ; raw op line text for error messages (defun llm-tools--hl-non-empty-non-comment-line-p (line) "Return t if LINE is not empty and not a comment (starts with #)." (let ((trimmed (string-trim line))) (and (not (string-empty-p trimmed)) (not (string-prefix-p "#" trimmed))))) (defun llm-tools--hl-parse-op-line-for-verify (line) "Parse a single operation LINE (e.g. \"+ 4ei\") into a `hl-verify-op`." (let* ((trimmed (string-trim line)) (ch (substring trimmed 0 1))) (make-hl-verify-op :type (pcase ch ("+" 'insert-after) ("<" 'insert-before) ("-" 'delete) ("=" 'replace)) :anchor (string-trim (substring trimmed 1)) :raw trimmed))) (defun llm-tools--hl-add-payload-to-verify-op (op payload-line) "Append PAYLOAD-LINE (without leading ~) to OP's payload list." (setf (hl-verify-op-payload op) (append (hl-verify-op-payload op) (list (substring (string-trim payload-line) 1))))) (defun llm-tools--hl-parse-section-ops (section-body) "Parse SECTION-BODY into a list of `hl-verify-op' structs." (let (ops op) (dolist (line (string-lines section-body)) (when (llm-tools--hl-non-empty-non-comment-line-p line) (let* ((trimmed (string-trim line)) (ch (substring trimmed 0 1))) (if (string= ch "~") (when op (llm-tools--hl-add-payload-to-verify-op op trimmed)) (when op (push op ops)) (setq op (llm-tools--hl-parse-op-line-for-verify trimmed)))))) (when op (push op ops)) (nreverse ops))) (defun llm-tools--hl-validate-no-payload-before-op (ops) "Check that no payload lines appear before the first op." (when-let ((first (car-safe ops))) (if (hl-verify-op-payload first) (list "Payload line (~) appears before any operation") '()))) (defun llm-tools--hl-validate-insert-has-payload (ops) "Check that all insert ops have at least one payload line." (mapcan (lambda (op) (when (and (memq (hl-verify-op-type op) '(insert-after insert-before)) (null (hl-verify-op-payload op))) (list (format "Insert operation (%s) has no payload lines following it" (hl-verify-op-type op))))) ops)) (defun llm-tools--hl-validate-delete-no-payload (ops) "Check that delete ops have no payload lines." (mapcan (lambda (op) (when (and (eq (hl-verify-op-type op) 'delete) (hl-verify-op-payload op)) (list "Delete operation (-) must not have payload lines"))) ops)) (defun llm-tools--hl-validate-insert-anchor (anchor) "Return error string if ANCHOR is malformed for insert, else nil." (when (and anchor (not (string= anchor "EOF")) (not (string= anchor "BOF"))) (pcase anchor ((pred (lambda (a) (or (< (length a) 3) (not (string-match-p "^[0-9]" a))))) (format "Invalid anchor %S (expected LINEHASH like '5ff' or EOF/BOF)" anchor)) (_ nil)))) (defun llm-tools--hl-validate-range-anchor (anchor) "Return error string if ANCHOR (like \"3gv..6be\") is malformed, else nil." (pcase (split-string anchor "\\.\\.") (`(,a ,b) (when (or (< (length a) 3) (not (string-match-p "^[0-9]" a)) (< (length b) 3) (not (string-match-p "^[0-9]" b))) (format "Invalid anchor %S in range (expected numeric line anchor like '5ff')" anchor))) (_ (format "Invalid range %S (expected A..B)" anchor)))) (defun llm-tools--hl-validate-anchors (ops) "Check that all anchors are well-formed." (mapcan (lambda (op) (pcase (hl-verify-op-type op) ((or 'insert-after 'insert-before) (when-let ((err (llm-tools--hl-validate-insert-anchor (hl-verify-op-anchor op)))) (list err))) ((or 'delete 'replace) (when-let ((err (llm-tools--hl-validate-range-anchor (hl-verify-op-anchor op)))) (list err))))) ops)) (defun llm-tools--hl-verify-section (section) "Validate a single SECTION. Returns a list of error strings." (let ((ops (llm-tools--hl-parse-section-ops (cdr section)))) (let (errors) ;; Inserts must have payload (dolist (op ops) (when (and (memq (hl-verify-op-type op) '(insert-after insert-before)) (null (hl-verify-op-payload op))) (push (format "Insert operation (%s) has no payload lines following it" (hl-verify-op-type op)) errors))) ;; Deletes must not have payload (dolist (op ops) (when (and (eq (hl-verify-op-type op) 'delete) (hl-verify-op-payload op)) (push "Delete operation (-) must not have payload lines" errors))) ;; Anchor validation (setq errors (append errors (llm-tools--hl-validate-anchors ops))) (nreverse errors)))) (defun llm-tools--hl-verify-structure (patch) "Validate the structural integrity of PATCH. Returns a list of error strings describing each structural violation found. An empty list means the patch is well-formed." (mapcan #'llm-tools--hl-verify-section (llm-tools--split-patch-sections patch))) (defun llm-tools--hl-verify (patch) "Verify PATCH is structurally valid and all anchors match current files. Returns a string with error messages, or an empty string if clean." (let ((struct-errors (llm-tools--hl-verify-structure patch))) (if struct-errors (string-join struct-errors "\n") (string-join (delete-dups (remq nil (mapcar (lambda (elem) (unless (cdr elem) (format "%s had incorrect anchors. Use the 'read_file' tool to get correct anchors." (car elem)))) (llm-tools--hl-verify-anchors patch)))) "\n")))) ;;;; Diff Parsing (defun llm-tools--split-patch-sections (patch) "Return a list of (FILENAME . REST) cons cells from PATCH. Each section starts with '@@ PATH' on the first line; the car is PATH and the cdr is the remainder of that section." (let ((pos (string-match "^@@" patch))) (when pos (let (sections (start pos)) (while (string-match "\n@@" patch (1+ pos)) (let ((nl (match-beginning 0))) (push (substring patch start (1+ nl)) sections) (setq start (1+ nl))) (setq pos (match-end 0))) (push (substring patch start) sections) (mapcar (lambda (sec) (let ((end (string-match "\n" sec))) (cons (substring sec 3 end) (substring sec end)))) (nreverse sections)))))) (defun llm-tools--hl-extract-anchors-from-op-line (line) "Return a list of anchor strings from a single operation LINE. Handles ranges by returning both endpoints." (when (length> line 0) (let ((op (char-to-string (elt line 0))) (anchor (substring line 2))) (pcase op ((or "+" "<") (list anchor)) ((or "-" "=") (split-string anchor "\\.\\.")))))) (defun llm-tools--hl-extract-anchors-from-section (section-body) "Return all anchors from a section body (list of strings)." (flatten-list (mapcar #'llm-tools--hl-extract-anchors-from-op-line (string-lines section-body)))) (defun llm-tools--hl-get-anchors (patch) "Returns an alist of (FILENAME . ANCHORS) from PATCH. ANCHORS is a sorted, deduplicated list of all line anchors referenced by the operations in that file's sections. Each anchor is a string like \"5ff\" or a list of two strings from a range like (\"3gv\" \"6be\")." (mapcar (lambda (section) (cons (car section) (delete-dups (sort (llm-tools--hl-extract-anchors-from-section (cdr section)))))) (llm-tools--split-patch-sections patch))) (defun llm-tools--hl-verify-anchors (patch) "Verify that all anchors in PATCH match the current file contents. Returns a list of booleans, one per file, indicating whether every anchor in that file's patch sections still matches the corresponding line in the on-disk file." (let ((patch-anchors (llm-tools--hl-get-anchors patch))) (mapcar (lambda (section) (let* ((file (car section)) (anchors (delete "BOF" (delete "EOF" (cdr section)))) (hl (llm-tools--hl-file-read file nil nil t t))) ;; cl-subsetp uses eql by default which compares by identity and not content (cons file (cl-subsetp anchors hl :test #'equal)))) patch-anchors))) (cl-defstruct hl-op (type nil) ; 'insert-after 'insert-before 'delete 'replace (anchor nil) ; string like "4ei" or "EOF" for +/-/< (range nil) ; (start . end) strings for - and = (payload nil)) ; list of strings (nil is no payload) (defun llm-tools--hl-anchor-to-line-num (anchor) "Extract the line number from ANCHOR like \"5ff\"." (string-to-number (substring anchor 0 (- (length anchor) 2)))) (defun llm-tools--hl-parse-op-line (line) "Parse a single operation LINE into a `hl-op` struct. LINE should start with `+`, `<`, `-`, or `=`." (pcase (substring line 0 1) ("+" (make-hl-op :type 'insert-after :anchor (substring line 2))) ("<" (make-hl-op :type 'insert-before :anchor (substring line 2))) ("-" (make-hl-op :type 'delete :range (split-string (substring line 2) "\\.\\."))) ("=" (make-hl-op :type 'replace :range (split-string (substring line 2) "\\.\\."))))) (defun llm-tools--hl-parse-section (section) "Parse SECTION (body after `@@ PATH`) into a list of `hl-op` structs. Skips comment lines (starting with `#`) and blank lines." (let (ops op) (dolist (line (string-lines section)) (when (string-match "\\S-" line) (let ((op-char (substring line 0 1))) (pcase op-char ("~" (when op (setf (hl-op-payload op) (append (hl-op-payload op) (list (substring line 1)))))) ("#" nil) (_ (when op (push op ops)) (setq op (llm-tools--hl-parse-op-line line))))))) (when op (push op ops)) (nreverse ops))) (defun llm-tools--hl-group-by-file (sections) "Group SECTIONS by file path. Returns an alist of (FILENAME . SECTION-LIST) where SECTION-LIST contains all (PATH . REST) cons cells from SECTIONS that target FILENAME." (let (grouped) (dolist (sec sections) (let ((existing (assoc (car sec) grouped))) (if existing (push sec (cdr existing)) (push (cons (car sec) (list sec)) grouped)))) grouped)) (defun llm-tools--hl-apply-insert-after (anchor payload content offset) "Insert PAYLOAD after the line identified by ANCHOR (or EOF)." (let* ((line-num (if (string= anchor "EOF") (length content) (+ (llm-tools--hl-anchor-to-line-num anchor) offset))) (idx (1- line-num))) (cons (append (cl-subseq content 0 (1+ idx)) payload (cl-subseq content (1+ idx))) (+ offset (length payload))))) (defun llm-tools--hl-apply-insert-before (anchor payload content offset) "Insert PAYLOAD before the line identified by ANCHOR (or BOF)." (let* ((line-num (if (string= anchor "BOF") 1 (+ (llm-tools--hl-anchor-to-line-num anchor) offset))) (idx (1- line-num))) (cons (append (cl-subseq content 0 idx) payload (cl-subseq content idx)) (+ offset (length payload))))) (defun llm-tools--hl-apply-delete (range content offset) "Delete lines from (car RANGE) to (cadr RANGE)." (let ((a (+ (llm-tools--hl-anchor-to-line-num (car range)) offset)) (b (+ (llm-tools--hl-anchor-to-line-num (cadr range)) offset))) (cons (append (cl-subseq content 0 (1- a)) (cl-subseq content b)) (- offset (- b a 1))))) (defun llm-tools--hl-apply-replace (range payload content offset) "Replace lines from (car RANGE) to (cadr RANGE) with PAYLOAD (nil → '(\"\"))" (let ((a (+ (llm-tools--hl-anchor-to-line-num (car range)) offset)) (b (+ (llm-tools--hl-anchor-to-line-num (cadr range)) offset)) (payload (or payload '("")))) (cons (append (cl-subseq content 0 (1- a)) payload (cl-subseq content b)) (+ offset (- (length payload) (- b a 1)))))) (defun llm-tools--hl-apply-one-op (op content offset) "Apply a single OP to CONTENT (list of strings) at the given OFFSET. Returns a cons cell (NEW-CONTENT . NEW-OFFSET)." (pcase (hl-op-type op) ('insert-after (llm-tools--hl-apply-insert-after (hl-op-anchor op) (hl-op-payload op) content offset)) ('insert-before (llm-tools--hl-apply-insert-before (hl-op-anchor op) (hl-op-payload op) content offset)) ('delete (llm-tools--hl-apply-delete (hl-op-range op) content offset)) ('replace (llm-tools--hl-apply-replace (hl-op-range op) (hl-op-payload op) content offset)))) (defun llm-tools--hl-apply-ops (ops content) "Apply a list of OPS to CONTENT (list of strings). Returns the modified list of strings." (let ((offset 0)) (dolist (op ops content) (let ((result (llm-tools--hl-apply-one-op op content offset))) (setq content (car result)) (setq offset (cdr result)))))) (defun llm-tools--hl-apply (patch) "Apply all operations in PATCH to their respective files. Operations within a file are applied sequentially, with line numbers adjusted for prior insertions/deletions via a running offset." (mapc (lambda (file-group) (let* ((file (car file-group)) (ops (mapcan (lambda (sec) (llm-tools--hl-parse-section (cdr sec))) (cdr file-group))) (content (llm-tools--hl-apply-ops ops (llm-tools--hl-file-lines file)))) (with-temp-buffer (insert (string-join content "\n")) (write-region (point-min) (point-max) file)))) (llm-tools--hl-group-by-file (llm-tools--split-patch-sections patch)))) (defun llm-tools--hl-edit (patch) "Apply a hashline PATCH to the files it references. PATCH is a string containing one or more sections, each starting with `@@ FILEPATH' followed by operations: + ANCHOR Insert lines after ANCHOR (or `EOF' to append) < ANCHOR Insert lines before ANCHOR (or `BOF' to prepend) - A..B Delete lines from A to B = A..B Replace lines from A to B with the following payload ~TEXT Payload line for the preceding operation ANCHOR is a hashline string like `5ff' (line number + 2-char hash) or `BOF' / `EOF'. Lines are written directly to disk. Before applying, verifies that every anchor in PATCH still matches the current file contents. If any file has drifted, the entire operation is aborted and an error message is returned identifying the affected files. Returns a success message if all operations applied, or an error string if verification failed." (let ((msg (llm-tools--hl-verify patch))) (if (string= msg "") (progn (llm-tools--hl-apply patch) (format "Finished applying patch.")) (format "%s" msg)))) (provide 'llm-tools-hl)