diff --git a/README.org b/README.org index c1e7fae..8526cbc 100644 --- a/README.org +++ b/README.org @@ -3,7 +3,7 @@ #+FILETAGS: :passepartout:ai:assistant: #+HTML:
-#+HTML: +#+HTML: #+HTML: #+HTML: #+HTML: @@ -112,6 +112,7 @@ Features marked =Stable= ship in the current release. Features marked =Planned= | Expanded theme (25-color) | Stable | v0.4.0 | 4 named presets (dark/light/gruvbox/solarized), /theme command | | Discord + Slack gateways | Stable | v0.4.0 | 4 platforms: Telegram, Signal, Discord, Slack | | Native embedding inference | Beta | v0.4.x | CFFI llama.cpp binding, nomic-embed-text (768-dim) | +| Structured output (function-calling) | Stable | v0.4.2 | LLM tool use via native function-calling API, JSON→plist boundary | | 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 | diff --git a/docs/ROADMAP.org b/docs/ROADMAP.org index d0ae309..b99e3e4 100644 --- a/docs/ROADMAP.org +++ b/docs/ROADMAP.org @@ -23,9 +23,9 @@ Feature releases increment the minor version (v0.X.0). Bugfix and hardening rele 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) +2. ~README.org~ — update version badge (line 6), 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"~) +4. ~lisp/core-transport.lisp~ — update the ~make-hello-message~ version string 5. ~passepartout~ (bash entry point) — update version reference On release: @@ -656,11 +656,14 @@ Rationale: Currently, several configurable values are hardcoded in source: the D The current ~think()~ function asks the LLM to produce raw S-expression plists. Four pieces of defensive infrastructure (~handler-case~ around ~read-from-string~, ~markdown-strip~, ~plist-keywords-normalize~, the RCE guard test) exist because LLMs cannot reliably produce balanced, keyword-prefixed plists. The fix: use the LLM API's native function calling / tool-use feature. The LLM always returns guaranteed-valid JSON. Convert to plist deterministically at the boundary. -*** TODO Implement function-calling / tool-use API in provider requests +*** DONE Implement function-calling / tool-use API in provider requests :PROPERTIES: :ID: id-v042-function-calling :CREATED: [2026-05-07 Thu] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-07 Thu 17:17] +:END: Rationale: Every major provider API (OpenAI, Anthropic, Groq, DeepSeek, OpenRouter) supports function calling. The LLM is sent tool definitions as JSON Schema. It returns ~tool_calls~ with guaranteed-valid JSON arguments. This eliminates the fragile ~read-from-string~ plist parsing entirely — the probabilistic layer speaks JSON (what it was trained on), the deterministic layer speaks plists (what the code controls). Conversion happens at a narrow, well-defined boundary. @@ -670,15 +673,18 @@ Rationale: Every major provider API (OpenAI, Anthropic, Groq, DeepSeek, OpenRout - For providers that don't support function calling (local Ollama): keep ~:content~ path as fallback. LLM can still return raw text. - FiveAM test: send a request with a mock tool definition, verify the response shape. -*** TODO Wire structured tool calls into ~think()~ — JSON→plist at boundary +*** DONE Wire structured tool calls into ~think()~ — JSON→plist at boundary :PROPERTIES: :ID: id-v042-wire-tool-calls :CREATED: [2026-05-07 Thu] :END: +:LOGBOOK: +- State "DONE" from "TODO" [2026-05-07 Thu 17:17] +:END: Rationale: Once the provider layer returns structured ~tool-calls~, the ~think()~ function must convert them to the internal plist format that ~cognitive-verify~ and ~loop-gate-act~ expect. This is a one-way, deterministic conversion at the architectural boundary. -- Add ~json-alist-to-plist~ helper in ~core-loop-reason.lisp~ or ~core-utils.lisp~: convert JSON alist (from ~cl-json:decode-json-from-string~) to keyword-prefixed plist. String keys → keywords. Nested objects recurse. JSON null → ~nil~. ~25 lines. +- Add ~json-alist-to-plist~ helper in ~core-loop-reason.lisp~: convert JSON alist (from ~cl-json:decode-json-from-string~) to keyword-prefixed plist. String keys → keywords. Nested objects recurse. JSON null → ~nil~. ~25 lines. - In ~think()~ after ~backend-cascade-call~: if result contains ~:tool-calls~, convert each tool call's ~:arguments~ JSON to plist via ~json-alist-to-plist~, wrap in ~(:TYPE :REQUEST :PAYLOAD (:TOOL :ARGS :EXPLANATION "..."))~. - Keep the existing ~read-from-string~ path as fallback for providers that return raw text (local Ollama, streaming). - The ~read-from-string~ path remains guarded by ~*read-eval* nil~ from v0.3.1. @@ -719,11 +725,160 @@ Rationale: The current shell safety check treats all dangerous patterns equally - The severity classification is the foundation that ~dispatcher-learn~ (v0.5.0) builds on — learning only applies to ~:dangerous~ and ~:moderate~ tiers. - FiveAM test: ~echo hello~ returns ~:harmless~ severity and passes through; ~mkfs.ext4 /dev/sda~ returns ~:catastrophic~ and is always blocked. -** v0.5.0: Token Economics & Prompt Efficiency +** v0.5.0: File Reorganization & Token Economics -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 — with no caching, no budget, and no incremental assembly. The foveal-peripheral model prunes memory content but doesn't touch the fixed overhead of IDENTITY, TOOLS, and LOGS sections, which together dominate the system prompt size. Standing mandates (~*standing-mandates*~) contribute negligible overhead (~40 tokens when the single active mandate fires). +The foundation work: rename and restructure the codebase around the self-repair criterion, extract non-core fragments from core, then build the learning loop on clean foundations. -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. +*** File Reorganization — self-repair criterion + +Rationale: The current file naming scheme mixes three concerns: architectural role (core-* = harness, system-* = skill), domain (security-*, programming-*, gateway-*), and implementation nature (system-model-* is LLM infrastructure, not a "system"). Worse, two fragments that can be extracted from core (context assembly, heartbeat) currently live there because the criterion for "what is core" was never defined. This reorganization establishes the criterion and applies it. + +The criterion: a file belongs in core if, when corrupted, the agent cannot fix it without human help. Corrupted core = dead brain, dead hands, or unreachable. Corrupted skill = degraded but self-repairable. + +*** TODO Extract core-context → symbolic-awareness +:PROPERTIES: +:ID: id-v050-reorg-awareness +:CREATED: [2026-05-07 Thu] +:END: + +Rationale: ~core-context.lisp~ (224 lines) handles ~context-assemble-global-awareness~, ~context-object-render~, ~context-query~, and related functions. If corrupted, the LLM receives empty awareness. But the agent still has tools, identity, and user input. It can reason about "no awareness", edit the context source file, reload the skill, and awareness returns. Degraded, not dead. Safe to extract. + +- Move ~core-context.lisp~ content to new ~symbolic-awareness.lisp~ (new ~org/symbolic-awareness.org~). +- Register as a skill via ~defskill :passepartout-symbolic-awareness~. +- In ~core-reason.lisp~'s ~think()~: wrap ~context-assemble-global-awareness~ and ~context-get-system-logs~ calls with ~fboundp~ guards. On skill failure, inject degraded awareness note. +- Remove ~core-context~ from ~passepartout.asd~ ~:components~. +- FiveAM: verify ~think()~ produces valid output when awareness skill is not loaded. + +*** TODO Extract heartbeat generation → symbolic-events +:PROPERTIES: +:ID: id-v050-reorg-heartbeat +:CREATED: [2026-05-07 Thu] +:END: + +Rationale: The heartbeat thread (~heartbeat-start~, ~*heartbeat-thread*~, auto-save counter) lives in ~core-loop.lisp~ (~50 lines). If heartbeat is corrupted or missing, the agent has no background ticks — no cron jobs, no auto-save. But the agent is fully functional: it perceives, reasons, and acts. It can detect missing ticks, reload the events skill, and heartbeat returns. Safe to extract. + +- Move heartbeat generation (~heartbeat-start~, ~*heartbeat-thread*~, ~*heartbeat-save-counter*~, ~*memory-auto-save-interval*~) from ~core-pipeline.lisp~ to ~symbolic-events.lisp~. +- Rename ~heartbeat-start~ → ~events-start-heartbeat~. +- In ~core-pipeline.lisp~'s ~main()~: change ~(heartbeat-start)~ to ~(when (fboundp 'events-start-heartbeat) (events-start-heartbeat))~. +- ~symbolic-events~ already processes ~:heartbeat~ signals for cron dispatch (existing code). Now it also generates them. + +*** TODO Relocate 6 utility fragments to correct files +:PROPERTIES: +:ID: id-v050-reorg-utilities +:CREATED: [2026-05-07 Thu] +:END: + +Rationale: Several functions live in core files not because they need core protection but because they were written there first. They are utility functions that can be extracted into skills. + +- ~markdown-strip~ (core-reason.lisp:51) → new ~programming-markdown.lisp~ (~org/programming-markdown.org~). +- ~plist-keywords-normalize~ (core-reason.lisp:60) → ~programming-lisp.lisp~. +- ~cognitive-tool-prompt~ / ~generate-tool-belt-prompt~ (core-defpackage.lisp:214-231) → ~programming-tools.lisp~. +- ~lisp-syntax-validate~ (core-skills.lisp) → ~programming-lisp.lisp~. +- ~VAULT-MASK-STRING~ + ~*VAULT-MEMORY*~ (core-skills.lisp) → ~security-vault.lisp~. +- ~*backend-registry*~ dedup: merge with ~*probabilistic-backends*~ (core-reason.lisp:10-12), remove ~backend-register~ (core-reason.lisp:18-19), update ~backend-cascade-call~ to check only one hash table. + +*** TODO Rename 6 core files — shorter, clearer names +:PROPERTIES: +:ID: id-v050-reorg-core-names +:CREATED: [2026-05-07 Thu] +:END: + +Rename mapping: +- ~core-defpackage~ → ~core-package~ +- ~core-communication~ → ~core-transport~ +- ~core-loop~ → ~core-pipeline~ +- ~core-loop-perceive~ → ~core-perceive~ +- ~core-loop-reason~ → ~core-reason~ +- ~core-loop-act~ → ~core-act~ + +Update: ASDF ~:components~, all ~:tangle~ headers in ~.org~ files, cross-file references, ~README.org~, ~ARCHITECTURE.org~, ~AGENTS.md~, ~*dispatcher-protected-paths*~ (wildcard ~core-*~ still matches — no change needed). + +*** TODO Rename 13 system-* → symbolic-/neuro-/embedding-* +:PROPERTIES: +:ID: id-v050-reorg-system-names +:CREATED: [2026-05-07 Thu] +:END: + +Rename mapping: +- ~system-config~ → ~symbolic-config~ +- ~system-diagnostics~ → ~symbolic-diagnostics~ +- ~system-archivist~ → ~symbolic-archivist~ +- ~system-event-orchestrator~ → ~symbolic-events~ +- ~system-self-improve~ → ~symbolic-self-improve~ +- ~system-context-manager~ → ~symbolic-scope~ +- ~system-memory~ → ~symbolic-memory~ +- ~system-model-provider~ → ~neuro-provider~ +- ~system-model-router~ → ~neuro-router~ +- ~system-model-explorer~ → ~neuro-explorer~ +- ~system-model-embedding~ → ~embedding-backends~ +- ~system-model-embedding-native~ → ~embedding-native~ +- ~system-actuator-shell~ → ~channel-shell~ + +*** TODO Delete ~system-model.lisp~ (16-line wrapper) + +The file delegates to ~*probabilistic-backends*~ — dead code. No skill references it directly. + +*** TODO Rename 4 gateway-* → channel-* +:PROPERTIES: +:ID: id-v050-reorg-channel-names +:CREATED: [2026-05-07 Thu] +:END: + +Rename mapping: +- ~gateway-cli~ → ~channel-cli~ +- ~gateway-tui-main~ → ~channel-tui-main~ +- ~gateway-tui-model~ → ~channel-tui-state~ +- ~gateway-tui-view~ → ~channel-tui-view~ + +Update TUI package name: ~passepartout.gateway-tui~ → ~passepartout.channel-tui~. + +*** TODO Split ~gateway-messaging~ → 4 ~channel-*~ files +:PROPERTIES: +:ID: id-v050-reorg-messaging-split +:CREATED: [2026-05-07 Thu] +:END: + +Rationale: ~gateway-messaging.lisp~ (411 lines) bundles 4 independent platforms. A Telegram fix shouldn't touch Signal/Discord/Slack code. Each platform becomes its own skill — independently loadable, hot-reloadable, self-repairable. + +- ~channel-telegram~: poll + send via Telegram Bot API. ~register-actuator :telegram~. +- ~channel-signal~: poll + send via ~signal-cli~ subprocess. ~register-actuator :signal~. +- ~channel-discord~: WebSocket events + REST POST. Replace hardcoded channel IDs with env vars. ~register-actuator :discord~. +- ~channel-slack~: Events API + ~chat.postMessage~. Replace hardcoded channel IDs. ~register-actuator :slack~. +- Delete ~gateway-messaging.lisp~. Update ~DEFSKILL-FROM-ORG~ references in ~system-config~ setup wizard. + +*** TODO Document core/non-core self-repair criterion +:PROPERTIES: +:ID: id-v050-reorg-docs +:CREATED: [2026-05-07 Thu] +:END: + +Rationale: The criterion is the architectural foundation for every discussion about "should this be core or a skill?" It must be documented where developers look. + +- New section in ~docs/ARCHITECTURE.org~: "What Makes Core Different — The Self-Repair Criterion." Explain: core = can't self-repair when corrupted, needs human. Skill = agent degrades but self-repairs. +- Include the dependency-chain analysis: which files block self-repair. +- New section in ~docs/DESIGN_DECISIONS.org~: "The Self-Repair Criterion for Core Files." Explain why ~core-context~ and heartbeat were extracted. +- Update ~README.org~ architecture summary to reflect new file map. + +*** TODO Update all cross-references after reorg +:PROPERTIES: +:ID: id-v050-reorg-crossref +:CREATED: [2026-05-07 Thu] +:END: + +After all renames complete, update every remaining reference: +- ~passepartout.asd~: remove ~core-context~, rename 6 core entries. +- All ~#+PROPERTY: header-args:lisp :tangle ../lisp/.lisp~ lines in ~.org~ files. +- All ~in-package~ / ~find-package~ / ~fboundp~ references to renamed packages. +- ~skill-initialize-all~ / ~context-skill-source~: resolve org files under new names. +- ~README.org~: Current Capabilities table, pipeline description, file references. +- ~ARCHITECTURE.org~: layer tables, pipeline flow, dispatcher gate stack. +- ~AGENTS.md~: Project Structure section, file path references. +- ~.env.example~: remove stale ~SAFETY_BLOCK_SHELL~ (unused), update skill paths if any. +- ~ROADMAP.org~: update v0.4.2 and v0.4.3 TODOs (system-model-provider → neuro-provider, core-loop-reason → core-reason, system-actuator-shell → channel-shell) to match new names. + +*** Verify: ASDF compiles, FiveAM suite passes, integration tests pass. + +*** Token Economics (foundation complete — now build features) **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. @@ -902,7 +1057,7 @@ Rationale: The Merkle tree provides content-addressed storage. Combined with emb - ~memory-find-similar~ in ~core-memory.lisp~: given a vector, return N memory objects with highest cosine similarity. Uses ~memory-object-vector~ (already populated via ~ingest-ast~ → ~embeddings-compute~ since v0.4.0). ~30 lines. - ~memory-outcome-record~: store an outcome (success/failure plist) against a signal. Keyed by Merkle hash of the signal. ~25 lines. - ~memory-find-outcomes~: given a signal (current context), find similar past signals and their outcomes. Uses ~memory-find-similar~ on the signal's foveal vector. Returns ranked list of past approaches with success/failure labels. ~40 lines. -- Outcome data feeds into ~context-assemble-global-awareness~: when the foveal node has similar past interactions, include them in the context as "Historical: last 3 times you asked this, approach X succeeded, Y failed." +- Outcome data feeds into ~symbolic-awareness~ (formerly core-context, extracted from core): when the foveal node has similar past interactions, include them in the context as "Historical: last 3 times you asked this, approach X succeeded, Y failed." - FiveAM test: record 3 outcomes for similar signals, verify ~memory-find-outcomes~ returns them ranked by similarity. *** TODO Merkle learning documentation in Design Decisions @@ -926,7 +1081,7 @@ Rationale: The Merkle tree was designed for integrity, not learning. Its second Rationale: Without an evaluation harness, there is no way to know if the agent's capabilities improve or regress across releases. SWE-bench (v0.9.0) measures competitive ranking against other agents. The internal suite measures regression detection — it catches when v0.5.1 breaks something v0.5.0 could do. The suite starts with 10 tasks and grows with the codebase. -- New skill: ~system-evaluation.org~ (~system-evaluation.lisp~). +- New skill: ~symbolic-evaluation.org~ (~symbolic-evaluation.lisp~). - ~deftask~ macro: define an eval task with ~:setup~ (create test environment), ~:prompt~ (what to ask the agent), ~:verify~ (function that checks the output), ~:teardown~ (cleanup). Similar to ~defskill~ but for agent capabilities, not code. - ~run-eval-task~: inject ~:prompt~ as ~:user-input~ signal via ~stimulus-inject~, wait for completion (poll ~*memory-store*~ or signal status), run ~:verify~ on the result, return ~(:passed)~ or ~(:failed :reason ...)~. - ~run-eval-suite~: run all registered eval tasks, produce score (pass count / total), per-task diagnostics, summary. diff --git a/lisp/core-communication.lisp b/lisp/core-communication.lisp index d644083..fc39b5d 100644 --- a/lisp/core-communication.lisp +++ b/lisp/core-communication.lisp @@ -62,7 +62,7 @@ (let ((stream (usocket:socket-stream socket))) (handler-case (progn - (format stream "~a" (frame-message (make-hello-message "0.4.0"))) + (format stream "~a" (frame-message (make-hello-message "0.4.2"))) (finish-output stream) (loop (let ((msg (read-framed-message stream))) diff --git a/lisp/core-defpackage.lisp b/lisp/core-defpackage.lisp index 13e6367..4ca3ec8 100644 --- a/lisp/core-defpackage.lisp +++ b/lisp/core-defpackage.lisp @@ -62,7 +62,7 @@ #:loop-gate-reason #:cognitive-verify #:backend-cascade-call - #:register-pre-reason-handler + #:json-alist-to-plist #:inject-stimulus #:stimulus-inject #:hitl-create diff --git a/lisp/core-loop-reason.lisp b/lisp/core-loop-reason.lisp index 3948e59..bedb210 100644 --- a/lisp/core-loop-reason.lisp +++ b/lisp/core-loop-reason.lisp @@ -21,7 +21,8 @@ (defun backend-cascade-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) - (context nil)) + (context nil) + tools) (let ((backends (or cascade *provider-cascade*)) (result nil)) (dolist (backend backends (or result @@ -35,20 +36,26 @@ (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))))) + (apply backend-fn + (append (list prompt system-prompt :model model) + (when tools (list :tools tools))))))) (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)) + (let ((tool-calls (getf r :tool-calls))) + (if tool-calls + (return (list :status :success :tool-calls tool-calls)) + (progn + (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) + (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 "")) @@ -91,11 +98,33 @@ (if standing-mandates-text (concatenate 'string (string #\Newline) standing-mandates-text) "") - tool-belt global-context system-logs))) - (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)))) + tool-belt global-context system-logs)) + (api-tools (let ((tools nil)) + (maphash (lambda (k tool) + (declare (ignore k)) + (push (list :name (cognitive-tool-name tool) + :description (cognitive-tool-description tool) + :parameters (cognitive-tool-parameters tool)) + tools)) + *cognitive-tool-registry*) + (when tools tools)))) + (let* ((thought (backend-cascade-call raw-prompt + :system-prompt system-prompt + :context context + :tools api-tools)) + (tool-calls (and (listp thought) (getf thought :tool-calls)))) + (if tool-calls + (let* ((first-call (car tool-calls)) + (tool-name (getf first-call :name)) + (args (getf first-call :arguments)) + (args-plist (json-alist-to-plist args))) + (list :TYPE :REQUEST + :PAYLOAD (list* :TOOL tool-name + :ARGS args-plist + :EXPLANATION "Generated by function-calling engine."))) + (let* ((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 (let ((*read-eval* nil)) (read-from-string cleaned)))) @@ -113,7 +142,18 @@ 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.")))))) + (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine.")))))))) + +(defun json-alist-to-plist (alist) + "Convert a JSON alist to a keyword-prefixed plist." + (when (listp alist) + (loop for (key . value) in alist + append (list (intern (string-upcase (string key)) :keyword) + (if (listp value) + (if (consp (car value)) + (json-alist-to-plist value) + value) + value))))) (defun cognitive-verify (proposed-action context) "Runs all registered deterministic gates against the proposed action, @@ -307,4 +347,47 @@ sorted by priority (highest first). Returns a rejection plist or the action." (result (passepartout::think ctx))) (is (not (eq passepartout::*v031-rce-test* :PWNED))) (is (eq :REQUEST (getf result :TYPE))) - (setf *read-eval* nil)))) + (setf *read-eval* nil)))) + +(test test-json-alist-to-plist-simple + "Contract 5: converts simple alist to keyword plist." + (let ((alist (list (cons "action" "shell") (cons "cmd" "echo hello")))) + (let ((result (json-alist-to-plist alist))) + (is (eq :ACTION (first result))) + (is (string= "shell" (second result))) + (is (eq :CMD (third result))) + (is (string= "echo hello" (fourth result)))))) + +(test test-json-alist-to-plist-nested + "Contract 5: nested alists recurse into nested plists." + (let ((alist (list (cons "tool" "write-file") + (cons "args" (list (cons "filepath" "/tmp/x") + (cons "content" "hi")))))) + (let ((result (json-alist-to-plist alist))) + (is (eq :TOOL (first result))) + (is (eq :ARGS (third result))) + (let ((inner (fourth result))) + (is (eq :FILEPATH (first inner))) + (is (string= "/tmp/x" (second inner))) + (is (eq :CONTENT (third inner))))))) + +(test test-json-alist-to-plist-array-passthrough + "Contract 5: JSON arrays pass through unchanged." + (let ((alist (list (cons "names" (list "alice" "bob"))))) + (let ((result (json-alist-to-plist alist))) + (is (eq :NAMES (first result))) + (is (equal (list "alice" "bob") (second result)))))) + +(test test-json-alist-to-plist-null + "Contract 5: nil passes through unchanged." + (let ((result (json-alist-to-plist nil))) + (is (null result)))) + +(test test-json-alist-to-plist-scalar + "Contract 5: scalar values pass through." + (let ((alist (list (cons "count" 42) (cons "active" :true)))) + (let ((result (json-alist-to-plist alist))) + (is (eq :COUNT (first result))) + (is (= 42 (second result))) + (is (eq :ACTIVE (third result))) + (is (eq :true (fourth result)))))) diff --git a/lisp/system-diagnostics.lisp b/lisp/system-diagnostics.lisp index 2236a0d..26f5d4b 100644 --- a/lisp/system-diagnostics.lisp +++ b/lisp/system-diagnostics.lisp @@ -1,14 +1,12 @@ (in-package :passepartout) -(defvar *diagnostics-binaries* '("sbcl" "emacs" "git" "socat" "nc") +(defvar *diagnostics-binaries* '("sbcl" "emacs" "git") "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.") diff --git a/lisp/system-model-provider.lisp b/lisp/system-model-provider.lisp index a8d7efa..7418c1d 100644 --- a/lisp/system-model-provider.lisp +++ b/lisp/system-model-provider.lisp @@ -24,8 +24,9 @@ (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." +(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter) tools) + "Executes a request against any OpenAI-compatible API endpoint. +When :tools is provided, includes function-calling tool definitions in the request." (let* ((config (provider-config provider)) (base-url (getf config :base-url)) (key-env (getf config :key-env)) @@ -47,22 +48,42 @@ ,@(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) ))))))) + (body (let ((base `((model . ,model-id) + (messages . (( (role . "system") (content . ,system-prompt) ) + ( (role . "user") (content . ,prompt) )))))) + (if tools + (append base + `((tools . ,(loop for tool in tools + collect (list (cons :|type| "function") + (cons :|function| (loop for (k v) on tool by #'cddr + collect (cons (intern (string-upcase (string k)) "KEYWORD") v)))))) + (:|tool_choice| . "auto"))) + base))) + (body-json (cl-json:encode-json-to-string body))) (handler-case - (let* ((response (dex:post url :headers headers :content body + (let* ((response (dex:post url :headers headers :content body-json :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))) + (tool-calls (cdr (assoc :|tool_calls| message))) (content (cdr (assoc :content message)))) - (if content - (list :status :success :content content) - (list :status :error :message (format nil "~a: No content" provider)))) + (cond + (tool-calls + (list :status :success + :tool-calls + (loop for tc in tool-calls + for fun = (cdr (assoc :|function| tc)) + for args-str = (cdr (assoc :|arguments| fun)) + for args = (when args-str (cl-json:decode-json-from-string args-str)) + collect (list :name (cdr (assoc :|name| fun)) + :arguments args)))) + (content + (list :status :success :content content)) + (t + (list :status :error :message (format nil "~a: No content" provider))))) (error (c) (list :status :error :message (format nil "~a Failure: ~a" provider c)))))) @@ -73,8 +94,8 @@ (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))))))) + (lambda (prompt system-prompt &key model tools) + (provider-openai-request prompt system-prompt :model model :provider provider :tools tools))))))) (defun provider-cascade-initialize () "Reads PROVIDER_CASCADE from env and sets *provider-cascade*." @@ -139,3 +160,8 @@ If API-KEY is nil, reads from environment." (let ((config (provider-config :openrouter))) (fiveam:is (listp config)) (fiveam:is (getf config :base-url)))) + +(fiveam:test test-provider-accepts-tools-parameter + "Contract 4: provider-openai-request accepts :tools parameter without error." + (let ((result (provider-openai-request "test" "system" :tools (list)))) + (fiveam:is (member (getf result :status) '(:success :error))))) diff --git a/org/core-communication.org b/org/core-communication.org index 754a2e9..53dc902 100644 --- a/org/core-communication.org +++ b/org/core-communication.org @@ -151,7 +151,7 @@ The daemon sends a handshake message on connection, then enters a read loop, inj (let ((stream (usocket:socket-stream socket))) (handler-case (progn - (format stream "~a" (frame-message (make-hello-message "0.4.0"))) + (format stream "~a" (frame-message (make-hello-message "0.4.2"))) (finish-output stream) (loop (let ((msg (read-framed-message stream))) diff --git a/org/core-defpackage.org b/org/core-defpackage.org index f5212ca..4f3fdf2 100644 --- a/org/core-defpackage.org +++ b/org/core-defpackage.org @@ -87,7 +87,7 @@ The package definition. All public symbols are exported here. #:loop-gate-reason #:cognitive-verify #:backend-cascade-call - #:register-pre-reason-handler + #:json-alist-to-plist #:inject-stimulus #:stimulus-inject #:hitl-create diff --git a/org/core-loop-reason.org b/org/core-loop-reason.org index dfaaebf..f849c4e 100644 --- a/org/core-loop-reason.org +++ b/org/core-loop-reason.org @@ -51,6 +51,11 @@ This is not a cosmetic choice. It means the reasoning pipeline can generate, mod 4. (backend-cascade-call prompt): iterates ~*provider-cascade*~ calling each backend's handler until one succeeds. Returns the LLM content string, or a ~:LOG~ failure if all backends are exhausted. +5. (json-alist-to-plist alist): converts a JSON alist (from + ~cl-json:decode-json-from-string~) to a keyword-prefixed plist. + String keys → upcased keywords. Nested alists recurse into plists. + JSON arrays (lists whose first element is not a cons) pass through. + Scalars and nil pass through. * Implementation @@ -136,7 +141,8 @@ This is deliberately resilient. The system should never crash because an LLM pro (defun backend-cascade-call (prompt &key (system-prompt "You are the Probabilistic engine.") (cascade nil) - (context nil)) + (context nil) + tools) (let ((backends (or cascade *provider-cascade*)) (result nil)) (dolist (backend backends (or result @@ -150,20 +156,33 @@ This is deliberately resilient. The system should never crash because an LLM pro (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))))) + (apply backend-fn + (append (list prompt system-prompt :model model) + (when tools (list :tools tools))))))) (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)) + (let ((tool-calls (getf r :tool-calls))) + (if tool-calls + (return (list :status :success :tool-calls tool-calls)) + (progn + (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) + (t + (log-message "PROBABILISTIC: Backend ~a failed: ~a" + backend (getf r :message)))))))))) +#+end_src + +** Markdown Strip + +The LLM might wrap its output in Markdown code fences (~```~). This function strips them before parsing. It also strips trailing/leading whitespace. + +;; REPL-VERIFIED: 2026-05-03T13:00:00 +#+begin_src lisp +(defun markdown-strip (text) (if (and text (stringp text)) (let ((cleaned text)) (setf cleaned (cl-ppcre:regex-replace-all "^```[a-z]*\\n" cleaned "")) @@ -227,11 +246,33 @@ The system prompt assembly order — identity (including mandates), tools, conte (if standing-mandates-text (concatenate 'string (string #\Newline) standing-mandates-text) "") - tool-belt global-context system-logs))) - (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)))) + tool-belt global-context system-logs)) + (api-tools (let ((tools nil)) + (maphash (lambda (k tool) + (declare (ignore k)) + (push (list :name (cognitive-tool-name tool) + :description (cognitive-tool-description tool) + :parameters (cognitive-tool-parameters tool)) + tools)) + *cognitive-tool-registry*) + (when tools tools)))) + (let* ((thought (backend-cascade-call raw-prompt + :system-prompt system-prompt + :context context + :tools api-tools)) + (tool-calls (and (listp thought) (getf thought :tool-calls)))) + (if tool-calls + (let* ((first-call (car tool-calls)) + (tool-name (getf first-call :name)) + (args (getf first-call :arguments)) + (args-plist (json-alist-to-plist args))) + (list :TYPE :REQUEST + :PAYLOAD (list* :TOOL tool-name + :ARGS args-plist + :EXPLANATION "Generated by function-calling engine."))) + (let* ((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 (let ((*read-eval* nil)) (read-from-string cleaned)))) @@ -249,7 +290,26 @@ The system prompt assembly order — identity (including mandates), tools, conte 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.")))))) + (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine.")))))))) +#+end_src + +** JSON-to-Plist Conversion (json-alist-to-plist) + +Converts a JSON alist as returned by ~cl-json:decode-json-from-string~ to a keyword-prefixed plist — the internal data format that ~cognitive-verify~ and the actuator layer expect. This is the boundary where the probabilistic layer's output format (JSON) meets the deterministic layer's input format (plists). + +String keys are interned as upcased keywords (~"action" → :ACTION~). Nested alists recurse. JSON arrays (lists whose first element is an atom) pass through unchanged since the actuator layer handles list arguments natively. + +#+begin_src lisp +(defun json-alist-to-plist (alist) + "Convert a JSON alist to a keyword-prefixed plist." + (when (listp alist) + (loop for (key . value) in alist + append (list (intern (string-upcase (string key)) :keyword) + (if (listp value) + (if (consp (car value)) + (json-alist-to-plist value) + value) + value))))) #+end_src ** Deterministic Engine (cognitive-verify) @@ -490,5 +550,48 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r (result (passepartout::think ctx))) (is (not (eq passepartout::*v031-rce-test* :PWNED))) (is (eq :REQUEST (getf result :TYPE))) - (setf *read-eval* nil)))) + (setf *read-eval* nil)))) + +(test test-json-alist-to-plist-simple + "Contract 5: converts simple alist to keyword plist." + (let ((alist (list (cons "action" "shell") (cons "cmd" "echo hello")))) + (let ((result (json-alist-to-plist alist))) + (is (eq :ACTION (first result))) + (is (string= "shell" (second result))) + (is (eq :CMD (third result))) + (is (string= "echo hello" (fourth result)))))) + +(test test-json-alist-to-plist-nested + "Contract 5: nested alists recurse into nested plists." + (let ((alist (list (cons "tool" "write-file") + (cons "args" (list (cons "filepath" "/tmp/x") + (cons "content" "hi")))))) + (let ((result (json-alist-to-plist alist))) + (is (eq :TOOL (first result))) + (is (eq :ARGS (third result))) + (let ((inner (fourth result))) + (is (eq :FILEPATH (first inner))) + (is (string= "/tmp/x" (second inner))) + (is (eq :CONTENT (third inner))))))) + +(test test-json-alist-to-plist-array-passthrough + "Contract 5: JSON arrays pass through unchanged." + (let ((alist (list (cons "names" (list "alice" "bob"))))) + (let ((result (json-alist-to-plist alist))) + (is (eq :NAMES (first result))) + (is (equal (list "alice" "bob") (second result)))))) + +(test test-json-alist-to-plist-null + "Contract 5: nil passes through unchanged." + (let ((result (json-alist-to-plist nil))) + (is (null result)))) + +(test test-json-alist-to-plist-scalar + "Contract 5: scalar values pass through." + (let ((alist (list (cons "count" 42) (cons "active" :true)))) + (let ((result (json-alist-to-plist alist))) + (is (eq :COUNT (first result))) + (is (= 42 (second result))) + (is (eq :ACTIVE (third result))) + (is (eq :true (fourth result)))))) #+end_src diff --git a/org/core-manifest.org b/org/core-manifest.org index 2860c3d..0aa64d9 100644 --- a/org/core-manifest.org +++ b/org/core-manifest.org @@ -22,7 +22,7 @@ Components are loaded in sequence (~:serial t~): package first (defines the publ (defsystem :passepartout :name "Passepartout" :author "Amr Gharbeia" - :version "0.4.0" + :version "0.4.2" :license "AGPLv3" :description "The Probabilistic-Deterministic Lisp Machine" :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid) diff --git a/org/system-diagnostics.org b/org/system-diagnostics.org index 5fa1a40..b62b06e 100644 --- a/org/system-diagnostics.org +++ b/org/system-diagnostics.org @@ -34,7 +34,7 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH` ** Global Configuration ;; REPL-VERIFIED: 2026-05-03T13:00:00 #+begin_src lisp -(defvar *diagnostics-binaries* '("sbcl" "emacs" "git" "socat" "nc") +(defvar *diagnostics-binaries* '("sbcl" "emacs" "git") "List of external binaries required for full system operation.") #+end_src @@ -45,8 +45,6 @@ Binary detection must use shell probing (`which`) to account for varying `$PATH` '(("sbcl" . "sbcl") ("emacs" . "emacs") ("git" . "git") - ("socat" . "socat") - ("nc" . "netcat-openbsd") ("curl" . "curl") ("rlwrap" . "rlwrap")) "Map binary names to apt package names.") diff --git a/org/system-model-provider.org b/org/system-model-provider.org index f8d46ad..6844d44 100644 --- a/org/system-model-provider.org +++ b/org/system-model-provider.org @@ -22,6 +22,13 @@ Providers register themselves at boot. No API key? That provider doesn't registe 3. (provider-openai-request prompt system-prompt &key model provider): executes an OpenAI-compatible /v1/chat/completions request. Returns ~(:status :success :content ...)~ or ~(:status :error :message ...)~. +4. (provider-openai-request prompt system-prompt &key model provider tools): + when ~:tools~ is provided (a list of plist tool definitions), the request + body includes ~"tools"~ and ~"tool_choice": "auto"~ fields. Parses + ~tool_calls~ from the response: extracts ~function.name~ and + ~function.arguments~ (decoded from JSON string to alist). Returns + ~(:status :success :tool-calls ((:name :arguments )))~ + when the LLM returns a tool call, or the existing ~:content~ path otherwise. 4. (provider-cascade-initialize): reads ~PROVIDER_CASCADE~ from env and sets ~*provider-cascade*~. @@ -64,8 +71,9 @@ Providers register themselves at boot. No API key? That provider doesn't registe ** Unified request execution #+begin_src lisp -(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter)) - "Executes a request against any OpenAI-compatible API endpoint." +(defun provider-openai-request (prompt system-prompt &key model (provider :openrouter) tools) + "Executes a request against any OpenAI-compatible API endpoint. +When :tools is provided, includes function-calling tool definitions in the request." (let* ((config (provider-config provider)) (base-url (getf config :base-url)) (key-env (getf config :key-env)) @@ -87,22 +95,42 @@ Providers register themselves at boot. No API key? That provider doesn't registe ,@(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) ))))))) + (body (let ((base `((model . ,model-id) + (messages . (( (role . "system") (content . ,system-prompt) ) + ( (role . "user") (content . ,prompt) )))))) + (if tools + (append base + `((tools . ,(loop for tool in tools + collect (list (cons :|type| "function") + (cons :|function| (loop for (k v) on tool by #'cddr + collect (cons (intern (string-upcase (string k)) "KEYWORD") v)))))) + (:|tool_choice| . "auto"))) + base))) + (body-json (cl-json:encode-json-to-string body))) (handler-case - (let* ((response (dex:post url :headers headers :content body + (let* ((response (dex:post url :headers headers :content body-json :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))) + (tool-calls (cdr (assoc :|tool_calls| message))) (content (cdr (assoc :content message)))) - (if content - (list :status :success :content content) - (list :status :error :message (format nil "~a: No content" provider)))) + (cond + (tool-calls + (list :status :success + :tool-calls + (loop for tc in tool-calls + for fun = (cdr (assoc :|function| tc)) + for args-str = (cdr (assoc :|arguments| fun)) + for args = (when args-str (cl-json:decode-json-from-string args-str)) + collect (list :name (cdr (assoc :|name| fun)) + :arguments args)))) + (content + (list :status :success :content content)) + (t + (list :status :error :message (format nil "~a: No content" provider))))) (error (c) (list :status :error :message (format nil "~a Failure: ~a" provider c)))))) #+end_src @@ -116,8 +144,8 @@ Providers register themselves at boot. No API key? That provider doesn't registe (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))))))) + (lambda (prompt system-prompt &key model tools) + (provider-openai-request prompt system-prompt :model model :provider provider :tools tools))))))) #+end_src ** Initialize cascade @@ -198,4 +226,9 @@ If API-KEY is nil, reads from environment." (let ((config (provider-config :openrouter))) (fiveam:is (listp config)) (fiveam:is (getf config :base-url)))) + +(fiveam:test test-provider-accepts-tools-parameter + "Contract 4: provider-openai-request accepts :tools parameter without error." + (let ((result (provider-openai-request "test" "system" :tools (list)))) + (fiveam:is (member (getf result :status) '(:success :error))))) #+end_src diff --git a/passepartout.asd b/passepartout.asd index 85d0dce..8452555 100644 --- a/passepartout.asd +++ b/passepartout.asd @@ -1,7 +1,7 @@ (defsystem :passepartout :name "Passepartout" :author "Amr Gharbeia" - :version "0.4.0" + :version "0.4.2" :license "AGPLv3" :description "The Probabilistic-Deterministic Lisp Machine" :depends-on (:usocket :bordeaux-threads :dexador :uiop :cl-dotenv :cl-ppcre :hunchentoot :ironclad :str :cl-json :uuid)