Регистрация | Войти
Lisp — программируемый язык программирования
Кэширование результатов функций
Автор: motopeh - 2014-04-24T03:05:05.000000+04:00
(define-condition function-caching-chance ()
  ((cached-function :initform (error "Cached function is unspecified")
                    :initarg :function
                    :reader cache-chance-function
)
)
)


(defparameter *cleaner-table*
  (make-hash-table)
)


;; FIXME: *cleaner-table* cleaning
(defun clean-cached-function-cache (&rest functions)
  (if functions
      (map nil
           (lambda (function)
             (funcall (gethash function
                               *cleaner-table*
)
)
)

           functions
)

      (maphash (lambda (fun cleaner)
                 (declare (ignore fun))
                 (funcall cleaner)
)

               *cleaner-table*
)
)
)


(defmacro define-cached-function-cache-cleaner (name cache)
  `(setf (gethash (symbol-function ',name)
                  *cleaner-table*
)

         (lambda ()
           (setf ,cache nil)
)
)
)


;; TODO: function documentation support
;; TODO: multiple values support
;; TODO: caching nil result case
(defmacro define-cached-function (name (&rest lambda-list)
                                  &body code
                                  &aux
                                    (cache-sym
                                     (gensym
                                      (format nil "~A-CACHE-"
                                              (symbol-name name)
)
)
)

                                    (result-sym (gensym "RESULT-"))
)

  `(let (,cache-sym)
     (defun ,name ,lambda-list
       (or ,cache-sym
           (let ((,result-sym (block ,name ,@code)))
             (restart-case (progn
                             (signal 'function-caching-chance
                                     :function #',name
)

                             ,result-sym
)

               (ok () ,result-sym)
               (cache () (setf ,cache-sym ,result-sym))
)
)
)
)

     (define-cached-function-cache-cleaner ,name ,cache-sym)
)
)


(defmacro with-cached-invocation (functions &body code
                                  &aux
                                    (function-list
                                     (map 'list
                                          (lambda (x)
                                            (etypecase x
                                              (symbol (symbol-function x))
                                              (function x)
)
)

                                          (if (listp functions)
                                              functions
                                              (list functions)
)
)
)
)

  
  `(handler-bind ((function-caching-chance
                    (lambda (c)
                      (if (member (cache-chance-function c)
                                  (list ,@function-list)
)

                          (invoke-restart 'cache)
                          (invoke-restart 'ok)
)
)
)
)

     (unwind-protect (progn ,@code)
       (clean-cached-function-cache ,@function-list)
)
)
)
@2009-2013 lisper.ru