Amr Gharbeia
908936d4d3
- Rename gateway-provider → system-model-provider (generic :local provider, no hardcoded ollama) - Rename gateway-llm → system-model (model-request dispatcher) - Rename system-embedding-gateway → system-model-embedding - Rename gateway-manager → gateway-messaging (public api renamed to messaging-*) - Add system-model-explorer (model discovery via OpenRouter API, cached, per-slot recommendations) - Fix skill loader export: replace prefix-matching with fbound/boundp-based export (20 skills now export) - Add model-router to skill-loader exclusion list (loaded via CLI) - De-ollama: remove hardcoded assumed-available patterns from provider pipeline - Default cascade: cloud-only (openrouter, openai, groq, gemini, deepseek, nvidia, anthropic) - Env example: add LOCAL_BASE_URL, fix cascade order - All org files updated with architectural prose (literate programming)
250 lines
7.6 KiB
Common Lisp
250 lines
7.6 KiB
Common Lisp
(defpackage :passepartout
|
|
(:use :cl)
|
|
(:export
|
|
#: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
|
|
#:start-daemon
|
|
#:stop-daemon
|
|
#:log-message
|
|
#:main
|
|
#:doctor-run-all
|
|
#:doctor-main
|
|
#:doctor-check-dependencies
|
|
#:doctor-check-env
|
|
#:register-provider
|
|
#:system-ready-p
|
|
#:run-setup-wizard
|
|
#:skill-gateway-register
|
|
#:skill-gateway-link
|
|
#:messaging-list-print
|
|
#:messaging-link
|
|
#:messaging-unlink
|
|
#:ingest-ast
|
|
#:memory-object-get
|
|
#:list-objects-by-type
|
|
#:org-id-new
|
|
#:*memory-store*
|
|
#:*history-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-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
|
|
#:telemetry-track
|
|
#:context-assemble-global-awareness
|
|
#:context-query
|
|
#:process-signal
|
|
#:loop-process
|
|
#:perceive-gate
|
|
#:probabilistic-gate
|
|
#:consensus-gate
|
|
#:act-gate
|
|
#:reason-gate
|
|
#:dispatch-gate
|
|
#:register-pre-reason-handler
|
|
#:inject-stimulus
|
|
#:stimulus-inject
|
|
#:hitl-create
|
|
#:hitl-approve
|
|
#:hitl-deny
|
|
#:hitl-handle-message
|
|
#:actuator-initialize
|
|
#:dispatch-action
|
|
#:register-actuator
|
|
#:load-skill-from-org
|
|
#:skill-initialize-all
|
|
#:load-skill-with-timeout
|
|
#:topological-sort-skills
|
|
#:validate-lisp-syntax
|
|
#:defskill
|
|
#:*skill-registry*
|
|
#:*scope-resolver*
|
|
#:*embedding-backend*
|
|
#:*embedding-queue*
|
|
#:*embedding-provider*
|
|
#:embed-queue-object
|
|
#:embed-object
|
|
#:embed-all-pending
|
|
#:embeddings-compute
|
|
#:skill
|
|
#:skill-name
|
|
#:skill-priority
|
|
#:skill-dependencies
|
|
#:skill-trigger-fn
|
|
#:skill-probabilistic-prompt
|
|
#:skill-deterministic-fn
|
|
#:def-cognitive-tool
|
|
#:*cognitive-tool-registry*
|
|
#:verify-git-clean-p
|
|
#:engineering-standards-verify-lisp
|
|
#:engineering-standards-format-lisp
|
|
#:literate-check-block-balance
|
|
#:check-tangle-sync
|
|
#:*tangle-targets*
|
|
#:utils-org-read-file
|
|
#:utils-org-write-file
|
|
#:utils-org-add-headline
|
|
#:utils-org-set-property
|
|
#:utils-org-set-todo
|
|
#:utils-org-find-headline-by-id
|
|
#:utils-org-find-headline-by-title
|
|
#:utils-org-generate-id
|
|
#:utils-org-id-format
|
|
#:utils-org-ast-to-org
|
|
#:utils-org-modify
|
|
#:utils-lisp-validate
|
|
#:utils-lisp-check-structural
|
|
#:utils-lisp-check-syntactic
|
|
#:utils-lisp-check-semantic
|
|
#:utils-lisp-eval
|
|
#:utils-lisp-format
|
|
#:utils-lisp-list-definitions
|
|
#:utils-lisp-structural-extract
|
|
#:utils-lisp-structural-wrap
|
|
#:utils-lisp-structural-inject
|
|
#:utils-lisp-structural-slurp
|
|
#:utils-lisp-register
|
|
#:get-oc-config-dir
|
|
#:prompt-for
|
|
#:save-secret
|
|
#:get-tool-permission
|
|
#:set-tool-permission
|
|
#:check-tool-permission-gate
|
|
#:cognitive-tool
|
|
#:cognitive-tool-name
|
|
#:cognitive-tool-description
|
|
#:cognitive-tool-parameters
|
|
#:cognitive-tool-guard
|
|
#:cognitive-tool-body
|
|
#:*emacs-clients*
|
|
#:*clients-lock*
|
|
#:register-emacs-client
|
|
#:unregister-emacs-client
|
|
#:ask-probabilistic
|
|
#:register-probabilistic-backend
|
|
#:distill-prompt
|
|
#:*probabilistic-backends*
|
|
#:*provider-cascade*
|
|
#:vault-get-secret
|
|
#:vault-set-secret
|
|
#:memory-objects-by-attribute
|
|
#:deterministic-verify
|
|
#:find-headline-missing-id))
|
|
|
|
(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 doctor~%")
|
|
(format t "│ For system diagnostics~%")
|
|
(format t "└─────────────────────────────────────────────┘~%")
|
|
(format t "~%")
|
|
(format t "Details: ~A~%" condition)
|
|
(finish-output)
|
|
(uiop:quit 1)))
|