amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity
Files
26d917dbc47b785e0cabba6e7e754c9a54a472f6
passepartout/org/core-memory.org

19 KiB
Raw Blame History

The System Memory (memory.lisp)

Overview: Architectural Intent

The Memory module is the cognitive bedrock of Passepartout. It is not a database; it is the agent's live, active brain state. Every perception, every action, every decision is recorded here.

Traditional architectures rely on external databases (SQLite, vector DBs, JSON files) which introduce I/O latency, structural impedance, and serialization overhead. Passepartout chooses a different path: the Single Address Space. By treating the entire knowledge base as a graph of Lisp pointers in RAM, we achieve microsecond recollection and total structural transparency.

The memory system has three layers:

  1. Active memory (*memory-store*) — a hash table mapping IDs to memory-object instances. This is what the agent queries during reasoning.
  2. Immutable history (*memory-history*) — an append-only hash table keyed by SHA-256 Merkle hash. Every version of every object that has ever existed is preserved here.
  3. Snapshot stack (*memory-snapshots*) — point-in-time copies of active memory for rollback recovery. Up to 20 snapshots are retained.

Why Merkle Hashes?

Every memory-object carries a hash field computed from its ID, type, attributes, content, and children. This hash is deterministic: the same data always produces the same hash.

The hash serves three purposes:

  1. Integrity verification — detect corruption or tampering
  2. Deduplication — if an object already exists in history, we reuse the existing entry
  3. Change detection — compare hashes to find what changed between snapshots

Why Snapshots Instead of Git?

Git tracks changes to files. Passepartout tracks changes to live memory state. The snapshot system captures the entire active memory at a point in time, enabling full rollback to any previous state. This is necessary because:

  1. The agent modifies memory continuously (learning, noting, deciding) — there's no discrete "commit" boundary
  2. Memory corruption from a bad LLM output can affect multiple objects — snapshot rollback restores all of them atomically
  3. Git can't snapshot the running Lisp image's hash tables

The tradeoff is memory usage: each snapshot is a deep copy of every object in active memory. 20 snapshots means 20x the active memory size. For a typical knowledge base of 10,000 objects, this is manageable (~100MB for 20 snapshots).

Contract

  1. (ingest-ast ast &key scope): stores AST nodes in *memory-store*. Detaches children, gives each an ID, computes Merkle hash. Returns the root ID string.
  2. (memory-object-hash object): returns the SHA-256 Merkle hash of the object's content. Hash is deterministic — same content → same hash.
  3. (memory-object-get id): retrieves a stored object by ID, or nil.
  4. (snapshot-memory): deep-copies *memory-store* to *memory-snapshots*.
  5. (rollback-memory snap-index): restores *memory-store* from a snapshot.

Implementation

Package Context 

(in-package :passepartout)

The Object Store

*memory-store* holds the agent's current state. *memory-history* holds every past version, keyed by Merkle hash.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *memory-store* (make-hash-table :test 'equal))

memory-history

;; REPL-VERIFIED: 2026-05-03T13:00:00

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

#+end_src

Object Lookup (memory-object-get)

Retrieve a single object by its ID from active memory. Returns nil if the ID doesn't exist.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun memory-object-get (id)
  "Retrieves an memory-object by ID from *memory-store*."
  (gethash id *memory-store*))

Object Search by Attribute (memory-objects-by-attribute)

Scan the entire active memory for objects whose attributes plist contains a specific key-value pair. For example, finding all objects with :TODO "APPROVED" (used by the Bouncer to find approved flight plans).

This is a full scan — O(n) over all objects. For the typical knowledge base size (< 10,000 objects), this is microsecond-fast. For larger datasets, a proper index would be needed.

;; REPL-VERIFIED: 2026-05-03T13:00:00

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

ID Generation (memory-id-generate)

Generates a unique identifier string for a new Org node. Uses the universal time encoded in base-36 for compactness and monotonic ordering (later IDs sort after earlier ones).

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun memory-id-generate ()
  "Generates a UUIDv4 unique ID. Compatible with Agora Note UUIDs."
  (concatenate 'string "id-" (string-downcase (format nil "~a" (uuid:make-v4-uuid)))))

The Data Structure (memory-object)

The universal data unit. Every stored entity — a note, a task, a project, a person, a decision — is an memory-object. The struct has:

  • id — unique identifier (string)
  • type — keyword (e.g., :HEADLINE, :PROPERTY_DRAWER)
  • attributes — property list (e.g., (:TITLE "My Note" :TAGS ("project") :TODO "NEXT"))
  • content — raw text content
  • vector — optional embedding vector for semantic search
  • parent-id — ID of the parent object (for tree structure)
  • children — list of child IDs
  • version — Unix timestamp of last modification
  • last-sync — Unix timestamp of last sync to disk
  • hash — SHA-256 Merkle hash for integrity verification
  • scope — scope keyword (:memex/:session/:project) for context-aware retrieval

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defstruct memory-object
  id type attributes content vector parent-id children version last-sync hash scope)

Serialization Support

Required by the Lisp runtime for saving/loading objects across image restarts via make-load-form-saving-slots.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defmethod make-load-form ((obj memory-object) &optional env)
  (make-load-form-saving-slots obj :environment env))

Deep Copy

Creates an independent copy of an memory-object, including fresh lists for attributes and children. Used by the snapshot system to capture a consistent memory state.

