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

Revert "docs: finalize architecture and philosophy with Mermaid diagrams and PSF mandates"

Browse Source 
This reverts commit 6c17619492.
This commit is contained in:
Amr Gharbeia
2026-04-01 16:14:20 -04:00
parent 6c17619492
commit 0eb9e3773f
8 changed files with 349 additions and 336 deletions
Download Patch File Download Diff File Expand all files Collapse all files

134
src/context.lisp
View File

@@ -1,134 +0,0 @@
(in-package :org-agent)
;;; ============================================================================
;;; Context API (System 1 Peripheral Vision)
;;; ============================================================================
;;; These functions provide the 'peripheral vision' for the LLM.
;;; When building a prompt, a skill can call these functions to gather
;;; relevant facts from the Object Store, preventing 'tunnel vision'.
(defun context-query-store (&key tag todo-state type)
"A high-level search engine for the Object Store.
TAG: String to search for in the :TAGS property.
TODO-STATE: The string state (e.g., 'TODO', 'DONE', 'WAITING').
TYPE: The keyword type (e.g., :HEADLINE).
Returns a list of org-object structs that satisfy ALL provided criteria."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let* ((attrs (org-object-attributes obj))
(obj-type (org-object-type obj))
(tags (getf attrs :TAGS))
(state (getf attrs :TODO-STATE))
(match t))
;; Filter by Type
(when (and type (not (eq obj-type type))) (setf match nil))
;; Filter by Tag (Org tags are often stored as a colon-delimited string like ':work:urgent:')
(when tag
(let ((tags-str (format nil "~a" tags)))
(unless (search tag tags-str :test #'string-equal)
(setf match nil))))
;; Filter by TODO State
(when (and todo-state (not (equal state todo-state))) (setf match nil))
(when match (push obj results))))
*object-store*)
results))
(defun context-get-active-projects ()
"Retrieves all headlines tagged with 'project' that are not yet complete.
This allows the agent to understand what the user is currently working on."
(let ((projects (context-query-store :tag "project" :type :HEADLINE)))
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
projects)))
(defun context-get-recent-completed-tasks ()
"Retrieves tasks that have been successfully finished.
Used to give the LLM context about the user's 'momentum' and recent wins."
(context-query-store :todo-state "DONE" :type :HEADLINE))
;;; ============================================================================
;;; Introspection API (Self-Awareness)
;;; ============================================================================
;;; These functions allow the agent to see its own internal configuration,
;;; such as its skill priorities and source code. This is critical for
;;; Phase 3 (Self-Editing) and autonomous priority negotiation.
(defun context-list-all-skills ()
"Returns a list of plists for all currently registered skills.
Each plist contains :name, :priority, and :dependencies.
This allows System 1 to understand the current 'Skill Graph'."
(let ((results nil))
(maphash (lambda (name skill)
(declare (ignore name))
(push (list :name (skill-name skill)
:priority (skill-priority skill)
:dependencies (skill-dependencies skill))
results))
*skills-registry*)
(sort results #'> :key (lambda (x) (getf x :priority)))))
(defun context-get-skill-source (skill-name)
"Reads the raw Org-mode source code of a specific skill.
Returns the file content as a string, or NIL if the file is missing."
(let* ((filename (format nil "~a.org" skill-name))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent)))
(full-path (merge-pathnames filename skills-dir)))
(if (uiop:file-exists-p full-path)
(uiop:read-file-string full-path)
nil)))
(defun context-get-system-logs (&optional (limit 20))
"Returns the most recent N lines from the kernel's execution history.
Allows the agent to 'perceive pain' (errors/rejections) and trigger self-repair."
(bt:with-lock-held (*logs-lock*)
(let ((count (min limit (length *system-logs*))))
(subseq *system-logs* 0 count))))
(defun context-get-skill-telemetry (skill-name)
"Returns performance metrics for a specific skill.
Returns a plist with :executions, :total-time, and :failures."
(bt:with-lock-held (*telemetry-lock*)
(gethash (string-downcase skill-name) *skill-telemetry*)))
(defun context-filter-sparse-tree (ast predicate)
"Recursively prunes an Org AST, keeping only nodes that match PREDICATE
and their parent hierarchies. Reduces token waste by removing noise."
(if (listp ast)
(let* ((type (getf ast :type))
(contents (getf ast :contents))
;; Recursively filter children
(filtered-contents
(remove-if #'null
(mapcar (lambda (c) (context-filter-sparse-tree c predicate))
contents))))
(if (or (funcall predicate ast)
(not (null filtered-contents)))
;; If this node matches OR has matching children, keep it
(let ((new-ast (copy-list ast)))
(setf (getf new-ast :contents) filtered-contents)
new-ast)
;; Otherwise, prune this entire branch
nil))
;; If it's a string (leaf content), keep it if the predicate says so,
;; but usually we keep it if the parent headline matches.
nil))
(defun context-resolve-path (path-string)
"Resolves environment variables in a path string (e.g., '$PROJECTS_DIR/my-proj').
This ensures project links remain valid even if base directories are moved."
(if (and (stringp path-string) (uiop:string-prefix-p "$" path-string))
(let* ((parts (uiop:split-string path-string :separator '(#\/)))
(var-name (subseq (car parts) 1)) ; Strip the '$'
(var-val (org-agent::get-env var-name))
(remaining (cl:reduce (lambda (a b) (format nil "~a/~a" a b)) (cdr parts))))
(if var-val
;; Strip any extra quotes that cl-dotenv might have preserved
(let ((clean-val (string-trim '(#\" #\Space) var-val)))
(format nil "~a/~a" (string-right-trim "/" clean-val) remaining))
path-string))
path-string))

49
src/core.lisp
View File

@@ -106,8 +106,9 @@
(defun dispatch-action (action)
"Routes an approved action intent to the correct physical actuator."
(when (and action (not (eq action :rejected)))
(when action
(let* ((payload (getf action :payload))
;; We default to :emacs for backward compatibility.
(target (or (getf action :target) :emacs))
(actuator-fn (gethash target *actuator-registry*)))
(if actuator-fn
@@ -147,9 +148,16 @@
(setf (skill-priority skill) val)
(kernel-log "ACTUATOR [System] - Set priority of ~a to ~a" name val))
(kernel-log "ACTUATOR [System] ERROR - Skill ~a not found" name))))
(:auth-google-code
(let ((code (getf payload :code)))
(kernel-log "ACTUATOR [System] - Received Google OAuth code. Exchanging...")
;; We call the function in the skill package.
;; Note: In a production kernel, we would use a more robust hook system.
(if (uiop:symbol-call :org-agent.skills.org-skill-auth-google-oauth :auth-google-receive-code code)
(kernel-log "ACTUATOR [System] - Google OAuth exchange successful.")
(kernel-log "ACTUATOR [System] - Google OAuth exchange FAILED."))))
(t (kernel-log "ACTUATOR [System] - Unknown command ~a" cmd)))))
;;; ============================================================================
;;; The Cognitive Loop (OODA)
;;; ============================================================================
@@ -178,7 +186,42 @@
(dispatch-action approved-action))))
;;; ================= ===========================================================
(defun perceive (raw-message)
"Updates the Object Store based on incoming stimulus and returns the context."
(let ((type (getf raw-message :type))
(payload (getf raw-message :payload)))
(kernel-log "PERCEIVE: ~a (~a)" type (or (getf payload :sensor) "no-sensor"))
(cond
((eq type :EVENT)
(let ((sensor (getf payload :sensor)))
(case sensor
(:buffer-update
(let ((ast (getf payload :ast)))
(when ast (ingest-ast ast))))
(:point-update
(let ((element (getf payload :element)))
(when element (ingest-ast element))))
;; Ensure we don't return NIL for these
(:user-command t)
(:heartbeat t)
(:chat-message t))))
((eq type :RESPONSE)
(kernel-log "ACT RESULT: ~a" (getf payload :status))))
;; ALWAYS return the raw message as the context base
raw-message))
(defun dispatch-action (action)
"Sends an approved action to the appropriate actuator."
(when (and action (not (eq action :rejected)))
(let ((target (getf action :target)))
(kernel-log "DISPATCH: Target ~a" target)
(let ((actuator (gethash target *actuators*)))
(if actuator
(funcall actuator action)
(kernel-log "ERROR: No actuator registered for ~a" target))))))
;;; ============================================================================
;;; Daemon Lifecycle Management
;;; ============================================================================

