X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-extensions.lisp;h=1918c8705a93bfa5e44394e5cb1858c17b3559cc;hb=a01e7ac2e8a9f3afae8f759381a0829fceb5bfde;hp=f6c5f25aed6233787d28f4714510ee50e7cbf27b;hpb=77d46c398278c0bbe221722c21c01d47713cd878;p=sbcl.git

diff --git a/src/code/late-extensions.lisp b/src/code/late-extensions.lisp
index f6c5f25..1918c87 100644
--- a/src/code/late-extensions.lisp
+++ b/src/code/late-extensions.lisp
@@ -140,3 +140,13 @@ EXPERIMENTAL: Interface subject to change."
   (def %compare-and-swap-symbol-plist (symbol) symbol-plist)
   (def %compare-and-swap-symbol-value (symbol) symbol-value)
   (def %compare-and-swap-svref (vector index) svref))
+
+(defun call-hooks (kind hooks &key (on-error :error))
+  (dolist (hook hooks)
+    (handler-case
+        (funcall hook)
+      (serious-condition (c)
+        (if (eq :warn on-error)
+            (warn "Problem running ~A hook ~S:~%  ~A" kind hook c)
+            (with-simple-restart (continue "Skip this ~A hook." kind)
+              (error "Problem running ~A hook ~S:~%  ~A" kind hook c)))))))