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

v0.7.2: context debugging — /context why + /context dropped — TDD

Browse Source 
/context why <id> 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
This commit is contained in:
Amr Gharbeia
2026-05-08 21:26:45 -04:00
parent da5718b97c
commit f7b3e20a15
2 changed files with 62 additions and 18 deletions
Download Patch File Download Diff File Expand all files Collapse all files

40
lisp/channel-tui-main.lisp
View File

@@ -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 <id> — debug node
;; /context why <id> — 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))))