v0.7.2: undo/redo — TDD

Operation-level memory undo/redo built on existing Merkle snapshot
infrastructure. undo-snapshot captures state before destructive tool
execution. /undo and /redo TUI commands send structured events.

- core-memory: undo-snapshot, undo, redo functions + 3 tests
- core-perceive: :undo/:redo sensor handlers
- core-act: auto-snapshot before non-read-only tools
- core-package: undo/redo symbol exports
- channel-tui-main: /undo, /redo commands + 2 tests
- Core: 73/73  TUI Main: 74/74

lisp/channel-tui-main.lisp

@@ -97,7 +97,14 @@
                 (setf (st :input-hpos) 0)
                 (setf (st :scroll-offset) 0)
                 (cond
-                  ;; v0.7.2: HITL inline — structured approval/denial
+                  ;; v0.7.2: undo/redo
+                  ((string-equal text "/undo")
+                   (send-daemon (list :type :event :payload (list :sensor :undo)))
+                   (add-msg :system "Undo: restoring memory to previous state"))
+                  ((string-equal text "/redo")
+                   (send-daemon (list :type :event :payload (list :sensor :redo)))
+                   (add-msg :system "Redo: restoring memory"))
+                  ;; /help command
                   ((and (>= (length text) 9)
                         (string-equal (subseq text 0 9) "/approve "))
                    (let ((token (string-trim '(#\Space) (subseq text 9))))
@@ -797,3 +804,25 @@
   (let ((m (aref (st :messages) 0)))
     (fiveam:is (eq :system (getf m :role)))
     (fiveam:is (search "Denied" (getf m :content)))))
+
+;; ── v0.7.2 Undo/Redo ──
+
+(fiveam:test test-undo-command
+  "Contract v0.7.2: /undo sends undo event."
+  (init-state)
+  (dolist (ch (coerce "/undo" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((m (aref (st :messages) 0)))
+    (fiveam:is (eq :system (getf m :role)))
+    (fiveam:is (search "Undo" (getf m :content)))))
+
+(fiveam:test test-redo-command
+  "Contract v0.7.2: /redo sends redo event."
+  (init-state)
+  (dolist (ch (coerce "/redo" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((m (aref (st :messages) 0)))
+    (fiveam:is (eq :system (getf m :role)))
+    (fiveam:is (search "Redo" (getf m :content)))))

lisp/core-act.lisp

@@ -81,6 +81,9 @@
          (meta (getf context :meta))
          (source (getf meta :source))
          (tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
+    ;; v0.7.2: snapshot before destructive tool execution
+    (when (and tool (not (cognitive-tool-read-only-p tool)))
+      (undo-snapshot))
     (if tool
         (handler-case
             (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))

lisp/core-memory.lisp

@@ -151,6 +151,50 @@
           (error (c) (log-message "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
   t)
 
+;; v0.7.2 — Undo/Redo
+(defvar *undo-stack* nil
+  "Ring buffer of pre-operation memory snapshots. Newest first, max 20.")
+(defvar *redo-stack* nil
+  "Stack of snapshots saved during undo for redo. Max 20.")
+
+(defun undo-snapshot ()
+  "Save current memory state to the undo stack."
+  (let ((snap (list :timestamp (get-universal-time)
+                    :data (memory-hash-table-copy *memory-store*))))
+    (push snap *undo-stack*)
+    (when (> (length *undo-stack*) 20)
+      (setf *undo-stack* (subseq *undo-stack* 0 20)))))
+
+(defun undo (&optional source)
+  "Restore memory to the most recent undo snapshot. Returns T on success, NIL if stack empty."
+  (declare (ignore source))
+  (if *undo-stack*
+      (let ((snap (pop *undo-stack*)))
+        (push (list :timestamp (get-universal-time)
+                    :data (memory-hash-table-copy *memory-store*))
+              *redo-stack*)
+        (when (> (length *redo-stack*) 20)
+          (setf *redo-stack* (subseq *redo-stack* 0 20)))
+        (setf *memory-store* (memory-hash-table-copy (getf snap :data)))
+        (log-message "UNDO: Memory restored to snapshot ~a" (getf snap :timestamp))
+        t)
+      (progn (log-message "UNDO: No snapshots to undo") nil)))
+
+(defun redo (&optional source)
+  "Restore memory to the most recent redo snapshot. Returns T on success, NIL if stack empty."
+  (declare (ignore source))
+  (if *redo-stack*
+      (let ((snap (pop *redo-stack*)))
+        (push (list :timestamp (get-universal-time)
+                    :data (memory-hash-table-copy *memory-store*))
+              *undo-stack*)
+        (when (> (length *undo-stack*) 20)
+          (setf *undo-stack* (subseq *undo-stack* 0 20)))
+        (setf *memory-store* (memory-hash-table-copy (getf snap :data)))
+        (log-message "REDO: Memory restored to snapshot ~a" (getf snap :timestamp))
+        t)
+      (progn (log-message "REDO: No snapshots to redo") nil)))
+
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (ql:quickload :fiveam :silent t))
 
@@ -211,3 +255,50 @@
   (rollback-memory 0)
   (is (not (null (memory-object-get "snap-a"))))
   (is (null (memory-object-get "snap-b"))))
+
+(test test-undo-snapshot-restore
+  "Contract v0.7.2: undo-snapshot captures state, undo restores."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "x" passepartout::*memory-store*) "hello")
+           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
+           (is (passepartout::undo))
+           (is (null (gethash "x" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-redo-cycle
+  "Contract v0.7.2: redo restores undone state."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "y" passepartout::*memory-store*) "world")
+           (is (passepartout::undo))
+           (is (null (gethash "y" passepartout::*memory-store*)))
+           (is (passepartout::redo))
+           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-empty-stack-nil
+  "Contract v0.7.2: undo returns nil on empty stack."
+  (let ((orig-undo passepartout::*undo-stack*))
+    (unwind-protect
+         (progn (setf passepartout::*undo-stack* nil)
+                (is (null (passepartout::undo))))
+      (setf passepartout::*undo-stack* orig-undo))))

lisp/core-package.lisp

@@ -37,6 +37,11 @@
    #:memory-object-scope
    #:snapshot-memory
    #:rollback-memory
+   #:undo-snapshot
+   #:undo
+   #:redo
+   #:*undo-stack*
+   #:*redo-stack*
     #:context-get-system-logs
     #:context-assemble-global-awareness
     #:context-awareness-assemble

lisp/core-perceive.lisp

@@ -89,8 +89,15 @@ FN receives (signal) and returns T if consumed, nil to continue."
                    (snapshot-memory)
                    (setf *loop-focus-id* (getf element :id))
                    (ingest-ast element :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
-              (:interrupt
+               (:interrupt
-               (setf *loop-interrupt* t))
+                (setf *loop-interrupt* t))
+               ;; v0.7.2 undo/redo
+               (:undo
+                (log-message "GATE [Perceive]: undo requested")
+                (undo "perceive"))
+               (:redo
+                (log-message "GATE [Perceive]: redo requested")
+                (redo "perceive"))
               ;; HITL: re-injected approved action from dispatcher-approvals-process
               (:approval-required
                (when (getf payload :approved)

org/channel-tui-main.org

@@ -131,7 +131,14 @@ Event handlers + daemon I/O + main loop.
                 (setf (st :input-hpos) 0)
                 (setf (st :scroll-offset) 0)
                 (cond
-                  ;; v0.7.2: HITL inline — structured approval/denial
+                  ;; v0.7.2: undo/redo
+                  ((string-equal text "/undo")
+                   (send-daemon (list :type :event :payload (list :sensor :undo)))
+                   (add-msg :system "Undo: restoring memory to previous state"))
+                  ((string-equal text "/redo")
+                   (send-daemon (list :type :event :payload (list :sensor :redo)))
+                   (add-msg :system "Redo: restoring memory"))
+                  ;; /help command
                   ((and (>= (length text) 9)
                         (string-equal (subseq text 0 9) "/approve "))
                    (let ((token (string-trim '(#\Space) (subseq text 9))))
@@ -844,4 +851,26 @@ Event handlers + daemon I/O + main loop.
   (let ((m (aref (st :messages) 0)))
     (fiveam:is (eq :system (getf m :role)))
     (fiveam:is (search "Denied" (getf m :content)))))
+
+;; ── v0.7.2 Undo/Redo ──
+
+(fiveam:test test-undo-command
+  "Contract v0.7.2: /undo sends undo event."
+  (init-state)
+  (dolist (ch (coerce "/undo" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((m (aref (st :messages) 0)))
+    (fiveam:is (eq :system (getf m :role)))
+    (fiveam:is (search "Undo" (getf m :content)))))
+
+(fiveam:test test-redo-command
+  "Contract v0.7.2: /redo sends redo event."
+  (init-state)
+  (dolist (ch (coerce "/redo" 'list))
+    (on-key (char-code ch)))
+  (on-key 343)
+  (let ((m (aref (st :messages) 0)))
+    (fiveam:is (eq :system (getf m :role)))
+    (fiveam:is (search "Redo" (getf m :content)))))
 #+end_src

org/core-act.org

@@ -180,6 +180,9 @@ The tool's return value is packed into a ~:tool-output~ event and fed back into
          (meta (getf context :meta))
          (source (getf meta :source))
          (tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
+    ;; v0.7.2: snapshot before destructive tool execution
+    (when (and tool (not (cognitive-tool-read-only-p tool)))
+      (undo-snapshot))
     (if tool
         (handler-case
             (let* ((clean-args (if (and (listp tool-args) (listp (car tool-args))) (car tool-args) tool-args))

org/core-memory.org

@@ -359,6 +359,50 @@ Restores memory state from a previously saved snapshot file. Called during boot
                   (log-message "MEMORY - Loaded from ~a (~a objects)" path (hash-table-size *memory-store*))))))
           (error (c) (log-message "MEMORY WARNING - Failed to load snapshot: ~a" c)))))
   t)
+
+;; v0.7.2 — Undo/Redo
+(defvar *undo-stack* nil
+  "Ring buffer of pre-operation memory snapshots. Newest first, max 20.")
+(defvar *redo-stack* nil
+  "Stack of snapshots saved during undo for redo. Max 20.")
+
+(defun undo-snapshot ()
+  "Save current memory state to the undo stack."
+  (let ((snap (list :timestamp (get-universal-time)
+                    :data (memory-hash-table-copy *memory-store*))))
+    (push snap *undo-stack*)
+    (when (> (length *undo-stack*) 20)
+      (setf *undo-stack* (subseq *undo-stack* 0 20)))))
+
+(defun undo (&optional source)
+  "Restore memory to the most recent undo snapshot. Returns T on success, NIL if stack empty."
+  (declare (ignore source))
+  (if *undo-stack*
+      (let ((snap (pop *undo-stack*)))
+        (push (list :timestamp (get-universal-time)
+                    :data (memory-hash-table-copy *memory-store*))
+              *redo-stack*)
+        (when (> (length *redo-stack*) 20)
+          (setf *redo-stack* (subseq *redo-stack* 0 20)))
+        (setf *memory-store* (memory-hash-table-copy (getf snap :data)))
+        (log-message "UNDO: Memory restored to snapshot ~a" (getf snap :timestamp))
+        t)
+      (progn (log-message "UNDO: No snapshots to undo") nil)))
+
+(defun redo (&optional source)
+  "Restore memory to the most recent redo snapshot. Returns T on success, NIL if stack empty."
+  (declare (ignore source))
+  (if *redo-stack*
+      (let ((snap (pop *redo-stack*)))
+        (push (list :timestamp (get-universal-time)
+                    :data (memory-hash-table-copy *memory-store*))
+              *undo-stack*)
+        (when (> (length *undo-stack*) 20)
+          (setf *undo-stack* (subseq *undo-stack* 0 20)))
+        (setf *memory-store* (memory-hash-table-copy (getf snap :data)))
+        (log-message "REDO: Memory restored to snapshot ~a" (getf snap :timestamp))
+        t)
+      (progn (log-message "REDO: No snapshots to redo") nil)))
 #+end_src
 
 * Test Suite
@@ -424,4 +468,51 @@ Verifies that the Merkle hash is deterministic and consistent across independent
   (rollback-memory 0)
   (is (not (null (memory-object-get "snap-a"))))
   (is (null (memory-object-get "snap-b"))))
+
+(test test-undo-snapshot-restore
+  "Contract v0.7.2: undo-snapshot captures state, undo restores."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "x" passepartout::*memory-store*) "hello")
+           (is (string= "hello" (gethash "x" passepartout::*memory-store*)))
+           (is (passepartout::undo))
+           (is (null (gethash "x" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-redo-cycle
+  "Contract v0.7.2: redo restores undone state."
+  (let ((orig-store passepartout::*memory-store*)
+        (orig-undo passepartout::*undo-stack*)
+        (orig-redo passepartout::*redo-stack*))
+    (unwind-protect
+         (progn
+           (setf passepartout::*memory-store* (make-hash-table :test 'equal)
+                 passepartout::*undo-stack* nil
+                 passepartout::*redo-stack* nil)
+           (passepartout::undo-snapshot)
+           (setf (gethash "y" passepartout::*memory-store*) "world")
+           (is (passepartout::undo))
+           (is (null (gethash "y" passepartout::*memory-store*)))
+           (is (passepartout::redo))
+           (is (string= "world" (gethash "y" passepartout::*memory-store*))))
+      (setf passepartout::*memory-store* orig-store
+            passepartout::*undo-stack* orig-undo
+            passepartout::*redo-stack* orig-redo))))
+
+(test test-undo-empty-stack-nil
+  "Contract v0.7.2: undo returns nil on empty stack."
+  (let ((orig-undo passepartout::*undo-stack*))
+    (unwind-protect
+         (progn (setf passepartout::*undo-stack* nil)
+                (is (null (passepartout::undo))))
+      (setf passepartout::*undo-stack* orig-undo))))
 #+end_src

org/core-package.org

@@ -62,6 +62,11 @@ The package definition. All public symbols are exported here.
    #:memory-object-scope
    #:snapshot-memory
    #:rollback-memory
+   #:undo-snapshot
+   #:undo
+   #:redo
+   #:*undo-stack*
+   #:*redo-stack*
     #:context-get-system-logs
     #:context-assemble-global-awareness
     #:context-awareness-assemble

org/core-perceive.org

@@ -214,8 +214,15 @@ The main perceive pipeline stage.
                    (snapshot-memory)
                    (setf *loop-focus-id* (getf element :id))
                    (ingest-ast element :scope (if *scope-resolver* (funcall *scope-resolver*) :memex)))))
-              (:interrupt
+               (:interrupt
-               (setf *loop-interrupt* t))
+                (setf *loop-interrupt* t))
+               ;; v0.7.2 undo/redo
+               (:undo
+                (log-message "GATE [Perceive]: undo requested")
+                (undo "perceive"))
+               (:redo
+                (log-message "GATE [Perceive]: redo requested")
+                (redo "perceive"))
               ;; HITL: re-injected approved action from dispatcher-approvals-process
               (:approval-required
                (when (getf payload :approved)