feat: Context Manager skill + org-object→memory-object fix
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
Some checks failed
Deploy (Gitea) / deploy (push) Has been cancelled
- 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.
This commit is contained in:
@@ -182,14 +182,12 @@ The "Brain" meets the "Machine." Standardization and professionalization of the
|
|||||||
|
|
||||||
Unified control plane and Human-in-the-Loop state management.
|
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
|
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.
|
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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-vault-secret-wrappers
|
: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=
|
=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~.
|
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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-archivist-distillation
|
: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=.
|
Wire both as cron jobs via =system-event-orchestrator=.
|
||||||
Depends on: orchestrator bootstrap (P1 item below).
|
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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-self-improve-real
|
: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).
|
Remove the dead first =defskill= registration (trigger nil, overwritten by second).
|
||||||
Depends on: =programming-org=, =programming-literate= (P0 items below).
|
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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-org-modify-render
|
: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
|
=org-ast-render(ast)= returns a hardcoded placeholder. Should convert plist AST
|
||||||
back to Org text.
|
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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-literate-real
|
: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.
|
have balanced parentheses. Returns T if all balanced, error message otherwise.
|
||||||
=literate-tangle-sync-check=: verify =.lisp= file matches tangled output of =.org= file.
|
=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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-orchestrator-bootstrap
|
: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.
|
and =#+CRON:= properties and register them via the existing registries.
|
||||||
Prerequisite for archivist cron jobs.
|
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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-memory-inspect
|
: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
|
by type, TODO state distribution, orphan count, snapshot list. Trigger on
|
||||||
=:INTROSPECTION= sensor type.
|
=: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]
|
CLOSED: [2026-05-03 Sun 10:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-path-relic
|
: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/=.
|
under =$PASSEPARTOUT_DATA_DIR=. Core and skills were merged into =lisp/=.
|
||||||
Update both functions to point at =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]
|
CLOSED: [2026-05-03 Sun 11:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-embeddings
|
: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
|
embeddings via Ollama =nomic-embed-text= at ingest time. Store in
|
||||||
=memory-object.vector=. Fallback: TF-IDF bag-of-words.
|
=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]
|
CLOSED: [2026-05-03 Sun 11:42]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-skill-subtree
|
: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=
|
=context-skill-source= reads entire Org files. Add =context-skill-subtree=
|
||||||
for targeted retrieval of specific function docs or test blocks by heading name.
|
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]
|
CLOSED: [2026-05-03 Sun 11:50]
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-name-normalization
|
: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
|
Normalization pass across all modules. Touches every file — do after P0-P2
|
||||||
are stable. Do not mix with functional changes.
|
are stable. Do not mix with functional changes.
|
||||||
|
|
||||||
*** DONE Project Renaming (Bouncer → Dispatcher)
|
**** DONE Project Renaming (Bouncer → Dispatcher)
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-9e779580-287b-b3d1-37b9-bcefd750bf9e
|
:ID: id-9e779580-287b-b3d1-37b9-bcefd750bf9e
|
||||||
:CREATED: [2026-05-01 Fri 15:40]
|
:CREATED: [2026-05-01 Fri 15:40]
|
||||||
@@ -348,7 +346,7 @@ are stable. Do not mix with functional changes.
|
|||||||
:END:
|
: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.
|
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:
|
:PROPERTIES:
|
||||||
:ID: id-d35aea3d-2e5f-4a12-a9b0-1c2d3e4f5a6b
|
:ID: id-d35aea3d-2e5f-4a12-a9b0-1c2d3e4f5a6b
|
||||||
:CREATED: [2026-05-02 Sat 14:00]
|
: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
|
- Hooked into heartbeat for cron processing
|
||||||
- Rule-based tier classifier (overrideable via ~*tier-classifier*~)
|
- Rule-based tier classifier (overrideable via ~*tier-classifier*~)
|
||||||
|
|
||||||
*** TODO Context Manager (project scoping)
|
**** TODO Context Manager (project scoping)
|
||||||
:PROPERTIES:
|
:PROPERTIES:
|
||||||
:ID: id-a10ed34e-9f37-4a15-b499-46672c00d951
|
:ID: id-a10ed34e-9f37-4a15-b499-46672c00d951
|
||||||
:CREATED: [2026-05-02 Sat 23:00]
|
: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).
|
Memory scope: ~:scope~ property on memory-objects (memex/session/project).
|
||||||
Implement lazy-loading proxies for large-scale memory traversal.
|
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.
|
Extend ~*model-selector-fn*~ for complexity-based routing.
|
||||||
- Heartbeats → smallest model
|
- Heartbeats → smallest model
|
||||||
- User input → medium model
|
- User input → medium model
|
||||||
- Complex reasoning → large model
|
- Complex reasoning → large model
|
||||||
|
|
||||||
*** TODO Memory Scope Segmentation
|
**** TODO Memory Scope Segmentation
|
||||||
Extend memory-object with ~:scope~ property.
|
Extend memory-object with ~:scope~ property.
|
||||||
- ~:memex~ (permanent knowledge), ~:session~ (ephemeral), ~:project~ (current work)
|
- ~:memex~ (permanent knowledge), ~:session~ (ephemeral), ~:project~ (current work)
|
||||||
- Scope-aware retrieval in memory layer
|
- Scope-aware retrieval in memory layer
|
||||||
|
|
||||||
*** TODO Asynchronous Embedding Gateway
|
**** TODO Asynchronous Embedding Gateway
|
||||||
Provider-agnostic vector generation (Ollama, llama.cpp, OpenAI).
|
Provider-agnostic vector generation (Ollama, llama.cpp, OpenAI).
|
||||||
Edits mark nodes as ~:vector :pending~; background worker batches and updates Merkle tree.
|
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~.
|
The TUI is a standalone Croatoan app in ~org/gateway-tui.org~.
|
||||||
None of these changes require daemon modifications — the protocol between TUI and
|
None of these changes require daemon modifications — the protocol between TUI and
|
||||||
daemon (port 9105, framed plists) is stable.
|
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: Tab completion for / commands — ~3h
|
||||||
- P4: Configurable theme — ~4h
|
- 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
|
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
|
permission or clarification and resume precisely where it left off. Builds on the
|
||||||
dispatcher's existing Flight Plan mechanism.
|
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.
|
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.
|
Decompose complex tasks into Org-mode headline trees.
|
||||||
Terminal states: ~:todo~ → ~:next-action~ → ~:in-progress~ → ~:done~ / ~:blocked~ / ~:stuck~.
|
Terminal states: ~:todo~ → ~:next-action~ → ~:in-progress~ → ~:done~ / ~:blocked~ / ~:stuck~.
|
||||||
Parent summarises child results.
|
Parent summarises child results.
|
||||||
Branch pruning when paths fail.
|
Branch pruning when paths fail.
|
||||||
|
|
||||||
*** TODO Git Steward (version control integration)
|
**** TODO Git Steward (version control integration)
|
||||||
Status, diff, commit, push, branch operations.
|
Status, diff, commit, push, branch operations.
|
||||||
Policy enforces commit-before-modify gate.
|
Policy enforces commit-before-modify gate.
|
||||||
Log commits to memory.
|
Log commits to memory.
|
||||||
|
|
||||||
*** TODO TDD Runner Integration
|
**** TODO TDD Runner Integration
|
||||||
Run FiveAM tests on file save.
|
Run FiveAM tests on file save.
|
||||||
Inject ~:test-failure~ event on red.
|
Inject ~:test-failure~ event on red.
|
||||||
Hook into self-fix for auto-repair proposals.
|
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.
|
Full org-agenda awareness: navigate, clock time, refile, archive.
|
||||||
Uses org-element + org-id.
|
Uses org-element + org-id.
|
||||||
|
|
||||||
@@ -438,13 +435,12 @@ Uses org-element + org-id.
|
|||||||
|
|
||||||
Interactive terminal sessions and autonomous dependency management.
|
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).
|
Stream long-running process output to the context window (e.g., ~npm run dev~, REPLs).
|
||||||
Async interrupt control (Ctrl+C emulation).
|
Async interrupt control (Ctrl+C emulation).
|
||||||
|
|
||||||
*** TODO The Environment Steward
|
**** TODO The Environment Steward
|
||||||
Autonomously detect missing dependencies ("Command not found").
|
Autonomously detect missing dependencies ("Command not found").
|
||||||
Propose installation command and retry the failed action.
|
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.
|
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.
|
LLM drafts complete skill org-file from natural language.
|
||||||
Mandatory: syntax validation → jail-load → test → register.
|
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.
|
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.
|
Full GTD cycle: capture, clarify, organize, reflect, engage.
|
||||||
org-gtd v4.0 DAG (~:TRIGGER:~, ~:BLOCKER:~).
|
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.
|
Run multiple providers for critical decisions.
|
||||||
Compare results, detect disagreements.
|
Compare results, detect disagreements.
|
||||||
Confidence scoring.
|
Confidence scoring.
|
||||||
|
|
||||||
*** TODO Web Research (Playwright browsing)
|
**** TODO Web Research (Playwright browsing)
|
||||||
Headless Chromium via Python bridge.
|
Headless Chromium via Python bridge.
|
||||||
Text extraction, screenshots, Gemini Web UI automation.
|
Text extraction, screenshots, Gemini Web UI automation.
|
||||||
|
|
||||||
*** TODO Memex Management (PARA lifecycle)
|
**** TODO Memex Management (PARA lifecycle)
|
||||||
Archive DONE tasks, suggest refiling.
|
Archive DONE tasks, suggest refiling.
|
||||||
Detect orphaned nodes.
|
Detect orphaned nodes.
|
||||||
PARA/Zettelkasten maintenance.
|
PARA/Zettelkasten maintenance.
|
||||||
@@ -483,13 +478,12 @@ PARA/Zettelkasten maintenance.
|
|||||||
|
|
||||||
Multimodal visual interaction and ecosystem-wide tool compatibility.
|
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.
|
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.
|
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.
|
Lisp-native client for the Model Context Protocol.
|
||||||
Connect Passepartout to external tools and data sources.
|
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.
|
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.
|
Automated pipeline that clones repositories and feeds GitHub issues.
|
||||||
Track multi-step resolution trajectory, run tests, and score success.
|
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.
|
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 |
|
| Area | Parity Target |
|
||||||
|------|--------------|
|
|-------------------+---------------------------------------------|
|
||||||
| Self-improvement | Claude Code self-debug |
|
| Self-improvement | Claude Code self-debug |
|
||||||
| Planning | ULTRAPLAN equivalent |
|
| Planning | ULTRAPLAN equivalent |
|
||||||
| Tool ecosystem | 10+ cognitive tools |
|
| Tool ecosystem | 10+ cognitive tools |
|
||||||
| Context window | Semantic search + scope segmentation |
|
| Context window | Semantic search + scope segmentation |
|
||||||
| Safety | 6 Policy invariants + formal verification |
|
| Safety | 6 Policy invariants + formal verification |
|
||||||
| Multi-step tasks | Task trees with terminal states |
|
| Multi-step tasks | Task trees with terminal states |
|
||||||
| Code editing | Full file read/write via org manipulation |
|
| Code editing | Full file read/write via org manipulation |
|
||||||
| Memory | Vector recall in memory-object |
|
| Memory | Vector recall in memory-object |
|
||||||
| Emacs integration | Full org-mode control (exceeds Claude Code) |
|
| 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
|
*** v2.0.0: Lisp Machine Emergence
|
||||||
|
|
||||||
|
|||||||
@@ -1,12 +1,18 @@
|
|||||||
(in-package :passepartout)
|
(in-package :passepartout)
|
||||||
|
|
||||||
(defun context-query (&key tag todo-state type)
|
(defun context-query (&key tag todo-state type scope)
|
||||||
"Filters the Memory based on tags, todo states, or types."
|
"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))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
(let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
(let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
||||||
(when (and type (not (eq (org-object-type obj) type))) (setf match nil))
|
;; 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 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 (and todo-state (not (equal state todo-state))) (setf match nil))
|
||||||
(when match (push obj results))))
|
(when match (push obj results))))
|
||||||
@@ -15,7 +21,7 @@
|
|||||||
|
|
||||||
(defun context-active-projects ()
|
(defun context-active-projects ()
|
||||||
"Returns headlines tagged as 'project' that are not yet marked DONE."
|
"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)))
|
(context-query :tag "project" :type :HEADLINE)))
|
||||||
|
|
||||||
(defun context-recent-tasks ()
|
(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))
|
(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."
|
"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))
|
(is-foveal (equal id foveal-id))
|
||||||
(title (or (getf (org-object-attributes obj) :TITLE) "Untitled"))
|
(title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
|
||||||
(content (org-object-content obj))
|
(content (memory-object-content obj))
|
||||||
(children (org-object-children obj))
|
(children (memory-object-children obj))
|
||||||
(stars (make-string depth :initial-element #\*))
|
(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))
|
(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))
|
(similarity (if (and foveal-vector obj-vector (not is-foveal))
|
||||||
(cosine-similarity foveal-vector obj-vector)
|
(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))))
|
(setf output (concatenate 'string output content (string #\Newline))))
|
||||||
|
|
||||||
(dolist (child-id children)
|
(dolist (child-id children)
|
||||||
(let ((child-obj (lookup-object child-id)))
|
(let ((child-obj (memory-object-get child-id)))
|
||||||
(when child-obj
|
(when child-obj
|
||||||
(let ((next-foveal (if is-foveal child-id foveal-id)))
|
(let ((next-foveal (if is-foveal child-id foveal-id)))
|
||||||
(setf output (concatenate 'string output
|
(setf output (concatenate 'string output
|
||||||
@@ -111,7 +117,7 @@ or nil if the heading is not found."
|
|||||||
|
|
||||||
(defun context-privacy-filtered-p (obj)
|
(defun context-privacy-filtered-p (obj)
|
||||||
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
|
"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))
|
(tags (getf attrs :TAGS))
|
||||||
(privacy-tags (and (find-package :passepartout.security-dispatcher)
|
(privacy-tags (and (find-package :passepartout.security-dispatcher)
|
||||||
(symbol-value
|
(symbol-value
|
||||||
|
|||||||
@@ -26,23 +26,24 @@
|
|||||||
#:skill-gateway-link
|
#:skill-gateway-link
|
||||||
#:gateway-manager-main
|
#:gateway-manager-main
|
||||||
#:ingest-ast
|
#:ingest-ast
|
||||||
#:lookup-object
|
#:memory-object-get
|
||||||
#:list-objects-by-type
|
#:list-objects-by-type
|
||||||
#:org-id-new
|
#:org-id-new
|
||||||
#:*memory-store*
|
#:*memory-store*
|
||||||
#:*history-store*
|
#:*history-store*
|
||||||
#:org-object
|
#:memory-object
|
||||||
#:make-org-object
|
#:make-memory-object
|
||||||
#:org-object-id
|
#:memory-object-id
|
||||||
#:org-object-type
|
#:memory-object-type
|
||||||
#:org-object-attributes
|
#:memory-object-attributes
|
||||||
#:org-object-parent-id
|
#:memory-object-parent-id
|
||||||
#:org-object-children
|
#:memory-object-children
|
||||||
#:org-object-version
|
#:memory-object-version
|
||||||
#:org-object-last-sync
|
#:memory-object-last-sync
|
||||||
#:org-object-vector
|
#:memory-object-vector
|
||||||
#:org-object-content
|
#:memory-object-content
|
||||||
#:org-object-hash
|
#:memory-object-hash
|
||||||
|
#:memory-object-scope
|
||||||
#:snapshot-memory
|
#:snapshot-memory
|
||||||
#:rollback-memory
|
#:rollback-memory
|
||||||
#:context-query-store
|
#:context-query-store
|
||||||
|
|||||||
@@ -23,7 +23,7 @@
|
|||||||
(concatenate 'string "id-" (string-downcase (format nil "~a" (uuid:make-v4-uuid)))))
|
(concatenate 'string "id-" (string-downcase (format nil "~a" (uuid:make-v4-uuid)))))
|
||||||
|
|
||||||
(defstruct memory-object
|
(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)
|
(defmethod make-load-form ((obj memory-object) &optional env)
|
||||||
(make-load-form-saving-slots obj :environment env))
|
(make-load-form-saving-slots obj :environment env))
|
||||||
@@ -39,7 +39,8 @@
|
|||||||
:children (copy-list (memory-object-children obj))
|
:children (copy-list (memory-object-children obj))
|
||||||
:version (memory-object-version obj)
|
:version (memory-object-version obj)
|
||||||
:last-sync (memory-object-last-sync 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)
|
(defun memory-merkle-hash (id type attributes content child-hashes)
|
||||||
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
|
(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:update-digest digester (ironclad:ascii-string-to-byte-array data-string))
|
||||||
(ironclad:byte-array-to-hex-string (ironclad:produce-digest digester))))
|
(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))
|
(let* ((type (getf ast :type))
|
||||||
(props (getf ast :properties))
|
(props (getf ast :properties))
|
||||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
||||||
@@ -62,7 +63,7 @@
|
|||||||
(child-ids nil) (child-hashes nil))
|
(child-ids nil) (child-hashes nil))
|
||||||
(dolist (child contents)
|
(dolist (child contents)
|
||||||
(when (listp child)
|
(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)
|
(push child-id child-ids)
|
||||||
(let ((child-obj (gethash child-id *memory-store*)))
|
(let ((child-obj (gethash child-id *memory-store*)))
|
||||||
(when child-obj (push (memory-object-hash child-obj) child-hashes))))))
|
(when child-obj (push (memory-object-hash child-obj) child-hashes))))))
|
||||||
@@ -75,7 +76,7 @@
|
|||||||
:id id :type type :attributes props :content raw-content
|
:id id :type type :attributes props :content raw-content
|
||||||
:parent-id parent-id :children child-ids
|
:parent-id parent-id :children child-ids
|
||||||
:version (get-universal-time) :last-sync (get-universal-time)
|
:version (get-universal-time) :last-sync (get-universal-time)
|
||||||
:hash hash))))
|
:hash hash :scope scope))))
|
||||||
(unless existing-obj (setf (gethash hash *memory-history*) obj))
|
(unless existing-obj (setf (gethash hash *memory-history*) obj))
|
||||||
(setf (gethash id *memory-store*) obj)
|
(setf (gethash id *memory-store*) obj)
|
||||||
id)))
|
id)))
|
||||||
|
|||||||
@@ -285,16 +285,16 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
|
|||||||
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
|
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
|
||||||
(found-any nil))
|
(found-any nil))
|
||||||
(dolist (node approved-nodes)
|
(dolist (node approved-nodes)
|
||||||
(let* ((attrs (org-object-attributes node))
|
(let* ((attrs (memory-object-attributes node))
|
||||||
(tags (getf attrs :TAGS))
|
(tags (getf attrs :TAGS))
|
||||||
(action-str (getf attrs :ACTION)))
|
(action-str (getf attrs :ACTION)))
|
||||||
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
|
(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))))
|
(let ((action (ignore-errors (read-from-string action-str))))
|
||||||
(when action
|
(when action
|
||||||
(setf (getf action :approved) t)
|
(setf (getf action :approved) t)
|
||||||
(inject-stimulus action)
|
(inject-stimulus action)
|
||||||
(setf (getf (org-object-attributes node) :TODO) "DONE")
|
(setf (getf (memory-object-attributes node) :TODO) "DONE")
|
||||||
(setq found-any t))))))
|
(setq found-any t))))))
|
||||||
found-any))
|
found-any))
|
||||||
|
|
||||||
|
|||||||
118
lisp/system-context-manager.lisp
Normal file
118
lisp/system-context-manager.lisp
Normal file
@@ -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))
|
||||||
@@ -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.
|
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
|
#+begin_src lisp
|
||||||
(defun context-query (&key tag todo-state type)
|
(defun context-query (&key tag todo-state type scope)
|
||||||
"Filters the Memory based on tags, todo states, or types."
|
"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))
|
(let ((results nil))
|
||||||
(maphash (lambda (id obj)
|
(maphash (lambda (id obj)
|
||||||
(declare (ignore id))
|
(declare (ignore id))
|
||||||
(let* ((attrs (org-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
(let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
|
||||||
(when (and type (not (eq (org-object-type obj) type))) (setf match nil))
|
;; 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 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 (and todo-state (not (equal state todo-state))) (setf match nil))
|
||||||
(when match (push obj results))))
|
(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
|
#+begin_src lisp
|
||||||
(defun context-active-projects ()
|
(defun context-active-projects ()
|
||||||
"Returns headlines tagged as 'project' that are not yet marked DONE."
|
"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)))
|
(context-query :tag "project" :type :HEADLINE)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
@@ -145,13 +151,13 @@ This function is the heart of the context assembly. Its performance directly aff
|
|||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
|
(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."
|
"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))
|
(is-foveal (equal id foveal-id))
|
||||||
(title (or (getf (org-object-attributes obj) :TITLE) "Untitled"))
|
(title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
|
||||||
(content (org-object-content obj))
|
(content (memory-object-content obj))
|
||||||
(children (org-object-children obj))
|
(children (memory-object-children obj))
|
||||||
(stars (make-string depth :initial-element #\*))
|
(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))
|
(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))
|
(similarity (if (and foveal-vector obj-vector (not is-foveal))
|
||||||
(cosine-similarity foveal-vector obj-vector)
|
(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))))
|
(setf output (concatenate 'string output content (string #\Newline))))
|
||||||
|
|
||||||
(dolist (child-id children)
|
(dolist (child-id children)
|
||||||
(let ((child-obj (lookup-object child-id)))
|
(let ((child-obj (memory-object-get child-id)))
|
||||||
(when child-obj
|
(when child-obj
|
||||||
(let ((next-foveal (if is-foveal child-id foveal-id)))
|
(let ((next-foveal (if is-foveal child-id foveal-id)))
|
||||||
(setf output (concatenate 'string output
|
(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
|
#+begin_src lisp
|
||||||
(defun context-privacy-filtered-p (obj)
|
(defun context-privacy-filtered-p (obj)
|
||||||
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
|
"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))
|
(tags (getf attrs :TAGS))
|
||||||
(privacy-tags (and (find-package :passepartout.security-dispatcher)
|
(privacy-tags (and (find-package :passepartout.security-dispatcher)
|
||||||
(symbol-value
|
(symbol-value
|
||||||
|
|||||||
@@ -51,23 +51,24 @@ The package definition. All public symbols are exported here.
|
|||||||
#:skill-gateway-link
|
#:skill-gateway-link
|
||||||
#:gateway-manager-main
|
#:gateway-manager-main
|
||||||
#:ingest-ast
|
#:ingest-ast
|
||||||
#:lookup-object
|
#:memory-object-get
|
||||||
#:list-objects-by-type
|
#:list-objects-by-type
|
||||||
#:org-id-new
|
#:org-id-new
|
||||||
#:*memory-store*
|
#:*memory-store*
|
||||||
#:*history-store*
|
#:*history-store*
|
||||||
#:org-object
|
#:memory-object
|
||||||
#:make-org-object
|
#:make-memory-object
|
||||||
#:org-object-id
|
#:memory-object-id
|
||||||
#:org-object-type
|
#:memory-object-type
|
||||||
#:org-object-attributes
|
#:memory-object-attributes
|
||||||
#:org-object-parent-id
|
#:memory-object-parent-id
|
||||||
#:org-object-children
|
#:memory-object-children
|
||||||
#:org-object-version
|
#:memory-object-version
|
||||||
#:org-object-last-sync
|
#:memory-object-last-sync
|
||||||
#:org-object-vector
|
#:memory-object-vector
|
||||||
#:org-object-content
|
#:memory-object-content
|
||||||
#:org-object-hash
|
#:memory-object-hash
|
||||||
|
#:memory-object-scope
|
||||||
#:snapshot-memory
|
#:snapshot-memory
|
||||||
#:rollback-memory
|
#:rollback-memory
|
||||||
#:context-query-store
|
#:context-query-store
|
||||||
|
|||||||
@@ -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
|
- ~version~ — Unix timestamp of last modification
|
||||||
- ~last-sync~ — Unix timestamp of last sync to disk
|
- ~last-sync~ — Unix timestamp of last sync to disk
|
||||||
- ~hash~ — SHA-256 Merkle hash for integrity verification
|
- ~hash~ — SHA-256 Merkle hash for integrity verification
|
||||||
|
- ~scope~ — scope keyword (:memex/:session/:project) for context-aware retrieval
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defstruct memory-object
|
(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
|
#+end_src
|
||||||
|
|
||||||
** Serialization Support
|
** 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))
|
:children (copy-list (memory-object-children obj))
|
||||||
:version (memory-object-version obj)
|
:version (memory-object-version obj)
|
||||||
:last-sync (memory-object-last-sync 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
|
#+end_src
|
||||||
|
|
||||||
** Merkle Tree Integrity (memory-merkle-hash)
|
** 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.
|
Returns the ID of the root node.
|
||||||
|
|
||||||
#+begin_src lisp
|
#+begin_src lisp
|
||||||
(defun ingest-ast (ast &optional parent-id)
|
(defun ingest-ast (ast &key parent-id (scope :memex))
|
||||||
(let* ((type (getf ast :type))
|
(let* ((type (getf ast :type))
|
||||||
(props (getf ast :properties))
|
(props (getf ast :properties))
|
||||||
(id (or (getf props :ID) (format nil "temp-~a" (get-universal-time))))
|
(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))
|
(child-ids nil) (child-hashes nil))
|
||||||
(dolist (child contents)
|
(dolist (child contents)
|
||||||
(when (listp child)
|
(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)
|
(push child-id child-ids)
|
||||||
(let ((child-obj (gethash child-id *memory-store*)))
|
(let ((child-obj (gethash child-id *memory-store*)))
|
||||||
(when child-obj (push (memory-object-hash child-obj) child-hashes))))))
|
(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
|
:id id :type type :attributes props :content raw-content
|
||||||
:parent-id parent-id :children child-ids
|
:parent-id parent-id :children child-ids
|
||||||
:version (get-universal-time) :last-sync (get-universal-time)
|
:version (get-universal-time) :last-sync (get-universal-time)
|
||||||
:hash hash))))
|
:hash hash :scope scope))))
|
||||||
(unless existing-obj (setf (gethash hash *memory-history*) obj))
|
(unless existing-obj (setf (gethash hash *memory-history*) obj))
|
||||||
(setf (gethash id *memory-store*) obj)
|
(setf (gethash id *memory-store*) obj)
|
||||||
id)))
|
id)))
|
||||||
|
|||||||
@@ -371,16 +371,16 @@ privacy tags, privacy text, shell safety, network exfil, high-impact approval."
|
|||||||
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
|
(let ((approved-nodes (list-objects-with-attribute :TODO "APPROVED"))
|
||||||
(found-any nil))
|
(found-any nil))
|
||||||
(dolist (node approved-nodes)
|
(dolist (node approved-nodes)
|
||||||
(let* ((attrs (org-object-attributes node))
|
(let* ((attrs (memory-object-attributes node))
|
||||||
(tags (getf attrs :TAGS))
|
(tags (getf attrs :TAGS))
|
||||||
(action-str (getf attrs :ACTION)))
|
(action-str (getf attrs :ACTION)))
|
||||||
(when (and (member "FLIGHT_PLAN" tags :test #'string-equal) action-str)
|
(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))))
|
(let ((action (ignore-errors (read-from-string action-str))))
|
||||||
(when action
|
(when action
|
||||||
(setf (getf action :approved) t)
|
(setf (getf action :approved) t)
|
||||||
(inject-stimulus action)
|
(inject-stimulus action)
|
||||||
(setf (getf (org-object-attributes node) :TODO) "DONE")
|
(setf (getf (memory-object-attributes node) :TODO) "DONE")
|
||||||
(setq found-any t))))))
|
(setq found-any t))))))
|
||||||
found-any))
|
found-any))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
170
org/system-context-manager.org
Normal file
170
org/system-context-manager.org
Normal file
@@ -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
|
||||||
Reference in New Issue
Block a user