#+TITLE: The System Memory (memory.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:memory:
#+STARTUP: content

* The System Memory (memory.lisp)
** Architectural Intent: The Single Address Space (Live Memory)

Yes, the Memory module is the cognitive bedrock of the opencortex. It is not a database; it is the agent's live, active "brain" state.

Traditional architectures rely on external databases (SQLite, Vector DBs) which introduce I/O latency and structural impedance. The opencortex architecture chooses a different path: the **Single Address Space**. By treating the entire knowledge base as a graph of Lisp pointers, we achieve microsecond recollection and total structural transparency.

- **Pointer-Based Reasoning:** By loading the entire knowledge graph into a live Common Lisp hash table, we achieve microsecond recollection. The harness doesn't "search a file"; it traverses a memory pointer.
- **Memory Imaging:** The ability to snapshot the Lisp image allows the agent to resume its entire cognitive state instantly, solving the "Cold Start" problem.
- **Merkle-Tree Integrity:** Every node in the Memory is cryptographically hashed. By recursively hashing content and children, the root hash provides a single, immutable fingerprint of the entire system state.

** System Architecture
#+begin_src mermaid
flowchart TD
    subgraph LispMachine[Lisp Machine]
        H[Harness Pipeline] --> OS[(Memory)]
        S1[Skill: Architect] --> OS
        S2[Skill: Analyst] --> OS
        S3[Skill: GTD] --> OS
        H -- Pointers --> S1
        H -- Pointers --> S2
    end
    subgraph IPCSlow[External Layer]
        E[Emacs / Actuators] -. communication protocol .-> H
    end
#+end_src

** Package Context
#+begin_src lisp :tangle ../library/memory.lisp
(in-package :opencortex)
#+end_src

** The Object Repository
The `*memory*` is the global hash table that holds every Org element by its unique ID. This is the "live RAM" of the agent's memory.

