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

FEAT: Implement Micro-Loader with Topological Sort and Jailing

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-11 16:52:41 -04:00
parent 9fcf45d918
commit 3b108a5e37
4 changed files with 432 additions and 170 deletions
Download Patch File Download Diff File Expand all files Collapse all files

42
docs/rca/rca-boot-sequence.org Normal file
View File

@@ -0,0 +1,42 @@
#+TITLE: Root Cause Analysis: Micro-Loader & Deterministic Boot Sequence
#+DATE: 2026-04-11
#+FILETAGS: :rca:boot:loader:topological-sort:psf:
* Executive Summary
Refactored the arbitrary skill loading mechanism into a robust **Micro-Loader**. The system now calculates a deterministic boot sequence based on `#+DEPENDS_ON:` tags and protects the kernel from malformed or hanging skills via package-based jailing and execution timeouts.
* 1. Issue: Fragile Load Order
** Symptoms
Skills that depended on functions or variables from other skills would randomly fail to load depending on the filesystem's directory traversal order.
** Root Cause
`initialize-all-skills` used a simple `dolist` over `uiop:directory-files`, which has no semantic awareness of inter-skill dependencies.
** Resolution
1. **Metadata Scanning:** Implemented `parse-skill-metadata` to extract `:ID:` and `#+DEPENDS_ON:` without executing code.
2. **Topological Sort:** Implemented a DFS-based `topological-sort-skills` to guarantee that prerequisites are loaded before their dependents.
3. **Circular Detection:** Added explicit detection and error reporting for circular dependency loops.
* 2. Issue: Shared State Corruption (Brain Rot)
** Symptoms
Variables or functions with the same name in different skills would silently overwrite each other, causing unpredictable behavior.
** Root Cause
All skills were being evaluated directly into the `org-agent` package.
** Resolution
**Package-Based Jailing:** Each skill is now evaluated within its own dedicated, shadowed package (e.g., `ORG-AGENT.SKILLS.ORG-SKILL-CHAT`). This ensures logical isolation while still allowing access to kernel exports.
* 3. Issue: Boot Stall (The Hanging Skill)
** Symptoms
A single skill with an infinite loop or heavy synchronous initialization could hang the entire agent during startup.
** Root Cause
Skill loading was strictly synchronous and blocking on the main thread.
** Resolution
**Execution Timeouts:** Implemented `load-skill-with-timeout`, which wraps the loader in a monitored thread. If a skill takes longer than 5 seconds to initialize, the loader terminates the thread, jails the failure, and continues with the rest of the boot sequence.
* 4. PSF Mandate Alignment
** Evolutionary Kernel
The boot sequence is now a verifiable, mathematical process rather than a side-effect of filesystem organization.
** Literate Granularity
The `org-skill-skills.org` source was refactored into a strictly granular "one definition per block" format.
* 5. Permanent Learnings
- **Reverse Topological Order:** Remember that a DFS-based sort with `push` needs an `nreverse` to place dependencies at the front of the list.
- **Path Portability:** Use `uiop:getcwd` instead of `pwd` for more reliable path resolution across different Lisp implementations and OSes.

199
literate/skills.org
View File

