Amr Gharbeia
94a8a0ab0b
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- Folders: literate->harness, src->library, system->environment, scripts->interfaces. - Synchronized all :tangle paths and system definitions. - Hardened .gitignore for binary and log artifacts. - Consolidated all documentation into docs/.
82 lines
3.1 KiB
Common Lisp
82 lines
3.1 KiB
Common Lisp
(in-package :opencortex)
|
|
|
|
(defvar *memory* (make-hash-table :test 'equal)
|
|
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
|
|
|
|
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
|
|
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
|
|
|
|
(defstruct org-object
|
|
"The fundamental unit of knowledge in the OpenCortex."
|
|
id
|
|
type
|
|
attributes
|
|
parent-id
|
|
children
|
|
version
|
|
last-sync
|
|
vector
|
|
content
|
|
hash)
|
|
|
|
(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))
|
|
(raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string)))
|
|
(ironclad:byte-array-to-hex-string
|
|
(ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data)))))
|
|
|
|
(defun ingest-ast (ast &optional parent-id)
|
|
"Recursively parses an Org AST into the Lisp Memory registry."
|
|
(let* ((type (getf ast :type))
|
|
(properties (getf ast :properties))
|
|
(id (or (getf properties :ID) (uuid:make-v4-uuid)))
|
|
(content (getf ast :content))
|
|
(children (getf ast :contents))
|
|
(child-ids nil))
|
|
|
|
;; Recursively ingest children and collect their IDs
|
|
(dolist (child children)
|
|
(let ((child-obj (ingest-ast child id)))
|
|
(when child-obj (push (org-object-id child-obj) child-ids))))
|
|
|
|
(let ((obj (make-org-object :id id
|
|
:type type
|
|
:attributes properties
|
|
:parent-id parent-id
|
|
:children (nreverse child-ids)
|
|
:content content
|
|
:version (get-universal-time))))
|
|
(setf (gethash id *memory*) obj)
|
|
obj)))
|
|
|
|
(defun lookup-object (id)
|
|
"Retrieves an object from memory by its ID."
|
|
(gethash id *memory*))
|
|
|
|
(defun list-objects-with-attribute (key value)
|
|
"Returns a list of objects that possess the specified attribute pair."
|
|
(let ((results nil))
|
|
(maphash (lambda (id obj)
|
|
(declare (ignore id))
|
|
(when (equal (getf (org-object-attributes obj) key) value)
|
|
(push obj results)))
|
|
*memory*)
|
|
results))
|
|
|
|
(defun snapshot-memory ()
|
|
"Creates a deep copy of the memory hash table and pushes it to the history store."
|
|
(let ((new-snap (make-hash-table :test 'equal)))
|
|
(maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*)
|
|
(vector-push-extend new-snap *history-store*)))
|
|
|
|
(defun rollback-memory (&optional (steps 1))
|
|
"Restores the memory to a previous snapshot state."
|
|
(let ((index (- (length *history-store*) steps 1)))
|
|
(when (>= index 0)
|
|
(setf *memory* (aref *history-store* index))
|
|
(harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps))))
|