amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

ALIGN: Rename Object Store to Memory and enrich literate text

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-13 14:29:15 -04:00
parent 5f86bcd8dc
commit dcd3a31112
47 changed files with 215 additions and 213 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
src/chaos-logic.lisp
View File

@@ -19,7 +19,7 @@
(mode (or (getf payload :mode) :random))
(intensity (or (getf payload :intensity) 3)))
(harness-log "CHAOS - Commencing stress test (Mode: ~a, Intensity: ~a)" mode intensity)
(snapshot-object-store)
(snapshot-memory)
(case mode
(:random (dotimes (i intensity)
(let ((failure-type (nth (random 3) '(:test-failure :shell-timeout :llm-error))))
@@ -27,7 +27,7 @@
`(:type :EVENT :payload (:sensor :chaos-injection :type ,failure-type))))))
(:shell (inject-stimulus
`(:type :EVENT :payload (:sensor :shell-response :cmd "git push" :exit-code 128 :stderr "fatal: network unreachable")))))
(snapshot-object-store)
(snapshot-memory)
(format nil "SUCCESS - Chaos stress test initiated.")))
(defun chaos-enable ()

6
src/chat-logic.lisp
View File

@@ -1,7 +1,7 @@
(in-package :org-agent)
(defun chat-archive-message (text &key (role :user) channel chat-id)
"Archives a chat message into the persistent Object Store and triggers a snapshot."
"Archives a chat message into the persistent Memory and triggers a snapshot."
(let* ((msg-id (org-id-new))
(obj (make-org-object
:id msg-id
@@ -9,9 +9,9 @@
:attributes `(:role ,role :channel ,channel :chat-id ,chat-id :timestamp ,(get-universal-time))
:content text
:version (get-universal-time))))
(setf (gethash msg-id *object-store*) obj)
(setf (gethash msg-id *memory*) obj)
(harness-log "CHAT - Message archived: ~a (~a)" msg-id role)
(snapshot-object-store)
(snapshot-memory)
msg-id))
(defun trigger-skill-chat (context)

8
src/config-logic.lisp
View File

@@ -1,7 +1,7 @@
(in-package :org-agent)
(defun set-llm-model (provider model-id)
"Registers a preferred model for a provider in the Object Store."
"Registers a preferred model for a provider in the Memory."
(let ((config-id (format nil "config-llm-~a" (string-downcase (string provider)))))
(let ((obj (make-org-object
:id config-id
@@ -9,14 +9,14 @@
:attributes `(:provider ,provider :model-id ,model-id)
:content (format nil "Fleet preference for ~a set to ~a" provider model-id)
:version (get-universal-time))))
(setf (gethash config-id *object-store*) obj)
(setf (gethash config-id *memory*) obj)
(harness-log "CONFIG - Fleet updated: ~a -> ~a" provider model-id)
t)))
(defun get-llm-model (provider &optional default)
"Retrieves the preferred model for a provider from the Object Store."
"Retrieves the preferred model for a provider from the Memory."
(let* ((config-id (format nil "config-llm-~a" (string-downcase (string provider))))
(obj (gethash config-id *object-store*)))
(obj (gethash config-id *memory*)))
(if obj
(getf (org-object-attributes obj) :model-id)
default)))

2
src/context-logic.lisp
View File

@@ -44,7 +44,7 @@
output))
(defun context-assemble-global-awareness (&optional signal)
"Produces a high-level skeletal outline of the current Object Store for the LLM."
"Produces a high-level skeletal outline of the current Memory for the LLM."
(let* ((payload (when signal (getf signal :payload)))
(foveal-id (when payload (getf payload :target-id)))
(foveal-vector (when foveal-id (org-object-vector (lookup-object foveal-id))))

6
src/context.lisp
View File

@@ -1,7 +1,7 @@
(in-package :org-agent)
(defun context-query-store (&key tag todo-state type)
"Filters the Object Store based on tags, todo states, or types."
"Filters the Memory based on tags, todo states, or types."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
@@ -10,7 +10,7 @@
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
(when (and todo-state (not (equal state todo-state))) (setf match nil))
(when match (push obj results))))
*object-store*)
*memory*)
results))
(defun context-get-active-projects ()
@@ -102,7 +102,7 @@
path-string))
(defun context-assemble-global-awareness (&optional signal)
"Produces a high-level skeletal outline of the current Object Store for the LLM."
"Produces a high-level skeletal outline of the current Memory for the LLM."
(let* ((payload (when signal (getf signal :payload)))
(foveal-id (when payload (getf payload :target-id)))
(projects (context-get-active-projects))

2
src/credentials-vault.lisp
View File

@@ -35,7 +35,7 @@
(let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret)
(harness-log "VAULT - Updated ~a for ~a. Triggering Merkle snapshot..." type provider)
(snapshot-object-store)
(snapshot-memory)
t))
(defun vault-onboard-gemini-web ()

4
src/deterministic.lisp
View File

@@ -27,11 +27,11 @@
current-action))
(defun list-objects-with-attribute (attr-key attr-val)
"Filters the Object Store for nodes having a specific attribute value."
"Filters the Memory for nodes having a specific attribute value."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (org-object-attributes obj) attr-key) attr-val)
(push obj results)))
*object-store*)
*memory*)
results))

