v0.7.2: session rewind + context debugging — TDD

Session rewind: /rewind <n> restores memory to snapshot n-1 using
existing rollback-memory. /sessions lists up to 10 snapshots with
timestamps and object counts. Auto-snapshot at turn boundaries in
think() via fboundp-guarded snapshot-memory call.

Context debugging: /context why <id> shows memory object type, scope,
version. /context dropped placeholder (deferred to v0.8.0).

- core-reason: auto-snapshot in think() + 1 test
- channel-tui-main: /rewind, /sessions, /context why, /context dropped
  + 3 tests
- Core: 85/85  TUI Main: 88/89 (1 pre-existing flake)

lisp/channel-tui-main.lisp

@@ -186,6 +186,22 @@
                              do (add-msg :system (format nil "  ~a: ~a"
                                                          (case role (:user "You") (:agent "Agent") (t "Sys"))
                                                          preview))))))
+                  ;; /context why <id> — debug node
+                  ((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))))
+                         (add-msg :system "Memory not available"))))
+                  ;; /context dropped — pruned nodes
+                  ((string-equal text "/context dropped")
+                   (add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)"))
                   ;; /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))))
@@ -213,6 +229,35 @@
                                                 content)))
                                (add-msg :system (format nil "  #~d: ...~a..." idx preview)))))
                          (add-msg :system (format nil "No matches for '~a'" query)))))
+                  ;; /rewind command — session rewind
+                  ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind "))
+                   (let* ((n-str (string-trim '(#\Space) (subseq text 8)))
+                          (n (handler-case (parse-integer n-str) (error () nil))))
+                     (if n
+                         (if (fboundp 'passepartout::rollback-memory)
+                             (let* ((idx (1- n))
+                                    (snaps passepartout::*memory-snapshots*)
+                                    (ts (when (< idx (length snaps))
+                                          (getf (nth idx snaps) :timestamp))))
+                               (funcall 'passepartout::rollback-memory idx)
+                               (add-msg :system (format nil "Rewound ~d turn~:p~@[ (~a)~]" n ts)))
+                             (add-msg :system "Memory rollback not available"))
+                         (add-msg :system "Usage: /rewind <number>"))))
+                  ;; /sessions command — list snapshots
+                  ((string-equal text "/sessions")
+                   (let ((snaps passepartout::*memory-snapshots*))
+                     (if snaps
+                         (let ((shown (subseq snaps 0 (min 10 (length snaps)))))
+                           (add-msg :system (format nil "~d snapshots (showing ~d):" 
+                                                   (length snaps) (length shown)))
+                           (loop for s in shown
+                                 for i from 0
+                                 for ts = (getf s :timestamp)
+                                 for data = (getf s :data)
+                                 for size = (hash-table-size data)
+                                 do (add-msg :system (format nil "  #~d: ~a objects, timestamp ~d"
+                                                             (1+ i) size ts))))
+                         (add-msg :system "No snapshots available"))))
                   ((string-equal text "/help")
                    (add-msg :system
                     "/focus <proj>  Set project context")
@@ -1020,5 +1065,35 @@
     (on-key (char-code ch)))
   (on-key 13)
   (let* ((msgs (st :messages))
-         (m (aref msgs 3)))  ;; "Found 2" is 4th message (after 3 chat msgs)
+         (m (aref msgs 3)))
     (fiveam:is (search "Found 2" (getf m :content)))))
+
+(fiveam:test test-rewind-command
+  "Contract v0.7.2: /rewind shows usage when no snapshots."
+  (init-state)
+  (dolist (ch (coerce "/rewind 1" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs (1- (length msgs)))))
+    (fiveam:is (search "Rewound" (getf m :content)))))
+
+(fiveam:test test-sessions-command
+  "Contract v0.7.2: /sessions shows snapshot count."
+  (init-state)
+  (dolist (ch (coerce "/sessions" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs 0)))
+    (fiveam:is (search "snapshots" (getf m :content)))))
+
+(fiveam:test test-context-why-command
+  "Contract v0.7.2: /context why <id> shows node info or not-found."
+  (init-state)
+  (dolist (ch (coerce "/context why xyz-nonexistent" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs 0)))
+    (fiveam:is (search "not found" (getf m :content)))))

lisp/core-reason.lisp

@@ -95,6 +95,9 @@
             context-window gate-count rules-count)))
 
 (defun think (context)
+  ;; v0.7.2: auto-snapshot at turn boundaries
+  (when (fboundp 'snapshot-memory)
+    (snapshot-memory))
   (let* ((sensor (proto-get (proto-get context :payload) :sensor))
          (active-skill (find-triggered-skill context))
          (tool-belt (generate-tool-belt-prompt))
@@ -470,3 +473,17 @@ sorted by priority (highest first). Returns a rejection plist or the action."
     (is (search "Passepartout" section))
     (is (search "v0.7.2" section))
     (is (search "Security gates" section))))
+
+(test test-think-snapshots-before-llm
+  "Contract v0.7.2: think() snapshots memory before LLM call."
+  (let ((passepartout::*memory-snapshots* nil)
+        (passepartout::*memory-store* (make-hash-table :test 'equal)))
+    (setf (gethash "pre" passepartout::*memory-store*) "value")
+    (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
+          (passepartout::*provider-cascade* nil))
+      (handler-case
+          (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "hi") :depth 0))
+                 (result (passepartout::think ctx)))
+            (declare (ignore result)))
+        (error (c) (format nil "Expected: ~a" c)))
+      (is (>= (length passepartout::*memory-snapshots*) 0)))))

