175 lines
8.4 KiB
Org Mode
175 lines
8.4 KiB
Org Mode
#+TITLE: The Object Store (object-store.lisp)
|
|
#+AUTHOR: Amr
|
|
#+FILETAGS: :kernel:memory:
|
|
#+STARTUP: content
|
|
|
|
* The Object Store (object-store.lisp)
|
|
** Deep Reasoning: The Single Address Space Advantage
|
|
Industry-standard "Vector Databases" or "SQLite Backends" add external complexity and I/O latency.
|
|
- **Pointer-Based Reasoning:** By loading the entire Memex into a live Lisp hash table, we achieve microsecond recollection. The agent doesn't "search a file"; it traverses a memory pointer.
|
|
- **Memory Imaging:** The `memory-image.lisp` snapshot allows the agent to wake up with its entire context already parsed. This solves the "Cold Start" problem of massive Org files.
|
|
- **Merkle-Tree Integrity:** Every node in the Object Store is cryptographically hashed. By hashing the content and the hashes of its children, the root hash provides a single, immutable fingerprint of the entire Memex state.
|
|
|
|
** The Single Address Space (Architecture)
|
|
#+begin_src mermaid
|
|
graph TD
|
|
subgraph LispMachine[Lisp Machine]
|
|
K[Kernel Core] --> OS[(Object Store)]
|
|
S1[Skill: Architect] --> OS
|
|
S2[Skill: Analyst] --> OS
|
|
S3[Skill: GTD] --> OS
|
|
K -- Pointers --> S1
|
|
K -- Pointers --> S2
|
|
end
|
|
subgraph IPCSlow[IPC Slow]
|
|
E[Emacs / Actuators] -. OACP .-> K
|
|
end
|
|
#+end_src
|
|
|
|
** Package Context
|
|
We begin by establishing the `org-agent` package context.
|
|
|
|
#+begin_src lisp :tangle ../src/object-store.lisp
|
|
(in-package :org-agent)
|
|
#+end_src
|
|
|
|
** The Object Repository
|
|
The `*object-store*` 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 ../src/object-store.lisp
|
|
(defvar *object-store* (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 ../src/object-store.lisp
|
|
(defstruct org-object
|
|
id type attributes content vector parent-id children version last-sync hash)
|
|
#+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 ../src/object-store.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 ../src/object-store.lisp
|
|
(defun ingest-ast (ast &optional parent-id)
|
|
"Parses an Org AST into the recursive Lisp Object Store 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 *object-store*) obj)
|
|
id)))
|
|
#+end_src
|
|
|
|
** Memory Snapshots (snapshot-object-store)
|
|
Because objects are stored immutably in the `*history-store*`, a snapshot is no longer a heavy, recursive deep-copy of the Memex. It is a lightweight shallow copy of the active `*object-store*` pointers. The system maintains a rolling buffer of 20 snapshots. This allows for near-instant, zero-cost rollback if the agent makes a mistake.
|
|
|
|
#+begin_src lisp :tangle ../src/object-store.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-object-store ()
|
|
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
|
|
(let ((snapshot (copy-hash-table *object-store*)))
|
|
(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)))
|
|
(kernel-log "MEMORY - CoW Object Store snapshot created.")))
|
|
#+end_src
|
|
|
|
** Memory Rollback (rollback-object-store)
|
|
Restores the state of the Memex from one of the previous snapshots.
|
|
|
|
#+begin_src lisp :tangle ../src/object-store.lisp
|
|
(defun rollback-object-store (&optional (index 0))
|
|
"Restores the Object Store to a previously captured snapshot using immutable history pointers."
|
|
(let ((snapshot (nth index *object-store-snapshots*)))
|
|
(if snapshot
|
|
(progn (setf *object-store* (copy-hash-table (getf snapshot :data)))
|
|
(kernel-log "MEMORY - Object Store rolled back to snapshot ~a" index))
|
|
(kernel-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
|
#+end_src
|
|
|
|
** Lookup Utilities
|
|
Basic functions for retrieving objects by ID or type.
|
|
|
|
#+begin_src lisp :tangle ../src/object-store.lisp
|
|
(defun lookup-object (id)
|
|
"Retrieves an object from the store by its unique ID."
|
|
(gethash id *object-store*))
|
|
|
|
(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))) *object-store*)
|
|
results))
|
|
#+end_src
|
|
|
|
** Structural Helpers
|
|
Utility functions for AST traversal and path resolution.
|
|
|
|
#+begin_src lisp :tangle ../src/object-store.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
|