Coverage report: /home/ellis/comp/core/lib/obj/meta/lazy.lisp

KindCoveredAll%
expression042 0.0
branch06 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; obj/meta/cached.lisp --- Simple cached generic functions
2
 
3
 ;;
4
 
5
 ;;; Code:
6
 (in-package :obj/meta/lazy)
7
 
8
 (defgeneric generic-function-cache (gf)
9
   (:method ((gf generic-function)) nil))
10
 
11
 (defgeneric method-cache (sm)
12
   (:method ((sm standard-method)) nil))
13
 
14
 (defclass cached-function (standard-generic-function)
15
   ((cache :initarg nil :accessor generic-function-cache))
16
   (:metaclass funcallable-standard-class))
17
 
18
 (defclass cached-method (standard-method)
19
   ((cache :reader method-cache)))
20
 
21
 (defmethod initialize-instance :before ((method cached-method) &key qualifiers)
22
   ;; make sure our cache is initialized.
23
   (unless qualifiers
24
     (when-let ((gf-cache (generic-function-cache (method-generic-function method))))
25
       (setf (slot-value method 'cache) gf-cache)))
26
   (when (member (first qualifiers) '(:before :after :around))
27
     (pop qualifiers))
28
   (when (eq (first qualifiers) :cache)
29
     (print (pop qualifiers))
30
     (unless qualifiers
31
       (error "Cache qualifier is not followed by a cache designator in method ~S." method))
32
     (unless (first qualifiers)
33
       (error "NIL is not a valid cache designator in method ~S." method))
34
     (setf (slot-value method 'cache)
35
           (pop qualifiers)
36
           qualifiers qualifiers)))
37
 
38
 #+nil
39
 (defgeneric c1 (self) (:generic-function-class cached-function) (:method-class cached-method))
40
 (defvar *cac* (make-hash-table))
41
 (defmethod c1 :cache *cac* ((self t)) t)