249 lines
12 KiB
Common Lisp
249 lines
12 KiB
Common Lisp
;;; Copyright 2013 Google Inc.
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
(defclass access-counter ()
|
|
((value :accessor value :initarg :value)
|
|
(access-count :reader access-count :initform 0)))
|
|
|
|
;;; The generated reader, writer, and accessor functions are generic functions.
|
|
;;; The methods of a generic function are combined using a method combination;
|
|
;;; by default, the standard method combination is used.
|
|
|
|
;;; This allows us to define :BEFORE and :AFTER methods whose code is executed
|
|
;;; before or after the primary method, and whose return values are discarded.
|
|
;;; The :BEFORE and :AFTER keywords used in this context are called qualifiers.
|
|
|
|
(defmethod value :after ((object access-counter))
|
|
(incf (slot-value object 'access-count)))
|
|
|
|
;; how is the signature for attributes decided?
|
|
;; do I just need to remember how (setf 'accessor') get arguments and those are all same?
|
|
(defmethod (setf value) :after (new-value (object access-counter))
|
|
(incf (slot-value object 'access-count)))
|
|
;; wowy, so 'value has :accessor - both reader value and writer through (setf value)
|
|
;; and these are gefgeneric, so I could after declaration of defgeneric add
|
|
;; more specific defmethod?
|
|
;; and they'd be specified to a specific type by having argument as (arg-name arg-class)
|
|
;; and 'qualifier' :after, that's trippy
|
|
|
|
(define-test defmethod-after
|
|
(let ((counter (make-instance 'access-counter :value 42)))
|
|
(assert-equal 0 (access-count counter))
|
|
(assert-equal 42 (value counter))
|
|
(assert-equal 1 (access-count counter))
|
|
(setf (value counter) 24)
|
|
(assert-equal 2 (access-count counter))
|
|
(assert-equal 24 (value counter))
|
|
(assert-equal 3 (access-count counter))
|
|
;; We read the value three more times and discard the result.
|
|
(value counter)
|
|
(value counter)
|
|
(value counter)
|
|
(assert-equal 6 (access-count counter))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; In addition to :BEFORE and :AFTER methods is also possible to write :AROUND
|
|
;;; methods, which execute instead of the primary methods. In such context, it
|
|
;;; is possible to call the primary method via CALL-NEXT-METHOD.
|
|
;;; In the standard method combination, the :AROUND method, if one exists, is
|
|
;;; executed first, and it may choose whether and how to call next methods.
|
|
|
|
(defgeneric grab-lollipop ()
|
|
(:method () :lollipop))
|
|
;; wtf is :method here?
|
|
;; oh, it's shorthand of defmethod inside of defgeneric
|
|
|
|
(defgeneric grab-lollipop-while-mom-is-nearby (was-nice-p)
|
|
(:method :around (was-nice-p) (if was-nice-p (call-next-method) :no-lollipop))
|
|
(:method (was-nice-p) (declare (ignore was-nice-p)) :lollipop))
|
|
;; why are here two methods? I don't understand
|
|
;; what's the connection between DEFGENERIC and DEFMETHOD ?
|
|
|
|
(define-test lollipop
|
|
(assert-equal :lollipop (grab-lollipop))
|
|
(assert-equal :lollipop (grab-lollipop-while-mom-is-nearby t))
|
|
(assert-equal :no-lollipop (grab-lollipop-while-mom-is-nearby nil)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defclass countdown ()
|
|
;; The countdown object represents an ongoing countdown. Each time the
|
|
;; REMAINING-TIME function is called, it should return a number one less than
|
|
;; the previous time that it returned. If the countdown hits zero, :BANG
|
|
;; should be returned instead.
|
|
((remaining-time :reader remaining-time :initarg :time)))
|
|
;; :reader remaining-time created DEFGENERIC over countdown object
|
|
;; so separately donig DEFMEHTOD could be as advice around, ok
|
|
|
|
;; is here OBJECT is a signifier? or a name for referencing? would OBJ do?
|
|
(defmethod remaining-time :around ((object countdown))
|
|
(let ((time (call-next-method)))
|
|
(if (< 0 time)
|
|
;; DECF is similar to INCF. It decreases the value stored in the place
|
|
;; and returns the decreased value.
|
|
(decf (slot-value object 'remaining-time))
|
|
:bang)))
|
|
|
|
(define-test countdown
|
|
(let ((countdown (make-instance 'countdown :time 4)))
|
|
(assert-equal 3 (remaining-time countdown))
|
|
(assert-equal 2 (remaining-time countdown))
|
|
(assert-equal 1 (remaining-time countdown))
|
|
(assert-equal 0 (remaining-time countdown))
|
|
(assert-equal :bang (remaining-time countdown))
|
|
(assert-equal :bang (remaining-time countdown))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; It is possible for multiple :BEFORE, :AFTER, :AROUND, or primary methods to
|
|
;;; be executed in a single method call.
|
|
|
|
(defclass object ()
|
|
((counter :accessor counter :initform 0)))
|
|
|
|
(defclass bigger-object (object) ())
|
|
|
|
(defgeneric frobnicate (x)
|
|
(:method :around ((x bigger-object))
|
|
(incf (counter x) 8)
|
|
(call-next-method))
|
|
(:method :around ((x object))
|
|
(incf (counter x) 70)
|
|
(call-next-method))
|
|
(:method :before ((x bigger-object))
|
|
(incf (counter x) 600))
|
|
(:method :before ((x object))
|
|
(incf (counter x) 5000))
|
|
(:method ((x bigger-object))
|
|
(incf (counter x) 40000)
|
|
(call-next-method))
|
|
(:method ((x object))
|
|
(incf (counter x) 300000))
|
|
(:method :after ((x object))
|
|
(incf (counter x) 2000000))
|
|
(:method :after ((x bigger-object))
|
|
(incf (counter x) 10000000)))
|
|
|
|
(define-test multiple-methods
|
|
(let ((object (make-instance 'object)))
|
|
(frobnicate object)
|
|
(assert-equal (+ 5000 70 300000 2000000) (counter object)))
|
|
(let ((object (make-instance 'bigger-object)))
|
|
(frobnicate object) ; nope, don't understand, why 345678
|
|
(assert-equal (+ 8 70 600 5000 40000 300000 2000000 10000000) (counter object))))
|
|
;; attempting get read documentation on CALL-NEXT-METHOD
|
|
;; getting to http://www.lispworks.com/documentation/HyperSpec/Body/07_ffb.htm
|
|
;;; The semantics of standard method combination is as follows:
|
|
;; * If there are any around methods, the most specific around method is called. It supplies the value or values of the generic function.
|
|
;; * Inside the body of an around method, call-next-method can be used to call the next method. When the next method returns, the around method can execute more code, perhaps based on the returned value or values. The generic function no-next-method is invoked if call-next-method is used and there is no applicable method to call. The function next-method-p may be used to determine whether a next method exists.
|
|
;; * If an around method invokes call-next-method, the next most specific around method is called, if one is applicable. If there are no around methods or if call-next-method is called by the least specific around method, the other methods are called as follows:
|
|
;; -- All the before methods are called, in most-specific-first order. Their values are ignored. An error is signaled if call-next-method is used in a before method.
|
|
;; -- The most specific primary method is called. Inside the body of a primary method, call-next-method may be used to call the next most specific primary method. When that method returns, the previous primary method can execute more code, perhaps based on the returned value or values. The generic function no-next-method is invoked if call-next-method is used and there are no more applicable primary methods. The function next-method-p may be used to determine whether a next method exists. If call-next-method is not used, only the most specific primary method is called.
|
|
;; -- All the after methods are called in most-specific-last order. Their values are ignored. An error is signaled if call-next-method is used in an after method.
|
|
;; * If no around methods were invoked, the most specific primary method supplies the value or values returned by the generic function. The value or values returned by the invocation of call-next-method in the least specific around method are those returned by the most specific primary method.
|
|
;; In standard method combination, if there is an applicable method but no applicable primary method, an error is signaled.
|
|
;; The before methods are run in most-specific-first order while the after methods are run in least-specific-first order. The design rationale for this difference can be illustrated with an example. Suppose class C1 modifies the behavior of its superclass, C2, by adding before methods and after methods. Whether the behavior of the class C2 is defined directly by methods on C2 or is inherited from its superclasses does not affect the relative order of invocation of methods on instances of the class C1. Class C1's before method runs before all of class C2's methods. Class C1's after method runs after all of class C2's methods.
|
|
;; By contrast, all around methods run before any other methods run. Thus a less specific around method runs before a more specific primary method.
|
|
;; If only primary methods are used and if call-next-method is not used, only the most specific method is invoked; that is, more specific methods shadow more general ones.
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; The method order of the standard combination is as follows:
|
|
;;; First, the most specific :AROUND method is executed.
|
|
;;; Second, all :BEFORE methods are executed, most specific first.
|
|
;;; Third, the most specific primary method is executed.
|
|
;;; Fourth, all :AFTER methods are executed, most specific last.
|
|
|
|
(defgeneric calculate (x)
|
|
(:method :around ((x bigger-object))
|
|
(setf (counter x) 40)
|
|
(call-next-method))
|
|
(:method :around ((x object))
|
|
(incf (counter x) 24)
|
|
(call-next-method))
|
|
(:method :before ((x bigger-object))
|
|
(setf (counter x) (mod (counter x) 6)))
|
|
(:method :before ((x object))
|
|
(setf (counter x) (/ (counter x) 4)))
|
|
(:method ((x bigger-object))
|
|
(setf (counter x) (* (counter x) (counter x)))
|
|
(call-next-method))
|
|
(:method ((x object))
|
|
(decf (counter x) 100))
|
|
(:method :after ((x object))
|
|
(setf (counter x) (/ 1 (counter x))))
|
|
(:method :after ((x bigger-object))
|
|
(incf (counter x) 2)))
|
|
|
|
(define-test standard-method-combination-order
|
|
(let ((object (make-instance 'object)))
|
|
(calculate object)
|
|
(assert-equal ____ (counter object)))
|
|
(let ((object (make-instance 'bigger-object)))
|
|
(calculate object)
|
|
(assert-equal ____ (counter object))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defclass programmer () ())
|
|
|
|
(defclass senior-programmer (programmer) ())
|
|
|
|
(defclass full-stack-programmer (programmer) ())
|
|
|
|
(defclass senior-full-stack-programmer (senior-programmer
|
|
full-stack-programmer)
|
|
())
|
|
|
|
;;; The :BEFORE, :AFTER, and :AROUND methods are only available in the standard
|
|
;;; method combination. It is possible to use other method combinations, such as
|
|
;;; +.
|
|
|
|
(defgeneric salary-at-company-a (programmer)
|
|
(:method-combination +)
|
|
(:method + ((programmer programmer)) 120000)
|
|
(:method + ((programmer senior-programmer)) 200000)
|
|
(:method + ((programmer full-stack-programmer)) 48000))
|
|
|
|
(define-test salary-at-company-a
|
|
(let ((programmer (make-instance 'programmer)))
|
|
(assert-equal ____ (salary-at-company-a programmer)))
|
|
(let ((programmer (make-instance 'senior-programmer)))
|
|
(assert-equal ____ (salary-at-company-a programmer)))
|
|
(let ((programmer (make-instance 'full-stack-programmer)))
|
|
(assert-equal ____ (salary-at-company-a programmer)))
|
|
(let ((programmer (make-instance 'senior-full-stack-programmer)))
|
|
(assert-equal ____ (salary-at-company-a programmer))))
|
|
|
|
;;; It is also possible to define custom method combinations.
|
|
|
|
(define-method-combination multiply :operator *)
|
|
|
|
(defgeneric salary-at-company-b (programmer)
|
|
(:method-combination multiply)
|
|
(:method multiply ((programmer programmer)) 120000)
|
|
(:method multiply ((programmer senior-programmer)) 2)
|
|
(:method multiply ((programmer full-stack-programmer)) 7/5))
|
|
|
|
(define-test salary-at-company-b
|
|
(let ((programmer (make-instance 'programmer)))
|
|
(assert-equal ____ (salary-at-company-b programmer)))
|
|
(let ((programmer (make-instance 'senior-programmer)))
|
|
(assert-equal ____ (salary-at-company-b programmer)))
|
|
(let ((programmer (make-instance 'full-stack-programmer)))
|
|
(assert-equal ____ (salary-at-company-b programmer)))
|
|
(let ((programmer (make-instance 'senior-full-stack-programmer)))
|
|
(assert-equal ____ (salary-at-company-b programmer))))
|