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

CORE: Enable OACP :eval, update Gemini v1 endpoints, and improved neural cleaning logic.

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-07 10:42:59 -04:00
parent 26920b135a
commit b917ea45b4
4 changed files with 194 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files

153
docs/README.org
View File

@@ -212,7 +212,11 @@ The physical implementation of the daemon, tangled from this Org document into =
#:org-id-new
;; --- AST Helpers ---
#:find-headline-missing-id))
#:find-headline-missing-id
;; --- Environment Config ---
#:set-llm-model
#:get-llm-model))
#+end_src
** Communication (OACP)
@@ -414,66 +418,87 @@ The physical implementation of the daemon, tangled from this Org document into =
(defvar *auth-providers* (make-hash-table :test 'equal))
(defun register-auth-provider (name fn) (setf (gethash name *auth-providers*) fn))
(defun get-provider-auth (provider)
"Retrieves authentication credentials for a provider.
Supports direct plists, functions, or environment variable fallbacks."
"Retrieves authentication credentials for a provider.
Supports direct plists, functions, or specific environment variable fallbacks."
(let ((auth (gethash provider *auth-providers*)))
(cond
((functionp auth) (funcall auth))
((listp auth) auth)
(t (case provider
(:gemini (list :api-key (uiop:getenv "GEMINI_API_KEY")))
(:openrouter (list :api-key (uiop:getenv "OPENROUTER_API_KEY")))
(t nil))))))
(t
(let ((specific-key (case provider
(:gemini (uiop:getenv "GEMINI_API_KEY"))
(:openrouter (uiop:getenv "OPENROUTER_API_KEY"))
(:anthropic (uiop:getenv "ANTHROPIC_API_KEY"))
(:openai (uiop:getenv "OPENAI_API_KEY"))
(t nil))))
(if (and specific-key (> (length specific-key) 0))
(list :api-key specific-key)
;; Final fallback to the legacy generic key
(let ((legacy (uiop:getenv "LLM_API_KEY")))
(when (and legacy (> (length legacy) 0))
(list :api-key legacy)))))))))
(defvar *neuro-backends* (make-hash-table :test 'equal))
(defvar *provider-cascade* '(:gemini))
(defvar *provider-cascade* '(:openrouter :gemini))
(defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn))
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil))
(let ((backends (or cascade *provider-cascade*)))
(defun ask-neuro (prompt &key (system-prompt "You are the System 1 engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
"Dispatches a neural request through the provider cascade.
If CASCADE is a function, it is called with CONTEXT to determine backends."
(let ((backends (cond
((and cascade (listp cascade)) cascade)
((functionp cascade) (funcall cascade context))
((functionp *provider-cascade*) (funcall *provider-cascade* context))
(t *provider-cascade*))))
(dolist (backend backends)
(let ((backend-fn (gethash backend *neuro-backends*)))
(when backend-fn
(kernel-log "SYSTEM 1: Attempting backend ~a..." backend)
(let ((result (funcall backend-fn prompt system-prompt)))
(if (and (stringp result) (search ":LOG" result) (search "Failure" result))
(let* (;; Consult the Economist for the model ID if available
(model (ignore-errors
(uiop:symbol-call :org-agent.skills.org-skill-economist :economist-get-model-for-provider backend)))
(result (if model
(funcall backend-fn prompt system-prompt :model model)
(funcall backend-fn prompt system-prompt))))
(if (and (stringp result) (search ":LOG" result) (or (search "Failure" result) (search "missing" result)))
(kernel-log "SYSTEM 1: Backend ~a failed. Falling back..." backend)
(return-from ask-neuro result))))))
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))
(defun execute-gemini-request (prompt system-prompt)
(defun execute-gemini-request (prompt system-prompt &key model)
(let* ((auth (get-provider-auth :gemini)) (api-key (getf auth :api-key)) (bearer-token (getf auth :bearer-token))
(endpoint (or (getf auth :endpoint) "https://generativelanguage.googleapis.com/v1beta/models/gemini-pro:generateContent")))
(endpoint-base (if model (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" model)
"https://generativelanguage.googleapis.com/v1/models/gemini-1.5-flash:generateContent")))
(unless (or api-key bearer-token) (return-from execute-gemini-request "(:type :LOG :payload (:text \"Authentication missing\"))"))
(let* ((url (if api-key (format nil "~a?key=~a" endpoint api-key) endpoint))
(let* ((url (if api-key (format nil "~a?key=~a" endpoint-base api-key) endpoint-base))
(headers `(("Content-Type" . "application/json") ,@(when bearer-token `(("Authorization" . ,(format nil "Bearer ~a" bearer-token))))))
(body (cl-json:encode-json-to-string `((contents . ((parts . ((text . ,(format nil "~a~%~%Prompt: ~a" system-prompt prompt))))))))))
(handler-case (let* ((response (dex:post url :headers headers :content body :connect-timeout 10 :read-timeout 30)) (json (cl-json:decode-json-from-string response)))
(cdr (assoc :text (cdr (assoc :parts (car (cdr (assoc :parts (car (cdr (assoc :candidates json)))))))))))
(error (c) (format nil "(:type :LOG :payload (:text \"Neural Engine Failure: ~a\"))" c))))))
(defun execute-openrouter-request (prompt system-prompt)
(defun execute-openrouter-request (prompt system-prompt &key model)
(let ((api-key (uiop:getenv "OPENROUTER_API_KEY"))
(endpoint "https://openrouter.ai/api/v1/chat/completions")
(model "google/gemini-flash-1.5")) ; default fallback
;; Dynamically read user's preferred model from the Object Store
(maphash (lambda (id obj)
(declare (ignore id))
(let ((val (getf (org-object-attributes obj) :LLM_MODEL_OPENROUTER)))
(when val (setf model val))))
*object-store*)
(model-id (or model "google/gemini-2.0-flash-001")))
(unless api-key (return-from execute-openrouter-request "(:type :LOG :payload (:text \"OpenRouter API Key missing\"))"))
(let* ((headers `(("Content-Type" . "application/json")
("Authorization" . ,(format nil "Bearer ~a" api-key))
("HTTP-Referer" . "https://github.com/amr/org-agent")))
(body (cl-json:encode-json-to-string
`((model . ,model)
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))))
(handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30))
(json (cl-json:decode-json-from-string response)))
(cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json))))))))
(error (c) (format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c))))))
(body (cl-ppcre:regex-replace-all "\\\\/"
(cl-json:encode-json-to-string
`((model . ,model-id)
(messages . (( (role . "system") (content . ,system-prompt) )
( (role . "user") (content . ,prompt) )))))
"/")))
(kernel-log "OPENROUTER DEBUG - Body: ~a" body)
(handler-case (let* ((response (dex:post endpoint :headers headers :content body :connect-timeout 10 :read-timeout 30)))
(kernel-log "OPENROUTER DEBUG - Raw Response: ~a" response)
(let ((json (cl-json:decode-json-from-string response)))
(cdr (assoc :content (cdr (assoc :message (car (cdr (assoc :choices json)))))))))
(error (c)
(kernel-log "OPENROUTER ERROR: ~a" c)
(format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c))))))
(defun openrouter-get-available-models ()
"Fetches available models from OpenRouter."
@@ -522,9 +547,14 @@ The physical implementation of the daemon, tangled from this Org document into =
(let* ((prompt-generator (skill-neuro-prompt active-skill))
(prompt (when prompt-generator (funcall prompt-generator context))))
(if prompt
(let* ((thought (ask-neuro prompt))
;; Strip markdown code blocks
(cleaned-thought (cl-ppcre:regex-replace-all "(?s)^```(?:lisp)?\\n?(.*?)\\n?```$" (string-trim '(#\Space #\Newline #\Tab) thought) "\\1"))
(let* ((thought (ask-neuro prompt :context context))
;; Improved cleaning: Extract content between ``` blocks if they exist
(cleaned-thought
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought)))
(if match
(let ((regs (nth-value 1 (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" thought))))
(if (and regs (> (length regs) 0)) (elt regs 0) thought))
(string-trim '(#\Space #\Newline #\Tab) thought))))
(suggestion (ignore-errors (read-from-string cleaned-thought))))
(kernel-log "SYSTEM 1 Suggestion: ~a~%" cleaned-thought)
(cond
@@ -533,12 +563,12 @@ The physical implementation of the daemon, tangled from this Org document into =
((and (let ((p (getf context :payload))) (eq (getf p :sensor) :chat-message))
(> (length cleaned-thought) 0))
(kernel-log "SYSTEM 1: SALVAGING plain-text response.~%")
;; Remove common AI conversational filler at the start or end of the response
(let* ((no-prefix (cl-ppcre:regex-replace "(?i)^(okay,? |sure,? |i will |i've |i have |here is |got it\\.? |understood\\.? |done\\.? |yes,? )+" cleaned-thought ""))
(no-suffix (cl-ppcre:regex-replace "(?i)(\\s+okay,?|\\s+sure,?|\\s+got it\\.?|\\s+understood\\.?)$" no-prefix ""))
(payload-text (string-trim '(#\Space #\Newline #\Tab #\") no-suffix)))
`(:type :request :target :emacs :payload (:action :insert-at-end :buffer "*org-agent-chat*" :text ,payload-text))))
(t (kernel-log "SYSTEM 1 ERROR: Could not parse response as Lisp plist.~%") nil))) '(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
(let* ((no-prefix (cl-ppcre:regex-replace "(?i)^(okay,? |sure,? |i will |i've |i have |here is |got it\\.? |understood\\.? |done\\.? |yes,? )+" cleaned-thought "")))
`(:target :emacs :payload (:action :insert-at-end :buffer "*org-agent-chat*" :text ,no-prefix))))
(t
(kernel-log "SYSTEM 1 ERROR: Could not parse response as Lisp plist.~%")
nil)))
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
nil)))
(defun distill-prompt (full-prompt successful-output)
@@ -689,6 +719,12 @@ The physical implementation of the daemon, tangled from this Org document into =
(declare (ignore context))
(let* ((payload (ignore-errors (getf action :payload))) (cmd (ignore-errors (getf payload :action))))
(case cmd
(:eval (let ((code (getf payload :code)))
(kernel-log "ACTUATOR [System] - Evaluating: ~a" code)
(handler-case (let ((result (eval (read-from-string code))))
(kernel-log "ACTUATOR [System] - Result: ~s" result)
result)
(error (c) (kernel-log "ACTUATOR ERROR [System] - Eval failed: ~a" c)))))
(:create-skill (let* ((filename (getf payload :filename)) (content (getf payload :content))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent))) (full-path (merge-pathnames filename skills-dir)))
(kernel-log "ACTUATOR [System] - Creating skill ~a..." filename)
@@ -699,17 +735,21 @@ The physical implementation of the daemon, tangled from this Org document into =
(t (kernel-log "ACTUATOR [System] - Unknown command ~s" cmd)))))
(defun cognitive-loop (raw-message)
(let* ((start-time (get-internal-real-time))
(let* ((start-time (get-internal-real-time))
(type (getf raw-message :type))
(perceive-fn (find-symbol "PERCEIVE" :org-agent))
(context (if perceive-fn (funcall perceive-fn raw-message) raw-message))
(skill (find-triggered-skill context))
(skill-name (when skill (skill-name skill))))
(context (if perceive-fn (funcall perceive-fn raw-message) raw-message)))
(snapshot-object-store)
(let* ((proposed-action (think context)) (approved-action (decide proposed-action context))
(status (if (and proposed-action (null approved-action)) :rejected :success))
(duration (- (get-internal-real-time) start-time)))
(when skill-name (kernel-track-telemetry skill-name duration status))
(dispatch-action approved-action context))))
(if (eq type :REQUEST)
(dispatch-action raw-message context)
(let* ((skill (find-triggered-skill context))
(skill-name (when skill (skill-name skill)))
(proposed-action (think context))
(approved-action (decide proposed-action context))
(status (if (and proposed-action (null approved-action)) :rejected :success))
(duration (- (get-internal-real-time) start-time)))
(when skill-name (kernel-track-telemetry skill-name duration status))
(dispatch-action approved-action context)))))
(defun perceive (raw-message)
(let ((type (getf raw-message :type)) (payload (getf raw-message :payload)))
@@ -721,10 +761,9 @@ The physical implementation of the daemon, tangled from this Org document into =
((eq type :RESPONSE) (kernel-log "ACT RESULT: ~a" (getf payload :status))))
raw-message))
(defun start-heartbeat ()
(let ((interval (or (ignore-errors (parse-integer (get-env "HEARTBEAT_INTERVAL") :junk-allowed t)) 60)))
(setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) (kernel-log "KERNEL: Heartbeat pulse...")
(inject-stimulus `(:type :EVENT :payload (:sensor :heartbeat :unix-time ,(get-universal-time)))))) :name "org-agent-heartbeat"))))
(defun start-heartbeat (&optional (interval 60))
(setf *heartbeat-thread* (bt:make-thread (lambda () (loop (sleep interval) (kernel-log "KERNEL: Heartbeat pulse...")
(inject-stimulus `(:type :EVENT :payload (:sensor :heartbeat :unix-time ,(get-universal-time)))))) :name "org-agent-heartbeat")))
(defun stop-heartbeat () (when (and *heartbeat-thread* (bt:thread-alive-p *heartbeat-thread*)) (bt:destroy-thread *heartbeat-thread*) (setf *heartbeat-thread* nil)))
@@ -782,7 +821,7 @@ The physical implementation of the daemon, tangled from this Org document into =
(kernel-log "DAEMON: Client disconnected.~%")
(ignore-errors (close stream))))
(defun start-daemon (&key port)
(defun start-daemon (&key port interval)
(let* ((env-host (uiop:getenv "DAEMON_HOST")) (env-port (uiop:getenv "ORG_AGENT_DAEMON_PORT"))
(listen-host (if env-host (string-trim " \"'" env-host) "127.0.0.1"))
(listen-port (or (or port (when env-port (ignore-errors (parse-integer (string-trim " \"'" env-port) :junk-allowed t)))) 9105)))
@@ -790,7 +829,7 @@ The physical implementation of the daemon, tangled from this Org document into =
(register-actuator :emacs (lambda (action context)
(declare (ignore context))
(kernel-log "ACTUATOR [Emacs] - Action: ~a~%" action)))
(start-heartbeat)
(start-heartbeat (or interval 60))
(kernel-log "DAEMON: Binding to ~a:~a..." listen-host listen-port)
(setf *daemon-socket* (usocket:socket-listen listen-host listen-port :reuse-address t))
(setf *daemon-thread* (bt:make-thread (lambda () (unwind-protect (loop (handler-case (let ((client-socket (usocket:socket-accept *daemon-socket*)))
@@ -811,7 +850,9 @@ The physical implementation of the daemon, tangled from this Org document into =
(format t "KERNEL: Loading environment from ~a~%" env-file)
(cl-dotenv:load-env env-file))
(format t "KERNEL ERROR: .env not found at ~a~%" env-file)))
(start-daemon)
(let ((interval (or (ignore-errors (parse-integer (uiop:getenv "HEARTBEAT_INTERVAL") :junk-allowed t)) 60)))
(format t "KERNEL: Heartbeat interval set to ~a seconds.~%" interval)
(start-daemon :interval interval))
;; Keep the process alive.
(loop (sleep 3600)))
#+end_src