Advertisement
Guest User

Untitled

a guest
May 16th, 2019
125
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 2.57 KB | None | 0 0
  1. (defmacro define-resetable-variable (name value)
  2. `(defparameter ,name (setf (get ',name 'initial-value) ,value)))
  3.  
  4. (defun reset-variable (name)
  5. (let* ((absent (cons name name))
  6. (initval (get name 'initial-value absent)))
  7. (if (eql absent initval)
  8. (error "The variable ~S doesn't have a initial value defined." name)
  9. (setf (symbol-value name) initval))))
  10.  
  11. (defmacro let-resettable-variables ((&rest bindings) &body body)
  12. (multiple-value-bind (docstrings declarations body) (parse-body :locally body)
  13. (let* ((vars (mapcar (lambda (binding) (if (listp binding) (first binding) binding)) bindings))
  14. (vals (mapcar (lambda (binding) (if (listp binding) (second binding) nil)) bindings))
  15. (initvars (mapcar (lambda (var) (gensym (symbol-name var))) vars)))
  16. `(let ,(mapcar (function list) initvars vals)
  17. (let ,(mapcar (function list) vars initvars)
  18. ,@declarations
  19. (flet ((reset-variable (name)
  20. (case name
  21. ,@(mapcar (lambda (var initvar) `((,var) (setf ,var ,initvar))) vars initvars)
  22. (otherwise (reset-variable name)))))
  23. ,@body))))))
  24.  
  25. (define-resetable-variable *foo* 42)
  26. (assert (eql *foo* 42))
  27. (setf *foo* 33)
  28. (assert (eql *foo* 33))
  29. (reset-variable '*foo*)
  30. (assert (eql *foo* 42))
  31. (define-resetable-variable *bar* 24)
  32. (let-resettable-variables ((*bar* 33)
  33. (x 1)
  34. (y 2))
  35. (declare (integer x y))
  36. (let ((z 3))
  37. (assert (eql *foo* 42))
  38. (assert (eql *bar* 33))
  39. (assert (eql x 1))
  40. (assert (eql y 2))
  41. (setf *foo* 0
  42. *bar* 1
  43. x 2)
  44. (assert (eql *foo* 0))
  45. (assert (eql *bar* 1))
  46. (assert (eql x 2))
  47. (assert (eql y 2))
  48. (reset-variable '*foo*)
  49. (assert (eql *foo* 42))
  50. (assert (eql *bar* 1))
  51. (assert (eql x 2))
  52. (assert (eql y 2))
  53. (reset-variable '*bar*)
  54. (assert (eql *foo* 42))
  55. (assert (eql *bar* 33))
  56. (assert (eql x 2))
  57. (assert (eql y 2))
  58. (reset-variable 'x)
  59. (assert (eql *foo* 42))
  60. (assert (eql *bar* 33))
  61. (assert (eql x 1))
  62. (assert (eql y 2))
  63. (reset-variable 'y)
  64. (assert (eql *foo* 42))
  65. (assert (eql *bar* 33))
  66. (assert (eql x 1))
  67. (assert (eql y 2))
  68. (assert (handler-case (progn (reset-variable 'z) nil)
  69. (error () t)))
  70. (assert (handler-case (progn (reset-variable ':not-a-variable-at-all) nil)
  71. (error () t)))))
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement