Context API (context.lisp)

Overview
Implementation
Test Suite

Overview

The Context API (Peripheral Vision) provides the opencortex with the ability to selectively prune and present its memory to the LLM. It implements a Foveal-Peripheral model, where the current task is shown in high detail (foveal), while the broader Memex structure is shown as a skeletal outline (peripheral).

Implementation

Package Context

(in-package :opencortex)

Memory Query (context-query-store)

(defun context-query-store (&key tag todo-state type)
  "Filters the Memory based on tags, todo states, or types."
  (let ((results nil))
    (maphash (lambda (id obj)
               (declare (ignore id))
               (let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
                 (when (and type (not (eq (org-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*)
    results))

Active Projects (context-get-active-projects)

(defun context-get-active-projects ()
  "Returns headlines tagged as 'project' that are not yet marked DONE."
  (remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE)
             (context-query-store :tag "project" :type :HEADLINE)))

Completed Tasks (context-get-recent-completed-tasks)

(defun context-get-recent-completed-tasks () 
  "Retrieves recently finished tasks from the store."
  (context-query-store :todo-state "DONE" :type :HEADLINE))

Capability Discovery (context-list-all-skills)

(defun context-list-all-skills ()
  "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))
             *skills-registry*)
    (sort results #'> :key (lambda (x) (getf x :priority)))))

Skill Inspection (context-get-skill-source)

(defun context-get-skill-source (skill-name)
  "Reads the raw literate source of a specific skill for inspection."
  (let* ((filename (format nil "~a.org" skill-name))
         (skills-dir-str (or (uiop:getenv "SKILLS_DIR") (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))
         (skills-dir (uiop:ensure-directory-pathname (context-resolve-path skills-dir-str)))
         (full-path (merge-pathnames filename skills-dir)))
    (if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))

Harness Logs (context-get-system-logs)

(defun context-get-system-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 (*logs-lock*)
      (let ((count (min log-limit (length *system-logs*)))) 
        (subseq *system-logs* 0 count)))))

AST to Org Rendering (context-render-to-org)

(defun context-render-to-org (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 (org-object-id obj))
         (is-foveal (equal id foveal-id))
         (title (or (getf (org-object-attributes obj) :TITLE) "Untitled)
         (content (org-object-content obj))
         (children (org-object-children obj))
         (stars (make-string depth :initial-element #\*))
         (obj-vector (org-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))
                         (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 (lookup-object child-id)))
          (when child-obj
            (let ((next-foveal (if is-foveal child-id foveal-id)))
              (setf output (concatenate 'string output 
                                        (context-render-to-org child-obj 
                                                               :depth (1+ depth) 
                                                               :foveal-id next-foveal
                                                               :semantic-threshold threshold
                                                               :foveal-vector foveal-vector))))))))
    output))

Path Resolution (context-resolve-path)

(defun context-resolve-path (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)))

Global Awareness (context-assemble-global-awareness)

(defun context-assemble-global-awareness (&optional signal)
  "Produces a high-level skeletal outline of the current Memory for the LLM."
  (let* ((foveal-id (or (getf signal :foveal-focus) 
                        (ignore-errors (getf (getf signal :payload) :target-id))))
         (projects (context-get-active-projects))
         (output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%))
    (if projects
        (dolist (project projects)
          (setf output (concatenate 'string output
                                    (context-render-to-org project :foveal-id foveal-id))))
        (setf output (concatenate 'string output "No active projects found.~%))
    output))

Test Suite

(defpackage :opencortex-peripheral-vision-tests
  (:use :cl :fiveam :opencortex)
  (:export #:vision-suite))
(in-package :opencortex-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 opencortex::*memory*)
  (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 :foveal-focus "node-foveal)))
      (is (search "FOVEAL CONTENT" output))
      (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 opencortex::*memory*)
  (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))))

8.6 KiB Raw Blame History