feat: add DeepSeek and NVIDIA NIM providers

- Add deepseek and nvidia entries to gateway-provider config - Add DEEPSEEK_API_KEY and NVIDIA_API_KEY to .env.example - Add deepseek and nvidia to doctor's LLM provider check - Fix remaining harness-log → log-message reference
2026-05-02 22:25:24 -04:00
parent d803889c01
commit 95d1ea3fed
100 changed files with 5344 additions and 2743 deletions
--- a/lisp/core-memory.lisp
+++ b/lisp/core-memory.lisp
@@ -0,0 +1,164 @@
+(in-package :passepartout)
+
+(defvar *memory-store* (make-hash-table :test 'equal))
+(defvar *memory-history* (make-hash-table :test 'equal)
+  "Immutable Merkle-Tree versioning store mapping hashes to objects.")
+
+(defun memory-object-get (id)
+  "Retrieves an memory-object by ID from *memory-store*."
+  (gethash id *memory-store*))
+
+(defun memory-objects-by-attribute (attr value)
+  "Returns all memory-objects whose :ATTRIBUTES plist has ATTR = VALUE."
+  (let ((results nil))
+    (maphash (lambda (id obj)
+               (declare (ignore id))
+               (when (equal (getf (memory-object-attributes obj) attr) value)
+                 (push obj results)))
+             *memory-store*)
+    (nreverse results)))
+
+(defun memory-id-generate ()
+  "Generates a timestamp-based unique ID."
+  (format nil "id-~36r" (get-universal-time)))
+
+(defstruct memory-object
+  id type attributes content vector parent-id children version last-sync hash)
+
+(defmethod make-load-form ((obj memory-object) &optional env)
+  (make-load-form-saving-slots obj :environment env))
+
+(defun deep-copy-memory-object (obj)
+  "Creates a full copy of an memory-object, including fresh lists for attributes and children."
+  (make-memory-object :id (memory-object-id obj)
+                  :type (memory-object-type obj)
+                  :attributes (copy-list (memory-object-attributes obj))
+                  :content (memory-object-content obj)
+                  :vector (memory-object-vector obj)
+                  :parent-id (memory-object-parent-id obj)
+                  :children (copy-list (memory-object-children obj))
+                  :version (memory-object-version obj)
+                  :last-sync (memory-object-last-sync obj)
+                  :hash (memory-object-hash obj)))
+
+(defun memory-merkle-hash (id type attributes content child-hashes)
+  (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
+         (sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
+         (attr-string (format nil "~s" sorted-alist))
+         (children-string (format nil "~{~a~}" child-hashes))
+         (data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
+                               id type attr-string (or content "") children-string))
+         (digester (ironclad:make-digest :sha256)))
+    (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
+    (ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
+
+(defun ingest-ast (ast &optional parent-id)
+  (let* ((type (getf ast :type))
+         (props (getf ast :properties))
+         (id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
+         (contents (getf ast :contents))
+         (raw-content (when (eq type :HEADLINE)
+                        (format nil "~a~%~a" (getf props :TITLE) (or (getf ast :raw-content) ""))))
+         (child-ids nil) (child-hashes nil))
+    (dolist (child contents)
+      (when (listp child)
+        (let ((child-id (ingest-ast child id)))
+          (push child-id child-ids)
+          (let ((child-obj (gethash child-id *memory-store*)))
+            (when child-obj (push (memory-object-hash child-obj) child-hashes))))))
+    (setf child-ids (nreverse child-ids))
+    (setf child-hashes (nreverse child-hashes))
+    (let* ((hash (memory-merkle-hash id type props raw-content child-hashes))
+           (existing-obj (gethash hash *memory-history*))
+           (obj (or existing-obj
+                    (make-memory-object 
+                     :id id :type type :attributes props :content raw-content
+                     :parent-id parent-id :children child-ids
+                     :version (get-universal-time) :last-sync (get-universal-time)
+                     :hash hash))))
+      (unless existing-obj (setf (gethash hash *memory-history*) obj))
+      (setf (gethash id *memory-store*) obj)
+      id)))
+
+(defvar *memory-snapshots* nil)
+
+(defun memory-hash-table-copy (hash-table)
+  "Creates an independent copy of a hash table."
+  (let ((new-table (make-hash-table :test (hash-table-test hash-table) 
+                                     :size (hash-table-size hash-table))))
+    (maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
+    new-table))
+
+(defun snapshot-memory ()
+  "Creates a CoW snapshot of *memory-store* for rollback recovery."
+  (let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory-store*))))
+    (maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-memory-object v))) *memory-store*)
+    (push (list :timestamp (get-universal-time) :data snapshot) *memory-snapshots*)
+    (when (> (length *memory-snapshots*) 20)
+      (setf *memory-snapshots* (subseq *memory-snapshots* 0 20)))
+    (harness-log "MEMORY - CoW Memory snapshot created.")))
+
+(defun rollback-memory (&optional (index 0))
+  "Restores *memory-store* from a snapshot. INDEX 0 = most recent."
+  (let ((snapshot (nth index *memory-snapshots*)))
+    (if snapshot
+        (progn (setf *memory-store* (memory-hash-table-copy (getf snapshot :data)))
+               (harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
+        (harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
+
+(defvar *memory-snapshot-path* nil)
+
+(defun memory-snapshot-path-ensure ()
+  "Returns the path to the memory snapshot file, resolving env or default."
+  (or *memory-snapshot-path*
+      (let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
+        (setf *memory-snapshot-path*
+              (or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
+
+(defun save-memory-to-disk ()
+  "Writes the entire memory and history store to disk as a plist."
+  (let ((path (memory-snapshot-path-ensure)))
+    (with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
+      (let ((memory-alist nil) (history-alist nil))
+        (maphash (lambda (k v) (push (cons k v) memory-alist)) *memory-store*)
+        (maphash (lambda (k v) (push (cons k v) history-alist)) *memory-history*)
+        (prin1 (list :memory memory-alist :history-store history-alist) stream)))
+    (harness-log "MEMORY - Saved to ~a" path)))
+
+(defun load-memory-from-disk ()
+  "Reads memory state from disk and restores *memory-store* and *memory-history*."
+  (let ((path (memory-snapshot-path-ensure)))
+    (when (uiop:file-exists-p path)
+      (handler-case
+          (with-open-file (stream path :direction :input)
+            (let ((data (read stream nil)))
+              (when data
+                (let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
+                  (setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
+                  (dolist (kv memory-alist) (setf (gethash (car kv) *memory-store*) (cdr kv)))
+                  (setf *memory-history* (make-hash-table :test 'equal :size (length history-alist)))
+                  (dolist (kv history-alist) (setf (gethash (car kv) *memory-history*) (cdr kv)))
+                  (harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
+          (error (c) (harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
+  t)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-memory-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:memory-suite))
+
+(in-package :passepartout-memory-tests)
+
+(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
+(in-suite memory-suite)
+
+(test merkle-hash-consistency
+  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
+    (clrhash passepartout::*memory-store*)
+    (let ((id1 (ingest-ast ast1)))
+      (let ((hash1 (memory-object-hash (memory-object-get id1))))
+        (clrhash passepartout::*memory-store*)
+        (let ((id2 (ingest-ast ast1)))
+          (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))