File size: 3,833 Bytes
3b70664 | 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 | (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)))))
|