From f7b3e20a154f2cb7366214f32ab6b32528894807 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Fri, 8 May 2026 21:26:45 -0400 Subject: [PATCH] =?UTF-8?q?v0.7.2:=20context=20debugging=20=E2=80=94=20/co?= =?UTF-8?q?ntext=20why=20+=20/context=20dropped=20=E2=80=94=20TDD?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit /context why now shows full memory object details: parent, children count, hash prefix, title from attributes. /context dropped replaced literal stub with computed estimate of pruned messages based on token budget (msg_count * 60 vs 8192). - channel-tui-main: enhanced both debug handlers - TUI Main: 102/102 --- lisp/channel-tui-main.lisp | 40 +++++++++++++++++++++++++++++--------- org/channel-tui-main.org | 40 +++++++++++++++++++++++++++++--------- 2 files changed, 62 insertions(+), 18 deletions(-) diff --git a/lisp/channel-tui-main.lisp b/lisp/channel-tui-main.lisp index 92c0328..bd79c17 100644 --- a/lisp/channel-tui-main.lisp +++ b/lisp/channel-tui-main.lisp @@ -253,22 +253,44 @@ bar (make-string (- 10 (length bar)) :initial-element #\Space) pct-used)) (when (> pct-used 80) (add-msg :system "⚠ Context near limit — older messages may be dropped")))) - ;; /context why — debug node + ;; /context why — debug node with full attributes ((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why ")) (let ((node-id (string-trim '(#\Space) (subseq text 13)))) (if (fboundp 'passepartout::memory-object-get) (let ((obj (funcall 'passepartout::memory-object-get node-id))) (if obj - (add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a" - node-id - (passepartout::memory-object-type obj) - (passepartout::memory-object-scope obj) - (passepartout::memory-object-version obj))) - (add-msg :system (format nil "Node ~a not found" node-id)))) + (let ((attrs (passepartout::memory-object-attributes obj)) + (parent (passepartout::memory-object-parent-id obj)) + (children (passepartout::memory-object-children obj)) + (hash (or (passepartout::memory-object-hash obj) "(none)"))) + (add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a" + node-id + (passepartout::memory-object-type obj) + (passepartout::memory-object-scope obj) + (passepartout::memory-object-version obj))) + (when parent + (add-msg :system (format nil " parent: ~a" parent))) + (when children + (add-msg :system (format nil " children: ~d" (length children)))) + (add-msg :system (format nil " hash: ~a" (subseq hash 0 (min 32 (length hash))))) + (when attrs + (add-msg :system (format nil " title: ~a" (or (getf attrs :TITLE) "(none)"))))) + (add-msg :system (format nil "Node ~a not found in memory" node-id)))) (add-msg :system "Memory not available")))) - ;; /context dropped — pruned nodes + ;; /context dropped — estimate pruned nodes from budget ((string-equal text "/context dropped") - (add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)")) + (let* ((msg-count (length (st :messages))) + (est-total (* msg-count 60)) + (budget 8192) + (dropped-msgs (if (> est-total budget) + (floor (- est-total budget) 60) + 0))) + (if (> dropped-msgs 0) + (add-msg :system (format nil "Estimate: ~d messages (~d tokens) may be pruned at budget ~d tokens (~d% used)" + dropped-msgs (- est-total budget) budget + (floor (* 100 est-total) budget))) + (add-msg :system (format nil "Within budget: ~d tokens used of ~d tokens (~d%)" + est-total budget (floor (* 100 est-total) budget)))))) ;; /search command — message search ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search ")) (let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8)))) diff --git a/org/channel-tui-main.org b/org/channel-tui-main.org index a456c98..8647af6 100644 --- a/org/channel-tui-main.org +++ b/org/channel-tui-main.org @@ -287,22 +287,44 @@ Event handlers + daemon I/O + main loop. bar (make-string (- 10 (length bar)) :initial-element #\Space) pct-used)) (when (> pct-used 80) (add-msg :system "⚠ Context near limit — older messages may be dropped")))) - ;; /context why — debug node + ;; /context why — debug node with full attributes ((and (>= (length text) 13) (string-equal (subseq text 0 13) "/context why ")) (let ((node-id (string-trim '(#\Space) (subseq text 13)))) (if (fboundp 'passepartout::memory-object-get) (let ((obj (funcall 'passepartout::memory-object-get node-id))) (if obj - (add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a" - node-id - (passepartout::memory-object-type obj) - (passepartout::memory-object-scope obj) - (passepartout::memory-object-version obj))) - (add-msg :system (format nil "Node ~a not found" node-id)))) + (let ((attrs (passepartout::memory-object-attributes obj)) + (parent (passepartout::memory-object-parent-id obj)) + (children (passepartout::memory-object-children obj)) + (hash (or (passepartout::memory-object-hash obj) "(none)"))) + (add-msg :system (format nil "Node ~a: type=~a scope=~a version=~a" + node-id + (passepartout::memory-object-type obj) + (passepartout::memory-object-scope obj) + (passepartout::memory-object-version obj))) + (when parent + (add-msg :system (format nil " parent: ~a" parent))) + (when children + (add-msg :system (format nil " children: ~d" (length children)))) + (add-msg :system (format nil " hash: ~a" (subseq hash 0 (min 32 (length hash))))) + (when attrs + (add-msg :system (format nil " title: ~a" (or (getf attrs :TITLE) "(none)"))))) + (add-msg :system (format nil "Node ~a not found in memory" node-id)))) (add-msg :system "Memory not available")))) - ;; /context dropped — pruned nodes + ;; /context dropped — estimate pruned nodes from budget ((string-equal text "/context dropped") - (add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)")) + (let* ((msg-count (length (st :messages))) + (est-total (* msg-count 60)) + (budget 8192) + (dropped-msgs (if (> est-total budget) + (floor (- est-total budget) 60) + 0))) + (if (> dropped-msgs 0) + (add-msg :system (format nil "Estimate: ~d messages (~d tokens) may be pruned at budget ~d tokens (~d% used)" + dropped-msgs (- est-total budget) budget + (floor (* 100 est-total) budget))) + (add-msg :system (format nil "Within budget: ~d tokens used of ~d tokens (~d%)" + est-total budget (floor (* 100 est-total) budget)))))) ;; /search command — message search ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/search ")) (let* ((query (string-downcase (string-trim '(#\Space) (subseq text 8))))