(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))