passepartout/harness/memory.org

The System Memory (memory.lisp)

• Overview
• Implementation
  • Package Context
  • The Object Repository
  • Object Lookup (lookup-object)
  • Object search (list-objects-with-attribute)
  • ID generation (org-id-new)
  • The Data Structure (org-object)
  • Serialization support
  • Deep copy
  • Merkle Tree Integrity
  • Ingest (ingest-ast)
  • Snapshot history (*object-store-snapshots*)
  • Hash table copy utility
  • Memory snapshot (snapshot-memory)
  • Memory rollback (rollback-memory)
  • Persistence — snapshot path (*memory-snapshot-path*)
  • Save to disk (save-memory-to-disk)
  • Load from disk (load-memory-from-disk)
• Test Suite

Overview

The Memory module is the agent's live cognitive state — a set of Merkle-tree-versioned org-object instances stored in hash tables. Every perception, action, and decision is recorded here.

Key structures:

• *memory* — the primary object store, keyed by ID
• *history-store* — immutable archive of all past object versions, keyed by SHA-256 hash
• org-object — the universal data unit (id, type, attributes, content, vector embedding, parent, children, merkle hash)
• ingest-ast — converts an Org-mode AST into org-object instances, computing Merkle hashes for integrity

Implementation

Package Context

(in-package :opencortex)

The Object Repository

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

Object Lookup (lookup-object)

Retrieve a single object by its ID from the active memory store.

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

Object search (list-objects-with-attribute)

Scan the entire memory store for objects whose attributes match a given key-value pair.

(defun list-objects-with-attribute (attr value)
  "Returns all org-objects whose :ATTRIBUTES plist has ATTR = VALUE."
  (let ((results nil))
    (maphash (lambda (id obj)
               (declare (ignore id))
               (when (equal (getf (org-object-attributes obj) attr) value)
                 (push obj results)))
             *memory*)
    (nreverse results)))

ID generation (org-id-new)

Generate a unique identifier string for a new Org node. Uses the universal time encoded in base-36 for compactness.

(defun org-id-new ()
  "Generates a timestamp-based unique ID."
  (format nil "id-~36r" (get-universal-time)))

The Data Structure (org-object)

The universal data unit. Every stored entity is an org-object with an ID, type, attribute plist, content string, optional vector embedding, parent/child pointers, version timestamp, and Merkle hash.

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

Serialization support

Required by the Lisp runtime for saving/loading objects across image restarts.

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

Deep copy

Creates an independent copy of an org-object. Used by the snapshot system to capture consistent memory state.

(defun deep-copy-org-object (obj)
  "Creates a full copy of an org-object, including a fresh list copy of attributes and children."
  (make-org-object :id (org-object-id obj)
                  :type (org-object-type obj)
                  :attributes (copy-list (org-object-attributes obj))
                  :content (org-object-content obj)
                  :vector (org-object-vector obj)
                  :parent-id (org-object-parent-id obj)
                  :children (copy-list (org-object-children obj))
                  :version (org-object-version obj)
                  :last-sync (org-object-last-sync obj)
                  :hash (org-object-hash obj)))

Merkle Tree Integrity

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

Ingest (ingest-ast)

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

Snapshot history (*object-store-snapshots*)

A stack of CoW (copy-on-write) memory snapshots for rollback. Up to 20 snapshots are retained.

(defvar *object-store-snapshots* nil)

Hash table copy utility

Used by the rollback system to restore saved memory state.

(defun copy-hash-table (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 (snapshot-memory)

Captures a point-in-time copy of *memory*. Each object is deep-copied so the snapshot is independent of ongoing mutations.

(defun snapshot-memory ()
  "Creates a CoW snapshot of *memory* for rollback recovery."
  (let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*))))
    (maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-org-object v))) *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.")))

Memory rollback (rollback-memory)

Restores *memory* to a previous snapshot. By default restores the most recent snapshot (index 0).

(defun rollback-memory (&optional (index 0))
  "Restores *memory* from a snapshot. INDEX 0 = most recent."
  (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))))

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

Configurable path for serialized memory state. Falls back to memory.snap in the home directory.

(defvar *memory-snapshot-path* nil)

(defun ensure-memory-snapshot-path ()
  "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))))))))

Save to disk (save-memory-to-disk)

Serialises *memory* and *history-store* to a Lisp-readable file.

(defun save-memory-to-disk ()
  "Writes the entire memory and history store to disk as a plist."
  (let ((path (ensure-memory-snapshot-path)))
    (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*)
        (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)))

Load from disk (load-memory-from-disk)

Restores memory state from a previously saved snapshot file.

(defun load-memory-from-disk ()
  "Reads memory state from disk and restores *memory* and *history-store*."
  (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)

Test Suite

(eval-when (:compile-toplevel :load-toplevel :execute)
  (ql:quickload :fiveam :silent t))

(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)))
    (clrhash opencortex::*memory*)
    (let ((id1 (ingest-ast ast1)))
      (let ((hash1 (org-object-hash (lookup-object id1))))
        (clrhash opencortex::*memory*)
        (let ((id2 (ingest-ast ast1)))
          (is (equal hash1 (org-object-hash (lookup-object id2)))))))))