Make hook functions generic.

Per #41.

hooks.lisp

@@ -2,64 +2,57 @@
 
 (defvar *hook* nil
   "The hook currently being run.")
-(declaim (type symbol *hook*))
 
-(declaim (ftype (function (symbol (or function symbol) &key (:append t))
-                          t)
-                add-hook))
-(defun add-hook (name fn &key append)
-  "Add FN to the value of NAME, a hook."
-  (declare (type (or function symbol) fn))
-  (if (not append)
-      (pushnew fn (symbol-value name))
-      (unless (member fn (symbol-value name))
-        (appendf (symbol-value name) (list fn)))))
-
-(declaim (ftype (function (symbol (or function symbol))
-                          t)
-                remove-hook))
-(defun remove-hook (name fn)
-  "Remove fn from the symbol value of NAME."
-  (removef (symbol-value name) fn))
+(defgeneric add-hook (hook fn &key append)
+  (:documentation "Add FN to the value of HOOK.")
+  (:method ((hook symbol) fn &key append)
+    (declare (type (or function symbol) fn))
+    (synchronized (hook)
+      (if (not append)
+          (pushnew fn (symbol-value hook))
+          (unless (member fn (symbol-value hook))
+            (appendf (symbol-value hook) (list fn)))))))
+
+(defgeneric remove-hook (hook fn)
+  (:documentation "Remove FN from the symbol value of HOOK.")
+  (:method ((hook symbol) fn)
+    (synchronized (hook)
+      (removef (symbol-value hook) fn))))
 
 (defmacro with-hook-restart (&body body)
   `(with-simple-restart (continue "Call next function in hook ~s" *hook*)
      ,@body))
 
-(declaim (ftype (function (&rest symbol)
-                          null)
-                run-hooks))
-(defun run-hooks (&rest hookvars)
-  "Run all the hooks in all the HOOKVARS.
+(defun run-hooks (&rest hooks)
+  "Run all the hooks in HOOKS.
 The variable `*hook*' is bound to the name of each hook as it is being
 run."
-  (dolist (*hook* hookvars)
+  (dolist (*hook* hooks)
+    (run-hook *hook*)))
+
+(defgeneric run-hook (hook)
+  (:documentation "Run the functions in HOOK.")
+  (:method ((*hook* symbol))
     (dolist (fn (symbol-value *hook*))
       (with-hook-restart
         (funcall fn)))))
 
-(declaim (ftype (function (symbol &rest t)
-                          null)
-                run-hook-with-args))
-(defun run-hook-with-args (*hook* &rest args)
-  "Apply each function in the symbol value of HOOK to ARGS."
-  (dolist (fn (symbol-value *hook*))
-    (with-hook-restart
-      (apply fn args))))
-
-(declaim (ftype (function (symbol &rest t)
-                          boolean)
-                run-hook-with-args-until-failure))
-(defun run-hook-with-args-until-failure (*hook* &rest args)
-  "Like `run-hook-with-args', but quit once a function returns nil."
-  (loop for fn in (symbol-value *hook*)
-        always (apply fn args)))
-
-(declaim (ftype (function (symbol &rest t)
-                          t)
-                run-hook-with-args-until-success))
-(defun run-hook-with-args-until-success (*hook* &rest args)
-  "Like `run-hook-with-args', but quit once a function returns
-non-nil."
-  (loop for fn in (symbol-value *hook*)
-          thereis (apply fn args)))
+(defgeneric run-hook-with-args (hook &rest args)
+  (:documentation "Apply each function in HOOK to ARGS.")
+  (:method ((*hook* symbol) &rest args)
+    (dolist (fn (symbol-value *hook*))
+      (with-hook-restart
+        (apply fn args)))))
+
+(defgeneric run-hook-with-args-until-failure (hook &rest args)
+  (:documentation "Like `run-hook-with-args', but quit once a function returns nil.")
+  (:method ((*hook* symbol) &rest args)
+    (loop for fn in (symbol-value *hook*)
+          always (apply fn args))))
+
+(defgeneric run-hook-with-args-until-success (hook &rest args)
+  (:documentation "Like `run-hook-with-args', but quit once a function returns
+non-nil.")
+  (:method ((*hook* symbol) &rest args)
+    (loop for fn in (symbol-value *hook*)
+            thereis (apply fn args))))

package.lisp

@@ -280,6 +280,7 @@
    #:add-hook
    #:remove-hook
    #:run-hooks
+   #:run-hook
    #:run-hook-with-args
    #:run-hook-with-args-until-failure
    #:run-hook-with-args-until-success

serapeum.asd

@@ -62,7 +62,8 @@
                  (:file "time")
                  (:file "clos"
                   :depends-on ("binding"))
-                 (:file "hooks")
+                 (:file "hooks"
+                  :depends-on ("threads"))
                  (:file "fbind"
                   :depends-on ("binding" "control-flow" "op" "iter"))
                  (:file "reader"