From b917ea45b4718b575918476d4753c0de9a925d8a Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Tue, 7 Apr 2026 10:42:59 -0400 Subject: [PATCH] CORE: Enable OACP :eval, update Gemini v1 endpoints, and improved neural cleaning logic. --- docs/README.org | 153 ++++++++++++++++++++++++++++++----------------- src/core.lisp | 43 ++++++++----- src/neuro.lisp | 104 ++++++++++++++++++++------------ src/package.lisp | 6 +- 4 files changed, 194 insertions(+), 112 deletions(-) diff --git a/docs/README.org b/docs/README.org index 33f06d6..2618400 100644 --- a/docs/README.org +++ b/docs/README.org @@ -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 diff --git a/src/core.lisp b/src/core.lisp index ad52616..c667209 100644 --- a/src/core.lisp +++ b/src/core.lisp @@ -50,6 +50,12 @@ (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) @@ -60,17 +66,21 @@ (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))) @@ -82,10 +92,9 @@ ((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))) @@ -143,7 +152,7 @@ (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))) @@ -151,7 +160,7 @@ (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*))) @@ -172,6 +181,8 @@ (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))) diff --git a/src/neuro.lisp b/src/neuro.lisp index 80e27c8..547f4e8 100644 --- a/src/neuro.lisp +++ b/src/neuro.lisp @@ -5,66 +5,87 @@ (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." @@ -113,9 +134,14 @@ (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 @@ -124,12 +150,12 @@ ((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) diff --git a/src/package.lisp b/src/package.lisp index fa010a5..b77dcd1 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -81,4 +81,8 @@ #:org-id-new ;; --- AST Helpers --- - #:find-headline-missing-id)) + #:find-headline-missing-id + + ;; --- Environment Config --- + #:set-llm-model + #:get-llm-model))