Amr Gharbeia
b67cd12d88
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
- system-embeddings (new skill): hashing-trick embeddings for memory-object vectors. Works offline with no Ollama/API dependency. Falls back to hashing-trick when no embedding backend is registered. Extensible — set *embedding-backend* to use Ollama/OpenAI/any provider. - programming-org: add org-subtree-extract and org-heading-list for targeting specific headlines in Org text without loading whole files. - core-context: add context-skill-subtree thin wrapper delegating to org-subtree-extract. Core stays thin — parsing lives in the skill.
92 lines
4.1 KiB
Common Lisp
92 lines
4.1 KiB
Common Lisp
(defvar *embedding-dimensions* 384
|
|
"Dimension of the embedding vector. Default 384 matches nomic-embed-text.")
|
|
|
|
(defvar *embedding-backend* nil
|
|
"Optional external embedding function (text-str) → float vector.
|
|
When nil, the hashing-trick fallback is used. Register a backend via:
|
|
(setf *embedding-backend* (lambda (text) ...))
|
|
For Ollama: POST /api/embeddings with model nomic-embed-text.
|
|
For OpenAI: POST /v1/embeddings with model text-embedding-3-small.")
|
|
|
|
(defun embeddings-tokenize (text)
|
|
"Splits text into lowercase word tokens, stripping punctuation and
|
|
discarding tokens shorter than 2 characters."
|
|
(let ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]"
|
|
(string-downcase (or text "")) " ")))
|
|
(remove-if (lambda (w) (< (length w) 2))
|
|
(uiop:split-string clean :separator '(#\Space #\Tab #\Newline)))))
|
|
|
|
(defun embeddings-hash-word (word dim)
|
|
"Hashes a word to a bucket index in [0, dim). Uses FNV-1a style hashing
|
|
for good distribution with minimal collisions."
|
|
(let ((hash 2166136261))
|
|
(loop for c across word
|
|
do (setf hash (logxor hash (char-code c)))
|
|
(setf hash (mod (* hash 16777619) #x100000000)))
|
|
(mod hash dim)))
|
|
|
|
(defun embeddings-compute (text &key (dimensions *embedding-dimensions*))
|
|
"Computes a dense embedding vector for TEXT.
|
|
Tries the registered backend first, falls back to hashing-trick.
|
|
Returns a list of DIMENSIONS double-floats normalized to unit length."
|
|
;; Try registered backend first
|
|
(when *embedding-backend*
|
|
(handler-case
|
|
(let ((result (funcall *embedding-backend* text)))
|
|
(when (and result (listp result) (> (length result) 0))
|
|
(return-from embeddings-compute result)))
|
|
(error (c)
|
|
(log-message "EMBEDDING: Backend failed (~a), falling back to hashing" c))))
|
|
;; Hashing-trick fallback
|
|
(let* ((tokens (embeddings-tokenize text))
|
|
(vec (make-array dimensions :initial-element 0.0d0 :element-type 'double-float)))
|
|
(dolist (token tokens)
|
|
(let* ((idx (embeddings-hash-word token dimensions))
|
|
(sign (if (evenp (char-code (char token 0))) 1 -1)))
|
|
(incf (aref vec idx) (coerce sign 'double-float))))
|
|
;; Normalize to unit length
|
|
(let ((norm (sqrt (loop for i below dimensions sum (expt (aref vec i) 2)))))
|
|
(if (> norm 0.0d0)
|
|
(loop for i below dimensions collect (/ (aref vec i) norm))
|
|
(loop for i below dimensions collect 0.0d0)))))
|
|
|
|
(defun embed-object (obj)
|
|
"Generates and stores an embedding vector for a memory-object.
|
|
Combines title, content, and tags into a single text for embedding.
|
|
Stores the result in the memory-object's :vector slot."
|
|
(let* ((attrs (memory-object-attributes obj))
|
|
(title (or (getf attrs :TITLE) ""))
|
|
(text (or (memory-object-content obj) ""))
|
|
(tags (format nil "~{~a~^ ~}" (or (getf attrs :TAGS) "")))
|
|
(combined (format nil "~a ~a ~a" title text tags))
|
|
(vec (embeddings-compute combined)))
|
|
(setf (memory-object-vector obj) vec)
|
|
(log-message "EMBEDDING: Vector for ~a (~d dims, ~d tokens)"
|
|
(memory-object-id obj) (length vec)
|
|
(length (embeddings-tokenize combined)))
|
|
vec))
|
|
|
|
(defun embed-all-pending ()
|
|
"Generates embeddings for all memory objects that lack vectors.
|
|
Called by the heartbeat or on demand. Returns count of objects processed."
|
|
(let ((count 0))
|
|
(maphash (lambda (id obj)
|
|
(declare (ignore id))
|
|
(unless (memory-object-vector obj)
|
|
(handler-case
|
|
(progn (embed-object obj) (incf count))
|
|
(error (c)
|
|
(log-message "EMBEDDING: Failed for ~a: ~a" (memory-object-id obj) c)))))
|
|
*memory-store*)
|
|
(when (> count 0)
|
|
(log-message "EMBEDDING: Batch processed ~d objects" count))
|
|
count))
|
|
|
|
(defskill :passepartout-system-embeddings
|
|
:priority 50
|
|
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
|
:deterministic (lambda (action ctx)
|
|
(declare (ignore action ctx))
|
|
(ignore-errors (embed-all-pending))
|
|
nil))
|