fix(v0.2.0): resolve TUI crash and setup wizard errors

- 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)
This commit is contained in:
2026-04-30 17:04:01 -04:00
parent 1eb8a3db92
commit b63f5477c1
35 changed files with 249 additions and 1249 deletions

View File

@@ -10,8 +10,7 @@
(defmethod make-load-form ((obj org-object) &optional env)
(make-load-form-saving-slots obj :environment env))
(defun deep-copy-org-object (obj)
"Create a deep copy of an org-object with fresh lists for mutable fields."
(defun copy-org-object (obj)
(make-org-object :id (org-object-id obj)
:type (org-object-type obj)
:attributes (copy-list (org-object-attributes obj))
@@ -72,7 +71,7 @@
(defun snapshot-memory ()
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*))))
(maphash (lambda (k v) (setf (gethash k snapshot) (deep-copy-org-object v))) *memory*)
(maphash (lambda (k v) (setf (gethash k snapshot) (copy-org-object v))) *memory*)
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
(when (> (length *object-store-snapshots*) 20) (setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))
(harness-log "MEMORY - CoW Memory snapshot created.")))

View File

@@ -224,7 +224,22 @@
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
:body ,body)))
(defun generate-tool-belt-prompt ()
"Generates a prompt string describing all available cognitive tools."
(let ((descriptions nil))
(maphash (lambda (k tool)
(declare (ignore k))
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
(cognitive-tool-name tool)
(cognitive-tool-description tool)
(cognitive-tool-parameters tool))
descriptions))
*cognitive-tools*)
(if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered.")))
(defun harness-log (msg &rest args)
"Centralized logging for the harness."

View File

@@ -240,7 +240,22 @@ The ~package.lisp~ file defines the public API of the ~opencortex~ harness.
:description ,description
:parameters ',parameters
:guard ,guard
:body ,body)))
:body ,body)))
(defun generate-tool-belt-prompt ()
"Generates a prompt string describing all available cognitive tools."
(let ((descriptions nil))
(maphash (lambda (k tool)
(declare (ignore k))
(push (format nil "- ~a: ~a~% Parameters: ~a~%"
(cognitive-tool-name tool)
(cognitive-tool-description tool)
(cognitive-tool-parameters tool))
descriptions))
*cognitive-tools*)
(if descriptions
(format nil "Available tools:~%~a" (apply #'concatenate 'string (sort descriptions #'string<)))
"No tools registered.")))
(defun harness-log (msg &rest args)
"Centralized logging for the harness."

View File

@@ -71,14 +71,14 @@
assistant-name reflection-feedback tool-belt global-context system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (or cleaned "No response")))))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
(defun deterministic-verify (proposed-action context)
(let ((current-action proposed-action)
@@ -98,7 +98,7 @@
(member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action))
(setf current-action next-action)))))
(when next-action (setf current-action next-action))))))
current-action))
(defun reason-gate (signal)

View File

@@ -96,14 +96,14 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
assistant-name reflection-feedback tool-belt global-context system-logs)))
(let* ((thought (probabilistic-call raw-prompt :system-prompt system-prompt :context context))
(cleaned (strip-markdown thought)))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (char= (char cleaned 0) #\((char= (char cleaned 0) #\()))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (or cleaned "No response")))))))
(if (and cleaned (stringp cleaned) (> (length cleaned) 0) (or (char= (char cleaned 0) #\() (char= (char cleaned 0) #\[)))
(handler-case
(let ((parsed (read-from-string cleaned)))
(if (listp parsed)
(normalize-plist-keywords parsed)
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(error () (list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT cleaned :EXPLANATION "Generated by the Probabilistic engine."))))
(list :TYPE :REQUEST :PAYLOAD (list :ACTION :MESSAGE :TEXT (if (stringp cleaned) cleaned "No response") :EXPLANATION "Generated by the Probabilistic engine."))))))
#+end_src
** Deterministic Engine (Verification)
@@ -126,7 +126,7 @@ The Reason stage implements the core Innovation of OpenCortex: the separation of
(member (proto-get next-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify next-action))
(setf current-action next-action)))))
(when next-action (setf current-action next-action))))))
current-action))
#+end_src

View File

@@ -74,7 +74,9 @@
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
(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))
@@ -83,10 +85,14 @@
(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) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))
(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)))
@@ -122,6 +128,16 @@
(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)))
@@ -133,7 +149,7 @@
(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*) (make-skill-entry :filename skill-base-name))))
(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))
@@ -146,7 +162,7 @@
((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)
;; 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))
@@ -168,7 +184,7 @@
(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))
@@ -190,13 +206,57 @@
(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))))
(defun initialize-all-skills ()
"Initializes all skills from SKILLS_DIR."
(let* ((env-path (uiop:getenv "SKILLS_DIR"))
@@ -205,5 +265,7 @@
(let ((sorted-files (topological-sort-skills skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(load-skill-from-org file))
(if (uiop:string-suffix-p (namestring file) ".lisp")
(load-skill-from-lisp file)
(load-skill-from-org file)))
(harness-log "LOADER: Boot Complete."))))

View File

@@ -96,7 +96,9 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
#+begin_src lisp
(defun topological-sort-skills (skills-dir)
"Returns a list of skill filepaths sorted by dependency."
(let ((files (uiop:directory-files skills-dir "org-skill-*.org"))
(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))
@@ -105,10 +107,14 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(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) name-to-file) file)
(when id (setf (gethash (string-downcase id) id-to-file) file))
(setf (gethash (string-downcase filename) adj) deps))))
(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)))
@@ -147,6 +153,16 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(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)))
@@ -158,7 +174,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(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*) (make-skill-entry :filename skill-base-name))))
(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))
@@ -171,7 +187,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
((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)
;; 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))
@@ -193,7 +209,7 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(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))
@@ -215,12 +231,56 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(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)
@@ -233,7 +293,9 @@ The ~opencortex~ Skill Engine enables **Late-Binding Intelligence**, allowing th
(let ((sorted-files (topological-sort-skills skills-dir)))
(harness-log "LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(load-skill-from-org file))
(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