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

REFAC: Standardize on Cognitive Cycle and harden harness

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-16 12:00:12 -04:00
parent 2d4a6d1586
commit 53eee06225
39 changed files with 236 additions and 2725 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
src/act.lisp
View File

@@ -68,15 +68,18 @@
(type (getf signal :type))
(feedback nil))
;; 1. Last-Mile Safety Check (The Bouncer)
;; 1. Last-Mile Safety Check (The Bouncer & Deterministic Gates)
(when approved
(let ((verified (decide approved signal)))
(if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT)))
(let ((verified (deterministic-verify approved signal)))
(if (and (listp verified) (member (getf verified :type) '(:LOG :EVENT :log :event)))
(progn
(harness-log "ACT BLOCKED: Action failed last-mile deterministic check.")
(setf (getf signal :approved-action) nil)
(setf approved nil)
(setf feedback verified))
(setf approved verified))))
(progn
(setf (getf signal :approved-action) verified)
(setf approved verified)))))
;; 2. Actuation Logic
(case type

37
src/deterministic.lisp
View File

@@ -1,37 +0,0 @@
(in-package :opencortex)
(defun decide (proposed-action context)
"The Deterministic Safety Gate: iterates through all skill deterministic-gates sorted by priority."
(let ((current-action proposed-action)
(skills nil))
;; 1. Collect all skills with deterministic gates
(maphash (lambda (name skill)
(declare (ignore name))
(when (skill-deterministic-fn skill)
(push skill skills)))
*skills-registry*)
;; 2. Sort skills by priority (highest first)
(setf skills (sort skills #'> :key #'skill-priority))
;; 3. Execute deterministic gates sequentially
(dolist (skill skills)
(let ((gate (skill-deterministic-fn skill)))
(setf current-action (funcall gate current-action context))
;; If any gate returns a LOG or EVENT (blocking/intercepting), stop and return it.
(when (and (listp current-action)
(member (getf current-action :type) '(:LOG :EVENT :log :event)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'~%" (skill-name skill))
(return-from decide current-action))))
current-action))
(defun list-objects-with-attribute (attr-key attr-val)
"Filters the Memory for nodes having a specific attribute value."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(when (equal (getf (org-object-attributes obj) attr-key) attr-val)
(push obj results)))
*memory*)
results))

4
src/memory.lisp
View File

@@ -79,6 +79,10 @@
(harness-log "MEMORY - Memory rolled back to snapshot ~a" index))
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
(defun org-id-new ()
"Generates a new UUID string for Org-mode identification."
(string-downcase (format nil "~a" (uuid:make-v4-uuid))))
(defun lookup-object (id)
"Retrieves an object from the store by its unique ID."
(gethash id *memory*))

11
src/package.lisp
View File

@@ -17,6 +17,7 @@
#:ingest-ast
#:lookup-object
#:list-objects-by-type
#:org-id-new
#:*memory*
#:*history-store*
#:org-object
@@ -51,7 +52,9 @@
#:perceive-gate
#:probabilistic-gate
#:consensus-gate
#:decide-gate
#:act-gate
#:reason-gate
#:perceive-gate
#:dispatch-gate
#:inject-stimulus
#:initialize-actuators
@@ -96,9 +99,13 @@
#:distill-prompt
#:*provider-cascade*
;; --- Security Vault ---
#:vault-get-secret
#:vault-set-secret
;; --- Deterministic Logic ---
#:list-objects-with-attribute
#:decide
#:deterministic-verify
;; --- AST Helpers ---
#:find-headline-missing-id))

16
src/reason.lisp
View File

@@ -58,14 +58,16 @@
(maphash (lambda (name skill) (declare (ignore name)) (when (skill-deterministic-fn skill) (push skill skills))) *skills-registry*)
(setf skills (sort skills #'> :key #'skill-priority))
;; 2. Execute gates sequentially
;; 2. Execute gates sequentially if their trigger allows
(dolist (skill skills)
(let ((gate (skill-deterministic-fn skill)))
(setf current-action (funcall gate current-action context))
;; If any gate returns a LOG or EVENT, it has intercepted the action.
(when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify current-action))))
(let ((trigger (skill-trigger-fn skill))
(gate (skill-deterministic-fn skill)))
(when (or (null trigger) (ignore-errors (funcall trigger context)))
(setf current-action (funcall gate current-action context))
;; If any gate returns a LOG or EVENT, it has intercepted the action.
(when (and (listp current-action) (member (getf current-action :type) '(:LOG :EVENT :log :event)))
(harness-log "DETERMINISTIC: Intercepted by skill '~a'" (skill-name skill))
(return-from deterministic-verify current-action)))))
current-action))
(defun reason-gate (signal)

44
src/skills.lisp
View File

@@ -205,30 +205,30 @@
'("org-skill-policy" "org-skill-bouncer"))))
(dolist (req mandatory-skills)
(unless (member req sorted-files :key #'pathname-name :test #'string-equal)
(error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory." req))))
(error "BOOT FAILURE: Mandatory skill '~a' not found in skills directory." req)))
(harness-log "==================================================")
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(let* ((skill-name (pathname-name file))
(is-mandatory (member skill-name mandatory-skills :test #'string-equal)))
(harness-log " LOADER: Loading ~a..." skill-name)
(let ((status (load-skill-with-timeout file 5)))
(unless (eq status :success)
(if is-mandatory
(error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status)
(harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name))))))
;; 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*)
(harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
(harness-log "==================================================")
(values ready failed)))))
(harness-log " LOADER: Initializing ~a skills..." (length sorted-files))
(dolist (file sorted-files)
(let* ((skill-name (pathname-name file))
(is-mandatory (member skill-name mandatory-skills :test #'string-equal)))
(harness-log " LOADER: Loading ~a..." skill-name)
(let ((status (load-skill-with-timeout file 5)))
(unless (eq status :success)
(if is-mandatory
(error "BOOT FAILURE: Mandatory skill '~a' failed to load (Status: ~a)." skill-name status)
(harness-log "LOADER WARNING: Skill '~a' failed to load." skill-name))))))
;; 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*)
(harness-log " LOADER: Boot Complete. [Ready: ~a] [Failed: ~a]" ready failed)
(harness-log "==================================================")
(values ready failed))))))
(defun generate-tool-belt-prompt ()
"Aggregates all registered cognitive tools into a descriptive prompt."