352 lines
16 KiB
Org Mode
352 lines
16 KiB
Org Mode
#+TITLE: Context API (context.lisp)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :harness:context:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle ../lisp/core-context.lisp
|
|
|
|
* Overview: Architectural Intent
|
|
|
|
The Context API implements the Foveal-Peripheral awareness model. When the agent thinks, it doesn't dump everything it knows into the LLM's context window — that would saturate the token budget immediately. Instead, it builds a skeletal outline of the entire Memex and only shows full detail for the current focus.
|
|
|
|
This mirrors human attention: you are aware of your entire apartment (peripheral vision), but you only see the book in front of you in detail (foveal vision).
|
|
|
|
** The Foveal-Peripheral Model
|
|
|
|
Three factors determine how much detail an object gets:
|
|
|
|
1. **Depth** — objects within 2 levels of the root get full outline (title + ID). Deeper objects are summarized or omitted.
|
|
2. **Foveal focus** — the object the user is currently interacting with gets full content rendered.
|
|
3. **Semantic similarity** — objects whose vector embedding is similar to the current foveal focus get promoted from peripheral to foveal detail.
|
|
|
|
** Why Not Just Dump Everything?
|
|
|
|
A naive implementation that serializes every ~org-object~ to text would produce hundreds of thousands of tokens for a typical knowledge base. The LLM would spend its attention budget on noise, not signal. The Foveal-Peripheral model preserves the signal (the current task and related information) while reducing noise (everything else).
|
|
|
|
The semantic threshold is configurable via ~CONTEXT_SEMANTIC_THRESHOLD~ env var (default 0.75). Lower values include more peripherally related content; higher values restrict to tightly related content.
|
|
|
|
** Contract
|
|
|
|
1. (context-awareness-assemble &optional signal): produces a skeletal
|
|
outline of current Memory for the LLM. If ~:foveal-focus~ is set,
|
|
the foveal node gets inline rendering; peripheral nodes get title-only.
|
|
Privacy-filtered objects are excluded.
|
|
2. (context-assemble-global-awareness): zero-arg wrapper — calls
|
|
~context-awareness-assemble~ without foveal focus.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :passepartout)
|
|
#+end_src
|
|
|
|
** Memory Query (context-query)
|
|
|
|
Filters the Memory store by tag, TODO state, or object type. This is the primary retrieval function used by skills to find relevant information.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-query (&key tag todo-state type scope)
|
|
"Filters the Memory based on tags, todo states, or types.
|
|
Optional SCOPE restricts results to objects with that scope
|
|
or :memex (global scope always visible)."
|
|
(let ((results nil))
|
|
(maphash (lambda (id obj)
|
|
(declare (ignore id))
|
|
(let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
|
;; Scope filter: if scope specified, only match :memex (global) or same scope
|
|
(when (and scope (not (eq (memory-object-scope obj) :memex))
|
|
(not (eq (memory-object-scope obj) scope)))
|
|
(setf match nil))
|
|
(when (and type (not (eq (memory-object-type obj) type))) (setf match nil))
|
|
(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))))
|
|
*memory-store*)
|
|
results))
|
|
#+end_src
|
|
|
|
** Active Projects (context-active-projects)
|
|
|
|
Returns headlines tagged as ~project~ that are not yet DONE. Used by the global awareness function to build the task overview.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-active-projects ()
|
|
"Returns headlines tagged as 'project' that are not yet marked DONE."
|
|
(remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE"))
|
|
(context-query :tag "project" :type :HEADLINE)))
|
|
#+end_src
|
|
|
|
** Completed Tasks (context-recent-tasks)
|
|
|
|
Retrieves recently finished tasks from the store. Used by the Scribe and Gardener for journal summarization.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-recent-tasks ()
|
|
"Retrieves recently finished tasks from the store."
|
|
(context-query :todo-state "DONE" :type :HEADLINE))
|
|
#+end_src
|
|
|
|
** Capability Discovery (context-skill-list)
|
|
|
|
Provides a sorted overview of currently loaded system capabilities. Each entry includes the skill name, priority, and dependencies.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-skill-list ()
|
|
"Provides a sorted overview of currently loaded system capabilities."
|
|
(let ((results nil))
|
|
(maphash (lambda (name skill)
|
|
(declare (ignore name))
|
|
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
|
|
*skill-registry*)
|
|
(sort results #'> :key (lambda (x) (getf x :priority)))))
|
|
#+end_src
|
|
|
|
** Skill Source Inspection (context-skill-source)
|
|
|
|
Reads the raw literate source of a specific skill for inspection. Used when the agent needs to understand or modify its own code.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-skill-source (skill-name)
|
|
"Reads the raw literate source of a specific skill for inspection."
|
|
(let* ((filename (format nil "~a.org" skill-name))
|
|
(data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
|
|
(org-dir (merge-pathnames "org/" data-dir))
|
|
(full-path (merge-pathnames filename org-dir)))
|
|
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
|
|
#+end_src
|
|
|
|
** Subtree Skill Source (context-skill-subtree)
|
|
|
|
Returns a specific headline subtree from a skill's Org file. Delegates to
|
|
=org-subtree-extract= in the =programming-org= skill for actual parsing.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-skill-subtree (skill-name heading-name)
|
|
"Reads a specific headline subtree from a skill's Org source file.
|
|
Returns the content under HEADING-NAME (including children) as a string,
|
|
or nil if the heading is not found."
|
|
(let ((full-source (context-skill-source skill-name)))
|
|
(unless full-source (return-from context-skill-subtree nil))
|
|
(if (fboundp 'org-subtree-extract)
|
|
(org-subtree-extract full-source heading-name)
|
|
;; Fallback: no org-subtree-extract available, return full source
|
|
full-source)))
|
|
#+end_src
|
|
|
|
** Harness Logs (context-logs)
|
|
|
|
Retrieves the most recent lines from the harness's internal log buffer. The log limit is configurable via ~CONTEXT_LOG_LIMIT~ env var (default 20).
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-logs (&optional limit)
|
|
"Retrieves the most recent lines from the harness's internal log."
|
|
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
|
|
(bt:with-lock-held (*log-lock*)
|
|
(let ((count (min log-limit (length *log-buffer*))))
|
|
(subseq *log-buffer* 0 count)))))
|
|
#+end_src
|
|
|
|
** Backward-Compatibility Alias (context-get-system-logs)
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun context-get-system-logs (&optional limit)
|
|
"Backward-compatibility alias for context-logs."
|
|
(context-logs limit))
|
|
#+end_src
|
|
|
|
** AST to Org Rendering (context-object-render)
|
|
|
|
Recursively renders an ~org-object~ and its children to an Org-mode string, applying the Foveal-Peripheral model:
|
|
|
|
- Objects within depth 2 are always included (outline)
|
|
- The foveal object (the one the user is looking at) is always included with full content
|
|
- Objects with semantic similarity above the threshold are included with full content
|
|
- All other objects are omitted silently
|
|
|
|
This function is the heart of the context assembly. Its performance directly affects the agent's response time.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
|
|
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
|
|
(let* ((id (memory-object-id obj))
|
|
(is-foveal (equal id foveal-id))
|
|
(title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
|
|
(content (memory-object-content obj))
|
|
(children (memory-object-children obj))
|
|
(stars (make-string depth :initial-element #\*))
|
|
(obj-vector (memory-object-vector obj))
|
|
(threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
|
|
(similarity (if (and foveal-vector obj-vector (not is-foveal))
|
|
(vector-cosine-similarity foveal-vector obj-vector)
|
|
0.0))
|
|
(is-semantically-relevant (>= similarity threshold))
|
|
(should-render (or (<= depth 2) is-foveal is-semantically-relevant))
|
|
(output ""))
|
|
|
|
(when should-render
|
|
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
|
|
(when is-semantically-relevant
|
|
(setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
|
|
(setf output (concatenate 'string output (format nil ":END:~%")))
|
|
|
|
(when (and content (or is-foveal is-semantically-relevant))
|
|
(setf output (concatenate 'string output content (string #\Newline))))
|
|
|
|
(dolist (child-id children)
|
|
(let ((child-obj (memory-object-get child-id)))
|
|
(when child-obj
|
|
(let ((next-foveal (if is-foveal child-id foveal-id)))
|
|
(setf output (concatenate 'string output
|
|
(context-object-render child-obj
|
|
:depth (1+ depth)
|
|
:foveal-id next-foveal
|
|
:semantic-threshold threshold
|
|
:foveal-vector foveal-vector))))))))
|
|
output))
|
|
#+end_src
|
|
|
|
** Path Resolution (context-path-resolve)
|
|
|
|
Expands environment variables in a path string and strips quotes. Used to resolve configurable paths from ~.env~.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-path-resolve (path-string)
|
|
"Expands environment variables and strips literal quotes from a path string."
|
|
(let ((path (if (stringp path-string)
|
|
(string-trim '(#\" #\' #\Space) path-string)
|
|
path-string)))
|
|
(if (and (stringp path) (search "$" path))
|
|
(let ((result path))
|
|
(ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
|
|
(let ((var-val (uiop:getenv var-name)))
|
|
(when var-val
|
|
(setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
|
|
result)
|
|
path)))
|
|
#+end_src
|
|
|
|
** Privacy Filter for Context Assembly
|
|
|
|
Checks if an org-object has tags matching the Bouncer's ~bouncer-privacy-tags~. Objects with matching tags are excluded from the LLM's context window. This prevents private content tagged with ~@personal~ (or any user-configured privacy tag) from being included in prompts sent to external LLM providers.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-privacy-filtered-p (obj)
|
|
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
|
|
(let* ((attrs (memory-object-attributes obj))
|
|
(tags (getf attrs :TAGS))
|
|
(privacy-tags (and (find-package :passepartout.security-dispatcher)
|
|
(symbol-value
|
|
(find-symbol "BOUNCER-PRIVACY-TAGS"
|
|
:passepartout.security-dispatcher)))))
|
|
(when (and tags privacy-tags)
|
|
(let ((tag-list (if (listp tags) tags (list tags))))
|
|
(some (lambda (tag)
|
|
(some (lambda (private)
|
|
(string-equal (string-trim '(#\:) tag)
|
|
(string-trim '(#\:) private)))
|
|
privacy-tags))
|
|
tag-list)))))
|
|
#+end_src
|
|
|
|
** Global Awareness (context-awareness-assemble)
|
|
|
|
Produces the high-level skeletal outline of the current Memory that is included in every LLM call. This is the "peripheral vision" of the agent — it knows what projects exist, their titles and IDs, but not their full content.
|
|
|
|
Privacy-filtered projects (those with tags matching ~bouncer-privacy-tags~) are excluded from the output.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T13:00:00
|
|
#+begin_src lisp
|
|
(defun context-awareness-assemble (&optional signal)
|
|
"Produces a high-level skeletal outline of the current Memory for the LLM.
|
|
Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
|
|
(let* ((foveal-id (or (getf signal :foveal-focus)
|
|
(ignore-errors (getf (getf signal :payload) :target-id))))
|
|
(all-projects (context-active-projects))
|
|
(projects (remove-if #'context-privacy-filtered-p all-projects))
|
|
(output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
|
|
(if projects
|
|
(dolist (project projects)
|
|
(setf output (concatenate 'string output
|
|
(context-object-render project :foveal-id foveal-id))))
|
|
(setf output (concatenate 'string output "No active projects found.~%")))
|
|
output))
|
|
#+end_src
|
|
|
|
** Backward-Compatibility Alias
|
|
|
|
The global awareness function was renamed from ~context-assemble-global-awareness~
|
|
to ~context-awareness-assemble~.
|
|
|
|
;; REPL-VERIFIED: 2026-05-03T14:00:00
|
|
#+begin_src lisp
|
|
(defun context-assemble-global-awareness ()
|
|
(context-awareness-assemble))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
Verifies that the Foveal-Peripheral rendering correctly distinguishes between foveal (detailed) and peripheral (outline) content, and that the awareness budget includes all active projects.
|
|
#+begin_src lisp :tangle ../lisp/core-context.lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :passepartout-peripheral-vision-tests
|
|
(:use :cl :fiveam :passepartout)
|
|
(:export #:vision-suite))
|
|
(in-package :passepartout-peripheral-vision-tests)
|
|
|
|
(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
|
|
(in-suite vision-suite)
|
|
|
|
(test test-foveal-rendering
|
|
"Contract 1: foveal content inline, peripheral content title-only."
|
|
(clrhash passepartout::*memory-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-awareness-assemble (list :foveal-focus "node-foveal"))))
|
|
(is (search "FOVEAL CONTENT" output))
|
|
(is (search "* Peripheral Node" output))
|
|
(is (not (search "PERIPHERAL CONTENT" output))))))
|
|
|
|
(test test-awareness-budget
|
|
"Contract 1: all active projects appear in awareness output."
|
|
(clrhash passepartout::*memory-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-awareness-assemble)))
|
|
(is (search "Project 1" output))
|
|
(is (search "Project 2" output))))
|
|
|
|
(test test-context-empty-memory
|
|
"Contract 1: empty memory produces clean output without error."
|
|
(clrhash passepartout::*memory-store*)
|
|
(let ((output (context-awareness-assemble)))
|
|
(is (stringp output))
|
|
(is (search "MEMEX" output :test #'char-equal))))
|
|
|
|
(test test-context-no-foveal-focus
|
|
"Contract 2: without foveal focus, no inline content appears."
|
|
(clrhash passepartout::*memory-store*)
|
|
(let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
|
|
:contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
|
|
:raw-content "CHILD CONTENT" :contents nil)))))
|
|
(ingest-ast ast)
|
|
(let ((output (context-awareness-assemble nil)))
|
|
(is (stringp output))
|
|
(is (not (search "CHILD CONTENT" output))))))
|
|
#+end_src
|