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

passepartout: v0.4.2 Structured Output
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 3s
Details

Browse Source 
- 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
This commit is contained in:
Amr Gharbeia
2026-05-07 17:39:08 -04:00
parent 639bc348d9
commit 791a0f9c3b
14 changed files with 476 additions and 79 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
lisp/core-communication.lisp
View File

@@ -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)))

2
lisp/core-defpackage.lisp
View File

@@ -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

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

@@ -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))))))

4
lisp/system-diagnostics.lisp
View File

@@ -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.")

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

@@ -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)))))