Amr Gharbeia
41de20d3f1
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 11s
- Secret Exposure Gate + Privacy Filter (Bouncer) - Shell actuator safety harness (timeout, blocked patterns) - REPL-first enforcement (lisp validation gate, system-prompt-augment) - Engineering Standards lifecycle (two-track Org-first + REPL-first) - Literate Programming discipline (one function per block, reflect-back) - AGENTS.md: thin routing layer, skills are authoritative - SKILLS_DIR removed, ~/notes fallback eliminated - opencortex.sh: multi-distro (Debian+Fedora), configure, install service, backup, restore, help - infrastructure/opencortex.service (systemd user unit) - Docker: updated to debian:trixie, fixed build context - GitHub CI: lint + test workflows fixed, trigger on tags only - Gitea CI: deploy workflow paths fixed - README: one-line curl install, badges - USER_MANUAL: Deployment section (bare metal, Docker, backup) - .gitignore: skills/*.lisp and tests/*.lisp as generated artifacts - Prose/block refactor across all 35 org files - Test suite Tier 1: 43/45 pass (env-dependent failures isolated)
249 lines
11 KiB
Org Mode
249 lines
11 KiB
Org Mode
#+TITLE: The System Memory (memory.lisp)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :harness:memory:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle memory.lisp
|
|
|
|
* 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
|
|
#+begin_src lisp
|
|
(in-package :opencortex)
|
|
#+end_src
|
|
|
|
** The Object Repository
|
|
#+begin_src 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
|
|
|
|
** Object Lookup (lookup-object)
|
|
Retrieve a single object by its ID from the active memory store.
|
|
#+begin_src lisp
|
|
(defun lookup-object (id)
|
|
"Retrieves an org-object by ID from *memory*."
|
|
(gethash id *memory*))
|
|
#+end_src
|
|
|
|
** Object search (list-objects-with-attribute)
|
|
Scan the entire memory store for objects whose attributes match a given key-value pair.
|
|
#+begin_src lisp
|
|
(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)))
|
|
#+end_src
|
|
|
|
** 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.
|
|
#+begin_src lisp
|
|
(defun org-id-new ()
|
|
"Generates a timestamp-based unique ID."
|
|
(format nil "id-~36r" (get-universal-time)))
|
|
#+end_src
|
|
|
|
** 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.
|
|
#+begin_src lisp
|
|
(defstruct org-object
|
|
id type attributes content vector parent-id children version last-sync hash)
|
|
#+end_src
|
|
|
|
** Serialization support
|
|
Required by the Lisp runtime for saving/loading objects across image restarts.
|
|
#+begin_src lisp
|
|
(defmethod make-load-form ((obj org-object) &optional env)
|
|
(make-load-form-saving-slots obj :environment env))
|
|
#+end_src
|
|
|
|
** Deep copy
|
|
Creates an independent copy of an ~org-object~. Used by the snapshot system to capture consistent memory state.
|
|
#+begin_src lisp
|
|
(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)))
|
|
#+end_src
|
|
|
|
** Merkle Tree Integrity
|
|
#+begin_src lisp
|
|
(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))))
|
|
#+end_src
|
|
|
|
** Ingest (ingest-ast)
|
|
#+begin_src lisp
|
|
(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)))
|
|
#+end_src
|
|
|
|
** Snapshot history (~*object-store-snapshots*~)
|
|
A stack of CoW (copy-on-write) memory snapshots for rollback. Up to 20 snapshots are retained.
|
|
#+begin_src lisp
|
|
(defvar *object-store-snapshots* nil)
|
|
#+end_src
|
|
|
|
** Hash table copy utility
|
|
Used by the rollback system to restore saved memory state.
|
|
#+begin_src lisp
|
|
(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))
|
|
#+end_src
|
|
|
|
** 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.
|
|
#+begin_src lisp
|
|
(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.")))
|
|
#+end_src
|
|
|
|
** Memory rollback (rollback-memory)
|
|
Restores ~*memory*~ to a previous snapshot. By default restores the most recent snapshot (index 0).
|
|
#+begin_src lisp
|
|
(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))))
|
|
#+end_src
|
|
|
|
** Persistence — snapshot path (~*memory-snapshot-path*~)
|
|
Configurable path for serialized memory state. Falls back to ~memory.snap~ in the home directory.
|
|
#+begin_src lisp
|
|
(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))))))))
|
|
#+end_src
|
|
|
|
** Save to disk (save-memory-to-disk)
|
|
Serialises ~*memory*~ and ~*history-store*~ to a Lisp-readable file.
|
|
#+begin_src lisp
|
|
(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)))
|
|
#+end_src
|
|
|
|
** Load from disk (load-memory-from-disk)
|
|
Restores memory state from a previously saved snapshot file.
|
|
#+begin_src lisp
|
|
(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)
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
#+begin_src lisp :tangle ../tests/memory-tests.lisp
|
|
(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)))))))))
|
|
#+end_src
|