diff --git a/README.org b/README.org index 78eaff8..66d2e4c 100644 --- a/README.org +++ b/README.org @@ -664,8 +664,7 @@ EXAMPLES: (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 specific environment variable fallbacks." + "Retrieves authentication credentials for a provider." (let ((auth (gethash provider *auth-providers*))) (cond ((functionp auth) (funcall auth)) @@ -679,7 +678,6 @@ EXAMPLES: (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))))))))) @@ -691,12 +689,10 @@ EXAMPLES: (defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.") (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." + "Dispatches a neural request through the provider cascade." (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*))) @@ -711,99 +707,17 @@ EXAMPLES: (return-from ask-neuro result)))))) "(:type :LOG :payload (:text \"Neural Cascade Failure\"))")) -(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-base (if model (format nil "https://generativelanguage.googleapis.com/v1/models/~a:generateContent" model) - (return-from execute-gemini-request "(:type :LOG :payload (:text \"Error: Gemini Model ID missing.\"))")))) - (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-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)))))) +;; --- Sovereign Service Fallbacks --- -(defun execute-groq-request (prompt system-prompt &key model) - (let ((api-key (uiop:getenv "GROQ_API_KEY")) - (endpoint "https://api.groq.com/openai/v1/chat/completions")) - (unless model (return-from execute-groq-request "(:type :LOG :payload (:text \"Error: Groq Model ID missing.\"))")) - (unless api-key (return-from execute-groq-request "(:type :LOG :payload (:text \"Groq API Key missing\"))")) - (let* ((headers `(("Content-Type" . "application/json") - ("Authorization" . ,(format nil "Bearer ~a" api-key)))) - (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 5 :read-timeout 10)) - (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 \"Groq Failure: ~a\"))" c)))))) - -(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")) - (unless model (return-from execute-openrouter-request "(:type :LOG :payload (:text \"Error: Model ID missing. Accountant must provide a model.\"))")) - (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-ppcre:regex-replace-all "\\\\/" - (cl-json:encode-json-to-string - `((model . ,model) - (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) - (if (typep c 'dex:http-request-failed) - (kernel-log "OPENROUTER ERROR BODY: ~a" (dex:response-body c))) - (format nil "(:type :LOG :payload (:text \"OpenRouter Failure: ~a\"))" c)))))) - -(defun openrouter-get-available-models () - "Fetches available models from OpenRouter." - (let ((api-key (uiop:getenv "OPENROUTER_API_KEY"))) - (unless api-key (return-from openrouter-get-available-models nil)) - (let ((headers `(("Authorization" . ,(format nil "Bearer ~a" api-key))))) - (handler-case - (let* ((response (dex:get "https://openrouter.ai/api/v1/models" - :headers headers - :connect-timeout 60 - :read-timeout 60)) - (json (cl-json:decode-json-from-string response)) - (data (cdr (assoc :data json))) - (results nil)) - (dolist (item data) - (let ((id (cdr (assoc :id item))) - (context-len (cdr (assoc :context--length item)))) - (when id - (push (list :id id :context (format nil "~a" (or context-len "unknown"))) results)))) - (nreverse results)) - (error (c) - (kernel-log "Model Discovery Error: ~a" c) - nil))))) - -;; --- Sovereign Service Stubs --- -;; These are implemented in specialized skills but registered in the kernel namespace. - -(defun economist-route-task (complexity) - "Stub for Neuro-Economic routing. Overridden by skill-economist." - (declare (ignore complexity)) - :gemini) ; Default fallback +(defun economist-route-task (context) + "Generic fallback for routing. Overridden by skill-economist." + (declare (ignore context)) + '(:openrouter :gemini)) (defun org-id-new () - "Stub for Sovereign ID generation. Overridden by skill-ast-normalization." + "Generic fallback for ID generation. Overridden by skill-ast-normalization." (format nil "node-~a" (get-universal-time))) -(register-neuro-backend :gemini #'execute-gemini-request) -(register-neuro-backend :openrouter #'execute-openrouter-request) -(register-neuro-backend :groq #'execute-groq-request) -(defvar *provider-cascade* '(:openrouter :gemini)) ; Default fallback only - (defun get-org-timestamp () "Returns a current Org-mode active timestamp." (multiple-value-bind (sec min hour day month year day-of-week) (decode-universal-time (get-universal-time)) @@ -812,22 +726,6 @@ EXAMPLES: (format nil "[~4,'0d-~2,'0d-~2,'0d ~a ~2,'0d:~2,'0d]" year month day (nth day-of-week day-names) hour min)))) -(defun update-note-metadata (filepath) - "Ensures a :PROPERTIES: drawer exists and updates the :EDITED: timestamp." - (let ((content (uiop:read-file-string filepath)) - (now (get-org-timestamp))) - (if (search ":PROPERTIES:" content) - ;; Update existing EDITED or add it - (let ((new-content (if (search ":EDITED:" content) - (cl-ppcre:regex-replace ":EDITED: \\[.*?\\]" content (format nil ":EDITED: ~a" now)) - (cl-ppcre:regex-replace ":PROPERTIES:\\n" content (format nil ":PROPERTIES:~%:EDITED: ~a~%" now))))) - (with-open-file (out filepath :direction :output :if-exists :supersede) - (write-string new-content out))) - ;; Create new drawer - (let ((new-content (format nil ":PROPERTIES:~%:CREATED: ~a~%:EDITED: ~a~%:END:~%~a" now now content))) - (with-open-file (out filepath :direction :output :if-exists :supersede) - (write-string new-content out)))))) - (defun think (context) (let ((active-skill (find-triggered-skill context)) (tool-belt (generate-tool-belt-prompt))) @@ -879,42 +777,6 @@ To call a tool, you MUST use: (defun distill-prompt (full-prompt successful-output) (let ((system-instr "You are a Meta-Cognitive Prompt Architect. DISTILL into template.")) (ask-neuro (format nil "PROMPT: ~a~%RESULT: ~a" full-prompt successful-output) :system-prompt system-instr))) - -(defun distillation-loop () - "Autonomous distillation cycle (Skeletal)." - (kernel-log "NEURO [Evolution] - Distillation cycle triggered.")) - -(in-package :org-agent) - -(defun decide (proposed-action context) - (let ((active-skill (find-triggered-skill context))) - (if (and proposed-action (listp proposed-action) active-skill) - (let* ((symbolic-gate (skill-symbolic-fn active-skill)) - (payload (getf proposed-action :payload)) - (action (or (getf payload :action) (getf proposed-action :action))) - (code (or (getf payload :code) (getf proposed-action :code)))) - ;; Global safety harness for EVAL - (when (and (member (getf proposed-action :type) '(:request :REQUEST)) - (member action '(:eval :EVAL))) - (let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness))) - (when (and code harness-pkg) - (unless (ignore-errors (uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)) - (kernel-log "SYSTEM 2 [GLOBAL]: Security violation blocked.~%") - (return-from decide '(:type :LOG :payload (:text "Blocked by Global Safety Harness"))))))) - ;; Skill-specific verification - (if symbolic-gate - (let ((decision (funcall symbolic-gate proposed-action context))) - (if decision - (progn (kernel-log "SYSTEM 2: Verified by skill '~a'.~%" (skill-name active-skill)) decision) - (progn (kernel-log "SYSTEM 2: REJECTED by skill '~a'.~%" (skill-name active-skill)) - '(:type :LOG :payload (:text "Action rejected by skill heuristics"))))) - (progn (kernel-log "SYSTEM 2: Verified (Implicitly safe for skill '~a').~%" (skill-name active-skill)) proposed-action))) - proposed-action))) - -(defun list-objects-with-attribute (attr-key attr-val) - (let ((results nil)) - (maphash (lambda (id obj) (declare (ignore id)) (when (equal (getf (org-object-attributes obj) attr-key) attr-val) (push obj results))) *object-store*) - results)) #+end_src * System Definition diff --git a/src/neuro.lisp b/src/neuro.lisp index 547f4e8..156154d 100644 --- a/src/neuro.lisp +++ b/src/neuro.lisp @@ -29,21 +29,21 @@ (defvar *provider-cascade* '(:openrouter :gemini)) (defun register-neuro-backend (name fn) (setf (gethash name *neuro-backends*) fn)) +(defvar *model-selector-fn* nil "A function called with (provider context) to return a model ID.") + (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* (;; 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))) + (let* (;; Consult the model selector (e.g. economist) for the model ID if available + (model (when *model-selector-fn* (funcall *model-selector-fn* backend context))) (result (if model (funcall backend-fn prompt system-prompt :model model) (funcall backend-fn prompt system-prompt)))) @@ -52,109 +52,86 @@ (return-from ask-neuro result)))))) "(:type :LOG :payload (:text \"Neural Cascade Failure\"))")) -(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-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-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)))))) +;; --- Sovereign Service Fallbacks --- -(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-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-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." - (let ((api-key (uiop:getenv "OPENROUTER_API_KEY"))) - (unless api-key (return-from openrouter-get-available-models nil)) - (let ((headers `(("Authorization" . ,(format nil "Bearer ~a" api-key))))) - (handler-case - (let* ((response (dex:get "https://openrouter.ai/api/v1/models" - :headers headers - :connect-timeout 60 - :read-timeout 60)) - (json (cl-json:decode-json-from-string response)) - (data (cdr (assoc :data json))) - (results nil)) - (dolist (item data) - (let ((id (cdr (assoc :id item))) - (context-len (cdr (assoc :context--length item)))) - (when id - (push (list :id id :context (format nil "~a" (or context-len "unknown"))) results)))) - (nreverse results)) - (error (c) - (kernel-log "Model Discovery Error: ~a" c) - nil))))) - -;; --- Sovereign Service Stubs --- -;; These are implemented in specialized skills but registered in the kernel namespace. - -(defun economist-route-task (complexity) - "Stub for Neuro-Economic routing. Overridden by skill-economist." - (declare (ignore complexity)) - :gemini) ; Default fallback +(defun economist-route-task (context) + "Generic fallback for routing. Overridden by skill-economist." + (declare (ignore context)) + '(:openrouter :gemini)) (defun org-id-new () - "Stub for Sovereign ID generation. Overridden by skill-ast-normalization." + "Generic fallback for ID generation. Overridden by skill-ast-normalization." (format nil "node-~a" (get-universal-time))) -(register-neuro-backend :gemini #'execute-gemini-request) -(register-neuro-backend :openrouter #'execute-openrouter-request) -(setf *provider-cascade* '(:openrouter :gemini)) +(defun get-org-timestamp () + "Returns a current Org-mode active timestamp." + (multiple-value-bind (sec min hour day month year day-of-week) (decode-universal-time (get-universal-time)) + (declare (ignore sec)) + (let ((day-names '("Mon" "Tue" "Wed" "Thu" "Fri" "Sat" "Sun"))) + (format nil "[~4,'0d-~2,'0d-~2,'0d ~a ~2,'0d:~2,'0d]" + year month day (nth day-of-week day-names) hour min)))) + +(defun update-note-metadata (filepath) + "Ensures a :PROPERTIES: drawer exists and updates the :EDITED: timestamp." + (let ((content (uiop:read-file-string filepath)) + (now (get-org-timestamp))) + (if (search ":PROPERTIES:" content) + ;; Update existing EDITED or add it + (let ((new-content (if (search ":EDITED:" content) + (cl-ppcre:regex-replace ":EDITED: \\[.*?\\]" content (format nil ":EDITED: ~a" now)) + (cl-ppcre:regex-replace ":PROPERTIES:\\n" content (format nil ":PROPERTIES:~%:EDITED: ~a~%" now))))) + (with-open-file (out filepath :direction :output :if-exists :supersede) + (write-string new-content out))) + ;; Create new drawer + (let ((new-content (format nil ":PROPERTIES:~%:CREATED: ~a~%:EDITED: ~a~%:END:~%~a" now now content))) + (with-open-file (out filepath :direction :output :if-exists :supersede) + (write-string new-content out)))))) (defun think (context) - (let ((active-skill (find-triggered-skill context))) + (let ((active-skill (find-triggered-skill context)) + (tool-belt (generate-tool-belt-prompt))) (if active-skill (progn (kernel-log "SYSTEM 1: Engaging skill '~a'~%" (skill-name active-skill)) (let* ((prompt-generator (skill-neuro-prompt active-skill)) - (prompt (when prompt-generator (funcall prompt-generator context)))) - (if prompt - (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 - ((and suggestion (listp suggestion)) suggestion) - ;; SALVAGE: If LLM returned plain text or a non-list symbol - ((and (let ((p (getf context :payload))) (eq (getf p :sensor) :chat-message)) - (> (length cleaned-thought) 0)) - (kernel-log "SYSTEM 1: SALVAGING plain-text 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 ""))) - `(: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))) + (raw-prompt (when prompt-generator (funcall prompt-generator context))) + (full-system-prompt (concatenate 'string + "ACTUATOR IDENTITY: You are the pure Lisp actuator for the org-agent kernel. +MANDATE: Output EXACTLY ONE Common Lisp property list starting with (:type :REQUEST). +ZERO CONVERSATION: Do not explain. Do not say 'Okay'. Do not use markdown blocks. +STRICT RULE: Do not output multiple lists. Do not chain multiple requests. +DO NOT embed tool calls inside text strings. +If you need to do multiple things or need information from a tool, you MUST: +1. Call the tool FIRST. +2. Wait for the result in the next recursive turn. +3. Only then reply to the user or call the next tool. + +" + tool-belt + " +IMPORTANT: To reply to the user, you MUST use: +(:type :REQUEST :target :emacs :action :insert-at-end :buffer \"*org-agent-chat*\" :text \"* \") + +To call a tool, you MUST use: +(:type :REQUEST :target :tool :action :call :tool \"\" :args (:arg1 \"val\")) + +"))) + (if (and raw-prompt (> (length raw-prompt) 1)) + (let* ((thought (ask-neuro raw-prompt :system-prompt full-system-prompt :context context))) + (kernel-log "SYSTEM 1 RAW: ~a~%" thought) + (let* ((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 + ((and suggestion (listp suggestion)) suggestion) + (t + (kernel-log "SYSTEM 1 ERROR: Invalid output format from LLM.~%") + nil)))) '(:type :LOG :payload (:text "Skill triggered (Deterministic only)"))))) nil)))