2
src/embedding-logic.lisp
View File

@@ -44,7 +44,7 @@
(let ((vec (org-object-vector obj)))
(when vec
(push (cons (cosine-similarity query-vector vec) obj) similarities))))
*object-store*)
*memory*)
(let ((sorted (sort similarities #'> :key #'car)))
(subseq sorted 0 (min top-k (length sorted))))))

2
src/embedding.lisp
View File

@@ -27,5 +27,5 @@
(defun find-most-similar (query-vector top-k)
"Identifies the top-k most semantically related objects in the store."
(let ((similarities nil))
(maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *object-store*)
(maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *memory*)
(let ((sorted (sort similarities #'> :key #'car))) (subseq sorted 0 (min top-k (length sorted))))))

4
src/event-orchestrator.lisp
View File

@@ -10,7 +10,7 @@
"Registers a function for a named hook. Triggers a Merkle snapshot."
(pushnew fn (gethash hook-name *hook-registry*))
(harness-log "ORCHESTRATOR - Registered hook function for ~a" hook-name)
(snapshot-object-store)
(snapshot-memory)
t)
(defun orchestrator-trigger-hook (hook-name &rest args)
@@ -24,7 +24,7 @@
"Schedules a task for execution. Schedule can be an interval (integer seconds) or 'heartbeat'."
(setf (gethash task-id *cron-registry*) (list :schedule schedule :fn fn :last-run 0))
(harness-log "ORCHESTRATOR - Scheduled task ~a (~a)" task-id schedule)
(snapshot-object-store)
(snapshot-memory)
t)
(defun orchestrator-process-cron ()

4
src/latent-reflection.lisp
View File

@@ -7,12 +7,12 @@
"Returns COUNT random objects from the object-store."
(let ((keys nil)
(selected nil))
(maphash (lambda (k v) (declare (ignore v)) (push k keys)) *object-store*)
(maphash (lambda (k v) (declare (ignore v)) (push k keys)) *memory*)
(let ((len (length keys)))
(when (> len 0)
(dotimes (i count)
(let* ((random-key (nth (random len) keys))
(obj (gethash random-key *object-store*)))
(obj (gethash random-key *memory*)))
(when obj
(push obj selected))))))
selected))

4
src/lisp-validator.lisp
View File

@@ -15,8 +15,8 @@
format concatenate string-downcase string-upcase search
;; Kernel specifics
org-agent::harness-log
org-agent::snapshot-object-store
org-agent::rollback-object-store
org-agent::snapshot-memory
org-agent::rollback-memory
org-agent::lookup-object
org-agent::list-objects-by-type
org-agent::ingest-ast

2
src/loop.lisp
View File

@@ -20,7 +20,7 @@
(setf current-signal (act-gate current-signal)))
(error (c)
(harness-log "METABOLISM CRASH: ~a - Initiating Micro-Rollback." c)
(rollback-object-store 0)
(rollback-memory 0)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)

24
src/object-store.lisp → src/memory.lisp
View File

@@ -1,6 +1,6 @@
(in-package :org-agent)
(defvar *object-store* (make-hash-table :test 'equal))
(defvar *memory* (make-hash-table :test 'equal))
(defvar *history-store* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
@@ -21,7 +21,7 @@
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
(defun ingest-ast (ast &optional parent-id)
"Parses an Org AST into the recursive Lisp Object Store with Merkle hashing."
"Parses an Org AST into the recursive Lisp Memory with Merkle hashing."
(let* ((type (getf ast :type))
(props (getf ast :properties))
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
@@ -51,7 +51,7 @@
:hash hash))))
(unless existing-obj
(setf (gethash hash *history-store*) obj))
(setf (gethash id *object-store*) obj)
(setf (gethash id *memory*) obj)
id)))
(defvar *object-store-snapshots* nil)
@@ -63,30 +63,30 @@
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
new-table))
(defun snapshot-object-store ()
(defun snapshot-memory ()
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
(let ((snapshot (copy-hash-table *object-store*)))
(let ((snapshot (copy-hash-table *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 Object Store snapshot created.")))
(harness-log "MEMORY - CoW Memory snapshot created.")))
(defun rollback-object-store (&optional (index 0))
"Restores the Object Store to a previously captured snapshot using immutable history pointers."
(defun rollback-memory (&optional (index 0))
"Restores the Memory 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)))
(harness-log "MEMORY - Object Store rolled back to snapshot ~a" index))
(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))))
(defun lookup-object (id)
"Retrieves an object from the store by its unique ID."
(gethash id *object-store*))
(gethash id *memory*))
(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*)
(maphash (lambda (id obj) (declare (ignore id)) (when (eq (org-object-type obj) type) (push obj results))) *memory*)
results))
(defun find-headline-missing-id (ast)

8
src/package.lisp
View File

@@ -13,11 +13,11 @@
#:harness-log
#:main
;; --- Object Store (CLOSOS) ---
;; --- Memory (CLOSOS) ---
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:*object-store*
#:*memory*
#:*history-store*
#:org-object
#:org-object-id
@@ -30,8 +30,8 @@
#:org-object-vector
#:org-object-content
#:org-object-hash
#:snapshot-object-store
#:rollback-object-store
#:snapshot-memory
#:rollback-memory
;; --- Context API (Peripheral Vision) ---
#:context-query-store

2
src/perceive.lisp
View File

@@ -24,7 +24,7 @@
(type (getf signal :type))
(sensor (getf payload :sensor)))
(harness-log "GATE [Perceive]: ~a (~a)" type (or sensor "no-sensor"))
(snapshot-object-store)
(snapshot-memory)
(cond ((eq type :EVENT)
(case sensor
(:buffer-update (let ((ast (getf payload :ast))) (when ast (ingest-ast ast))))

6
src/self-fix.lisp
View File

@@ -10,7 +10,7 @@
(is-skill (and (stringp (namestring target-file))
(search "skills/" (namestring target-file)))))
(org-agent:snapshot-object-store)
(org-agent:snapshot-memory)
(org-agent:harness-log "SELF-FIX - Attempting surgical fix on ~a..." target-file)
(handler-case
@@ -32,7 +32,7 @@
(org-agent:harness-log "SELF-FIX FAILURE - Skill reload failed. Rolling back.")
(with-open-file (out target-file :direction :output :if-exists :supersede)
(write-string content out))
(org-agent:rollback-object-store 0)
(org-agent:rollback-memory 0)
nil)))
(progn
(org-agent:harness-log "SELF-FIX SUCCESS - Applied fix to file.")
@@ -41,7 +41,7 @@
(progn (org-agent:harness-log "SELF-FIX FAILURE - File not found.") nil))
(error (c)
(org-agent:harness-log "SELF-FIX CRASH - ~a. Rolling back." c)
(org-agent:rollback-object-store 0)
(org-agent:rollback-memory 0)
nil))))
(def-cognitive-tool :repair-file

10
src/state-persistence.lisp
View File

@@ -18,8 +18,8 @@
*history-store*)
;; 2. Dump the current active pointers
(maphash (lambda (id obj)
(print `(setf (gethash ,id *object-store*) (gethash ,(org-object-hash obj) *history-store*)) out))
*object-store*))
(print `(setf (gethash ,id *memory*) (gethash ,(org-object-hash obj) *history-store*)) out))
*memory*))
t))
(defun persistence-load-local ()
@@ -50,7 +50,7 @@
(:last-sync . ,(org-object-last-sync obj))
(:hash . ,(org-object-hash obj)))
objects))
*object-store*)
*memory*)
objects))
(defun persistence-push-ipfs ()
@@ -76,7 +76,7 @@
(handler-case
(let* ((response (dex:post ipfs-url))
(data (cl-json:decode-json-from-string response)))
(clrhash *object-store*)
(clrhash *memory*)
(dolist (item data)
(let* ((id (cdr (assoc :id item)))
(obj (make-org-object
@@ -90,7 +90,7 @@
:version (cdr (assoc :version item))
:last-sync (cdr (assoc :last-sync item))
:hash (cdr (assoc :hash item)))))
(setf (gethash id *object-store*) obj)))
(setf (gethash id *memory*) obj)))
(harness-log "PERSISTENCE - Restored from IPFS: ~a" cid)
t)
(error (c)