From 13d660c3e9f4517b3136d725bfe1f188b8ff3544 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Thu, 9 Apr 2026 14:31:00 -0400 Subject: [PATCH] feat: implement Foveal-Peripheral vision model and Org renderer --- literate/context.org | 90 +++++++++++++++++++++++------- literate/system-definition.org | 2 + org-agent.asd | 2 + src/context.lisp | 50 +++++++++++------ src/embedding.lisp | 10 +++- tests/peripheral-vision-tests.lisp | 32 +++++++++++ 6 files changed, 147 insertions(+), 39 deletions(-) create mode 100644 tests/peripheral-vision-tests.lisp diff --git a/literate/context.org b/literate/context.org index 563122f..93425cd 100644 --- a/literate/context.org +++ b/literate/context.org @@ -80,7 +80,7 @@ Reads the raw literate source of a specific skill. This is crucial for "System 2 #+end_src ** Kernel Logs (context-get-system-logs) -Retrieves the most recent system logs, providing temporal context to the LLM. +Retrieves the most recent lines from the kernel's internal log. #+begin_src lisp :tangle ../src/context.lisp (defun context-get-system-logs (&optional (limit 20)) @@ -98,19 +98,33 @@ Provides execution stats for a specific skill. (bt:with-lock-held (*telemetry-lock*) (gethash (string-downcase skill-name) *skill-telemetry*))) #+end_src -** Sparse Trees (context-filter-sparse-tree) -Prunes the Org AST to show only specific nodes and their ancestors, creating a "skeleton" view that fits within LLM context limits. +** AST to Org Rendering (context-render-to-org) +Transforms the internal Object Store structures back into a human-readable (and LLM-readable) Org-mode string. It supports depth-based indentation and content suppression for peripheral nodes. #+begin_src lisp :tangle ../src/context.lisp -(defun context-filter-sparse-tree (ast predicate) - "Prunes an AST to show only nodes matching a predicate and their ancestors." - (if (listp ast) - (let* ((contents (getf ast :contents)) - (filtered-contents (remove-if #'null (mapcar (lambda (c) (context-filter-sparse-tree c predicate)) contents)))) - (if (or (funcall predicate ast) (not (null filtered-contents))) - (let ((new-ast (copy-list ast))) (setf (getf new-ast :contents) filtered-contents) new-ast) - nil)) - nil)) +(defun context-render-to-org (obj &key (depth 1) (foveal-id nil)) + "Recursively renders an org-object and its children to an Org string." + (let* ((is-foveal (equal (org-object-id obj) foveal-id)) + (title (or (getf (org-object-attributes obj) :TITLE) "Untitled")) + (id (org-object-id obj)) + (content (org-object-content obj)) + (children (org-object-children obj)) + (stars (make-string depth :initial-element #\*)) + (output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%:END:~%" stars title id))) + + ;; Only include content if this is the foveal focus + (when (and is-foveal content) + (setf output (concatenate 'string output content (string #\Newline)))) + + ;; Recursively render children + (dolist (child-id children) + (let ((child-obj (lookup-object child-id))) + (when child-obj + (setf output (concatenate 'string output + (context-render-to-org child-obj + :depth (1+ depth) + :foveal-id foveal-id)))))) + output)) #+end_src ** Path Resolution (context-resolve-path) @@ -130,20 +144,20 @@ Expands environment variables (like `$HOME`) within path strings. #+end_src ** Global Awareness (context-assemble-global-awareness) -The primary "peripheral vision" generator. It produces the skeletal overview of the Memex that is prepended to LLM prompts. +The primary context generator. It identifies active projects and the current foveal focus, then assembles a pruned Org-mode view of the Memex. #+begin_src lisp :tangle ../src/context.lisp -(defun context-assemble-global-awareness () +(defun context-assemble-global-awareness (&optional signal) "Produces a high-level skeletal outline of the current Object Store for the LLM." - (let ((projects (context-get-active-projects)) - (output "GLOBAL MEMEX AWARENESS (Peripheral Vision): + (let* ((payload (when signal (getf signal :payload))) + (foveal-id (when payload (getf payload :target-id))) + (projects (context-get-active-projects)) + (output "GLOBAL MEMEX AWARENESS (Peripheral Vision): ")) (if projects (dolist (project projects) (setf output (concatenate 'string output - (format nil "- PROJECT: ~a (ID: ~a)~%" - (getf (org-object-attributes project) :TITLE) - (org-object-id project))))) + (context-render-to-org project :foveal-id foveal-id)))) (setf output (concatenate 'string output "No active projects found.~%"))) output)) #+end_src @@ -205,3 +219,41 @@ Identifies the top-k most semantically related objects in the entire store by co (maphash (lambda (id obj) (let ((vec (org-object-vector obj))) (when vec (push (cons (cosine-similarity query-vector vec) obj) similarities)))) *object-store*) (let ((sorted (sort similarities #'> :key #'car))) (subseq sorted 0 (min top-k (length sorted)))))) #+end_src + +* Phase E: Chaos (Verification) +Verification of the peripheral vision extraction and rendering logic. + +#+begin_src lisp :tangle ../tests/peripheral-vision-tests.lisp +(defpackage :org-agent-peripheral-vision-tests + (:use :cl :fiveam :org-agent)) +(in-package :org-agent-peripheral-vision-tests) + +(def-suite vision-suite + :description "Verification of Foveal-Peripheral context model.") +(in-suite vision-suite) + +(test test-foveal-rendering + "Verify that the foveal target is rendered with content, while siblings are skeletal." + (clrhash org-agent::*object-store*) + (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project") + :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node") + :raw-content "FOVEAL CONTENT" :contents nil) + (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node") + :raw-content "PERIPHERAL CONTENT" :contents nil))))) + (ingest-ast ast) + (let ((output (context-assemble-global-awareness (list :payload (list :target-id "node-foveal"))))) + ;; Foveal node should have its content + (is (search "FOVEAL CONTENT" output)) + ;; Peripheral node should be skeletal (only title/ID) + (is (search "* Peripheral Node" output)) + (is (not (search "PERIPHERAL CONTENT" output)))))) + +(test test-awareness-budget + "Verify that context-assemble-global-awareness handles multiple projects." + (clrhash org-agent::*object-store*) + (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil)) + (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil)) + (let ((output (context-assemble-global-awareness))) + (is (search "Project 1" output)) + (is (search "Project 2" output)))) +#+end_src diff --git a/literate/system-definition.org b/literate/system-definition.org index 7d99462..61103f6 100644 --- a/literate/system-definition.org +++ b/literate/system-definition.org @@ -33,6 +33,7 @@ :components ((:module "tests" :components ((:file "oacp-tests") (:file "pipeline-tests") + (:file "peripheral-vision-tests") (:file "boot-sequence-tests") (:file "object-store-tests") (:file "immune-system-tests") @@ -40,6 +41,7 @@ :perform (test-op (o s) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :oacp-suite :org-agent-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests)) + (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests)) diff --git a/org-agent.asd b/org-agent.asd index cf41f7d..1d97d9f 100644 --- a/org-agent.asd +++ b/org-agent.asd @@ -26,6 +26,7 @@ :components ((:module "tests" :components ((:file "oacp-tests") (:file "pipeline-tests") + (:file "peripheral-vision-tests") (:file "boot-sequence-tests") (:file "object-store-tests") (:file "immune-system-tests") @@ -33,6 +34,7 @@ :perform (test-op (o s) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :oacp-suite :org-agent-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :org-agent-pipeline-tests)) + (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :vision-suite :org-agent-peripheral-vision-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :org-agent-boot-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :object-store-suite :org-agent-object-store-tests)) (uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :org-agent-immune-system-tests)) diff --git a/src/context.lisp b/src/context.lisp index 16a4e88..ad77e6f 100644 --- a/src/context.lisp +++ b/src/context.lisp @@ -18,9 +18,11 @@ (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE")) (context-query-store :tag "project" :type :HEADLINE))) -(defun context-get-recent-completed-tasks () (context-query-store :todo-state "DONE" :type :HEADLINE)) +(defun context-get-recent-completed-tasks () "Retrieves recently finished tasks from the store." - (defun context-list-all-skills () + (context-query-store :todo-state "DONE" :type :HEADLINE)) + +(defun context-list-all-skills () "Provides a sorted overview of currently loaded system capabilities." (let ((results nil)) (maphash (lambda (name skill) @@ -45,15 +47,29 @@ "Returns performance and execution data for a specific skill." (bt:with-lock-held (*telemetry-lock*) (gethash (string-downcase skill-name) *skill-telemetry*))) -(defun context-filter-sparse-tree (ast predicate) - "Prunes an AST to show only nodes matching a predicate and their ancestors." - (if (listp ast) - (let* ((contents (getf ast :contents)) - (filtered-contents (remove-if #'null (mapcar (lambda (c) (context-filter-sparse-tree c predicate)) contents)))) - (if (or (funcall predicate ast) (not (null filtered-contents))) - (let ((new-ast (copy-list ast))) (setf (getf new-ast :contents) filtered-contents) new-ast) - nil)) - nil)) +(defun context-render-to-org (obj &key (depth 1) (foveal-id nil)) + "Recursively renders an org-object and its children to an Org string." + (let* ((is-foveal (equal (org-object-id obj) foveal-id)) + (title (or (getf (org-object-attributes obj) :TITLE) "Untitled")) + (id (org-object-id obj)) + (content (org-object-content obj)) + (children (org-object-children obj)) + (stars (make-string depth :initial-element #\*)) + (output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%:END:~%" stars title id))) + + ;; Only include content if this is the foveal focus + (when (and is-foveal content) + (setf output (concatenate 'string output content (string #\Newline)))) + + ;; Recursively render children + (dolist (child-id children) + (let ((child-obj (lookup-object child-id))) + (when child-obj + (setf output (concatenate 'string output + (context-render-to-org child-obj + :depth (1+ depth) + :foveal-id foveal-id)))))) + output)) (defun context-resolve-path (path-string) "Expands environment variables within path strings (e.g. $HOME/...)." @@ -66,16 +82,16 @@ path-string)) path-string)) -(defun context-assemble-global-awareness () +(defun context-assemble-global-awareness (&optional signal) "Produces a high-level skeletal outline of the current Object Store for the LLM." - (let ((projects (context-get-active-projects)) - (output "GLOBAL MEMEX AWARENESS (Peripheral Vision): + (let* ((payload (when signal (getf signal :payload))) + (foveal-id (when payload (getf payload :target-id))) + (projects (context-get-active-projects)) + (output "GLOBAL MEMEX AWARENESS (Peripheral Vision): ")) (if projects (dolist (project projects) (setf output (concatenate 'string output - (format nil "- PROJECT: ~a (ID: ~a)~%" - (getf (org-object-attributes project) :TITLE) - (org-object-id project))))) + (context-render-to-org project :foveal-id foveal-id)))) (setf output (concatenate 'string output "No active projects found.~%"))) output)) diff --git a/src/embedding.lisp b/src/embedding.lisp index 6970589..ab22eee 100644 --- a/src/embedding.lisp +++ b/src/embedding.lisp @@ -12,11 +12,15 @@ (cdr (assoc :values (cdr (assoc :embedding json))))) (error (c) (kernel-log "EMBEDDING FAILURE: ~a" c) nil))))) -(defun dot-product (v1 v2) (reduce #'+ (mapcar #'* v1 v2))) +(defun dot-product (v1 v2) "Calculates the dot product of two numerical vectors." - (defun magnitude (v) (sqrt (reduce #'+ (mapcar (lambda (x) (* x x)) v)))) + (reduce #'+ (mapcar #'* v1 v2))) + +(defun magnitude (v) "Calculates the Euclidean magnitude of a numerical vector." - (defun cosine-similarity (v1 v2) + (sqrt (reduce #'+ (mapcar (lambda (x) (* x x)) v)))) + +(defun cosine-similarity (v1 v2) "Calculates the semantic distance between two vectors." (let ((m1 (magnitude v1)) (m2 (magnitude v2))) (if (or (zerop m1) (zerop m2)) 0 (/ (dot-product v1 v2) (* m1 m2))))) diff --git a/tests/peripheral-vision-tests.lisp b/tests/peripheral-vision-tests.lisp new file mode 100644 index 0000000..80802de --- /dev/null +++ b/tests/peripheral-vision-tests.lisp @@ -0,0 +1,32 @@ +(defpackage :org-agent-peripheral-vision-tests + (:use :cl :fiveam :org-agent)) +(in-package :org-agent-peripheral-vision-tests) + +(def-suite vision-suite + :description "Verification of Foveal-Peripheral context model.") +(in-suite vision-suite) + +(test test-foveal-rendering + "Verify that the foveal target is rendered with content, while siblings are skeletal." + (clrhash org-agent::*object-store*) + (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project") + :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node") + :raw-content "FOVEAL CONTENT" :contents nil) + (:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node") + :raw-content "PERIPHERAL CONTENT" :contents nil))))) + (ingest-ast ast) + (let ((output (context-assemble-global-awareness (list :payload (list :target-id "node-foveal"))))) + ;; Foveal node should have its content + (is (search "FOVEAL CONTENT" output)) + ;; Peripheral node should be skeletal (only title/ID) + (is (search "* Peripheral Node" output)) + (is (not (search "PERIPHERAL CONTENT" output)))))) + +(test test-awareness-budget + "Verify that context-assemble-global-awareness handles multiple projects." + (clrhash org-agent::*object-store*) + (ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil)) + (ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil)) + (let ((output (context-assemble-global-awareness))) + (is (search "Project 1" output)) + (is (search "Project 2" output))))