Amr Gharbeia
b63f5477c1
- Fix unbalanced parens in config-manager (set-config-value, setup-gateways) - Fix assoc :key #'car SBCL compatibility issue in setup-llm-providers - Add missing generate-tool-belt-prompt function - Fix deterministic-verify to not overwrite action when skills return nil - Add :explanation to think fallback responses for policy compliance - Update opencortex.sh to tangle from repo org to XDG .lisp - Remove generated .lisp artifacts from repo (skills, tests, state)
330 lines
17 KiB
Org Mode
330 lines
17 KiB
Org Mode
#+TITLE: The Skill Engine (skills.lisp)
|
|
#+AUTHOR: Agent
|
|
#+FILETAGS: :harness:skills:
|
|
#+STARTUP: content
|
|
#+PROPERTY: header-args:lisp :tangle skills.lisp
|
|
|
|
* Overview
|
|
The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing the system to discover and integrate new cognitive capabilities at runtime.
|
|
|
|
* Implementation
|
|
|
|
** Package Context
|
|
#+begin_src lisp
|
|
(in-package :opencortex)
|
|
#+end_src
|
|
|
|
** Global Skill Registry
|
|
#+begin_src lisp
|
|
(defun COSINE-SIMILARITY (v1 v2)
|
|
"Computes cosine similarity between two vectors."
|
|
(let* ((len1 (length v1)) (len2 (length v2)))
|
|
(if (or (zerop len1) (zerop len2))
|
|
0.0
|
|
(let* ((dot 0.0d0) (n1 0.0d0) (n2 0.0d0))
|
|
(dotimes (i (min len1 len2))
|
|
(let* ((x (coerce (elt v1 i) 'double-float)) (y (coerce (elt v2 i) 'double-float)))
|
|
(incf dot (* x y)) (incf n1 (* x x)) (incf n2 (* y y))))
|
|
(if (or (zerop n1) (zerop n2)) 0.0 (/ dot (sqrt (* n1 n2))))))))
|
|
|
|
(defun VAULT-MASK-STRING (s) (declare (ignore s)) "[MASKED]")
|
|
(defvar *VAULT-MEMORY* (make-hash-table :test 'equal))
|
|
|
|
(defstruct skill name priority dependencies trigger-fn probabilistic-prompt deterministic-fn)
|
|
(defvar *skills-registry* (make-hash-table :test 'equal))
|
|
(defvar *skill-catalog* (make-hash-table :test 'equal)
|
|
"A stateful tracking table for all skill files discovered in the environment.")
|
|
|
|
(defstruct skill-entry filename (status :discovered) error-log (load-time 0))
|
|
|
|
(defun find-triggered-skill (context)
|
|
"Returns the highest priority skill whose trigger matches context."
|
|
(let ((triggered nil))
|
|
(maphash (lambda (name skill)
|
|
(declare (ignore name))
|
|
(when (and (skill-probabilistic-prompt skill)
|
|
(ignore-errors (funcall (skill-trigger-fn skill) context)))
|
|
(push skill triggered)))
|
|
*skills-registry*)
|
|
(first (sort triggered #'> :key #'skill-priority))))
|
|
|
|
(defmacro defskill (name &key priority dependencies trigger probabilistic deterministic)
|
|
"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
|
|
:probabilistic-prompt ,probabilistic
|
|
:deterministic-fn ,deterministic)))
|
|
|
|
(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))))
|
|
#+end_src
|
|
|
|
** Skill File Analysis (parse-skill-metadata)
|
|
#+begin_src lisp
|
|
(defun parse-skill-metadata (filepath)
|
|
"Extracts ID and DEPENDS_ON tags from org file."
|
|
(let ((dependencies nil) (id nil) (content (uiop:read-file-string filepath)))
|
|
(let ((id-start (search ":ID:" content)))
|
|
(when id-start
|
|
(let ((id-end (position #\Newline content :start id-start)))
|
|
(when id-end (setf id (string-trim " " (subseq content (+ id-start 4) id-end)))))))
|
|
(let ((pos 0))
|
|
(loop while (setf pos (search "#+DEPENDS_ON:" content :start2 pos))
|
|
do (let ((end (position #\Newline content :start pos)))
|
|
(when end
|
|
(let ((line (string-trim " " (subseq content (+ pos 13) end))))
|
|
(dolist (d (uiop:split-string line :separator '(#\Space #\Tab)))
|
|
(unless (string= d "") (push d dependencies))))
|
|
(setf pos end)))))
|
|
(values id (reverse dependencies))))
|
|
#+end_src
|
|
|
|
** Dependency Resolution (topological-sort-skills)
|
|
#+begin_src lisp
|
|
(defun topological-sort-skills (skills-dir)
|
|
"Returns a list of skill filepaths sorted by dependency."
|
|
(let* ((org-files (uiop:directory-files skills-dir "org-skill-*.org"))
|
|
(lisp-files (uiop:directory-files skills-dir "org-skill-*.lisp"))
|
|
(files (append org-files lisp-files))
|
|
(adj (make-hash-table :test 'equal))
|
|
(name-to-file (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)))
|
|
(if (uiop:string-suffix-p (namestring file) ".lisp")
|
|
(progn
|
|
(setf (gethash (string-downcase filename) name-to-file) file)
|
|
(setf (gethash (string-downcase filename) adj) nil))
|
|
(multiple-value-bind (id deps) (parse-skill-metadata file)
|
|
(setf (gethash (string-downcase filename) name-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* ((is-id-p (uiop:string-prefix-p "id:" (string-downcase dep)))
|
|
(dep-key (string-downcase (if is-id-p (subseq dep 3) dep)))
|
|
(dep-file (if is-id-p
|
|
(gethash dep-key id-to-file)
|
|
(or (gethash dep-key id-to-file)
|
|
(gethash dep-key name-to-file)))))
|
|
(when dep-file
|
|
(let ((dep-filename (pathname-name dep-file)))
|
|
(if (gethash (string-downcase dep-filename) stack)
|
|
(error "Circular dependency detected")
|
|
(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) name-to-file)))
|
|
(when file (visit file)))))
|
|
(nreverse result))))
|
|
#+end_src
|
|
|
|
** Jailed Loading (load-skill-from-org)
|
|
#+begin_src lisp
|
|
(defun validate-lisp-syntax (code-string)
|
|
"Checks if a string contains valid Common Lisp forms."
|
|
(handler-case
|
|
(let ((*read-eval* nil))
|
|
(with-input-from-string (s (format nil "(progn ~a)" code-string))
|
|
(loop for form = (read s nil :eof) until (eq form :eof)))
|
|
(values t nil))
|
|
(error (c) (values nil (format nil "~a" c)))))
|
|
|
|
(defun remove-in-package-forms (code-string)
|
|
"Removes in-package forms so symbols get defined in skill package."
|
|
(let ((lines (uiop:split-string code-string :separator '(#\Newline)))
|
|
(result ""))
|
|
(dolist (line lines)
|
|
(let ((trimmed (string-trim '(#\Space #\Tab) line)))
|
|
(unless (uiop:string-prefix-p "(in-package" trimmed)
|
|
(setf result (concatenate 'string result line (string #\Newline))))))
|
|
result))
|
|
|
|
(defun extract-tangle-target (line)
|
|
"Extracts the value of the :tangle header."
|
|
(let ((pos (search ":tangle" line)))
|
|
(when pos
|
|
(let ((rest (string-trim '(#\Space #\Tab) (subseq line (+ pos 7)))))
|
|
(let ((end (position #\Space rest)))
|
|
(if end (subseq rest 0 end) rest))))))
|
|
|
|
(defun load-skill-from-org (filepath)
|
|
"Parses and evaluates Lisp blocks from an Org file."
|
|
(let* ((skill-base-name (pathname-name filepath))
|
|
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
|
|
(setf (skill-entry-status entry) :loading)
|
|
(handler-case
|
|
(let* ((content (uiop:read-file-string filepath))
|
|
(lines (uiop:split-string content :separator '(#\Newline)))
|
|
(in-lisp-block nil) (collect-this-block nil) (lisp-code "")
|
|
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.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" clean-line)
|
|
(setf in-lisp-block t)
|
|
(let ((target (extract-tangle-target clean-line)))
|
|
;; Collect if there's no tangle target (inherits from file)
|
|
;; or if it's a lisp file and NOT a test.
|
|
(setf collect-this-block (or (null target)
|
|
(and (not (search "no" target))
|
|
(not (search "/tests" target)))))))
|
|
((uiop:string-prefix-p "#+end_src" clean-line)
|
|
(setf in-lisp-block nil) (setf collect-this-block nil))
|
|
((and in-lisp-block collect-this-block)
|
|
(unless (or (uiop:string-prefix-p ":PROPERTIES:" (string-upcase clean-line))
|
|
(uiop:string-prefix-p ":END:" (string-upcase clean-line))
|
|
(uiop:string-prefix-p ":ID:" (string-upcase clean-line)))
|
|
(setf lisp-code (concatenate 'string lisp-code line (string #\Newline))))))))
|
|
(if (= (length lisp-code) 0)
|
|
(setf (skill-entry-status entry) :ready)
|
|
(progn
|
|
(multiple-value-bind (valid-p err) (validate-lisp-syntax lisp-code)
|
|
(unless valid-p (error err)))
|
|
(unless (find-package pkg-name)
|
|
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg)))
|
|
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
|
|
(harness-log "LOADER: Evaluating code for '~a' in package ~a" skill-base-name (package-name *package*))
|
|
(eval (read-from-string (format nil "(progn ~a)" lisp-code))))
|
|
|
|
;; Export symbols back to :OPENCORTEX for discoverability and testing
|
|
(let* ((target-pkg (find-package :opencortex))
|
|
(raw-name (string-upcase skill-base-name))
|
|
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
|
|
(subseq raw-name 10)
|
|
raw-name)))
|
|
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
|
|
(do-symbols (sym (find-package pkg-name))
|
|
(when (eq (symbol-package sym) (find-package pkg-name))
|
|
(let ((sn (symbol-name sym)))
|
|
(when (or (uiop:string-prefix-p raw-name sn)
|
|
(uiop:string-prefix-p short-name sn)
|
|
(string-equal sn "DOCTOR-MAIN")
|
|
(string-equal sn "RUN-SETUP-WIZARD"))
|
|
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn)
|
|
;; Resolve potential name conflicts by uninterning first
|
|
(let ((existing (find-symbol sn target-pkg)))
|
|
(when (and existing (not (eq existing sym)))
|
|
(unintern existing target-pkg)))
|
|
(import sym target-pkg)
|
|
(export sym target-pkg))))))
|
|
|
|
(setf (skill-entry-status entry) :ready)))
|
|
t)
|
|
(error (c)
|
|
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c)
|
|
(setf (skill-entry-status entry) :failed) nil))))
|
|
|
|
(defun load-skill-from-lisp (filepath)
|
|
"Loads a .lisp skill file directly, filtering out in-package forms."
|
|
(let* ((skill-base-name (pathname-name filepath))
|
|
(entry (or (gethash skill-base-name *skill-catalog*) (setf (gethash skill-base-name *skill-catalog*) (make-skill-entry :filename skill-base-name)))))
|
|
(setf (skill-entry-status entry) :loading)
|
|
(handler-case
|
|
(let* ((content (remove-in-package-forms (uiop:read-file-string filepath)))
|
|
(pkg-name (intern (string-upcase (format nil "OPENCORTEX.SKILLS.~a" skill-base-name)) :keyword)))
|
|
(multiple-value-bind (valid-p err) (validate-lisp-syntax content)
|
|
(unless valid-p (error err)))
|
|
(unless (find-package pkg-name)
|
|
(let ((new-pkg (make-package pkg-name :use '(:cl)))) (use-package :opencortex new-pkg)))
|
|
(let ((*read-eval* nil) (*package* (find-package pkg-name)))
|
|
(harness-log "LOADER: Loading .lisp skill '~a' in package ~a" skill-base-name (package-name *package*))
|
|
;; Evaluate forms individually so one bad form doesn't abort the entire skill
|
|
(with-input-from-string (s content)
|
|
(loop for form = (read s nil :eof) until (eq form :eof)
|
|
do (handler-case (eval form)
|
|
(error (c) (harness-log "LOADER WARNING in '~a': ~a" skill-base-name c))))))
|
|
;; Export symbols
|
|
(let* ((target-pkg (find-package :opencortex))
|
|
(raw-name (string-upcase skill-base-name))
|
|
(short-name (if (uiop:string-prefix-p "ORG-SKILL-" raw-name)
|
|
(subseq raw-name 10)
|
|
raw-name)))
|
|
(harness-log "LOADER: Scanning package ~a for symbols to export..." (package-name (find-package pkg-name)))
|
|
(do-symbols (sym (find-package pkg-name))
|
|
(when (eq (symbol-package sym) (find-package pkg-name))
|
|
(let ((sn (symbol-name sym)))
|
|
(when (or (uiop:string-prefix-p raw-name sn)
|
|
(uiop:string-prefix-p short-name sn)
|
|
(string-equal sn "DOCTOR-MAIN")
|
|
(string-equal sn "RUN-SETUP-WIZARD"))
|
|
(harness-log "LOADER: Exporting ~a to :OPENCORTEX" sn)
|
|
(let ((existing (find-symbol sn target-pkg)))
|
|
(when (and existing (not (eq existing sym)))
|
|
(unintern existing target-pkg)))
|
|
(import sym target-pkg)
|
|
(export sym target-pkg))))))
|
|
(setf (skill-entry-status entry) :ready))
|
|
(error (c)
|
|
(harness-log "LOADER ERROR in skill '~a': ~a" skill-base-name c)
|
|
(setf (skill-entry-status entry) :failed) nil))))
|
|
#+end_src
|
|
|
|
** Initialize (initialize-all-skills)
|
|
#+begin_src lisp
|
|
(defun initialize-all-skills ()
|
|
"Initializes all skills from SKILLS_DIR."
|
|
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
|
|
(skills-dir (uiop:ensure-directory-pathname (or env-path (namestring (merge-pathnames "notes/" (user-homedir-pathname)))))))
|
|
(unless (uiop:directory-exists-p skills-dir) (return-from initialize-all-skills nil))
|
|
(let ((sorted-files (topological-sort-skills skills-dir)))
|
|
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files))
|
|
(dolist (file sorted-files)
|
|
(if (uiop:string-suffix-p (namestring file) ".lisp")
|
|
(load-skill-from-lisp file)
|
|
(load-skill-from-org file)))
|
|
(harness-log "LOADER: Boot Complete."))))
|
|
#+end_src
|
|
|
|
* Test Suite
|
|
#+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp
|
|
(eval-when (:compile-toplevel :load-toplevel :execute)
|
|
(ql:quickload :fiveam :silent t))
|
|
|
|
(defpackage :opencortex-boot-tests
|
|
(:use :cl :fiveam :opencortex)
|
|
(:export #:boot-suite))
|
|
|
|
(in-package :opencortex-boot-tests)
|
|
|
|
(def-suite boot-suite :description "Verification of the Skill Engine loader")
|
|
(in-suite boot-suite)
|
|
|
|
(test test-topological-sort-basic
|
|
(let ((tmp-dir "/tmp/opencortex-boot-test/"))
|
|
(uiop:ensure-all-directories-exist (list tmp-dir))
|
|
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
(format out "#+DEPENDS_ON: 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:~%"))
|
|
(unwind-protect
|
|
(let ((sorted (opencortex::topological-sort-skills tmp-dir)))
|
|
(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 (< pos-b pos-a))))
|
|
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
|
#+end_src
|