34
src/embedding.lisp
View File

@@ -4,32 +4,15 @@
;;; Vector Embedding and Math
;;; ============================================================================
(defvar *embedding-registry* (make-hash-table :test 'equal)
"Registry of embedding provider functions.")
(defvar *embedding-provider* :gemini
"The active embedding provider.")
(defun register-embedding-provider (name fn)
"Registers a function to handle vector embedding requests."
(setf (gethash name *embedding-registry*) fn))
(defun get-embedding (text)
"Fetches the vector embedding for a given text string using the active provider."
(let ((provider-fn (gethash *embedding-provider* *embedding-registry*)))
(if provider-fn
(funcall provider-fn text)
(progn
(kernel-log "EMBEDDING ERROR: No provider registered for ~a" *embedding-provider*)
nil))))
;;; --- Default Provider: Gemini ---
(defun embed-gemini (text)
"Fetches the vector embedding for a given text string from Gemini's embedding-004 model."
(let* ((auth (get-provider-auth :gemini))
(api-key (getf auth :api-key))
(endpoint "https://generativelanguage.googleapis.com/v1beta/models/text-embedding-004:embedContent"))
(unless api-key (return-from embed-gemini nil))
(unless api-key
(return-from get-embedding nil))
(let* ((url (format nil "~a?key=~a" endpoint api-key))
(headers `(("Content-Type" . "application/json")))
(body (cl-json:encode-json-to-string
@@ -38,15 +21,12 @@
(handler-case
(let* ((response (dex:post url :headers headers :content body))
(json (cl-json:decode-json-from-string response)))
;; Path: embedding.values
(cdr (assoc :values (cdr (assoc :embedding json)))))
(error (c)
(kernel-log "EMBEDDING FAILURE [Gemini]: ~a" c)
(kernel-log "EMBEDDING FAILURE: ~a" c)
nil)))))
(register-embedding-provider :gemini #'embed-gemini)
;;; --- Math Utilities ---
(defun dot-product (v1 v2)
(reduce #'+ (mapcar #'* v1 v2)))

18
src/neuro.lisp
View File

@@ -104,10 +104,6 @@
;; Read the LLM string back into a native Lisp data structure.
(suggestion (ignore-errors (read-from-string thought))))
(kernel-log "SYSTEM 1 Suggestion: ~a~%" thought)
;; SOTA: Store the successful prompt/result for future distillation
(when (and suggestion (not (eq suggestion :rejected)))
(setf (getf (gethash (skill-name active-skill) *skill-telemetry*) :last-successful-thought)
(list :prompt prompt :result thought)))
suggestion)
;; If the skill has no neuro-prompt, it's a 'Deterministic Skill' (Symbolic-only).
'(:type :LOG :payload (:text "Skill triggered (Deterministic only)")))))
@@ -128,12 +124,8 @@
(defun distillation-loop ()
"Periodically reviews internal logs and distills prompts for active skills.
This is an autonomous self-improvement cycle."
(maphash (lambda (name telemetry)
(let ((thought (getf telemetry :last-successful-thought)))
(when thought
(kernel-log "NEURO [Evolution] - Distilling prompt for skill '~a'..." name)
(let ((distilled (distill-prompt (getf thought :prompt) (getf thought :result))))
;; In a full Order 2 implementation, we would now surgically update
;; the .org file with the #+DISTILLED_PROMPT: property.
(kernel-log "NEURO [Evolution] - Distilled prompt for ~a: ~a" name distilled)))))
*skill-telemetry*))
(let ((logs (context-get-system-logs 50)))
(dolist (log logs)
(when (search "Verified by skill" log)
;; Extract the skill name and attempt distillation
(kernel-log "NEURO - Triggering prompt distillation cycle...")))))

141
src/object-store.lisp
View File

@@ -42,12 +42,11 @@
(id (or (getf props :ID)
(format nil "temp-~a" (get-universal-time))))
(contents (getf ast :contents))
;; Lazy Embedding: Only embed if the headline has :EMBED: t property
;; Extract raw text for embedding if it's a headline
(raw-content (when (eq type :HEADLINE)
(format nil "~a~%~a"
(getf props :TITLE)
(or (cl:getf ast :raw-content) ""))))
(should-embed (and raw-content (equal (getf props :EMBED) "t")))
(child-ids nil))
;; Depth-first ingestion: Recurse into children first to gather their IDs.
@@ -56,12 +55,13 @@
(push (ingest-ast child id) child-ids)))
;; Create or overwrite the object in the hash table.
;; This is a 'late-binding' update—if the ID exists, we update its state.
(let ((obj (make-org-object
:id id
:type type
:attributes props
:content raw-content
:vector (when should-embed (get-embedding raw-content))
:vector (when raw-content (get-embedding raw-content))
:parent-id parent-id
:children (nreverse child-ids) ; Maintain document order
:version (get-universal-time)
@@ -123,7 +123,140 @@
*object-store*)
results))
;;; ================= ===========================================================
;;; ============================================================================
;;; Context API (System 1 Peripheral Vision)
;;; ============================================================================
;;; These functions provide the 'peripheral vision' for the LLM.
;;; When building a prompt, a skill can call these functions to gather
;;; relevant facts from the Object Store, preventing 'tunnel vision'.
(defun context-query-store (&key tag todo-state type)
"A high-level search engine for the Object Store.
TAG: String to search for in the :TAGS property.
TODO-STATE: The string state (e.g., 'TODO', 'DONE', 'WAITING').
TYPE: The keyword type (e.g., :HEADLINE).
Returns a list of org-object structs that satisfy ALL provided criteria."
(let ((results nil))
(maphash (lambda (id obj)
(declare (ignore id))
(let* ((attrs (org-object-attributes obj))
(obj-type (org-object-type obj))
(tags (getf attrs :TAGS))
(state (getf attrs :TODO-STATE))
(match t))
;; Filter by Type
(when (and type (not (eq obj-type type))) (setf match nil))
;; Filter by Tag (Org tags are often stored as a colon-delimited string like ':work:urgent:')
(when tag
(let ((tags-str (format nil "~a" tags)))
(unless (search tag tags-str :test #'string-equal)
(setf match nil))))
;; Filter by TODO State
(when (and todo-state (not (equal state todo-state))) (setf match nil))
(when match (push obj results))))
*object-store*)
results))
(defun context-get-active-projects ()
"Retrieves all headlines tagged with 'project' that are not yet complete.
This allows the agent to understand what the user is currently working on."
(let ((projects (context-query-store :tag "project" :type :HEADLINE)))
(remove-if (lambda (obj) (equal (getf (org-object-attributes obj) :TODO-STATE) "DONE"))
projects)))
(defun context-get-recent-completed-tasks ()
"Retrieves tasks that have been successfully finished.
Used to give the LLM context about the user's 'momentum' and recent wins."
(context-query-store :todo-state "DONE" :type :HEADLINE))
;;; ============================================================================
;;; Introspection API (Self-Awareness)
;;; ============================================================================
;;; These functions allow the agent to see its own internal configuration,
;;; such as its skill priorities and source code. This is critical for
;;; Phase 3 (Self-Editing) and autonomous priority negotiation.
(defun context-list-all-skills ()
"Returns a list of plists for all currently registered skills.
Each plist contains :name, :priority, and :dependencies.
This allows System 1 to understand the current 'Skill Graph'."
(let ((results nil))
(maphash (lambda (name skill)
(declare (ignore name))
(push (list :name (skill-name skill)
:priority (skill-priority skill)
:dependencies (skill-dependencies skill))
results))
*skills-registry*)
(sort results #'> :key (lambda (x) (getf x :priority)))))
(defun context-get-skill-source (skill-name)
"Reads the raw Org-mode source code of a specific skill.
Returns the file content as a string, or NIL if the file is missing."
(let* ((filename (format nil "~a.org" skill-name))
(skills-dir (merge-pathnames "skills/" (asdf:system-source-directory :org-agent)))
(full-path (merge-pathnames filename skills-dir)))
(if (uiop:file-exists-p full-path)
(uiop:read-file-string full-path)
nil)))
(defun context-get-system-logs (&optional (limit 20))
"Returns the most recent N lines from the kernel's execution history.
Allows the agent to 'perceive pain' (errors/rejections) and trigger self-repair."
(bt:with-lock-held (*logs-lock*)
(let ((count (min limit (length *system-logs*))))
(subseq *system-logs* 0 count))))
(defun context-get-skill-telemetry (skill-name)
"Returns performance metrics for a specific skill.
Returns a plist with :executions, :total-time, and :failures."
(bt:with-lock-held (*telemetry-lock*)
(gethash (string-downcase skill-name) *skill-telemetry*)))
(defun context-filter-sparse-tree (ast predicate)
"Recursively prunes an Org AST, keeping only nodes that match PREDICATE
and their parent hierarchies. Reduces token waste by removing noise."
(if (listp ast)
(let* ((type (getf ast :type))
(contents (getf ast :contents))
;; Recursively filter children
(filtered-contents
(remove-if #'null
(mapcar (lambda (c) (context-filter-sparse-tree c predicate))
contents))))
(if (or (funcall predicate ast)
(not (null filtered-contents)))
;; If this node matches OR has matching children, keep it
(let ((new-ast (copy-list ast)))
(setf (getf new-ast :contents) filtered-contents)
new-ast)
;; Otherwise, prune this entire branch
nil))
;; If it's a string (leaf content), keep it if the predicate says so,
;; but usually we keep it if the parent headline matches.
nil))
(defun context-resolve-path (path-string)
"Resolves environment variables in a path string (e.g., '$PROJECTS_DIR/my-proj').
This ensures project links remain valid even if base directories are moved."
(if (and (stringp path-string) (uiop:string-prefix-p "$" path-string))
(let* ((parts (uiop:split-string path-string :separator '(#\/)))
(var-name (subseq (car parts) 1)) ; Strip the '$'
(var-val (org-agent::get-env var-name))
(remaining (cl:reduce (lambda (a b) (format nil "~a/~a" a b)) (cdr parts))))
(if var-val
;; Strip any extra quotes that cl-dotenv might have preserved
(let ((clean-val (string-trim '(#\" #\Space) var-val)))
(format nil "~a/~a" (string-right-trim "/" clean-val) remaining))
path-string))
path-string))
;;; ============================================================================
;;; AST Helper Functions
;;; ============================================================================