Without deep copy, a snapshot would share structure with the live memory — mutating the live memory would also mutate the snapshot, defeating the purpose of having a recovery point.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)
                  :scope (memory-object-scope obj)))

Merkle Tree Integrity (memory-merkle-hash)

Computes a deterministic SHA-256 hash from an object's identity and contents. The hash covers:

  • The object's ID and type
  • All attributes (sorted by key name for determinism)
  • The raw content text
  • The hashes of all children (making the hash a true Merkle tree — changing a descendant changes this hash)

This is NOT a cryptographic signature — it's an integrity check. If any part of an object or its descendants changes, the hash changes.

;; REPL-VERIFIED: 2026-05-03T13:00:00

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

AST Ingestion (memory-ingest)

The primary entry point for adding data to memory. Given an Org-mode AST (a tree of plists representing headlines and their contents), it recursively:

  1. Generates or assigns an ID to each node
  2. Computes the Merkle hash of each node
  3. Checks if the hash already exists in *memory-history* (deduplication)
  4. Stores the node in *memory-store* and *memory-history*
  5. Links children to parents

Returns the ID of the root node.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defun ingest-ast (ast &key parent-id (scope :memex))
  (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 :parent-id id :scope scope)))
          (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 :scope scope))))
      (unless existing-obj (setf (gethash hash *memory-history*) obj))
      (setf (gethash id *memory-store*) obj)
      id)))

Snapshot History (*memory-snapshots*)

A stack of CoW (copy-on-write) snapshots for rollback. When a critical error occurs, the system can roll back to any of the last 20 snapshots. Newer snapshots are prepended (index 0 = most recent).

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *memory-snapshots* nil)

Hash Table Copy Utility

Creates a fully independent copy of a hash table. Used by the rollback system to restore saved memory state from a snapshot.

;; REPL-VERIFIED: 2026-05-03T13:00:00

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

Memory Snapshot (memory-snapshot)

Captures a point-in-time copy of *memory-store*. Each object is deep-copied so the snapshot is independent of ongoing mutations. The snapshot is prepended to the snapshot stack, and the stack is trimmed to 20 entries.

Called automatically before significant memory mutations (buffer updates from Emacs, AST ingestion). Also callable manually.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)))
    (log-message "MEMORY - CoW Memory snapshot created.")))

Memory Rollback (memory-rollback)

Restores *memory-store* to a previous snapshot. By default restores the most recent snapshot (index 0). Can specify a specific index to roll back further.

This is the immune system's last resort. When the metabolic loop catches an unhandled error, it calls (rollback-memory 0) to undo any memory mutations caused by the bad signal.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)))
               (log-message "MEMORY - Memory rolled back to snapshot ~a" index))
        (log-message "MEMORY ERROR - Snapshot ~a not found." index))))

Persistence — Snapshot Path (*memory-snapshot-path*)

Configurable path for serialized memory state. Falls back to memory.snap in the home directory. Can be overridden via MEMORY_SNAPSHOT_PATH env var.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(defvar *memory-snapshot-path* nil)

memory-snapshot-path-ensure

;; REPL-VERIFIED: 2026-05-03T13:00:00

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

#+end_src

Save to Disk (memory-save)

Serialises both *memory-store* and *memory-history* to a Lisp-readable file. The format is a plist with :memory and :history-store keys, each containing an alist of (key . object) pairs.

The serialization uses prin1, which produces human-readable Lisp output. The file can be read with read on restart.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)))
    (log-message "MEMORY - Saved to ~a" path)))

Load from Disk (memory-load)

Restores memory state from a previously saved snapshot file. Called during boot (main in loop.org). If no snapshot file exists, the function returns silently and the agent starts with empty memory.

;; REPL-VERIFIED: 2026-05-03T13:00:00

(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)))
                  (log-message "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
          (error (c) (log-message "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
  t)

Test Suite

Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.

(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
  "Contract 2: identical ASTs produce identical Merkle hashes."
  (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)))))))))

(test merkle-hash-different
  "Contract 2: distinct ASTs produce different Merkle hashes."
  (clrhash passepartout::*memory-store*)
  (let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
         (ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
         (id1 (ingest-ast ast1))
         (id2 (ingest-ast ast2))
         (hash1 (memory-object-hash (memory-object-get id1)))
         (hash2 (memory-object-hash (memory-object-get id2))))
    (is (not (equal hash1 hash2)))))

(test test-ingest-ast-returns-id
  "Contract 1: ingest-ast returns a string ID and stores the object."
  (clrhash passepartout::*memory-store*)
  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
    (is (stringp id))
    (is (not (null id)))))

(test test-memory-object-get
  "Contract 3: memory-object-get retrieves an object by ID after ingest."
  (clrhash passepartout::*memory-store*)
  (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
    (let ((obj (memory-object-get id)))
      (is (not (null obj)))
      (is (eq :HEADLINE (memory-object-type obj)))
      (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))

(test test-snapshot-and-rollback
  "Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
  (clrhash passepartout::*memory-store*)
  (setf passepartout::*memory-snapshots* nil)
  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
  (snapshot-memory)
  (clrhash passepartout::*memory-store*)
  (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
  (rollback-memory 0)
  (is (not (null (memory-object-get "snap-a"))))
  (is (null (memory-object-get "snap-b"))))
Reference in New Issue View Git Blame Copy Permalink