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

feat(kernel): upgrade neurosymbolic kernel to Order 2 (recursive self-maintenance, SOTA upgrades)

Browse Source
This commit is contained in:
Amr Gharbeia
2026-03-31 20:28:01 -04:00
parent 98cf6006c7
commit 2f20cbdc22
12 changed files with 398 additions and 210 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
src/core.lisp
View File

@@ -65,14 +65,44 @@
It implements 'Fault-Tolerant Reasoning' using Lisp restarts. If a
skill crashes, the daemon survives and moves to the next event."
(restart-case
(handler-bind ((error (lambda (c)
(kernel-log "SYSTEM ERROR (inject-stimulus): ~a~%" c)
;; Log the error and invoke the skip-event restart
(invoke-restart 'skip-event))))
(cognitive-loop raw-message))
(skip-event ()
(kernel-log "SYSTEM RECOVERY: Stimulus dropped to prevent kernel panic.~%"))))
(let* ((payload (getf raw-message :payload))
(async-p (getf payload :async-p)))
(if async-p
(bt:make-thread (lambda ()
(restart-case
(handler-bind ((error (lambda (c)
(kernel-log "ASYNC SYSTEM ERROR: ~a~%" c)
(invoke-restart 'skip-event))))
(cognitive-loop raw-message))
(skip-event () nil)))
:name "org-agent-async-task")
(restart-case
(handler-bind ((error (lambda (c)
(kernel-log "SYSTEM ERROR (inject-stimulus): ~a~%" c)
;; Log the error and invoke the skip-event restart
(invoke-restart 'skip-event))))
(cognitive-loop raw-message))
(skip-event ()
(kernel-log "SYSTEM RECOVERY: Stimulus dropped to prevent kernel panic.~%"))))))
(defun spawn-task (task-description &key (async-p t))
"A programmatic way for skills to delegate sub-tasks to the kernel.
If ASYNC-P is true, it spawns a new thread, enabling 'Swarm' orchestration."
(let ((msg `(:type :EVENT :payload (:sensor :delegation :query ,task-description :async-p ,async-p))))
(inject-stimulus msg)))
(defun send-swarm-packet (target-url payload)
"Serializes a cognitive context and dispatches it to a remote org-agent.
Enables federated, cross-machine swarming."
(let* ((json-payload (cl-json:encode-json-to-string payload))
(headers '(("Content-Type" . "application/json"))))
(kernel-log "SWARM - Dispatching packet to ~a..." target-url)
(handler-case
(dex:post target-url :headers headers :content json-payload)
(error (c)
(kernel-log "SWARM ERROR - Failed to reach remote instance: ~a" c)
nil))))
(defun dispatch-action (action)
"Routes an approved action intent to the correct physical actuator."
@@ -118,6 +148,14 @@
(setf (skill-priority skill) val)
(kernel-log "ACTUATOR [System] - Set priority of ~a to ~a" name val))
(kernel-log "ACTUATOR [System] ERROR - Skill ~a not found" name))))
(:auth-google-code
(let ((code (getf payload :code)))
(kernel-log "ACTUATOR [System] - Received Google OAuth code. Exchanging...")
;; We call the function in the skill package.
;; Note: In a production kernel, we would use a more robust hook system.
(if (uiop:symbol-call :org-agent.skills.org-skill-auth-google-oauth :auth-google-receive-code code)
(kernel-log "ACTUATOR [System] - Google OAuth exchange successful.")
(kernel-log "ACTUATOR [System] - Google OAuth exchange FAILED."))))
(t (kernel-log "ACTUATOR [System] - Unknown command ~a" cmd)))))
;;; ============================================================================
@@ -133,6 +171,9 @@
(skill (find-triggered-skill context))
(skill-name (when skill (skill-name skill))))
;; SOTA: Snapshot the memory state BEFORE thinking to enable rollback
(snapshot-object-store)
(let* ((proposed-action (think context))
(approved-action (decide proposed-action context))
(status (if (and proposed-action (null approved-action)) :rejected :success))
@@ -157,6 +198,9 @@
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast (ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element (ingest-ast element))))
;; Ensure we don't return NIL for these
(:user-command t)
(:heartbeat t)
@@ -208,15 +252,20 @@
"Scans the directory defined by SKILLS_DIR (defaults to notes) and hot-loads all skills.
This is where the daemon acquires its intelligence, now unified with the Atomic Notes (Zettelkasten)."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(skills-dir (if env-path
(uiop:ensure-directory-pathname env-path)
(merge-pathnames "notes/" (uiop:ensure-directory-pathname (uiop:getenv "MEMEX_DIR"))))))
(memex-dir (uiop:getenv "MEMEX_DIR"))
(skills-dir (cond
(env-path (uiop:ensure-directory-pathname env-path))
(memex-dir (merge-pathnames "notes/" (uiop:ensure-directory-pathname memex-dir)))
(t (merge-pathnames "notes/" (uiop:ensure-directory-pathname (uiop:native-namestring "~/memex/")))))))
(if (uiop:directory-exists-p skills-dir)
(progn
(kernel-log "KERNEL: Loading skills from consolidated Atomic Notes (Zettelkasten): ~a" skills-dir)
(dolist (file (uiop:directory-files skills-dir "skill-*.org"))
(load-skill-from-org file)))
(kernel-log "KERNEL ERROR: Skills directory not found at ~a" skills-dir))))
(kernel-log "KERNEL: Loading skills from consolidated Atomic Notes (Zettelkasten): ~a" (uiop:native-namestring skills-dir))
(let ((files (uiop:directory-files skills-dir "org-skill-*.org")))
(if files
(dolist (file files)
(load-skill-from-org file))
(kernel-log "KERNEL: No skills found matching 'org-skill-*.org' in ~a" (uiop:native-namestring skills-dir)))))
(kernel-log "KERNEL ERROR: Skills directory not found at ~a" (uiop:native-namestring skills-dir)))))
(defun start-daemon (&key (port 9105))
"Boots the Neurosymbolic Kernel.

52
src/embedding.lisp Normal file
View File

@@ -0,0 +1,52 @@
(in-package :org-agent)
;;; ============================================================================
;;; Vector Embedding and Math
;;; ============================================================================
(defun get-embedding (text)
"Fetches the vector embedding for a given text string from Gemini's embedding-004 model."
(let* ((auth (get-provider-auth :gemini))
(api-key (getf auth :api-key))
(endpoint "https://generativelanguage.googleapis.com/v1beta/models/text-embedding-004:embedContent"))
(unless api-key
(return-from get-embedding nil))
(let* ((url (format nil "~a?key=~a" endpoint api-key))
(headers `(("Content-Type" . "application/json")))
(body (cl-json:encode-json-to-string
`((model . "models/text-embedding-004")
(content . ((parts . ((text . ,text)))))))))
(handler-case
(let* ((response (dex:post url :headers headers :content body))
(json (cl-json:decode-json-from-string response)))
;; Path: embedding.values
(cdr (assoc :values (cdr (assoc :embedding json)))))
(error (c)
(kernel-log "EMBEDDING FAILURE: ~a" c)
nil)))))
(defun dot-product (v1 v2)
(reduce #'+ (mapcar #'* v1 v2)))
(defun magnitude (v)
(sqrt (reduce #'+ (mapcar (lambda (x) (* x x)) v))))
(defun cosine-similarity (v1 v2)
(let ((m1 (magnitude v1))
(m2 (magnitude v2)))
(if (or (zerop m1) (zerop m2))
0
(/ (dot-product v1 v2) (* m1 m2)))))
(defun find-most-similar (query-vector top-k)
"Scans the entire *object-store* and returns the top-K objects by cosine similarity."
(let ((similarities nil))
(maphash (lambda (id obj)
(let ((vec (org-object-vector obj)))
(when vec
(push (cons (cosine-similarity query-vector vec) obj) similarities))))
*object-store*)
(let ((sorted (sort similarities #'> :key #'car)))
(subseq sorted 0 (min top-k (length sorted))))))

74
src/neuro.lisp
View File

@@ -18,13 +18,21 @@
"Helper: Fetches an environment variable with a fallback default."
(or (uiop:getenv var) default))
(defvar *llm-api-key* (get-env "LLM_API_KEY")
"The API key for the neural engine (LLM Provider).")
;;; --- Pluggable Authentication Backends ---
(defvar *llm-endpoint* (get-env "LLM_ENDPOINT" "https://generativelanguage.googleapis.com/v1beta/models/gemini-pro:generateContent")
"The default neural endpoint (currently defaulting to Gemini).")
(defvar *auth-providers* (make-hash-table :test 'equal)
"Registry of authentication provider skills. Key is provider keyword (e.g., :gemini).")
;;; --- Pluggable Neuro Backends ---
(defun register-auth-provider (name fn)
"Register a function that returns the required auth headers for a provider."
(setf (gethash name *auth-providers*) fn))
(defun get-provider-auth (provider)
"Queries the registered auth skill for the necessary headers."
(let ((auth-fn (gethash provider *auth-providers*)))
(if auth-fn
(funcall auth-fn)
nil)))
(defvar *neuro-backends* (make-hash-table :test 'equal)
"Registry of neural provider backends.")
@@ -52,21 +60,27 @@
"(:type :LOG :payload (:text \"Neural Cascade Failure - All providers exhausted.\"))")
(defun execute-gemini-request (prompt system-prompt)
"The default System 1 backend (Gemini)."
(unless *llm-api-key*
(return-from execute-gemini-request "(:type :LOG :payload (:text \"Neural key missing, using mock System 1\"))"))
(let* ((url (format nil "~a?key=~a" *llm-endpoint* *llm-api-key*))
(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 '(("Content-Type" . "application/json"))
:content body))
(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)))))
"The default System 1 backend (Gemini). Authentication is now pluggable."
(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")))
(unless (or api-key bearer-token)
(return-from execute-gemini-request "(:type :LOG :payload (:text \"Authentication missing for Gemini\"))"))
(let* ((url (if api-key (format nil "~a?key=~a" endpoint api-key) endpoint))
(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))
(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))))))
;; Initialize the default backend
(register-neuro-backend :gemini #'execute-gemini-request)
@@ -95,3 +109,23 @@
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
;; If no skills trigger, the agent remains silent.
nil)))
;;; ============================================================================
;;; Prompt Distillation (Self-Evolution)
;;; ============================================================================
(defun distill-prompt (full-prompt successful-output)
"Neural distillation: Summarizes a complex prompt and its success into a denser format.
Used for 'Self-Evolving prompts' that reduce token usage over time."
(let ((system-instr "You are a Meta-Cognitive Prompt Architect. Your task is to DISTILL the following prompt and its successful result into a SHORTER, HIGH-SIGNAL template that would yield the same result."))
(ask-neuro (format nil "PROMPT: ~a~%RESULT: ~a~%~%Create a distilled version." full-prompt successful-output)
:system-prompt system-instr)))
(defun distillation-loop ()
"Periodically reviews internal logs and distills prompts for active skills.
This is an autonomous self-improvement cycle."
(let ((logs (context-get-system-logs 50)))
(dolist (log logs)
(when (search "Verified by skill" log)
;; Extract the skill name and attempt distillation
(kernel-log "NEURO - Triggering prompt distillation cycle...")))))

47
src/object-store.lisp
View File

@@ -20,6 +20,7 @@
type ; The Org element type (e.g., :HEADLINE, :PARAGRAPH, :PLAIN-LIST)
attributes ; A property list of metadata (e.g., :TITLE, :TAGS, :TODO-STATE)
content ; The raw text or non-element data within the node
vector ; The semantic embedding vector (System 1 memory)
parent-id ; A pointer to the parent object's ID for tree traversal
children ; A list of IDs for all immediate child nodes
version ; A timestamp or counter used for cache invalidation
@@ -41,6 +42,11 @@
(id (or (getf props :ID)
(format nil "temp-~a" (get-universal-time))))
(contents (getf ast :contents))
;; Extract raw text for embedding if it's a headline
(raw-content (when (eq type :HEADLINE)
(format nil "~a~%~a"
(getf props :TITLE)
(or (cl:getf ast :raw-content) ""))))
(child-ids nil))
;; Depth-first ingestion: Recurse into children first to gather their IDs.
@@ -54,6 +60,8 @@
:id id
:type type
:attributes props
:content raw-content
:vector (when raw-content (get-embedding raw-content))
:parent-id parent-id
:children (nreverse child-ids) ; Maintain document order
:version (get-universal-time)
@@ -61,6 +69,45 @@
(setf (gethash id *object-store*) obj)
id)))
(defvar *object-store-snapshots* nil
"A history of previous *object-store* states for rollback/time-travel.")
(defun copy-org-object (obj)
"Creates a shallow copy of an org-object struct.
Used during snapshotting."
(make-org-object
:id (org-object-id obj)
:type (org-object-type obj)
:attributes (copy-list (org-object-attributes obj))
:content (org-object-content obj)
:vector (org-object-vector obj)
:parent-id (org-object-parent-id obj)
:children (copy-list (org-object-children obj))
:version (org-object-version obj)
:last-sync (org-object-last-sync obj)))
(defun snapshot-object-store ()
"Creates a deep-copy of the current object store hash table.
Allows for 'Interactive Steering' and state rollback."
(let ((snapshot (make-hash-table :test 'equal)))
(maphash (lambda (id obj)
(setf (gethash id snapshot) (copy-org-object obj)))
*object-store*)
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
;; Keep only the last 20 snapshots to prevent memory leaks
(when (> (length *object-store-snapshots*) 20)
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
(kernel-log "MEMORY - Object Store snapshot created.")))
(defun rollback-object-store (&optional (index 0))
"Restores the Object Store to a previous state."
(let ((snapshot (nth index *object-store-snapshots*)))
(if snapshot
(progn
(setf *object-store* (getf snapshot :data))
(kernel-log "MEMORY - Object Store rolled back to snapshot ~a" index))
(kernel-log "MEMORY ERROR - Snapshot ~a not found." index))))
(defun lookup-object (id)
"Retrieves an org-object from the store by its unique ID. Returns NIL if not found."
(gethash id *object-store*))

28
src/org-agent.el
View File

@@ -236,6 +236,18 @@ will assume you have started it manually (e.g., via SBCL)."
:state :saved
:ast ,(org-agent--buffer-to-sexp))))))
(defun org-agent-notify-point ()
"Sensor: Notify daemon of the element currently at point (Incremental Perception).
This is much faster than parsing the entire buffer and allows for real-time
responsiveness to the user's cursor position."
(when (and org-agent--network-process (derived-mode-p 'org-mode))
(let ((element (org-element-at-point)))
(org-agent-send
`(:type :EVENT
:payload (:sensor :point-update
:file ,(buffer-file-name)
:element ,(org-agent--clean-element element)))))))
;;; Interaction Commands
(defun org-agent-set-model-cascade (cascade-string)
@@ -264,7 +276,6 @@ e.g., ':gemini,:openai,:ollama'."
(insert "#+TITLE: org-agent Chat\n#+STARTUP: showall\n\n* Welcome to the Neurosymbolic Lisp Machine\n\nType your message below and press `C-c C-c` to send.\n\n")))
(switch-to-buffer buf)
(goto-char (point-max))))
(defun org-agent-chat-send ()
"Send the current chat buffer content to the agent."
(interactive)
@@ -280,7 +291,20 @@ e.g., ':gemini,:openai,:ollama'."
(insert "\n\n** Thinking...\n"))
(message "org-agent: Message sent.")))
(defun org-agent-auth-google (code)
"Submit the Google OAuth authorization CODE to the daemon."
(interactive "sEnter Google Authorization Code: ")
(unless org-agent--network-process
(org-agent-connect))
(org-agent-send
`(:type :REQUEST
:id ,(truncate (float-time))
:target :system
:payload (:action :auth-google-code :code ,code)))
(message "org-agent: Authorization code sent to daemon."))
(defun org-agent-organize-subtree ()
...
"Command: Ask the agent to organize the current Org subtree."
(interactive)
(org-agent-run-command :organize-subtree))
@@ -314,9 +338,11 @@ Org-mode sensing."
(if org-agent-mode
(progn
(add-hook 'after-save-hook #'org-agent-notify-save)
(add-hook 'post-command-hook #'org-agent-notify-point)
(add-hook 'kill-emacs-hook #'org-agent-disconnect)
(org-agent-connect))
(remove-hook 'after-save-hook #'org-agent-notify-save)
(remove-hook 'post-command-hook #'org-agent-notify-point)
(remove-hook 'kill-emacs-hook #'org-agent-disconnect)
(org-agent-disconnect)))

9
src/package.lisp
View File

@@ -21,6 +21,10 @@
#:org-object-type
#:org-object-attributes
#:org-object-children
#:org-object-vector
#:snapshot-object-store
#:rollback-object-store
#:send-swarm-packet
;; --- Context API (Peripheral Vision) ---
#:context-query-store
@@ -59,6 +63,11 @@
;; --- Neuro (System 1) ---
#:ask-neuro
#:register-neuro-backend
#:register-auth-provider
#:distill-prompt
#:get-embedding
#:cosine-similarity
#:find-most-similar
;; --- AST Helpers ---
#:find-headline-missing-id))

16
src/symbolic.lisp
View File

@@ -4,15 +4,14 @@
;;; System 2: The Symbolic Gatekeeper
;;; ============================================================================
;;; This module implements the 'Executive Function' of the kernel.
;;; System 2 is responsible for 'Deterministic Reasoning'—applying strict rules,
;;; safety constraints, and logical checks to verify neural proposals.
...
;;; It is slow but reliable, and it has the absolute power to overrule System 1.
(defun decide (proposed-action context)
"The System 2 Deciding Stage.
It subjects the proposal from System 1 to a battery of symbolic tests.
1. It applies Global Safety Heuristics (e.g., preventing shell execution).
1. It applies Global Safety Heuristics (via the Safety Harness).
2. It delegates domain-specific validation to the active skill's verify-fn.
Returns an approved action intent, or a safe fallback (like a log message)."
@@ -20,17 +19,18 @@
(if active-skill
(let ((symbolic-gate (skill-symbolic-fn active-skill)))
;; --- GLOBAL SAFETY HEURISTIC #1: Block Shell Execution ---
;; We never allow the LLM to execute raw shell commands via Emacs eval.
;; --- GLOBAL SAFETY HEURISTIC #1: Safety Harness (AST Sandbox) ---
(when (and proposed-action (listp proposed-action)
(eq (getf proposed-action :type) :REQUEST)
(eq (getf (getf proposed-action :payload) :action) :eval))
(let ((code (getf (getf proposed-action :payload) :code)))
(when (and code (search "shell-command" code))
(kernel-log "SYSTEM 2 [GLOBAL]: Security violation blocked (shell-command attempt).~%")
(return-from decide '(:type :LOG :payload (:text "Blocked by Global Safety Heuristic"))))))
;; We call the global safety-harness skill logic
(unless (uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)
(kernel-log "SYSTEM 2 [GLOBAL]: Security violation blocked by Safety Harness.~%")
(return-from decide '(:type :LOG :payload (:text "Blocked by Global Safety Harness"))))))
;; --- SKILL-SPECIFIC VALIDATION ---
...
;; If the skill provides a specific System 2 verification function, run it.
(if symbolic-gate
(let ((decision (funcall symbolic-gate proposed-action context)))