selfmod/rollback.lisp

(in-package #:nekod.selfmod)

;; Rollback: multi-level undo for the live Nekomata process
;;
;; Three rollback planes:
;;   1. Function level  -- hot-swap log (hot-swap.lisp)
;;   2. State level     -- snapshot store (state-capture.lisp)
;;   3. Generation level -- evolutionary generation counter
;;
;; Rollback is not a recovery mechanism. It is a time-travel mechanism.

;; ---- Rollback context -------------------------------------------------------

(defstruct rollback-point
  id
  label         ; human-readable tag
  snapshot-id   ; corresponding state-snapshot id
  hot-swap-depth ; length of *hot-swap-log* at this point
  generation     ; *generation* value
  timestamp
  )

(defvar *rollback-stack* nil
  "Stack of rollback-points. Push before risky operations. Pop to undo.")

(defun push-rollback-point (label)
  "Mark the current state as a named rollback point.
   Returns the rollback point ID."
  (let ((snap-id (capture-state (list :label label))))
    (let ((rp (make-rollback-point
               :id snap-id
               :label label
               :snapshot-id snap-id
               :hot-swap-depth (length *hot-swap-log*)
               :generation *generation*
               :timestamp (get-universal-time))))
      (push rp *rollback-stack*)
      (format t "~&[rollback] Checkpoint: ~a (snap ~a)~%" label snap-id)
      (rollback-point-id rp))))

(defun rollback-to (label)
  "Roll back to the most recent rollback point with LABEL.
   Restores: state snapshot, hot-swap log depth, generation counter."
  (let ((rp (find label *rollback-stack* :key #'rollback-point-label :test #'string=)))
    (unless rp
      (error "rollback-to: no rollback point labeled ~s" label))
    ;; Restore state snapshot
    (restore-state (rollback-point-snapshot-id rp))
    ;; Truncate hot-swap log to captured depth
    (let ((target-depth (rollback-point-hot-swap-depth rp)))
      (when (> (length *hot-swap-log*) target-depth)
        ;; Roll back each extra swap in reverse
        (let ((extra-swaps (subseq *hot-swap-log* 0
                                   (- (length *hot-swap-log*) target-depth))))
          (dolist (entry (reverse extra-swaps))
            (let ((fn-name (second entry))
                  (old-fn  (getf entry :had)))
              (if old-fn
                  (setf (symbol-function fn-name) old-fn)
                  (when (fboundp fn-name) (fmakunbound fn-name)))))
          (setf *hot-swap-log*
                (subseq *hot-swap-log* (- (length *hot-swap-log*) target-depth))))))
    (format t "~&[rollback] Restored to ~s (gen ~a)~%"
            label (rollback-point-generation rp))
    rp))

(defun rollback-last ()
  "Roll back to the most recently pushed rollback point."
  (if *rollback-stack*
      (rollback-to (rollback-point-label (first *rollback-stack*)))
      (format t "~&[rollback] Nothing to roll back.~%")))

(defun list-rollback-points ()
  "List all available rollback points."
  (mapcar (lambda (rp)
            (list :label      (rollback-point-label rp)
                  :generation (rollback-point-generation rp)
                  :timestamp  (rollback-point-timestamp rp)))
          *rollback-stack*))

;; ---- Safe execution wrapper -------------------------------------------------

(defmacro with-rollback ((label) &body body)
  "Execute BODY with an automatic rollback point.
   If BODY signals an error, the rollback point is automatically restored."
  `(let ((rp-id (push-rollback-point ,label)))
     (handler-case
         (prog1 (progn ,@body)
           (format t "~&[rollback] ~a succeeded.~%" ,label))
       (error (e)
         (format t "~&[rollback] ~a failed (~a), rolling back...~%" ,label e)
         (rollback-to ,label)
         (error e)))))