#+begin_src lisp :tangle ../library/memory.lisp
(defvar *memory* (make-hash-table :test 'equal))

(defvar *history-store* (make-hash-table :test 'equal)
  "Immutable Merkle-Tree versioning store mapping hashes to objects.")
#+end_src

** The Data Structure (org-object)
Every element in the Memex (headlines, paragraphs, etc.) is represented by an `org-object` structure. It contains both semantic metadata (attributes, content) and structural metadata (parent/child pointers, Merkle hashes).

#+begin_src lisp :tangle ../library/memory.lisp
(defstruct org-object
  id type attributes content vector parent-id children version last-sync hash)

;; Enable serialization via make-load-form (standard CL)
(defmethod make-load-form ((obj org-object) &optional env)
  (make-load-form-saving-slots obj :environment env))
#+end_src

** Merkle Tree Integrity (compute-merkle-hash)
The `compute-merkle-hash` function ensures the cryptographic integrity of the knowledge graph. A node's hash depends on its own properties and the hashes of all its children. This creates a recursive fingerprint where any change to a single note propagates up to the root hash.

#+begin_src lisp :tangle ../library/memory.lisp
(defun compute-merkle-hash (id type attributes content child-hashes)
  "Computes a SHA-256 Merkle hash for a node based on its core properties and children's 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))))
#+end_src

** Ingesting the AST (ingest-ast)
The `ingest-ast` function is the primary bridge between the external world (Emacs/JSON) and the internal Lisp machine. It recursively parses an Org-mode Abstract Syntax Tree (AST) into `org-object` structures and registers them in the store.

#+begin_src lisp :tangle ../library/memory.lisp
(defun ingest-ast (ast &optional parent-id)
  "Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
  (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 (cl:getf ast :raw-content) ""))))
         (should-embed (and raw-content (equal (getf props :EMBED) "t")))
         (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-id-val child-id))
             (let ((child-obj (lookup-object child-id-val)))
               (when child-obj (push (org-object-hash child-obj) child-hashes)))))))
    (setf child-ids (nreverse child-ids))
    (setf child-hashes (nreverse child-hashes))
    (let* ((hash (compute-merkle-hash id type props raw-content child-hashes))
           (existing-obj (gethash hash *history-store*))
           (obj (or existing-obj
                    (make-org-object 
                     :id id :type type :attributes props :content raw-content
                     :vector (when should-embed (get-embedding 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 *history-store*) obj))
      (setf (gethash id *memory*) obj)
      id)))
#+end_src

** Memory Snapshots (snapshot-memory)
Because objects are stored immutably in the `*history-store*`, a snapshot is a lightweight shallow copy of the active `*memory*` pointers. The system maintains a rolling buffer of 20 snapshots, allowing for near-instant, zero-cost rollback.

#+begin_src lisp :tangle ../library/memory.lisp
(defvar *object-store-snapshots* nil)

(defun copy-hash-table (hash-table)
  "Creates a shallow 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 lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
  (let ((snapshot (copy-hash-table *memory*)))
    (push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
    (when (> (length *object-store-snapshots*) 20)
      (setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
    (harness-log "MEMORY - CoW Memory snapshot created.")))
#+end_src

** Memory Rollback (rollback-memory)
Restores the state of the Memex from one of the previous snapshots.

#+begin_src lisp :tangle ../library/memory.lisp
(defun rollback-memory (&optional (index 0))
  "Restores the Memory to a previously captured snapshot using immutable history pointers."
  (let ((snapshot (nth index *object-store-snapshots*)))
    (if snapshot
        (progn (setf *memory* (copy-hash-table (getf snapshot :data)))
               (harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
        (harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
#+end_src

* Test Suite

These tests verify the Memory system. Run with:
~(fiveam:run! 'memory-suite)~

#+begin_src lisp :tangle ../tests/memory-tests.lisp
(defpackage :opencortex-memory-tests
  (:use :cl :fiveam :opencortex)
  (:export #:memory-suite))

(in-package :opencortex-memory-tests)

(def-suite memory-suite
  :description "Tests for the Merkle-Tree Memory")

(in-suite memory-suite)

(test merkle-hash-consistency
  "Verify identical ASTs produce identical Merkle hashes."
  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
    (clrhash *memory*)
    (let ((id1 (ingest-ast ast1)))
      (let ((hash1 (org-object-hash (lookup-object id1))))
        (clrhash *memory*)
        (let ((id2 (ingest-ast ast1)))
          (let ((hash2 (org-object-hash (lookup-object id2))))
            (is (equal hash1 hash2))))))))

(test history-store-immutability
  "Verify that *history-store* retains old versions."
  (clrhash *memory*)
  (clrhash *history-store*)
  (let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
         (id-v1 (ingest-ast ast-v1))
         (obj-v1 (lookup-object id-v1))
         (hash-v1 (org-object-hash obj-v1)))
    (let* ((ast-v2 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 2") :contents nil))
           (id-v2 (ingest-ast ast-v2))
           (hash-v2 (org-object-hash (lookup-object id-v2))))
      (is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
      (is (not (null (gethash hash-v1 *history-store*)))
      (is (not (null (gethash hash-v2 *history-store*))))))

(test cow-snapshot-and-rollback
  "Verify that lightweight snapshots restore previous pointer states."
  (clrhash *memory*)
  (setf *object-store-snapshots* nil)
  (let* ((ast-v1 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State A") :contents nil))
         (id-v1 (ingest-ast ast-v1))
         (hash-v1 (org-object-hash (lookup-object id-v1))))
    (snapshot-memory)
    (let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
           (id-v2 (ingest-ast ast-v2))
           (hash-v2 (org-object-hash (lookup-object id-v2))))
      (is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
      (rollback-memory 0)
      (is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
      (is (not (null (gethash hash-v2 *history-store*))))))
#+end_src

** Disk Persistence (save-memory / load-memory)
Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart. The path is controlled by the `MEMORY_SNAPSHOT_PATH` environment variable.

#+begin_src lisp :tangle ../library/memory.lisp
(defvar *memory-snapshot-path* nil
  "Path to the memory snapshot file. Set from MEMORY_SNAPSHOT_PATH env or default.")

(defun ensure-memory-snapshot-path ()
  "Initializes the snapshot path from environment or default location."
  (or *memory-snapshot-path*
      (let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
        (setf *memory-snapshot-path*
              (or env-path
                  (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname)))))))

(defun save-memory-to-disk ()
  "Serializes *memory* and *history-store* to disk for crash recovery.
Converts hash tables to alists for proper serialization."
  (let ((path (ensure-memory-snapshot-path)))
    (with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
      (format stream ";; OpenCortex Memory Snapshot~%")
      (format stream ";; Created: ~a~%~%" (format nil "~a" (get-universal-time)))
      (let ((memory-alist nil)
            (history-alist nil))
        (maphash (lambda (k v) (push (cons k v) memory-alist)) *memory*)
        (maphash (lambda (k v) (push (cons k v) history-alist)) *history-store*)
        (prin1 (list :memory memory-alist :history-store history-alist) stream)))
    (harness-log "MEMORY - Saved to ~a" path)
    path))

(defun load-memory-from-disk ()
  "Loads *memory* and *history-store* from disk if the snapshot exists.
Reconstitutes alists into hash tables."
  (let ((path (ensure-memory-snapshot-path)))
    (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* (make-hash-table :test 'equal :size (length memory-alist)))
                  (dolist (kv memory-alist)
                    (setf (gethash (car kv) *memory*) (cdr kv)))
                  (setf *history-store* (make-hash-table :test 'equal :size (length history-alist)))
                  (dolist (kv history-alist)
                    (setf (gethash (car kv) *history-store*) (cdr kv)))
                  (harness-log "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory*))))))
          (error (c)
            (harness-log "MEMORY WARNING - Failed to load snapshot: ~a" c))))
    t))
#+end_src

** Semantic Search (get-embedding, semantic-search)
Support for vector embeddings via Ollama and semantic search with cosine similarity.

The vector slot on org-objects enables semantic recall - searching memory by meaning rather than just keywords. Embeddings are generated on ingest when the :EMBED property is set to "t", and cached locally to avoid redundant API calls.

#+begin_src lisp :tangle ../library/memory.lisp
(defvar *embedding-cache* (make-hash-table :test 'equal)
  "Cache for embeddings to avoid redundant API calls.")

(defun get-embedding (text)
  "Generates a vector embedding for the given text via Ollama. Returns nil on failure."
  (when (or (null text) (string= text ""))
    (return-from get-embedding nil))
  (let ((cached (gethash text *embedding-cache*)))
    (when cached (return-from get-embedding cached)))
  (let ((result (funcall (get-cognitive-tool-body :get-ollama-embedding) (list :text text))))
    (when (eq (getf result :status) :success)
      (let ((vec (getf result :vector)))
        (setf (gethash text *embedding-cache*) vec)
        vec))))

(defun cosine-similarity (vec-a vec-b)
  "Computes cosine similarity between two vectors. Both should be sequences of numbers."
  (when (or (null vec-a) (null vec-b) (zerop (length vec-a)) (zerop (length vec-b)))
    (return-from cosine-similarity 0.0))
  (let ((dot-product (loop for a across vec-a
                          for b across vec-b
                          sum (* a b)))
        (norm-a (sqrt (loop for a across vec-a sum (* a a))))
        (norm-b (sqrt (loop for b across vec-b sum (* b b)))))
    (if (or (zerop norm-a) (zerop norm-b))
        0.0
        (/ dot-product (* norm-a norm-b)))))

(defun semantic-search (query &key (limit 10) (min-similarity 0.5))
  "Searches memory for objects semantically similar to the query.
Returns up to LIMIT objects with similarity >= MIN-SIMILARITY, sorted by similarity descending."
  (let* ((query-vec (get-embedding query))
         (results nil))
    (unless query-vec
      (harness-log "EMBEDDING: Failed to generate embedding for query: ~a" query)
      (return-from semantic-search nil))
    (maphash (lambda (id obj)
               (let ((obj-vec (org-object-vector obj)))
                 (when obj-vec
                   (let ((sim (cosine-similarity query-vec obj-vec)))
                     (when (>= sim min-similarity)
                       (push (list :id id :object obj :similarity sim) results))))))
             *memory*)
    (setf results (sort results #'> :key (lambda (r) (getf r :similarity))))
    (subseq results 0 (min limit (length results)))))

(def-cognitive-tool :semantic-search
  "Searches memory for objects semantically similar to a query."
  ((:query :type :string :description "The search query.")
   (:limit :type :integer :description "Maximum results to return." :default 10)
   (:min-similarity :type :number :description "Minimum similarity threshold (0-1)." :default 0.5))
  :body (lambda (args)
          (semantic-search (getf args :query)
                        :limit (or (getf args :limit) 10)
                        :min-similarity (or (getf args :min-similarity) 0.5))))
#+end_src

** Lookup Utilities
Basic functions for retrieving objects by ID or type.

#+begin_src lisp :tangle ../library/memory.lisp
(defun org-id-new ()
  "Generates a new UUID string for Org-mode identification."
  (string-downcase (format nil "~a" (uuid:make-v4-uuid))))

(defun lookup-object (id) 
  "Retrieves an object from the store by its unique ID."
  (gethash id *memory*))

(defun list-objects-by-type (type)
  "Returns a list of all objects matching a specific Org element type."
  (let ((results nil))
    (maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
    results))
(defun list-objects-with-attribute (attr-name value)
  "Returns a list of all objects where ATTR-NAME matches VALUE."
  (let ((results nil))
    (maphash (lambda (id obj)
               (declare (ignore id))
               (let ((attrs (org-object-attributes obj)))
                 (when (equal (getf attrs attr-name) value)
                   (push obj results))))
             *memory*)
    results))
#+end_src

** Structural Helpers
Utility functions for AST traversal and path resolution.

#+begin_src lisp :tangle ../library/memory.lisp
(defun find-headline-missing-id (ast)
  "Traverses an AST to find headlines that lack an :ID: property."
  (when (listp ast)
    (if (and (eq (getf ast :type) :HEADLINE) (not (getf (getf ast :properties) :ID)))
        ast
        (cl:some #'find-headline-missing-id (getf ast :contents)))))

(defun file-name-nondirectory (path)
  "Extracts the filename from a full path string."
  (let ((pos (position #\/ path :from-end t))) (if pos (subseq path (1+ pos)) path)))
#+end_src

* Phase E: Chaos (Verification)
Following the Engineering Standards, the Memory must be empirically verified through automated testing. The following test suite ensures the mathematical integrity of the Merkle hashes and the behavioral correctness of the immutable versioning and rollback systems.

#+begin_src lisp :tangle ../tests/memory-tests.lisp
(defpackage :opencortex-memory-tests
  (:use :cl :fiveam :opencortex)
  (:export #:memory-suite))

(in-package :opencortex-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))
         (ast2 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
    (clrhash *memory*)
    (let ((id1 (ingest-ast ast1)))
      (let ((hash1 (org-object-hash (lookup-object id1))))
        (clrhash *memory*)
        (let ((id2 (ingest-ast ast2)))
          (let ((hash2 (org-object-hash (lookup-object id2))))
            (is (equal hash1 hash2))))))))

(test merkle-hash-cascading
  (let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
         (ast-root-full '(:type :HEADLINE :properties (:ID "root" :TITLE "Root") 
                           :contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
         (id-root (progn (clrhash *memory*) (ingest-ast ast-root-full)))
         (initial-root-hash (org-object-hash (lookup-object id-root))))
      
      ;; Now ingest a modified version (title change)
      (let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root") 
                                 :contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
             (id-root-mod (progn (clrhash *memory*) (ingest-ast ast-root-modified)))
             (modified-root-hash (org-object-hash (lookup-object id-root-mod))))
        (is (not (equal initial-root-hash modified-root-hash))))))

(test history-store-immutability
  "Verify that *history-store* retains old versions even after *memory* updates."
  (clrhash *memory*)
  (clrhash *history-store*)
  (let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
         (id-v1 (ingest-ast ast-v1))
         (obj-v1 (lookup-object id-v1))
         (hash-v1 (org-object-hash obj-v1)))
    
    (let* ((ast-v2 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 2") :contents nil))
           (id-v2 (ingest-ast ast-v2))
           (obj-v2 (lookup-object id-v2))
           (hash-v2 (org-object-hash obj-v2)))
      
      ;; The active pointer should be v2
      (is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
      
      ;; Both v1 and v2 should exist in the immutable history store
      (is (not (null (gethash hash-v1 *history-store*))))
      (is (not (null (gethash hash-v2 *history-store*))))
      
      ;; Modifying v2 should not affect v1 in the history store
      (is (equal (org-object-content (gethash hash-v1 *history-store*)) "Version 1
"))
      (is (equal (org-object-content (gethash hash-v2 *history-store*)) "Version 2
")))))

(test cow-snapshot-and-rollback
  "Verify that lightweight snapshots can accurately restore previous pointer states."
  (clrhash *memory*)
  (clrhash *history-store*)
  (setf *object-store-snapshots* nil)
  
  (let* ((ast-v1 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State A") :contents nil))
         (id-v1 (ingest-ast ast-v1))
         (hash-v1 (org-object-hash (lookup-object id-v1))))
    
    ;; Take a snapshot at State A
    (snapshot-memory)
    
    (let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
           (id-v2 (ingest-ast ast-v2))
           (hash-v2 (org-object-hash (lookup-object id-v2))))
      
      ;; Verify we are currently in State B
      (is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
      
      ;; Rollback to State A (index 0 because we only took 1 snapshot)
      (rollback-memory 0)
      
      ;; Verify we are back in State A
      (is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
      
;; Verify State B is still safely in the history store (no data loss)
      (is (not (null (gethash hash-v2 *history-store*))))))

(test merkle-hash-consistency
  "Verify that identical ASTs produce identical Merkle hashes."
  (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
    (clrhash *memory*)
    (let ((id1 (ingest-ast ast1)))
      (let ((hash1 (org-object-hash (lookup-object id1))))
        (clrhash *memory*)
        (let ((id2 (ingest-ast ast1)))
          (let ((hash2 (org-object-hash (lookup-object id2))))
            (is (equal hash1 hash2))))))))

(test merkle-hash-cascading
  "Verify that child changes propagate to parent hashes."
  (let* ((ast-root '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
                      :contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
         (id-root (progn (clrhash *memory*) (ingest-ast ast-root)))
         (root-hash (org-object-hash (lookup-object id-root))))
    ;; Now ingest a modified child - parent hash should change
    (let* ((ast-mod '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
                    :contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Changed") :contents nil))))
           (id-mod (progn (clrhash *memory*) (ingest-ast ast-mod)))
           (mod-hash (org-object-hash (lookup-object id-mod))))
      (is (not (equal root-hash mod-hash))))))
#+end_src