From 529f8d0782d99f62f6785dcbbeb16ed02ed36c7d Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Sun, 3 May 2026 12:08:04 -0400 Subject: [PATCH] =?UTF-8?q?feat:=20Context=20Manager=20skill=20+=20org-obj?= =?UTF-8?q?ect=E2=86=92memory-object=20fix?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit - system-context-manager (new skill): stack-based project focusing with push-context/pop-context, path resolution relative to base path, and scope-aware memory queries via context-scoped-query. - core-memory: add :scope slot to memory-object struct (default :memex). - core-memory: ingest-ast accepts &key (scope :memex), propagates to children. - core-context: context-query accepts :scope parameter for filtering. - DEFECT FIX: renamed org-object-* accessors to memory-object-* across core-context, security-dispatcher, tests, and defpackage exports. The struct was renamed but accessor references were never updated — the code referenced nonexistent functions. --- docs/ROADMAP.org | 99 +++++++++--------- lisp/core-context.lisp | 30 +++--- lisp/core-defpackage.lisp | 27 ++--- lisp/core-memory.lisp | 11 +- lisp/security-dispatcher.lisp | 6 +- lisp/system-context-manager.lisp | 118 +++++++++++++++++++++ org/core-context.org | 30 +++--- org/core-defpackage.org | 27 ++--- org/core-memory.org | 12 ++- org/security-dispatcher.org | 6 +- org/system-context-manager.org | 170 +++++++++++++++++++++++++++++++ 11 files changed, 417 insertions(+), 119 deletions(-) create mode 100644 lisp/system-context-manager.lisp create mode 100644 org/system-context-manager.org diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index a0da21a..a82e386 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -182,14 +182,12 @@ The "Brain" meets the "Machine." Standardization and professionalization of the Unified control plane and Human-in-the-Loop state management. -** Tasks - -*** Remediation: Backfill v0.1.0/v0.2.0 Gaps +**** Remediation: Backfill v0.1.0/v0.2.0 Gaps These features were marked DONE in prior versions but are stubs, no-ops, or missing. They must be completed before v0.3.0 feature work proceeds. -**** DONE P0: Add vault-get-secret / vault-set-secret wrappers :backfill: +***** DONE P0: Add vault-get-secret / vault-set-secret wrappers :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-vault-secret-wrappers @@ -203,7 +201,7 @@ and called from =gateway-manager.org= (lines 36, 86, 180) but never defined. =gateway-link= crashes at runtime. Add one-line wrappers in =security-vault.org= that delegate to the existing =vault-get=/=vault-set= with ~:type :secret~. -**** DONE P0: system-archivist — Scribe + Gardener :backfill: +***** DONE P0: system-archivist — Scribe + Gardener :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-archivist-distillation @@ -217,7 +215,7 @@ Gardener: scan for broken =[[file:]]= links and orphaned =memory-object= entries Wire both as cron jobs via =system-event-orchestrator=. Depends on: orchestrator bootstrap (P1 item below). -**** DONE P0: system-self-improve — surgical edit + error fix :backfill: +***** DONE P0: system-self-improve — surgical edit + error fix :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-self-improve-real @@ -233,7 +231,7 @@ CLOSED: [2026-05-03 Sun 10:42] Remove the dead first =defskill= registration (trigger nil, overwritten by second). Depends on: =programming-org=, =programming-literate= (P0 items below). -**** DONE P0: programming-org — fix org-modify + org-ast-render :backfill: +***** DONE P0: programming-org — fix org-modify + org-ast-render :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-org-modify-render @@ -247,7 +245,7 @@ node by ID in file and apply changes to its content. =org-ast-render(ast)= returns a hardcoded placeholder. Should convert plist AST back to Org text. -**** DONE P0: programming-literate — fix both stubs :backfill: +***** DONE P0: programming-literate — fix both stubs :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-literate-real @@ -260,7 +258,7 @@ CLOSED: [2026-05-03 Sun 10:42] have balanced parentheses. Returns T if all balanced, error message otherwise. =literate-tangle-sync-check=: verify =.lisp= file matches tangled output of =.org= file. -**** DONE P1: system-event-orchestrator — bootstrap implementation :backfill: +***** DONE P1: system-event-orchestrator — bootstrap implementation :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-orchestrator-bootstrap @@ -273,7 +271,7 @@ CLOSED: [2026-05-03 Sun 10:42] and =#+CRON:= properties and register them via the existing registries. Prerequisite for archivist cron jobs. -**** DONE P1: system-memory — memory introspection :backfill: +***** DONE P1: system-memory — memory introspection :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-memory-inspect @@ -286,7 +284,7 @@ CLOSED: [2026-05-03 Sun 10:42] by type, TODO state distribution, orphan count, snapshot list. Trigger on =:INTROSPECTION= sensor type. -**** DONE P1: Path relic — skills/ → lisp/ in skill-initialize-all :backfill: +***** DONE P1: Path relic — skills/ → lisp/ in skill-initialize-all :backfill: CLOSED: [2026-05-03 Sun 10:42] :PROPERTIES: :ID: id-path-relic @@ -299,7 +297,7 @@ CLOSED: [2026-05-03 Sun 10:42] under =$PASSEPARTOUT_DATA_DIR=. Core and skills were merged into =lisp/=. Update both functions to point at =lisp/=. -**** DONE P2: core-context — semantic retrieval (embeddings) :backfill: +***** DONE P2: core-context — semantic retrieval (embeddings) :backfill: CLOSED: [2026-05-03 Sun 11:42] :PROPERTIES: :ID: id-embeddings @@ -312,7 +310,7 @@ CLOSED: [2026-05-03 Sun 11:42] embeddings via Ollama =nomic-embed-text= at ingest time. Store in =memory-object.vector=. Fallback: TF-IDF bag-of-words. -**** DONE P2: core-context — subtree-based skill source loading :backfill: +***** DONE P2: core-context — subtree-based skill source loading :backfill: CLOSED: [2026-05-03 Sun 11:42] :PROPERTIES: :ID: id-skill-subtree @@ -324,7 +322,7 @@ CLOSED: [2026-05-03 Sun 11:42] =context-skill-source= reads entire Org files. Add =context-skill-subtree= for targeted retrieval of specific function docs or test blocks by heading name. -**** DONE P3: Variable name drift normalization (out of scope for now) :backfill: +***** DONE P3: Variable name drift normalization (out of scope for now) :backfill: CLOSED: [2026-05-03 Sun 11:50] :PROPERTIES: :ID: id-name-normalization @@ -338,7 +336,7 @@ underscore (reason/context) vs =*skill-registry*= with hyphen (defpackage). Normalization pass across all modules. Touches every file — do after P0-P2 are stable. Do not mix with functional changes. -*** DONE Project Renaming (Bouncer → Dispatcher) +**** DONE Project Renaming (Bouncer → Dispatcher) :PROPERTIES: :ID: id-9e779580-287b-b3d1-37b9-bcefd750bf9e :CREATED: [2026-05-01 Fri 15:40] @@ -348,7 +346,7 @@ are stable. Do not mix with functional changes. :END: The Dispatcher's role has evolved beyond security guard. It is the seed of the deterministic engine — it learns to execute procedures without invoking the neural net. -*** DONE Event Orchestrator (unified hooks+cron+routing) +**** DONE Event Orchestrator (unified hooks+cron+routing) :PROPERTIES: :ID: id-d35aea3d-2e5f-4a12-a9b0-1c2d3e4f5a6b :CREATED: [2026-05-02 Sat 14:00] @@ -363,7 +361,7 @@ Unified control plane for hooks, cron, and complexity-based routing. - Hooked into heartbeat for cron processing - Rule-based tier classifier (overrideable via ~*tier-classifier*~) -*** TODO Context Manager (project scoping) +**** TODO Context Manager (project scoping) :PROPERTIES: :ID: id-a10ed34e-9f37-4a15-b499-46672c00d951 :CREATED: [2026-05-02 Sat 23:00] @@ -373,22 +371,22 @@ Path resolution relative to current context. Memory scope: ~:scope~ property on memory-objects (memex/session/project). Implement lazy-loading proxies for large-scale memory traversal. -*** TODO Model-Tier Routing (cost optimization) +**** TODO Model-Tier Routing (cost optimization) Extend ~*model-selector-fn*~ for complexity-based routing. - Heartbeats → smallest model - User input → medium model - Complex reasoning → large model -*** TODO Memory Scope Segmentation +**** TODO Memory Scope Segmentation Extend memory-object with ~:scope~ property. - ~:memex~ (permanent knowledge), ~:session~ (ephemeral), ~:project~ (current work) - Scope-aware retrieval in memory layer -*** TODO Asynchronous Embedding Gateway +**** TODO Asynchronous Embedding Gateway Provider-agnostic vector generation (Ollama, llama.cpp, OpenAI). Edits mark nodes as ~:vector :pending~; background worker batches and updates Merkle tree. -*** TODO TUI Experience (Daily Driver Quality) +**** TODO TUI Experience (Daily Driver Quality) The TUI is a standalone Croatoan app in ~org/gateway-tui.org~. None of these changes require daemon modifications — the protocol between TUI and daemon (port 9105, framed plists) is stable. @@ -403,7 +401,7 @@ daemon (port 9105, framed plists) is stable. - P4: Tab completion for / commands — ~3h - P4: Configurable theme — ~4h -*** TODO Human-in-the-Loop (HITL) +**** TODO Human-in-the-Loop (HITL) Continuation-based interaction. The agent can suspend its cognitive loop to ask for permission or clarification and resume precisely where it left off. Builds on the dispatcher's existing Flight Plan mechanism. @@ -412,25 +410,24 @@ dispatcher's existing Flight Plan mechanism. Structured tracking, failure handling, and course correction for multi-step engineering work. -** Tasks -*** TODO Long-Horizon Planning (task tree DAG) +**** TODO Long-Horizon Planning (task tree DAG) Decompose complex tasks into Org-mode headline trees. Terminal states: ~:todo~ → ~:next-action~ → ~:in-progress~ → ~:done~ / ~:blocked~ / ~:stuck~. Parent summarises child results. Branch pruning when paths fail. -*** TODO Git Steward (version control integration) +**** TODO Git Steward (version control integration) Status, diff, commit, push, branch operations. Policy enforces commit-before-modify gate. Log commits to memory. -*** TODO TDD Runner Integration +**** TODO TDD Runner Integration Run FiveAM tests on file save. Inject ~:test-failure~ event on red. Hook into self-fix for auto-repair proposals. -*** TODO Deep Emacs Integration +**** TODO Deep Emacs Integration Full org-agenda awareness: navigate, clock time, refile, archive. Uses org-element + org-id. @@ -438,13 +435,12 @@ Uses org-element + org-id. Interactive terminal sessions and autonomous dependency management. -** Tasks -*** TODO Interactive PTY Actuator +**** TODO Interactive PTY Actuator Stream long-running process output to the context window (e.g., ~npm run dev~, REPLs). Async interrupt control (Ctrl+C emulation). -*** TODO The Environment Steward +**** TODO The Environment Steward Autonomously detect missing dependencies ("Command not found"). Propose installation command and retry the failed action. @@ -452,29 +448,28 @@ Propose installation command and retry the failed action. The agent bootstraps itself and manages parallel workstreams. -** Tasks -*** TODO Skill Creator (autonomous skill generation) +**** TODO Skill Creator (autonomous skill generation) LLM drafts complete skill org-file from natural language. Mandatory: syntax validation → jail-load → test → register. -*** TODO Architect Agent (PRD → PROTOCOL) +**** TODO Architect Agent (PRD → PROTOCOL) Scan ~:STATUS: FROZEN~ PRDs. Generate Phase B PROTOCOL from Phase A. -*** TODO GTD Integration (project tracking) +**** TODO GTD Integration (project tracking) Full GTD cycle: capture, clarify, organize, reflect, engage. org-gtd v4.0 DAG (~:TRIGGER:~, ~:BLOCKER:~). -*** TODO Consensus Loop (multi-model agreement) +**** TODO Consensus Loop (multi-model agreement) Run multiple providers for critical decisions. Compare results, detect disagreements. Confidence scoring. -*** TODO Web Research (Playwright browsing) +**** TODO Web Research (Playwright browsing) Headless Chromium via Python bridge. Text extraction, screenshots, Gemini Web UI automation. -*** TODO Memex Management (PARA lifecycle) +**** TODO Memex Management (PARA lifecycle) Archive DONE tasks, suggest refiling. Detect orphaned nodes. PARA/Zettelkasten maintenance. @@ -483,13 +478,12 @@ PARA/Zettelkasten maintenance. Multimodal visual interaction and ecosystem-wide tool compatibility. -** Tasks -*** TODO Computer Use / Vision +**** TODO Computer Use / Vision Allow the agent to request host OS or browser screenshots. Analyze UI and issue precise X/Y coordinate click/type commands via X11/Wayland bridge. -*** TODO MCP Gateway Bridge +**** TODO MCP Gateway Bridge Lisp-native client for the Model Context Protocol. Connect Passepartout to external tools and data sources. @@ -497,9 +491,8 @@ Connect Passepartout to external tools and data sources. Automated benchmarking to mathematically prove the agent's reasoning capabilities. -** Tasks -*** TODO SWE-Bench Harness +**** TODO SWE-Bench Harness Automated pipeline that clones repositories and feeds GitHub issues. Track multi-step resolution trajectory, run tests, and score success. @@ -507,18 +500,18 @@ Track multi-step resolution trajectory, run tests, and score success. Feature-complete agent competitive with commercial agents. All features from v0.2.0 through v0.8.0 combined, verified, and tested end-to-end. -| Area | Parity Target | -|------|--------------| -| Self-improvement | Claude Code self-debug | -| Planning | ULTRAPLAN equivalent | -| Tool ecosystem | 10+ cognitive tools | -| Context window | Semantic search + scope segmentation | -| Safety | 6 Policy invariants + formal verification | -| Multi-step tasks | Task trees with terminal states | -| Code editing | Full file read/write via org manipulation | -| Memory | Vector recall in memory-object | +| Area | Parity Target | +|-------------------+---------------------------------------------| +| Self-improvement | Claude Code self-debug | +| Planning | ULTRAPLAN equivalent | +| Tool ecosystem | 10+ cognitive tools | +| Context window | Semantic search + scope segmentation | +| Safety | 6 Policy invariants + formal verification | +| Multi-step tasks | Task trees with terminal states | +| Code editing | Full file read/write via org manipulation | +| Memory | Vector recall in memory-object | | Emacs integration | Full org-mode control (exceeds Claude Code) | -| Autonomy | 100% local capable (exceeds Claude Code) | +| Autonomy | 100% local capable (exceeds Claude Code) | *** v2.0.0: Lisp Machine Emergence diff --git a/lisp/core-context.lisp b/lisp/core-context.lisp index b5ce71a..57dda31 100644 --- a/lisp/core-context.lisp +++ b/lisp/core-context.lisp @@ -1,12 +1,18 @@ (in-package :passepartout) -(defun context-query (&key tag todo-state type) - "Filters the Memory based on tags, todo states, or types." +(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 (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t)) - (when (and type (not (eq (org-object-type obj) type))) (setf match nil)) + (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)))) @@ -15,7 +21,7 @@ (defun context-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")) + (remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE")) (context-query :tag "project" :type :HEADLINE))) (defun context-recent-tasks () @@ -59,13 +65,13 @@ or nil if the heading is not found." (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 (org-object-id obj)) + (let* ((id (memory-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)) + (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 (org-object-vector obj)) + (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)) (cosine-similarity foveal-vector obj-vector) @@ -84,7 +90,7 @@ or nil if the heading is not found." (setf output (concatenate 'string output content (string #\Newline)))) (dolist (child-id children) - (let ((child-obj (lookup-object child-id))) + (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 @@ -111,7 +117,7 @@ or nil if the heading is not found." (defun context-privacy-filtered-p (obj) "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags." - (let* ((attrs (org-object-attributes obj)) + (let* ((attrs (memory-object-attributes obj)) (tags (getf attrs :TAGS)) (privacy-tags (and (find-package :passepartout.security-dispatcher) (symbol-value diff --git a/lisp/core-defpackage.lisp b/lisp/core-defpackage.lisp index 244583b..90d4cae 100644 --- a/lisp/core-defpackage.lisp +++ b/lisp/core-defpackage.lisp @@ -26,23 +26,24 @@ #:skill-gateway-link #:gateway-manager-main #:ingest-ast - #:lookup-object + #:memory-object-get #:list-objects-by-type #:org-id-new #:*memory-store* #:*history-store* - #:org-object - #:make-org-object - #:org-object-id - #:org-object-type - #:org-object-attributes - #:org-object-parent-id - #:org-object-children - #:org-object-version - #:org-object-last-sync - #:org-object-vector - #:org-object-content - #:org-object-hash + #:memory-object + #:make-memory-object + #:memory-object-id + #:memory-object-type + #:memory-object-attributes + #:memory-object-parent-id + #:memory-object-children + #:memory-object-version + #:memory-object-last-sync + #:memory-object-vector + #:memory-object-content + #:memory-object-hash + #:memory-object-scope #:snapshot-memory #:rollback-memory #:context-query-store diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index ef2ed9d..2e44cc3 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -23,7 +23,7 @@ (concatenate 'string "id-" (string-downcase (format nil "~a" (uuid:make-v4-uuid))))) (defstruct memory-object - id type attributes content vector parent-id children version last-sync hash) + id type attributes content vector parent-id children version last-sync hash scope) (defmethod make-load-form ((obj memory-object) &optional env) (make-load-form-saving-slots obj :environment env)) @@ -39,7 +39,8 @@ :children (copy-list (memory-object-children obj)) :version (memory-object-version obj) :last-sync (memory-object-last-sync obj) - :hash (memory-object-hash obj))) + :hash (memory-object-hash obj) + :scope (memory-object-scope obj))) (defun memory-merkle-hash (id type attributes content child-hashes) (let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v))) @@ -52,7 +53,7 @@ (ironclad:update-digest digester (ironclad:ascii-string-to-byte-array data-string)) (ironclad:byte-array-to-hex-string (ironclad:produce-digest digester)))) -(defun ingest-ast (ast &optional parent-id) +(defun ingest-ast (ast &key parent-id (scope :memex)) (let* ((type (getf ast :type)) (props (getf ast :properties)) (id (or (getf props :ID) (format nil "temp-~a" (get-universal-time)))) @@ -62,7 +63,7 @@ (child-ids nil) (child-hashes nil)) (dolist (child contents) (when (listp child) - (let ((child-id (ingest-ast child id))) + (let ((child-id (ingest-ast child :parent-id id :scope scope))) (push child-id child-ids) (let ((child-obj (gethash child-id *memory-store*))) (when child-obj (push (memory-object-hash child-obj) child-hashes)))))) @@ -75,7 +76,7 @@ :id id :type type :attributes props :content raw-content :parent-id parent-id :children child-ids :version (get-universal-time) :last-sync (get-universal-time) - :hash hash)))) + :hash hash :scope scope)))) (unless existing-obj (setf (gethash hash *memory-history*) obj)) (setf (gethash id *memory-store*) obj) id))) diff --git a/lisp/security-dispatcher.lisp b/lisp/security-dispatcher.lisp index 0a11c3c..c65de80 100644 --- a/lisp/security-dispatcher.lisp +++ b/lisp/security-dispatcher.lisp @@ -285,16 +285,16 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED")) (found-any nil)) (dolist (node approved-nodes) - (let* ((attrs (org-object-attributes node)) + (let* ((attrs (memory-object-attributes node)) (tags (getf attrs :TAGS)) (action-str (getf attrs :ACTION))) (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str) - (log-message "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (org-object-id node)) + (log-message "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node)) (let ((action (ignore-errors (read-from-string action-str)))) (when action (setf (getf action :approved) t) (inject-stimulus action) - (setf (getf (org-object-attributes node) :TODO) "DONE") + (setf (getf (memory-object-attributes node) :TODO) "DONE") (setq found-any t)))))) found-any)) diff --git a/lisp/system-context-manager.lisp b/lisp/system-context-manager.lisp new file mode 100644 index 0000000..32dd5d9 --- /dev/null +++ b/lisp/system-context-manager.lisp @@ -0,0 +1,118 @@ +(defvar *context-stack* nil + "Stack of context plists. Each plist has :project, :base-path, :scope. +Top of stack (car) is the current context.") + +(defvar *context-max-depth* 10 + "Maximum context stack depth. Prevents runaway pushes.") + +(defun current-context () + "Returns the current context plist, or nil if no context is set." + (car *context-stack*)) + +(defun current-scope () + "Returns the current scope keyword (:memex/:session/:project). +Returns :memex when no context is set (defaults to global scope)." + (or (getf (current-context) :scope) :memex)) + +(defun current-project () + "Returns the current project name, or nil." + (getf (current-context) :project)) + +(defun current-base-path () + "Returns the current base path for file resolution, or nil." + (getf (current-context) :base-path)) + +(defun context-stack-depth () + "Returns the current depth of the context stack." + (length *context-stack*)) + +(defun push-context (&key project base-path (scope :project)) + "Pushes a new context onto the stack. When focused on a project: +- File paths resolve relative to BASE-PATH +- Memory queries filter by SCOPE +- :memex scope objects remain visible (always global) +Returns the new context plist." + (when (>= (context-stack-depth) *context-max-depth*) + (log-message "CONTEXT: Stack depth limit reached (~d), refusing push" *context-max-depth*) + (return-from push-context (current-context))) + (let* ((context (list :project project + :base-path base-path + :scope scope))) + (push context *context-stack*) + (log-message "CONTEXT: Pushed ~a (depth ~d)" project (context-stack-depth)) + context)) + +(defun pop-context () + "Pops the current context, restoring the previous one. +Returns the restored context or nil if stack becomes empty." + (if *context-stack* + (let ((popped (pop *context-stack*))) + (log-message "CONTEXT: Popped ~a (depth ~d)" + (getf popped :project) (context-stack-depth)) + (current-context)) + (progn + (log-message "CONTEXT: Cannot pop — stack is empty") + nil))) + +(defmacro with-context ((&key project base-path (scope :project)) &body body) + "Executes BODY within a scoped context, then restores the previous context. +Example: + (with-context (:project \"passepartout\" :base-path \"/home/user/memex/projects/passepartout\") + (context-scoped-query :tag \"bug\"))" + `(let ((*context-stack* (cons (list :project ,project + :base-path ,base-path + :scope ,scope) + *context-stack*))) + ,@body)) + +(defun resolve-path (path) + "Resolves a file path relative to the current context. +If PATH is absolute, returns it unchanged. +If PATH is relative and a base-path is set, merges them. +Otherwise returns PATH unchanged." + (let ((base (current-base-path))) + (if (and base path (not (uiop:absolute-pathname-p path))) + (namestring (merge-pathnames path (uiop:ensure-directory-pathname base))) + path))) + +(defun context-scoped-query (&key tag todo-state type) + "Like context-query but filtered to the current context's scope. +:memex-scoped objects are always visible regardless of current scope." + (context-query :tag tag :todo-state todo-state :type type :scope (current-scope))) + +(defun project-objects () + "Returns all objects scoped to the current project. +Includes :memex-scoped objects (global knowledge) plus :project-scoped +objects matching the current project." + (context-scoped-query)) + +(defun focus-project (name base-path) + "Shortcut: focus on a project by name and base path. +Calls push-context with :scope :project." + (push-context :project name :base-path base-path :scope :project)) + +(defun focus-session () + "Shortcut: enter a session context (ephemeral scope). +Objects created in this scope are visible only during the session." + (push-context :project "session" :scope :session)) + +(defun focus-memex () + "Shortcut: return to global memex scope. Equivalent to pop-context +until stack is empty or :memex context is reached." + (loop while (and *context-stack* + (not (eq (getf (current-context) :scope) :memex))) + do (pop-context))) + +(defun unfocus () + "Pop the top context and return to the previous one." + (pop-context)) + +(defskill :passepartout-system-context-manager + :priority 90 + :trigger (lambda (ctx) (declare (ignore ctx)) nil) + :deterministic (lambda (action ctx) + (declare (ignore action)) + (ignore-errors + (when (> (context-stack-depth) 0) + nil)) + nil)) diff --git a/org/core-context.org b/org/core-context.org index b8e2111..9428301 100644 --- a/org/core-context.org +++ b/org/core-context.org @@ -36,13 +36,19 @@ The semantic threshold is configurable via ~CONTEXT_SEMANTIC_THRESHOLD~ env var Filters the Memory store by tag, TODO state, or object type. This is the primary retrieval function used by skills to find relevant information. #+begin_src lisp -(defun context-query (&key tag todo-state type) - "Filters the Memory based on tags, todo states, or types." +(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 (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t)) - (when (and type (not (eq (org-object-type obj) type))) (setf match nil)) + (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)))) @@ -57,7 +63,7 @@ Returns headlines tagged as ~project~ that are not yet DONE. Used by the global #+begin_src lisp (defun context-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")) + (remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE")) (context-query :tag "project" :type :HEADLINE))) #+end_src @@ -145,13 +151,13 @@ This function is the heart of the context assembly. Its performance directly aff #+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 (org-object-id obj)) + (let* ((id (memory-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)) + (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 (org-object-vector obj)) + (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)) (cosine-similarity foveal-vector obj-vector) @@ -170,7 +176,7 @@ This function is the heart of the context assembly. Its performance directly aff (setf output (concatenate 'string output content (string #\Newline)))) (dolist (child-id children) - (let ((child-obj (lookup-object child-id))) + (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 @@ -209,7 +215,7 @@ Checks if an org-object has tags matching the Bouncer's ~bouncer-privacy-tags~. #+begin_src lisp (defun context-privacy-filtered-p (obj) "Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags." - (let* ((attrs (org-object-attributes obj)) + (let* ((attrs (memory-object-attributes obj)) (tags (getf attrs :TAGS)) (privacy-tags (and (find-package :passepartout.security-dispatcher) (symbol-value diff --git a/org/core-defpackage.org b/org/core-defpackage.org index b4a2ed2..9e27af9 100644 --- a/org/core-defpackage.org +++ b/org/core-defpackage.org @@ -51,23 +51,24 @@ The package definition. All public symbols are exported here. #:skill-gateway-link #:gateway-manager-main #:ingest-ast - #:lookup-object + #:memory-object-get #:list-objects-by-type #:org-id-new #:*memory-store* #:*history-store* - #:org-object - #:make-org-object - #:org-object-id - #:org-object-type - #:org-object-attributes - #:org-object-parent-id - #:org-object-children - #:org-object-version - #:org-object-last-sync - #:org-object-vector - #:org-object-content - #:org-object-hash + #:memory-object + #:make-memory-object + #:memory-object-id + #:memory-object-type + #:memory-object-attributes + #:memory-object-parent-id + #:memory-object-children + #:memory-object-version + #:memory-object-last-sync + #:memory-object-vector + #:memory-object-content + #:memory-object-hash + #:memory-object-scope #:snapshot-memory #:rollback-memory #:context-query-store diff --git a/org/core-memory.org b/org/core-memory.org index 551b4ff..73fea51 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -103,10 +103,11 @@ The universal data unit. Every stored entity — a note, a task, a project, a pe - ~version~ — Unix timestamp of last modification - ~last-sync~ — Unix timestamp of last sync to disk - ~hash~ — SHA-256 Merkle hash for integrity verification +- ~scope~ — scope keyword (:memex/:session/:project) for context-aware retrieval #+begin_src lisp (defstruct memory-object - id type attributes content vector parent-id children version last-sync hash) + id type attributes content vector parent-id children version last-sync hash scope) #+end_src ** Serialization Support @@ -136,7 +137,8 @@ Without deep copy, a snapshot would share structure with the live memory — mut :children (copy-list (memory-object-children obj)) :version (memory-object-version obj) :last-sync (memory-object-last-sync obj) - :hash (memory-object-hash obj))) + :hash (memory-object-hash obj) + :scope (memory-object-scope obj))) #+end_src ** Merkle Tree Integrity (memory-merkle-hash) @@ -175,7 +177,7 @@ The primary entry point for adding data to memory. Given an Org-mode AST (a tree Returns the ID of the root node. #+begin_src lisp -(defun ingest-ast (ast &optional parent-id) +(defun ingest-ast (ast &key parent-id (scope :memex)) (let* ((type (getf ast :type)) (props (getf ast :properties)) (id (or (getf props :ID) (format nil "temp-~a" (get-universal-time)))) @@ -185,7 +187,7 @@ Returns the ID of the root node. (child-ids nil) (child-hashes nil)) (dolist (child contents) (when (listp child) - (let ((child-id (ingest-ast child id))) + (let ((child-id (ingest-ast child :parent-id id :scope scope))) (push child-id child-ids) (let ((child-obj (gethash child-id *memory-store*))) (when child-obj (push (memory-object-hash child-obj) child-hashes)))))) @@ -198,7 +200,7 @@ Returns the ID of the root node. :id id :type type :attributes props :content raw-content :parent-id parent-id :children child-ids :version (get-universal-time) :last-sync (get-universal-time) - :hash hash)))) + :hash hash :scope scope)))) (unless existing-obj (setf (gethash hash *memory-history*) obj)) (setf (gethash id *memory-store*) obj) id))) diff --git a/org/security-dispatcher.org b/org/security-dispatcher.org index 8c16c8e..f99c89d 100644 --- a/org/security-dispatcher.org +++ b/org/security-dispatcher.org @@ -371,16 +371,16 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval." (let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED")) (found-any nil)) (dolist (node approved-nodes) - (let* ((attrs (org-object-attributes node)) + (let* ((attrs (memory-object-attributes node)) (tags (getf attrs :TAGS)) (action-str (getf attrs :ACTION))) (when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str) - (log-message "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (org-object-id node)) + (log-message "BOUNCER: Found approved flight plan '~a'. Re-injecting..." (memory-object-id node)) (let ((action (ignore-errors (read-from-string action-str)))) (when action (setf (getf action :approved) t) (inject-stimulus action) - (setf (getf (org-object-attributes node) :TODO) "DONE") + (setf (getf (memory-object-attributes node) :TODO) "DONE") (setq found-any t)))))) found-any)) #+end_src diff --git a/org/system-context-manager.org b/org/system-context-manager.org new file mode 100644 index 0000000..8fefbff --- /dev/null +++ b/org/system-context-manager.org @@ -0,0 +1,170 @@ +#+TITLE: SKILL: Context Manager (org-skill-context-manager.org) +#+AUTHOR: Agent +#+FILETAGS: :system:context:scoping: +#+PROPERTY: header-args:lisp :tangle ../lisp/system-context-manager.lisp + +* Overview + +The Context Manager provides stack-based project focusing. When the agent +"focuses" on a project, file paths resolve relative to it and memory queries +auto-filter by scope. This enables the agent to work within a bounded context +without being distracted by unrelated memory. + +The core provides the mechanism (=memory-object-scope=, =context-query= with +scope parameter). This skill provides the policy — what to focus on, what +scope means for each project, and how the stack is managed. + +* Implementation + +** Context Stack + +#+begin_src lisp +(defvar *context-stack* nil + "Stack of context plists. Each plist has :project, :base-path, :scope. +Top of stack (car) is the current context.") + +(defvar *context-max-depth* 10 + "Maximum context stack depth. Prevents runaway pushes.") +#+end_src + +** Context Accessors + +#+begin_src lisp +(defun current-context () + "Returns the current context plist, or nil if no context is set." + (car *context-stack*)) + +(defun current-scope () + "Returns the current scope keyword (:memex/:session/:project). +Returns :memex when no context is set (defaults to global scope)." + (or (getf (current-context) :scope) :memex)) + +(defun current-project () + "Returns the current project name, or nil." + (getf (current-context) :project)) + +(defun current-base-path () + "Returns the current base path for file resolution, or nil." + (getf (current-context) :base-path)) + +(defun context-stack-depth () + "Returns the current depth of the context stack." + (length *context-stack*)) +#+end_src + +** Stack Operations + +#+begin_src lisp +(defun push-context (&key project base-path (scope :project)) + "Pushes a new context onto the stack. When focused on a project: +- File paths resolve relative to BASE-PATH +- Memory queries filter by SCOPE +- :memex scope objects remain visible (always global) +Returns the new context plist." + (when (>= (context-stack-depth) *context-max-depth*) + (log-message "CONTEXT: Stack depth limit reached (~d), refusing push" *context-max-depth*) + (return-from push-context (current-context))) + (let* ((context (list :project project + :base-path base-path + :scope scope))) + (push context *context-stack*) + (log-message "CONTEXT: Pushed ~a (depth ~d)" project (context-stack-depth)) + context)) + +(defun pop-context () + "Pops the current context, restoring the previous one. +Returns the restored context or nil if stack becomes empty." + (if *context-stack* + (let ((popped (pop *context-stack*))) + (log-message "CONTEXT: Popped ~a (depth ~d)" + (getf popped :project) (context-stack-depth)) + (current-context)) + (progn + (log-message "CONTEXT: Cannot pop — stack is empty") + nil))) + +(defmacro with-context ((&key project base-path (scope :project)) &body body) + "Executes BODY within a scoped context, then restores the previous context. +Example: + (with-context (:project \"passepartout\" :base-path \"/home/user/memex/projects/passepartout\") + (context-scoped-query :tag \"bug\"))" + `(let ((*context-stack* (cons (list :project ,project + :base-path ,base-path + :scope ,scope) + *context-stack*))) + ,@body)) +#+end_src + +** Path Resolution + +Resolves file paths relative to the current project's base path. + +#+begin_src lisp +(defun resolve-path (path) + "Resolves a file path relative to the current context. +If PATH is absolute, returns it unchanged. +If PATH is relative and a base-path is set, merges them. +Otherwise returns PATH unchanged." + (let ((base (current-base-path))) + (if (and base path (not (uiop:absolute-pathname-p path))) + (namestring (merge-pathnames path (uiop:ensure-directory-pathname base))) + path))) +#+end_src + +** Memory Scope Filtering + +Provides scope-aware query access. When a context is active (scope ≠ :memex), +queries only return objects whose scope is :memex (global) or matches the +current scope. + +#+begin_src lisp +(defun context-scoped-query (&key tag todo-state type) + "Like context-query but filtered to the current context's scope. +:memex-scoped objects are always visible regardless of current scope." + (context-query :tag tag :todo-state todo-state :type type :scope (current-scope))) + +(defun project-objects () + "Returns all objects scoped to the current project. +Includes :memex-scoped objects (global knowledge) plus :project-scoped +objects matching the current project." + (context-scoped-query)) +#+end_src + +** Project Focus Convenience + +#+begin_src lisp +(defun focus-project (name base-path) + "Shortcut: focus on a project by name and base path. +Calls push-context with :scope :project." + (push-context :project name :base-path base-path :scope :project)) + +(defun focus-session () + "Shortcut: enter a session context (ephemeral scope). +Objects created in this scope are visible only during the session." + (push-context :project "session" :scope :session)) + +(defun focus-memex () + "Shortcut: return to global memex scope. Equivalent to pop-context +until stack is empty or :memex context is reached." + (loop while (and *context-stack* + (not (eq (getf (current-context) :scope) :memex))) + do (pop-context))) + +(defun unfocus () + "Pop the top context and return to the previous one." + (pop-context)) +#+end_src + +** Skill Registration + +#+begin_src lisp +(defskill :passepartout-system-context-manager + :priority 90 + :trigger (lambda (ctx) (declare (ignore ctx)) nil) + :deterministic (lambda (action ctx) + (declare (ignore action)) + (ignore-errors + (when (> (context-stack-depth) 0) + nil)) + nil)) +#+end_src