efim
/
common-lisp-study
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

koans - clos and advice 

objects similar to structures, but can have "generic" setters and creators
generic methods can have methods with qualifier :before :after :around
that in a way I don't fully understand registers them to be launched
with original function?
This commit is contained in:
efim 2022-08-06 09:00:44 +00:00
parent b7bccb9cfb
commit 4cfca2c9c3
2 changed files with 72 additions and 53 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

86
lisp-koans/koans/clos.lisp
View File

@ -96,6 +96,11 @@
(defclass person ()
((name :initarg :name :accessor person-name)))
(let* ((my-person (make-instance 'person :name "initial-name"))
(name-accessor (person-name my-person))
(name-generic (slot-value my-person 'name)))
(list name-accessor name-generic))
(defclass lisp-programmer (person)
((favorite-lisp-implementation :initarg :favorite-lisp-implementation
:accessor favorite-lisp-implementation)))
@ -104,22 +109,24 @@
((favorite-c-compiler :initarg :favorite-c-compiler
:accessor favorite-c-compiler)))
;; structures also have inheritance of some kind
(define-test inheritance
(let ((jack (make-instance 'person :name :jack))
(bob (make-instance 'lisp-programmer
:name :bob
:favorite-lisp-implementation :sbcl))
(adam (make-instance 'c-programmer
:name :adam
:favorite-c-compiler :clang)))
(assert-equal ____ (person-name jack))
(assert-equal ____ (person-name bob))
(assert-equal ____ (favorite-lisp-implementation bob))
(assert-equal ____ (person-name adam))
(assert-equal ____ (favorite-c-compiler adam))
(true-or-false? ____ (typep bob 'person))
(true-or-false? ____ (typep bob 'lisp-programmer))
(true-or-false? ____ (typep bob 'c-programmer))))
(let ((jack (make-instance 'person :name :jack))
(bob (make-instance 'lisp-programmer
:name :bob
:favorite-lisp-implementation :sbcl))
(adam (make-instance 'c-programmer
:name :adam
:favorite-c-compiler :clang)))
(assert-equal :jack (person-name jack))
(assert-equal :bob (person-name bob))
(assert-equal :sbcl (favorite-lisp-implementation bob))
(assert-equal :adam (person-name adam))
(assert-equal :clang (favorite-c-compiler adam))
(true-or-false? t (typep bob 'person))
(true-or-false? t (typep bob 'lisp-programmer))
(true-or-false? nil (typep bob 'c-programmer))))
;;; This includes multiple inheritance.
@ -130,13 +137,13 @@
:name :zenon
:favorite-lisp-implementation :clisp
:favorite-c-compiler :gcc)))
(assert-equal ____ (person-name zenon))
(assert-equal ____ (favorite-lisp-implementation zenon))
(assert-equal ____ (favorite-c-compiler zenon))
(true-or-false? ____ (typep zenon 'person))
(true-or-false? ____ (typep zenon 'lisp-programmer))
(true-or-false? ____ (typep zenon 'c-programmer))
(true-or-false? ____ (typep zenon 'clisp-programmer))))
(assert-equal :zenon (person-name zenon))
(assert-equal :clisp (favorite-lisp-implementation zenon))
(assert-equal :gcc (favorite-c-compiler zenon))
(true-or-false? t (typep zenon 'person))
(true-or-false? t (typep zenon 'lisp-programmer))
(true-or-false? t (typep zenon 'c-programmer))
(true-or-false? t (typep zenon 'clisp-programmer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -153,6 +160,8 @@
(pushnew name (greeted-people object) :test #'equal)
(format nil "Hello, ~A." name))
;; now #'defgeneric and #'defmethod are new things for me, don't know theory
(defclass chatbot ()
((version :reader version :initarg :version)))
@ -160,17 +169,17 @@
(define-test greeting-chatbot ()
(let ((chatbot (make-instance 'greeting-chatbot :version "1.0.0")))
(true-or-false? ____ (typep chatbot 'greeting-mixin))
(true-or-false? ____ (typep chatbot 'chatbot))
(true-or-false? ____ (typep chatbot 'greeting-chatbot))
(assert-equal ____ (greet chatbot "Tom"))
(assert-equal ____ (greeted-people chatbot))
(assert-equal ____ (greet chatbot "Sue"))
(assert-equal ____ (greet chatbot "Mark"))
(assert-equal ____ (greet chatbot "Kate"))
(assert-equal ____ (greet chatbot "Mark"))
(assert-equal ____ (greeted-people chatbot))
(assert-equal ____ (version chatbot))))
(true-or-false? t (typep chatbot 'greeting-mixin))
(true-or-false? t (typep chatbot 'chatbot))
(true-or-false? t (typep chatbot 'greeting-chatbot))
(assert-equal "Hello, Tom." (greet chatbot "Tom"))
(assert-equal '("Tom") (greeted-people chatbot))
(assert-equal "Hello, Sue." (greet chatbot "Sue"))
(assert-equal "Hello, Mark." (greet chatbot "Mark"))
(assert-equal "Hello, Kate." (greet chatbot "Kate"))
(assert-equal "Hello, Mark." (greet chatbot "Mark"))
(assert-equal '("Kate" "Mark" "Sue" "Tom") (greeted-people chatbot))
(assert-equal "1.0.0" (version chatbot))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -195,7 +204,10 @@
(antonio (make-instance 'italian))
(roy (make-instance 'stereotypical-person))
(mary (make-instance 'another-stereotypical-person)))
(assert-equal ____ (stereotypical-food james))
(assert-equal ____ (stereotypical-food antonio))
(assert-equal ____ (stereotypical-food roy))
(assert-equal ____ (stereotypical-food mary))))
(assert-equal :burger (stereotypical-food james))
(assert-equal :pasta (stereotypical-food antonio))
(assert-equal :burger (stereotypical-food roy))
(assert-equal :pasta (stereotypical-food mary))))
;; well, I'd need maybe some reading experience of code written "well" in CLOS
;; or maybe exercises, currently generic methods seem to be sooo unpleasant to use

39
lisp-koans/koans/std-method-comb.lisp
View File

@ -29,21 +29,26 @@
(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 ____ (access-count counter))
(assert-equal ____ (value counter))
(assert-equal ____ (access-count counter))
(setf (value counter) 24)
(assert-equal ____ (access-count counter))
(assert-equal ____ (value counter))
(assert-equal ____ (access-count counter))
;; We read the value three more times and discard the result.
(value counter)
(value counter)
(value counter)
(assert-equal ____ (access-count counter))))
(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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@ -55,15 +60,17 @@
(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))
(define-test lollipop
(assert-equal ____ (grab-lollipop))
(assert-equal ____ (grab-lollipop-while-mom-is-nearby t))
(assert-equal ____ (grab-lollipop-while-mom-is-nearby nil)))
(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)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;