passepartout/harness/skills.org

The Skill Engine (skills.lisp)

• Overview
• Implementation
  • Package Context
  • Global Skill Registry
  • Skill File Analysis (parse-skill-metadata)
  • Dependency Resolution (topological-sort-skills)
  • Jailed Loading (load-skill-from-org)
  • Initialize (initialize-all-skills)
• Test Suite

Overview

The opencortex Skill Engine enables Late-Binding Intelligence, allowing the system to discover and integrate new cognitive capabilities at runtime.

Implementation

Package Context

(in-package :opencortex)

Global Skill Registry

(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))))

Skill File Analysis (parse-skill-metadata)

(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))))

Dependency Resolution (topological-sort-skills)

(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))))

Jailed Loading (load-skill-from-org)

(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))))

Initialize (initialize-all-skills)

(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."))))

Test Suite

(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))))