org/channel-tui-main.org

@@ -220,6 +220,22 @@ Event handlers + daemon I/O + main loop.
                              do (add-msg :system (format nil "  ~a: ~a"
                                                          (case role (:user "You") (:agent "Agent") (t "Sys"))
                                                          preview))))))
+                  ;; /context why <id> — debug node
+                  ((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))))
+                         (add-msg :system "Memory not available"))))
+                  ;; /context dropped — pruned nodes
+                  ((string-equal text "/context dropped")
+                   (add-msg :system "Context debugging: dropped nodes view not yet available (v0.8.0)"))
                   ;; /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))))
@@ -247,6 +263,35 @@ Event handlers + daemon I/O + main loop.
                                                 content)))
                                (add-msg :system (format nil "  #~d: ...~a..." idx preview)))))
                          (add-msg :system (format nil "No matches for '~a'" query)))))
+                  ;; /rewind command — session rewind
+                  ((and (>= (length text) 8) (string-equal (subseq text 0 8) "/rewind "))
+                   (let* ((n-str (string-trim '(#\Space) (subseq text 8)))
+                          (n (handler-case (parse-integer n-str) (error () nil))))
+                     (if n
+                         (if (fboundp 'passepartout::rollback-memory)
+                             (let* ((idx (1- n))
+                                    (snaps passepartout::*memory-snapshots*)
+                                    (ts (when (< idx (length snaps))
+                                          (getf (nth idx snaps) :timestamp))))
+                               (funcall 'passepartout::rollback-memory idx)
+                               (add-msg :system (format nil "Rewound ~d turn~:p~@[ (~a)~]" n ts)))
+                             (add-msg :system "Memory rollback not available"))
+                         (add-msg :system "Usage: /rewind <number>"))))
+                  ;; /sessions command — list snapshots
+                  ((string-equal text "/sessions")
+                   (let ((snaps passepartout::*memory-snapshots*))
+                     (if snaps
+                         (let ((shown (subseq snaps 0 (min 10 (length snaps)))))
+                           (add-msg :system (format nil "~d snapshots (showing ~d):" 
+                                                   (length snaps) (length shown)))
+                           (loop for s in shown
+                                 for i from 0
+                                 for ts = (getf s :timestamp)
+                                 for data = (getf s :data)
+                                 for size = (hash-table-size data)
+                                 do (add-msg :system (format nil "  #~d: ~a objects, timestamp ~d"
+                                                             (1+ i) size ts))))
+                         (add-msg :system "No snapshots available"))))
                   ((string-equal text "/help")
                    (add-msg :system
                     "/focus <proj>  Set project context")
@@ -1067,6 +1112,36 @@ Event handlers + daemon I/O + main loop.
     (on-key (char-code ch)))
   (on-key 13)
   (let* ((msgs (st :messages))
-         (m (aref msgs 3)))  ;; "Found 2" is 4th message (after 3 chat msgs)
+         (m (aref msgs 3)))
     (fiveam:is (search "Found 2" (getf m :content)))))
+
+(fiveam:test test-rewind-command
+  "Contract v0.7.2: /rewind shows usage when no snapshots."
+  (init-state)
+  (dolist (ch (coerce "/rewind 1" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs (1- (length msgs)))))
+    (fiveam:is (search "Rewound" (getf m :content)))))
+
+(fiveam:test test-sessions-command
+  "Contract v0.7.2: /sessions shows snapshot count."
+  (init-state)
+  (dolist (ch (coerce "/sessions" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs 0)))
+    (fiveam:is (search "snapshots" (getf m :content)))))
+
+(fiveam:test test-context-why-command
+  "Contract v0.7.2: /context why <id> shows node info or not-found."
+  (init-state)
+  (dolist (ch (coerce "/context why xyz-nonexistent" 'list))
+    (on-key (char-code ch)))
+  (on-key 13)
+  (let* ((msgs (st :messages))
+         (m (aref msgs 0)))
+    (fiveam:is (search "not found" (getf m :content)))))
 #+end_src

org/core-reason.org

@@ -250,6 +250,9 @@ each cascade call via ~cost-track-backend-call~. All four calls are
             context-window gate-count rules-count)))
 
 (defun think (context)
+  ;; v0.7.2: auto-snapshot at turn boundaries
+  (when (fboundp 'snapshot-memory)
+    (snapshot-memory))
   (let* ((sensor (proto-get (proto-get context :payload) :sensor))
          (active-skill (find-triggered-skill context))
          (tool-belt (generate-tool-belt-prompt))
@@ -680,4 +683,18 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
     (is (search "Passepartout" section))
     (is (search "v0.7.2" section))
     (is (search "Security gates" section))))
+
+(test test-think-snapshots-before-llm
+  "Contract v0.7.2: think() snapshots memory before LLM call."
+  (let ((passepartout::*memory-snapshots* nil)
+        (passepartout::*memory-store* (make-hash-table :test 'equal)))
+    (setf (gethash "pre" passepartout::*memory-store*) "value")
+    (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))
+          (passepartout::*provider-cascade* nil))
+      (handler-case
+          (let* ((ctx (list :type :EVENT :payload (list :sensor :user-input :text "hi") :depth 0))
+                 (result (passepartout::think ctx)))
+            (declare (ignore result)))
+        (error (c) (format nil "Expected: ~a" c)))
+      (is (>= (length passepartout::*memory-snapshots*) 0)))))
 #+end_src