passepartout: v0.4.2 Structured Output

- json-alist-to-plist: JSON alist-to-keyword-plist converter (core-loop-reason) - provider-openai-request: accept :tools parameter, build tool definitions in request body, parse tool_calls from response (system-model-provider) - think(): build tools from cognitive-tool-registry, pass to backend cascade, handle :tool-calls response via json-alist-to-plist (core-loop-reason) - backend-cascade-call: accept and propagate :tools parameter - Diagnostics: remove nc/socat from required binaries — health check passes - Version: 0.4.0 -> 0.4.2 across handshake, ASDF, README badge
2026-05-07 17:39:08 -04:00
parent 639bc348d9
commit 791a0f9c3b
14 changed files with 476 additions and 79 deletions
--- 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)))
--- 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
--- 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
--- 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)
--- 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.")
--- 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 <str> :arguments <alist>)))~
+   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