@@ -14,25 +14,21 @@ Hardcoding logic into a compiled binary creates a "Brittle Kernel."
(in-package :org-agent)
#+end_src
** Skill Registry
The central hub for all loaded capabilities.
#+begin_src lisp :tangle ../src/skills.lisp
;; MOVED TO package.lisp
#+end_src
** Skill Definition (defstruct skill)
#+begin_src lisp :tangle ../src/skills.lisp
(defstruct skill name priority dependencies trigger-fn neuro-prompt symbolic-fn)
#+end_src
** Skill Catalog
** Skill Catalog Tracking
A stateful tracking table for all skill files discovered in the environment.
#+begin_src lisp :tangle ../src/skills.lisp
(defvar *skill-catalog* (make-hash-table :test 'equal)
"A stateful tracking table for all skill files discovered in the environment.")
#+end_src
** Skill Entry Structure
#+begin_src lisp :tangle ../src/skills.lisp
(defstruct skill-entry
filename
(status :discovered) ;; :discovered, :loading, :ready, :failed
@@ -40,81 +36,53 @@ A stateful tracking table for all skill files discovered in the environment.
(load-time 0))
#+end_src
** Cognitive Tool Registry
Tools are discrete actions that System 1 (Neuro) can request. This registry tracks tool definitions, their parameters, and their safety guards.
#+begin_src lisp :tangle ../src/skills.lisp
;; MOVED TO package.lisp
#+end_src
** Cognitive Tool Definition (defstruct cognitive-tool)
#+begin_src lisp :tangle ../src/skills.lisp
;; MOVED TO package.lisp
#+end_src
** Cognitive Tool Registration (def-cognitive-tool)
Allows skills to register hot-reloadable capabilities that System 1 can discover and invoke.
#+begin_src lisp :tangle ../src/skills.lisp
;; MOVED TO package.lisp
#+end_src
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
Constructs the technical documentation of available tools that is injected into the LLM system prompt.
#+begin_src lisp :tangle ../src/skills.lisp
(defun generate-tool-belt-prompt ()
(let ((output (format nil "AVAILABLE TOOLS:
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
EXAMPLES:
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\"))
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
---
")))
(maphash (lambda (name tool)
(setf output (concatenate 'string output
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
name
(cognitive-tool-description tool)
(cognitive-tool-parameters tool)))))
*cognitive-tools*)
output))
#+end_src
** Defining Skills (defskill)
The primary macro used within Org files to register new agent capabilities.
#+begin_src lisp :tangle ../src/skills.lisp
(defmacro defskill (name &key priority dependencies trigger neuro symbolic)
`(setf (gethash ,(string-downcase (string name)) *skills-registry*)
(make-skill :name ,(string-downcase (string name)) :priority (or ,priority 10) :dependencies ,dependencies
:trigger-fn ,trigger :neuro-prompt ,neuro :symbolic-fn ,symbolic)))
#+end_src
** Skill Selection (find-triggered-skill)
Iterates through the registry to find the highest-priority skill whose trigger function matches the current context.
#+begin_src lisp :tangle ../src/skills.lisp
(defun find-triggered-skill (context)
"Returns the highest priority skill whose trigger condition matches the context."
(let ((triggered nil))
(maphash (lambda (name skill) (declare (ignore name)) (when (ignore-errors (funcall (skill-trigger-fn skill) context)) (push skill triggered))) *skills-registry*)
(maphash (lambda (name skill)
(declare (ignore name))
(when (ignore-errors (funcall (skill-trigger-fn skill) context))
(push skill triggered)))
*skills-registry*)
(first (sort triggered #'> :key #'skill-priority))))
#+end_src
** Dependency Resolution
** Skill Definition Macro (defskill)
The primary macro used within Org files to register new agent capabilities.
#+begin_src lisp :tangle ../src/skills.lisp
(defmacro defskill (name &key priority dependencies trigger neuro symbolic)
"Registers a new skill into the global registry."
`(setf (gethash (string-downcase (string ,name)) *skills-registry*)
(make-skill :name (string-downcase (string ,name))
:priority (or ,priority 10)
:dependencies ,dependencies
:trigger-fn ,trigger
:neuro-prompt ,neuro
:symbolic-fn ,symbolic)))
#+end_src
** Dependency Resolution (resolve-skill-dependencies)
Ensures that skills are loaded and unloaded in the correct order.
#+begin_src lisp :tangle ../src/skills.lisp
(defun resolve-skill-dependencies (skill-name)
"Recursively resolves dependencies for a given skill name."
(let ((resolved nil) (seen nil))
(labels ((visit (name) (unless (member name seen :test #'equal) (push name seen)
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
(when skill (dolist (dep (skill-dependencies skill)) (visit dep))))
(push name resolved))))
(visit skill-name) (nreverse resolved))))
(labels ((visit (name)
(unless (member name seen :test #'equal)
(push name seen)
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
(when skill
(dolist (dep (skill-dependencies skill))
(visit dep))))
(push name resolved))))
(visit skill-name)
(nreverse resolved))))
#+end_src
** Metadata Parsing (parse-skill-metadata)
@@ -141,7 +109,7 @@ Robustly extracts `#+DEPENDS_ON:` and `:ID:` tags from an Org file without full
#+end_src
** Topological Sorting (topological-sort-skills)
Calculates the correct load order for a directory of skill files, detecting circular dependencies.
Calculates the correct load order for a directory of skill filepaths, detecting circular dependencies.
#+begin_src lisp :tangle ../src/skills.lisp
(defun topological-sort-skills (skills-dir)
@@ -183,6 +151,18 @@ Calculates the correct load order for a directory of skill files, detecting circ
result)))
#+end_src
** Syntax Validation (validate-lisp-syntax)
#+begin_src lisp :tangle ../src/skills.lisp
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
(loop for form = (read stream nil :eof) until (eq form :eof))
(values t nil)))
(error (c) (values nil (format nil "~a" c)))))
#+end_src
** Jailed Loading (load-skill-from-org)
The core "hot-loading" mechanism. It extracts Lisp blocks from an Org file and evaluates them within a dedicated package ("Jail").
@@ -233,7 +213,7 @@ The core "hot-loading" mechanism. It extracts Lisp blocks from an Org file and e
nil)))))
#+end_src
** Safe Loading with Timeout
** Safe Loading with Timeout (load-skill-with-timeout)
Wraps the skill loader in a thread with a hard timeout to prevent a single malformed skill from hanging the entire kernel boot sequence.
#+begin_src lisp :tangle ../src/skills.lisp
@@ -298,13 +278,30 @@ The unified orchestrator for the kernel boot sequence. It scans the environment,
(values ready failed)))))
#+end_src
** Syntax Validation
** Toolbelt Prompt Generation (generate-tool-belt-prompt)
Constructs the technical documentation of available tools that is injected into the LLM system prompt.
#+begin_src lisp :tangle ../src/skills.lisp
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms."
(handler-case (let ((*read-eval* nil)) (with-input-from-string (stream (format nil "(progn ~a)" code-string))
(loop for form = (read stream nil :eof) until (eq form :eof)) (values t nil)))
(error (c) (values nil (format nil "~a" c)))))
(defun generate-tool-belt-prompt ()
"Aggregates all registered cognitive tools into a descriptive prompt."
(let ((output (format nil "AVAILABLE TOOLS:
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
EXAMPLES:
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\"))
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
---
")))
(maphash (lambda (name tool)
(setf output (concatenate 'string output
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
name
(cognitive-tool-description tool)
(cognitive-tool-parameters tool)))))
*cognitive-tools*)
output))
#+end_src
** The Default Tool Belt
@@ -313,7 +310,7 @@ We register a set of standard cognitive tools that all skills can use.
*** The Eval Tool
#+begin_src lisp :tangle ../src/skills.lisp
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the kernel image. Use this for complex calculations or internal state inspection."
:parameters ((:code :type :string :description "The Lisp code to evaluate"))
((:code :type :string :description "The Lisp code to evaluate"))
:guard (lambda (args context)
(declare (ignore context))
(let ((code (getf args :code)))
@@ -331,8 +328,8 @@ We register a set of standard cognitive tools that all skills can use.
*** The Grep Tool
#+begin_src lisp :tangle ../src/skills.lisp
(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
:parameters ((:pattern :type :string :description "The regex pattern to search for")
(:dir :type :string :description "Directory to search in (default is project root)"))
((:pattern :type :string :description "The regex pattern to search for")
(:dir :type :string :description "Directory to search in (default is project root)"))
:body (lambda (args)
(let ((pattern (getf args :pattern))
(dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
@@ -343,7 +340,7 @@ We register a set of standard cognitive tools that all skills can use.
*** The Shell Tool
#+begin_src lisp :tangle ../src/skills.lisp
(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
:parameters ((:cmd :type :string :description "The full bash command to execute"))
((:cmd :type :string :description "The full bash command to execute"))
:guard (lambda (args context)
(declare (ignore context))
(let ((cmd (getf args :cmd)))
@@ -354,43 +351,3 @@ We register a set of standard cognitive tools that all skills can use.
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))
#+end_src
* Phase E: Chaos (Verification)
Verify that the Micro-Loader correctly handles malformed skills and reports status.
#+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp
(defpackage :org-agent-boot-tests
(:use :cl :fiveam :org-agent)
(:export #:boot-suite))
(in-package :org-agent-boot-tests)
(def-suite boot-suite :description "Verification of the Micro-Loader.")
(in-suite boot-suite)
(test test-skill-catalog-tracking
"Verify that skills are added to the catalog with correct status."
(clrhash org-agent::*skill-catalog*)
;; We need a temporary skill file to test loading
(let ((tmp-skill "/tmp/org-skill-test-catalog.org"))
(with-open-file (out tmp-skill :direction :output :if-exists :supersede)
(format out "#+TITLE: Test Skill~%#+begin_src lisp~%(defun test-catalog-fn () t)~%#+end_src"))
(org-agent:load-skill-from-org tmp-skill)
(let ((entry (gethash "org-skill-test-catalog" org-agent::*skill-catalog*)))
(is (not (null entry)))
(is (eq :ready (org-agent::skill-entry-status entry))))
(uiop:delete-file-if-exists tmp-skill)))
(test test-syntax-preflight-blocking
"Verify that malformed Lisp prevents skill from loading."
(clrhash org-agent::*skill-catalog*)
(let ((bad-skill "/tmp/org-skill-bad-syntax.org"))
(with-open-file (out bad-skill :direction :output :if-exists :supersede)
(format out "#+TITLE: Bad Skill~%#+begin_src lisp~%(defun unclosed (x~%#+end_src"))
(org-agent:load-skill-from-org bad-skill)
(let ((entry (gethash "org-skill-bad-syntax" org-agent::*skill-catalog*)))
(is (eq :failed (org-agent::skill-entry-status entry)))
(is (search "Syntax Error" (org-agent::skill-entry-error-log entry))))
(uiop:delete-file-if-exists bad-skill)))
#+end_src

273
src/skills.lisp
View File

@@ -13,36 +13,259 @@
(defun find-triggered-skill (context)
"Returns the highest priority skill whose trigger condition matches the context."
(let ((matched-skills nil))
(maphash (lambda (name skill)
(declare (ignore name))
(let ((trigger-fn (skill-trigger-fn skill)))
(when (and trigger-fn (funcall trigger-fn context))
(push skill matched-skills))))
(let ((triggered nil))
(maphash (lambda (name skill)
(declare (ignore name))
(when (ignore-errors (funcall (skill-trigger-fn skill) context))
(push skill triggered)))
*skills-registry*)
(first (sort matched-skills #'> :key #'skill-priority))))
(first (sort triggered #'> :key #'skill-priority))))
(defmacro defskill (name &key priority dependencies trigger neuro symbolic)
`(setf (gethash ,(string-downcase (string name)) *skills-registry*)
(make-skill :name ,(string-downcase (string name)) :priority (or ,priority 10) :dependencies ,dependencies :trigger-fn ,trigger :neuro-prompt ,neuro :symbolic-fn ,symbolic)))
"Registers a new skill into the global registry."
`(setf (gethash (string-downcase (string ,name)) *skills-registry*)
(make-skill :name (string-downcase (string ,name))
:priority (or ,priority 10)
:dependencies ,dependencies
:trigger-fn ,trigger
:neuro-prompt ,neuro
:symbolic-fn ,symbolic)))
(defun load-skill-from-org (path)
"Extracts Lisp source from an Org file and evaluates it."
(let ((skill-name (pathname-name path)))
(defun resolve-skill-dependencies (skill-name)
"Recursively resolves dependencies for a given skill name."
(let ((resolved nil) (seen nil))
(labels ((visit (name)
(unless (member name seen :test #'equal)
(push name seen)
(let ((skill (gethash (string-downcase (string name)) *skills-registry*)))
(when skill
(dolist (dep (skill-dependencies skill))
(visit dep))))
(push name resolved))))
(visit skill-name)
(nreverse resolved))))
(defun parse-skill-metadata (filepath)
"Extracts ID and DEPENDS_ON tags using robust line-scanning."
(let ((dependencies nil)
(id nil))
(with-open-file (stream filepath)
(loop for line = (read-line stream nil :eof)
until (eq line :eof)
do (let ((clean (string-trim '(#\Space #\Tab #\Return #\Newline) line)))
(cond
((uiop:string-prefix-p "#+DEPENDS_ON:" (string-upcase clean))
(let* ((deps-part (string-trim " " (subseq clean 13))))
(setf dependencies (append dependencies
(mapcar (lambda (s) (string-trim "[] " s))
(uiop:split-string deps-part :separator '(#\Space #\Tab)))))))
((uiop:string-prefix-p ":ID:" (string-upcase clean))
(setf id (string-trim '(#\Space #\Tab) (subseq clean 4))))))))
(values id (remove-if (lambda (s) (= 0 (length s))) dependencies))))
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency (dependencies first)."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
(adj (make-hash-table :test 'equal))
(id-to-file (make-hash-table :test 'equal))
(result nil)
(visited (make-hash-table :test 'equal))
(stack (make-hash-table :test 'equal)))
(dolist (file files)
(let ((filename (pathname-name file)))
(multiple-value-bind (id deps) (parse-skill-metadata file)
(setf (gethash (string-downcase filename) id-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))
(labels ((visit (file)
(let* ((filename (pathname-name file))
(node-key (string-downcase filename)))
(unless (gethash node-key visited)
(setf (gethash node-key stack) t)
(dolist (dep (gethash node-key adj))
(let* ((dep-id (if (and (> (length dep) 3) (uiop:string-prefix-p "id:" (string-downcase dep)))
(subseq dep 3)
dep))
(dep-file (gethash (string-downcase dep-id) id-to-file)))
(when dep-file
(let ((dep-filename (pathname-name dep-file)))
(if (gethash (string-downcase dep-filename) stack)
(error "Circular dependency detected: ~a -> ~a" filename dep-filename)
(visit dep-file))))))
(setf (gethash node-key stack) nil)
(setf (gethash node-key visited) t)
(push file result)))))
(let ((filenames (sort (mapcar #'pathname-name files) #'string<)))
(dolist (name filenames)
(let ((file (gethash (string-downcase name) id-to-file)))
(when file (visit file)))))
(nreverse result))))
(defun validate-lisp-syntax (code-string)
"Checks if a string contains valid, readable Common Lisp forms."
(handler-case
(let ((*read-eval* nil))
(with-input-from-string (stream (format nil "(progn ~a)" code-string))
(loop for form = (read stream nil :eof) until (eq form :eof))
(values t nil)))
(error (c) (values nil (format nil "~a" c)))))
(defun load-skill-from-org (filepath)
"Parses and evaluates Lisp blocks from an Org file into a jailed package."
(let* ((skill-base-name (pathname-name filepath))
(entry (or (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name))))
(setf (skill-entry-status entry) :loading)
(setf (gethash skill-base-name *skill-catalog*) entry)
(handler-case
(let ((source (uiop:read-file-string path)))
(cl-ppcre:do-register-groups (code) ("#\\+begin_src lisp.*\\n([\\s\\S]*?)\\n#\\+end_src" source)
(let ((*package* (find-package :org-agent)))
(eval (read-from-string (concatenate 'string "(progn " code ")")))))
(setf (gethash skill-name *skill-catalog*) (make-skill-entry :filename path :status :ready :load-time (get-universal-time)))
(kernel-log "SKILL [Loader] - Successfully loaded ~a" skill-name))
(let* ((content (uiop:read-file-string filepath))
(lines (uiop:split-string content :separator '(#\Newline)))
(in-lisp-block nil)
(lisp-code "")
(pkg-name (intern (string-upcase (format nil "ORG-AGENT.SKILLS.~a" skill-base-name)) :keyword)))
(dolist (line lines)
(let ((clean-line (string-trim '(#\Space #\Tab #\Return) line)))
(cond ((uiop:string-prefix-p "#+begin_src lisp" (string-downcase clean-line)) (setf in-lisp-block t))
((uiop:string-prefix-p "#+end_src" (string-downcase clean-line)) (setf in-lisp-block nil))
(in-lisp-block (setf lisp-code (concatenate 'string lisp-code line (string #\Newline)))))))
(if (= (length lisp-code) 0)
(progn (setf (skill-entry-status entry) :ready) t) ;; Valid empty skill
(progn
;; PRE-FLIGHT: Syntax Validation
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
(unless valid-p
(error "Syntax Error: ~a" err)))
(kernel-log "KERNEL: Jailing skill '~a' in package ~a" skill-base-name pkg-name)
(unless (find-package pkg-name)
(let ((new-pkg (make-package pkg-name :use '(:cl))))
(do-external-symbols (sym (find-package :org-agent)) (shadowing-import sym new-pkg))))
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
(setf (skill-entry-status entry) :ready)
t)))
(error (c)
(kernel-log "SKILL ERROR [Loader] - Failed to load ~a: ~a" skill-name c)
(setf (gethash skill-name *skill-catalog*) (make-skill-entry :filename path :status :failed :error-log (format nil "~a" c)))))))
(let ((msg (format nil "~a" c)))
(kernel-log "LOADER ERROR in skill '~a': ~a" skill-base-name msg)
(setf (skill-entry-status entry) :failed)
(setf (skill-entry-error-log entry) msg)
nil)))))
(defun load-skill-with-timeout (filepath timeout-seconds)
"Loads a skill Org file with a hard execution timeout."
(let* ((finished nil)
(thread (bt:make-thread (lambda ()
(if (load-skill-from-org filepath)
(setf finished t)
(setf finished :error)))
:name (format nil "loader-~a" (pathname-name filepath))))
(start-time (get-internal-real-time))
(timeout-units (truncate (* timeout-seconds internal-time-units-per-second))))
(loop
(when (eq finished t) (return :success))
(when (eq finished :error) (return :error))
(unless (bt:thread-alive-p thread) (return :error))
(when (> (- (get-internal-real-time) start-time) timeout-units)
(kernel-log "KERNEL: Timing out skill ~a..." (pathname-name filepath))
#+sbcl (sb-thread:terminate-thread thread)
#-sbcl (bt:destroy-thread thread)
(return :timeout))
(sleep 0.05))))
(defun initialize-all-skills ()
"Discovers and loads all .org skills from the project directory."
(let ((skill-dir (or (uiop:getenv "SKILLS_DIR") "projects/org-agent/skills/")))
(ensure-directories-exist skill-dir)
(dolist (path (uiop:directory-files skill-dir "*.org"))
(load-skill-from-org path))))
"Scans the directory defined by SKILLS_DIR and hot-loads skills using topological order."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
(skills-dir-str (or env-path (namestring (merge-pathnames "projects/org-agent/skills/" (uiop:getcwd)))))
(resolved-path (context-resolve-path skills-dir-str))
(skills-dir (if resolved-path (uiop:ensure-directory-pathname resolved-path) nil)))
(unless (and skills-dir (uiop:directory-exists-p skills-dir))
(kernel-log "KERNEL ERROR: Skills directory not found: ~a" skills-dir-str)
;; Fallback check
(setq skills-dir (uiop:ensure-directory-pathname (merge-pathnames "projects/org-agent/skills/" (uiop:getcwd))))
(unless (uiop:directory-exists-p skills-dir)
(return-from initialize-all-skills nil)))
(let ((sorted-files (topological-sort-skills skills-dir)))
;; MANDATE: The Executive Soul must be present
(unless (member "org-skill-agent" sorted-files :key #'pathname-name :test #'string-equal)
(error "BOOT FAILURE: org-skill-agent.org not found in skills directory."))
(kernel-log "==================================================")
(kernel-log " LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(let ((skill-name (pathname-name file)))
(kernel-log " LOADER: Loading ~a..." skill-name)
(load-skill-with-timeout file 5)))
;; Final Summary
(let ((ready 0) (failed 0))
(maphash (lambda (k v)
(declare (ignore k))
(if (eq (skill-entry-status v) :ready) (incf ready) (incf failed)))
*skill-catalog*)
(kernel-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
(kernel-log "==================================================")
(values ready failed)))))
(defun generate-tool-belt-prompt ()
"Aggregates all registered cognitive tools into a descriptive prompt."
(let ((output (format nil "AVAILABLE TOOLS:
You can call tools by returning a Lisp plist: (:target :tool :action :call :tool <name> :args (...))
EXAMPLES:
(:target :tool :action :call :tool \"eval\" :args (:code \"(+ 1 1)\"))
(:target :tool :action :call :tool \"grep-search\" :args (:pattern \"sovereignty\"))
(:target :tool :action :call :tool \"shell\" :args (:cmd \"ls -la\"))
---
")))
(maphash (lambda (name tool)
(setf output (concatenate 'string output
(format nil "- ~a: ~a~% Parameters: ~s~%~%"
name
(cognitive-tool-description tool)
(cognitive-tool-parameters tool)))))
*cognitive-tools*)
output))
(def-cognitive-tool :eval "Evaluates raw Common Lisp code in the kernel image. Use this for complex calculations or internal state inspection."
((:code :type :string :description "The Lisp code to evaluate"))
:guard (lambda (args context)
(declare (ignore context))
(let ((code (getf args :code)))
(let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness)))
(if harness-pkg
(uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)
t))))
:body (lambda (args)
(let ((code (getf args :code)))
(handler-case (let ((result (eval (read-from-string code))))
(format nil "~s" result))
(error (c) (format nil "ERROR: ~a" c))))))
(def-cognitive-tool :grep-search "Searches for a pattern in the project files."
((:pattern :type :string :description "The regex pattern to search for")
(:dir :type :string :description "Directory to search in (default is project root)"))
:body (lambda (args)
(let ((pattern (getf args :pattern))
(dir (or (getf args :dir) (uiop:getenv "MEMEX_DIR"))))
(uiop:run-program (list "grep" "-r" "-n" "--exclude-dir=node_modules" pattern dir)
:output :string :ignore-error-status t))))
(def-cognitive-tool :shell "Executes a shell command on the local machine. Use this for file operations, system checks, or running tests."
((:cmd :type :string :description "The full bash command to execute"))
:guard (lambda (args context)
(declare (ignore context))
(let ((cmd (getf args :cmd)))
(not (or (search "rm -rf /" cmd) (search ":(){ :|:& };:" cmd)))))
:body (lambda (args)
(let ((cmd (getf args :cmd)))
(multiple-value-bind (out err code)
(uiop:run-program (list "bash" "-c" cmd) :output :string :error-output :string :ignore-error-status t)
(format nil "EXIT-CODE: ~a~%~%STDOUT:~%~a~%~%STDERR:~%~a" code out err)))))

88
tests/boot-sequence-tests.lisp
View File

@@ -6,29 +6,69 @@
(def-suite boot-suite :description "Verification of the Micro-Loader.")
(in-suite boot-suite)
(test test-skill-catalog-tracking
"Verify that skills are added to the catalog with correct status."
(clrhash org-agent::*skill-catalog*)
;; We need a temporary skill file to test loading
(let ((tmp-skill "/tmp/org-skill-test-catalog.org"))
(with-open-file (out tmp-skill :direction :output :if-exists :supersede)
(format out "#+TITLE: Test Skill~%#+begin_src lisp~%(defun test-catalog-fn () t)~%#+end_src"))
(org-agent:load-skill-from-org tmp-skill)
(let ((entry (gethash "org-skill-test-catalog" org-agent::*skill-catalog*)))
(is (not (null entry)))
(is (eq :ready (org-agent::skill-entry-status entry))))
(uiop:delete-file-if-exists tmp-skill)))
(test test-parse-skill-metadata
"Verify extraction of ID and DEPENDS_ON from Org headers."
(let ((tmp-file "/tmp/org-skill-test-metadata.org"))
(with-open-file (out tmp-file :direction :output :if-exists :supersede)
(format out ":PROPERTIES:~%:ID: test-id~%:END:~%#+DEPENDS_ON: dep1 dep2~%"))
(unwind-protect
(multiple-value-bind (id deps) (org-agent::parse-skill-metadata tmp-file)
(is (equal "test-id" id))
(is (member "dep1" deps :test #'string=))
(is (member "dep2" deps :test #'string=)))
(uiop:delete-file-if-exists tmp-file))))
(test test-syntax-preflight-blocking
"Verify that malformed Lisp prevents skill from loading."
(clrhash org-agent::*skill-catalog*)
(let ((bad-skill "/tmp/org-skill-bad-syntax.org"))
(with-open-file (out bad-skill :direction :output :if-exists :supersede)
(format out "#+TITLE: Bad Skill~%#+begin_src lisp~%(defun unclosed (x~%#+end_src"))
(test test-topological-sort-basic
"Verify that skills are ordered by dependency."
(let ((tmp-dir "/tmp/org-agent-boot-test/"))
(uiop:ensure-all-directories-exist (list tmp-dir))
;; A depends on B
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
(format out "#+DEPENDS_ON: id:skill-b-id~%"))
(with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
(format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%"))
;; Add executive soul (required)
(with-open-file (out (merge-pathnames "org-skill-agent.org" tmp-dir) :direction :output :if-exists :supersede)
(format out "#+TITLE: Agent~%"))
(org-agent:load-skill-from-org bad-skill)
(let ((entry (gethash "org-skill-bad-syntax" org-agent::*skill-catalog*)))
(is (eq :failed (org-agent::skill-entry-status entry)))
(is (search "Syntax Error" (org-agent::skill-entry-error-log entry))))
(uiop:delete-file-if-exists bad-skill)))
(unwind-protect
(let ((sorted (org-agent::topological-sort-skills tmp-dir)))
;; B must appear before A
(let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal))
(pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal)))
(is (not (null pos-a)))
(is (not (null pos-b)))
(is (< pos-b pos-a))))
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
(test test-topological-sort-circular
"Verify that circular dependencies raise an error."
(let ((tmp-dir "/tmp/org-agent-boot-test-circ/"))
(uiop:ensure-all-directories-exist (list tmp-dir))
;; A depends on B, B depends on A
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
(format out "#+DEPENDS_ON: org-skill-b~%"))
(with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
(format out "#+DEPENDS_ON: org-skill-a~%"))
(unwind-protect
(signals error (org-agent::topological-sort-skills tmp-dir))
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
(test test-skill-jailing
"Verify that skills are loaded into their own packages."
(let ((tmp-skill "/tmp/org-skill-jail-test.org"))
(with-open-file (out tmp-skill :direction :output :if-exists :supersede)
(format out "#+begin_src lisp~%(defvar *jailed-var* 42)~%#+end_src"))
(unwind-protect
(progn
(org-agent::load-skill-from-org tmp-skill)
(let ((pkg (find-package :ORG-AGENT.SKILLS.ORG-SKILL-JAIL-TEST)))
(is (not (null pkg)))
(is (= 42 (symbol-value (find-symbol "*JAILED-VAR*" pkg))))))
(uiop:delete-file-if-exists tmp-skill))))
(test test-syntax-validation
"Verify that malformed Lisp is caught by the pre-flight check."
(is (nth-value 0 (org-agent::validate-lisp-syntax "(defun x () t)")))
(is (not (nth-value 0 (org-agent::validate-lisp-syntax "(defun x (")))))