REFACTOR: Explanatory Core Architecture & Terminology Alignment
This commit is contained in:
@@ -17,7 +17,7 @@
|
||||
(when (member act '(:modify-file :write-file :replace :rename-file :delete-file))
|
||||
(let ((proj-root (asdf:system-source-directory :org-agent)))
|
||||
(unless (verify-git-clean-p proj-root)
|
||||
(harness-log "DELIBERATE [Standards]: BLOCKING ACTION. Working tree is dirty. Commit changes before modification.")
|
||||
(harness-log "DETERMINISTIC [Standards]: BLOCKING ACTION. Working tree is dirty. Commit changes before modification.")
|
||||
(return-from engineering-standards-gate
|
||||
(list :type :LOG :payload (list :text "Engineering Standard Violation: Working tree dirty. You MUST commit before modifying files."))))))
|
||||
|
||||
|
||||
36
src/harness-monitor.lisp
Normal file
36
src/harness-monitor.lisp
Normal file
@@ -0,0 +1,36 @@
|
||||
(in-package :org-agent)
|
||||
|
||||
(org-agent:def-cognitive-tool :harness-status \"Returns the current operational status of the Org-Agent harness, including loaded skills and telemetry.\"
|
||||
nil
|
||||
:body (lambda (args)
|
||||
(declare (ignore args))
|
||||
(format nil \"HARNESS STATUS:
|
||||
- Active Skills: ~a
|
||||
- Uptime: ~a seconds
|
||||
- Memory Usage: ~a
|
||||
- Providers: ~a\"
|
||||
(hash-table-count org-agent:*skills-registry*)
|
||||
(get-universal-time)
|
||||
\"Not implemented\"
|
||||
org-agent:*provider-cascade*)))
|
||||
|
||||
(org-agent:def-cognitive-tool :list-skills \"Lists all currently loaded skills and their metadata.\"
|
||||
nil
|
||||
:body (lambda (args)
|
||||
(declare (ignore args))
|
||||
(let ((output \"LOADED SKILLS:
|
||||
\"))
|
||||
(maphash (lambda (name skill)
|
||||
(setf output (concatenate 'string output
|
||||
(format nil \"- ~a (Priority: ~a, Deps: ~s)~%\"
|
||||
name
|
||||
(org-agent:skill-priority skill)
|
||||
(org-agent:skill-dependencies skill)))))
|
||||
org-agent:*skills-registry*)
|
||||
output)))
|
||||
|
||||
(defskill :skill-harness-monitor
|
||||
:priority 100
|
||||
:trigger (lambda (context) t)
|
||||
:neuro (lambda (context) \"You are the Harness Monitor. Use your tools to provide system visibility.\")
|
||||
:symbolic (lambda (action context) action))
|
||||
@@ -17,7 +17,7 @@
|
||||
code)))
|
||||
|
||||
(defun neural-repair (code error-message)
|
||||
"Uses System 1 to deeply repair the syntax structure."
|
||||
"Uses Probabilistic Engine to deeply repair the syntax structure."
|
||||
(let ((prompt (format nil "The following Lisp code failed to parse.
|
||||
ERROR: ~a
|
||||
CODE: ~a
|
||||
|
||||
102
src/lisp-validator.lisp
Normal file
102
src/lisp-validator.lisp
Normal file
@@ -0,0 +1,102 @@
|
||||
(in-package :org-agent)
|
||||
|
||||
(defparameter *lisp-validator-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max
|
||||
and or not null eq eql equal string= string-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop
|
||||
;; Plists and Hash Tables
|
||||
getf gethash
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search
|
||||
;; Kernel specifics
|
||||
org-agent::harness-log
|
||||
org-agent::snapshot-object-store
|
||||
org-agent::rollback-object-store
|
||||
org-agent::lookup-object
|
||||
org-agent::list-objects-by-type
|
||||
org-agent::ingest-ast
|
||||
org-agent::find-headline-missing-id
|
||||
org-agent::context-query-store
|
||||
org-agent::context-get-active-projects
|
||||
org-agent::context-get-recent-completed-tasks
|
||||
org-agent::context-list-all-skills
|
||||
org-agent::context-get-system-logs
|
||||
org-agent::context-assemble-global-awareness
|
||||
org-agent::org-object-id
|
||||
org-agent::org-object-type
|
||||
org-agent::org-object-attributes
|
||||
org-agent::org-object-content
|
||||
org-agent::org-object-parent-id
|
||||
org-agent::org-object-children
|
||||
org-agent::org-object-version
|
||||
org-agent::org-object-last-sync
|
||||
org-agent::org-object-hash
|
||||
;; Essential macros
|
||||
declare ignore
|
||||
;; Let's also add simple data types
|
||||
t nil quote function))
|
||||
|
||||
(defvar *lisp-validator-registry* nil
|
||||
"List of dynamically registered safe symbols.")
|
||||
|
||||
(defun lisp-validator-register (symbols)
|
||||
"Adds symbols to the global validator registry."
|
||||
(setf *lisp-validator-registry* (append *lisp-validator-registry* (if (listp symbols) symbols (list symbols))))
|
||||
(harness-log "LISP VALIDATOR: Registered ~a new safe symbols." (length (if (listp symbols) symbols (list symbols)))))
|
||||
|
||||
(defun lisp-validator-is-safe (symbol)
|
||||
"Checks if a symbol is in the static whitelist or the dynamic registry."
|
||||
(or (member symbol *lisp-validator-whitelist* :test #'string-equal)
|
||||
(member symbol *lisp-validator-registry* :test #'string-equal)))
|
||||
|
||||
(defun lisp-validator-ast-walk (form)
|
||||
"Recursively walks the Lisp AST. Returns T if safe, NIL if unsafe."
|
||||
(cond
|
||||
;; Self-evaluating objects (strings, numbers, keywords) are safe.
|
||||
((or (stringp form) (numberp form) (keywordp form) (characterp form))
|
||||
t)
|
||||
;; Symbols used as variables (in non-function position)
|
||||
((symbolp form)
|
||||
(lisp-validator-is-safe form))
|
||||
;; Lists represent function calls or special forms.
|
||||
((listp form)
|
||||
(let ((head (car form)))
|
||||
(cond
|
||||
((eq head 'quote) t)
|
||||
((not (symbolp head)) nil)
|
||||
((lisp-validator-is-safe head)
|
||||
(every #'lisp-validator-ast-walk (cdr form)))
|
||||
(t
|
||||
(harness-log "LISP VALIDATOR: Blocked call to non-whitelisted function ~a" head)
|
||||
nil))))
|
||||
(t nil)))
|
||||
|
||||
(org-agent:def-cognitive-tool :lisp-validator-status "Returns validator-related telemetry, including blocked actions and harness status."
|
||||
nil
|
||||
:body (lambda (args)
|
||||
(declare (ignore args))
|
||||
(format nil "LISP VALIDATOR STATUS:
|
||||
- Static Whitelist: ~a symbols
|
||||
- Dynamic Registry: ~a symbols
|
||||
- Total Blocked Actions: ~a"
|
||||
(length *lisp-validator-whitelist*)
|
||||
(length *lisp-validator-registry*)
|
||||
"Not implemented")))
|
||||
|
||||
(org-agent:defskill :skill-lisp-validator
|
||||
:priority 900 ; High priority, before most skills
|
||||
:trigger (lambda (ctx)
|
||||
;; Check if any proposed action is an :eval or :shell call
|
||||
(let ((candidate (getf ctx :candidate)))
|
||||
(when candidate
|
||||
(let ((payload (getf candidate :payload)))
|
||||
(member (getf payload :action) '(:eval :shell))))))
|
||||
:neuro nil ; Purely deterministic/safety skill
|
||||
:symbolic (lambda (action context)
|
||||
(harness-log "DETERMINISTIC ENGINE [Lisp-Validator]: Intercepted critical action for structural validation.")
|
||||
action))
|
||||
@@ -19,7 +19,7 @@
|
||||
(let ((api-key (vault-get-secret provider :type :api-key))
|
||||
(full-prompt (format nil "~a~%~%Prompt: ~a" system-prompt prompt)))
|
||||
|
||||
(harness-log "SYSTEM 1: Requesting ~a (Model: ~a) [Key: ~a]"
|
||||
(harness-log "PROBABILISTIC ENGINE: Requesting ~a (Model: ~a) [Key: ~a]"
|
||||
provider (or model "default") (vault-mask-string api-key))
|
||||
|
||||
(case provider
|
||||
|
||||
@@ -70,10 +70,10 @@
|
||||
signal))
|
||||
|
||||
(defun neuro-gate (signal)
|
||||
"Associative: Neural intuition and proposed actions."
|
||||
"Probabilistic: Neural intuition and proposed actions."
|
||||
(unless (eq (getf signal :type) :EVENT)
|
||||
(return-from neuro-gate signal))
|
||||
(harness-log "GATE [Associative]: Consulting LLM...")
|
||||
(harness-log "GATE [Probabilistic]: Consulting LLM...")
|
||||
(let ((thoughts (think signal)))
|
||||
(setf (getf signal :proposals) (if (and (listp thoughts) (listp (car thoughts)))
|
||||
thoughts
|
||||
@@ -103,7 +103,7 @@
|
||||
signal))
|
||||
|
||||
(defun decide-gate (signal)
|
||||
"Deliberate: Deterministic safety and validation."
|
||||
"Deterministic: Deterministic safety and validation."
|
||||
(let ((candidate (getf signal :candidate)))
|
||||
(if candidate
|
||||
(let* ((normalized-candidate (if (listp candidate) candidate (list :type :RESPONSE :payload (list :text candidate))))
|
||||
|
||||
@@ -10,7 +10,7 @@
|
||||
|
||||
(defvar *consensus-enabled-p* nil "If T, ask-neuro queries all backends in parallel.")
|
||||
|
||||
(defun ask-neuro (prompt &key (system-prompt "You are the Associative engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
|
||||
(defun ask-neuro (prompt &key (system-prompt "You are the Probabilistic engine of a Neurosymbolic Lisp Machine.") (cascade nil) (context nil))
|
||||
"Dispatches a neural request through the provider cascade or parallel consensus."
|
||||
(let ((backends (cond
|
||||
((and cascade (listp cascade)) cascade)
|
||||
@@ -26,7 +26,7 @@
|
||||
(when backend-fn
|
||||
(push (bt:make-thread
|
||||
(lambda ()
|
||||
(harness-log "ASSOCIATIVE [Consensus]: Querying backend ~a..." backend)
|
||||
(harness-log "PROBABILISTIC [Consensus]: Querying backend ~a..." backend)
|
||||
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
|
||||
(result (ignore-errors
|
||||
(if model
|
||||
@@ -50,7 +50,7 @@
|
||||
(or (dolist (backend backends)
|
||||
(let ((backend-fn (gethash backend *neuro-backends*)))
|
||||
(when backend-fn
|
||||
(harness-log "ASSOCIATIVE: Attempting backend ~a..." backend)
|
||||
(harness-log "PROBABILISTIC: Attempting backend ~a..." backend)
|
||||
(let* ((model (when *model-selector-fn* (funcall *model-selector-fn* backend context)))
|
||||
(result (if model
|
||||
(funcall backend-fn prompt system-prompt :model model)
|
||||
@@ -61,13 +61,13 @@
|
||||
"(:type :LOG :payload (:text \"Neural Cascade Failure\"))"))))
|
||||
|
||||
(defun think (context)
|
||||
"Invokes the neural Associative engine to propose a Lisp action based on context."
|
||||
"Invokes the neural Probabilistic engine to propose a Lisp action based on context."
|
||||
(let ((active-skill (find-triggered-skill context))
|
||||
(tool-belt (generate-tool-belt-prompt))
|
||||
(global-context (context-assemble-global-awareness)))
|
||||
(if active-skill
|
||||
(progn
|
||||
(harness-log "ASSOCIATIVE: Engaging skill '~a'~%" (skill-name active-skill))
|
||||
(harness-log "PROBABILISTIC: Engaging skill '~a'~%" (skill-name active-skill))
|
||||
(let* ((prompt-generator (skill-neuro-prompt active-skill))
|
||||
(raw-prompt (when prompt-generator (funcall prompt-generator context)))
|
||||
(full-system-prompt (concatenate 'string
|
||||
@@ -95,7 +95,7 @@ To call a tool, you MUST use:
|
||||
(raw-thoughts (cl-ppcre:split (cl-ppcre:quote-meta-chars "|CONSENSUS-SEP|") thought))
|
||||
(suggestions nil))
|
||||
(dolist (raw-thought raw-thoughts)
|
||||
(harness-log "ASSOCIATIVE RAW: ~a~%" raw-thought)
|
||||
(harness-log "PROBABILISTIC RAW: ~a~%" raw-thought)
|
||||
(let* ((cleaned-thought
|
||||
(let ((match (cl-ppcre:scan-to-strings "(?s)```(?:lisp)?\\n?(.*?)\\n?```" raw-thought)))
|
||||
(if match
|
||||
@@ -109,7 +109,7 @@ To call a tool, you MUST use:
|
||||
(list :sensor :syntax-error
|
||||
:code cleaned-thought
|
||||
:error (format nil "~a" c)))))))
|
||||
(harness-log "ASSOCIATIVE Suggestion: ~a~%" cleaned-thought)
|
||||
(harness-log "PROBABILISTIC Suggestion: ~a~%" cleaned-thought)
|
||||
(when (and suggestion (listp suggestion))
|
||||
(push suggestion suggestions))))
|
||||
(if (and *consensus-enabled-p* suggestions)
|
||||
|
||||
@@ -61,7 +61,7 @@
|
||||
#:load-skill-with-timeout
|
||||
#:topological-sort-skills
|
||||
#:validate-lisp-syntax
|
||||
#:safety-harness-validate
|
||||
#:lisp-validator-validate
|
||||
#:defskill
|
||||
#:*skills-registry*
|
||||
#:skill
|
||||
@@ -88,7 +88,7 @@
|
||||
#:register-emacs-client
|
||||
#:unregister-emacs-client
|
||||
|
||||
;; --- Associative Engine ---
|
||||
;; --- Probabilistic Engine ---
|
||||
#:ask-neuro
|
||||
#:register-neuro-backend
|
||||
#:distill-prompt
|
||||
|
||||
15
src/policy-enforcer.lisp
Normal file
15
src/policy-enforcer.lisp
Normal file
@@ -0,0 +1,15 @@
|
||||
(in-package :org-agent)
|
||||
|
||||
(defskill :skill-policy-enforcer
|
||||
:priority 1000 ; Absolute highest priority
|
||||
:trigger (lambda (context) t) ; Always active as a fallback
|
||||
:neuro (lambda (context)
|
||||
"You are the Org-Agent Policy Enforcer. Your goal is to ensure all actions empower the user through the Lisp Machine and adhere to the System Policy.")
|
||||
:symbolic (lambda (action context)
|
||||
;; Basic invariant check: Block actions that appear to violate sovereignty
|
||||
(let ((payload (getf action :payload)))
|
||||
(if (and payload (search "proprietary" (format nil "~s" payload)))
|
||||
(progn
|
||||
(org-agent:harness-log "DETERMINISTIC [Policy]: Sovereignty violation suspected. Blocking action.")
|
||||
nil)
|
||||
action))))
|
||||
@@ -1,42 +0,0 @@
|
||||
(in-package :org-agent)
|
||||
|
||||
(defparameter *safety-whitelist*
|
||||
'(;; Math & Logic
|
||||
+ - * / = < > <= >= 1+ 1- min max
|
||||
and or not null eq eql equal string= string-equal
|
||||
;; List Manipulation
|
||||
list cons car cdr cadr cddr cdar caar append mapcar remove-if remove-if-not
|
||||
length reverse sort nth nthcdr push pop
|
||||
;; Plists and Hash Tables
|
||||
getf gethash
|
||||
;; Control Flow
|
||||
let let* if cond when unless case typecase
|
||||
;; Strings
|
||||
format concatenate string-downcase string-upcase search
|
||||
;; Kernel specifics
|
||||
org-agent::harness-log
|
||||
org-agent::snapshot-object-store
|
||||
org-agent::rollback-object-store
|
||||
org-agent::lookup-object
|
||||
org-agent::list-objects-by-type
|
||||
org-agent::ingest-ast
|
||||
org-agent::find-headline-missing-id
|
||||
org-agent::context-query-store
|
||||
org-agent::context-get-active-projects
|
||||
org-agent::context-get-recent-completed-tasks
|
||||
org-agent::context-list-all-skills
|
||||
org-agent::context-get-system-logs
|
||||
org-agent::context-assemble-global-awareness
|
||||
org-agent::org-object-id
|
||||
org-agent::org-object-type
|
||||
org-agent::org-object-attributes
|
||||
org-agent::org-object-content
|
||||
org-agent::org-object-parent-id
|
||||
org-agent::org-object-children
|
||||
org-agent::org-object-version
|
||||
org-agent::org-object-last-sync
|
||||
org-agent::org-object-hash
|
||||
;; Essential macros
|
||||
declare ignore
|
||||
;; Let's also add simple data types
|
||||
t nil quote function))
|
||||
@@ -196,7 +196,7 @@
|
||||
(return-from initialize-all-skills nil))
|
||||
|
||||
(let ((sorted-files (topological-sort-skills skills-dir)))
|
||||
;; MANDATE: The System Invariants must be present for a safe boot
|
||||
;; MANDATE: The System Policy must be present for a safe boot
|
||||
(unless (member "org-skill-system-invariants" sorted-files :key #'pathname-name :test #'string-equal)
|
||||
(error "BOOT FAILURE: org-skill-system-invariants.org not found in skills directory."))
|
||||
|
||||
@@ -244,9 +244,9 @@ EXAMPLES:
|
||||
:guard (lambda (args context)
|
||||
(declare (ignore context))
|
||||
(let ((code (getf args :code)))
|
||||
(let ((harness-pkg (find-package :org-agent.skills.org-skill-safety-harness)))
|
||||
(let ((harness-pkg (find-package :org-agent.skills.org-skill-lisp-validator)))
|
||||
(if harness-pkg
|
||||
(uiop:symbol-call :org-agent.skills.org-skill-safety-harness :safety-harness-validate code)
|
||||
(uiop:symbol-call :org-agent.skills.org-skill-lisp-validator :lisp-validator-validate code)
|
||||
t))))
|
||||
:body (lambda (args)
|
||||
(let ((code (getf args :code)))
|
||||
|
||||
@@ -1,7 +1,7 @@
|
||||
(in-package :org-agent)
|
||||
|
||||
(defun decide (proposed-action context)
|
||||
"The Deliberate Safety Gate: iterates through all skill symbolic-gates sorted by priority."
|
||||
"The Deterministic Safety Gate: iterates through all skill symbolic-gates sorted by priority."
|
||||
(let ((current-action proposed-action)
|
||||
(skills nil))
|
||||
;; 1. Collect all skills with symbolic gates
|
||||
@@ -21,7 +21,7 @@
|
||||
;; 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 "DELIBERATE: Intercepted by skill '~a'~%" (skill-name skill))
|
||||
(harness-log "DETERMINISTIC: Intercepted by skill '~a'~%" (skill-name skill))
|
||||
(return-from decide current-action))))
|
||||
|
||||
current-action))
|
||||
|
||||
@@ -1,50 +0,0 @@
|
||||
(in-package :org-agent)
|
||||
|
||||
(org-agent:def-cognitive-tool :harness-status "Returns the current operational status of the Org-Agent harness, including loaded skills and telemetry."
|
||||
nil
|
||||
:body (lambda (args)
|
||||
(declare (ignore args))
|
||||
(format nil "HARNESS STATUS:
|
||||
- Active Skills: ~a
|
||||
- Uptime: ~a seconds
|
||||
- Memory Usage: ~a
|
||||
- Providers: ~a"
|
||||
(hash-table-count org-agent:*skills-registry*)
|
||||
(get-universal-time) ; Placeholder for actual uptime
|
||||
"Not implemented"
|
||||
org-agent:*provider-cascade*)))
|
||||
|
||||
(org-agent:def-cognitive-tool :list-skills "Lists all currently loaded skills and their metadata."
|
||||
nil
|
||||
:body (lambda (args)
|
||||
(declare (ignore args))
|
||||
(let ((output "LOADED SKILLS:
|
||||
"))
|
||||
(maphash (lambda (name skill)
|
||||
(setf output (concatenate 'string output
|
||||
(format nil "- ~a (Priority: ~a, Deps: ~s)~%"
|
||||
name
|
||||
(org-agent:skill-priority skill)
|
||||
(org-agent:skill-dependencies skill)))))
|
||||
org-agent:*skills-registry*)
|
||||
output)))
|
||||
|
||||
(org-agent:defskill :skill-system-invariants
|
||||
:priority 1000 ; Absolute highest priority
|
||||
:trigger (lambda (context) t) ; Always active as a fallback
|
||||
:neuro (lambda (context)
|
||||
"You are the Org-Agent System Invariants Skill. Your goal is to empower the user through the Lisp Machine.
|
||||
Follow the Core Invariants:
|
||||
1. Sovereignty: Avoid proprietary traps.
|
||||
2. Technical Mastery: Explain your logic.
|
||||
3. Zero-Bloat: Keep it minimal.
|
||||
4. Transparency: Your thoughts are auditable.
|
||||
5. Sustainability: Think long-term.")
|
||||
:symbolic (lambda (action context)
|
||||
;; Basic invariant check: Block actions that appear to violate sovereignty
|
||||
(let ((payload (getf action :payload)))
|
||||
(if (and payload (search "proprietary" (format nil "~s" payload)))
|
||||
(progn
|
||||
(org-agent:harness-log "DELIBERATE [Invariants]: Sovereignty violation suspected. Blocking action.")
|
||||
nil)
|
||||
action))))
|
||||
Reference in New Issue
Block a user